| author | Jan Vrany <jan.vrany@fit.cvut.cz> |
| Tue, 17 May 2016 10:05:14 +0100 | |
| branch | jv |
| changeset 19863 | 513bd7237fe7 |
| parent 19862 | 6c010853ea32 (current diff) |
| parent 19860 | 324edacff5cc (diff) |
| child 19882 | 8a3f4071dfec |
--- a/AbstractOperatingSystem.st Sun May 15 08:38:43 2016 +0100 +++ b/AbstractOperatingSystem.st Tue May 17 10:05:14 2016 +0100 @@ -1939,27 +1939,27 @@ Return true if successful, false otherwise." ^ self - executeCommand:aCommandString - inputFrom:nil - outputTo:anOutStreamOrNil - errorTo:anErrStreamOrNil - auxFrom:nil - environment:nil - inDirectory:nil - lineWise:false - onError:[:status| false] + executeCommand:aCommandString + inputFrom:nil + outputTo:anOutStreamOrNil + errorTo:anErrStreamOrNil + auxFrom:nil + environment:nil + inDirectory:nil + lineWise:false + onError:[:status| false] " String streamContents:[:s|OperatingSystem - executeCommand:'ls' - outputTo:s + executeCommand:'ls' + outputTo:s ] " " String streamContents:[:s|OperatingSystem - executeCommand:'pwd' - outputTo:s + executeCommand:'pwd' + outputTo:s ] " ! @@ -3664,7 +3664,7 @@ %{ /* NOCONTEXT */ #ifndef CC_DEFINE -# ifdef WIN32 +# ifdef __win32__ # if defined( __BORLANDC__ ) # define CC_DEFINE "__BORLANDC__" # else @@ -3682,9 +3682,9 @@ # endif # endif # endif -# else /* not WIN32 */ -# ifdef __clang__ -# define CC_DEFINE "__clang__" +# else /* not __win32__ */ +# ifdef __CLANG__ +# define CC_DEFINE "__CLANG__" # else # ifdef __GNUC__ # define CC_DEFINE "__GNUC__" @@ -3736,7 +3736,9 @@ # ifdef __mips__ # define CPU_SYMBOL @symbol(mips) # endif -# ifdef __i386__ +# if defined(__x86__) +# define CPU_SYMBOL @symbol(x86) +# elif defined(__i386__) // old style # define CPU_SYMBOL @symbol(i386) # endif # ifdef __x86_64__ @@ -3942,8 +3944,8 @@ %{ /* NOCONTEXT */ #ifndef OS_DEFINE -# ifdef WIN32 -# define OS_DEFINE "-DWIN32" +# ifdef __win32__ +# define OS_DEFINE "-D__win32__" # endif # ifndef OS_DEFINE @@ -3969,19 +3971,33 @@ %{ /* NOCONTEXT */ -# ifdef MSDOS -# define OS_SYMBOL @symbol(msdos) -# endif - -# ifdef WIN32 + // do not do this; all win sytems are counted as win32 (for now); + // see the detailed getSystemType / getSytemInfo for that + // # ifdef __win64__ + // # define OS_SYMBOL @symbol(win64) + // # endif + +# ifdef __win32__ # define OS_SYMBOL @symbol(win32) # endif -# ifdef MSWINDOWS +# ifdef __MSWINDOWS__ # define OS_SYMBOL @symbol(mswindows) # endif -# ifdef VMS +# ifdef __OS2__ +# define OS_SYMBOL @symbol(os2) +# endif + +# ifdef __BEOS__ +# define OS_SYMBOL @symbol(beos) +# endif + +# ifdef __MSDOS__ +# define OS_SYMBOL @symbol(msdos) +# endif + +# ifdef __VMS__ # ifdef __openVMS__ # define OS_SYMBOL @symbol(openVMS) # else @@ -3989,55 +4005,51 @@ # endif # endif -# ifdef MVS /* ;-) */ +# ifdef __MVS__ /* ;-) */ # define OS_SYMBOL @symbol(mvs) # endif -# ifdef OS2 -# define OS_SYMBOL @symbol(os2) -# endif - -# ifdef sinix +# ifdef __sinix__ # define OS_SYMBOL @symbol(sinix) # endif -# ifdef ultrix +# ifdef __ultrix__ # define OS_SYMBOL @symbol(ultrix) # endif -# ifdef sco +# ifdef __sco__ # define OS_SYMBOL @symbol(sco) # endif -# ifdef hpux +# ifdef __hpux__ # define OS_SYMBOL @symbol(hpux) # endif -# ifdef LINUX +# ifdef __linux__ # define OS_SYMBOL @symbol(linux) # endif -# ifdef FREEBSD +# ifdef __FREEBSD__ # define OS_SYMBOL @symbol(freeBSD) # endif -# ifdef sunos +# ifdef __sunos__ # define OS_SYMBOL @symbol(sunos) # endif -# ifdef solaris +# ifdef __solaris__ # define OS_SYMBOL @symbol(solaris) # endif -# ifdef IRIS +# ifdef __IRIS__ # define OS_SYMBOL @symbol(irix) # endif -# ifdef aix +# ifdef __aix__ # define OS_SYMBOL @symbol(aix) # endif -# ifdef realIX +# ifdef __realIX__ # define OS_SYMBOL @symbol(realIX) # endif @@ -4059,15 +4071,15 @@ # endif # ifndef OS_SYMBOL -# ifdef BSD +# ifdef __BSD__ # define OS_SYMBOL @symbol(bsd) # endif -# ifdef SYSV -# ifdef SYSV3 +# ifdef __SYSV__ +# ifdef __SYSV3__ # define OS_SYMBOL @symbol(sys5_3) # else -# ifdef SYSV4 +# ifdef __SYSV4__ # define OS_SYMBOL @symbol(sys5_4) # else # define OS_SYMBOL @symbol(sys5) @@ -4080,13 +4092,13 @@ * become very vague ... */ # ifndef OS_SYMBOL -# ifdef POSIX -# define OS_SYMBOL @symbol(posix) +# ifdef __UNIX__ +# define OS_SYMBOL @symbol(unix) # endif # endif # ifndef OS_SYMBOL -# ifdef UNIX -# define OS_SYMBOL @symbol(unix) +# ifdef __POSIX__ +# define OS_SYMBOL @symbol(posix) # endif # endif @@ -4113,29 +4125,34 @@ %{ /* NOCONTEXT */ #ifndef PLATFORM_DEFINE -# ifdef WIN32 -# define PLATFORM_DEFINE "-DWIN32" +# ifdef __win32__ +# define PLATFORM_DEFINE "-D__win32__" # endif -# ifdef OS2 -# define PLATFORM_DEFINE "-DOS2" +# ifdef __OS2__ +# define PLATFORM_DEFINE "-D__OS2__" # endif -# ifdef BEOS -# define PLATFORM_DEFINE "-DBEOS" +# ifdef __BEOS__ +# define PLATFORM_DEFINE "-D__BEOS__" # endif -# ifdef MACOS -# define PLATFORM_DEFINE "-DMACOS" +# ifdef __MACOS__ +# define PLATFORM_DEFINE "-D__MACOS__" # endif -# ifdef VMS -# define PLATFORM_DEFINE "-DVMS" +# ifdef __VMS__ +# define PLATFORM_DEFINE "-D__VMS__" # endif # ifdef __osx__ # define PLATFORM_DEFINE "-D__osx__" # endif -# ifdef OSX -# define PLATFORM_DEFINE "-DOSX" +// # ifdef OSX +// # define PLATFORM_DEFINE "-DOSX" +// # endif +# ifndef PLATFORM_DEFINE +# ifdef __UNIX__ +# define PLATFORM_DEFINE "-D__UNIX__" +# endif # endif # ifndef PLATFORM_DEFINE -# define PLATFORM_DEFINE "-DUNIX" +# define PLATFORM_DEFINE "-DunknownPlatform" # endif #endif @@ -4338,12 +4355,14 @@ ^#( win32 + osx "/ yes!! it is supported + unix + os2 "/ actually - this is no longer true (OS/2 not supported) macos "/ actually - this is no longer true (old MACOS not supported) - vms "/ actually - this is no longer true (VMS not supported) + vms "/ actually - this is no longer true (VMS no longer supported) + qnx "/ actually - this is no longer true (qny no longer supported) beos "/ actually - this was never true (beos not supported) - osx "/ yes!! it is supported - unix ) " @@ -4409,13 +4428,13 @@ platformDefineForPlatformName:osID "return a c-define for a particular platform (use only for makefile generation etc.)" - osID = #win32 ifTrue:[ ^ '-DWIN32']. - osID = #os2 ifTrue:[ ^ '-DOS2']. - osID = #macos ifTrue:[ ^ '-DMACOS']. - osID = #beos ifTrue:[ ^ '-DBEOS']. - osID = #vms ifTrue:[ ^ '-DVMS']. - osID = #unix ifTrue:[ ^ '-DUNIX']. - osID = #osx ifTrue:[ ^ '-DOSX']. + osID = #win32 ifTrue:[ ^ '-D__win32__']. + osID = #os2 ifTrue:[ ^ '-D__OS2__']. + osID = #macos ifTrue:[ ^ '-D__MACOS__']. + osID = #beos ifTrue:[ ^ '-D__beos__']. + osID = #vms ifTrue:[ ^ '-D__VMS__']. + osID = #unix ifTrue:[ ^ '-D__UNIX__']. + osID = #osx ifTrue:[ ^ '-D__OSX__']. self error:'unknown os'. " @@ -4433,10 +4452,12 @@ |os| os := self getSystemType. + os = #osx ifTrue:[ ^ #osx]. os = #win32 ifTrue:[ ^ #win32]. + os = #os2 ifTrue:[ ^ #os2]. - os = #osx ifTrue:[ ^ #osx]. os = #macos ifTrue:[ ^ #macos]. + os = #VMS ifTrue:[ ^ #vms]. os = #openVMS ifTrue:[ ^ #vms]. ^ #unix
--- a/CharacterArray.st Sun May 15 08:38:43 2016 +0100 +++ b/CharacterArray.st Tue May 17 10:05:14 2016 +0100 @@ -349,6 +349,7 @@ "Created: 3.8.1997 / 18:16:40 / cg" ! ! + !CharacterArray class methodsFor:'cleanup'! lowSpaceCleanup @@ -367,31 +368,189 @@ !CharacterArray class methodsFor:'encoding & decoding'! decodeFromUTF8:aStringOrByteCollection - "return a string which represents the characters as decoded - from the utf8 encoded bytes, aByteCollection. - Returns either a normal String, or a TwoByteString instance. - Only useful, when reading twoByteStrings from external sources. - This only handles up-to 16bit characters." - - ^ CharacterEncoderImplementations::ISO10646_to_UTF8 new decodeString:aStringOrByteCollection - - " - CharacterArray fromUTF8Bytes:#[ 16r41 16r42 ] - CharacterArray fromUTF8Bytes:#[ 16rC1 16r02 ] - CharacterArray fromUTF8Bytes:#[ 16rE0 16r81 16r02 ] - CharacterArray fromUTF8Bytes:#[ 16rEF 16rBF 16rBF ] + "given a string in UTF8 encoding, + return a new string containing the same characters, in Unicode encoding. + Returns either a normal String, a Unicode16String or a Unicode32String instance. + This is only useful, when reading from external sources or communicating with + other systems + (ST/X never uses utf8 internally, but always uses strings of fully decoded unicode characters). + This only handles up-to 30bit characters." + + |sz anyAbove7BitAscii nBitsRequired + ascii "{ Class: SmallInteger }" + byte "{ Class: SmallInteger }" + lastIdx "{ Class: SmallInteger }" + srcIdx "{ Class: SmallInteger }" + idx "{ Class: SmallInteger }" + nFollowBytes "{ Class: SmallInteger }" + minValue "{ Class: SmallInteger }" + newString| + + "/ fast track, also avoid creation of new strings if aStringOrByteCollection is already a 7-bit string + aStringOrByteCollection containsNon7BitAscii ifFalse:[ + ^ aStringOrByteCollection asSingleByteString + ]. + + nBitsRequired := 8. + anyAbove7BitAscii := false. + sz := 0. + + lastIdx := aStringOrByteCollection size. + srcIdx := 1. + + "first determine the string size and max element size. + Check for UTF-8 confomance on the fly." + [srcIdx <= lastIdx] whileTrue:[ + byte := ascii := aStringOrByteCollection byteAt:srcIdx. + srcIdx := srcIdx + 1. + (byte bitAnd:16r80) ~~ 0 ifTrue:[ + anyAbove7BitAscii := true. + (byte bitAnd:2r11100000) == 2r11000000 ifTrue:[ + "/ 80 .. 7FF + ascii := byte bitAnd:2r00011111. + nFollowBytes := 1. + minValue := 16r80. + ] ifFalse:[(byte bitAnd:2r11110000) == 2r11100000 ifTrue:[ + "/ 800 .. FFFF + ascii := byte bitAnd:2r00001111. + nFollowBytes := 2. + minValue := 16r800. + ] ifFalse:[(byte bitAnd:2r11111000) == 2r11110000 ifTrue:[ + "/ 10000 .. 1FFFFF + ascii := byte bitAnd:2r00000111. + nFollowBytes := 3. + minValue := 16r10000. + ] ifFalse:[(byte bitAnd:2r11111100) == 2r11111000 ifTrue:[ + "/ 200000 .. 3FFFFFF + ascii := byte bitAnd:2r00000011. + nFollowBytes := 4. + minValue := 16r200000. + ] ifFalse:[(byte bitAnd:2r11111110) == 2r11111100 ifTrue:[ + "/ 4000000 .. 7FFFFFFF + ascii := byte bitAnd:2r00000001. + ascii ~~ 0 ifTrue:[ + "/ ST/X can only represent 30 bit unicode characters. + "/ but the max unicode character is defined as 16r10 FFFF anyway + ^ DecodingError newException + defaultValue:aStringOrByteCollection; + raiseRequestWith:aStringOrByteCollection errorString:'unicode character out of range'. + ]. + nFollowBytes := 5. + minValue := 16r4000000. + ] ifFalse:[ + ^ DecodingError newException + defaultValue:aStringOrByteCollection; + raiseRequestWith:aStringOrByteCollection errorString:'invalid utf8 encoding'. + ]]]]]. + + nFollowBytes timesRepeat:[ + byte := aStringOrByteCollection byteAt:srcIdx. + srcIdx := srcIdx + 1. + (byte bitAnd:2r11000000) ~~ 2r10000000 ifTrue:[ + ^ DecodingError newException + defaultValue:aStringOrByteCollection; + raiseRequestWith:aStringOrByteCollection errorString:'illegal followbyte'. + ]. + ascii := (ascii bitShift:6) bitOr:(byte bitAnd:2r00111111). + ]. + ascii > 16rFFFF ifTrue:[ + nBitsRequired < 32 ifTrue:[nBitsRequired := 32]. + ] ifFalse:[ascii > 16rFF ifTrue:[ + nBitsRequired < 16 ifTrue:[nBitsRequired := 16]. + ]]. + ascii < minValue ifTrue:[ + "encoding a value in a longer utf8-sequence than required is not allowed + and imposes a security risk" + ^ DecodingError newException + defaultValue:aStringOrByteCollection; + raiseRequestWith:aStringOrByteCollection errorString:'overlong utf8 sequence'. + ]. + ]. + sz := sz + 1. + ]. + + nBitsRequired == 8 ifTrue:[ + anyAbove7BitAscii ifFalse:[ + "/ can return the original string + ^ aStringOrByteCollection asSingleByteString. + ]. + newString := String uninitializedNew:sz + ] ifFalse:[nBitsRequired <= 16 ifTrue:[ + newString := Unicode16String new:sz + ] ifFalse:[ + newString := Unicode32String new:sz + ]]. + + idx := srcIdx := 1. + + "now fill the string" + [srcIdx <= lastIdx] whileTrue:[ + byte := ascii := aStringOrByteCollection byteAt:srcIdx. + srcIdx := srcIdx + 1. + (byte bitAnd:2r10000000) ~~ 0 ifTrue:[ + (byte bitAnd:2r11100000) == 2r11000000 ifTrue:[ + ascii := byte bitAnd:2r00011111. + nFollowBytes := 1. + ] ifFalse:[(byte bitAnd:2r11110000) == 2r11100000 ifTrue:[ + ascii := byte bitAnd:2r00001111. + nFollowBytes := 2. + ] ifFalse:[(byte bitAnd:2r11111000) == 2r11110000 ifTrue:[ + ascii := byte bitAnd:2r00000111. + nFollowBytes := 3. + ] ifFalse:[(byte bitAnd:2r11111100) == 2r11111000 ifTrue:[ + "5 byte sequences do not result in valid unicode" + ascii := byte bitAnd:2r00000011. + nFollowBytes := 4. + ] ifFalse:[(byte bitAnd:2r11111110) == 2r11111100 ifTrue:[ + "6 byte sequences do not result in valid unicode" + ascii := byte bitAnd:2r00000001. + nFollowBytes := 5. + ]]]]]. + nFollowBytes timesRepeat:[ + byte := aStringOrByteCollection byteAt:srcIdx. + srcIdx := srcIdx + 1. + ascii := (ascii bitShift:6) bitOr:(byte bitAnd:2r00111111). + ]. + ]. + newString at:idx put:(Character value:ascii). + idx := idx + 1. + ]. + ^ newString + + " + CharacterArray decodeFromUTF8:#[ 16r41 16r42 ] + CharacterArray decodeFromUTF8:#[ 16rC6 16r8F ] + CharacterArray decodeFromUTF8:#[ 16rE0 16r81 16r02 ] + CharacterArray decodeFromUTF8:#[ 16rEF 16rBF 16rBF ] + + rfc2279 (deprecated) examples: + CharacterArray decodeFromUTF8:#[ 16r41 16rE2 16r89 16rA2 16rCE 16r91 16r2E ] + CharacterArray decodeFromUTF8:#[ 16rED 16r95 16r9C 16rEA 16rB5 16rAD 16rEC 16r96 16rB4 ] + CharacterArray decodeFromUTF8:#[ 16rE6 16r97 16rA5 16rE6 16r9C 16rAC 16rE8 16rAA 16r9E ] + + invalid: + CharacterArray decodeFromUTF8:#[ 16rC0 16r80 ] + CharacterArray decodeFromUTF8:#[ 16rE0 16r80 16r80 ] + " + + " + CharacterArray decodeFromUTF8:#[ 16r41 16r42 ] + CharacterArray decodeFromUTF8:#[ 16rC1 16r02 ] + CharacterArray decodeFromUTF8:#[ 16rE0 16r81 16r02 ] + CharacterArray decodeFromUTF8:#[ 16rEF 16rBF 16rBF ] rfc2279 examples: - CharacterArray fromUTF8Bytes:#[ 16r41 16rE2 16r89 16rA2 16rCE 16r91 16r2E ] - CharacterArray fromUTF8Bytes:#[ 16rED 16r95 16r9C 16rEA 16rB5 16rAD 16rEC 16r96 16rB4 ] - CharacterArray fromUTF8Bytes:#[ 16rE6 16r97 16rA5 16rE6 16r9C 16rAC 16rE8 16rAA 16r9E ] + CharacterArray decodeFromUTF8:#[ 16r41 16rE2 16r89 16rA2 16rCE 16r91 16r2E ] + CharacterArray decodeFromUTF8:#[ 16rED 16r95 16r9C 16rEA 16rB5 16rAD 16rEC 16r96 16rB4 ] + CharacterArray decodeFromUTF8:#[ 16rE6 16r97 16rA5 16rE6 16r9C 16rAC 16rE8 16rAA 16r9E ] invalid: - CharacterArray fromUTF8Bytes:#[ 16rC0 16r80 ] - CharacterArray fromUTF8Bytes:#[ 16rE0 16r80 16r80 ] + CharacterArray decodeFromUTF8:#[ 16rC0 16r80 ] + CharacterArray decodeFromUTF8:#[ 16rE0 16r80 16r80 ] " ! ! + !CharacterArray class methodsFor:'pattern matching'! matchEscapeCharacter @@ -797,6 +956,7 @@ ^ Unicode32String ! ! + !CharacterArray methodsFor:'Compatibility-ANSI'! addLineDelimiters @@ -4474,56 +4634,138 @@ ! utf8Encoded - "Return my UTF-8 representation as a new String" - - |string| + "return the UTF-8 representation of a Unicode string. + The resulting string is only useful to be stored on some external file, + not for being used inside ST/X." + + |string stream| string := self string. - string ~~ self ifTrue:[ - ^ string utf8Encoded. - ]. - - ^ CharacterEncoderImplementations::ISO10646_to_UTF8 new encodeString:self - - " + + "/ avoid creation of new strings if possible + string containsNon7BitAscii ifFalse:[ + ^ string asSingleByteString + ]. + + "make it size 2 for 1-byte strings" + stream := WriteStream on:(String uninitializedNew:(1 + (string size * 3 // 2))). + string utf8EncodedOn:stream. + ^ stream contents. + + " + 'hello' utf8Encoded asByteArray #[104 101 108 108 111] + (Character value:16r40) asString utf8Encoded asByteArray #[64] + (Character value:16r7F) asString utf8Encoded asByteArray #[127] + (Character value:16r80) asString utf8Encoded asByteArray #[194 128] + (Character value:16rFF) asString utf8Encoded asByteArray #[195 191] + (Character value:16r100) asString utf8Encoded asByteArray #[196 128] + (Character value:16r200) asString utf8Encoded asByteArray #[200 128] + (Character value:16r400) asString utf8Encoded asByteArray #[208 128] + (Character value:16r800) asString utf8Encoded asByteArray #[224 160 128] + (Character value:16r1000) asString utf8Encoded asByteArray #[225 128 128] + (Character value:16r2000) asString utf8Encoded asByteArray #[226 128 128] + (Character value:16r4000) asString utf8Encoded asByteArray #[228 128 128] + (Character value:16r8000) asString utf8Encoded asByteArray #[232 128 128] + (Character value:16rFFFF) asString utf8Encoded asByteArray #[239 191 191] + 'abcde1234' asUnicode32String utf8Encoded 'abcdeäöüß' asUnicode32String utf8Encoded " - - "Modified: / 11-05-2010 / 19:12:37 / cg" ! utf8EncodedOn:aStream - "write to aStream in utf8 encoding" - - |string| + "return the UTF-8 representation of a Unicode string. + The resulting string is only useful to be stored on some external file, + not for being used inside ST/X." + + |string + stringSize "{ Class: SmallInteger }" + codePoint "{Class: SmallInteger }" + v "{Class: SmallInteger }" + character b1 b2 b3 b4 b5| string := self string. - string ~~ self ifTrue:[ - ^ string utf8EncodedOn:aStream. - ]. - - self containsNon7BitAscii ifTrue:[ - aStream nextPutAllUtf8:self. - ] ifFalse:[ - "speed up common case" - aStream nextPutAll:self. - ]. - - " - String streamContents:[:w| - 'abcde1234' asUnicode32String utf8EncodedOn:w - ]. - String streamContents:[:w| - 'abcde1234' asUnicode32String utf8EncodedOn:w - ]. - String streamContents:[:w| - 'abcdeäöüß' asUnicode32String utf8EncodedOn:w - ]. + + "/ avoid creation of new strings if possible + string containsNon7BitAscii ifFalse:[ + aStream nextPutAll:string asSingleByteString. + ^ self. + ]. + + stringSize := string size. + + 1 to:stringSize do:[:idx | + character := string at:idx. + codePoint := character codePoint. + codePoint < 16r80 ifTrue:[ + aStream nextPutByte:codePoint. + ] ifFalse:[ + b1 := (codePoint bitAnd:16r3F) bitOr:2r10000000. + v := codePoint bitShift:-6. + v <= 16r1F ifTrue:[ + aStream nextPutByte:(v bitOr:2r11000000). + aStream nextPutByte:b1. + ] ifFalse:[ + b2 := (v bitAnd:16r3F) bitOr:2r10000000. + v := v bitShift:-6. + v <= 16r0F ifTrue:[ + aStream nextPutByte:(v bitOr:2r11100000). + aStream nextPutByte:b2; nextPutByte:b1. + ] ifFalse:[ + b3 := (v bitAnd:16r3F) bitOr:2r10000000. + v := v bitShift:-6. + v <= 16r07 ifTrue:[ + aStream nextPutByte:(v bitOr:2r11110000). + aStream nextPutByte:b3; nextPutByte:b2; nextPutByte:b1. + ] ifFalse:[ + b4 := (v bitAnd:16r3F) bitOr:2r10000000. + v := v bitShift:-6. + v <= 16r03 ifTrue:[ + aStream nextPutByte:(v bitOr:2r11111000). + aStream nextPutByte:b4; nextPutByte:b3; nextPutByte:b2; nextPutByte:b1. + ] ifFalse:[ + b5 := (v bitAnd:16r3F) bitOr:2r10000000. + v := v bitShift:-6. + v <= 16r01 ifTrue:[ + aStream nextPutByte:(v bitOr:2r11111100). + aStream nextPutByte:b5; nextPutByte:b4; nextPutByte:b3; nextPutByte:b2; nextPutByte:b1. + ] ifFalse:[ + "/ cannot happen - we only support up to 30 bit characters + EncodingError raiseWith:character errorString:'codePoint > 31bit in #utf8Encode'. + ] + ]. + ]. + ]. + ]. + ]. + ]. + + " + String streamContents:[:s| + 'hallo' utf8EncodedOn:s + ]. + + ByteArray streamContents:[:s| + 'hallo' utf8EncodedOn:s + ]. + + String streamContents:[:s| + 'abcdeäöüß' asUnicode32String utf8EncodedOn:s + ]. +. + ByteArray streamContents:[:s| + 'abcdeäöüß' asUnicode32String utf8EncodedOn:s + ]. + + '/tmp/bytes' asFilename writingFileDo:[:s| + 'abcdeäöüß' utf8EncodedOn:s + ]. " ! ! + + !CharacterArray methodsFor:'matching - glob expressions'! compoundMatch:aString @@ -5999,6 +6241,7 @@ "Modified: 17.4.1997 / 12:50:23 / cg" ! ! + !CharacterArray methodsFor:'special string converting'! asUnixFilenameString @@ -7028,23 +7271,6 @@ " ! -withoutSuffix:aString - "if the receiver endsWith aString, return a copy without it. - Otherwise return the receiver" - - (self endsWith:aString) ifTrue:[ - ^ self copyFrom:1 to:(self size - aString size) - ]. - ^ self - - " - 'helloworld' withoutSuffix:'world' - 'helloworld' withoutSuffix:'foo' - " - - "Created: / 30-04-2016 / 10:00:32 / cg" -! - withoutTrailingSeparators "return a copy of myself without trailing separators. Notice: this does remove tabs, newline or any other whitespace. @@ -7063,6 +7289,7 @@ " ! ! + !CharacterArray methodsFor:'substring searching'! findRangeOfString:subString @@ -7824,6 +8051,7 @@ ^ aVisitor visitString:self with:aParameter ! ! + !CharacterArray class methodsFor:'documentation'! version
--- a/CharacterEncoderImplementations__ISO10646_to_UTF8.st Sun May 15 08:38:43 2016 +0100 +++ b/CharacterEncoderImplementations__ISO10646_to_UTF8.st Tue May 17 10:05:14 2016 +0100 @@ -1,3 +1,5 @@ +"{ Encoding: utf8 }" + " COPYRIGHT (c) 2004 by eXept Software AG All Rights Reserved @@ -52,7 +54,7 @@ Decoding (utf8 to unicode): |t| - t := ISO10646_to_UTF8 encodeString:'Helloœ'. + t := ISO10646_to_UTF8 encodeString:'HelloÂœ'. ISO10646_to_UTF8 decodeString:t. " ! ! @@ -100,238 +102,9 @@ This is only useful, when reading from external sources or communicating with other systems (ST/X never uses utf8 internally, but always uses strings of fully decoded unicode characters). - This only handles up-to 30bit characters. - - If you work a lot with utf-8 encoded textFiles, - this is a first-class candidate for a primitive." - - |sz anyAbove7BitAscii nBitsRequired - ascii "{ Class: SmallInteger }" - byte "{ Class: SmallInteger }" - s newString idx next6Bits last6Bits - errorReporter| - - "/ fast track, also avoid creation of new strings if aStringOrByteCollection is already a 7-bit string - aStringOrByteCollection containsNon7BitAscii ifFalse:[ - ^ aStringOrByteCollection asSingleByteString - ]. - - errorReporter := [:msg | - DecodingError newException - defaultValue:aStringOrByteCollection; - raiseRequestWith:aStringOrByteCollection errorString:msg. - ]. - - next6Bits := [ - | byte | - - byte := s nextByte. - byte isNil ifTrue:[^ errorReporter value:'short utf8 string']. - ascii := (ascii bitShift:6) bitOr:(byte bitAnd:2r00111111). - (byte bitAnd:2r11000000) ~~ 2r10000000 ifTrue:[ - ^ errorReporter value:'illegal followbyte (next)'. - ]. - ]. - - last6Bits := [ - | a byte | - - byte := s nextByte. - byte isNil ifTrue:[^ errorReporter value:'short utf8 string']. - a := (ascii bitShift:6) bitOr:(byte bitAnd:2r00111111). - (a > 16r3FFFFFFF) ifTrue:[ - "/ ST/X can only represent 30 bit unicode characters. - errorReporter value:'unicode character out of range'. - a := 16r3FFFFFFF. - ]. - ascii := a. - (byte bitAnd:2r11000000) ~~ 2r10000000 ifTrue:[ - ^ errorReporter value:'illegal followbyte (last)'. - ]. - ]. - - nBitsRequired := 8. - anyAbove7BitAscii := false. - sz := 0. - s := aStringOrByteCollection readStream. + This only handles up-to 30bit characters." - "first determine the string size" - [s atEnd] whileFalse:[ - byte := ascii := s nextByte. - (byte bitAnd:16r80) ~~ 0 ifTrue:[ - anyAbove7BitAscii := true. - (byte bitAnd:2r11100000) == 2r11000000 ifTrue:[ - "/ 80 .. 7FF - ascii := (byte bitAnd:2r00011111). - next6Bits value. - ascii > 16rFF ifTrue:[ - nBitsRequired := nBitsRequired max:16 - ]. - "/ a strict utf8 decoder does not allow overlong sequences - ascii < 16r80 ifTrue:[ - errorReporter value:'overlong utf8 sequence' - ]. - ] ifFalse:[ - (byte bitAnd:2r11110000) == 2r11100000 ifTrue:[ - "/ 800 .. FFFF - ascii := (byte bitAnd:2r00001111). - next6Bits value. - next6Bits value. - ascii > 16rFF ifTrue:[ - nBitsRequired := nBitsRequired max:16 - ]. - ascii < 16r800 ifTrue:[ - errorReporter value:'overlong utf8 sequence' - ]. - ] ifFalse:[ - (byte bitAnd:2r11111000) == 2r11110000 ifTrue:[ - "/ 10000 .. 1FFFFF - ascii := (byte bitAnd:2r00000111). - next6Bits value. - next6Bits value. - next6Bits value. - ascii > 16rFF ifTrue:[ - ascii > 16rFFFF ifTrue:[ - nBitsRequired := nBitsRequired max:32 - ] ifFalse:[ - nBitsRequired := nBitsRequired max:16 - ] - ]. - ascii < 16r10000 ifTrue:[ - errorReporter value:'overlong utf8 sequence' - ]. - ] ifFalse:[ - (byte bitAnd:2r11111100) == 2r11111000 ifTrue:[ - "/ 200000 .. 3FFFFFF - ascii := (byte bitAnd:2r00000011). - next6Bits value. - next6Bits value. - next6Bits value. - next6Bits value. - ascii > 16rFF ifTrue:[ - ascii > 16rFFFF ifTrue:[ - nBitsRequired := nBitsRequired max:32 - ] ifFalse:[ - nBitsRequired := nBitsRequired max:16 - ] - ]. - ascii < 200000 ifTrue:[ - errorReporter value:'overlong utf8 sequence' - ]. - ] ifFalse:[ - (byte bitAnd:2r11111110) == 2r11111100 ifTrue:[ - "/ 4000000 .. 7FFFFFFF - ascii := (byte bitAnd:2r00000001). - next6Bits value. - next6Bits value. - next6Bits value. - next6Bits value. - last6Bits value. - ascii > 16rFF ifTrue:[ - ascii > 16rFFFF ifTrue:[ - nBitsRequired := nBitsRequired max:32 - ] ifFalse:[ - nBitsRequired := nBitsRequired max:16 - ] - ]. - ascii < 16r4000000 ifTrue:[ - errorReporter value:'overlong utf8 sequence' - ]. - ] ifFalse:[ - errorReporter value:'invalid utf8 encoding' - ] - ] - ] - ] - ]. - ]. - sz := sz + 1. - ]. - nBitsRequired == 8 ifTrue:[ - anyAbove7BitAscii ifFalse:[ - "/ can return the original string - aStringOrByteCollection isString ifTrue:[^ aStringOrByteCollection]. - ]. - newString := String uninitializedNew:sz - ] ifFalse:[ - nBitsRequired <= 16 ifTrue:[ - newString := Unicode16String new:sz - ] ifFalse:[ - newString := Unicode32String new:sz - ] - ]. - - next6Bits := [ - |byte| - - byte := s nextByte. - ascii := (ascii bitShift:6) bitOr:(byte bitAnd:2r00111111). - ]. - - s reset. - idx := 1. - - "now fill the string" - [s atEnd] whileFalse:[ - byte := ascii := s nextByte. - (byte bitAnd:2r10000000) ~~ 0 ifTrue:[ - (byte bitAnd:2r11100000) == 2r11000000 ifTrue:[ - ascii := (byte bitAnd:2r00011111). - next6Bits value. - ] ifFalse:[ - (byte bitAnd:2r11110000) == 2r11100000 ifTrue:[ - ascii := (byte bitAnd:2r00001111). - next6Bits value. - next6Bits value. - ] ifFalse:[ - (byte bitAnd:2r11111000) == 2r11110000 ifTrue:[ - ascii := (byte bitAnd:2r00000111). - next6Bits value. - next6Bits value. - next6Bits value. - ] ifFalse:[ - (byte bitAnd:2r11111100) == 2r11111000 ifTrue:[ - ascii := (byte bitAnd:2r00000011). - next6Bits value. - next6Bits value. - next6Bits value. - next6Bits value. - ] ifFalse:[ - (byte bitAnd:2r11111110) == 2r11111100 ifTrue:[ - ascii := (byte bitAnd:2r00000001). - next6Bits value. - next6Bits value. - next6Bits value. - next6Bits value. - last6Bits value. - ] - ] - ] - ] - ]. - ]. - newString at:idx put:(Character value:ascii). - idx := idx + 1. - ]. - ^ newString - - " - CharacterArray fromUTF8Bytes:#[ 16r41 16r42 ] - CharacterArray fromUTF8Bytes:#[ 16rC1 16r02 ] - CharacterArray fromUTF8Bytes:#[ 16rE0 16r81 16r02 ] - CharacterArray fromUTF8Bytes:#[ 16rEF 16rBF 16rBF ] - - rfc2279 examples: - CharacterArray fromUTF8Bytes:#[ 16r41 16rE2 16r89 16rA2 16rCE 16r91 16r2E ] - CharacterArray fromUTF8Bytes:#[ 16rED 16r95 16r9C 16rEA 16rB5 16rAD 16rEC 16r96 16rB4 ] - CharacterArray fromUTF8Bytes:#[ 16rE6 16r97 16rA5 16rE6 16r9C 16rAC 16rE8 16rAA 16r9E ] - - invalid: - CharacterArray fromUTF8Bytes:#[ 16rC0 16r80 ] - CharacterArray fromUTF8Bytes:#[ 16rE0 16r80 16r80 ] - " - - "Modified: / 18-09-2006 / 19:55:52 / cg" + ^ CharacterArray decodeFromUTF8:aStringOrByteCollection. ! encode:aCode @@ -341,87 +114,9 @@ encodeString:aUnicodeString "return the UTF-8 representation of a Unicode string. The resulting string is only useful to be stored on some external file, - not for being used inside ST/X. - - If you work a lot with utf8 encoded textFiles, - this is a first-class candidate for a primitive." - - |s - stringSize "{ Class: SmallInteger }"| - - "/ avoid creation of new strings if possible - aUnicodeString containsNon7BitAscii ifFalse:[ - ^ aUnicodeString asSingleByteString - ]. - - stringSize := aUnicodeString size. - s := WriteStream on:(String uninitializedNew:(stringSize * 3 // 2)). - 1 to:stringSize do:[:idx | - |character codePoint "{Class: SmallInteger }" b1 b2 b3 b4 b5 v "{Class: SmallInteger }"| + not for being used inside ST/X." - character := aUnicodeString at:idx. - codePoint := character codePoint. - codePoint <= 16r7F ifTrue:[ - s nextPut:character. - ] 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 - EncodingError raiseWith:character errorString:'codePoint > 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] - " + ^ aUnicodeString utf8Encoded. ! ! !ISO10646_to_UTF8 methodsFor:'queries'!
--- a/Dictionary.st Sun May 15 08:38:43 2016 +0100 +++ b/Dictionary.st Tue May 17 10:05:14 2016 +0100 @@ -292,8 +292,6 @@ ^ true ! ! - - !Dictionary methodsFor:'accessing'! associationAt:aKey @@ -977,7 +975,7 @@ removeKey:aKey ifAbsent:aBlock "remove the association under aKey from the collection, - return the value previously stored there.. + return the value previously stored there. If it was not in the collection return the result from evaluating aBlock. @@ -2338,7 +2336,6 @@ ^ aVisitor visitDictionary:self with:aParameter ! ! - !Dictionary class methodsFor:'documentation'! version
--- a/DirectoryStream.st Sun May 15 08:38:43 2016 +0100 +++ b/DirectoryStream.st Tue May 17 10:05:14 2016 +0100 @@ -24,10 +24,10 @@ %{ #include "stxOSDefs.h" -#if defined(WIN32) +#if defined(__win32__) # undef UNIX_LIKE #else -# if defined(transputer) +# if defined(__transputer__) # undef UNIX_LIKE # else # define UNIX_LIKE @@ -72,7 +72,7 @@ #endif /* UNIX_LIKE */ -#ifdef WIN32 +#ifdef __win32__ # ifdef __i386__ # define _X86_ @@ -560,7 +560,7 @@ #ifdef HAS_OPENDIR closedir( (DIR *)(__FILEVal(dp)) ); #else -# ifdef WIN32 +# ifdef __win32__ FindClose( __HANDLEVal(dp) ); # endif #endif @@ -602,7 +602,7 @@ } } #else -#ifdef WIN32 +#ifdef __win32__ HANDLE d; OBJ path, dp; union {
--- a/ExternalBytes.st Sun May 15 08:38:43 2016 +0100 +++ b/ExternalBytes.st Tue May 17 10:05:14 2016 +0100 @@ -36,7 +36,7 @@ #endif extern char *__stx_malloc(size_t); - extern char *__stx_calloc(size_t, size_t); + extern char *__stx_calloc(size_t, size_t); extern char *__stx_realloc(char *, size_t); extern void __stx_free(char *); extern void __stx_mallocStatistics(void); @@ -47,9 +47,9 @@ %{ struct mallocList { - char *chunk; - size_t size; - struct mallocList *next; + char *chunk; + size_t size; + struct mallocList *next; }; static struct mallocList *mallocList = (struct mallocList *)0; static INT mallocCount = 0; @@ -63,25 +63,25 @@ if (@global(DebugMalloc) != true) return; if (ptr) { - found = 0; - for (this=mallocList, prev=0; this; this=next) { - next = this->next; - if (this->chunk == ptr) { - if (prev) { - prev->next = next; - } else { - mallocList = next; - } - free(this); - found++; - mallocCount--; - } else { - prev = this; - } - } - if (! found) { - console_printf("ExternalBytes [warning]: **** free: alien %"_lx_" (allocated somewhere else ?))\n", (INT)ptr); - } + found = 0; + for (this=mallocList, prev=0; this; this=next) { + next = this->next; + if (this->chunk == ptr) { + if (prev) { + prev->next = next; + } else { + mallocList = next; + } + free(this); + found++; + mallocCount--; + } else { + prev = this; + } + } + if (! found) { + console_printf("ExternalBytes [warning]: **** free: alien %"_lx_" (allocated somewhere else ?))\n", (INT)ptr); + } } } @@ -95,82 +95,82 @@ if (@global(DebugMalloc) != true) return; if (ptr) { - found = 0; - for (this=mallocList; this; this=this->next) { - if (this->chunk == ptr) { - console_printf("ExternalBytes [warning]: **** %016"_lx_" already allocated (freed somewhere else ?)\n", (INT)ptr); - found++; - } - } - if (! found) { - e = (struct mallocList *) malloc(sizeof(struct mallocList)); - e->next = mallocList; - e->chunk = ptr; - e->size = nBytes; - mallocList = e; - mallocCount++; - } + found = 0; + for (this=mallocList; this; this=this->next) { + if (this->chunk == ptr) { + console_printf("ExternalBytes [warning]: **** %016"_lx_" already allocated (freed somewhere else ?)\n", (INT)ptr); + found++; + } + } + if (! found) { + e = (struct mallocList *) malloc(sizeof(struct mallocList)); + e->next = mallocList; + e->chunk = ptr; + e->size = nBytes; + mallocList = e; + mallocCount++; + } } } char * __stx_malloc(size_t nBytes) { - char *ptr = malloc(nBytes); + char *ptr = malloc(nBytes); - if (@global(TraceMalloc) == true) { - console_printf("ExternalBytes [info]: allocated %d bytes at: %016"_lx_"\n", nBytes, (INT)ptr); - } - addToMallocList(ptr, nBytes); + if (@global(TraceMalloc) == true) { + console_printf("ExternalBytes [info]: allocated %d bytes at: %016"_lx_"\n", nBytes, (INT)ptr); + } + addToMallocList(ptr, nBytes); - return ptr; + return ptr; } char * __stx_calloc(size_t n, size_t size) { - char *ptr = __stx_malloc(n * size); - if (ptr != 0) { - bzero(ptr, (n * size)); - } - return ptr; + char *ptr = __stx_malloc(n * size); + if (ptr != 0) { + bzero(ptr, (n * size)); + } + return ptr; } char * __stx_realloc(char *ptr, size_t nBytes) { - char *newPtr; + char *newPtr; - removeFromMallocList(ptr); - newPtr = realloc(ptr, nBytes); - addToMallocList(newPtr, nBytes); + removeFromMallocList(ptr); + newPtr = realloc(ptr, nBytes); + addToMallocList(newPtr, nBytes); - if (@global(TraceMalloc) == true) { - console_printf("ExternalBytes [info]: realloc %d bytes for %"_lx_" at: %"_lx_"\n", nBytes, (INT)ptr, (INT)newPtr); - } - return newPtr; + if (@global(TraceMalloc) == true) { + console_printf("ExternalBytes [info]: realloc %d bytes for %"_lx_" at: %"_lx_"\n", nBytes, (INT)ptr, (INT)newPtr); + } + return newPtr; } void __stx_free(char *ptr) { - if (@global(TraceMalloc) == true) { - console_printf("ExternalBytes: free bytes at: %"_lx_"\n", (INT)ptr); - } - removeFromMallocList(ptr); + if (@global(TraceMalloc) == true) { + console_printf("ExternalBytes: free bytes at: %"_lx_"\n", (INT)ptr); + } + removeFromMallocList(ptr); - free(ptr); + free(ptr); } void __stx_mallocStatistics() { - struct mallocList *this; - int amount = 0; - int n = 0; + struct mallocList *this; + int amount = 0; + int n = 0; - for (this=mallocList; this; this=this->next) { - n++; - amount += this->size; - } - console_printf("ExternalBytes [info]: allocated %d blocks with %d bytes overall\n", n, amount); + for (this=mallocList; this; this=this->next) { + n++; + amount += this->size; + } + console_printf("ExternalBytes [info]: allocated %d blocks with %d bytes overall\n", n, amount); } %} @@ -393,13 +393,13 @@ address:anAddressInteger "return a new ExternalBytes object to access bytes starting at anAddressInteger. - The memory at anAddressInteger has been allocated elsewhere. + The memory at anAddressInteger has been allocated elsewhere. The size is not known, therefore byte accesses will NOT be checked for valid index. Use this, if you get a pointer from some external source (such as a C-callBack function) and you have to extract bytes from that. DANGER ALERT: this method allows very bad things to be done to the - system - use with GREAT care (better: do not use it)" + system - use with GREAT care (better: do not use it)" ^ self basicNew setAddress:anAddressInteger size:nil @@ -408,13 +408,13 @@ address:anAddressInteger size:size "return a new ExternalBytes object to access bytes starting at anAddressInteger. - The memory at anAddressInteger has been allocated elsewhere. + The memory at anAddressInteger has been allocated elsewhere. The size is known, which allows byte accesses to be checked for valid index. Use this, if you get a pointer to a structure from some external source (such as a C-callBack function) and you have to extract things from that. DANGER ALERT: this method allows very bad things to be done to the - system - use with GREAT care (better: do not use it)" + system - use with GREAT care (better: do not use it)" ^ self basicNew setAddress:anAddressInteger size:size @@ -477,7 +477,7 @@ extBytes := self new:((nChars+1)*2). 1 to:nChars do:[:i | - extBytes unsignedInt16At:(i*2) put:(aString at:i) codePoint. + extBytes unsignedInt16At:(i*2) put:(aString at:i) codePoint. ]. extBytes unsignedInt16At:((nChars+1)*2) put:0. ^ extBytes @@ -688,7 +688,7 @@ If the machine does not support them, return nil." %{ /* NOCONTEXT */ -#if defined(__GNUC__) || defined(WIN32) +#if defined(__GNUC__) || defined(__CLANG__) || defined(__win32__) RETURN (__mkSmallInteger( sizeof(long double))); #endif %}. @@ -885,8 +885,8 @@ idx := 1. s := WriteStream on:Unicode16String new. [(word := self unsignedInt16At:idx) ~~ 0] whileTrue:[ - s nextPut:(Character value:word). - idx := idx + 2. + s nextPut:(Character value:word). + idx := idx + 2. ]. ^ s contents ! @@ -1102,7 +1102,7 @@ "replace elements from aString, and add a 0-byte at the end" |nChars| - + nChars := aString size. self replaceBytesFrom:1 to:nChars with:aString startingAt:1. self at:nChars+1 put:0. @@ -1145,7 +1145,7 @@ %{ /* NOCONTEXT */ char *mem = (char *)__INST(address_); if (mem && (OBJ)mem != nil) { - __stx_free(mem); + __stx_free(mem); } __INST(address_) = __INST(size) = nil; %} @@ -1210,29 +1210,29 @@ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream; "/ ST/X (and some old ST80's) mean: draw-yourself on a GC. (aGCOrStream isStream) ifFalse:[ - ^ super displayOn:aGCOrStream + ^ super displayOn:aGCOrStream ]. aGCOrStream nextPutAll:self className. addr := self address. addr isNil ifTrue:[ - aGCOrStream nextPutAll:'[free]'. + aGCOrStream nextPutAll:'[free]'. ] ifFalse:[ - size notNil ifTrue:[ - aGCOrStream nextPutAll:'[sz:'. - size printOn:aGCOrStream. - aGCOrStream space. - ] ifFalse:[ - aGCOrStream nextPut:$[. - ]. - aGCOrStream nextPutAll:'@'. - addr printOn:aGCOrStream base:16. - aGCOrStream nextPut:$]. + size notNil ifTrue:[ + aGCOrStream nextPutAll:'[sz:'. + size printOn:aGCOrStream. + aGCOrStream space. + ] ifFalse:[ + aGCOrStream nextPut:$[. + ]. + aGCOrStream nextPutAll:'@'. + addr printOn:aGCOrStream base:16. + aGCOrStream nextPut:$]. ]. " - self new printString - (self new:5) displayString + self new printString + (self new:5) displayString " @@ -1301,26 +1301,26 @@ * Fail if already allocated */ if (__INST(address_) == nil && __isSmallInteger(numberOfBytes)) { - INT nBytes = __smallIntegerVal(numberOfBytes); - if (nBytes > 0) { - char *space = __stx_malloc(nBytes); - if (space) { - if (doClear == true) { - bzero(space, nBytes); - } - __INST(address_) = (OBJ)space; - __INST(size) = numberOfBytes; - RETURN(self); - } else { - mallocFailure = true; - } - } + INT nBytes = __smallIntegerVal(numberOfBytes); + if (nBytes > 0) { + char *space = __stx_malloc(nBytes); + if (space) { + if (doClear == true) { + bzero(space, nBytes); + } + __INST(address_) = (OBJ)space; + __INST(size) = numberOfBytes; + RETURN(self); + } else { + mallocFailure = true; + } + } } %}. mallocFailure == true ifTrue:[ - ^ MallocFailure raiseRequestWith:numberOfBytes. + ^ MallocFailure raiseRequestWith:numberOfBytes. ] ifFalse:[ - self primitiveFailed. + self primitiveFailed. ]. ! ! @@ -1445,34 +1445,34 @@ %{ if (__isSmallInteger(numberOfBytes)) { - INT nBytes = __smallIntegerVal(numberOfBytes); - if (nBytes > 0) { - char *space; - char *prevSpace = (char *)__INST(address_); + INT nBytes = __smallIntegerVal(numberOfBytes); + if (nBytes > 0) { + char *space; + char *prevSpace = (char *)__INST(address_); - if (prevSpace == (char *)nil) - prevSpace = 0; /* allocate from scratch */ - space = __stx_realloc(prevSpace, nBytes); - if (space) { - __INST(address_) = (OBJ)space; - __INST(size) = numberOfBytes; - if (space == prevSpace) { - /* same address, no re-registration */ - RETURN(self); - } - mallocStatus = true; - } else { - mallocStatus = false; - } - } + if (prevSpace == (char *)nil) + prevSpace = 0; /* allocate from scratch */ + space = __stx_realloc(prevSpace, nBytes); + if (space) { + __INST(address_) = (OBJ)space; + __INST(size) = numberOfBytes; + if (space == prevSpace) { + /* same address, no re-registration */ + RETURN(self); + } + mallocStatus = true; + } else { + mallocStatus = false; + } + } } %}. mallocStatus == true ifTrue:[ - Lobby registerChange:self. + Lobby registerChange:self. ] ifFalse:[mallocStatus == false ifTrue:[ - ^ MallocFailure raiseRequestWith:numberOfBytes. + ^ MallocFailure raiseRequestWith:numberOfBytes. ] ifFalse:[ - self primitiveFailed. + self primitiveFailed. ]]. ! !
--- a/ExternalLibraryFunction.st Sun May 15 08:38:43 2016 +0100 +++ b/ExternalLibraryFunction.st Tue May 17 10:05:14 2016 +0100 @@ -100,10 +100,10 @@ instances of me are used to interface to external library functions (as found in a dll/shared object). Inside a method, when a special external-call pragma such as: - <api: bool MessageBeep(uint)> + <api: bool MessageBeep(uint)> is encountered by the parser, the compiler generates a call via - <correspondingExternalLibraryFunctionObject> invokeWithArguments: argumentArray. + <correspondingExternalLibraryFunctionObject> invokeWithArguments: argumentArray. and the correspondingExternalLibraryFunctionObject is kept in the literal array. In the invoke method, the library is checked to be loaded (and loaded if not already), @@ -111,22 +111,22 @@ and finally, the return value is converted back from C to a smalltalk object. The parser supports the call-syntax of various other smalltalk dialects: - Squeak / ST-X: - <cdecl: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName > - <apicall: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName > + Squeak / ST-X: + <cdecl: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName > + <apicall: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName > - Dolphin: - <stdcall: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN> - <cdecl: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN> + Dolphin: + <stdcall: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN> + <cdecl: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN> - ST/V: - <api: functionName argType1 .. argTypeN returnType> - <ccall: functionName argType1 .. argTypeN returnType> - <ole: vFunctionIndex argType1 .. argTypeN returnType> + ST/V: + <api: functionName argType1 .. argTypeN returnType> + <ccall: functionName argType1 .. argTypeN returnType> + <ole: vFunctionIndex argType1 .. argTypeN returnType> - VisualWorks: - <c: ...> - <c: #define NAME value> + VisualWorks: + <c: ...> + <c: #define NAME value> " ! @@ -219,19 +219,19 @@ dllMapping "allows for dll's to be replaced, for example, if you want to use the mozilla sqlite dll - C:\Program Files\Mozilla Firefox\mozsqlite3.dll + C:\Program Files\Mozilla Firefox\mozsqlite3.dll for the sqlite3, execute: - ExternalLibraryFunction - dllMapping at:'sqlite3' - put: 'C:\Program Files\Mozilla Firefox\mozsqlite3.dll' + ExternalLibraryFunction + dllMapping at:'sqlite3' + put: 'C:\Program Files\Mozilla Firefox\mozsqlite3.dll' for mingw: - ExternalLibraryFunction - dllMapping at:'sqlite3' - put:'C:\mingw64\opt\bin\libsqlite3-0.dll' + ExternalLibraryFunction + dllMapping at:'sqlite3' + put:'C:\mingw64\opt\bin\libsqlite3-0.dll' " DllMapping isNil ifTrue:[ - DllMapping := Dictionary new. + DllMapping := Dictionary new. ]. ^ DllMapping @@ -1770,7 +1770,7 @@ printf("async call 0x%"_lx_"\n", (INT)codeAddress); } # endif -# ifdef WIN32 +# ifdef __win32__ __STX_C_CALL4( "ffi_call", ffi_call, &__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis); # else __BEGIN_INTERRUPTABLE__
--- a/ExternalStream.st Sun May 15 08:38:43 2016 +0100 +++ b/ExternalStream.st Tue May 17 10:05:14 2016 +0100 @@ -66,7 +66,7 @@ # define SEEK_END 2 #endif -#if defined(__VMS__) || defined(__sparc__) || defined(WIN32) +#if defined(__VMS__) || defined(__sparc__) || defined(__win32__) # define CLEAR_ERRNO __threadErrno = 0; #else # define CLEAR_ERRNO /* nothing */ @@ -80,7 +80,7 @@ # define __MKFILEPOINTER(f) __MKEXTERNALADDRESS(f) #endif -#ifdef WIN32 +#ifdef __win32__ # define NO_STDIO # undef __HANDLE_INTERRUPTS__ @@ -97,7 +97,7 @@ # define _X86_ # endif -#ifdef WIN32 +#ifdef __win32__ # undef INT # undef UINT # undef Array @@ -188,7 +188,7 @@ # ifndef off_t # define off_t long # endif -#endif /* WIN32 */ +#endif /* __win32__ */ #ifndef NO_STDIO /* use STDIO */ # define STDIO_NEEDS_FSEEK @@ -223,7 +223,7 @@ # define OPT_FSEEK(f, pos, whence) /* nothing */ #endif -#ifdef WIN32 +#ifdef __win32__ // Win returns from ReadFile() with false and _threadErrno == 0 on end of pipe. // We don't know why # define READ(ret, f, cp, n, handleType) { \ @@ -692,7 +692,7 @@ } \ } -#else /* ! WIN32 */ +#else /* ! __win32__ */ /* ======================== UNIX / LINUX ====================================================== */ typedef int SOCKET; @@ -1504,24 +1504,24 @@ initDefaultEOLMode OperatingSystem isUNIXlike ifTrue:[ - "/ unix EOL conventions - DefaultEOLMode := #nl + "/ unix EOL conventions + DefaultEOLMode := #nl ] ifFalse:[ - OperatingSystem isVMSlike ifTrue:[ - "/ vms EOL conventions - DefaultEOLMode := #cr - ] ifFalse:[ - "/ msdos EOL conventions - "/ msdos uses #crlf. - "/ the following breaks all programs, which do not explicitly - "/ change th eolMode when writing/reading binary files (zip reader) - "/ MUST change all classes before doing the following. - "/ Anyway: for backward compatibility (swisscom), it is left in this - "/ mode (for a while, I hope). - DefaultEOLMode := #crlf. - - "/ DefaultEOLMode := #nl - ] + OperatingSystem isVMSlike ifTrue:[ + "/ vms EOL conventions + DefaultEOLMode := #cr + ] ifFalse:[ + "/ msdos EOL conventions + "/ msdos uses #crlf. + "/ the following breaks all programs, which do not explicitly + "/ change th eolMode when writing/reading binary files (zip reader) + "/ MUST change all classes before doing the following. + "/ Anyway: for backward compatibility (swisscom), it is left in this + "/ mode (for a while, I hope). + DefaultEOLMode := #crlf. + + "/ DefaultEOLMode := #nl + ] ] ! @@ -1546,41 +1546,41 @@ initialize OpenErrorSignal isNil ifTrue:[ - OpenErrorSignal := OpenError. - OpenErrorSignal notifierString:'open error'. - - InvalidReadSignal := InvalidReadError. - InvalidReadSignal notifierString:'stream does not support reading'. - - InvalidWriteSignal := InvalidWriteError. - InvalidWriteSignal notifierString:'stream does not support writing'. - - InvalidModeSignal := InvalidModeError. - InvalidModeSignal notifierString:'binary/text mode mismatch'. - - InvalidOperationSignal := InvalidOperationError. - InvalidOperationSignal notifierString:'unsupported file operation'. - - StreamNotOpenSignal := StreamNotOpenError. - StreamNotOpenSignal notifierString:'stream is not open'. - - StreamIOErrorSignal := StreamIOError. - StreamIOErrorSignal notifierString:'I/O error'. - - "/ self patchByteOrderOptimizedMethods + OpenErrorSignal := OpenError. + OpenErrorSignal notifierString:'open error'. + + InvalidReadSignal := InvalidReadError. + InvalidReadSignal notifierString:'stream does not support reading'. + + InvalidWriteSignal := InvalidWriteError. + InvalidWriteSignal notifierString:'stream does not support writing'. + + InvalidModeSignal := InvalidModeError. + InvalidModeSignal notifierString:'binary/text mode mismatch'. + + InvalidOperationSignal := InvalidOperationError. + InvalidOperationSignal notifierString:'unsupported file operation'. + + StreamNotOpenSignal := StreamNotOpenError. + StreamNotOpenSignal notifierString:'stream is not open'. + + StreamIOErrorSignal := StreamIOError. + StreamIOErrorSignal notifierString:'I/O error'. + + "/ self patchByteOrderOptimizedMethods ]. Lobby isNil ifTrue:[ - Lobby := Registry new. - - "want to get informed when returning from snapshot" - ObjectMemory addDependent:self + Lobby := Registry new. + + "want to get informed when returning from snapshot" + ObjectMemory addDependent:self ]. DefaultEOLMode isNil ifTrue:[ - self initDefaultEOLMode. + self initDefaultEOLMode. ]. ReadMode isNil ifTrue:[ - self initModeStrings. + self initModeStrings. ]. "limit the amount of newspace to be used for non-tenurable executors to 5%" @@ -1595,21 +1595,21 @@ patchByteOrderOptimizedMethods "EXPERIMENTAL (not yet done by default): change the underlying implementation of - nextPutInt16MSB / nextPutInt16LSB - nextPutInt32MSB / nextPutInt32LSB + nextPutInt16MSB / nextPutInt16LSB + nextPutInt32MSB / nextPutInt32LSB to the corresponding NATIVE methods." |native16 native32| - + native16 := self compiledMethodAt:#nextPutInt16NATIVE:. native32 := self compiledMethodAt:#nextPutInt32NATIVE:. - + UninterpretedBytes isBigEndian ifTrue:[ - (self compiledMethodAt:#nextPutInt16MSB:) code:(native16 code). - (self compiledMethodAt:#nextPutInt32MSB:) code:(native32 code). + (self compiledMethodAt:#nextPutInt16MSB:) code:(native16 code). + (self compiledMethodAt:#nextPutInt32MSB:) code:(native32 code). ] ifFalse:[ - (self compiledMethodAt:#nextPutInt16LSB:) code:(native16 code). - (self compiledMethodAt:#nextPutInt32LSB:) code:(native32 code). + (self compiledMethodAt:#nextPutInt16LSB:) code:(native16 code). + (self compiledMethodAt:#nextPutInt32LSB:) code:(native32 code). ]. ! @@ -2148,7 +2148,7 @@ || (__INST(handleType) == @symbol(filePointer)) || (__INST(handleType) == @symbol(socketFilePointer)) || (__INST(handleType) == @symbol(pipeFilePointer))) { -#ifdef WIN32 +#ifdef __win32__ RETURN(__MKEXTERNALADDRESS(_get_osfhandle(fileno(__FILEVal(_handle))))); #else RETURN (__MKINT(fileno(__FILEVal(_handle)))); @@ -2991,14 +2991,14 @@ |bufferSize| (self isFileStream and:[outStream isFileStream]) ifTrue:[ - bufferSize := 8192 * 8. "/ 64k buffer size - ] ifFalse:[ - OperatingSystem isMSDOSlike ifTrue:[ - "/ mhmh - NT hangs, when copying bigger blocks to a network drive - why ? - bufferSize := 1 * 1024. - ] ifFalse:[ - bufferSize := 8 * 1024. - ]. + bufferSize := 8192 * 8. "/ 64k buffer size + ] ifFalse:[ + OperatingSystem isMSDOSlike ifTrue:[ + "/ mhmh - NT hangs, when copying bigger blocks to a network drive - why ? + bufferSize := 1 * 1024. + ] ifFalse:[ + bufferSize := 8 * 1024. + ]. ]. ^ self copyToEndInto:outStream bufferSize:bufferSize @@ -3163,7 +3163,7 @@ goto out; } -#ifdef WIN32 +#ifdef __win32__ __threadErrno = 0; ret = __STX_API_NOINT_CALL1( "FlushFileBuffers", FlushFileBuffers, _get_osfhandle(fd)); if (ret) { @@ -3179,7 +3179,7 @@ if (ret >= 0) { RETURN (self); } -#endif /* ! WIN32 */ +#endif /* ! __win32__ */ error = __mkSmallInteger(__threadErrno); #endif /* ! __openVMS__ */ out:; @@ -3232,7 +3232,7 @@ goto out; } -#ifdef WIN32 +#ifdef __win32__ __threadErrno = 0; ret = __STX_API_NOINT_CALL1( "FlushFileBuffers", FlushFileBuffers, _get_osfhandle(fd)); if (ret) { @@ -3248,7 +3248,7 @@ if (ret >= 0) { RETURN (self); } -#endif /* ! WIN32 */ +#endif /* ! __win32__ */ error = __mkSmallInteger(__threadErrno); #endif /* ! __openVMS__ */ out:; @@ -3969,66 +3969,66 @@ || (__INST(handleType) == @symbol(socketFilePointer)) || (__INST(handleType) == @symbol(socketHandle)) || (__INST(handleType) == @symbol(pipeFilePointer))) { - if (((fp = __INST(handle)) != nil) - && (__INST(mode) != @symbol(writeonly)) - ) { - FILEPOINTER f; - int ret, _buffered; - int value; - union { - unsigned char buffer[4]; - int intVal; - } u; - - f = __FILEVal(fp); - _buffered = (__INST(buffered) == true); - if (_buffered) { - __READING__(f) - } - __READBYTES__(ret, f, u.buffer, 4, _buffered, __INST(handleType)); - - if (ret == 4) { - if (__isSmallInteger(__INST(position))) { - INT np = __intVal(__INST(position)) + 4; - OBJ t; - - t = __MKINT(np); __INST(position) = t; __STORE(self, t); - } else { - __INST(position) = nil; /* i.e. do not know */ - } - if (msbFlag == true) { + if (((fp = __INST(handle)) != nil) + && (__INST(mode) != @symbol(writeonly)) + ) { + FILEPOINTER f; + int ret, _buffered; + int value; + union { + unsigned char buffer[4]; + int intVal; + } u; + + f = __FILEVal(fp); + _buffered = (__INST(buffered) == true); + if (_buffered) { + __READING__(f) + } + __READBYTES__(ret, f, u.buffer, 4, _buffered, __INST(handleType)); + + if (ret == 4) { + if (__isSmallInteger(__INST(position))) { + INT np = __intVal(__INST(position)) + 4; + OBJ t; + + t = __MKINT(np); __INST(position) = t; __STORE(self, t); + } else { + __INST(position) = nil; /* i.e. do not know */ + } + if (msbFlag == true) { #if defined(__MSBFIRST__) - value = u.intVal; + value = u.intVal; #else - value = (u.buffer[0] & 0xFF); - value = (value << 8) | (u.buffer[1] & 0xFF); - value = (value << 8) | (u.buffer[2] & 0xFF); - value = (value << 8) | (u.buffer[3] & 0xFF); + value = (u.buffer[0] & 0xFF); + value = (value << 8) | (u.buffer[1] & 0xFF); + value = (value << 8) | (u.buffer[2] & 0xFF); + value = (value << 8) | (u.buffer[3] & 0xFF); #endif - } else { + } else { #if defined(__LSBFIRST__) - value = u.intVal; + value = u.intVal; #else - value = (u.buffer[3] & 0xFF); - value = (value << 8) | (u.buffer[2] & 0xFF); - value = (value << 8) | (u.buffer[1] & 0xFF); - value = (value << 8) | (u.buffer[0] & 0xFF); + value = (u.buffer[3] & 0xFF); + value = (value << 8) | (u.buffer[2] & 0xFF); + value = (value << 8) | (u.buffer[1] & 0xFF); + value = (value << 8) | (u.buffer[0] & 0xFF); #endif - } + } #if __POINTER_SIZE__ == 8 - RETURN ( __mkSmallInteger(value)); + RETURN ( __mkSmallInteger(value)); #else - RETURN ( __MKINT(value) ); + RETURN ( __MKINT(value) ); #endif - } - - if (ret < 0) { - __INST(position) = nil; - error = __mkSmallInteger(__threadErrno); - } else /* ret == 0 */ { - __INST(hitEOF) = true; - } - } + } + + if (ret < 0) { + __INST(position) = nil; + error = __mkSmallInteger(__threadErrno); + } else /* ret == 0 */ { + __INST(hitEOF) = true; + } + } } %}. hitEOF ifTrue:[^ self pastEndRead]. @@ -4208,15 +4208,15 @@ nextWord <resource: #obsolete> "in text-mode: - read the alphaNumeric next word (i.e. up to non letter-or-digit). - return a string containing those characters. + read the alphaNumeric next word (i.e. up to non letter-or-digit). + return a string containing those characters. in binary-mode: - read two bytes (msb-first) and return the value as a 16-bit - unsigned Integer (for compatibility with other smalltalks)" + read two bytes (msb-first) and return the value as a 16-bit + unsigned Integer (for compatibility with other smalltalks)" binary ifTrue:[ - self obsoleteMethodWarning:'use #nextUnsignedShortMSB:true'. - ^ self nextUnsignedInt16MSB:true + self obsoleteMethodWarning:'use #nextUnsignedShortMSB:true'. + ^ self nextUnsignedInt16MSB:true ]. self obsoleteMethodWarning:'use #nextAlphaNumericWord'. ^ self nextAlphaNumericWord @@ -4285,8 +4285,8 @@ ! nextPutInt16:anIntegerOrCharacter MSB:msbFlag - "Write the argument, anIntegerOrCharacter as a short (two bytes). - If msbFlag is true, data is written most-significant byte first; + "Write the argument, anIntegerOrCharacter as a short (two bytes). + If msbFlag is true, data is written most-significant byte first; otherwise least first. Notice that integers in the range -16r8000 to +16rFFFF can be written (i.e. both signed and unsigned int32 values can be written. @@ -4296,8 +4296,8 @@ %{ int num; union { - char bytes[2]; - short shortVal; + char bytes[2]; + short shortVal; } u; OBJ fp; @@ -4307,62 +4307,62 @@ || (__INST(handleType) == @symbol(socketFilePointer)) || (__INST(handleType) == @symbol(socketHandle)) || (__INST(handleType) == @symbol(pipeFilePointer))) { - if (((fp = __INST(handle)) != nil) - && (__INST(mode) != @symbol(readonly)) - ) { - FILEPOINTER f = __FILEVal(fp); - int _buffered = (__INST(buffered) == true); - int cnt; - - if (__isSmallInteger(anIntegerOrCharacter)) { - num = __intVal(anIntegerOrCharacter); - } else if (__isCharacter(anIntegerOrCharacter)) { - num = __smallIntegerVal(__characterVal(anIntegerOrCharacter)); - } else - goto out; - - if (msbFlag == true) { + if (((fp = __INST(handle)) != nil) + && (__INST(mode) != @symbol(readonly)) + ) { + FILEPOINTER f = __FILEVal(fp); + int _buffered = (__INST(buffered) == true); + int cnt; + + if (__isSmallInteger(anIntegerOrCharacter)) { + num = __intVal(anIntegerOrCharacter); + } else if (__isCharacter(anIntegerOrCharacter)) { + num = __smallIntegerVal(__characterVal(anIntegerOrCharacter)); + } else + goto out; + + if (msbFlag == true) { #if defined(__MSBFIRST__) - u.shortVal = num; + u.shortVal = num; #else - u.bytes[0] = (num >> 8) & 0xFF; - u.bytes[1] = num & 0xFF; + u.bytes[0] = (num >> 8) & 0xFF; + u.bytes[1] = num & 0xFF; #endif - } else { + } else { #if defined(__LSBFIRST__) - u.shortVal = num; + u.shortVal = num; #else - u.bytes[1] = (num >> 8) & 0xFF; - u.bytes[0] = num & 0xFF; + u.bytes[1] = (num >> 8) & 0xFF; + u.bytes[0] = num & 0xFF; #endif - } - - if (_buffered) { - __WRITING__(f) - } - __WRITEBYTES__(cnt, f, u.bytes, 2, _buffered, __INST(handleType)); - - if (cnt == 2) { - if (__isSmallInteger(__INST(position))) { - INT np = __intVal(__INST(position)) + 2; - OBJ t; - - t = __MKINT(np); __INST(position) = t; __STORE(self, t); - } else { - __INST(position) = nil; /* i.e. do not know */ - } - RETURN ( self ); - } - __INST(position) = nil; /* i.e. do not know */ - error = __mkSmallInteger(__threadErrno); - } + } + + if (_buffered) { + __WRITING__(f) + } + __WRITEBYTES__(cnt, f, u.bytes, 2, _buffered, __INST(handleType)); + + if (cnt == 2) { + if (__isSmallInteger(__INST(position))) { + INT np = __intVal(__INST(position)) + 2; + OBJ t; + + t = __MKINT(np); __INST(position) = t; __STORE(self, t); + } else { + __INST(position) = nil; /* i.e. do not know */ + } + RETURN ( self ); + } + __INST(position) = nil; /* i.e. do not know */ + error = __mkSmallInteger(__threadErrno); + } } out:; %}. error notNil ifTrue:[ - lastErrorNumber := error. - self writeError:error. - ^ self + lastErrorNumber := error. + self writeError:error. + ^ self ]. handle isNil ifTrue:[self errorNotOpen. ^ self]. (mode == #readonly) ifTrue:[self errorReadOnly. ^ self]. @@ -4372,19 +4372,19 @@ nextPutInt16LSB:anIntegerOrCharacter "do not remove. See #patchByteOrderOptimizedMethods" - + self nextPutInt16:anIntegerOrCharacter MSB:false ! nextPutInt16MSB:anIntegerOrCharacter "do not remove. See #patchByteOrderOptimizedMethods" - + self nextPutInt16:anIntegerOrCharacter MSB:true ! -nextPutInt16NATIVE:anIntegerOrCharacter - "Write the argument, anIntegerOrCharacter as a short (two bytes) in native byte order. +nextPutInt16NATIVE:anIntegerOrCharacter + "Write the argument, anIntegerOrCharacter as a short (two bytes) in native byte order. This is the CPU-specific byte order (LSB on x86, MSB on sparc, VAX and possibly on ARM). Notice that integers in the range -16r8000 to +16rFFFF can be written (i.e. both signed and unsigned int32 values can be written. @@ -4394,8 +4394,8 @@ %{ int num; union { - char bytes[2]; - short shortVal; + char bytes[2]; + short shortVal; } u; OBJ fp; @@ -4405,41 +4405,41 @@ || (__INST(handleType) == @symbol(socketFilePointer)) || (__INST(handleType) == @symbol(socketHandle)) || (__INST(handleType) == @symbol(pipeFilePointer))) { - if (((fp = __INST(handle)) != nil) - && (__INST(mode) != @symbol(readonly)) - ) { - FILEPOINTER f = __FILEVal(fp); - int _buffered = (__INST(buffered) == true); - int cnt; - - if (__isSmallInteger(anIntegerOrCharacter)) { - num = __intVal(anIntegerOrCharacter); - } else if (__isCharacter(anIntegerOrCharacter)) { - num = __smallIntegerVal(__characterVal(anIntegerOrCharacter)); - } else - goto out; - - u.shortVal = num; - - if (_buffered) { - __WRITING__(f) - } - __WRITEBYTES__(cnt, f, u.bytes, 2, _buffered, __INST(handleType)); - - if (cnt == 2) { - if (__isSmallInteger(__INST(position))) { - INT np = __intVal(__INST(position)) + 2; - OBJ t; - - t = __MKINT(np); __INST(position) = t; __STORE(self, t); - } else { - __INST(position) = nil; /* i.e. do not know */ - } - RETURN ( self ); - } - __INST(position) = nil; /* i.e. do not know */ - error = __mkSmallInteger(__threadErrno); - } + if (((fp = __INST(handle)) != nil) + && (__INST(mode) != @symbol(readonly)) + ) { + FILEPOINTER f = __FILEVal(fp); + int _buffered = (__INST(buffered) == true); + int cnt; + + if (__isSmallInteger(anIntegerOrCharacter)) { + num = __intVal(anIntegerOrCharacter); + } else if (__isCharacter(anIntegerOrCharacter)) { + num = __smallIntegerVal(__characterVal(anIntegerOrCharacter)); + } else + goto out; + + u.shortVal = num; + + if (_buffered) { + __WRITING__(f) + } + __WRITEBYTES__(cnt, f, u.bytes, 2, _buffered, __INST(handleType)); + + if (cnt == 2) { + if (__isSmallInteger(__INST(position))) { + INT np = __intVal(__INST(position)) + 2; + OBJ t; + + t = __MKINT(np); __INST(position) = t; __STORE(self, t); + } else { + __INST(position) = nil; /* i.e. do not know */ + } + RETURN ( self ); + } + __INST(position) = nil; /* i.e. do not know */ + error = __mkSmallInteger(__threadErrno); + } } out:; %}. @@ -4447,8 +4447,8 @@ ! nextPutInt32:aNumber MSB:msbFlag - "Write the argument, aNumber as a long (four bytes). - If msbFlag is true, data is written most-significant byte first; + "Write the argument, aNumber as a long (four bytes). + If msbFlag is true, data is written most-significant byte first; otherwise least first. Notice that integers in the range -16r80000000 to +16rFFFFFFFF can be written (i.e. both signed and unsigned int32 values can be written. @@ -4459,29 +4459,29 @@ %{ int num; union { - char bytes[4]; - int intVal; + char bytes[4]; + int intVal; } u; OBJ fp; __INST(lastErrorNumber) = nil; if (__isSmallInteger(aNumber)) { - num = __intVal(aNumber); + num = __intVal(aNumber); } else { #if __POINTER_SIZE__ == 8 - // always more than 4-bytes - goto badArg; + // always more than 4-bytes + goto badArg; #else - num = __longIntVal(aNumber); - if (num == 0) { - num = __signedLongIntVal(aNumber); - if (num == 0) { - /* bad arg or out-of-range integer - * (handled by the fallBack code) - */ - goto badArg; - } - } + num = __longIntVal(aNumber); + if (num == 0) { + num = __signedLongIntVal(aNumber); + if (num == 0) { + /* bad arg or out-of-range integer + * (handled by the fallBack code) + */ + goto badArg; + } + } #endif } @@ -4490,65 +4490,65 @@ || (__INST(handleType) == @symbol(socketFilePointer)) || (__INST(handleType) == @symbol(socketHandle)) || (__INST(handleType) == @symbol(pipeFilePointer))) { - if (((fp = __INST(handle)) != nil) - && (__INST(mode) != @symbol(readonly)) - ) { - int _buffered = (__INST(buffered) == true); - FILEPOINTER f = __FILEVal(fp); - int cnt; - - if (msbFlag == true) { + if (((fp = __INST(handle)) != nil) + && (__INST(mode) != @symbol(readonly)) + ) { + int _buffered = (__INST(buffered) == true); + FILEPOINTER f = __FILEVal(fp); + int cnt; + + if (msbFlag == true) { #if defined(__MSBFIRST__) - u.intVal = num; + u.intVal = num; #else - u.bytes[0] = (num >> 24) & 0xFF; - u.bytes[1] = (num >> 16) & 0xFF; - u.bytes[2] = (num >> 8) & 0xFF; - u.bytes[3] = num & 0xFF; + u.bytes[0] = (num >> 24) & 0xFF; + u.bytes[1] = (num >> 16) & 0xFF; + u.bytes[2] = (num >> 8) & 0xFF; + u.bytes[3] = num & 0xFF; #endif - } else { + } else { #if defined(__LSBFIRST__) - u.intVal = num; + u.intVal = num; #else - u.bytes[3] = (num >> 24) & 0xFF; - u.bytes[2] = (num >> 16) & 0xFF; - u.bytes[1] = (num >> 8) & 0xFF; - u.bytes[0] = num & 0xFF; + u.bytes[3] = (num >> 24) & 0xFF; + u.bytes[2] = (num >> 16) & 0xFF; + u.bytes[1] = (num >> 8) & 0xFF; + u.bytes[0] = num & 0xFF; #endif - } - - if (_buffered) { - __WRITING__(f) - } - __WRITEBYTES__(cnt, f, u.bytes, 4, _buffered, __INST(handleType)); - - if (cnt == 4) { - if (__isSmallInteger(__INST(position))) { - INT np = __intVal(__INST(position)) + 4; - OBJ t; - - t = __MKINT(np); __INST(position) = t; __STORE(self, t); - } else { - __INST(position) = nil; /* i.e. do not know */ - } - RETURN ( self ); - } - __INST(position) = nil; /* i.e. do not know */ - error = __mkSmallInteger(__threadErrno); - } + } + + if (_buffered) { + __WRITING__(f) + } + __WRITEBYTES__(cnt, f, u.bytes, 4, _buffered, __INST(handleType)); + + if (cnt == 4) { + if (__isSmallInteger(__INST(position))) { + INT np = __intVal(__INST(position)) + 4; + OBJ t; + + t = __MKINT(np); __INST(position) = t; __STORE(self, t); + } else { + __INST(position) = nil; /* i.e. do not know */ + } + RETURN ( self ); + } + __INST(position) = nil; /* i.e. do not know */ + error = __mkSmallInteger(__threadErrno); + } } badArg: ; %}. handle isNil ifTrue:[self errorNotOpen. ^ self]. (mode == #readonly) ifTrue:[self errorReadOnly. ^ self]. error notNil ifTrue:[ - lastErrorNumber := error. - self writeError:error. - ^ self + lastErrorNumber := error. + self writeError:error. + ^ self ]. aNumber isInteger ifTrue:[ - ^ super nextPutInt32:aNumber MSB:msbFlag + ^ super nextPutInt32:aNumber MSB:msbFlag ]. self argumentMustBeInteger ! @@ -4556,55 +4556,55 @@ nextPutInt32LSB:anIntegerOrCharacter "do not remove. See #patchByteOrderOptimizedMethods" - + self nextPutInt32:anIntegerOrCharacter MSB:false ! nextPutInt32MSB:anIntegerOrCharacter "do not remove. See #patchByteOrderOptimizedMethods" - + self nextPutInt32:anIntegerOrCharacter MSB:true ! nextPutInt32NATIVE:anInteger - "Write the argument, anInteger as a long (four bytes) in native byte order. + "Write the argument, anInteger as a long (four bytes) in native byte order. This is the CPU-specific byte order (LSB on x86, MSB on sparc, VAX and possibly on ARM). Notice that integers in the range -16r80000000 to +16rFFFFFFFF can be written (i.e. both signed and unsigned int32 values can be written. Works in both binary and text modes. Notice: this message should not be sent explicitly by ANY program. - the following implementation replaces the code of either nextPutInt32MSB or LSB - dynamically (see #initialize on the class side)" + the following implementation replaces the code of either nextPutInt32MSB or LSB + dynamically (see #initialize on the class side)" |error| %{ int num; union { - char bytes[4]; - int intVal; + char bytes[4]; + int intVal; } u; OBJ fp; __INST(lastErrorNumber) = nil; if (__isSmallInteger(anInteger)) { - num = __intVal(anInteger); + num = __intVal(anInteger); } else { #if __POINTER_SIZE__ == 8 - // always more than 4-bytes - goto badArg; + // always more than 4-bytes + goto badArg; #else - num = __longIntVal(anInteger); - if (num == 0) { - num = __signedLongIntVal(anInteger); - if (num == 0) { - /* bad arg or out-of-range integer - * (handled by the fallBack code) - */ - goto badArg; - } - } + num = __longIntVal(anInteger); + if (num == 0) { + num = __signedLongIntVal(anInteger); + if (num == 0) { + /* bad arg or out-of-range integer + * (handled by the fallBack code) + */ + goto badArg; + } + } #endif } @@ -4613,33 +4613,33 @@ || (__INST(handleType) == @symbol(socketFilePointer)) || (__INST(handleType) == @symbol(socketHandle)) || (__INST(handleType) == @symbol(pipeFilePointer))) { - if (((fp = __INST(handle)) != nil) - && (__INST(mode) != @symbol(readonly)) - ) { - int _buffered = (__INST(buffered) == true); - FILEPOINTER f = __FILEVal(fp); - int cnt; - - u.intVal = num; - if (_buffered) { - __WRITING__(f) - } - __WRITEBYTES__(cnt, f, u.bytes, 4, _buffered, __INST(handleType)); - - if (cnt == 4) { - if (__isSmallInteger(__INST(position))) { - INT np = __intVal(__INST(position)) + 4; - OBJ t; - - t = __MKINT(np); __INST(position) = t; __STORE(self, t); - } else { - __INST(position) = nil; /* i.e. do not know */ - } - RETURN ( self ); - } - __INST(position) = nil; /* i.e. do not know */ - error = __mkSmallInteger(__threadErrno); - } + if (((fp = __INST(handle)) != nil) + && (__INST(mode) != @symbol(readonly)) + ) { + int _buffered = (__INST(buffered) == true); + FILEPOINTER f = __FILEVal(fp); + int cnt; + + u.intVal = num; + if (_buffered) { + __WRITING__(f) + } + __WRITEBYTES__(cnt, f, u.bytes, 4, _buffered, __INST(handleType)); + + if (cnt == 4) { + if (__isSmallInteger(__INST(position))) { + INT np = __intVal(__INST(position)) + 4; + OBJ t; + + t = __MKINT(np); __INST(position) = t; __STORE(self, t); + } else { + __INST(position) = nil; /* i.e. do not know */ + } + RETURN ( self ); + } + __INST(position) = nil; /* i.e. do not know */ + error = __mkSmallInteger(__threadErrno); + } } badArg: ; %}. @@ -4685,74 +4685,74 @@ int rslt; if (fp == nil) { - error = @symbol(errorNotOpen); - goto out; + error = @symbol(errorNotOpen); + goto out; } if (__INST(handleType) == @symbol(socketHandle)) { - SOCKET sock = __FILEVal(fp); - - if (@global(FileOpenTrace) == true) { - fprintf(stderr, "close socket [ExternalStream] %"_lx_"\n", (INT)sock); - } - - // whether the close() will be successful or not - the handle is invalid now! - __INST(handle) = nil; - do { -#ifdef WIN32 - rslt = __STX_WSA_NOINT_CALL1("closesocket", closesocket, sock); + SOCKET sock = __FILEVal(fp); + + if (@global(FileOpenTrace) == true) { + fprintf(stderr, "close socket [ExternalStream] %"_lx_"\n", (INT)sock); + } + + // whether the close() will be successful or not - the handle is invalid now! + __INST(handle) = nil; + do { +#ifdef __win32__ + rslt = __STX_WSA_NOINT_CALL1("closesocket", closesocket, sock); #else - rslt = close(sock); + rslt = close(sock); #endif - } while((rslt < 0) && (__threadErrno == EINTR)); + } while((rslt < 0) && (__threadErrno == EINTR)); } else if ((__INST(handleType) == nil) - || (__INST(handleType) == @symbol(filePointer)) - || (__INST(handleType) == @symbol(socketFilePointer)) - || (__INST(handleType) == @symbol(pipeFilePointer))) + || (__INST(handleType) == @symbol(filePointer)) + || (__INST(handleType) == @symbol(socketFilePointer)) + || (__INST(handleType) == @symbol(pipeFilePointer))) { - FILEPOINTER f = __FILEVal(fp); - - if (@global(FileOpenTrace) == true) { - fprintf(stderr, "fclose [ExternalStream] %"_lx_"\n", (INT)f); - } - // whether the close() will be successful or not - the handle is invalid now! - __INST(handle) = nil; - -#ifdef WIN32 - if (__INST(mode) != @symbol(readonly) && __INST(buffered) != false) { - // do a fflush() first, so that fclose() doesn't block - // we suspect, that EINTR causes problems in fclose() - do { - __threadErrno = 0; - rslt = __STX_C_CALL1("fflush", fflush, f); - } while((rslt < 0) && (__threadErrno == EINTR)); - } - do { - __threadErrno = 0; - rslt = __STX_C_NOINT_CALL1("fclose", fclose, f); - } while((rslt < 0) && (__threadErrno == EINTR)); + FILEPOINTER f = __FILEVal(fp); + + if (@global(FileOpenTrace) == true) { + fprintf(stderr, "fclose [ExternalStream] %"_lx_"\n", (INT)f); + } + // whether the close() will be successful or not - the handle is invalid now! + __INST(handle) = nil; + +#ifdef __win32__ + if (__INST(mode) != @symbol(readonly) && __INST(buffered) != false) { + // do a fflush() first, so that fclose() doesn't block + // we suspect, that EINTR causes problems in fclose() + do { + __threadErrno = 0; + rslt = __STX_C_CALL1("fflush", fflush, f); + } while((rslt < 0) && (__threadErrno == EINTR)); + } + do { + __threadErrno = 0; + rslt = __STX_C_NOINT_CALL1("fclose", fclose, f); + } while((rslt < 0) && (__threadErrno == EINTR)); #else - // cg: the pre Nov2014 code always did the fclose interruptable; - // I am not sure, if fclose is actually prepared to do this; - // at least when only reading, this should not block, and we - // should be ableto do it without being interruptable. - // Must watch this - if it leads to blockings, change and think about it. - if (__INST(mode) != @symbol(readonly)) { - __BEGIN_INTERRUPTABLE__ - rslt = fclose(f); - __END_INTERRUPTABLE__ - } else { - rslt = fclose(f); - } + // cg: the pre Nov2014 code always did the fclose interruptable; + // I am not sure, if fclose is actually prepared to do this; + // at least when only reading, this should not block, and we + // should be ableto do it without being interruptable. + // Must watch this - if it leads to blockings, change and think about it. + if (__INST(mode) != @symbol(readonly)) { + __BEGIN_INTERRUPTABLE__ + rslt = fclose(f); + __END_INTERRUPTABLE__ + } else { + rslt = fclose(f); + } #endif } else { - error = @symbol(badHandleType); - goto out; + error = @symbol(badHandleType); + goto out; } if (rslt < 0) { - error = __mkSmallInteger(__threadErrno); - goto out; + error = __mkSmallInteger(__threadErrno); + goto out; } RETURN (self); @@ -4760,28 +4760,28 @@ %}. error notNil ifTrue:[ - error == #errorNotOpen ifTrue:[ - self errorNotOpen. - ]. - error isInteger ifTrue:[ - lastErrorNumber := error. - mode == #readonly ifTrue:[ - self ioError:error. - ] ifFalse:[ - self writeError:error. - ]. - ^ self. - ]. - self primitiveFailed:error. - ^ self. + error == #errorNotOpen ifTrue:[ + self errorNotOpen. + ]. + error isInteger ifTrue:[ + lastErrorNumber := error. + mode == #readonly ifTrue:[ + self ioError:error. + ] ifFalse:[ + self writeError:error. + ]. + ^ self. + ]. + self primitiveFailed:error. + ^ self. ]. "/ fallback for rel5 fp := handle. fp notNil ifTrue:[ - handle := nil. - self closeFile:fp + handle := nil. + self closeFile:fp ] ! @@ -4811,13 +4811,13 @@ int fd = -2; if (__isStringLike(openmode)) { -#ifdef WIN32 +#ifdef __win32__ __stxWrapApiEnterCritical(); #endif if (__isSmallInteger(aFileDescriptor)) { fd = __intVal(aFileDescriptor); } -#ifdef WIN32 +#ifdef __win32__ else if (__isExternalAddressLike(aFileDescriptor)) { fd = _open_osfhandle((long)__externalAddressVal(aFileDescriptor), O_BINARY); if (fd < 0) { @@ -4832,7 +4832,7 @@ } #endif f = (FILEPOINTER) fdopen(fd, (char *)__stringVal(openmode)); -#ifdef WIN32 +#ifdef __win32__ __stxWrapApiLeaveCritical(); #endif if (f == NULL) { @@ -4909,7 +4909,7 @@ OBJ fp; if (__isStringLike(aPath) && __isStringLike(openModeString)) { -#ifdef WIN32 +#ifdef __win32__ # if 1 f = fopen((char *) __stringVal(aPath), (char *) __stringVal(openModeString)); # else @@ -5005,7 +5005,7 @@ if (!__isStringLike(openMode)) goto err; -#ifdef WIN32 +#ifdef __win32__ __stxWrapApiEnterCritical(); if (__isExternalAddressLike(anIntegerOrExternalAddress) ) { HANDLE __fileHandle = (HANDLE)__externalAddressVal(anIntegerOrExternalAddress); @@ -5020,13 +5020,13 @@ if (__isSmallInteger(anIntegerOrExternalAddress)) { fd = __smallIntegerVal(anIntegerOrExternalAddress); } else { -#ifdef WIN32 +#ifdef __win32__ __stxWrapApiLeaveCritical(); #endif goto err; } f = fdopen(fd, __stringVal(openMode)); -#ifdef WIN32 +#ifdef __win32__ __stxWrapApiLeaveCritical(); #endif if (f != NULL) { @@ -5115,7 +5115,7 @@ fd := self fileDescriptor. %{ -#ifdef WIN32 +#ifdef __win32__ int res = 1; int success = 0; @@ -5593,7 +5593,7 @@ * read ahead ... */ do { -#ifdef WIN32 +#ifdef __win32__ # if 1 __READBYTE__(ret, f, &c, _buffered, __INST(handleType)); @@ -5602,7 +5602,7 @@ __READBYTE__(ret, f, &c, _buffered, __INST(handleType)); __END_INTERRUPTABLE__ # endif -#else /* not WIN32 */ +#else /* not __win32__ */ __BEGIN_INTERRUPTABLE__ __READBYTE__(ret, f, &c, _buffered, __INST(handleType)); __END_INTERRUPTABLE__ @@ -5991,11 +5991,11 @@ rslt = __STX_C_CALL1("fflush", fflush, f); } while((rslt < 0) && (__threadErrno == EINTR)); } -#else /* ! WIN32 */ +#else /* ! __win32__ */ __BEGIN_INTERRUPTABLE__ FFLUSH(f); __END_INTERRUPTABLE__ -#endif /* ! WIN32 */ +#endif /* ! __win32__ */ } } } @@ -6714,13 +6714,13 @@ self nextPutUtf16:aCharacter MSB:true " - (FileStream newTemporary - nextPutUtf16:$B; - nextPutUtf16:$; - nextPutUtf16:(Character codePoint:16r10CCCC); - reset; - binary; - contents) + (FileStream newTemporary + nextPutUtf16:$B; + nextPutUtf16:$; + nextPutUtf16:(Character codePoint:16r10CCCC); + reset; + binary; + contents) " ! @@ -6733,35 +6733,35 @@ codePoint := aCharacter codePoint. (codePoint <= 16rD7FF or:[codePoint >= 16rE000 and:[codePoint <= 16rFFFF]]) ifTrue:[ - self nextPutInt16:codePoint MSB:msb. + self nextPutInt16:codePoint MSB:msb. ] ifFalse:[codePoint <= 16r10FFFF ifTrue:[ - |highBits lowBits| - - codePoint := codePoint - 16r100000. - highBits := codePoint bitShift:-10. - lowBits := codePoint bitAnd:16r3FF. - self nextPutInt16:highBits+16rD800 MSB:msb. - self nextPutInt16:lowBits+16rDC00 MSB:msb. + |highBits lowBits| + + codePoint := codePoint - 16r100000. + highBits := codePoint bitShift:-10. + lowBits := codePoint bitAnd:16r3FF. + self nextPutInt16:highBits+16rD800 MSB:msb. + self nextPutInt16:lowBits+16rDC00 MSB:msb. ] ifFalse:[ - EncodingError raiseWith:aCharacter errorString:'Character cannot be encoded as UTF-16'. + EncodingError raiseWith:aCharacter errorString:'Character cannot be encoded as UTF-16'. ]]. " - (FileStream newTemporary - nextPutUtf16:$B MSB:true; - nextPutUtf16:$ MSB:true; - nextPutUtf16:(Character codePoint:16r10CCCC) MSB:true; - reset; - binary; - contents) - - (FileStream newTemporary - nextPutUtf16:$B MSB:false; - nextPutUtf16:$ MSB:false; - nextPutUtf16:(Character codePoint:16r10CCCC) MSB:false; - reset; - binary; - contents) + (FileStream newTemporary + nextPutUtf16:$B MSB:true; + nextPutUtf16:$ MSB:true; + nextPutUtf16:(Character codePoint:16r10CCCC) MSB:true; + reset; + binary; + contents) + + (FileStream newTemporary + nextPutUtf16:$B MSB:false; + nextPutUtf16:$ MSB:false; + nextPutUtf16:(Character codePoint:16r10CCCC) MSB:false; + reset; + binary; + contents) " !
--- a/FileStream.st Sun May 15 08:38:43 2016 +0100 +++ b/FileStream.st Tue May 17 10:05:14 2016 +0100 @@ -58,9 +58,9 @@ #define String __STX_String #define Character __STX_Character -#ifdef WIN32 +#ifdef __win32__ # define NO_STDIO -# ifdef __i386__ +# if defined(__i386__) || defined(__x86__) # define _X86_ # endif @@ -179,9 +179,9 @@ # define HFILE FILE * /* # define fileno(f) f */ -#else /* not WIN32 */ +#else /* not __win32__ */ # define HFILE FILE * -#endif /* ! WIN32 */ +#endif /* ! __win32__ */ //#define DO_WRAP_CALL_FSEEK @@ -447,48 +447,48 @@ |nameString random prevRandom prevNameString newTempFilename stream| [ - prevRandom := random. - prevNameString := nameString. + prevRandom := random. + prevNameString := nameString. - "Use random numbers in order to improve the security - by making the generated names less predictable" - [ - random := RandomGenerator nextLettersOrDigits:4. - ] doWhile:[random = prevRandom]. + "Use random numbers in order to improve the security + by making the generated names less predictable" + [ + random := RandomGenerator nextLettersOrDigits:4. + ] doWhile:[random = prevRandom]. - nameString := template bindWith:(OperatingSystem getProcessId) with:random. + nameString := template bindWith:(OperatingSystem getProcessId) with:random. - aDirectoryOrNil isNil ifTrue:[ - newTempFilename := nameString. - ] ifFalse:[ - newTempFilename := aDirectoryOrNil asFilename constructString:nameString. - ]. + aDirectoryOrNil isNil ifTrue:[ + newTempFilename := nameString. + ] ifFalse:[ + newTempFilename := aDirectoryOrNil asFilename constructString:nameString. + ]. - [ - stream := self open:newTempFilename withMode:#(CREATE_NEW GENERIC_READ_WRITE). - ] on:OpenError do:[:ex| - ex errorCategory ~~ #existingReferentSignal ifTrue:[ - "some fundamental error, raise exception" - ex reject. - ]. - prevNameString = nameString ifTrue:[ - "no more names - probably a bad template" - ex reject. - ]. - "file exists, retry another one" - ]. + [ + stream := self open:newTempFilename withMode:#(CREATE_NEW GENERIC_READ_WRITE). + ] on:OpenError do:[:ex| + ex errorCategory ~~ #existingReferentSignal ifTrue:[ + "some fundamental error, raise exception" + ex reject. + ]. + prevNameString = nameString ifTrue:[ + "no more names - probably a bad template" + ex reject. + ]. + "file exists, retry another one" + ]. ] doWhile:[ - stream isNil and:[prevNameString ~= nameString] "/ if namestring didn't change, the template is bad + stream isNil and:[prevNameString ~= nameString] "/ if namestring didn't change, the template is bad ]. ^ stream "temp files in '/tmp': - FileStream newTemporaryIn:'/tmp' asFilename nameTemplate:'foo%1_%2' + FileStream newTemporaryIn:'/tmp' asFilename nameTemplate:'foo%1_%2' This must fail on the second try: - FileStream newTemporaryIn:'/tmp' asFilename nameTemplate:'foo' - FileStream newTemporaryIn:'c:\temp' asFilename nameTemplate:'foo' + FileStream newTemporaryIn:'/tmp' asFilename nameTemplate:'foo' + FileStream newTemporaryIn:'c:\temp' asFilename nameTemplate:'foo' " "temp files somewhere @@ -1004,7 +1004,7 @@ if (__INST(handle) != nil) { do { f = __FILEVal(__INST(handle)); -#ifdef WIN32 +#ifdef __win32__ __threadErrno = 0; if (__INST(buffered) == true) { # if 0 @@ -1028,7 +1028,7 @@ __threadErrno = errno; # endif } -#else /* !WIN32 */ +#else /* !__win32__ */ if (__INST(buffered) == true) { #ifdef _LFS_LARGEFILE currentPosition = ftello(f); @@ -1078,7 +1078,7 @@ if ((__INST(canPosition) != false) || (newPos == __mkSmallInteger(0))) { if ((fp = __INST(handle)) != nil) { -#if defined(_LFS_LARGE_FILE) && !defined(WIN32) +#if defined(_LFS_LARGE_FILE) && !defined(__win32__) # define FSEEK fseeko off_t nP; #else @@ -1205,7 +1205,7 @@ f = __FILEVal(__INST(handle)); __INST(position) = nil; /* i.e. unknown */ do { -#ifdef WIN32 +#ifdef __win32__ __threadErrno = 0; if (__INST(buffered) == true) { ret = STX_C_CALL3( "fseek", fseek, f, 0L, SEEK_END); @@ -1215,11 +1215,11 @@ } #else if (__INST(buffered) == true) { -#ifdef _LFS_LARGE_FILE +# ifdef _LFS_LARGE_FILE ret = fseeko(f, (off_t)0, SEEK_END); -#else +# else ret = fseek(f, 0L, SEEK_END); -#endif +# endif } else { if (sizeof(off_t) == 8) { ret = lseek64(fileno(f), (off_t)0, SEEK_END); @@ -1363,369 +1363,369 @@ int pass = 0; if (!__isNonNilObject(encodedPathName) - || !(__isStringLike(openmode) || __isArrayLike(openmode))) - goto badArgument; + || !(__isStringLike(openmode) || __isArrayLike(openmode))) + goto badArgument; retry: #ifdef __VMS__ if (__isStringLike(encodedPathName)) { - do { - /* - * allow passing additional RMS arguments. - * stupid: DEC does not seem to offer an interface for passing a char **. - */ - __threadErrno = 0; + do { + /* + * allow passing additional RMS arguments. + * stupid: DEC does not seem to offer an interface for passing a char **. + */ + __threadErrno = 0; - { - if (__isArray(attributeSpec)) { - OBJ *ap = __ArrayInstPtr(attributeSpec)->a_element; - int numAttrib = 0; - int i; + { + if (__isArray(attributeSpec)) { + OBJ *ap = __ArrayInstPtr(attributeSpec)->a_element; + int numAttrib = 0; + int i; - numAttrib = __arraySize(attributeSpec); - for (i=0; i<numAttrib;i++) { - if (! __isStringLike(ap[i])) { - __threadErrno = EINVAL; /* invalid argument */ - goto getOutOfHere; - } - } - switch (numAttrib) { - case 0: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode)); - __END_INTERRUPTABLE__ - break; - case 1: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0])); - __END_INTERRUPTABLE__ - break; - case 2: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0]), __stringVal(ap[1])); - __END_INTERRUPTABLE__ - break; - case 3: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2])); - __END_INTERRUPTABLE__ - break; - case 4: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), - __stringVal(ap[3])); - __END_INTERRUPTABLE__ - break; - case 5: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), - __stringVal(ap[3]), __stringVal(ap[4])); - __END_INTERRUPTABLE__ - break; - case 6: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), - __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5])); - __END_INTERRUPTABLE__ - break; - case 7: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), - __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]), - __stringVal(ap[6])); - __END_INTERRUPTABLE__ - break; - case 8: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), - __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]), - __stringVal(ap[6]), __stringVal(ap[7])); - __END_INTERRUPTABLE__ - break; - case 9: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), - __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]), - __stringVal(ap[6]), __stringVal(ap[7]), __stringVal(ap[8])); - __END_INTERRUPTABLE__ - break; - case 10: - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), - __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), - __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]), - __stringVal(ap[6]), __stringVal(ap[7]), __stringVal(ap[8]), - __stringVal(ap[9])); - __END_INTERRUPTABLE__ - break; - default: - __threadErrno = E2BIG; /* too many args */ - goto getOutOfHere; - } - } else if (attributeSpec != nil) { - __threadErrno = EINVAL; /* invalid argument */ - goto getOutOfHere; - } else { - /* - * create file as sequential streamLF by default. - */ - __BEGIN_INTERRUPTABLE__ - f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), "rfm=stmlf"); - __END_INTERRUPTABLE__ - } - } - } while ((f == NULL) && (__threadErrno == EINTR)); + numAttrib = __arraySize(attributeSpec); + for (i=0; i<numAttrib;i++) { + if (! __isStringLike(ap[i])) { + __threadErrno = EINVAL; /* invalid argument */ + goto getOutOfHere; + } + } + switch (numAttrib) { + case 0: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode)); + __END_INTERRUPTABLE__ + break; + case 1: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0])); + __END_INTERRUPTABLE__ + break; + case 2: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0]), __stringVal(ap[1])); + __END_INTERRUPTABLE__ + break; + case 3: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2])); + __END_INTERRUPTABLE__ + break; + case 4: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), + __stringVal(ap[3])); + __END_INTERRUPTABLE__ + break; + case 5: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), + __stringVal(ap[3]), __stringVal(ap[4])); + __END_INTERRUPTABLE__ + break; + case 6: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), + __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5])); + __END_INTERRUPTABLE__ + break; + case 7: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), + __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]), + __stringVal(ap[6])); + __END_INTERRUPTABLE__ + break; + case 8: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), + __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]), + __stringVal(ap[6]), __stringVal(ap[7])); + __END_INTERRUPTABLE__ + break; + case 9: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), + __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]), + __stringVal(ap[6]), __stringVal(ap[7]), __stringVal(ap[8])); + __END_INTERRUPTABLE__ + break; + case 10: + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), + __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]), + __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]), + __stringVal(ap[6]), __stringVal(ap[7]), __stringVal(ap[8]), + __stringVal(ap[9])); + __END_INTERRUPTABLE__ + break; + default: + __threadErrno = E2BIG; /* too many args */ + goto getOutOfHere; + } + } else if (attributeSpec != nil) { + __threadErrno = EINVAL; /* invalid argument */ + goto getOutOfHere; + } else { + /* + * create file as sequential streamLF by default. + */ + __BEGIN_INTERRUPTABLE__ + f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), "rfm=stmlf"); + __END_INTERRUPTABLE__ + } + } + } while ((f == NULL) && (__threadErrno == EINTR)); } #else /* not VMS */ -# ifdef WIN32 +# ifdef __win32__ { - DWORD share = 0, access = 0, create = 0, attr = 0; - char * __openmode; - HANDLE handle; - SECURITY_ATTRIBUTES sa; + DWORD share = 0, access = 0, create = 0, attr = 0; + char * __openmode; + HANDLE handle; + SECURITY_ATTRIBUTES sa; - if (__isStringLike(openmode)) { - share = FILE_SHARE_READ|FILE_SHARE_WRITE; - __openmode = __stringVal(openmode); - if (strcmp(__openmode, "rb") == 0) { - access = GENERIC_READ; - create = OPEN_EXISTING; - } else if (strcmp(__openmode, "rb+") == 0) { - access = GENERIC_READ | GENERIC_WRITE; - create = OPEN_EXISTING; - } else if (strcmp(__openmode, "wb") == 0) { - access = GENERIC_WRITE; - create = CREATE_ALWAYS; - } else if (strcmp(__openmode, "wb+") == 0) { - access = GENERIC_READ | GENERIC_WRITE; - create = CREATE_ALWAYS; - } else if (strcmp(__openmode, "ab") == 0) { - access = FILE_APPEND_DATA|FILE_WRITE_ATTRIBUTES|FILE_WRITE_EA| - STANDARD_RIGHTS_WRITE|SYNCHRONIZE; - create = OPEN_ALWAYS; - } else if (strcmp(__openmode, "ab+") == 0) { - access = GENERIC_READ |FILE_APPEND_DATA|FILE_WRITE_ATTRIBUTES|FILE_WRITE_EA| - STANDARD_RIGHTS_WRITE|SYNCHRONIZE; - create = OPEN_ALWAYS; - } else { - console_fprintf(stderr, "Win32OS [warning]: unsupported open mode\n"); - } - } else if (__isArrayLike(openmode)) { - OBJ *ap = __arrayVal(openmode); - int numAttrib = __arraySize(openmode); - int i; + if (__isStringLike(openmode)) { + share = FILE_SHARE_READ|FILE_SHARE_WRITE; + __openmode = __stringVal(openmode); + if (strcmp(__openmode, "rb") == 0) { + access = GENERIC_READ; + create = OPEN_EXISTING; + } else if (strcmp(__openmode, "rb+") == 0) { + access = GENERIC_READ | GENERIC_WRITE; + create = OPEN_EXISTING; + } else if (strcmp(__openmode, "wb") == 0) { + access = GENERIC_WRITE; + create = CREATE_ALWAYS; + } else if (strcmp(__openmode, "wb+") == 0) { + access = GENERIC_READ | GENERIC_WRITE; + create = CREATE_ALWAYS; + } else if (strcmp(__openmode, "ab") == 0) { + access = FILE_APPEND_DATA|FILE_WRITE_ATTRIBUTES|FILE_WRITE_EA| + STANDARD_RIGHTS_WRITE|SYNCHRONIZE; + create = OPEN_ALWAYS; + } else if (strcmp(__openmode, "ab+") == 0) { + access = GENERIC_READ |FILE_APPEND_DATA|FILE_WRITE_ATTRIBUTES|FILE_WRITE_EA| + STANDARD_RIGHTS_WRITE|SYNCHRONIZE; + create = OPEN_ALWAYS; + } else { + console_fprintf(stderr, "Win32OS [warning]: unsupported open mode\n"); + } + } else if (__isArrayLike(openmode)) { + OBJ *ap = __arrayVal(openmode); + int numAttrib = __arraySize(openmode); + int i; - __openmode = "rb+"; + __openmode = "rb+"; - for (i=0; i<numAttrib; i++) { - OBJ attrSym = ap[i]; + for (i=0; i<numAttrib; i++) { + OBJ attrSym = ap[i]; - if (attrSym == @symbol(FILE_SHARE_READ)) { - share |= FILE_SHARE_READ; - } else if (attrSym == @symbol(FILE_SHARE_WRITE)) { - share |= FILE_SHARE_WRITE; + if (attrSym == @symbol(FILE_SHARE_READ)) { + share |= FILE_SHARE_READ; + } else if (attrSym == @symbol(FILE_SHARE_WRITE)) { + share |= FILE_SHARE_WRITE; - } else if (attrSym == @symbol(GENERIC_READ)) { - access |= GENERIC_READ; - } else if (attrSym == @symbol(GENERIC_WRITE)) { - access |= GENERIC_WRITE; - } else if (attrSym == @symbol(GENERIC_READ_WRITE)) { - access |= GENERIC_READ|GENERIC_WRITE; + } else if (attrSym == @symbol(GENERIC_READ)) { + access |= GENERIC_READ; + } else if (attrSym == @symbol(GENERIC_WRITE)) { + access |= GENERIC_WRITE; + } else if (attrSym == @symbol(GENERIC_READ_WRITE)) { + access |= GENERIC_READ|GENERIC_WRITE; - } else if (attrSym == @symbol(CREATE_NEW)) { - create |= CREATE_NEW; - } else if (attrSym == @symbol(CREATE_ALWAYS)) { - create |= CREATE_ALWAYS; - } else if (attrSym == @symbol(OPEN_EXISTING)) { - create |= OPEN_EXISTING; - } else if (attrSym == @symbol(OPEN_ALWAYS)) { - create |= OPEN_ALWAYS; - } else if (attrSym == @symbol(TRUNCATE_EXISTING)) { - create |= TRUNCATE_EXISTING; + } else if (attrSym == @symbol(CREATE_NEW)) { + create |= CREATE_NEW; + } else if (attrSym == @symbol(CREATE_ALWAYS)) { + create |= CREATE_ALWAYS; + } else if (attrSym == @symbol(OPEN_EXISTING)) { + create |= OPEN_EXISTING; + } else if (attrSym == @symbol(OPEN_ALWAYS)) { + create |= OPEN_ALWAYS; + } else if (attrSym == @symbol(TRUNCATE_EXISTING)) { + create |= TRUNCATE_EXISTING; - } else if (attrSym == @symbol(FILE_ATTRIBUTE_HIDDEN)) { - attr |= FILE_ATTRIBUTE_HIDDEN; - } else if (attrSym == @symbol(FILE_ATTRIBUTE_READONLY)) { - attr |= FILE_ATTRIBUTE_READONLY; - } else if (attrSym == @symbol(FILE_FLAG_WRITE_THROUGH)) { - attr |= FILE_FLAG_WRITE_THROUGH; - } else if (attrSym == @symbol(FILE_FLAG_SEQUENTIAL_SCAN)) { - attr |= FILE_FLAG_SEQUENTIAL_SCAN; - } else if (attrSym == @symbol(FILE_FLAG_DELETE_ON_CLOSE)) { - attr |= FILE_FLAG_DELETE_ON_CLOSE; - } else if (!__isSymbol(attrSym) && __isStringLike(attrSym)) { - __openmode = __stringVal(attrSym); - } else { - console_fprintf(stderr, "Win32OS [warning]: unsupported open mode\n"); - } - } - } - if (create == 0) { + } else if (attrSym == @symbol(FILE_ATTRIBUTE_HIDDEN)) { + attr |= FILE_ATTRIBUTE_HIDDEN; + } else if (attrSym == @symbol(FILE_ATTRIBUTE_READONLY)) { + attr |= FILE_ATTRIBUTE_READONLY; + } else if (attrSym == @symbol(FILE_FLAG_WRITE_THROUGH)) { + attr |= FILE_FLAG_WRITE_THROUGH; + } else if (attrSym == @symbol(FILE_FLAG_SEQUENTIAL_SCAN)) { + attr |= FILE_FLAG_SEQUENTIAL_SCAN; + } else if (attrSym == @symbol(FILE_FLAG_DELETE_ON_CLOSE)) { + attr |= FILE_FLAG_DELETE_ON_CLOSE; + } else if (!__isSymbol(attrSym) && __isStringLike(attrSym)) { + __openmode = __stringVal(attrSym); + } else { + console_fprintf(stderr, "Win32OS [warning]: unsupported open mode\n"); + } + } + } + if (create == 0) { // argumentError = @symbol(missingCreateMode); - goto badArgument; - } - if (attr == 0) { - attr = FILE_ATTRIBUTE_NORMAL; - } + goto badArgument; + } + if (attr == 0) { + attr = FILE_ATTRIBUTE_NORMAL; + } - /* - * create security attributes - make handle inheritable by subprocesses - */ - memset(&sa, 0, sizeof (sa)); - sa.nLength = sizeof( sa ); - // sa.bInheritHandle = TRUE; - sa.bInheritHandle = FALSE; + /* + * create security attributes - make handle inheritable by subprocesses + */ + memset(&sa, 0, sizeof (sa)); + sa.nLength = sizeof( sa ); + // sa.bInheritHandle = TRUE; + sa.bInheritHandle = FALSE; - if (__isStringLike(pathName)) { - char _aPathName[MAXPATHLEN]; + if (__isStringLike(pathName)) { + char _aPathName[MAXPATHLEN]; - strncpy(_aPathName, __stringVal(pathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0'; - do { - __threadErrno = 0; - handle = STX_API_NOINT_CALL7( "CreateFileA", CreateFileA, _aPathName, access, share, &sa, create, attr, 0 /* hTempl */); - if (__threadErrno == EINTR) { - handle = INVALID_HANDLE_VALUE; - } - } while ((handle == INVALID_HANDLE_VALUE) && (__threadErrno == EINTR)); - } else if (__isUnicode16String(pathName)) { - wchar_t _aPathName[MAXPATHLEN+1]; - int i, l; + strncpy(_aPathName, __stringVal(pathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0'; + do { + __threadErrno = 0; + handle = STX_API_NOINT_CALL7( "CreateFileA", CreateFileA, _aPathName, access, share, &sa, create, attr, 0 /* hTempl */); + if (__threadErrno == EINTR) { + handle = INVALID_HANDLE_VALUE; + } + } while ((handle == INVALID_HANDLE_VALUE) && (__threadErrno == EINTR)); + } else if (__isUnicode16String(pathName)) { + wchar_t _aPathName[MAXPATHLEN+1]; + int i, l; - l = __unicode16StringSize(pathName); - if (l > MAXPATHLEN) l = MAXPATHLEN; - for (i=0; i<l; i++) { - _aPathName[i] = __unicode16StringVal(pathName)[i]; - } - _aPathName[i] = 0; + l = __unicode16StringSize(pathName); + if (l > MAXPATHLEN) l = MAXPATHLEN; + for (i=0; i<l; i++) { + _aPathName[i] = __unicode16StringVal(pathName)[i]; + } + _aPathName[i] = 0; - do { - __threadErrno = 0; - handle = STX_API_NOINT_CALL7( "CreateFileW", CreateFileW, _aPathName, access, share, &sa, create, attr, 0 /* hTempl */); - if (__threadErrno == EINTR) { - handle = INVALID_HANDLE_VALUE; - } - } while ((handle == INVALID_HANDLE_VALUE) && (__threadErrno == EINTR)); - } - if (handle != INVALID_HANDLE_VALUE) { - int fd; - extern void __stxWrapApiEnterCritical(), __stxWrapApiLeaveCritical(); + do { + __threadErrno = 0; + handle = STX_API_NOINT_CALL7( "CreateFileW", CreateFileW, _aPathName, access, share, &sa, create, attr, 0 /* hTempl */); + if (__threadErrno == EINTR) { + handle = INVALID_HANDLE_VALUE; + } + } while ((handle == INVALID_HANDLE_VALUE) && (__threadErrno == EINTR)); + } + if (handle != INVALID_HANDLE_VALUE) { + int fd; + extern void __stxWrapApiEnterCritical(), __stxWrapApiLeaveCritical(); - __stxWrapApiEnterCritical(); - fd = _open_osfhandle((long)handle, O_BINARY); - if (fd < 0) { - if (__threadErrno == 0) { - // no more file descriptors - __threadErrno = EMFILE; - } - CloseHandle(handle); - } else { - f = fdopen(fd, __openmode); - } - __stxWrapApiLeaveCritical(); - } else { - __threadErrno = __WIN32_ERR(GetLastError()); - } + __stxWrapApiEnterCritical(); + fd = _open_osfhandle((long)handle, O_BINARY); + if (fd < 0) { + if (__threadErrno == 0) { + // no more file descriptors + __threadErrno = EMFILE; + } + CloseHandle(handle); + } else { + f = fdopen(fd, __openmode); + } + __stxWrapApiLeaveCritical(); + } else { + __threadErrno = __WIN32_ERR(GetLastError()); + } } # else /* not WIN32 */ if (__isStringLike(encodedPathName)) { - int accessMode = 0666; // default access mode of fopen(), relies on umask() - int flags = 0; - int fd; - char * __openmode; + int accessMode = 0666; // default access mode of fopen(), relies on umask() + int flags = 0; + int fd; + char * __openmode; - if (__isStringLike(openmode)) { - __openmode = __stringVal(openmode); - if (strcmp(__openmode, "r") == 0) { - flags = O_RDONLY; - } else if (strcmp(__openmode, "r+") == 0) { - flags = O_RDWR; - } else if (strcmp(__openmode, "w") == 0) { - flags = O_WRONLY | O_CREAT | O_TRUNC; - } else if (strcmp(__openmode, "w+") == 0) { - flags = O_RDWR | O_CREAT | O_TRUNC; - } else if (strcmp(__openmode, "a") == 0) { - flags = O_WRONLY | O_CREAT | O_APPEND; - } else if (strcmp(__openmode, "a+") == 0) { - flags = O_RDWR | O_CREAT| O_APPEND; - } else { - console_fprintf(stderr, "UNIXOS [warning]: unsupported open mode\n"); - } - } else if (__isArrayLike(openmode)) { - OBJ *ap = __arrayVal(openmode); - int numAttrib = __arraySize(openmode); - int i; + if (__isStringLike(openmode)) { + __openmode = __stringVal(openmode); + if (strcmp(__openmode, "r") == 0) { + flags = O_RDONLY; + } else if (strcmp(__openmode, "r+") == 0) { + flags = O_RDWR; + } else if (strcmp(__openmode, "w") == 0) { + flags = O_WRONLY | O_CREAT | O_TRUNC; + } else if (strcmp(__openmode, "w+") == 0) { + flags = O_RDWR | O_CREAT | O_TRUNC; + } else if (strcmp(__openmode, "a") == 0) { + flags = O_WRONLY | O_CREAT | O_APPEND; + } else if (strcmp(__openmode, "a+") == 0) { + flags = O_RDWR | O_CREAT| O_APPEND; + } else { + console_fprintf(stderr, "UNIXOS [warning]: unsupported open mode\n"); + } + } else if (__isArrayLike(openmode)) { + OBJ *ap = __arrayVal(openmode); + int numAttrib = __arraySize(openmode); + int i; - __openmode = "r+"; + __openmode = "r+"; - for (i=0; i<numAttrib; i++) { - OBJ attrSym = ap[i]; + for (i=0; i<numAttrib; i++) { + OBJ attrSym = ap[i]; - if (attrSym == @symbol(FILE_SHARE_READ)) { - // ignore - } else if (attrSym == @symbol(FILE_SHARE_WRITE)) { - // ignore - } else if (attrSym == @symbol(GENERIC_READ)) { - flags |= O_RDONLY; - } else if (attrSym == @symbol(GENERIC_WRITE)) { - flags |= O_WRONLY; - } else if (attrSym == @symbol(GENERIC_READ_WRITE)) { - flags |= O_RDWR; + if (attrSym == @symbol(FILE_SHARE_READ)) { + // ignore + } else if (attrSym == @symbol(FILE_SHARE_WRITE)) { + // ignore + } else if (attrSym == @symbol(GENERIC_READ)) { + flags |= O_RDONLY; + } else if (attrSym == @symbol(GENERIC_WRITE)) { + flags |= O_WRONLY; + } else if (attrSym == @symbol(GENERIC_READ_WRITE)) { + flags |= O_RDWR; - } else if (attrSym == @symbol(CREATE_NEW)) { - flags |= O_CREAT|O_EXCL; - accessMode = 0600; // simulate mkstemp() - } else if (attrSym == @symbol(CREATE_ALWAYS)) { - flags |= O_CREAT|O_TRUNC; - } else if (attrSym == @symbol(OPEN_EXISTING)) { - // nothing to be set - } else if (attrSym == @symbol(OPEN_ALWAYS)) { - flags |= O_CREAT; - } else if (attrSym == @symbol(TRUNCATE_EXISTING)) { - flags |= O_TRUNC; + } else if (attrSym == @symbol(CREATE_NEW)) { + flags |= O_CREAT|O_EXCL; + accessMode = 0600; // simulate mkstemp() + } else if (attrSym == @symbol(CREATE_ALWAYS)) { + flags |= O_CREAT|O_TRUNC; + } else if (attrSym == @symbol(OPEN_EXISTING)) { + // nothing to be set + } else if (attrSym == @symbol(OPEN_ALWAYS)) { + flags |= O_CREAT; + } else if (attrSym == @symbol(TRUNCATE_EXISTING)) { + flags |= O_TRUNC; - } else if (attrSym == @symbol(FILE_ATTRIBUTE_HIDDEN)) { - // ignore - } else if (attrSym == @symbol(FILE_ATTRIBUTE_READONLY)) { - accessMode &= 0444; - } else if (attrSym == @symbol(FILE_FLAG_WRITE_THROUGH)) { + } else if (attrSym == @symbol(FILE_ATTRIBUTE_HIDDEN)) { + // ignore + } else if (attrSym == @symbol(FILE_ATTRIBUTE_READONLY)) { + accessMode &= 0444; + } else if (attrSym == @symbol(FILE_FLAG_WRITE_THROUGH)) { #ifdef O_DIRECT - flags |= O_DIRECT; + flags |= O_DIRECT; #endif - } else if (attrSym == @symbol(FILE_FLAG_SEQUENTIAL_SCAN)) { - // ignore - } else if (attrSym == @symbol(FILE_FLAG_DELETE_ON_CLOSE)) { - // ignore; - } else if (!__isSymbol(attrSym) && __isStringLike(attrSym)) { - __openmode = __stringVal(attrSym); - } else { - console_fprintf(stderr, "UNIXOS [warning]: unsupported open mode\n"); - } - } - } - do { - __BEGIN_INTERRUPTABLE__ - fd = open((char *) __stringVal(encodedPathName), flags, accessMode); - __END_INTERRUPTABLE__ - } while ((fd < 0) && (__threadErrno == EINTR)); + } else if (attrSym == @symbol(FILE_FLAG_SEQUENTIAL_SCAN)) { + // ignore + } else if (attrSym == @symbol(FILE_FLAG_DELETE_ON_CLOSE)) { + // ignore; + } else if (!__isSymbol(attrSym) && __isStringLike(attrSym)) { + __openmode = __stringVal(attrSym); + } else { + console_fprintf(stderr, "UNIXOS [warning]: unsupported open mode\n"); + } + } + } + do { + __BEGIN_INTERRUPTABLE__ + fd = open((char *) __stringVal(encodedPathName), flags, accessMode); + __END_INTERRUPTABLE__ + } while ((fd < 0) && (__threadErrno == EINTR)); - if (fd >= 0) { - __threadErrno = 0; - f = fdopen(fd, __openmode); - if (f == NULL) { - close(fd); // fdopen failed, close before retry. - } - } + if (fd >= 0) { + __threadErrno = 0; + f = fdopen(fd, __openmode); + if (f == NULL) { + close(fd); // fdopen failed, close before retry. + } + } } # endif /* not WIN32 */ @@ -1733,81 +1733,81 @@ if (f == NULL) { - /* - * If no filedescriptors available, try to finalize - * possibly collected fd's and try again. - */ - if ((__threadErrno == ENFILE || __threadErrno == EMFILE) && pass == 0) { - pass = 1; - __SSEND0(@global(ObjectMemory), @symbol(scavenge), 0); - __SSEND0(@global(ObjectMemory), @symbol(finalize), 0); - goto retry; - } + /* + * If no filedescriptors available, try to finalize + * possibly collected fd's and try again. + */ + if ((__threadErrno == ENFILE || __threadErrno == EMFILE) && pass == 0) { + pass = 1; + __SSEND0(@global(ObjectMemory), @symbol(scavenge), 0); + __SSEND0(@global(ObjectMemory), @symbol(finalize), 0); + goto retry; + } badArgument: getOutOfHere: - error = __mkSmallInteger(__threadErrno); - __INST(position) = nil; + error = __mkSmallInteger(__threadErrno); + __INST(position) = nil; } else { #ifdef __VMS__ - /* - * check to see if this is positionable ... - */ - __INST(canPosition) = false; + /* + * check to see if this is positionable ... + */ + __INST(canPosition) = false; # ifndef _POSIX_C_SOURCE - { - struct stat statBuffer; + { + struct stat statBuffer; - if (fstat(fileno(f), &statBuffer) >= 0) { - switch (statBuffer.st_fab_rfm) { - case FAB$C_UDF: /* undefined (also stream binary) */ - case FAB$C_VAR: /* variable length records */ - case FAB$C_VFC: /* variable fixed control */ - case FAB$C_STM: /* RMS-11 stream (valid only for sequen) */ - default: - __INST(canPosition) = false; - break; + if (fstat(fileno(f), &statBuffer) >= 0) { + switch (statBuffer.st_fab_rfm) { + case FAB$C_UDF: /* undefined (also stream binary) */ + case FAB$C_VAR: /* variable length records */ + case FAB$C_VFC: /* variable fixed control */ + case FAB$C_STM: /* RMS-11 stream (valid only for sequen) */ + default: + __INST(canPosition) = false; + break; - case FAB$C_FIX: /* fixed length records */ - case FAB$C_STMLF: /* LF stream (valid only for sequential) */ - case FAB$C_STMCR: /* CR stream (valid only for sequential) */ - __INST(canPosition) = true; - break; - } - } - } + case FAB$C_FIX: /* fixed length records */ + case FAB$C_STMLF: /* LF stream (valid only for sequential) */ + case FAB$C_STMCR: /* CR stream (valid only for sequential) */ + __INST(canPosition) = true; + break; + } + } + } # endif #else /* not VMS */ - __INST(canPosition) = true; + __INST(canPosition) = true; #endif /* not VMS */ - if (@global(FileOpenTrace) == true) { - console_fprintf(stderr, "fopen %s [FileStream] -> %"_lx_"\n", __stringVal(pathName), (INT)f); - } - if (f != NULL) { - OBJ fp; + if (@global(FileOpenTrace) == true) { + console_fprintf(stderr, "fopen %s [FileStream] -> %"_lx_"\n", __stringVal(pathName), (INT)f); + } + if (f != NULL) { + OBJ fp; - wasBlocked = __BLOCKINTERRUPTS(); + wasBlocked = __BLOCKINTERRUPTS(); #if 0 - // The original code was: - __INST(handle) = fp = __MKEXTERNALADDRESS(f); __STORE(self, fp); - // but for that, gcc generates wrong code, which loads self (volatile) into - // a register (bp), then calls __MKEXTERNALADDRESS, then stores indirect bp. - // That is wrong if a scavenge occurs in __MKEXTERNALADDRESS, as bp is now still pointing to the old - // object. + // The original code was: + __INST(handle) = fp = __MKEXTERNALADDRESS(f); __STORE(self, fp); + // but for that, gcc generates wrong code, which loads self (volatile) into + // a register (bp), then calls __MKEXTERNALADDRESS, then stores indirect bp. + // That is wrong if a scavenge occurs in __MKEXTERNALADDRESS, as bp is now still pointing to the old + // object. #else - fp = __MKEXTERNALADDRESS(f); - __INST(handle) = fp; - __STORE(self, fp); + fp = __MKEXTERNALADDRESS(f); + __INST(handle) = fp; + __STORE(self, fp); #endif - } + } } %}. error notNil ifTrue:[ - lastErrorNumber := error. - ^ self openError:error. + lastErrorNumber := error. + ^ self openError:error. ]. handle isNil ifTrue:[ - ^ self openError:0. + ^ self openError:0. ]. position := 0. @@ -1917,37 +1917,37 @@ sent after snapin to reopen streams." handle notNil ifTrue:[ - "it was open, when snapped-out" - handle := nil. - self unregisterForFinalization. - pathName isNil ifTrue:[ - ^ self. - ]. - [ - |oldPos| + "it was open, when snapped-out" + handle := nil. + self unregisterForFinalization. + pathName isNil ifTrue:[ + ^ self. + ]. + [ + |oldPos| - "should take care of appending files and open them for - append / position them to the end" + "should take care of appending files and open them for + append / position them to the end" - oldPos := position. + oldPos := position. - mode == #readonly ifTrue: [ - self openForReading - ] ifFalse:[mode == #writeonly ifTrue: [ - self openForWriting. - ] ifFalse:[ - self openForReadWrite. - ]]. + mode == #readonly ifTrue: [ + self openForReading + ] ifFalse:[mode == #writeonly ifTrue: [ + self openForWriting. + ] ifFalse:[ + self openForReadWrite. + ]]. - oldPos notNil ifTrue:[ - self position:oldPos. - ] - ] on:OpenError do:[:ex| - "this happens, if after a restart, - the file is no longer present or accessible ..." + oldPos notNil ifTrue:[ + self position:oldPos. + ] + ] on:OpenError do:[:ex| + "this happens, if after a restart, + the file is no longer present or accessible ..." - (self class name , ' [warning]: could not reopen file: ', pathName) errorPrintCR. - ]. + (self class name , ' [warning]: could not reopen file: ', pathName) errorPrintCR. + ]. ] "Modified: 10.1.1997 / 17:50:51 / cg"
--- a/Float.st Sun May 15 08:38:43 2016 +0100 +++ b/Float.st Tue May 17 10:05:14 2016 +0100 @@ -50,25 +50,25 @@ extern errno; #endif -#if !defined (WIN32) +#if !defined (__win32__) # include <locale.h> #endif -#if defined (_AIX) +#if defined (__aix__) # include <float.h> #endif -#if defined(IRIX) +#if defined(__irix__) # include <nan.h> #endif -#if defined(LINUX) +#if defined(__linux__) # ifndef NAN # include <bits/nan.h> # endif #endif -#if defined(solaris) || defined(sunos) +#if defined(__solaris__) || defined(__sunos__) # include <nan.h> #endif @@ -77,7 +77,7 @@ * (AIX even declares them as macros, so an external decl * will not work below ... */ -#if !defined(_AIX) && !defined(NEXT3) +#if !defined(__aix__) && !defined(NEXT3) # ifdef acos double acos(); @@ -117,7 +117,7 @@ #endif /* not AIX */ -#ifdef WIN32 +#ifdef __win32__ /* * no finite(x) ? * no isnan(x) ? @@ -158,7 +158,7 @@ # include <string.h> # endif -#endif /* WIN32 */ +#endif /* __win32__ */ #ifdef solaris # ifndef isfinite @@ -1197,7 +1197,7 @@ double dVal; dVal = __floatVal(self); -#ifdef WIN32 +#ifdef __win32__ if (! isnan(dVal)) #endif { @@ -1672,15 +1672,12 @@ %{ /* NOCONTEXT */ -#ifndef WIN32 /* seems to be not avail. in WIN32 math lib */ +#ifndef __win32__ /* seems to be not avail. in WIN32 math lib */ double val, rslt; OBJ newFloat; val = __floatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ - if (val >= 0.0) -# endif { __threadErrno = 0; rslt = cbrt(val); @@ -1744,9 +1741,9 @@ val = __floatVal(self); -#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val > 0.0) -#endif +# endif { __threadErrno = 0; rslt = log(val); @@ -1787,9 +1784,9 @@ val = __floatVal(self); -#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val > 0.0) -#endif +# endif { __threadErrno = 0; rslt = log10(val); @@ -1870,7 +1867,7 @@ val = __floatVal(self); -#ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +#ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val >= 0.0) #endif { @@ -2555,7 +2552,7 @@ val = __floatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if ((val >= -1.0) && (val <= 1.0)) # endif { @@ -2600,7 +2597,7 @@ val = __floatVal(self); -# ifdef WIN32 /* don't know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val >= 1.0) # endif { @@ -2649,7 +2646,7 @@ val = __floatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if ((val >= -1.0) && (val <= 1.0)) # endif { @@ -2693,7 +2690,7 @@ val = __floatVal(self); -# ifdef WIN32 /* don't know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val >= 1.0) # endif { @@ -2821,15 +2818,15 @@ __threadErrno = 0; val = __floatVal(self); -# ifdef WIN32 /* don't know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if ((val >= -1.0) && (val <= 1.0)) # endif { rslt = atanh(__floatVal(self)); if (! isnan(rslt)) /* Currently all our systems support isnan() */ -#ifdef __osx__ +# ifdef __osx__ if (! isinf(rslt)) -#endif +# endif { if (__threadErrno == 0) { __qMKFLOAT(newFloat, rslt);
--- a/KeyedCollection.st Sun May 15 08:38:43 2016 +0100 +++ b/KeyedCollection.st Tue May 17 10:05:14 2016 +0100 @@ -170,7 +170,8 @@ removeKey:aKey ifAbsent:exceptionBlock "remove key (and the value stored under that key) from the - receiver; if no such element is contained, return the value + receiver; return the value which was stored previously there. + If no such element is contained, return the value from evaluating exceptionBlock" ^ self subclassResponsibility
--- a/LargeInteger.st Sun May 15 08:38:43 2016 +0100 +++ b/LargeInteger.st Tue May 17 10:05:14 2016 +0100 @@ -260,9 +260,9 @@ |digits| msb == false ifTrue:[ - digits := aByteArrayOfDigits + digits := aByteArrayOfDigits ] ifFalse:[ - digits := aByteArrayOfDigits reversed + digits := aByteArrayOfDigits reversed ]. ^ self basicNew setDigits:digits @@ -1654,7 +1654,7 @@ %}. l := digitByteArray size. [l ~~ 0 and:[(digitByteArray at:l) == 0]] whileTrue:[ - l := l - 1. + l := l - 1. ]. ^ l @@ -2207,13 +2207,13 @@ sz := digitByteArray size. (sz <= SmallInteger maxBytes and:[self absLess:SmallInteger maxVal]) ifTrue:[ - "I am really an unnormalized SmallInteger, answer the same hash as for the SmallInteger" - ^ self bitAnd:SmallInteger maxVal. + "I am really an unnormalized SmallInteger, answer the same hash as for the SmallInteger" + ^ self bitAnd:SmallInteger maxVal. ]. h := digitByteArray computeXorHashFrom:1 to:8. "/ the low 8 bytes sz > 8 ifTrue:[ "/ the high 8 bytes - h := h bitXor:(digitByteArray computeXorHashFrom:sz-8 to:sz). + h := h bitXor:(digitByteArray computeXorHashFrom:sz-8 to:sz). ]. ^ h @@ -2451,7 +2451,7 @@ _l -= 4; } # else /* not GNU-i386 */ -# if defined(WIN32) && defined(__BORLANDC__) && defined(__i386__) && (__POINTER_SIZE__ == 4) +# if defined(__win32__) && defined(__BORLANDC__) && defined(__x86__) && (__POINTER_SIZE__ == 4) /* * can do it long-word-wise; * 32*32 -> 64 multiplication @@ -3327,7 +3327,7 @@ ((aSmallInteger < (SmallInteger minVal + 255)) or:[aSmallInteger > (SmallInteger maxVal - 255)]) ifTrue:[ - ^ self absMinus:(self class value:aSmallInteger) sign:newSign. + ^ self absMinus:(self class value:aSmallInteger) sign:newSign. ]. len := digitByteArray size. @@ -3341,133 +3341,133 @@ %{ if (__isByteArray(__INST(digitByteArray)) && __isByteArray(resultDigitByteArray)) { - unsigned INT __borrow = __intVal(borrow); - INT __diff; - int __index = 1; - int __len = __intVal(len); - unsigned char *__digitP = __ByteArrayInstPtr(__INST(digitByteArray))->ba_element; - unsigned char *__resultP = __ByteArrayInstPtr(resultDigitByteArray)->ba_element; - int __len3; + unsigned INT __borrow = __intVal(borrow); + INT __diff; + int __index = 1; + int __len = __intVal(len); + unsigned char *__digitP = __ByteArrayInstPtr(__INST(digitByteArray))->ba_element; + unsigned char *__resultP = __ByteArrayInstPtr(resultDigitByteArray)->ba_element; + int __len3; #if defined(__LSBFIRST__) # if (__POINTER_SIZE__ == 8) - /* - * subtract int-wise - */ - __len3 = __len - 3; - while (__index < __len3) { - /* do not make this into one expression - ask cg why */ - __diff = ((unsigned int *)(__digitP + __index-1))[0]; - __diff -= (__borrow & 0xFFFFFFFFL); - __borrow >>= 32; - ((unsigned int *)(__resultP+__index-1))[0] = __diff; - __index += 4; - if (__diff < 0) { - /* __diff += 0x100000000; */ - __borrow++; - } else { - if (__borrow == 0) { - /* nothing more to subtract .. */ - while (__index < __len3) { - ((unsigned int *)(__resultP+__index-1))[0] = ((unsigned int *)(__digitP+__index-1))[0]; - __index += 4; - } - if (__index < __len) { - ((unsigned short *)(__resultP+__index-1))[0] = ((unsigned short *)(__digitP+__index-1))[0]; - __index += 2; - } - if (__index <= __len) { - __resultP[__index-1] = __digitP[__index-1]; - } - break; - } - } - } + /* + * subtract int-wise + */ + __len3 = __len - 3; + while (__index < __len3) { + /* do not make this into one expression - ask cg why */ + __diff = ((unsigned int *)(__digitP + __index-1))[0]; + __diff -= (__borrow & 0xFFFFFFFFL); + __borrow >>= 32; + ((unsigned int *)(__resultP+__index-1))[0] = __diff; + __index += 4; + if (__diff < 0) { + /* __diff += 0x100000000; */ + __borrow++; + } else { + if (__borrow == 0) { + /* nothing more to subtract .. */ + while (__index < __len3) { + ((unsigned int *)(__resultP+__index-1))[0] = ((unsigned int *)(__digitP+__index-1))[0]; + __index += 4; + } + if (__index < __len) { + ((unsigned short *)(__resultP+__index-1))[0] = ((unsigned short *)(__digitP+__index-1))[0]; + __index += 2; + } + if (__index <= __len) { + __resultP[__index-1] = __digitP[__index-1]; + } + break; + } + } + } # endif - /* - * subtract short-wise - */ - while (__index < __len) { - /* do not make this into one expression - ask cg why */ - __diff = ((unsigned short *)(__digitP+__index-1))[0]; - __diff -= (__borrow & 0xFFFF); - __borrow >>= 16; - ((unsigned short *)(__resultP+__index-1))[0] = __diff; - __index += 2; - if (__diff < 0) { - /* __diff += 0x10000; */ - __borrow++; - } else { - if (__borrow == 0) { - /* nothing more to subtract .. */ - while (__index < __len) { - ((unsigned short *)(__resultP+__index-1))[0] = ((unsigned short *)(__digitP+__index-1))[0]; - __index += 2; - } - if (__index <= __len) { - __resultP[__index-1] = __digitP[__index-1]; - } - break; - } - } - } + /* + * subtract short-wise + */ + while (__index < __len) { + /* do not make this into one expression - ask cg why */ + __diff = ((unsigned short *)(__digitP+__index-1))[0]; + __diff -= (__borrow & 0xFFFF); + __borrow >>= 16; + ((unsigned short *)(__resultP+__index-1))[0] = __diff; + __index += 2; + if (__diff < 0) { + /* __diff += 0x10000; */ + __borrow++; + } else { + if (__borrow == 0) { + /* nothing more to subtract .. */ + while (__index < __len) { + ((unsigned short *)(__resultP+__index-1))[0] = ((unsigned short *)(__digitP+__index-1))[0]; + __index += 2; + } + if (__index <= __len) { + __resultP[__index-1] = __digitP[__index-1]; + } + break; + } + } + } #endif - /* - * subtract byte-wise - */ - while (__index <= __len) { - __diff = __digitP[__index-1]; - __diff -= (__borrow & 0xFF); - __borrow >>= 8; - __resultP[__index-1] = __diff; - __index++; - if (__diff < 0) { - /* __diff += 0x100; */ - __borrow++; - } else { - if (__borrow == 0) { - /* nothing more to subtract .. */ - while (__index <= __len) { - __resultP[__index-1] = __digitP[__index-1]; - __index++; - } - break; - } - } - } - lastDigit = __mkSmallInteger( __resultP[__index-1-1] ); - ok = true; + /* + * subtract byte-wise + */ + while (__index <= __len) { + __diff = __digitP[__index-1]; + __diff -= (__borrow & 0xFF); + __borrow >>= 8; + __resultP[__index-1] = __diff; + __index++; + if (__diff < 0) { + /* __diff += 0x100; */ + __borrow++; + } else { + if (__borrow == 0) { + /* nothing more to subtract .. */ + while (__index <= __len) { + __resultP[__index-1] = __digitP[__index-1]; + __index++; + } + break; + } + } + } + lastDigit = __mkSmallInteger( __resultP[__index-1-1] ); + ok = true; } %}. ok == true ifFalse:[ "/ cannot happen - index := 1. - [borrow ~~ 0] whileTrue:[ - (index <= len) ifTrue:[ - diff := (digitByteArray basicAt:index) - (borrow bitAnd:16rFF). - borrow := borrow bitShift:-8. - diff < 0 ifTrue:[ - diff := diff + 256. - borrow := borrow + 1. - ] - ] ifFalse:[ - diff := borrow bitAnd:255. - borrow := borrow bitShift:-8. - ]. - resultDigitByteArray basicAt:index put:(lastDigit := diff). - index := index + 1 - ]. - [index <= len] whileTrue:[ - resultDigitByteArray basicAt:index put:(lastDigit := digitByteArray basicAt:index). - index := index + 1 - ]. - (index <= rsltLen) ifTrue:[ - lastDigit := 0. - ] + index := 1. + [borrow ~~ 0] whileTrue:[ + (index <= len) ifTrue:[ + diff := (digitByteArray basicAt:index) - (borrow bitAnd:16rFF). + borrow := borrow bitShift:-8. + diff < 0 ifTrue:[ + diff := diff + 256. + borrow := borrow + 1. + ] + ] ifFalse:[ + diff := borrow bitAnd:255. + borrow := borrow bitShift:-8. + ]. + resultDigitByteArray basicAt:index put:(lastDigit := diff). + index := index + 1 + ]. + [index <= len] whileTrue:[ + resultDigitByteArray basicAt:index put:(lastDigit := digitByteArray basicAt:index). + index := index + 1 + ]. + (index <= rsltLen) ifTrue:[ + lastDigit := 0. + ] ]. (lastDigit == 0 or:[rsltLen <= SmallInteger maxBytes]) ifTrue:[ - ^ result compressed. + ^ result compressed. ]. ^ result @@ -3502,7 +3502,7 @@ ((aSmallInteger < (SmallInteger minVal + 255)) or:[aSmallInteger > (SmallInteger maxVal - 255)]) ifTrue:[ - ^ self absPlus:(self class value:aSmallInteger) sign:newSign. + ^ self absPlus:(self class value:aSmallInteger) sign:newSign. ]. len := rsltLen := digitByteArray size. @@ -3511,18 +3511,18 @@ "/ if it is 255 (since the other number is definitely smaller) "/ (digitByteArray at:len) == 16rFF ifTrue:[ - rsltLen := len + 1. + rsltLen := len + 1. ] ifFalse:[ - "/ or the argument has something in the high byte .. + "/ or the argument has something in the high byte .. %{ #if __POINTER_SIZE__ == 8 - if (__intVal(aSmallInteger) & 0xFF00000000000000L) { - rsltLen = __mkSmallInteger(__intVal(len) + 1); - } + if (__intVal(aSmallInteger) & 0xFF00000000000000L) { + rsltLen = __mkSmallInteger(__intVal(len) + 1); + } #else - if (__intVal(aSmallInteger) & 0xFF000000) { - rsltLen = __mkSmallInteger(__intVal(len) + 1); - } + if (__intVal(aSmallInteger) & 0xFF000000) { + rsltLen = __mkSmallInteger(__intVal(len) + 1); + } #endif %} ]. @@ -3534,309 +3534,309 @@ if (__isByteArray(__INST(digitByteArray)) && __isByteArray(resultDigitByteArray) && __isSmallInteger(aSmallInteger)) { - /* carry is NOT unsigned (see negation below) */ - INT __carry = __intVal(aSmallInteger); - int __index = 1; - int __len = __intVal(len); - unsigned char *__src = (unsigned char *)(__ByteArrayInstPtr(__INST(digitByteArray))->ba_element); - unsigned char *__dst = (unsigned char *)(__ByteArrayInstPtr(resultDigitByteArray)->ba_element); - INT __ptrDelta = __dst - __src; - unsigned char *__srcLast = __src + __len - 1; - int __rsltLen = __intVal(rsltLen); - - if (__carry < 0) { - __carry = -__carry; - } + /* carry is NOT unsigned (see negation below) */ + INT __carry = __intVal(aSmallInteger); + int __index = 1; + int __len = __intVal(len); + unsigned char *__src = (unsigned char *)(__ByteArrayInstPtr(__INST(digitByteArray))->ba_element); + unsigned char *__dst = (unsigned char *)(__ByteArrayInstPtr(resultDigitByteArray)->ba_element); + INT __ptrDelta = __dst - __src; + unsigned char *__srcLast = __src + __len - 1; + int __rsltLen = __intVal(rsltLen); + + if (__carry < 0) { + __carry = -__carry; + } #if defined(__LSBFIRST__) # if defined(__i386__) && defined(__GNUC__) && (__POINTER_SIZE__ == 4) # if 0 /* NOTICE - the code below is 20% slower ... - why */ - /* - * add long-wise - */ - asm(" jecxz nothingToDo \n\ - movl %%eax, %%esi /* __src input */ \n\ - movl %%ebx, %%edi /* __dst input */ \n\ - \n\ - /* the first 4-byte int */ \n\ - lodsl /* fetch */ \n\ - addl %%edx, %%eax /* add */ \n\ - stosl /* store */ \n\ - leal -1(%%ecx),%%ecx /* do not clobber carry */ \n\ - jecxz doneLoop /* any more ? */ \n\ - /* remaining 4-byte ints */ \n\ - jmp addLoop \n\ - \n\ - .align 8 \n\ - addLoop: \n\ - movl 0(%%esi), %%ebx /* fetch */ \n\ - jnc copyLoop2 \n\ - movl $0, %%eax \n\ - leal 4(%%esi), %%esi \n\ - adcl %%ebx, %%eax /* & add carry from prev int */\n\ - leal 8(%%edi), %%edi \n\ - movl %%eax, -8(%%edi) /* store */ \n\ - leal -1(%%ecx),%%ecx /* do not clobber carry */ \n\ - jecxz doneLoop /* any more ? */ \n\ - \n\ - movl 0(%%esi), %%ebx /* fetch */ \n\ - movl $0, %%eax \n\ - leal 4(%%esi), %%esi \ - adcl %%ebx, %%eax /* & add carry from prev int */\n\ - movl %%eax, -4(%%edi) /* store */ \n\ - \n\ - loop addLoop \n\ - jmp doneLoop \n\ - \n\ - .align 8 \n\ - copyLoop: \n\ - movl 0(%%esi), %%ebx \n\ - copyLoop2: \n\ - add $4, %%esi \n\ - add $4, %%edi \n\ - movl %%ebx, -4(%%edi) \n\ - loop copyLoop \n\ - \n\ - doneLoop: \n\ - movl $0, %%edx /* do not clobber carry (xorl clears it) */ \n\ - adcl $0, %%edx \n\ - movl %%esi, %%eax /* __src output */ \n\ - nothingToDo: \n\ - " : "=d" ((unsigned long)(__carry)), - "=a" (__src) - : "1" (__src), - "b" (__dst), - "c" (__len / 4), - "0" (__carry) - : "esi", "edi"); + /* + * add long-wise + */ + asm(" jecxz nothingToDo \n\ + movl %%eax, %%esi /* __src input */ \n\ + movl %%ebx, %%edi /* __dst input */ \n\ + \n\ + /* the first 4-byte int */ \n\ + lodsl /* fetch */ \n\ + addl %%edx, %%eax /* add */ \n\ + stosl /* store */ \n\ + leal -1(%%ecx),%%ecx /* do not clobber carry */ \n\ + jecxz doneLoop /* any more ? */ \n\ + /* remaining 4-byte ints */ \n\ + jmp addLoop \n\ + \n\ + .align 8 \n\ + addLoop: \n\ + movl 0(%%esi), %%ebx /* fetch */ \n\ + jnc copyLoop2 \n\ + movl $0, %%eax \n\ + leal 4(%%esi), %%esi \n\ + adcl %%ebx, %%eax /* & add carry from prev int */\n\ + leal 8(%%edi), %%edi \n\ + movl %%eax, -8(%%edi) /* store */ \n\ + leal -1(%%ecx),%%ecx /* do not clobber carry */ \n\ + jecxz doneLoop /* any more ? */ \n\ + \n\ + movl 0(%%esi), %%ebx /* fetch */ \n\ + movl $0, %%eax \n\ + leal 4(%%esi), %%esi \ + adcl %%ebx, %%eax /* & add carry from prev int */\n\ + movl %%eax, -4(%%edi) /* store */ \n\ + \n\ + loop addLoop \n\ + jmp doneLoop \n\ + \n\ + .align 8 \n\ + copyLoop: \n\ + movl 0(%%esi), %%ebx \n\ + copyLoop2: \n\ + add $4, %%esi \n\ + add $4, %%edi \n\ + movl %%ebx, -4(%%edi) \n\ + loop copyLoop \n\ + \n\ + doneLoop: \n\ + movl $0, %%edx /* do not clobber carry (xorl clears it) */ \n\ + adcl $0, %%edx \n\ + movl %%esi, %%eax /* __src output */ \n\ + nothingToDo: \n\ + " : "=d" ((unsigned long)(__carry)), + "=a" (__src) + : "1" (__src), + "b" (__dst), + "c" (__len / 4), + "0" (__carry) + : "esi", "edi"); # else - { - unsigned char *__srcLastX; - - __srcLastX = __srcLast - 3 - 4; - while (__src <= __srcLastX) { - unsigned int __sum, __sum2; - unsigned __digit1, __digit2; - - __digit1 = ((unsigned *)__src)[0]; - __digit2 = ((unsigned *)__src)[1]; - asm ("addl %%edx,%%ecx \n\ - adcl $0, %%eax \n\ - movl $0, %%edx \n\ - adcl $0, %%edx" - : "=d" ((unsigned long)(__carry)), - "=c" ((unsigned long)(__sum)), - "=a" ((unsigned long)(__sum2)) - : "0" ((unsigned long)(__carry)), - "1" (__digit1), - "2" (__digit2)); - - ((unsigned int *)(__src + __ptrDelta))[0] = __sum; - ((unsigned int *)(__src + __ptrDelta))[1] = __sum2; - - __src += 8; - - if (__carry == 0) { - while (__src <= __srcLastX) { - /* copy over words */ - ((unsigned int *)(__src + __ptrDelta))[0] = ((unsigned int *)__src)[0]; - ((unsigned int *)(__src + __ptrDelta))[1] = ((unsigned int *)__src)[1]; - __src += 8; - } - while (__src <= __srcLast) { - /* copy over bytes */ - __src[__ptrDelta] = __src[0]; - __src ++; - } - goto doneSource; - } - } - - __srcLastX = __srcLastX + 4; - if (__src <= __srcLastX) { - unsigned int __sum, __digit; - - __digit = ((unsigned *)__src)[0]; - - asm ("addl %%eax,%%edx \n\ - movl $0,%%eax \n\ - adcl $0,%%eax" - : "=a" ((unsigned long)(__carry)), - "=d" ((unsigned long)(__sum)) - : "0" ((unsigned long)(__carry)), - "1" (__digit) ); - - ((unsigned int *)(__src + __ptrDelta))[0] = __sum; - __src += 4; - - if (__carry == 0) { - while (__src <= __srcLast) { - /* copy over bytes */ - __src[__ptrDelta] = __src[0]; - __src ++; - } - goto doneSource; - } - } - } + { + unsigned char *__srcLastX; + + __srcLastX = __srcLast - 3 - 4; + while (__src <= __srcLastX) { + unsigned int __sum, __sum2; + unsigned __digit1, __digit2; + + __digit1 = ((unsigned *)__src)[0]; + __digit2 = ((unsigned *)__src)[1]; + asm ("addl %%edx,%%ecx \n\ + adcl $0, %%eax \n\ + movl $0, %%edx \n\ + adcl $0, %%edx" + : "=d" ((unsigned long)(__carry)), + "=c" ((unsigned long)(__sum)), + "=a" ((unsigned long)(__sum2)) + : "0" ((unsigned long)(__carry)), + "1" (__digit1), + "2" (__digit2)); + + ((unsigned int *)(__src + __ptrDelta))[0] = __sum; + ((unsigned int *)(__src + __ptrDelta))[1] = __sum2; + + __src += 8; + + if (__carry == 0) { + while (__src <= __srcLastX) { + /* copy over words */ + ((unsigned int *)(__src + __ptrDelta))[0] = ((unsigned int *)__src)[0]; + ((unsigned int *)(__src + __ptrDelta))[1] = ((unsigned int *)__src)[1]; + __src += 8; + } + while (__src <= __srcLast) { + /* copy over bytes */ + __src[__ptrDelta] = __src[0]; + __src ++; + } + goto doneSource; + } + } + + __srcLastX = __srcLastX + 4; + if (__src <= __srcLastX) { + unsigned int __sum, __digit; + + __digit = ((unsigned *)__src)[0]; + + asm ("addl %%eax,%%edx \n\ + movl $0,%%eax \n\ + adcl $0,%%eax" + : "=a" ((unsigned long)(__carry)), + "=d" ((unsigned long)(__sum)) + : "0" ((unsigned long)(__carry)), + "1" (__digit) ); + + ((unsigned int *)(__src + __ptrDelta))[0] = __sum; + __src += 4; + + if (__carry == 0) { + while (__src <= __srcLast) { + /* copy over bytes */ + __src[__ptrDelta] = __src[0]; + __src ++; + } + goto doneSource; + } + } + } # endif # else /* not i386-GNUC */ -# if defined(WIN32) && defined(__BORLANDC__) && defined(__i386__) && (__POINTER_SIZE__ == 4) - { - unsigned char *__srcLast4; - - /* - * add long-wise - */ - __srcLast4 = __srcLast - 3; - while (__src <= __srcLast4) { - unsigned int __sum; - - __sum = ((unsigned int *)__src)[0]; - asm { - mov eax, __sum - add eax, __carry - mov edx, 0 - adc edx, 0 - mov __sum, eax - mov __carry, edx - } - - ((unsigned int *)(__src + __ptrDelta))[0] = __sum; - __src += 4; - if (__carry == 0) { - while (__src <= __srcLast4) { - /* copy over words */ - ((unsigned int *)(__src + __ptrDelta))[0] = ((unsigned int *)__src)[0]; - __src += 4; - } - while (__src <= __srcLast) { - /* copy over bytes */ - __src[__ptrDelta] = __src[0]; - __src ++; - } - goto doneSource; - } - } - } +# if defined(__win32__) && defined(__BORLANDC__) && defined(__x86__) && (__POINTER_SIZE__ == 4) + { + unsigned char *__srcLast4; + + /* + * add long-wise + */ + __srcLast4 = __srcLast - 3; + while (__src <= __srcLast4) { + unsigned int __sum; + + __sum = ((unsigned int *)__src)[0]; + asm { + mov eax, __sum + add eax, __carry + mov edx, 0 + adc edx, 0 + mov __sum, eax + mov __carry, edx + } + + ((unsigned int *)(__src + __ptrDelta))[0] = __sum; + __src += 4; + if (__carry == 0) { + while (__src <= __srcLast4) { + /* copy over words */ + ((unsigned int *)(__src + __ptrDelta))[0] = ((unsigned int *)__src)[0]; + __src += 4; + } + while (__src <= __srcLast) { + /* copy over bytes */ + __src[__ptrDelta] = __src[0]; + __src ++; + } + goto doneSource; + } + } + } # else /* not i386-WIN32 */ # if defined(__LSBFIRST__) && (__POINTER_SIZE__ == 8) - { - unsigned char *__srcLast4; - - /* - * add long-wise - */ - __srcLast4 = __srcLast - 3; - while (__src <= __srcLast4) { - unsigned INT __sum; - - __sum = (INT)(((unsigned int *)__src)[0]); - __sum += __carry; - ((unsigned int *)(__src + __ptrDelta))[0] = __sum /* & 0xFFFF */; - __src += 4; - __carry = __sum >> 32; - if (__carry == 0) { - while (__src <= __srcLast4) { - /* copy over words */ - ((unsigned int *)(__src + __ptrDelta))[0] = ((unsigned int *)__src)[0]; - __src += 4; - } - while (__src <= __srcLast) { - /* copy over bytes */ - __src[__ptrDelta] = __src[0]; - __src ++; - } - goto doneSource; - } - } - } + { + unsigned char *__srcLast4; + + /* + * add long-wise + */ + __srcLast4 = __srcLast - 3; + while (__src <= __srcLast4) { + unsigned INT __sum; + + __sum = (INT)(((unsigned int *)__src)[0]); + __sum += __carry; + ((unsigned int *)(__src + __ptrDelta))[0] = __sum /* & 0xFFFF */; + __src += 4; + __carry = __sum >> 32; + if (__carry == 0) { + while (__src <= __srcLast4) { + /* copy over words */ + ((unsigned int *)(__src + __ptrDelta))[0] = ((unsigned int *)__src)[0]; + __src += 4; + } + while (__src <= __srcLast) { + /* copy over bytes */ + __src[__ptrDelta] = __src[0]; + __src ++; + } + goto doneSource; + } + } + } # endif /* LSB+64bit */ # endif /* __i386__ & WIN32 */ # endif /* __i386__ & GNUC */ - /* - * add short-wise - */ - while (__src < __srcLast) { - __carry += ((unsigned short *)__src)[0]; - ((unsigned short *)(__src + __ptrDelta))[0] = __carry /* & 0xFFFF */; - __carry >>= 16; - __src += 2; - } - /* - * last (odd) byte - */ - if (__src <= __srcLast) { - __carry += __src[0]; - __src[__ptrDelta] = __carry /* & 0xFF */; - __carry >>= 8; - __src++; - } + /* + * add short-wise + */ + while (__src < __srcLast) { + __carry += ((unsigned short *)__src)[0]; + ((unsigned short *)(__src + __ptrDelta))[0] = __carry /* & 0xFFFF */; + __carry >>= 16; + __src += 2; + } + /* + * last (odd) byte + */ + if (__src <= __srcLast) { + __carry += __src[0]; + __src[__ptrDelta] = __carry /* & 0xFF */; + __carry >>= 8; + __src++; + } #else /* not __LSBFIRST__ */ - /* - * add byte-wise - */ - while (__src <= __srcLast) { - __carry += __src[0]; - __src[__ptrDelta] = __carry /* & 0xFF */; - __src++; - __carry >>= 8; - - if (__carry == 0) { - while (__src <= __srcLast) { - /* copy over rest */ - __src[__ptrDelta] = __src[0]; - __src++; - } - goto doneSource; - } - } + /* + * add byte-wise + */ + while (__src <= __srcLast) { + __carry += __src[0]; + __src[__ptrDelta] = __carry /* & 0xFF */; + __src++; + __carry >>= 8; + + if (__carry == 0) { + while (__src <= __srcLast) { + /* copy over rest */ + __src[__ptrDelta] = __src[0]; + __src++; + } + goto doneSource; + } + } #endif /* __LSBFIRST__ */ doneSource: ; - /* - * now, at most one other byte is to be stored ... - */ - if (__len < __rsltLen) { - __src[__ptrDelta] = __carry /* & 0xFF */; - __src++; - } - - if (__src[__ptrDelta-1] != 0) { /* lastDigit */ - RETURN (result); - } - // must compress - ok = true; + /* + * now, at most one other byte is to be stored ... + */ + if (__len < __rsltLen) { + __src[__ptrDelta] = __carry /* & 0xFF */; + __src++; + } + + if (__src[__ptrDelta-1] != 0) { /* lastDigit */ + RETURN (result); + } + // must compress + ok = true; } %}. ok ~~ true ifTrue:[ - index := 1. - carry := aSmallInteger abs. - - [carry ~~ 0] whileTrue:[ - (index <= len) ifTrue:[ - carry := (digitByteArray basicAt:index) + carry. - ]. - resultDigitByteArray basicAt:index put:(lastDigit := carry bitAnd:16rFF). - carry := carry bitShift:-8. - index := index + 1 - ]. - - (index <= rsltLen) ifTrue:[ - [index <= len] whileTrue:[ - resultDigitByteArray basicAt:index put:(digitByteArray basicAt:index). - index := index + 1 - ]. - lastDigit := 0. - ]. - - (lastDigit ~~ 0 and:[rsltLen > SmallInteger maxBytes]) ifTrue:[ - ^ result - ]. + index := 1. + carry := aSmallInteger abs. + + [carry ~~ 0] whileTrue:[ + (index <= len) ifTrue:[ + carry := (digitByteArray basicAt:index) + carry. + ]. + resultDigitByteArray basicAt:index put:(lastDigit := carry bitAnd:16rFF). + carry := carry bitShift:-8. + index := index + 1 + ]. + + (index <= rsltLen) ifTrue:[ + [index <= len] whileTrue:[ + resultDigitByteArray basicAt:index put:(digitByteArray basicAt:index). + index := index + 1 + ]. + lastDigit := 0. + ]. + + (lastDigit ~~ 0 and:[rsltLen > SmallInteger maxBytes]) ifTrue:[ + ^ result + ]. ]. ^ result compressed @@ -5008,7 +5008,7 @@ } } # endif /* __i386__ && GNUC */ -# if defined(WIN32) && defined(__BORLANDC__) && defined(__i386__) && (__POINTER_SIZE__ == 4) +# if defined(__win32__) && defined(__BORLANDC__) && defined(__x86__) && (__POINTER_SIZE__ == 4) { int _comLen3; @@ -5515,7 +5515,7 @@ numberOfDigits:nDigits "allocate space for nDigits bytes of magnitude" - + digitByteArray := ByteArray new:nDigits. sign := 1. ! @@ -5529,7 +5529,7 @@ setDigits:digits "set the digits from the lsb-ordered digit-bytes" - + digitByteArray := digits. sign := 1. !
--- a/LongFloat.st Sun May 15 08:38:43 2016 +0100 +++ b/LongFloat.st Tue May 17 10:05:14 2016 +0100 @@ -40,25 +40,25 @@ extern errno; #endif -#if !defined (WIN32) +#if !defined (__win32__) # include <locale.h> #endif -#if defined (_AIX) +#if defined (__aix__) # include <float.h> #endif -#if defined(IRIX) || defined(solaris) || defined(sunos) +#if defined(__irix__) || defined(__solaris__) || defined(__sunos__) # include <nan.h> #endif -#if defined(LINUX) +#if defined(__linux__) # ifndef NAN # include <bits/nan.h> # endif #endif -#ifdef WIN32 +#ifdef __win32__ /* * no finite(x) ? * no isnan(x) ? @@ -110,24 +110,24 @@ # define snprintf __mingw_snprintf # endif /* __MINGW__ */ -#endif /* WIN32 */ - -#ifdef solaris +#endif /* __win32__ */ + +#ifdef __solaris__ # ifndef isfinite # define isfinite(f) finite((double)(f)) # endif #endif -#ifdef realIX +#ifdef __realIX__ # ifndef isfinite # define isfinite(x) 1 # endif #endif /* realIX */ -#if defined(__GNUC__) || defined(__MINGW__) || defined(WIN32) +#if defined(__GNUC__) || defined(__MINGW__) || defined(__win32__) # define LONGFLOAT long double -# if defined(linux) || defined(__osx__) || defined(WIN32) +# if defined(__linux__) || defined(__osx__) || defined(__win32__) # define LONG_ceil ceill # define LONG_floor floorl # define LONG_sqrt sqrtl @@ -154,13 +154,13 @@ # endif # define LONG_isfinite isfinitel -# if !defined(WIN32) +# if !defined(__win32__) # define LONG_asinh asinhl # define LONG_acosh acoshl # define LONG_atanh atanhl # endif /* linux */ -# endif /* defined(linux) || defined(WIN32) */ +# endif /* defined(__linux__) || defined(__win32__) */ # if !defined(LONG_isnan) /* This should be true for ISO C99 systems - even for newer linux systems */ @@ -168,7 +168,7 @@ # define LONG_isfinite isfinite # endif /* !defined(LONG_isnan) */ -#endif /* defined(__GNUC__) || defined(WIN32) */ +#endif /* defined(__GNUC__) || defined(__win32__) */ /* * on systems which do not support long doubles, fall back to double @@ -586,14 +586,14 @@ 00000000 00000000 seeeeeee eeeeeeee mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm ... " %{ /* NOCONTEXT */ -#if defined(__i386__) || defined(__x86_64__) - if (sizeof(LONGFLOAT) == 10) { /* i386 - WIN32: 80bit floats */ +#if defined(__x86__) || defined(__x86_64__) + if (sizeof(LONGFLOAT) == 10) { /* x86 - WIN32: 80bit floats */ RETURN (__mkSmallInteger(15)); } - if (sizeof(LONGFLOAT) == 12) { /* i386 - some unixes: 96bit floats */ + if (sizeof(LONGFLOAT) == 12) { /* x86 - some unixes: 96bit floats */ RETURN (__mkSmallInteger(15)); } - if (sizeof(LONGFLOAT) == 16) { /* amd64, i386-64bit */ + if (sizeof(LONGFLOAT) == 16) { /* amd64, x86_64 */ RETURN (__mkSmallInteger(15)); } #else @@ -626,15 +626,15 @@ 00000000 00000000 seeeeeee eeeeeeee mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm ... " %{ /* NOCONTEXT */ -#if defined(__i386__) || defined(__x86_64__) - if (sizeof(LONGFLOAT) == 10) { /* i386 - WIN32: 80bit floats */ +#if defined(__x86__) || defined(__x86_64__) + if (sizeof(LONGFLOAT) == 10) { /* x86 - WIN32: 80bit floats */ RETURN (__mkSmallInteger(1)); } - if (sizeof(LONGFLOAT) == 12) { /* i386 - some other unixes: 96bit floats*/ + if (sizeof(LONGFLOAT) == 12) { /* x86 - some other unixes: 96bit floats*/ RETURN (__mkSmallInteger(1)); } if (sizeof(LONGFLOAT) == 16) { - RETURN (__mkSmallInteger(1)); /* amd64, i386-64bit */ + RETURN (__mkSmallInteger(1)); /* amd64, x86_64 */ } #else if (sizeof(LONGFLOAT) == 16) { @@ -666,15 +666,15 @@ 00000000 00000000 seeeeeee eeeeeeee mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm " %{ /* NOCONTEXT */ -#if defined(__i386__) || defined(__x86_64__) - if (sizeof(LONGFLOAT) == 10) { /* i386 - WIN32: 80bit */ +#if defined(__x86__) || defined(__x86_64__) + if (sizeof(LONGFLOAT) == 10) { /* x86 - WIN32: 80bit */ RETURN (__mkSmallInteger(64)); } - if (sizeof(LONGFLOAT) == 12) { /* i386 some unixes: 96bit */ + if (sizeof(LONGFLOAT) == 12) { /* x86 some unixes: 96bit */ RETURN (__mkSmallInteger(64)); } if (sizeof(LONGFLOAT) == 16) { - RETURN (__mkSmallInteger(64)); /* amd64, i386-64bit */ + RETURN (__mkSmallInteger(64)); /* amd64, x86_64 */ } #else if (sizeof(LONGFLOAT) == 16) { @@ -1307,7 +1307,7 @@ val = __longFloatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val > 0.0) # endif { @@ -1356,7 +1356,7 @@ val = __longFloatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val > 0.0) # endif { @@ -1458,7 +1458,7 @@ val = __longFloatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val >= 0.0) # endif { @@ -2106,7 +2106,7 @@ val = __longFloatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if ((val >= -1.0) && (val <= 1.0)) # endif { @@ -2156,7 +2156,7 @@ val = __longFloatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val >= 1.0) # endif { @@ -2207,7 +2207,7 @@ val = __longFloatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if ((val >= -1.0) && (val <= 1.0)) # endif { @@ -2257,7 +2257,7 @@ val = __longFloatVal(self); -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if (val >= 1.0) # endif { @@ -2344,7 +2344,7 @@ val = __longFloatVal(self); __threadErrno = 0; -# ifdef WIN32 /* dont know (yet) how to suppress the warnBox opened by win32 */ +# ifdef __win32__ /* to suppress the warnBox opened by win32 */ if ((val >= -1.0) && (val <= 1.0)) # endif {
--- a/Method.st Sun May 15 08:38:43 2016 +0100 +++ b/Method.st Tue May 17 10:05:14 2016 +0100 @@ -1057,7 +1057,6 @@ "Modified (format): / 18-11-2011 / 14:47:06 / cg" ! ! - !Method methodsFor:'accessing-visibility'! isIgnored @@ -1965,30 +1964,32 @@ classAndSelector := self who. classAndSelector isNil ifTrue:[ - " - not anchored in any class. - check if wrapped (to be more informative in inspectors) - " - m := self wrapper. - m notNil ifTrue:[ - classAndSelector := m who. - wrapped := true. - ] + " + not anchored in any class. + check if wrapped (to be more informative in inspectors) + " + m := self wrapper. + m notNil ifTrue:[ + classAndSelector := m who. + wrapped := true. + ] ]. classAndSelector notNil ifTrue:[ - (classAndSelector methodClass) name printOn:aStream. - aStream nextPutAll:' '. - (classAndSelector methodSelector) printOn:aStream. + (classAndSelector methodClass) name printOn:aStream. + "/ print out in a form that can directly be evaluated (>> is a selector in Behavior) + "/ aStream nextPutAll:' » '. + aStream nextPutAll:' >> '. + (classAndSelector methodSelector) printOn:aStream. ] ifFalse:[ - " - sorry, a method which is nowhere anchored - " - aStream nextPutAll:'unbound' + " + sorry, a method which is nowhere anchored + " + aStream nextPutAll:'unbound' ]. aStream nextPut:$). wrapped ifTrue:[ - aStream nextPutAll:'; wrapped' + aStream nextPutAll:'; wrapped' ]. " @@ -3723,7 +3724,6 @@ "Created: / 23-07-2012 / 11:16:36 / cg" ! ! - !Method methodsFor:'source management'! revisionInfo
--- a/MethodDictionary.st Sun May 15 08:38:43 2016 +0100 +++ b/MethodDictionary.st Tue May 17 10:05:14 2016 +0100 @@ -11,6 +11,8 @@ " "{ Package: 'stx:libbasic' }" +"{ NameSpace: Smalltalk }" + KeyedCollection variableSubclass:#MethodDictionary instanceVariableNames:'' classVariableNames:'' @@ -333,7 +335,10 @@ !MethodDictionary methodsFor:'removing'! removeKey:key ifAbsent:failBlock - "remove key from dictionary. + "remove key from dictionary, + return the value previously stored there. + If it was not in the collection return the result + from evaluating failBlock. We actually do not remove it, but set it to nil." |value sz "{ Class: SmallInteger }"| @@ -393,10 +398,10 @@ !MethodDictionary class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/MethodDictionary.st,v 1.30 2014-12-26 14:56:48 cg Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/MethodDictionary.st,v 1.30 2014-12-26 14:56:48 cg Exp $' + ^ '$Header$' ! !
--- a/MethodWithBreakpoints.st Sun May 15 08:38:43 2016 +0100 +++ b/MethodWithBreakpoints.st Tue May 17 10:05:14 2016 +0100 @@ -125,6 +125,16 @@ self breakpointsDo:[:bp | bp disable]. ! +disableBreakpointInLine:lineNr + "disable one of my breakpoints" + + self breakpointsDo:[:bp | + bp line == lineNr ifTrue:[ + bp disable + ]. + ]. +! + restoreOriginalMethod "remove myself - i.e. replace by the original method (i.e. the one without line breakpoints)" @@ -178,11 +188,11 @@ !MethodWithBreakpoints class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/MethodWithBreakpoints.st,v 1.10 2015-01-29 23:49:33 cg Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/MethodWithBreakpoints.st,v 1.10 2015-01-29 23:49:33 cg Exp $' + ^ '$Header$' ! !
--- a/NonPositionableExternalStream.st Sun May 15 08:38:43 2016 +0100 +++ b/NonPositionableExternalStream.st Tue May 17 10:05:14 2016 +0100 @@ -227,7 +227,7 @@ In this case, we ignore the error." ((self == Stderr) or:[self == Stdout]) ifTrue:[ - ^ self + ^ self ]. super writeError:errorNumber ! ! @@ -361,7 +361,7 @@ #ifdef __SCHTEAM__ return context._RETURN( StandardErrorStream ); #else -# ifdef WIN32 +# ifdef __win32__ RETURN ( __MKEXTERNALADDRESS( __win32_stderr() )); # else RETURN ( __MKEXTERNALADDRESS(stderr) ); @@ -379,7 +379,7 @@ #ifdef __SCHTEAM__ return context._RETURN( StandardInputStream ); #else -# ifdef WIN32 +# ifdef __win32__ RETURN ( __MKEXTERNALADDRESS( __win32_stdin() )); # else RETURN ( __MKEXTERNALADDRESS(stdin) ); @@ -397,7 +397,7 @@ #ifdef __SCHTEAM__ return context._RETURN( StandardOutputStream ); #else -# ifdef WIN32 +# ifdef __win32__ RETURN ( __MKEXTERNALADDRESS( __win32_stdout() )); # else RETURN ( __MKEXTERNALADDRESS(stdout) ); @@ -470,9 +470,9 @@ "return true, if position is at end" (self == StdInStream) ifTrue:[ - OperatingSystem hasConsole ifFalse:[ - ^ true - ] + OperatingSystem hasConsole ifFalse:[ + ^ true + ] ]. "first, wait to avoid blocking on the read.
--- a/Object.st Sun May 15 08:38:43 2016 +0100 +++ b/Object.st Tue May 17 10:05:14 2016 +0100 @@ -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 @@ -14,21 +14,21 @@ "{ NameSpace: Smalltalk }" nil subclass:#Object - instanceVariableNames:'' - classVariableNames:'AbortAllSignal AbortSignal ActivityNotificationSignal - DebuggerHooks DeepCopyErrorSignal Dependencies - ElementOutOfBoundsSignal EnabledBreakPoints ErrorRecursion - ErrorSignal FinalizationLobby HaltSignal IndexNotFoundSignal - InfoPrinting InformationSignal InternalErrorSignal - KeyNotFoundSignal MessageNotUnderstoodSignal - NonIntegerIndexSignal NonWeakDependencies NotFoundSignal - OSSignalInterruptSignal ObjectAttributes - ObjectAttributesAccessLock PrimitiveFailureSignal - RecursionInterruptSignal RecursiveStoreStringSignal - SubscriptOutOfBoundsSignal SynchronizationSemaphores - UserInterruptSignal UserNotificationSignal WarningSignal' - poolDictionaries:'' - category:'Kernel-Objects' + instanceVariableNames:'' + classVariableNames:'AbortAllSignal AbortSignal ActivityNotificationSignal + DebuggerHooks DeepCopyErrorSignal Dependencies + ElementOutOfBoundsSignal EnabledBreakPoints ErrorRecursion + ErrorSignal FinalizationLobby HaltSignal IndexNotFoundSignal + InfoPrinting InformationSignal InternalErrorSignal + KeyNotFoundSignal MessageNotUnderstoodSignal + NonIntegerIndexSignal NonWeakDependencies NotFoundSignal + OSSignalInterruptSignal ObjectAttributes + ObjectAttributesAccessLock PrimitiveFailureSignal + RecursionInterruptSignal RecursiveStoreStringSignal + SubscriptOutOfBoundsSignal SynchronizationSemaphores + UserInterruptSignal UserNotificationSignal WarningSignal' + poolDictionaries:'' + category:'Kernel-Objects' ! !Object class methodsFor:'documentation'! @@ -36,7 +36,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 @@ -120,52 +120,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 " ! ! @@ -224,25 +224,25 @@ "called only once - initialize signals" ErrorSignal isNil ifTrue:[ - self initSignals. - ErrorRecursion := true. + self initSignals. + ErrorRecursion := true. ]. ObjectAttributes isNil ifTrue:[ - ObjectAttributes := WeakIdentityDictionary new. - ObjectAttributesAccessLock := RecursionLock new. + ObjectAttributes := WeakIdentityDictionary new. + ObjectAttributesAccessLock := RecursionLock 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 @@ -256,7 +256,6 @@ "Modified: / 4.8.1999 / 08:54:06 / stefan" ! ! - !Object class methodsFor:'Compatibility-ST80'! rootError @@ -423,13 +422,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 ] " @@ -495,7 +494,6 @@ InfoPrinting := aBoolean ! ! - !Object class methodsFor:'queries'! isAbstract @@ -518,8 +516,6 @@ ! ! - - !Object methodsFor:'Compatibility-Dolphin'! stbFixup: anSTBInFiler at: newObjectIndex @@ -605,7 +601,7 @@ explore (self confirm:'The Squeak explorer has not yet been ported to ST/X\\Inspect instead ?' withCRs) ifTrue:[ - self inspect + self inspect ] ! @@ -636,13 +632,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 @@ -695,7 +691,6 @@ " ! ! - !Object methodsFor:'accessing'! _at:index @@ -703,9 +698,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 @@ -718,9 +713,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 @@ -739,20 +734,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. @@ -809,8 +804,8 @@ %{ /* NOCONTEXT */ #ifdef __SCHTEAM__ { - int idx1Based = index.intValue(); // st index is 1 based - return context._RETURN( self.basicAt( idx1Based )); + int idx1Based = index.intValue(); // st index is 1 based + return context._RETURN( self.basicAt( idx1Based )); } /* NOTREACHED */ #else @@ -825,250 +820,250 @@ * 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): - /* - * pointers - */ - if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) { - OBJ *op; - - op = (OBJ *)pFirst + indx; - RETURN ( *op ); - } - break; - - case __MASKSMALLINT(WKPOINTERARRAY): - if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) { - OBJ *op; - OBJ el; - - op = (OBJ *)pFirst + indx; - el = *op; - el = __WEAK_READ__(self, el); - RETURN ( el ); - } - 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 = STX__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): + /* + * pointers + */ + if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) { + OBJ *op; + + op = (OBJ *)pFirst + indx; + RETURN ( *op ); + } + break; + + case __MASKSMALLINT(WKPOINTERARRAY): + if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) { + OBJ *op; + OBJ el; + + op = (OBJ *)pFirst + indx; + el = *op; + el = __WEAK_READ__(self, el); + RETURN ( el ); + } + 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 = STX__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 = STX__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 = STX__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; + } } #endif /* ! __SCHTEAM__ */ %}. @@ -1085,10 +1080,10 @@ %{ /* NOCONTEXT */ #ifdef __SCHTEAM__ { - int idx1Based = index.intValue(); // st index is 1 based - - self.basicAt_put(idx1Based, anObject ); - return context._RETURN( anObject ); + int idx1Based = index.intValue(); // st index is 1 based + + self.basicAt_put(idx1Based, anObject ); + return context._RETURN( anObject ); } /* NOTREACHED */ #else @@ -1105,292 +1100,292 @@ 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): - if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) { - OBJ *op; - - op = (OBJ *)pFirst + indx; - *op = anObject; - __STORE(self, anObject); - RETURN ( anObject ); - } - break; - - case __MASKSMALLINT(WKPOINTERARRAY): - if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) { - OBJ *op; - - op = (OBJ *)pFirst + indx; - *op = anObject; - __STORE(self, anObject); - __WEAK_WRITE__(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): + if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) { + OBJ *op; + + op = (OBJ *)pFirst + indx; + *op = anObject; + __STORE(self, anObject); + RETURN ( anObject ); + } + break; + + case __MASKSMALLINT(WKPOINTERARRAY): + if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) { + OBJ *op; + + op = (OBJ *)pFirst + indx; + *op = anObject; + __STORE(self, anObject); + __WEAK_WRITE__(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; + } } #endif /* ! __SCHTEAM__ */ %}. 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 @@ -1412,23 +1407,13 @@ %{ /* NOCONTEXT */ - REGISTER int indx; - int nIndex; - REGISTER OBJ slf; - REGISTER OBJ cls; - if (__isSmallInteger(index)) { - slf = self; + OBJ 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; + OBJ cls = __qClass(slf); + INT indx = __intVal(index) - 1; + INT nIndex = __byteArraySize(slf); + unsigned char *pFirst = __byteArrayVal(slf) + __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars)); switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) { case __MASKSMALLINT(DOUBLEARRAY): @@ -1479,6 +1464,7 @@ Point new byteAt:1 (ByteArray with:1 with:2) byteAt:2 (WordArray with:1) byteAt:1 + (WordArray with:1) byteAt:2 (FloatArray with:1.0) byteAt:2 'hello' byteAt:1 " @@ -1553,26 +1539,26 @@ 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)) { - // do not trust the ninstvars slot - verify - if ((__OBJS2BYTES__(ninstvars) + OHDR_SIZE) <= __qSize(self)) { - RETURN ( __InstPtr(self)->i_instvars[idx] ); - } - console_printf("[VM] warning: bad ninsts in class\n"); - } + 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)) { + // do not trust the ninstvars slot - verify + if ((__OBJS2BYTES__(ninstvars) + OHDR_SIZE) <= __qSize(self)) { + RETURN ( __InstPtr(self)->i_instvars[idx] ); + } + console_printf("[VM] warning: bad ninsts in class\n"); + } } #endif /* not SCHTEAM */ %}. @@ -1593,28 +1579,28 @@ 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)) { - // do not trust the ninstvars slot - verify - if ((__OBJS2BYTES__(ninstvars) + OHDR_SIZE) <= __qSize(self)) { - __InstPtr(self)->i_instvars[idx] = value; - __STORE(self, value); - RETURN ( value ); - } - console_printf("[VM] warning: bad ninsts in class\n"); - } + 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)) { + // do not trust the ninstvars slot - verify + if ((__OBJS2BYTES__(ninstvars) + OHDR_SIZE) <= __qSize(self)) { + __InstPtr(self)->i_instvars[idx] = value; + __STORE(self, value); + RETURN ( value ); + } + console_printf("[VM] warning: bad ninsts in class\n"); + } } #endif /* not SCHTEAM */ %}. @@ -1632,7 +1618,7 @@ idx := self class instVarIndexFor:name. idx isNil ifTrue:[ - ^ self errorKeyNotFound:name. + ^ self errorKeyNotFound:name. ]. ^ self instVarAt:idx. @@ -1684,7 +1670,7 @@ idx := self class instVarIndexFor:name. idx isNil ifTrue:[ - ^ self errorKeyNotFound:name. + ^ self errorKeyNotFound:name. ]. ^ self instVarAt:idx put:value. @@ -1736,17 +1722,17 @@ int flags; if (!__isNonNilObject(self)) { - RETURN(self); + RETURN(self); } /* * bail out for special (weak) objects .. */ flags = __intVal(__ClassInstPtr(__qClass(self))->c_flags); if (((flags & ~ARRAYMASK) == 0) - && ((flags & ARRAYMASK) != WKPOINTERARRAY) + && ((flags & ARRAYMASK) != WKPOINTERARRAY) ) { - bzero((void *)__InstPtr(self)->i_instvars, __qSize(self)-OHDR_SIZE); - RETURN(self); + bzero((void *)__InstPtr(self)->i_instvars, __qSize(self)-OHDR_SIZE); + RETURN(self); } %}. "/ fail for special objects @@ -1758,8 +1744,6 @@ " ! ! - - !Object methodsFor:'attributes access'! objectAttributeAt:attributeKey @@ -1769,7 +1753,7 @@ attrs := self objectAttributes. attrs size ~~ 0 ifTrue:[ - ^ attrs at:attributeKey ifAbsent:[] + ^ attrs at:attributeKey ifAbsent:[] ]. ^ nil @@ -1783,30 +1767,30 @@ "/ must do this save from being reentered, since the attributes collection "/ is possibly accessed from multiple threads... ObjectAttributesAccessLock critical:[ - | attrs | - - attrs := self objectAttributes. - "/ only need a WeakIdentityDictionary, if there are any non-symbol keys in - "/ it. Start with a regular IDDict, and migrate to WeakIDDict if ever required. - "/ Typically, this never happens (but does in the UIPainter!!) - attrs isEmptyOrNil ifTrue:[ - attributeKey isSymbol ifTrue:[ - attrs := IdentityDictionary new. - ] ifFalse:[ - attrs := WeakIdentityDictionary new. - ]. - attrs at:attributeKey put:anObject. - self objectAttributes:attrs. - ] ifFalse:[ - attributeKey isSymbol ifFalse:[ - attrs isWeakCollection ifFalse:[ - "first non-symbol attributeKey - convert to WeakIdentityDictionary" - attrs := WeakIdentityDictionary new declareAllFrom:attrs. - self objectAttributes:attrs. - ]. - ]. - attrs at:attributeKey put:anObject. - ]. + | attrs | + + attrs := self objectAttributes. + "/ only need a WeakIdentityDictionary, if there are any non-symbol keys in + "/ it. Start with a regular IDDict, and migrate to WeakIDDict if ever required. + "/ Typically, this never happens (but does in the UIPainter!!) + attrs isEmptyOrNil ifTrue:[ + attributeKey isSymbol ifTrue:[ + attrs := IdentityDictionary new. + ] ifFalse:[ + attrs := WeakIdentityDictionary new. + ]. + attrs at:attributeKey put:anObject. + self objectAttributes:attrs. + ] ifFalse:[ + attributeKey isSymbol ifFalse:[ + attrs isWeakCollection ifFalse:[ + "first non-symbol attributeKey - convert to WeakIdentityDictionary" + attrs := WeakIdentityDictionary new declareAllFrom:attrs. + self objectAttributes:attrs. + ]. + ]. + attrs at:attributeKey put:anObject. + ]. ] "Attaching additional attributes (slots) to an arbitrary object: @@ -1847,11 +1831,11 @@ "/ is possibly accessed from multiple threads. ObjectAttributesAccessLock critical:[ - aCollection isEmptyOrNil ifTrue:[ - ObjectAttributes removeKey:self ifAbsent:nil - ] ifFalse:[ - ObjectAttributes at:self put:aCollection - ]. + aCollection isEmptyOrNil ifTrue:[ + ObjectAttributes removeKey:self ifAbsent:nil + ] ifFalse:[ + ObjectAttributes at:self put:aCollection + ]. ] "Created: / 22.1.1998 / 21:29:35 / av" @@ -1859,37 +1843,41 @@ ! removeObjectAttribute:attributeKey - "make the argument, anObject be no attribute of the receiver" - + "remove an object attribute; + return the value previously stored there, or nil. + (make the argument, anObject be no longer an attribute of the receiver)" + + |oldVal| + "/ must do this save from being reentered, since the attributes collection "/ is possibly accessed from multiple threads. ObjectAttributesAccessLock critical:[ - |attrs| - - attrs := self objectAttributes. - attrs notNil ifTrue:[ - attrs size ~~ 0 ifTrue:[ - attrs removeKey:attributeKey ifAbsent:nil. - ]. - attrs size == 0 ifTrue:[ - self objectAttributes:nil - ]. - ] - ] + |attrs| + + attrs := self objectAttributes. + attrs notNil ifTrue:[ + attrs size ~~ 0 ifTrue:[ + oldVal := attrs removeKey:attributeKey ifAbsent:nil. + ]. + attrs size == 0 ifTrue:[ + self objectAttributes:nil + ]. + ] + ]. + ^ oldVal "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 ] ! @@ -1898,7 +1886,7 @@ argument anArgument to all my dependents." self dependentsDo:[:dependent | - dependent perform:aSelectorSymbol with:anArgument + dependent perform:aSelectorSymbol with:anArgument ] ! @@ -1907,7 +1895,7 @@ grant the request, and return true if so" self dependentsDo:[:dependent | - dependent updateRequest ifFalse:[^ false]. + dependent updateRequest ifFalse:[^ false]. ]. ^ true ! @@ -1917,7 +1905,7 @@ grant the request, and return true if so" self dependentsDo:[:dependent | - (dependent updateRequest:aSymbol) ifFalse:[^ false]. + (dependent updateRequest:aSymbol) ifFalse:[^ false]. ]. ^ true ! @@ -1945,9 +1933,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 ! @@ -1959,9 +1947,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 ! @@ -2057,21 +2045,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 ! @@ -2080,8 +2067,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 */ #ifdef __SCHTEAM__ @@ -2102,28 +2089,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 @@ -2162,25 +2149,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" @@ -2200,53 +2187,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" @@ -2265,13 +2252,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" @@ -2279,7 +2266,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 @@ -2296,9 +2283,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 ! @@ -2307,8 +2294,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 */ #ifdef __SCHTEAM__ @@ -2407,24 +2394,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. + ] ]. ! @@ -2538,8 +2525,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| @@ -2553,22 +2540,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 @@ -2576,24 +2563,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) ). @@ -2690,11 +2677,11 @@ myClass := self class. myClass isVariable ifTrue:[ - basicSize := self basicSize. - aCopy := self speciesForCopy basicNew:basicSize. + basicSize := self basicSize. + aCopy := self speciesForCopy basicNew:basicSize. ] ifFalse:[ - basicSize := 0. - aCopy := self speciesForCopy basicNew + basicSize := 0. + aCopy := self speciesForCopy basicNew ]. aCopy setHashFrom:self. aDictionary at:self put:aCopy. @@ -2704,40 +2691,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. @@ -2776,9 +2763,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" @@ -2803,54 +2790,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 @@ -2870,9 +2857,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" @@ -2905,9 +2892,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" @@ -2929,11 +2916,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,']') ]. " @@ -2990,12 +2977,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" @@ -3015,9 +3002,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) ]. " @@ -3045,9 +3032,9 @@ <resource: #skipInDebuggersWalkBack> (self isBreakPointEnabled:someKey) ifTrue:[ - ^ HaltSignal - raiseRequestWith:someKey - errorString:(infoString bindWith:someKey) + ^ HaltSignal + raiseRequestWith:someKey + errorString:(infoString bindWith:someKey) ]. ! @@ -3065,7 +3052,7 @@ <resource: #skipInDebuggersWalkBack> (self isBreakPointEnabled:someKey) ifTrue:[ - aBlock value + aBlock value ]. " @@ -3101,8 +3088,8 @@ "{ Pragma: +optSpace }" EnabledBreakPoints notNil ifTrue:[ - EnabledBreakPoints remove:someKey ifAbsent:[]. - EnabledBreakPoints := EnabledBreakPoints asNilIfEmpty. + EnabledBreakPoints remove:someKey ifAbsent:[]. + EnabledBreakPoints := EnabledBreakPoints asNilIfEmpty. ]. " @@ -3121,7 +3108,7 @@ "{ Pragma: +optSpace }" EnabledBreakPoints isNil ifTrue:[ - EnabledBreakPoints := Set new. + EnabledBreakPoints := Set new. ]. EnabledBreakPoints add:someKey. @@ -3149,7 +3136,7 @@ ^ self " - (3 halt * 5) + (3 halt * 5) " "Modified: / 02-08-1999 / 17:00:29 / stefan" @@ -3179,7 +3166,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 ]) @@ -3210,18 +3197,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' ] ! @@ -3269,7 +3256,7 @@ (' called from ' , sender sender printString) infoPrintCR. ]. message notNil ifTrue:[ - '------> ' infoPrint. message infoPrintCR + '------> ' infoPrint. message infoPrintCR ] " @@ -3367,9 +3354,9 @@ " example: - ... - self todo. - ... + ... + self todo. + ... " ! @@ -3384,11 +3371,11 @@ " example: - ... - self todo:[ - code which needs more work ... - ]. - ... + ... + self todo:[ + code which needs more work ... + ]. + ... " "Created: / 25-05-2007 / 21:34:39 / cg" @@ -3406,10 +3393,10 @@ "Example: nil tracePoint:#stefan" (self isBreakPointEnabled:someKey) ifTrue:[ - ^ Transcript showCR:('Tracepoint (at %1 for %3 from %2)' - bindWith:(Timestamp now printString) - with:(thisContext sender printString) - with:someKey) + ^ Transcript showCR:('Tracepoint (at %1 for %3 from %2)' + bindWith:(Timestamp now printString) + with:(thisContext sender printString) + with:someKey) ]. " @@ -3433,11 +3420,11 @@ "Example: nil tracePoint:#stefan" (self isBreakPointEnabled:someKey) ifTrue:[ - Transcript showCR:('Tracepoint: %4 (at %1 for %3 from %2)' - bindWith:(Timestamp now printString) - with:(thisContext sender printString) - with:someKey - with:messageBlockOrString value) + Transcript showCR:('Tracepoint: %4 (at %1 for %3 from %2)' + bindWith:(Timestamp now printString) + with:(thisContext sender printString) + with:someKey + with:messageBlockOrString value) ]. " @@ -3465,35 +3452,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 class == SmallInteger]) 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 class == SmallInteger]) 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" @@ -3515,10 +3502,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. ] ! @@ -3533,7 +3520,7 @@ |deps| (deps := Dependencies at:self ifAbsent:nil) isNil ifTrue:[ - ^ #(). + ^ #(). ]. ^ deps @@ -3552,24 +3539,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" @@ -3582,15 +3569,15 @@ deps := self dependents. deps size ~~ 0 ifTrue:[ - deps do:[:d | - (d notNil and:[d class ~~ SmallInteger]) ifTrue:[ - aBlock value:d - ] - ] + deps do:[:d | + (d notNil and:[d class ~~ SmallInteger]) 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" @@ -3623,43 +3610,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 class == SmallInteger]]) 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 class == SmallInteger]]) 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" @@ -3682,37 +3669,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" @@ -3735,11 +3722,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" @@ -3758,29 +3745,29 @@ 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" @@ -3813,8 +3800,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. @@ -3874,14 +3861,14 @@ but sometimes redefined for a better look. Note: the base method (used by the inspector) is #displayOn:. - So you should implement #displayOn: instead of #displayString in subclasses." + So you should implement #displayOn: instead of #displayString in subclasses." |s| "/ attention: TextStream is not present in ultra-mini standalone apps s := TextStream isNil - ifTrue:['' writeStream] - ifFalse:[TextStream on:(String new:32)]. + ifTrue:['' writeStream] + ifFalse:[TextStream on:(String new:32)]. self displayOn:s. ^ s contents @@ -4088,7 +4075,7 @@ |names encoding cls skipped slots| self isLiteral ifTrue:[ - ^ self + ^ self ]. slots := self literalArrayEncodingSlotOrder. @@ -4099,22 +4086,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 asMutator). - encoding add:value literalArrayEncoding - ] - ] + |value nm| + + nm := names at:instSlot. + (skipped includes:nm) ifFalse:[ + (value := self instVarAt:instSlot) notNil ifTrue:[ + encoding add:(nm asMutator). + encoding add:value literalArrayEncoding + ] + ] ]. ^ encoding asArray " - (1 -> 2) literalArrayEncoding - DebugView menuSpec decodeAsLiteralArray literalArrayEncoding = - DebugView menuSpec + (1 -> 2) literalArrayEncoding + DebugView menuSpec decodeAsLiteralArray literalArrayEncoding = + DebugView menuSpec " ! @@ -4177,8 +4164,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" ! @@ -4315,7 +4302,7 @@ <resource: #skipInDebuggersWalkBack> mayProceed ifTrue:[ - ^ ProceedableError raiseRequestWith:#error: errorString:aString + ^ ProceedableError raiseRequestWith:#error: errorString:aString ]. Error raiseWith:#error: errorString:aString @@ -4444,7 +4431,7 @@ <resource: #skipInDebuggersWalkBack> index isInteger ifFalse:[ - ^ self indexNotInteger:index + ^ self indexNotInteger:index ]. ^ self subscriptBoundsError:index ! @@ -4459,9 +4446,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" ! @@ -4475,7 +4462,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" ! @@ -4501,7 +4488,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" ! @@ -4515,7 +4502,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" ! @@ -4530,7 +4517,7 @@ <resource: #skipInDebuggersWalkBack> ^ SubscriptOutOfBoundsError - raiseRequestErrorString:'receiver has no indexed variables' + raiseRequestErrorString:'receiver has no indexed variables' " 1234 at:4 @@ -4552,7 +4539,7 @@ sender := thisContext sender. ^ UnimplementedFunctionalityError - raiseRequestWith:(Message selector:sender selector arguments:sender args) + raiseRequestWith:(Message selector:sender selector arguments:sender args) "Modified: / 02-11-2012 / 10:24:12 / cg" ! @@ -4571,20 +4558,20 @@ "do loop to take care of super sends" sender := thisContext sender. [ - selector := sender selector. - selector == #primitiveFailed: or:[selector == #primitiveFailed] + selector := sender selector. + selector == #primitiveFailed: or:[selector == #primitiveFailed] ] whileTrue:[sender := sender sender]. ^ PrimitiveFailure raiseRequestWith:(Message selector:selector arguments:sender args) - in:sender. + in:sender. " 1234 primitiveFailed [ - ExternalBytes new basicAt:40 + ExternalBytes new basicAt:40 ] on:PrimitiveFailure do:[:ex| - ex inspect + ex inspect ] " ! @@ -4602,13 +4589,13 @@ "do loop to take care of super sends" sender := thisContext sender. [ - selector := sender selector. - selector == #primitiveFailed: or:[selector == #primitiveFailed] + selector := sender selector. + selector == #primitiveFailed: or:[selector == #primitiveFailed] ] whileTrue:[sender := sender sender]. ^ PrimitiveFailure raiseRequestWith:(Message selector:selector arguments:sender args) - errorString:messageString - in:sender. + errorString:messageString + in:sender. " 1234 primitiveFailed:'this is a test' @@ -4629,7 +4616,7 @@ sender := thisContext sender. ^ UnimplementedFunctionalityError - raiseRequestWith:(Message selector:sender selector arguments:sender args) + raiseRequestWith:(Message selector:sender selector arguments:sender args) " self shouldImplement @@ -4650,8 +4637,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' @@ -4664,7 +4651,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" ! @@ -4675,7 +4662,7 @@ <resource: #skipInDebuggersWalkBack> ^ MethodNotAppropriateError - raiseRequestErrorString:'This message never may be sent to me'. + raiseRequestErrorString:'This message never may be sent to me'. "Modified: / 20-04-2005 / 18:59:28 / janfrog" "Modified: / 02-11-2012 / 10:10:42 / cg" @@ -4690,7 +4677,7 @@ <resource: #skipInDebuggersWalkBack> ^ MethodNotAppropriateError - raiseRequestErrorString:'method/functionality is not appropriate for class'. + raiseRequestErrorString:'method/functionality is not appropriate for class'. "Modified: / 02-11-2012 / 10:02:25 / cg" ! @@ -4740,8 +4727,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" ! @@ -4758,9 +4745,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" ! ! @@ -4771,12 +4758,12 @@ "add a debugger hook. Any registered hook is evaluated with the exception as argument before a real debugger is entered. Hooks can be used for two purposes: - - record exception information in a log file - - filter exceptions and either decide to ignore them or to open an alternative - debugger (depending on the exception type, maybe)" + - record exception information in a log file + - filter exceptions and either decide to ignore them or to open an alternative + debugger (depending on the exception type, maybe)" DebuggerHooks isNil ifTrue:[ - DebuggerHooks := OrderedCollection new. + DebuggerHooks := OrderedCollection new. ]. DebuggerHooks add:aBlock @@ -4797,11 +4784,11 @@ " " Object addDebuggerHook:[:ex | '/tmp/stx.log' asFilename - appendingFileDo:[:s | - s nextPutLine:'----------------------'. - (Timestamp now printOn:s). s cr. - ex suspendedContext fullPrintAllOn:s - ]]. + appendingFileDo:[:s | + s nextPutLine:'----------------------'. + (Timestamp now printOn:s). s cr. + ex suspendedContext fullPrintAllOn:s + ]]. (1 / (1-1)). Object removeDebuggerHook:(DebuggerHooks first). " @@ -4821,34 +4808,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 @@ -4872,47 +4859,47 @@ 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) ifTrue:[ - (HaltInterrupt handles:ex exception) ifTrue:[ - "/ 'Halt ignored' infoPrintCR. - ^ nil - ]. - "don't output the message, if the exception is a UserInterrupt (CTRL-C)" - (ex exception creator == UserInterrupt) ifTrue:[ - ex description errorPrintCR. - OperatingSystem exit:130. - ]. - ]. - ]. - - (Dialog notNil and:[Screen default notNil]) ifTrue:[ - 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. - 'Backtrace:' errorPrintCR. - thisContext fullPrintAll. - OperatingSystem exit:1 + msgString := 'Error: ' , msgString. + + thisContext isRecursive ifTrue:[ + msgString errorPrintCR. + Smalltalk fatalAbort:'recursive unhandled exception' + ]. + + Smalltalk isStandAloneApp ifTrue:[ + (ex creator == NoHandlerError) ifTrue:[ + (HaltInterrupt handles:ex exception) ifTrue:[ + "/ 'Halt ignored' infoPrintCR. + ^ nil + ]. + "don't output the message, if the exception is a UserInterrupt (CTRL-C)" + (ex exception creator == UserInterrupt) ifTrue:[ + ex description errorPrintCR. + OperatingSystem exit:130. + ]. + ]. + ]. + + (Dialog notNil and:[Screen default notNil]) ifTrue:[ + 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. + 'Backtrace:' errorPrintCR. + thisContext fullPrintAll. + OperatingSystem exit:1 ]. " @@ -4920,7 +4907,7 @@ " debugger := self appropriateDebugger:(thisContext selector). debugger isNil ifTrue:[ - ^ AbortOperationRequest raiseRequest + ^ AbortOperationRequest raiseRequest ]. "/ call any registered debug hooks. @@ -4928,9 +4915,9 @@ "/ ex-message (ex proceed, ex return etc.) or raise an Abort signal. "/ However, the real intent for hooks is to allow saving exceptions in a log file... DebuggerHooks notNil ifTrue:[ - DebuggerHooks do:[:eachHook | - eachHook value:ex. - ]. + DebuggerHooks do:[:eachHook | + eachHook value:ex. + ]. ]. ^ debugger enterException:ex. @@ -4941,8 +4928,8 @@ "remove a debugger hook." DebuggerHooks notNil ifTrue:[ - DebuggerHooks removeIdentical:aBlock. - DebuggerHooks isNil ifTrue:[ DebuggerHooks := nil ]. + DebuggerHooks removeIdentical:aBlock. + DebuggerHooks isNil ifTrue:[ DebuggerHooks := nil ]. ]. ! ! @@ -4957,7 +4944,7 @@ ^ 0 " - [1 // 0] on:ArithmeticError do:9999 + [1 // 0] on:ArithmeticError do:9999 " ! @@ -4971,16 +4958,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 @@ -5112,30 +5099,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 @@ -5161,12 +5148,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 ... @@ -5231,39 +5218,39 @@ "/ 'Stray recursionInterrupt ...' infoPrintCR. "/ ^ self "/ ]. - ObjectMemory infoPrinting ifTrue:[ - level := 0. - caller := thisContext sender. - [caller notNil] whileTrue:[ - level := level + 1. - caller := caller sender. - ]. - - 'Object [info]: recursionInterrupt from:' printCR. - con := con sender. - remaining := 500. - n := 0. - [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:[ + level := 0. + caller := thisContext sender. + [caller notNil] whileTrue:[ + level := level + 1. + caller := caller sender. + ]. + + 'Object [info]: recursionInterrupt from:' printCR. + con := con sender. + remaining := 500. + n := 0. + [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" @@ -5295,43 +5282,43 @@ 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. "/ ]. - MiniDebugger enter. - Processor activeProcess terminateNoSignal. + MiniDebugger enter. + 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. @@ -5341,7 +5328,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 @@ -5353,117 +5340,117 @@ "there is a screen. use it to bring up a box asking for what to do ..." Screen currentScreenQuerySignal answer:screen do:[ - " - SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue) - since the system will retry the faulty instruction, which leads to - another signal - to avoid frustration, better not offer this option. - " - fatal := OperatingSystem isFatalSignal:signalNumber. - fatal ifTrue:[ - (Debugger isNil or:[here isRecursive]) ifTrue:[ - 'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR. - ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. - ]. - " - a hard signal - go into debugger immediately - " - msg := 'OS-signal: ', name. - - "/ the IRQ-PC is passed as low-hi, to avoid the need - "/ to allocate a LargeInteger in the VM during signal - "/ time. I know, this is ugly. - - InterruptPcLow notNil ifTrue:[ - pc := InterruptPcLow + (InterruptPcHi bitShift:((SmallInteger maxBits + 1) // 2)). - pc ~~ 0 ifTrue:[ - msg := msg , ' PC=' , (pc printStringRadix:16) - ]. - ]. - InterruptAddrLow notNil ifTrue:[ - addr := InterruptAddrLow + (InterruptAddrHi bitShift:((SmallInteger maxBits + 1) // 2)). - addr ~~ 0 ifTrue:[ - msg := msg , ' ADDR=' , (addr printStringRadix:16) - ]. - ]. - Debugger enter:here withMessage:msg mayProceed:false. - "unreachable" - ^ nil. - ]. - - "if possible, open an option box asking the user what do. - Otherwise, start a debugger" - Dialog notNil ifTrue:[ - OperatingSystem isOSXlike ifTrue:[ - titles := #('Save crash image' 'Dump core' 'GDB' 'Exit ST/X' 'Debug'). - actions := #(save core gdb exit debug). - ] ifFalse:[ - titles := #('Save crash image' 'Dump core' 'Exit ST/X' 'Debug'). - actions := #(save core exit debug). - ]. - action := nil. - title := 'OS Signal caught (' , name, ')'. - title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs. - - "/ if caught while in the scheduler or event dispatcher, - "/ a modal dialog is not possible ... - "/ (therefore, abort & return does not makes sense) - - Processor activeProcess isSystemProcess ifFalse:[ - titles := #('Abort') , titles. - actions := #(abort), actions. - - badContext canReturn ifTrue:[ - titles := #('Return') , titles. - actions := #(return), actions. - ]. - ]. - - fatal ifFalse:[ - titles := titles, #('Ignore'). - actions := actions , #(ignore). - ]. - action := Dialog choose:title - labels:titles - values:actions - default:(fatal ifTrue:[nil] ifFalse:[#ignore]). - - "Dialog may fail (if system process), default action is debug" - action isEmptyOrNil ifTrue:[action := #debug]. - ] ifFalse:[ - action := #debug. - ]. - - action == #save ifTrue:[ - ObjectMemory writeCrashImage - ]. - action == #gdb ifTrue:[ - |pid| - - pid := OperatingSystem getProcessId. - OperatingSystem openTerminalWithCommand:('gdb -p %1' bindWith:pid) inBackground:true. - MiniDebugger enter. "/ to stop, so gdb can show where we are - AbortOperationRequest raise. - ]. - action == #core ifTrue:[ - Smalltalk fatalAbort - ]. - action == #exit ifTrue:[ - Smalltalk exit:10. - ]. - action == #return ifTrue:[ - badContext return - ]. - action == #abort ifTrue:[ - AbortOperationRequest raise. - ]. - - action == #debug ifTrue:[ - Debugger isNil ifTrue:[ - ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. - ]. - Debugger enter:here withMessage:('OS-Signal ', name) mayProceed:true. - ]. - "action == #ignore" + " + SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue) + since the system will retry the faulty instruction, which leads to + another signal - to avoid frustration, better not offer this option. + " + fatal := OperatingSystem isFatalSignal:signalNumber. + fatal ifTrue:[ + (Debugger isNil or:[here isRecursive]) ifTrue:[ + 'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR. + ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. + ]. + " + a hard signal - go into debugger immediately + " + msg := 'OS-signal: ', name. + + "/ the IRQ-PC is passed as low-hi, to avoid the need + "/ to allocate a LargeInteger in the VM during signal + "/ time. I know, this is ugly. + + InterruptPcLow notNil ifTrue:[ + pc := InterruptPcLow + (InterruptPcHi bitShift:((SmallInteger maxBits + 1) // 2)). + pc ~~ 0 ifTrue:[ + msg := msg , ' PC=' , (pc printStringRadix:16) + ]. + ]. + InterruptAddrLow notNil ifTrue:[ + addr := InterruptAddrLow + (InterruptAddrHi bitShift:((SmallInteger maxBits + 1) // 2)). + addr ~~ 0 ifTrue:[ + msg := msg , ' ADDR=' , (addr printStringRadix:16) + ]. + ]. + Debugger enter:here withMessage:msg mayProceed:false. + "unreachable" + ^ nil. + ]. + + "if possible, open an option box asking the user what do. + Otherwise, start a debugger" + Dialog notNil ifTrue:[ + OperatingSystem isOSXlike ifTrue:[ + titles := #('Save crash image' 'Dump core' 'GDB' 'Exit ST/X' 'Debug'). + actions := #(save core gdb exit debug). + ] ifFalse:[ + titles := #('Save crash image' 'Dump core' 'Exit ST/X' 'Debug'). + actions := #(save core exit debug). + ]. + action := nil. + title := 'OS Signal caught (' , name, ')'. + title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs. + + "/ if caught while in the scheduler or event dispatcher, + "/ a modal dialog is not possible ... + "/ (therefore, abort & return does not makes sense) + + Processor activeProcess isSystemProcess ifFalse:[ + titles := #('Abort') , titles. + actions := #(abort), actions. + + badContext canReturn ifTrue:[ + titles := #('Return') , titles. + actions := #(return), actions. + ]. + ]. + + fatal ifFalse:[ + titles := titles, #('Ignore'). + actions := actions , #(ignore). + ]. + action := Dialog choose:title + labels:titles + values:actions + default:(fatal ifTrue:[nil] ifFalse:[#ignore]). + + "Dialog may fail (if system process), default action is debug" + action isEmptyOrNil ifTrue:[action := #debug]. + ] ifFalse:[ + action := #debug. + ]. + + action == #save ifTrue:[ + ObjectMemory writeCrashImage + ]. + action == #gdb ifTrue:[ + |pid| + + pid := OperatingSystem getProcessId. + OperatingSystem openTerminalWithCommand:('gdb -p %1' bindWith:pid) inBackground:true. + MiniDebugger enter. "/ to stop, so gdb can show where we are + AbortOperationRequest raise. + ]. + action == #core ifTrue:[ + Smalltalk fatalAbort + ]. + action == #exit ifTrue:[ + Smalltalk exit:10. + ]. + action == #return ifTrue:[ + badContext return + ]. + action == #abort ifTrue:[ + AbortOperationRequest raise. + ]. + + action == #debug ifTrue:[ + Debugger isNil ifTrue:[ + ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. + ]. + Debugger enter:here withMessage:('OS-Signal ', name) mayProceed:true. + ]. + "action == #ignore" ]. "Modified: / 15-09-2011 / 16:38:14 / cg" @@ -5482,10 +5469,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. ! @@ -5542,7 +5529,7 @@ int hash0; if (InterruptPending == nil) { - struct inlineCache *pIlc; + struct inlineCache *pIlc; # define nways 2 # define nilcs 131 @@ -5560,7 +5547,7 @@ # define SEL_AND_ILC_INIT_131(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_1(l) - static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) }; + static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) }; # undef SEL_AND_ILC_INIT_1 # undef SEL_AND_ILC_INIT_2 @@ -5576,37 +5563,37 @@ # undef SEL_AND_ILC_INIT_257 # define TRY(n) \ - if (sel == sel_and_ilc[hash0].sel[n]) { \ - pIlc = &sel_and_ilc[hash0].ilc[n]; \ - goto perform0_send_and_return; \ - } - - if (__isNonNilObject(sel)) { - hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; - } else { - /* sel is either nil or smallint, use its value as hash */ - hash0 = (INT)sel % nilcs; - } - - TRY(0); - TRY(1); + if (sel == sel_and_ilc[hash0].sel[n]) { \ + pIlc = &sel_and_ilc[hash0].ilc[n]; \ + goto perform0_send_and_return; \ + } + + if (__isNonNilObject(sel)) { + hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; + } else { + /* sel is either nil or smallint, use its value as hash */ + hash0 = (INT)sel % nilcs; + } + + TRY(0); + TRY(1); # undef TRY - /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ - - pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; - sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; - sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; - pIlc->ilc_func = __SEND0ADDR__; - if (pIlc->ilc_poly) { - __flushPolyCache(pIlc->ilc_poly); - pIlc->ilc_poly = 0; - } + /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ + + pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; + sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; + sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; + pIlc->ilc_func = __SEND0ADDR__; + if (pIlc->ilc_poly) { + __flushPolyCache(pIlc->ilc_poly); + pIlc->ilc_poly = 0; + } perform0_send_and_return: - RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) ); + RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) ); } else { - static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1); - RETURN (_SEND0(self, aSelector, nil, &ilc0)); + static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1); + RETURN (_SEND0(self, aSelector, nil, &ilc0)); } #endif /* not __SCHTEAM__ */ %}. @@ -5620,7 +5607,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 ?). @@ -5634,8 +5621,8 @@ " 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 ]. %{ #ifdef __SCHTEAM__ @@ -5644,166 +5631,166 @@ 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 @@ -5828,7 +5815,7 @@ int hash0; if (InterruptPending == nil) { - struct inlineCache *pIlc; + struct inlineCache *pIlc; # undef nways # define nways 2 # undef nilcs @@ -5847,7 +5834,7 @@ # define SEL_AND_ILC_INIT_131(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_1(l) - static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) }; + static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) }; # undef SEL_AND_ILC_INIT_1 # undef SEL_AND_ILC_INIT_2 @@ -5863,38 +5850,38 @@ # undef SEL_AND_ILC_INIT_257 # define TRY(n) \ - if (sel == sel_and_ilc[hash0].sel[n]) { \ - pIlc = &sel_and_ilc[hash0].ilc[n]; \ - goto perform1_send_and_return; \ - } - - if (__isNonNilObject(sel)) { - hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; - } else { - /* sel is either nil or smallint, use its value as hash */ - hash0 = (INT)sel % nilcs; - } - - TRY(0); - TRY(1); + if (sel == sel_and_ilc[hash0].sel[n]) { \ + pIlc = &sel_and_ilc[hash0].ilc[n]; \ + goto perform1_send_and_return; \ + } + + if (__isNonNilObject(sel)) { + hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; + } else { + /* sel is either nil or smallint, use its value as hash */ + hash0 = (INT)sel % nilcs; + } + + TRY(0); + TRY(1); # undef TRY - /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ - - pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; - sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; - sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; - pIlc->ilc_func = __SEND1ADDR__; - if (pIlc->ilc_poly) { - __flushPolyCache(pIlc->ilc_poly); - pIlc->ilc_poly = 0; - } + /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ + + pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; + sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; + sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; + pIlc->ilc_func = __SEND1ADDR__; + if (pIlc->ilc_poly) { + __flushPolyCache(pIlc->ilc_poly); + pIlc->ilc_poly = 0; + } perform1_send_and_return: - RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) ); + RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) ); } else { - static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1); - RETURN (_SEND1(self, aSelector, nil, &ilc1, arg)); + static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1); + RETURN (_SEND1(self, aSelector, nil, &ilc1, arg)); } #endif /* not __SCHTEAM__ */ %}. @@ -5931,7 +5918,7 @@ # define SEL_AND_ILC_INIT_131(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_1(l) - static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) }; + static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) }; # undef SEL_AND_ILC_INIT_1 # undef SEL_AND_ILC_INIT_2 @@ -5947,38 +5934,38 @@ # undef SEL_AND_ILC_INIT_257 # define TRY(n) \ - if (sel == sel_and_ilc[hash0].sel[n]) { \ - pIlc = &sel_and_ilc[hash0].ilc[n]; \ - goto perform2_send_and_return; \ - } - - if (__isNonNilObject(sel)) { - hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; - } else { - /* sel is either nil or smallint, use its value as hash */ - hash0 = (INT)sel % nilcs; - } - - TRY(0); - TRY(1); + if (sel == sel_and_ilc[hash0].sel[n]) { \ + pIlc = &sel_and_ilc[hash0].ilc[n]; \ + goto perform2_send_and_return; \ + } + + if (__isNonNilObject(sel)) { + hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; + } else { + /* sel is either nil or smallint, use its value as hash */ + hash0 = (INT)sel % nilcs; + } + + TRY(0); + TRY(1); # undef TRY - /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ - - pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; - sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; - sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; - pIlc->ilc_func = __SEND2ADDR__; - if (pIlc->ilc_poly) { - __flushPolyCache(pIlc->ilc_poly); - pIlc->ilc_poly = 0; - } + /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ + + pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; + sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; + sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; + pIlc->ilc_func = __SEND2ADDR__; + if (pIlc->ilc_poly) { + __flushPolyCache(pIlc->ilc_poly); + pIlc->ilc_poly = 0; + } perform2_send_and_return: - RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) ); + RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) ); } else { - static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1); - RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2)); + static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1); + RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2)); } #endif /* not SCHTEAM */ %}. @@ -6000,32 +5987,32 @@ static int 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)); } #endif /* not SCHTEAM */ %}. @@ -6045,34 +6032,34 @@ static int 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) @@ -6091,38 +6078,38 @@ static int 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) ! @@ -6138,39 +6125,39 @@ static int 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) ! @@ -6189,398 +6176,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:; #endif @@ -6597,7 +6584,7 @@ If the message expects an argument, pass arg." aSelector argumentCount == 1 ifTrue:[ - ^ self perform:aSelector with:arg + ^ self perform:aSelector with:arg ]. ^ self perform:aSelector @@ -6622,10 +6609,10 @@ numArgs := aSelector argumentCount. 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. @@ -6650,13 +6637,13 @@ numArgs := aSelector argumentCount. 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. @@ -6681,16 +6668,16 @@ numArgs := aSelector argumentCount. 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. @@ -6724,8 +6711,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:#() @@ -6754,8 +6741,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 @@ -6775,8 +6762,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) @@ -6796,8 +6783,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) @@ -6819,8 +6806,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) @@ -6837,7 +6824,7 @@ REGISTER OBJ sel = aSelector; if (InterruptPending == nil) { - struct inlineCache *pIlc; + struct inlineCache *pIlc; #define SEL_AND_ILC_INIT_1(l) { nil , __ILCPERF0(l) } #define SEL_AND_ILC_INIT_2(l) SEL_AND_ILC_INIT_1(l) , SEL_AND_ILC_INIT_1(l) @@ -6852,11 +6839,11 @@ #undef nilcs #define nilcs 256 - static struct sel_and_ilc { - OBJ sel; - struct inlineCache ilc; - struct sel_and_ilc *next; - } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) }; + static struct sel_and_ilc { + OBJ sel; + struct inlineCache ilc; + struct sel_and_ilc *next; + } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) }; #undef SEL_AND_ILC_INIT_1 #undef SEL_AND_ILC_INIT_2 @@ -6868,62 +6855,62 @@ #undef SEL_AND_ILC_INIT_128 #undef SEL_AND_ILC_INIT_256 - static struct sel_and_ilc *nextFree = sel_and_ilc; - static struct sel_and_ilc *lastUsed = 0; - int n; - struct sel_and_ilc *slot, *prev, *prevPrev; - - for (n=0, slot = lastUsed, prev = prevPrev = 0; slot; n++, slot = slot->next) { - if (sel == slot->sel) { + static struct sel_and_ilc *nextFree = sel_and_ilc; + static struct sel_and_ilc *lastUsed = 0; + int n; + struct sel_and_ilc *slot, *prev, *prevPrev; + + for (n=0, slot = lastUsed, prev = prevPrev = 0; slot; n++, slot = slot->next) { + if (sel == slot->sel) { #ifdef XXDEBUG printf("cached slot %d (len=%d)\n", slot-sel_and_ilc, n); #endif - pIlc = &(slot->ilc); - // move to front - if (prev) { - prev->next = slot->next; - } - slot->next = lastUsed; - lastUsed = slot; - pIlc = &(slot->ilc); - goto perform0_send_and_return; - } - prevPrev = prev; - prev = slot; - } - // not recently used... - if (nextFree) { - // another free one - slot = nextFree; - nextFree = nextFree + 1; - if (nextFree >= &(sel_and_ilc[nilcs])) nextFree = 0; + pIlc = &(slot->ilc); + // move to front + if (prev) { + prev->next = slot->next; + } + slot->next = lastUsed; + lastUsed = slot; + pIlc = &(slot->ilc); + goto perform0_send_and_return; + } + prevPrev = prev; + prev = slot; + } + // not recently used... + if (nextFree) { + // another free one + slot = nextFree; + nextFree = nextFree + 1; + if (nextFree >= &(sel_and_ilc[nilcs])) nextFree = 0; #ifdef XXDEBUG printf("new slot %d\n", slot-sel_and_ilc); #endif - } else { - // no more for reuse - use least recently used - slot = prev; - prevPrev->next = 0; - slot->next = lastUsed; - lastUsed = slot; + } else { + // no more for reuse - use least recently used + slot = prev; + prevPrev->next = 0; + slot->next = lastUsed; + lastUsed = slot; #ifdef XXDEBUG printf("reuse last slot %d\n", slot-sel_and_ilc); #endif - } - - /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ - pIlc = &(slot->ilc); - slot->sel = sel; - pIlc->ilc_func = __SEND0ADDR__; - if (pIlc->ilc_poly) { - __flushPolyCache(pIlc->ilc_poly); - pIlc->ilc_poly = 0; - } + } + + /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ + pIlc = &(slot->ilc); + slot->sel = sel; + 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:#() @@ -6938,7 +6925,7 @@ REGISTER OBJ sel = aSelector; if (InterruptPending == nil) { - struct inlineCache *pIlc; + struct inlineCache *pIlc; /* JV @ 2010-22-07: To improve performance I use 256 ILCs instead of default 4. For details, see comment in perform: */ @@ -6955,7 +6942,7 @@ #undef nilcs #define nilcs 256 - static struct { OBJ sel; struct inlineCache ilc; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) }; + static struct { OBJ sel; struct inlineCache ilc; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) }; #undef SEL_AND_ILC_INIT_1 #undef SEL_AND_ILC_INIT_2 @@ -6967,28 +6954,28 @@ #undef SEL_AND_ILC_INIT_128 #undef SEL_AND_ILC_INIT_256 - static int 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; - } + static int 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; + } 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) @@ -7023,10 +7010,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. ! @@ -7059,16 +7046,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. @@ -7127,10 +7114,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 @@ -7150,11 +7137,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]. @@ -7170,11 +7157,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]. @@ -7220,7 +7207,7 @@ These messages can be turned on/off by 'Object infoPrinting:true/false'" InfoPrinting == true ifTrue:[ - self errorPrint + self errorPrint ] ! @@ -7233,7 +7220,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" @@ -7508,9 +7495,9 @@ |rslt| Error handle:[:ex | - rslt := exceptionBlock value + rslt := exceptionBlock value ] do:[ - rslt := self printString + rslt := self printString ]. ^ rslt ! @@ -7654,12 +7641,12 @@ |myClass hasSemi sz "{ Class: SmallInteger }" | thisContext isRecursive ifTrue:[ - RecursiveStoreError raiseRequestWith:self. - 'Object [error]: storeString of self referencing object (' errorPrint. - self class name errorPrint. - ')' errorPrintCR. - aStream nextPutAll:'#("recursive")'. - ^ self + RecursiveStoreError raiseRequestWith:self. + 'Object [error]: storeString of self referencing object (' errorPrint. + self class name errorPrint. + ')' errorPrintCR. + aStream nextPutAll:'#("recursive")'. + ^ self ]. myClass := self class. @@ -7668,48 +7655,48 @@ hasSemi := false. myClass isVariable ifTrue:[ - aStream nextPutAll:' basicNew:'. - self basicSize printOn:aStream + aStream nextPutAll:' basicNew:'. + self basicSize printOn:aStream ] ifFalse:[ - aStream nextPutAll:' basicNew' + aStream nextPutAll:' basicNew' ]. sz := myClass instSize. 1 to:sz do:[:i | - |ref| - - ref := (self instVarAt:i). - "/ no need to store nil entries, because the object has been instantiated - "/ with basicNew just a moment ago (so the fields are already nil) - ref notNil ifTrue:[ - aStream nextPutAll:' instVarAt:'. - i printOn:aStream. - aStream nextPutAll:' put:'. - ref storeOn:aStream. - aStream nextPut:$;. - hasSemi := true - ]. + |ref| + + ref := (self instVarAt:i). + "/ no need to store nil entries, because the object has been instantiated + "/ with basicNew just a moment ago (so the fields are already nil) + ref notNil ifTrue:[ + aStream nextPutAll:' instVarAt:'. + i printOn:aStream. + aStream nextPutAll:' put:'. + ref storeOn:aStream. + aStream nextPut:$;. + hasSemi := true + ]. ]. myClass isVariable ifTrue:[ - sz := self basicSize. - 1 to:sz do:[:i | - |ref| - - ref := (self basicAt:i). - "/ no need to store nil entries, because the object has been instantiated - "/ with basicNew just a moment ago (so the fields are already nil) - ref notNil ifTrue:[ - aStream nextPutAll:' basicAt:'. - i printOn:aStream. - aStream nextPutAll:' put:'. - ref storeOn:aStream. - aStream nextPut:$;. - hasSemi := true - ] - ] + sz := self basicSize. + 1 to:sz do:[:i | + |ref| + + ref := (self basicAt:i). + "/ no need to store nil entries, because the object has been instantiated + "/ with basicNew just a moment ago (so the fields are already nil) + ref notNil ifTrue:[ + aStream nextPutAll:' basicAt:'. + i printOn:aStream. + aStream nextPutAll:' put:'. + ref storeOn:aStream. + aStream nextPut:$;. + hasSemi := true + ] + ] ]. hasSemi ifTrue:[ - aStream nextPutAll:' yourself' + aStream nextPutAll:' yourself' ]. aStream nextPut:$). @@ -8003,7 +7990,6 @@ ^ self ! ! - !Object methodsFor:'secure message sending'! ?:selector @@ -8068,17 +8054,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 @@ -8102,17 +8088,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 @@ -8139,17 +8125,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 ! @@ -8167,17 +8153,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 @@ -8233,152 +8219,152 @@ 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); - } - - cls = __qClass(self); - 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 (nObjs == 1) { - /* better reverse the loop */ - OBJ anObject = __arrayVal(aCollection)[0]; - - if (anObject == cls) { - RETURN(true); - } - if (! nInsts) { - RETURN (false); - } - - if ((__qSpace(self) <= OLDSPACE) - && !__isRemembered(self) - && __isNonNilObject(anObject)) { - int spc = __qSpace(anObject); - - if ((spc == NEWSPACE) || (spc == SURVSPACE)) { - RETURN(false); - } - } + int nObjs = __arraySize(aCollection); + char *minAddr = 0, *maxAddr = 0; + + if (nObjs == 0) { + RETURN (false); + } + + cls = __qClass(self); + 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 (nObjs == 1) { + /* better reverse the loop */ + OBJ anObject = __arrayVal(aCollection)[0]; + + if (anObject == cls) { + RETURN(true); + } + if (! nInsts) { + RETURN (false); + } + + if ((__qSpace(self) <= OLDSPACE) + && !__isRemembered(self) + && __isNonNilObject(anObject)) { + int spc = __qSpace(anObject); + + if ((spc == NEWSPACE) || (spc == SURVSPACE)) { + RETURN(false); + } + } # 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); - } - - /* - * 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 *)(__arrayVal(aCollection)[0]); - maxAddr = minAddr; - - for (i=0; i<nObjs; i++) { - OBJ anObject = __arrayVal(aCollection)[i]; - - if (__isNonNilObject(anObject)) { - int spc = __qSpace(anObject); - - if ((spc != 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 above) - */ - if (minAddr == 0) { - int i; - - for (i=0; i<nObjs; i++) { - char *anObject = (char *)__arrayVal(aCollection)[i]; - - if (anObject < minAddr) { - minAddr = anObject; - } else if (anObject > maxAddr) { - maxAddr = anObject; - } - } - } - - if (((char *)cls >= minAddr) && ((char *)cls <= maxAddr)) { + 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 *)(__arrayVal(aCollection)[0]); + maxAddr = minAddr; + + for (i=0; i<nObjs; i++) { + OBJ anObject = __arrayVal(aCollection)[i]; + + if (__isNonNilObject(anObject)) { + int spc = __qSpace(anObject); + + if ((spc != 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 above) + */ + if (minAddr == 0) { + int i; + + for (i=0; i<nObjs; i++) { + char *anObject = (char *)__arrayVal(aCollection)[i]; + + if (anObject < minAddr) { + minAddr = anObject; + } else if (anObject > maxAddr) { + maxAddr = anObject; + } + } + } + + 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++) { - if (cls == __arrayVal(aCollection)[i]) { - RETURN (true); - } - } + int i; + + for (i=0; i<nObjs; i++) { + if (cls == __arrayVal(aCollection)[i]) { + RETURN (true); + } + } # endif /* memsrch4 */ - } - - for (inst=0; inst<nInsts; inst++) { - OBJ instVar = __InstPtr(self)->i_instvars[inst]; - int i; - - if (((char *)instVar >= minAddr) && ((char *)instVar <= maxAddr)) { + } + + 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++) { - if (instVar == __arrayVal(aCollection)[i]) { - RETURN (true); - } - } + for (i=0; i<nObjs; i++) { + if (instVar == __arrayVal(aCollection)[i]) { + RETURN (true); + } + } # endif /* memsrch4 */ - } - } - RETURN (false); + } + } + RETURN (false); } %}. aCollection do:[:el | - (self referencesObject:el) ifTrue:[^ true]. + (self referencesObject:el) ifTrue:[^ true]. ]. ^ false ! @@ -8398,19 +8384,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 @@ -8429,21 +8415,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]. + ] + ] ]. " @@ -8467,24 +8453,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 @@ -8504,20 +8490,20 @@ int nInsts, i; if (! __isNonNilObject(self)) { - RETURN (false); + 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); } @@ -8527,24 +8513,24 @@ * 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); + } + } } # 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 */ @@ -8609,7 +8595,6 @@ " ! ! - !Object methodsFor:'synchronized evaluation'! freeSynchronizationSemaphore @@ -8620,8 +8605,8 @@ sema := self synchronizationSemaphore. sema notNil ifTrue:[ - sema wait. "/ get lock - self synchronizationSemaphore:nil. + sema wait. "/ get lock + self synchronizationSemaphore:nil. ]. " @@ -8652,10 +8637,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" @@ -8710,7 +8695,7 @@ %{ /* NOCONTEXT */ if (! __isNonNilObject(self)) { - RETURN (self); + RETURN (self); } __beImmutable(self); %} @@ -8721,7 +8706,7 @@ %{ /* NOCONTEXT */ if (! __isNonNilObject(self)) { - RETURN (self); + RETURN (self); } __beMutable(self); %} @@ -8745,7 +8730,7 @@ - the Collection-classes have been rewritten to not use it.)" %{ if (__primBecome(self, anotherObject)) { - RETURN ( self ); + RETURN ( self ); } %}. self primitiveFailed @@ -8761,7 +8746,7 @@ %{ if (__primBecomeNil(self)) { - RETURN ( nil ); + RETURN ( nil ); } %}. self primitiveFailed @@ -8782,7 +8767,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 @@ -8931,7 +8916,7 @@ int nInsts, i; if (! __isNonNilObject(self)) { - RETURN (false); + RETURN (false); } /* @@ -8940,34 +8925,34 @@ * 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); 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); } anyChange = false; for (i=0; i<nInsts; i++) { - if (__InstPtr(self)->i_instvars[i] == anObject) { - __InstPtr(self)->i_instvars[i] = newRef; - __STORE(self, newRef); - // __dumpObject__(self, __LINE__); - anyChange = true; - } + if (__InstPtr(self)->i_instvars[i] == anObject) { + __InstPtr(self)->i_instvars[i] = newRef; + __STORE(self, newRef); + // __dumpObject__(self, __LINE__); + anyChange = true; + } } RETURN (anyChange); %}. @@ -9053,21 +9038,21 @@ the receiver 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 value] ifFalse:[foo]) + (foo isNil ifTrue:[bar value] ifFalse:[foo]) if they are message sends, the equivalent code is: - [ - |t t2| - - t := foo. - t isNil ifTrue:[bar value] ifFalse:[t] - ] value + [ + |t t2| + + t := foo. + t isNil ifTrue:[bar value] ifFalse:[t] + ] value Can be used to provide defaultValues to variables, as in: - foo := arg ?? [ self computeDefault ] + foo := arg ?? [ self computeDefault ] Note: this method should never be redefined in classes other than UndefinedObject. " @@ -9092,8 +9077,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 ! @@ -9102,11 +9087,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 argumentCount == 1]) ifTrue:[ - ^ notNilBlockOrValue value:self. + ^ notNilBlockOrValue value:self. ]. ^ notNilBlockOrValue value ! @@ -9115,11 +9100,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 argumentCount == 1]) ifTrue:[ - ^ aBlockOrValue value:self. + ^ aBlockOrValue value:self. ]. ^ aBlockOrValue value ! @@ -9128,11 +9113,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 argumentCount == 1]) ifTrue:[ - ^ notNilBlockOrValue value:self. + ^ notNilBlockOrValue value:self. ]. ^ notNilBlockOrValue value ! @@ -9497,21 +9482,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 */ @@ -9519,10 +9504,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 ); %} @@ -9583,16 +9568,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 ! @@ -9650,8 +9635,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 ! @@ -9674,11 +9659,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 " ! @@ -9965,8 +9950,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 ! ! @@ -9995,7 +9980,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 ]. " @@ -10005,12 +9990,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. ] " @@ -10042,7 +10027,7 @@ answer := self confirmWithCancel:aString. answer isNil ifTrue:[ - ^ cancelBlock value + ^ cancelBlock value ]. ^ answer @@ -10078,10 +10063,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 @@ -10094,10 +10079,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' @@ -10130,141 +10115,141 @@ |currentScreen con sender action boxLabels boxValues default s| Smalltalk isInitialized ifFalse:[ - 'errorNotification: ' print. aString printCR. - con := aContext ? thisContext methodHome. - con sender printAllLevels:10. - ^ nil + 'errorNotification: ' print. aString printCR. + con := aContext ? thisContext methodHome. + con sender printAllLevels:10. + ^ nil ]. (Dialog isNil or:[Screen isNil or:[(currentScreen := Screen current) isNil or:[currentScreen isOpen not]]]) ifTrue:[ - " - on systems without GUI, simply show - the message on the Transcript and abort. - " - Transcript showCR:aString. - AbortOperationRequest raise. - "not reached" - ^ nil + " + on systems without GUI, simply show + the message on the Transcript and abort. + " + Transcript showCR:aString. + AbortOperationRequest raise. + "not reached" + ^ nil ]. Processor activeProcessIsSystemProcess ifTrue:[ - action := #debug. - sender := aContext. - Debugger isNil ifTrue:[ - '****************** Caught Error while in SystemProcess ****************' errorPrintCR. - aString errorPrintCR. - Exception handle:[:ex | - 'Caught recursive error while printing backtrace:' errorPrintCR. - ex description errorPrintCR. - ] do:[ - thisContext fullPrintAll. - ]. - action := #abort. - ]. + action := #debug. + sender := aContext. + Debugger isNil ifTrue:[ + '****************** Caught Error while in SystemProcess ****************' errorPrintCR. + aString errorPrintCR. + Exception handle:[:ex | + 'Caught recursive error while printing backtrace:' errorPrintCR. + ex description errorPrintCR. + ] do:[ + thisContext fullPrintAll. + ]. + action := #abort. + ]. ] ifFalse:[ - Dialog autoload. "in case it's autoloaded" - - Error handle:[:ex | - "/ a recursive error - quickly enter debugger - "/ this happened, when I corrupted the Dialog class ... - ('Object [error]: ' , ex description , ' caught in errorNotification') errorPrintCR. - action := #debug. - ex return. - ] do:[ |s| - sender := aContext. - sender isNil ifTrue:[ - sender := thisContext methodHome sender. - ]. - con := sender. - - "/ skip intermediate (signal & exception) contexts - DebugView notNil ifTrue:[ - con := DebugView interestingContextFrom:sender - ]. - - "/ show the first few contexts - - s := CharacterWriteStream with:aString. - s cr; cr. - s nextPutLine:'Calling Chain:'. - s nextPutLine:'--------------------------------------------------------------'. - 1 to:25 do:[:n | - con notNil ifTrue:[ - con printOn:s. - s cr. - con := con sender - ] - ]. - - mayProceed ifTrue:[ - boxLabels := #('Proceed'). - boxValues := #(#proceed). - default := #proceed. - ] ifFalse:[ - boxLabels := #(). - boxValues := #(). - ]. - - AbortOperationRequest isHandled ifTrue:[ - default := #abort. - boxLabels := boxLabels , #('Abort'). - boxValues := boxValues , #(#abort). - AbortAllOperationRequest isHandled ifTrue:[ - boxLabels := boxLabels , #('Abort All'). - boxValues := boxValues , #(#abortAll). - ]. - true "allowDebug" ifTrue:[ - boxLabels := boxLabels , #('Copy Trace and Abort'). - boxValues := boxValues , #(#copyAndAbort). - ]. - ] ifFalse:[ - mayProceed "and:[allowDebug]" ifTrue:[ - boxLabels := boxLabels , #('Copy Trace and Proceed'). - boxValues := boxValues , #(#copyAndProceed). - ]. - ]. - - (allowDebug and:[Debugger notNil]) ifTrue:[ - boxLabels := boxLabels , #('Debug'). - boxValues := boxValues , #(#debug). - default := #debug. - ]. - - action := Dialog - choose:s contents - label:('Exception [' , Processor activeProcess nameOrId , ']') - image:WarningBox errorIconBitmap - labels:boxLabels - values:boxValues - default:default - onCancel:nil. - ]. + Dialog autoload. "in case it's autoloaded" + + Error handle:[:ex | + "/ a recursive error - quickly enter debugger + "/ this happened, when I corrupted the Dialog class ... + ('Object [error]: ' , ex description , ' caught in errorNotification') errorPrintCR. + action := #debug. + ex return. + ] do:[ |s| + sender := aContext. + sender isNil ifTrue:[ + sender := thisContext methodHome sender. + ]. + con := sender. + + "/ skip intermediate (signal & exception) contexts + DebugView notNil ifTrue:[ + con := DebugView interestingContextFrom:sender + ]. + + "/ show the first few contexts + + s := CharacterWriteStream with:aString. + s cr; cr. + s nextPutLine:'Calling Chain:'. + s nextPutLine:'--------------------------------------------------------------'. + 1 to:25 do:[:n | + con notNil ifTrue:[ + con printOn:s. + s cr. + con := con sender + ] + ]. + + mayProceed ifTrue:[ + boxLabels := #('Proceed'). + boxValues := #(#proceed). + default := #proceed. + ] ifFalse:[ + boxLabels := #(). + boxValues := #(). + ]. + + AbortOperationRequest isHandled ifTrue:[ + default := #abort. + boxLabels := boxLabels , #('Abort'). + boxValues := boxValues , #(#abort). + AbortAllOperationRequest isHandled ifTrue:[ + boxLabels := boxLabels , #('Abort All'). + boxValues := boxValues , #(#abortAll). + ]. + true "allowDebug" ifTrue:[ + boxLabels := boxLabels , #('Copy Trace and Abort'). + boxValues := boxValues , #(#copyAndAbort). + ]. + ] ifFalse:[ + mayProceed "and:[allowDebug]" ifTrue:[ + boxLabels := boxLabels , #('Copy Trace and Proceed'). + boxValues := boxValues , #(#copyAndProceed). + ]. + ]. + + (allowDebug and:[Debugger notNil]) ifTrue:[ + boxLabels := boxLabels , #('Debug'). + boxValues := boxValues , #(#debug). + default := #debug. + ]. + + action := Dialog + choose:s contents + label:('Exception [' , Processor activeProcess nameOrId , ']') + image:WarningBox errorIconBitmap + labels:boxLabels + values:boxValues + default:default + onCancel:nil. + ]. ]. action == #debug ifTrue:[ - ^ Debugger enter:sender withMessage:aString mayProceed:mayProceed + ^ Debugger enter:sender withMessage:aString mayProceed:mayProceed ]. action == #proceed ifTrue:[ - ^ nil. + ^ nil. ]. (action == #copyAndProceed or:[action == #copyAndAbort]) ifTrue:[ - s := '' writeStream. - Exception handle:[:ex | - 'Caught recursive error while printing backtrace' errorPrintCR. - ] do:[ - sender fullPrintAllOn:s. - ]. - currentScreen rootView setClipboardText:s contents. - action == #copyAndProceed ifTrue:[ - ^ nil - ]. + s := '' writeStream. + Exception handle:[:ex | + 'Caught recursive error while printing backtrace' errorPrintCR. + ] do:[ + sender fullPrintAllOn:s. + ]. + currentScreen rootView setClipboardText:s contents. + action == #copyAndProceed ifTrue:[ + ^ nil + ]. ]. (action == #abortAll) ifTrue:[ - AbortAllOperationRequest raise + AbortAllOperationRequest raise ]. AbortOperationRequest raise. @@ -10297,12 +10282,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. ] " @@ -10317,9 +10302,9 @@ Smalltalk isInitialized ifFalse:[ - "/ thisContext fullPrintAll. - 'information: ' print. aString printCR. - ^ self + "/ thisContext fullPrintAll. + 'information: ' print. aString printCR. + ^ self ]. UserNotification raiseRequestWith:self errorString:aString. @@ -10347,12 +10332,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. ] " @@ -10374,9 +10359,6 @@ ^ aVisitor visitObject:self with:aParameter ! ! - - - !Object class methodsFor:'documentation'! version
--- a/ObjectMemory.st Sun May 15 08:38:43 2016 +0100 +++ b/ObjectMemory.st Tue May 17 10:05:14 2016 +0100 @@ -270,9 +270,9 @@ Interestingly, the scavenger performs better, if many garbage objects are to be reclaimed, since less object-copying has to be done. Therefore, the best-case scavenge time is almost zero, if there is only garbage in - the newSpace. + the newSpace. In contrast, the worst-case is when all newSpace objects are still living. - Thus, garbage reclamation of young objects is basically free - + Thus, garbage reclamation of young objects is basically free - the more garbage is in newspace, the faster is the collector, asymptotically approaching zero time, when all new objects are garbage!! @@ -313,9 +313,9 @@ The blocking mark&sweep runs whenever the oldspace becomes full and the oldSpace limit has been reached (i.e. it prefers to map more pages to the oldSpace up to an - adjustable limit). It puts dead objects onto a free list. + adjustable limit). It puts dead objects onto a free list. If a memory request cannot be served from this freelist, - and the total size of objects on the freelist exceeds a threshold (actually: the fragmentation does so), + and the total size of objects on the freelist exceeds a threshold (actually: the fragmentation does so), the system will compress the oldspace to make the free-space into one big area. This compress is either done by a 1-pass semispace copy algorithm, or a 2pass inplace compress - depending on the setting of the compress limit @@ -349,7 +349,7 @@ (see ProcessorSceduler>>waitForEventOrTimeout), or alternatively as a low or high priority background process (see ObjectMemory>>startBackgroundCollector). Like the normal mark&sweep, this incremental collector follows object references - and marks reachable objects on its way. + and marks reachable objects on its way. However, this is done 'a few objects-at-a-time', to not disrupt the system noticably. Currently, there are some (theoretical) and in practice never occurring situations, in which the incremental GC still creates noticable delays. @@ -428,55 +428,55 @@ Notice, that the defaults below are those of the VM and or ObjectMemory class. These may already be changed by a smalltalk.rc or private.rc startup file. - what default change by - command line arg dynamically + what default change by + command line arg dynamically ----------------------------------------------------------------------- - newSpace size 400k -Mnew nnn newSpaceSize:nnn - - oldSpace size 3000k -Mold nnn moreOldSpace: - announceSpaceNeed: - collectGarbage - - max tenure age 29 lockTenure: - avoidTenure: - (sets it to infinity) - - adaptive tenure - - tenureParameters - - 2pass oldSpace - compressor enabled -Msingle - - - limit for 1pass - old-compress 8000k - oldSpaceCompressLimit: - - chunk size - to increase - oldSpace 256k - oldSpaceIncrement: - - prefer moreOld - to doing GC false - fastMoreOldSpaceAllocation: - - limit for - above - - fastMoreOldSpaceLimit: - - keep size for - - freeSpaceGCAmount: - IGC - - low water - trigger for IGC - - freeSpaceGCLimit: - - allocated - trigger for IGC 500k - incrementalGCLimit - - maximum time - interval between - IGC's - - BackgroundCollectMaximumInterval - - JIT codeCache - size unlimited - dynamicCodeLimit: - - new JIT code - trigger for IGC none - dynamicCodeGCTrigger: + newSpace size 400k -Mnew nnn newSpaceSize:nnn + + oldSpace size 3000k -Mold nnn moreOldSpace: + announceSpaceNeed: + collectGarbage + + max tenure age 29 lockTenure: + avoidTenure: + (sets it to infinity) + + adaptive tenure - - tenureParameters + + 2pass oldSpace + compressor enabled -Msingle - + + limit for 1pass + old-compress 8000k - oldSpaceCompressLimit: + + chunk size + to increase + oldSpace 256k - oldSpaceIncrement: + + prefer moreOld + to doing GC false - fastMoreOldSpaceAllocation: + + limit for + above - - fastMoreOldSpaceLimit: + + keep size for - - freeSpaceGCAmount: + IGC + + low water + trigger for IGC - - freeSpaceGCLimit: + + allocated + trigger for IGC 500k - incrementalGCLimit + + maximum time + interval between + IGC's - - BackgroundCollectMaximumInterval + + JIT codeCache + size unlimited - dynamicCodeLimit: + + new JIT code + trigger for IGC none - dynamicCodeGCTrigger: By default, no incremental GC is started by the system; however, @@ -484,28 +484,28 @@ You have to edit your startup files to change this. A suggested configuration (used by the author and the default) is: - ' keep 1meg in the pocket ' - - ObjectMemory freeSpaceGCAmount:1000000. - - ' start incrementalGC when freespace drops below 250k ' - ' or 500k of oldSpace has been allocated ' - - ObjectMemory freeSpaceGCLimit:250000. ' - ObjectMemory incrementalGCLimit:500000. ' - - ' collect as a background process (the default is: at idle times) - ' this means that running cubes or other demo processes are suspended - ' for the collect; change the prio to below 4 if you want them to continue - - ObjectMemory startBackgroundCollectorAt:5. ' - ObjectMemory startBackgroundFinalizationAt:5. ' - - ' quickly allocate more space (i.e. avoid blocking collects) - ' up to 8meg - then start to collect if more memory is needed. - - ObjectMemory fastMoreOldSpaceLimit:8*1024*1024. ' - ObjectMemory fastMoreOldSpaceAllocation:true. ' + ' keep 1meg in the pocket ' + + ObjectMemory freeSpaceGCAmount:1000000. + + ' start incrementalGC when freespace drops below 250k ' + ' or 500k of oldSpace has been allocated ' + + ObjectMemory freeSpaceGCLimit:250000. ' + ObjectMemory incrementalGCLimit:500000. ' + + ' collect as a background process (the default is: at idle times) + ' this means that running cubes or other demo processes are suspended + ' for the collect; change the prio to below 4 if you want them to continue + + ObjectMemory startBackgroundCollectorAt:5. ' + ObjectMemory startBackgroundFinalizationAt:5. ' + + ' quickly allocate more space (i.e. avoid blocking collects) + ' up to 8meg - then start to collect if more memory is needed. + + ObjectMemory fastMoreOldSpaceLimit:8*1024*1024. ' + ObjectMemory fastMoreOldSpaceAllocation:true. ' hints & tricks: @@ -518,37 +518,37 @@ control over allocation can speedup your programs; but please: - if you think you have to play around with the memory policies, - first check your program - you may find useless allocations - or bad uses of collections. A typical error that is made is to - create large collections using the #, (comma) concatenation method, - which shows square behavior, since it allocates many, many temporary - collections. Also, watch out for #copyWith:, #add: etc. - All of these create a new collection. Remember, that most collections - offer methods to preallocate some space; for example, 'Set new:' creates - an empty set, but preallocates space to avoid resizing over and over. - - An especially bad performace dog is to use #add: on fix-size collection - objects (such as Strings or Arrays), since in addition to allocating - lots of garbage, a #become: operation is required for EACH element - added. NEVER use Arrays for growing/shrinking data - use OrderedCollection - instead. (if you really need an array, use asArray afterwards) + first check your program - you may find useless allocations + or bad uses of collections. A typical error that is made is to + create large collections using the #, (comma) concatenation method, + which shows square behavior, since it allocates many, many temporary + collections. Also, watch out for #copyWith:, #add: etc. + All of these create a new collection. Remember, that most collections + offer methods to preallocate some space; for example, 'Set new:' creates + an empty set, but preallocates space to avoid resizing over and over. + + An especially bad performace dog is to use #add: on fix-size collection + objects (such as Strings or Arrays), since in addition to allocating + lots of garbage, a #become: operation is required for EACH element + added. NEVER use Arrays for growing/shrinking data - use OrderedCollection + instead. (if you really need an array, use asArray afterwards) - if you are going to allocate huge data structures, think about - optimizing space. For example, if you allocate a million instances of - some object, each added instance variable makes up 4Mb of additional - memory need. - Also, for Byte-valued, Integer-valued and Float like objects, special - collections are provided, which store their values directly inside (instead - of a reference to the object). A FloatArray consisting of 1 million floats - requires about 4mb of memory, while an Array of Floats requires 4mb for the - references to the floats, PLUS 20Mb for the floats themself. + optimizing space. For example, if you allocate a million instances of + some object, each added instance variable makes up 4Mb of additional + memory need. + Also, for Byte-valued, Integer-valued and Float like objects, special + collections are provided, which store their values directly inside (instead + of a reference to the object). A FloatArray consisting of 1 million floats + requires about 4mb of memory, while an Array of Floats requires 4mb for the + references to the floats, PLUS 20Mb for the floats themself. - check if you really need fast access to all of these objects; you may - try to only keep some subset in memory, and use binary storage or - (if this is too slow) optimized store/retrieve methods and keep the bigger - part in a file. - (How about a DiskArray class, which does this transparently ? - See the FileText class for some ideas and something to start with ...) + try to only keep some subset in memory, and use binary storage or + (if this is too slow) optimized store/retrieve methods and keep the bigger + part in a file. + (How about a DiskArray class, which does this transparently ? + See the FileText class for some ideas and something to start with ...) Hint / Example 1: @@ -1125,7 +1125,7 @@ debugBreakPoint3 %{ -#ifndef WIN32 +#ifndef __win32__ /*extern void __debugBreakPoint3__();*/ __debugBreakPoint3__(); #endif @@ -2830,7 +2830,7 @@ allowTenureOf:anObject "set the age of anObject back to 0 so it may eventually tenure - into old space. + into old space. This should only be used in very special situations. One such situation may be to ensure that an object is finalized early by the next scavenge, and not by a (possibly late) old space collect. @@ -2838,12 +2838,12 @@ any value with the seatAgeOf:to: message. If the object is already old, this call has no effect. WARNING: this method is for ST/X experts only - it is dangerous, should be used with care - and it may be removed without notice" + it is dangerous, should be used with care + and it may be removed without notice" self setAgeOf:anObject to:0 - + " |p| p := Point new. @@ -3544,7 +3544,7 @@ ! preventTenureOf:anObject - "set the age of anObject to the never-tenure special age. + "set the age of anObject to the never-tenure special age. This prevents the object from ever going out of the new space, and if used without care may lead to a filling of th newspace to a point, where the system becomes inoperable. @@ -3555,14 +3555,14 @@ any value with the seatAgeOf:to: message. If the object is already old, this call has no effect. WARNING: this method is for ST/X experts only - it is dangerous, should be used with care - and it may be removed without notice" + it is dangerous, should be used with care + and it may be removed without notice" %{ /* NOCONTEXT */ #ifndef __SCHTEAM__ if (__isNonNilObject(anObject)) { - _SET_AGE(anObject, NO_TENURE_AGE); - } + _SET_AGE(anObject, NO_TENURE_AGE); + } #endif %} " @@ -3587,21 +3587,21 @@ ! setAgeOf:anObject to:newAge - "change the age of anObject. + "change the age of anObject. This counts the number of scavenges that an object has survived in new space. For old space objects, this is a no-op. WARNING: this method is for ST/X debugging only - it may be removed without notice" + it may be removed without notice" %{ /* NOCONTEXT */ #ifndef __SCHTEAM__ if (__isNonNilObject(anObject) && __isSmallInteger(newAge)) { - int age = __intVal(newAge); - - if (age < 0) age = 0; - else if (age > AGE_MAX) age = AGE_MAX; - _SET_AGE(anObject, age); - } + int age = __intVal(newAge); + + if (age < 0) age = 0; + else if (age > AGE_MAX) age = AGE_MAX; + _SET_AGE(anObject, age); + } #endif %} " @@ -5567,21 +5567,21 @@ localName := self nameForChangesLocal. userPrefs := UserPreferences current. - + "/ if the prefs provide a full, explicit name - (nm := userPrefs changeFileName) isNil ifTrue:[ - - "/ if there is a workspace, create it there - ((wd := userPrefs workspaceDirectory) notNil and:[wd exists]) ifTrue:[ - nm := wd / (localName asFilename baseName) - ] ifFalse:[ - "/ if it was set by a startup file - (nm := ChangeFileName) isNil ifTrue:[ - "/ finally, fall back to a default. - nm := localName - ] - ] - ]. + (nm := userPrefs changeFileName) isNil ifTrue:[ + + "/ if there is a workspace, create it there + ((wd := userPrefs workspaceDirectory) notNil and:[wd exists]) ifTrue:[ + nm := wd / (localName asFilename baseName) + ] ifFalse:[ + "/ if it was set by a startup file + (nm := ChangeFileName) isNil ifTrue:[ + "/ finally, fall back to a default. + nm := localName + ] + ] + ]. ^ nm asFilename pathName. " @@ -5631,10 +5631,10 @@ |localName wd| localName := self nameForSnapshotLocal. - + "/ if there is a workspace, create it there ((wd := UserPreferences current workspaceDirectory) notNil and:[wd exists]) ifTrue:[ - ^ wd / (localName asFilename baseName) + ^ wd / (localName asFilename baseName) ]. ^ localName @@ -5762,7 +5762,7 @@ ST-80 compatibility; send #preSnapshot to all classes " Smalltalk allClassesDo:[:aClass | - aClass preSnapshot + aClass preSnapshot ]. " @@ -5772,55 +5772,55 @@ " snapshotFilename := aFileName asFilename. snapshotFilename isAbsolute ifFalse:[ - snapshotFilename := self directoryForImageAndChangeFile - / snapshotFilename name. + snapshotFilename := self directoryForImageAndChangeFile + / snapshotFilename name. ]. tempFilename := (FileStream newTemporaryIn:snapshotFilename directory) - close; - fileName. + close; + fileName. ok := self primSnapShotOn:tempFilename. ok ifTrue:[ - "keep history of one snapshot file" - snapshotFilename exists ifTrue:[ - tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights. - snapshotFilename renameTo:(snapshotFilename withSuffix:'sav'). - ] ifFalse:[ - "image file hat stx as interpreter and can be executed" - tempFilename makeExecutable. - ]. - tempFilename renameTo:snapshotFilename. - - Class addChangeRecordForSnapshot:aFileName. - - setImageName ifTrue:[ - oldChangeFile := self nameForChanges. - ImageName := snapshotFilename asAbsoluteFilename asString. - self refreshChangesFrom:oldChangeFile. - ]. + "keep history of one snapshot file" + snapshotFilename exists ifTrue:[ + tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights. + snapshotFilename renameTo:(snapshotFilename withSuffix:'sav'). + ] ifFalse:[ + "image file hat stx as interpreter and can be executed" + tempFilename makeExecutable. + ]. + tempFilename renameTo:snapshotFilename. + + Class addChangeRecordForSnapshot:aFileName. + + setImageName ifTrue:[ + oldChangeFile := self nameForChanges. + ImageName := snapshotFilename asAbsoluteFilename asString. + self refreshChangesFrom:oldChangeFile. + ]. ] ifFalse:[ - tempFilename remove. + tempFilename remove. ]. " ST-80 compatibility; send #postSnapshot to all classes " Smalltalk allClassesDo:[:aClass | - aClass postSnapshot + aClass postSnapshot ]. self changed:#finishedSnapshot. "/ ST-80 compatibility ok ifFalse:[ - SnapshotError raise. - "not reached" + SnapshotError raise. + "not reached" ]. Transcript - show:'Snapshot '; show:snapshotFilename baseName allBold; - show:' saved '; show:Timestamp now; - show:' in '; show:snapshotFilename asAbsoluteFilename directoryName; - showCR:'.'. + show:'Snapshot '; show:snapshotFilename baseName allBold; + show:' saved '; show:Timestamp now; + show:' in '; show:snapshotFilename asAbsoluteFilename directoryName; + showCR:'.'. ^ ok
--- a/OpenVMSOperatingSystem.st Sun May 15 08:38:43 2016 +0100 +++ b/OpenVMSOperatingSystem.st Tue May 17 10:05:14 2016 +0100 @@ -243,7 +243,7 @@ #endif #ifndef _IOCTL_H_INCLUDED_ -# ifndef WIN32 +# ifndef __win32__ # include <sys/ioctl.h> # define _IOCTL_H_INCLUDED_ # endif @@ -4517,7 +4517,7 @@ |osSeconds i| %{ -#if !defined(WIN32) && !defined(__VMS__) +#if !defined(__win32__) && !defined(__VMS__) struct stat buf; time_t mtime; int ret; @@ -4560,7 +4560,7 @@ |osSeconds i| %{ -#if !defined(WIN32) && !defined(__VMS__) +#if !defined(__win32__) && !defined(__VMS__) struct stat buf; int ret; time_t mtime; @@ -5026,7 +5026,7 @@ # endif #endif #ifdef SIGALRM -# ifndef WIN32 +# ifndef __win32__ # ifndef __signalTimerInterrupt extern void __signalTimerInterrupt(SIGHANDLER_ARG); # endif @@ -5065,7 +5065,7 @@ #ifdef SIGQUIT case SIGQUIT: #endif -#ifdef WIN32 +#ifdef __win32__ # ifdef PROCESSDEBUGWIN32 printf("ConsoleSignal %d\n",sigNr); # endif @@ -5154,7 +5154,7 @@ vec.sv_handler = handler; sigvec(sigNr, &vec, NULL); # else -# ifdef WIN32 +# ifdef __win32__ # ifdef PROCESSDEBUGWIN32 printf("signal %d can't change handler\n",sigNr); # endif @@ -7854,6 +7854,6 @@ !OpenVMSOperatingSystem class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/OpenVMSOperatingSystem.st,v 1.18 2015-01-12 12:50:08 cg Exp $' + ^ '$Header$' ! ! OpenVMSOperatingSystem initialize!
--- a/OrderedDictionary.st Sun May 15 08:38:43 2016 +0100 +++ b/OrderedDictionary.st Tue May 17 10:05:14 2016 +0100 @@ -937,6 +937,11 @@ ! removeKey:aKey ifAbsent:aBlock + "remove key (and the associated value) from the receiver, + return the value previously stored there. + If it was not in the collection return the result + from evaluating aBlock." + |oldValue| oldValue := super removeKey:aKey ifAbsent:aBlock.
--- a/PipeStream.st Sun May 15 08:38:43 2016 +0100 +++ b/PipeStream.st Tue May 17 10:05:14 2016 +0100 @@ -24,7 +24,7 @@ %{ #include "stxOSDefs.h" -#if defined(WIN32) +#if defined(__win32__) # undef UNIX_LIKE # define MSDOS_LIKE #endif @@ -165,28 +165,28 @@ For example, to get a stream reading the output of an 'ls -l' command, a PipeStream can be created with: - PipeStream readingFrom:'ls -l' + PipeStream readingFrom:'ls -l' the characters of the command's output can be read using the standard stream messages, such as next, nextLine etc. Example for writing to a command: - PipeStream writingTo:'cat >/tmp/x' + PipeStream writingTo:'cat >/tmp/x' Bidirectional pipestreams (supporting both reading an writing) may be used for filters: - PipeStream bidirectionalFor:'sed -e ''s/Hello/Greetings/''' + PipeStream bidirectionalFor:'sed -e ''s/Hello/Greetings/''' Buffered pipes do not work with Linux - the stdio library seems to be buggy (trying to restart the read ...) [author:] - Claus Gittinger + Claus Gittinger [see also:] - ExternalStream FileStream Socket - OperatingSystem + ExternalStream FileStream Socket + OperatingSystem " ! ! @@ -444,9 +444,9 @@ p isNil ifTrue:[^ nil]. [ - cmdOutput := p contentsAsString. + cmdOutput := p contentsAsString. ] ensure:[ - p close. + p close. ]. ^ cmdOutput @@ -491,9 +491,9 @@ "terminate first under windows" OperatingSystem isMSDOSlike ifTrue:[ - self terminatePipeCommand. - self closeFileDescriptor. - ^ self. + self terminatePipeCommand. + self closeFileDescriptor. + ^ self. ]. "terminate last under unix" @@ -568,7 +568,7 @@ if (@global(FileOpenTrace) == true) { console_fprintf(stderr, "close [PipeStream] %"_lx_" fd=%d\n", (INT)f, fileno(f)); } -#ifdef WIN32 +#ifdef __win32__ do { __threadErrno = 0; retVal = __STX_C_NOINT_CALL1( "close", (void*)close, (void*)fileno(f) ); @@ -611,17 +611,17 @@ realCmd execDirectory tmpComFile nullOutput resultPid errorNumber| handle notNil ifTrue:[ - "the pipe was already open ... - this should (can) not happen." - ^ self errorAlreadyOpen + "the pipe was already open ... + this should (can) not happen." + ^ self errorAlreadyOpen ]. rwMode = #r ifTrue:[ - mode := #readonly. didWrite := false. + mode := #readonly. didWrite := false. ] ifFalse:[rwMode = #'r+' ifTrue:[ - mode := #readwrite. didWrite := true. + mode := #readwrite. didWrite := true. ] ifFalse:[ - mode := #writeonly. didWrite := true. + mode := #writeonly. didWrite := true. ]]. lastErrorNumber := nil. @@ -633,79 +633,79 @@ execFdArray := #(0 1 2) copy. OperatingSystem isVMSlike ifTrue:[ - "/ - "/ the generated COM-file includes a 'set default' - "/ - tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory. - realCmd := '@' , tmpComFile osName. - execDirectory := nil. + "/ + "/ the generated COM-file includes a 'set default' + "/ + tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory. + realCmd := '@' , tmpComFile osName. + execDirectory := nil. - mbx := OperatingSystem createMailBox. - mbx isNil ifTrue:[ - lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber. - tmpComFile delete. - ^ self openError:errorNumber. - ]. - mbxName := OperatingSystem mailBoxNameOf:mbx. + mbx := OperatingSystem createMailBox. + mbx isNil ifTrue:[ + lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber. + tmpComFile delete. + ^ self openError:errorNumber. + ]. + mbxName := OperatingSystem mailBoxNameOf:mbx. - "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR. - shellPath := ''. - shellArgs := realCmd. + "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR. + shellPath := ''. + shellArgs := realCmd. - rwMode = #r ifTrue:[ - "redirect stdout of subprocess to write to mailbox" - execFdArray at:2 put:mbx. - ] ifFalse:[ - "redirect stdin of subprocess to read from mailbox" - execFdArray at:1 put:mbx. - ]. + rwMode = #r ifTrue:[ + "redirect stdout of subprocess to write to mailbox" + execFdArray at:2 put:mbx. + ] ifFalse:[ + "redirect stdin of subprocess to read from mailbox" + execFdArray at:1 put:mbx. + ]. ] ifFalse:[ - shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd. - shellPath := shellAndArgs at:1. - shellArgs := shellAndArgs at:2. + shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd. + shellPath := shellAndArgs at:1. + shellArgs := shellAndArgs at:2. - mode == #readwrite ifTrue:[ - pipeFdArray := OperatingSystem makeBidirectionalPipe. - pipeFdArray isNil ifTrue:[ - lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber. - ^ self openError:errorNumber. - ]. - myFd := pipeFdArray at:1. - execFd := pipeFdArray at:2. - execFdArray at:1 put:execFd. - execFdArray at:2 put:execFd. - ] ifFalse:[ - pipeFdArray := OperatingSystem makePipe. - pipeFdArray isNil ifTrue:[ - lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber. - ^ self openError:errorNumber. - ]. + mode == #readwrite ifTrue:[ + pipeFdArray := OperatingSystem makeBidirectionalPipe. + pipeFdArray isNil ifTrue:[ + lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber. + ^ self openError:errorNumber. + ]. + myFd := pipeFdArray at:1. + execFd := pipeFdArray at:2. + execFdArray at:1 put:execFd. + execFdArray at:2 put:execFd. + ] ifFalse:[ + pipeFdArray := OperatingSystem makePipe. + pipeFdArray isNil ifTrue:[ + lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber. + ^ self openError:errorNumber. + ]. - mode == #readonly ifTrue:[ - "redirect stdout of subprocess to write to pipe" - myFd := pipeFdArray at:1. - execFd := pipeFdArray at:2. - execFdArray at:2 put:execFd. - ] ifFalse:[ - "redirect stdin of subprocess to read from pipe" - myFd := pipeFdArray at:2. - execFd := pipeFdArray at:1. - execFdArray at:1 put:execFd. - ]. - ]. + mode == #readonly ifTrue:[ + "redirect stdout of subprocess to write to pipe" + myFd := pipeFdArray at:1. + execFd := pipeFdArray at:2. + execFdArray at:2 put:execFd. + ] ifFalse:[ + "redirect stdin of subprocess to read from pipe" + myFd := pipeFdArray at:2. + execFd := pipeFdArray at:1. + execFdArray at:1 put:execFd. + ]. + ]. ]. errorDisposition == #discard ifTrue:[ - nullOutput := Filename nullDevice writeStream. - execFdArray at:3 put:nullOutput fileDescriptor + nullOutput := Filename nullDevice writeStream. + execFdArray at:3 put:nullOutput fileDescriptor ] ifFalse:[ - (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[ - execFdArray at:3 put:1 - ] ifFalse:[ + (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[ + execFdArray at:3 put:1 + ] ifFalse:[ "/ errorDisposition isStream ifTrue:[ "/self halt. "/ ]. - ]. + ]. ]. "/ must block here, to avoid races due to early finishing @@ -715,84 +715,84 @@ "beware: pid may change if subprocess is fast" pid := resultPid := Processor - monitor:[ - OperatingSystem - exec:shellPath - withArguments:shellArgs - environment:nil - fileDescriptors:execFdArray - fork:true - newPgrp:true - inDirectory:execDirectory. - ] - action:[:status | - status stillAlive ifFalse:[ - exitStatus := status. + monitor:[ + OperatingSystem + exec:shellPath + withArguments:shellArgs + environment:nil + fileDescriptors:execFdArray + fork:true + newPgrp:true + inDirectory:execDirectory. + ] + action:[:status | + status stillAlive ifFalse:[ + exitStatus := status. - "writing doesn't make sense - there is no reader any longer" - mode == #readwrite ifTrue:[ - "... but allow to read the rest of the command's output" - self shutDownOutput. - ] ifFalse:[mode == #writeonly ifTrue:[ - self closeFileDescriptor. - ]]. + "writing doesn't make sense - there is no reader any longer" + mode == #readwrite ifTrue:[ + "... but allow to read the rest of the command's output" + self shutDownOutput. + ] ifFalse:[mode == #writeonly ifTrue:[ + self closeFileDescriptor. + ]]. - OperatingSystem closePid:pid. - pid := nil. - exitSema signal. - ]. - ]. + OperatingSystem closePid:pid. + pid := nil. + exitSema signal. + ]. + ]. "subprocess has been created. close unused filedescriptors" execFd notNil ifTrue:[ - OperatingSystem closeFd:execFd. + OperatingSystem closeFd:execFd. ]. nullOutput notNil ifTrue:[ - nullOutput close + nullOutput close ]. resultPid notNil ifTrue:[ - "successfull creation of subprocesss" - OperatingSystem isVMSlike ifTrue:[ - "/ - "/ reopen the mailbox as a file ... - "/ - mbxName := OperatingSystem mailBoxNameOf:mbx. - mbxName notNil ifTrue:[ - super open:mbxName withMode:rwMode. - exitAction := [tmpComFile delete]. - ]. - ] ifFalse:[ - self setFileDescriptor:myFd mode:rwMode. - handleType := #pipeFilePointer. - ] + "successfull creation of subprocesss" + OperatingSystem isVMSlike ifTrue:[ + "/ + "/ reopen the mailbox as a file ... + "/ + mbxName := OperatingSystem mailBoxNameOf:mbx. + mbxName notNil ifTrue:[ + super open:mbxName withMode:rwMode. + exitAction := [tmpComFile delete]. + ]. + ] ifFalse:[ + self setFileDescriptor:myFd mode:rwMode. + handleType := #pipeFilePointer. + ] ] ifFalse:[ - "creation of subprocesss failed" - lastErrorNumber := OperatingSystem currentErrorNumber. - OperatingSystem isVMSlike ifTrue:[ - OperatingSystem destroyMailBox:mbx. - tmpComFile delete. - ] ifFalse:[ - OperatingSystem closeFd:myFd. - ]. + "creation of subprocesss failed" + lastErrorNumber := OperatingSystem currentErrorNumber. + OperatingSystem isVMSlike ifTrue:[ + OperatingSystem destroyMailBox:mbx. + tmpComFile delete. + ] ifFalse:[ + OperatingSystem closeFd:myFd. + ]. ]. blocked ifFalse:[ - OperatingSystem unblockInterrupts + OperatingSystem unblockInterrupts ]. (resultPid isNil or:[lastErrorNumber notNil]) ifTrue:[ - " - the pipe open failed for some reason ... - ... this may be either due to an invalid command string, - or due to the system running out of memory (when forking - the unix process) - " - exitAction value. - ^ self openError:lastErrorNumber. + " + the pipe open failed for some reason ... + ... this may be either due to an invalid command string, + or due to the system running out of memory (when forking + the unix process) + " + exitAction value. + ^ self openError:lastErrorNumber. ]. commandString := realCmd.
--- a/Process.st Sun May 15 08:38:43 2016 +0100 +++ b/Process.st Tue May 17 10:05:14 2016 +0100 @@ -42,7 +42,7 @@ documentation " - WARNING: + WARNING: the offsets of the instance variables lookupActivations and lookupDisabled are known in the VM do not remove them, and do not insert/remove instance variables before them @@ -377,7 +377,7 @@ "return the default max stack size. All new processes get this limit initially. It may be changed for individual processes with: - aProcess setMaximumStackSize:limit" + aProcess setMaximumStackSize:limit" %{ /* NOCONTEXT */ extern INT __defaultThreadMaxStackSize(); @@ -396,16 +396,16 @@ "set the default max stack size, return the previous value. All new processes get this stack limit initially. It may be changed for individual processes with: - aProcess setMaximumStackSize:limit + aProcess setMaximumStackSize:limit Notice: - There is seldom any need to change the default setting, - except for highly recursive programs." + There is seldom any need to change the default setting, + except for highly recursive programs." %{ /* NOCONTEXT */ extern INT __threadSetDefaultMaxStackSize(); if (__isSmallInteger(numberOfBytes)) { - RETURN ( __mkSmallInteger(__threadSetDefaultMaxStackSize(__intVal(numberOfBytes)) )); + RETURN ( __mkSmallInteger(__threadSetDefaultMaxStackSize(__intVal(numberOfBytes)) )); } %} @@ -417,7 +417,7 @@ ! wrapStackSize - "return the wrap stack size. + "return the wrap stack size. Under windows, blocking API calls are executed on a separate stack with this size. If you ever encounter that a call to n external library function requires more stack than this, you may change this size in your startup (or programmatically) during early startup. @@ -426,7 +426,7 @@ %{ /* NOCONTEXT */ INT sz = 0; -#ifdef WIN32 +#ifdef __win32__ extern INT __getWrapStackSize(); sz = __getWrapStackSize(); @@ -436,7 +436,7 @@ ! wrapStackSize:newSize - "set the wrap stack size. + "set the wrap stack size. Under windows, blocking API calls are executed on a separate stack with this size. If you ever encounter that a call to n external library function requires more stack than this, you may change this size in your startup (or programmatically) during early startup. @@ -447,15 +447,15 @@ INT __oldSize = 0; if (__isSmallInteger(newSize)) { - INT __newSize = __intVal(newSize); - - if (__newSize >= 0) { -#ifdef WIN32 - extern INT __setWrapStackSize(INT); - - __oldSize = __setWrapStackSize(__newSize); + INT __newSize = __intVal(newSize); + + if (__newSize >= 0) { +#ifdef __win32__ + extern INT __setWrapStackSize(INT); + + __oldSize = __setWrapStackSize(__newSize); #endif - } + } } RETURN (__MKINT(__oldSize)); %} @@ -835,7 +835,7 @@ OBJ i; if (__isSmallInteger(i = __INST(id))) { - RETURN( __MKINT(__threadMaxStackSize(__intVal(i))) ); + RETURN( __MKINT(__threadMaxStackSize(__intVal(i))) ); } %}. ^ nil @@ -853,7 +853,7 @@ if (__isSmallInteger(i = __INST(id)) && __isSmallInteger(limit) ) { - RETURN ( __MKINT(__threadSetMaxStackSize(__intVal(i), __intVal(limit))) ); + RETURN ( __MKINT(__threadSetMaxStackSize(__intVal(i), __intVal(limit))) ); } %}. ^ nil @@ -872,7 +872,7 @@ && __isSmallInteger(initial) && __isSmallInteger(increment) && __isSmallInteger(safe)) { - RETURN ( __threadSetJunkSizes(__intVal(i), __intVal(initial), __intVal(increment), __intVal(safe)) ? true : false ); + RETURN ( __threadSetJunkSizes(__intVal(i), __intVal(initial), __intVal(increment), __intVal(safe)) ? true : false ); } %}. ^ false @@ -1077,9 +1077,9 @@ OBJ i; if (__isSmallInteger(i = __INST(id))) { - n = __threadNumberOfStackBoundaryHits(__intVal(i)); - n &= _MAX_INT; - RETURN( __mkSmallInteger(n) ); + n = __threadNumberOfStackBoundaryHits(__intVal(i)); + n &= _MAX_INT; + RETURN( __mkSmallInteger(n) ); } %}. ^ nil @@ -1094,7 +1094,7 @@ OBJ i; if (__isSmallInteger(i = __INST(id))) { - RETURN( __mkSmallInteger((INT)__threadStackSegments(__intVal(i))) ); + RETURN( __mkSmallInteger((INT)__threadStackSegments(__intVal(i))) ); } %}. ^ nil @@ -1109,7 +1109,7 @@ OBJ i; if (__isSmallInteger(i = __INST(id))) { - RETURN( __MKINT(__threadTotalStackSize(__intVal(i))) ); + RETURN( __MKINT(__threadTotalStackSize(__intVal(i))) ); } %}. ^ nil @@ -1124,7 +1124,7 @@ OBJ i; if (__isSmallInteger(i = __INST(id))) { - RETURN( __MKINT(__threadUsedStackSize(__intVal(i))) ); + RETURN( __MKINT(__threadUsedStackSize(__intVal(i))) ); } %}. ^ nil @@ -1814,22 +1814,22 @@ suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll]. suspendActions notNil ifTrue:[ - |savedState| - - savedState := state. - state := #aboutToSuspend. - suspendActions do:[:action | action value]. - state ~~ #aboutToSuspend ifTrue:[ - "/ mhmh - one of the suspendActions lead to making me active again; - "/ bail out. - "/ This fixes the Semaphore was signalled, but process did not run error, - "/ which can happen when a process with a suspend action goes into a readWait, - "/ and the suspend action does a thread switch, and the readWait semaphore gets - "/ signalled before we come back here. Then the semaphore wakeup will have already - "/ place me back into the run state, so I should not go into a suspend below. - ^ self. - ]. - state := savedState. + |savedState| + + savedState := state. + state := #aboutToSuspend. + suspendActions do:[:action | action value]. + state ~~ #aboutToSuspend ifTrue:[ + "/ mhmh - one of the suspendActions lead to making me active again; + "/ bail out. + "/ This fixes the Semaphore was signalled, but process did not run error, + "/ which can happen when a process with a suspend action goes into a readWait, + "/ and the suspend action does a thread switch, and the readWait semaphore gets + "/ signalled before we come back here. Then the semaphore wakeup will have already + "/ place me back into the run state, so I should not go into a suspend below. + ^ self. + ]. + state := savedState. ]. " @@ -1841,7 +1841,7 @@ (state == #active or:[state == #run or:[aStateSymbol == #stopped]]) ifTrue:[ - state := aStateSymbol. + state := aStateSymbol. ]. Processor suspend:self ! @@ -1913,26 +1913,26 @@ the receiver itself)." id isNil ifTrue:[ - "/ problem: - "/ if receiver is already dead, its id is nil. - "/ children are found by looking for processes with a parentID identical to - "/ mine - ifNil, system processes are found, which is probably not what you - "/ want ... - "/ FIX: remember the id (or dont nil it when terminating) - "/ requires VM changes. - ProcessorScheduler invalidProcessSignal - raiseRequestWith:self - errorString:'process is already dead - cannot determine child processes'. - ^ self + "/ problem: + "/ if receiver is already dead, its id is nil. + "/ children are found by looking for processes with a parentID identical to + "/ mine - ifNil, system processes are found, which is probably not what you + "/ want ... + "/ FIX: remember the id (or dont nil it when terminating) + "/ requires VM changes. + ProcessorScheduler invalidProcessSignal + raiseRequestWith:self + errorString:'process is already dead - cannot determine child processes'. + ^ self ]. ProcessorScheduler knownProcesses do:[:aProcess | - aProcess ~~ self ifTrue:[ - aProcess creatorId == id ifTrue:[ - aProcess isGUIProcess ifTrue:[ - aProcess terminateWithAllGUISubprocesses - ] - ] - ] + aProcess ~~ self ifTrue:[ + aProcess creatorId == id ifTrue:[ + aProcess isGUIProcess ifTrue:[ + aProcess terminateWithAllGUISubprocesses + ] + ] + ] ]. "Created: / 28-10-1996 / 20:43:32 / cg" @@ -1946,17 +1946,17 @@ and recursively oll of their group processes.)." id isNil ifTrue:[ - "/ problem: - "/ if receiver is already dead, its id is nil. - "/ children are found by looking for processes with a parentID identical to - "/ mine - ifNil, system processes are found, which is probably not what you - "/ want ... - "/ FIX: remember the id (or dont nil it when terminating) - "/ requires VM changes. - ProcessorScheduler invalidProcessSignal - raiseRequestWith:self - errorString:'process is already dead - cannot determine child processes'. - ^ self + "/ problem: + "/ if receiver is already dead, its id is nil. + "/ children are found by looking for processes with a parentID identical to + "/ mine - ifNil, system processes are found, which is probably not what you + "/ want ... + "/ FIX: remember the id (or dont nil it when terminating) + "/ requires VM changes. + ProcessorScheduler invalidProcessSignal + raiseRequestWith:self + errorString:'process is already dead - cannot determine child processes'. + ^ self ]. self terminateAllSubprocessesInGroup:id ! @@ -1968,11 +1968,11 @@ and recursively oll of their group processes.)." ProcessorScheduler knownProcesses do:[:aProcess | - aProcess ~~ self ifTrue:[ - (aProcess processGroupId == aGroup) ifTrue:[ - aProcess terminateWithAllSubprocessesInGroup - ] - ] + aProcess ~~ self ifTrue:[ + (aProcess processGroupId == aGroup) ifTrue:[ + aProcess terminateWithAllSubprocessesInGroup + ] + ] ]. "Created: / 28.10.1996 / 20:43:32 / cg" @@ -1984,24 +1984,24 @@ that are in the receiver's process group." id isNil ifTrue:[ - "/ problem: - "/ if receiver is already dead, its id is nil. - "/ children are found by looking for processes with a parentID identical to - "/ mine - ifNil, system processes are found, which is probably not what you - "/ want ... - "/ FIX: remember the id (or dont nil it when terminating) - "/ requires VM changes. - ProcessorScheduler invalidProcessSignal - raiseRequestWith:self - errorString:'process is already dead - cannot determine child processes'. - ^ self + "/ problem: + "/ if receiver is already dead, its id is nil. + "/ children are found by looking for processes with a parentID identical to + "/ mine - ifNil, system processes are found, which is probably not what you + "/ want ... + "/ FIX: remember the id (or dont nil it when terminating) + "/ requires VM changes. + ProcessorScheduler invalidProcessSignal + raiseRequestWith:self + errorString:'process is already dead - cannot determine child processes'. + ^ self ]. ProcessorScheduler knownProcesses do:[:aProcess | - aProcess ~~ self ifTrue:[ - aProcess processGroupId == id ifTrue:[ - aProcess terminate - ] - ] + aProcess ~~ self ifTrue:[ + aProcess processGroupId == id ifTrue:[ + aProcess terminate + ] + ] ]. self terminate ! @@ -2041,29 +2041,29 @@ the receiver itself)." id isNil ifTrue:[ - "/ problem: - "/ if receiver is already dead, its id is nil. - "/ children are found by looking for processes with a parentID identical to - "/ mine - ifNil, system processes are found, which is probably not what you - "/ want ... - "/ FIX: remember the id (or dont nil it when terminating) - "/ requires VM changes. - ProcessorScheduler invalidProcessSignal - raiseRequestWith:self - errorString:'process is already dead - cannot determine child processes'. - ^ self + "/ problem: + "/ if receiver is already dead, its id is nil. + "/ children are found by looking for processes with a parentID identical to + "/ mine - ifNil, system processes are found, which is probably not what you + "/ want ... + "/ FIX: remember the id (or dont nil it when terminating) + "/ requires VM changes. + ProcessorScheduler invalidProcessSignal + raiseRequestWith:self + errorString:'process is already dead - cannot determine child processes'. + ^ self ]. processGroupId == 0 ifTrue:[ - ProcessorScheduler invalidProcessSignal - raiseWith:self errorString:'trying to terminate the system process group'. + ProcessorScheduler invalidProcessSignal + raiseWith:self errorString:'trying to terminate the system process group'. ]. ProcessorScheduler knownProcesses do:[:aProcess | - aProcess ~~ self ifTrue:[ - (aProcess processGroupId == processGroupId - or:[aProcess processGroupId == id]) ifTrue:[ - aProcess terminate - ] - ] + aProcess ~~ self ifTrue:[ + (aProcess processGroupId == processGroupId + or:[aProcess processGroupId == id]) ifTrue:[ + aProcess terminate + ] + ] ]. "Created: 28.10.1996 / 20:41:49 / cg" @@ -2145,7 +2145,7 @@ ^ aValue ! -environmentIncludesKey:aKey +environmentIncludesKey:aKey "true if there is a thread local variable, false if no such variable exists" environment isNil ifTrue:[^ false]. @@ -2156,23 +2156,23 @@ "the processes stderr. By default, this is Stderr, but it can be overwritten (for example to redirect a thread's error output to some other place" - + ^ self environmentAt:#Stderr ifAbsent:Stderr " Processor activeProcess stdout " - + " |out sema| - + out := WriteStream on:''. sema := Semaphore new. [ - Processor activeProcess environmentAt:#Stdout put:out. - 'hello world' printCR. - sema signal. - ] fork. + Processor activeProcess environmentAt:#Stdout put:out. + 'hello world' printCR. + sema signal. + ] fork. sema wait. Transcript showCR:('output was: ''',out contents,''''). " @@ -2182,7 +2182,7 @@ "the processes stdin. By default, this is Stdin, but it can be overwritten (for example to redirect a thread's input from some other place" - + ^ self environmentAt:#Stdin ifAbsent:Stdin ! @@ -2190,7 +2190,7 @@ "the processes stdout. By default, this is Stdout, but it can be overwritten (for example to redirect a thread's output to some other place" - + ^ self environmentAt:#Stdout ifAbsent:Stdout ! @@ -2208,7 +2208,7 @@ "the processes transcript. By default, this is Transcript, but it can be overwritten (for example to redirect a thread's output to some other place" - + ^ self environmentAt:#Transcript ifAbsent:[Transcript] ! @@ -2221,10 +2221,10 @@ oldEnv := environment. [ - environment := aDictionary. - result := aBlock value. + environment := aDictionary. + result := aBlock value. ] ensure:[ - environment := oldEnv. + environment := oldEnv. ]. ^ result !
--- a/ProcessorScheduler.st Sun May 15 08:38:43 2016 +0100 +++ b/ProcessorScheduler.st Tue May 17 10:05:14 2016 +0100 @@ -25,7 +25,8 @@ supportDynamicPriorities timeSliceNeededSemaphore scheduledProcesses preWaitActions timeoutHandlerProcess readableResultFdArray writableResultFdArray exceptFdArray - exceptResultFdArray exceptSemaphoreArray' + exceptResultFdArray exceptSemaphoreArray interruptCounter + timedActionCounter' classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven UserSchedulingPriority UserInterruptPriority TimingPriority HighestPriority SchedulingPriority MaxNumberOfProcesses @@ -577,6 +578,16 @@ "Processor currentPriority" ! +interruptCounter + "for statistics: counts the overall number of interrupts" + + ^ interruptCounter + + " + Processor interruptCounter + " +! + interruptedProcess "returns the process which was interrupted by the active one" @@ -593,6 +604,16 @@ "return the scheduling process" ^ scheduler +! + +timedActionCounter + "for statistics: counts the overall number of timer actions" + + ^ timedActionCounter + + " + Processor timedActionCounter + " ! ! !ProcessorScheduler methodsFor:'background processing'! @@ -646,7 +667,7 @@ handle all timeout actions " anyTimeouts ifTrue:[ - self evaluateTimeouts + self evaluateTimeouts ]. "first do a quick check for semaphores using checkActions - this is needed for @@ -658,40 +679,40 @@ " nActions := readCheckArray size. 1 to:nActions do:[:index | - checkBlock := readCheckArray at:index. - (checkBlock notNil and:[checkBlock value]) ifTrue:[ - sema := readSemaphoreArray at:index. - sema notNil ifTrue:[ - sema signalOnce. - ]. - ] + checkBlock := readCheckArray at:index. + (checkBlock notNil and:[checkBlock value]) ifTrue:[ + sema := readSemaphoreArray at:index. + sema notNil ifTrue:[ + sema signalOnce. + ]. + ] ]. nActions := writeCheckArray size. 1 to:nActions do:[:index | - checkBlock := writeCheckArray at:index. - (checkBlock notNil and:[checkBlock value]) ifTrue:[ - sema := writeSemaphoreArray at:index. - sema notNil ifTrue:[ - sema signalOnce. - ]. - ] + checkBlock := writeCheckArray at:index. + (checkBlock notNil and:[checkBlock value]) ifTrue:[ + sema := writeSemaphoreArray at:index. + sema notNil ifTrue:[ + sema signalOnce. + ]. + ] ]. "now, someone might be runnable ..." p := self highestPriorityRunnableProcess. p isNil ifTrue:[ - "/ no one runnable, hard wait for event or timeout - "/ Trace ifTrue:['w' printCR.]. - self waitForEventOrTimeout. - - "/ check for OS process termination - gotChildSignalInterrupt ifTrue:[ - gotChildSignalInterrupt := false. - self handleChildSignalInterrupt - ]. - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ self + "/ no one runnable, hard wait for event or timeout + "/ Trace ifTrue:['w' printCR.]. + self waitForEventOrTimeout. + + "/ check for OS process termination + gotChildSignalInterrupt ifTrue:[ + gotChildSignalInterrupt := false. + self handleChildSignalInterrupt + ]. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ self ]. pri := p priority. @@ -722,13 +743,13 @@ " pri < TimingPriority ifTrue:[ - anyTimeouts ifTrue:[ - millis := self timeToNextTimeout. - millis == 0 ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ self - ] - ] + anyTimeouts ifTrue:[ + millis := self timeToNextTimeout. + millis == 0 ifTrue:[ + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ self + ] + ] ]. " @@ -741,38 +762,38 @@ pri < UserInterruptPriority ifTrue:[ "comment out this if above is uncommented" - anyTimeouts ifTrue:[ - millis := self timeToNextTimeout. - millis == 0 ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ self - ]. - ]. + anyTimeouts ifTrue:[ + millis := self timeToNextTimeout. + millis == 0 ifTrue:[ + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ self + ]. + ]. "---" - useIOInterrupts ifTrue:[ + useIOInterrupts ifTrue:[ "/ readFdArray do:[:fd | "/ (fd notNil and:[fd >= 0]) ifTrue:[ "/ OperatingSystem enableIOInterruptsOn:fd "/ ]. "/ ]. - ] ifFalse:[ - millis notNil ifTrue:[ - millis := millis min:EventPollingInterval - ] ifFalse:[ - millis := EventPollingInterval - ] - ] + ] ifFalse:[ + millis notNil ifTrue:[ + millis := millis min:EventPollingInterval + ] ifFalse:[ + millis := EventPollingInterval + ] + ] ]. millis notNil ifTrue:[ - "/ Trace ifTrue:['C' print. millis printCR.]. - "schedule a clock interrupt after millis milliseconds" - OperatingSystem enableTimer:millis rounded. + "/ Trace ifTrue:['C' print. millis printCR.]. + "schedule a clock interrupt after millis milliseconds" + OperatingSystem enableTimer:millis rounded. ]. scheduledProcesses notNil ifTrue:[ - scheduledProcesses add:p + scheduledProcesses add:p ]. " @@ -784,17 +805,17 @@ "/ Trace ifTrue:['<-' printCR.]. "... when we arrive here, we are back on stage. - Either by an ALARM or IO signal, or by a suspend of another process + Either by an ALARM or IO signal, or by a suspend of another process " millis notNil ifTrue:[ - OperatingSystem disableTimer. + OperatingSystem disableTimer. ]. "/ check for OS process termination gotChildSignalInterrupt ifTrue:[ - gotChildSignalInterrupt := false. - self handleChildSignalInterrupt + gotChildSignalInterrupt := false. + self handleChildSignalInterrupt ]. "/ check for new input @@ -802,8 +823,8 @@ OperatingSystem unblockInterrupts. (gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[ - gotIOInterrupt := false. - self checkForIOWithTimeout:0. + gotIOInterrupt := false. + self checkForIOWithTimeout:0. ]. wasBlocked ifTrue:[OperatingSystem blockInterrupts]. @@ -891,9 +912,9 @@ p l| KnownProcesses isNil ifTrue:[ - KnownProcesses := WeakArray new:30. - KnownProcesses addDependent:self class. - KnownProcessIds := OrderedCollection new:30. + KnownProcesses := WeakArray new:30. + KnownProcesses addDependent:self class. + KnownProcessIds := OrderedCollection new:30. ]. " @@ -922,10 +943,11 @@ gotIOInterrupt := false. osChildExitActions := Dictionary new. gotChildSignalInterrupt := false. + interruptCounter := timedActionCounter := 0. supportDynamicPriorities := false. exitWhenNoMoreUserProcesses isNil ifTrue:[ - exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ? + exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ? ]. " @@ -937,10 +959,10 @@ currentPriority := SchedulingPriority. p := Process basicNew. p - setId:0 state:#run; - setPriority:currentPriority; - name:'scheduler'; - beSystemProcess. + setId:0 state:#run; + setPriority:currentPriority; + name:'scheduler'; + beSystemProcess. scheduler := activeProcess := p. activeProcessId := 0. @@ -953,8 +975,8 @@ " useIOInterrupts ifTrue:[ObjectMemory ioInterruptHandler:self]. ObjectMemory - timerInterruptHandler:self; - childSignalInterruptHandler:self. + timerInterruptHandler:self; + childSignalInterruptHandler:self. "Modified: / 7.1.1997 / 16:48:26 / stefan" "Modified: / 4.2.1999 / 13:08:39 / cg" @@ -1018,44 +1040,44 @@ |index pri aProcess l| OperatingSystem interruptsBlocked ifFalse:[ - MiniDebugger - enterWithMessage:'vmResumeInterrupt with no interruptsBlocked' - mayProceed:true. + MiniDebugger + enterWithMessage:'vmResumeInterrupt with no interruptsBlocked' + mayProceed:true. ]. index := KnownProcessIds identityIndexOf:id. index ~~ 0 ifTrue:[ - aProcess := KnownProcesses at:index. - pri := aProcess priority. - l := quiescentProcessLists at:pri. - l notNil ifTrue:[ - (l includesIdentical:aProcess) ifTrue:[ - "/ aProcess is on a run queue. - "/ CG: this situation may happen, if the wrapCall - "/ finishes before the process was layed to sleep - "/ (i.e. schedulerIRQ arrives before the threadSwitch was finished). - "/ In that case, simply resume it and everything is OK. - "/ If the process is state running, ignore. - - |state| - - state := aProcess state. - (state == #wrapWait or:[(state == #osWait) or:[state == #stopped]]) ifTrue:[ - aProcess state:#run. - ]. - 'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint. - aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR. - ^ self - ] - ] ifFalse:[ - l := LinkedList new. - quiescentProcessLists at:pri put:l. - ]. - l addLast:aProcess. - aProcess state:#run. + aProcess := KnownProcesses at:index. + pri := aProcess priority. + l := quiescentProcessLists at:pri. + l notNil ifTrue:[ + (l includesIdentical:aProcess) ifTrue:[ + "/ aProcess is on a run queue. + "/ CG: this situation may happen, if the wrapCall + "/ finishes before the process was layed to sleep + "/ (i.e. schedulerIRQ arrives before the threadSwitch was finished). + "/ In that case, simply resume it and everything is OK. + "/ If the process is state running, ignore. + + |state| + + state := aProcess state. + (state == #wrapWait or:[(state == #osWait) or:[state == #stopped]]) ifTrue:[ + aProcess state:#run. + ]. + 'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint. + aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR. + ^ self + ] + ] ifFalse:[ + l := LinkedList new. + quiescentProcessLists at:pri put:l. + ]. + l addLast:aProcess. + aProcess state:#run. ] ifFalse:[ - 'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint. - id infoPrintCR. + 'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint. + id infoPrintCR. ] "Modified: / 28.9.1998 / 11:36:53 / cg" @@ -1110,9 +1132,11 @@ what to do now." gotChildSignalInterrupt := true. + interruptCounter := interruptCounter + 1. activeProcess ~~ scheduler ifTrue:[ - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF). + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] "Modified: 12.4.1996 / 10:12:18 / stefan" @@ -1542,41 +1566,41 @@ listArray := quiescentProcessLists. [prio >= 1] whileTrue:[ - l := listArray at:prio. - l notNil ifTrue:[ - l linksDo:[:aProcess | - aProcess isUserProcess ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ true. - ] - ] - ]. - prio := prio - 1 + l := listArray at:prio. + l notNil ifTrue:[ + l linksDo:[:aProcess | + aProcess isUserProcess ifTrue:[ + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ true. + ] + ] + ]. + prio := prio - 1 ]. "/ any user process waiting on a sema? - (readSemaphoreArray contains:[:sema | - sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]] + (readSemaphoreArray contains:[:sema | + sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]] ) ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ true. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ true. ]. - (writeSemaphoreArray contains:[:sema | - sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]] + (writeSemaphoreArray contains:[:sema | + sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]] ) ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ true. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ true. ]. - (timeoutSemaphoreArray contains:[:sema | - sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]] + (timeoutSemaphoreArray contains:[:sema | + sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]] ) ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ true. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ true. ]. (timeoutProcessArray contains:[:p | p notNil and:[p isUserProcess] ] ) ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ true. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ true. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2323,43 +2347,43 @@ wasBlocked := OperatingSystem blockInterrupts. useIOInterrupts ifTrue:[ - OperatingSystem disableIOInterruptsOn:aFileDescriptor. + OperatingSystem disableIOInterruptsOn:aFileDescriptor. ]. idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1. [idx ~~ 0] whileTrue:[ - readFdArray at:idx put:nil. - readCheckArray at:idx put:nil. - (sema := readSemaphoreArray at:idx) notNil ifTrue:[ - readSemaphoreArray at:idx put:nil. - doSignal ifTrue:[ - sema signalForAll. - ]. - ]. - idx := readFdArray identityIndexOf:aFileDescriptor startingAt:idx+1. + readFdArray at:idx put:nil. + readCheckArray at:idx put:nil. + (sema := readSemaphoreArray at:idx) notNil ifTrue:[ + readSemaphoreArray at:idx put:nil. + doSignal ifTrue:[ + sema signalForAll. + ]. + ]. + idx := readFdArray identityIndexOf:aFileDescriptor startingAt:idx+1. ]. idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:1. [idx ~~ 0] whileTrue:[ - writeFdArray at:idx put:nil. - writeCheckArray at:idx put:nil. - (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ - writeSemaphoreArray at:idx put:nil. - doSignal ifTrue:[ - sema signalForAll. - ]. - ]. - idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:idx+1. + writeFdArray at:idx put:nil. + writeCheckArray at:idx put:nil. + (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ + writeSemaphoreArray at:idx put:nil. + doSignal ifTrue:[ + sema signalForAll. + ]. + ]. + idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:idx+1. ]. idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:1. [idx ~~ 0] whileTrue:[ - exceptFdArray at:idx put:nil. - (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[ - exceptSemaphoreArray at:idx put:nil. - doSignal ifTrue:[ - sema signalForAll. - ]. - ]. - idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:idx+1. + exceptFdArray at:idx put:nil. + (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[ + exceptSemaphoreArray at:idx put:nil. + doSignal ifTrue:[ + sema signalForAll. + ]. + ]. + idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:idx+1. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ! @@ -2373,43 +2397,43 @@ wasBlocked := OperatingSystem blockInterrupts. idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:1. [idx ~~ 0] whileTrue:[ - useIOInterrupts ifTrue:[ - fd := readFdArray at:idx. - fd notNil ifTrue:[ - OperatingSystem disableIOInterruptsOn:fd - ]. - ]. - readFdArray at:idx put:nil. - readSemaphoreArray at:idx put:nil. - readCheckArray at:idx put:nil. - idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. + useIOInterrupts ifTrue:[ + fd := readFdArray at:idx. + fd notNil ifTrue:[ + OperatingSystem disableIOInterruptsOn:fd + ]. + ]. + readFdArray at:idx put:nil. + readSemaphoreArray at:idx put:nil. + readCheckArray at:idx put:nil. + idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. ]. idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:1. [idx ~~ 0] whileTrue:[ - useIOInterrupts ifTrue:[ - fd := writeFdArray at:idx. - fd notNil ifTrue:[ - OperatingSystem disableIOInterruptsOn:fd - ]. - ]. - writeFdArray at:idx put:nil. - writeSemaphoreArray at:idx put:nil. - writeCheckArray at:idx put:nil. - idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. + useIOInterrupts ifTrue:[ + fd := writeFdArray at:idx. + fd notNil ifTrue:[ + OperatingSystem disableIOInterruptsOn:fd + ]. + ]. + writeFdArray at:idx put:nil. + writeSemaphoreArray at:idx put:nil. + writeCheckArray at:idx put:nil. + idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. ]. idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:1. [idx ~~ 0] whileTrue:[ - timeoutArray at:idx put:nil. - timeoutSemaphoreArray at:idx put:nil. - timeoutActionArray at:idx put:nil. - timeoutProcessArray at:idx put:nil. - idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. + timeoutArray at:idx put:nil. + timeoutSemaphoreArray at:idx put:nil. + timeoutActionArray at:idx put:nil. + timeoutProcessArray at:idx put:nil. + idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. ]. idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:1. [idx ~~ 0] whileTrue:[ - exceptFdArray at:idx put:nil. - exceptSemaphoreArray at:idx put:nil. - idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. + exceptFdArray at:idx put:nil. + exceptSemaphoreArray at:idx put:nil. + idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2506,30 +2530,30 @@ aSemphore is never nil, but one of aFileDescriptor, aBlock may be nil" aFileDescriptor isNil ifTrue:[ - idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil. - idx == 0 ifTrue:[ - "aSemaphore is not registered yet, have to create a new slot" - exceptFdArray := exceptFdArray copyWith:nil. - exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore. - ] ifFalse:[ - slot := exceptSemaphoreArray at:idx. - slot isNil ifTrue:[ - exceptSemaphoreArray at:idx put:aSemaphore. - ] - ] + idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil. + idx == 0 ifTrue:[ + "aSemaphore is not registered yet, have to create a new slot" + exceptFdArray := exceptFdArray copyWith:nil. + exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore. + ] ifFalse:[ + slot := exceptSemaphoreArray at:idx. + slot isNil ifTrue:[ + exceptSemaphoreArray at:idx put:aSemaphore. + ] + ] ] ifFalse:[ - idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil. - idx == 0 ifTrue:[ - "aFileDescriptor is not registered yet, have to create a new slot" - exceptFdArray := exceptFdArray copyWith:aFileDescriptor. - exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore. - ] ifFalse:[ - slot := exceptFdArray at:idx. - slot isNil ifTrue:[ - exceptFdArray at:idx put:aFileDescriptor. - exceptSemaphoreArray at:idx put:aSemaphore. - ]. - ]. + idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil. + idx == 0 ifTrue:[ + "aFileDescriptor is not registered yet, have to create a new slot" + exceptFdArray := exceptFdArray copyWith:aFileDescriptor. + exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore. + ] ifFalse:[ + slot := exceptFdArray at:idx. + slot isNil ifTrue:[ + exceptFdArray at:idx put:aFileDescriptor. + exceptSemaphoreArray at:idx put:aSemaphore. + ]. + ]. "/ (useIOInterrupts and:[slot isNil]) ifTrue:[ "/ OperatingSystem enableIOInterruptsOn:aFileDescriptor "/ ]. @@ -2995,9 +3019,9 @@ halfSize "{ Class: SmallInteger }" wasBlocked p| - anyTimeouts ifFalse:[ ^ self]. anyTimeouts := false. + indexOfLastTimeout := 0. "have to collect the blocks first, then evaluate them. This avoids problems due to newly inserted blocks." @@ -3013,90 +3037,97 @@ now := OperatingSystem getMillisecondTime. n := timeoutArray size. 1 to:n do:[:index | - aTime := timeoutArray at:index. - aTime notNil ifTrue:[ - (OperatingSystem millisecondTime:now isAfter:aTime) ifTrue:[ - "this one should be triggered" - - sema := timeoutSemaphoreArray at:index. - sema notNil ifTrue:[ - timeoutSemaphoreArray at:index put:nil. - sema signalOnce. - ] ifFalse:[ - "to support pure-events" - block := timeoutActionArray at:index. - block notNil ifTrue:[ - firstBlockToEvaluate isNil ifTrue:[ - firstBlockToEvaluate := block. - firstProcess := timeoutProcessArray at:index. - ] ifFalse:[ - blocksAndProcessesToEvaluate isNil ifTrue:[ - blocksAndProcessesToEvaluate := OrderedCollection - with:firstBlockToEvaluate - with:firstProcess. - ]. - blocksAndProcessesToEvaluate add:block. - blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index). - ]. - timeoutActionArray at:index put:nil. - timeoutProcessArray at:index put:nil. - ] - ]. - timeoutArray at:index put:nil. - ] ifFalse:[ - "there are still pending timeouts" - anyTimeouts := true. - indexOfLastTimeout := index. - ] - ] + aTime := timeoutArray at:index. + aTime notNil ifTrue:[ + (OperatingSystem millisecondTime:now isAfter:aTime) ifTrue:[ + "this one should be triggered" + + sema := timeoutSemaphoreArray at:index. + sema notNil ifTrue:[ + timeoutSemaphoreArray at:index put:nil. + timedActionCounter := (timedActionCounter + 1 bitAnd:16r3FFFFFFF). + sema signalOnce. + ] ifFalse:[ + "to support pure-events" + block := timeoutActionArray at:index. + block notNil ifTrue:[ + "/ usually (>99%), there is only one single timeout action to call; + "/ avoid creation of an OrderedCollection + firstBlockToEvaluate isNil ifTrue:[ + firstBlockToEvaluate := block. + firstProcess := timeoutProcessArray at:index. + ] ifFalse:[ + blocksAndProcessesToEvaluate isNil ifTrue:[ + blocksAndProcessesToEvaluate := OrderedCollection + with:firstBlockToEvaluate + with:firstProcess. + ]. + blocksAndProcessesToEvaluate add:block. + blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index). + ]. + timeoutActionArray at:index put:nil. + timeoutProcessArray at:index put:nil. + ] + ]. + timeoutArray at:index put:nil. + ] ifFalse:[ + "there are still pending timeouts" + anyTimeouts := true. + indexOfLastTimeout := index. + ] + ] ]. "shrink the arrays, if they are 50% free" n > 20 ifTrue:[ - halfSize := n // 2. - indexOfLastTimeout < halfSize ifTrue:[ - wasBlocked := OperatingSystem blockInterrupts. - (timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[ "/ no new timeouts arrived - timeoutArray := timeoutArray copyTo:halfSize. - timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize. - timeoutActionArray := timeoutActionArray copyTo:halfSize. - timeoutProcessArray := timeoutProcessArray copyTo:halfSize. - ]. - wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ]. - ]. + halfSize := n // 2. + (indexOfLastTimeout ~~ 0 and:[indexOfLastTimeout < halfSize]) ifTrue:[ + wasBlocked := OperatingSystem blockInterrupts. + (timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[ "/ no new timeouts arrived + timeoutArray := timeoutArray copyTo:halfSize. + timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize. + timeoutActionArray := timeoutActionArray copyTo:halfSize. + timeoutProcessArray := timeoutProcessArray copyTo:halfSize. + ]. + wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ]. + ]. ]. + "/ usually (>99%), there is only one single timeout action to call; + "/ above code avoided the creation of an OrderedCollection blocksAndProcessesToEvaluate isNil ifTrue:[ - firstBlockToEvaluate notNil ifTrue:[ - (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[ - firstBlockToEvaluate value - ] ifFalse:[ - firstProcess isDead ifTrue:[ - "/ a timedBlock for a process which has already terminated - "/ issue a warning and do not execute it. - "/ (exeuting here may be dangerous, since it would run at scheduler priority here, - "/ and thereby could block the whole smalltalk system. - "/ For this reason is it IGNORED here.) + firstBlockToEvaluate notNil ifTrue:[ + timedActionCounter := (timedActionCounter + 1 bitAnd:16r3FFFFFFF). + (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[ + firstBlockToEvaluate value + ] ifFalse:[ + firstProcess isDead ifTrue:[ + "/ a timedBlock for a process which has already terminated + "/ issue a warning and do not execute it. + "/ (exeuting here may be dangerous, since it would run at scheduler priority here, + "/ and thereby could block the whole smalltalk system. + "/ For this reason is it IGNORED here.) "/ Could handle it in timeoutProcess, but we don't, "/ because otherwise timeouts might be reissued forever... "/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[ "/ timeoutHandlerProcess interruptWith:block. "/ ] ifFalse:[ - ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , firstProcess name , '''') infoPrintCR. - ('ProcessorScheduler [warning]: the timedBlock is: ' , firstBlockToEvaluate displayString) infoPrintCR. + ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , firstProcess name , '''') infoPrintCR. + ('ProcessorScheduler [warning]: the timedBlock is: ' , firstBlockToEvaluate displayString) infoPrintCR. "/ ]. - ] ifFalse:[ - firstProcess interruptWith:firstBlockToEvaluate - ] - ] - ]. + ] ifFalse:[ + firstProcess interruptWith:firstBlockToEvaluate + ] + ] + ]. ] ifFalse:[ n := blocksAndProcessesToEvaluate size. 1 to:n by:2 do:[:index | block := blocksAndProcessesToEvaluate at:index. p := blocksAndProcessesToEvaluate at:index+1. (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[ - block value + block value. + timedActionCounter := timedActionCounter + 1. ] ifFalse:[ p isDead ifTrue:[ "/ a timedBlock for a process which has already terminated @@ -3113,6 +3144,7 @@ ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR. "/ ]. ] ifFalse:[ + timedActionCounter := timedActionCounter + 1. p interruptWith:block ] ] @@ -3175,20 +3207,20 @@ index := anID. (anID notNil and:[index > 0]) ifTrue:[ - wasBlocked := OperatingSystem blockInterrupts. - - (aBlockOrSemaphore notNil - and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore - and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[ - 'Processor: trying to remove stale timeout id - ignored' errorPrintCR. - ] ifFalse:[ - timeoutArray at:index put:nil. - timeoutActionArray at:index put:nil. - timeoutSemaphoreArray at:index put:nil. - timeoutProcessArray at:index put:nil. - ]. - - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + wasBlocked := OperatingSystem blockInterrupts. + + (aBlockOrSemaphore notNil + and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore + and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[ + 'Processor: trying to remove stale timeout id - ignored' errorPrintCR. + ] ifFalse:[ + timeoutArray at:index put:nil. + timeoutActionArray at:index put:nil. + timeoutSemaphoreArray at:index put:nil. + timeoutProcessArray at:index put:nil. + ]. + + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ] ! @@ -3216,18 +3248,20 @@ timeoutHandlerProcessLoop "The timeoutHandlerProcess does nothing but wait. - It exists only, so that timeout blocks may be executed in its context." + It exists only, so that timeout blocks may be executed in its context + (i.e. it will always just wait forever, and perform timeout actions + in its interrupt handler)." [ - [ - (Semaphore new name:'timeoutHandler') wait. - ] on:Exception do:[:ex| - "ignore errors, but tell the user" - InfoPrinting == true ifTrue:[ - ('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR. - thisContext fullPrintAll. - ]. - ]. + [ + (Semaphore new name:'timeoutHandler') wait. + ] on:Exception do:[:ex| + "ignore errors, but tell the user" + InfoPrinting == true ifTrue:[ + ('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR. + thisContext fullPrintAll. + ]. + ]. ] loop. ! ! @@ -3279,158 +3313,158 @@ newProcessMaybeReady := false. readableResultFdArray size < readFdArray size ifTrue:[ - readableResultFdArray := Array new:(40 max:readFdArray size). + readableResultFdArray := Array new:(40 max:readFdArray size). ]. writableResultFdArray size < writeFdArray size ifTrue:[ - writableResultFdArray := Array new:(40 max:writeFdArray size). + writableResultFdArray := Array new:(40 max:writeFdArray size). ]. exceptArray := exceptFdArray. OperatingSystem isMSWINDOWSlike ifTrue:[ - "/ - "/ win32 does a WaitForMultipleObjects in select... - "/ unix waits for SIGCHLD - "/ - |hasPids| - - hasPids := false. - osChildExitActions keysDo:[:eachPid| - eachPid address = 0 ifTrue:[ - 'Processor: remove 0-handle pid: ' infoPrint. eachPid infoPrintCR. - osChildExitActions safeRemoveKey:eachPid. - ] ifFalse:[ - hasPids := true. - ]. - ]. - hasPids ifTrue:[ - exceptArray := (exceptArray upTo:nil), osChildExitActions keys asArray. + "/ + "/ win32 does a WaitForMultipleObjects in select... + "/ unix waits for SIGCHLD + "/ + |hasPids| + + hasPids := false. + osChildExitActions keysDo:[:eachPid| + eachPid address = 0 ifTrue:[ + 'Processor: remove 0-handle pid: ' infoPrint. eachPid infoPrintCR. + osChildExitActions safeRemoveKey:eachPid. + ] ifFalse:[ + hasPids := true. + ]. + ]. + hasPids ifTrue:[ + exceptArray := (exceptArray upTo:nil), osChildExitActions keys asArray. "/'exceptArray: ' print. exceptArray printCR. - ]. + ]. ]. exceptResultFdArray size < exceptArray size ifTrue:[ - exceptResultFdArray := Array new:(40 max:exceptArray size). + exceptResultFdArray := Array new:(40 max:exceptArray size). ]. nReady := OperatingSystem - selectOnAnyReadable:readFdArray - writable:writeFdArray - exception:exceptArray - readableInto:readableResultFdArray - writableInto:writableResultFdArray - exceptionInto:exceptResultFdArray - withTimeOut:millis. + selectOnAnyReadable:readFdArray + writable:writeFdArray + exception:exceptArray + readableInto:readableResultFdArray + writableInto:writableResultFdArray + exceptionInto:exceptResultFdArray + withTimeOut:millis. wasBlocked ifTrue:[ - OperatingSystem blockInterrupts. + OperatingSystem blockInterrupts. ]. nReady <= 0 ifTrue:[ - "/ either still nothing to do, - "/ or error (which should not happen) - - (nReady < 0 and:[(err := OperatingSystem lastErrorSymbol) notNil]) ifTrue:[ - err == #EBADF ifTrue:[ - "/ mhmh - one of the fd's given to me is corrupt. - "/ find out which one .... and remove it - self removeCorruptedFds - ] ifFalse:[ - err == #ENOENT ifTrue:[ - 'Processor [warning]: ENOENT in select; rd=' infoPrint. - readFdArray infoPrint. ' wr=' infoPrint. writeFdArray infoPrintCR. - ] ifFalse:[ - 'Processor [warning]: error in select: ' infoPrint. err infoPrintCR. - ] - ]. - ] + "/ either still nothing to do, + "/ or error (which should not happen) + + (nReady < 0 and:[(err := OperatingSystem lastErrorSymbol) notNil]) ifTrue:[ + err == #EBADF ifTrue:[ + "/ mhmh - one of the fd's given to me is corrupt. + "/ find out which one .... and remove it + self removeCorruptedFds + ] ifFalse:[ + err == #ENOENT ifTrue:[ + 'Processor [warning]: ENOENT in select; rd=' infoPrint. + readFdArray infoPrint. ' wr=' infoPrint. writeFdArray infoPrintCR. + ] ifFalse:[ + 'Processor [warning]: error in select: ' infoPrint. err infoPrintCR. + ] + ]. + ] ] ifFalse:[ - readyIndex := 1. - [nReady > 0 - and:[ readyIndex <= readableResultFdArray size - and:[ (fd := readableResultFdArray at:readyIndex) notNil ]] - ] whileTrue:[ - index := readFdArray identityIndexOf:fd. - index ~~ 0 ifTrue:[ - action := readCheckArray at:index. - sema := readSemaphoreArray at:index. - sema notNil ifTrue:[ - sema signalOnce. - newProcessMaybeReady := true. - action isNil ifTrue:[ - "before May 2014 we disabled the sema in the caller after wakeup. - This caused ST/X to consume 100% cpu, when the caller didn't read - the data (e.g. because his process was stopped)." - "disable possible write side and timeouts as well" - self disableSemaphore:sema. - ]. - ]. - (action notNil and:[action value]) ifTrue:[ - newProcessMaybeReady := true. - ]. - ]. - nReady := nReady - 1. - readyIndex := readyIndex + 1. - ]. - - readyIndex := 1. - [nReady > 0 - and:[ readyIndex <= writableResultFdArray size - and:[ (fd := writableResultFdArray at:readyIndex) notNil ]] - ] whileTrue:[ - index := writeFdArray identityIndexOf:fd. - index ~~ 0 ifTrue:[ - action := writeCheckArray at:index. - sema := writeSemaphoreArray at:index. - sema notNil ifTrue:[ - sema signalOnce. - newProcessMaybeReady := true. - action isNil ifTrue:[ - "now this is a one shot operation - see the input above" - "disable possible read side and timeouts as well" - self disableSemaphore:sema. - ]. - ]. - (action notNil and:[action value]) ifTrue:[ - newProcessMaybeReady := true. - ]. - ]. - nReady := nReady - 1. - readyIndex := readyIndex + 1. - ]. + readyIndex := 1. + [nReady > 0 + and:[ readyIndex <= readableResultFdArray size + and:[ (fd := readableResultFdArray at:readyIndex) notNil ]] + ] whileTrue:[ + index := readFdArray identityIndexOf:fd. + index ~~ 0 ifTrue:[ + action := readCheckArray at:index. + sema := readSemaphoreArray at:index. + sema notNil ifTrue:[ + sema signalOnce. + newProcessMaybeReady := true. + action isNil ifTrue:[ + "before May 2014 we disabled the sema in the caller after wakeup. + This caused ST/X to consume 100% cpu, when the caller didn't read + the data (e.g. because his process was stopped)." + "disable possible write side and timeouts as well" + self disableSemaphore:sema. + ]. + ]. + (action notNil and:[action value]) ifTrue:[ + newProcessMaybeReady := true. + ]. + ]. + nReady := nReady - 1. + readyIndex := readyIndex + 1. + ]. + + readyIndex := 1. + [nReady > 0 + and:[ readyIndex <= writableResultFdArray size + and:[ (fd := writableResultFdArray at:readyIndex) notNil ]] + ] whileTrue:[ + index := writeFdArray identityIndexOf:fd. + index ~~ 0 ifTrue:[ + action := writeCheckArray at:index. + sema := writeSemaphoreArray at:index. + sema notNil ifTrue:[ + sema signalOnce. + newProcessMaybeReady := true. + action isNil ifTrue:[ + "now this is a one shot operation - see the input above" + "disable possible read side and timeouts as well" + self disableSemaphore:sema. + ]. + ]. + (action notNil and:[action value]) ifTrue:[ + newProcessMaybeReady := true. + ]. + ]. + nReady := nReady - 1. + readyIndex := readyIndex + 1. + ]. "/'except result got: ' print. exceptArray printCR. exceptResultFdArray printCR. - readyIndex := 1. - [nReady > 0 - and:[ readyIndex <= exceptResultFdArray size - and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]] - ] whileTrue:[ + readyIndex := 1. + [nReady > 0 + and:[ readyIndex <= exceptResultFdArray size + and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]] + ] whileTrue:[ "/'except got: ' print. fdOrPid printCR. - index := exceptFdArray identityIndexOf:fdOrPid. - index ~~ 0 ifTrue:[ - sema := exceptSemaphoreArray at:index. - sema notNil ifTrue:[ - sema signalOnce. - newProcessMaybeReady := true. - "disable possible read/write side and timeouts as well" - self disableSemaphore:sema. - ]. - ] ifFalse:[ "may be a PID?" - |osProcessStatus actionBlock| - - actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil. + index := exceptFdArray identityIndexOf:fdOrPid. + index ~~ 0 ifTrue:[ + sema := exceptSemaphoreArray at:index. + sema notNil ifTrue:[ + sema signalOnce. + newProcessMaybeReady := true. + "disable possible read/write side and timeouts as well" + self disableSemaphore:sema. + ]. + ] ifFalse:[ "may be a PID?" + |osProcessStatus actionBlock| + + actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil. "/'pid signaled: ' print. fdOrPid printCR. - actionBlock notNil ifTrue:[ - osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid. - (osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[ - actionBlock value:osProcessStatus. - newProcessMaybeReady := true. - ]. - ]. - ]. - nReady := nReady - 1. - readyIndex := readyIndex + 1. - ]. + actionBlock notNil ifTrue:[ + osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid. + (osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[ + actionBlock value:osProcessStatus. + newProcessMaybeReady := true. + ]. + ]. + ]. + nReady := nReady - 1. + readyIndex := readyIndex + 1. + ]. ]. ^ newProcessMaybeReady @@ -3449,15 +3483,16 @@ gotIOInterrupt := true. activeProcess ~~ scheduler ifTrue:[ - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF). + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] "Modified: 21.12.1995 / 16:17:40 / stefan" "Modified: 4.8.1997 / 14:23:08 / cg" ! -noMoreUserProcesses +noMoreUserProcesses "/ check if there are any processes at all "/ stop dispatching if there is none "/ (and anyTimeouts is false, which means that no timeout blocks are present) @@ -3465,8 +3500,8 @@ "/ and no writeSemaphores are present anyTimeouts ifFalse:[ - ^ self anyUserProcessAtAll not. - ]. + ^ self anyUserProcessAtAll not. + ]. ^ false "/ |anySema| "/ @@ -3500,88 +3535,88 @@ readFdArray/writeFdArray in the debugger)" readFdArray keysAndValuesDo:[:idx :fd | - |result sema| - - fd notNil ifTrue:[ - result := OperatingSystem - selectOnAnyReadable:(Array with:fd) writable:nil exception:nil - readableInto:nil writableInto:nil exceptionInto:nil - withTimeOut:0. - - result < 0 ifTrue:[ - 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. - readFdArray at:idx put:nil. - readCheckArray at:idx put:nil. - (sema := readSemaphoreArray at:idx) notNil ifTrue:[ - readSemaphoreArray at:idx put:nil. - sema signalForAll. - ]. - ] - ]. + |result sema| + + fd notNil ifTrue:[ + result := OperatingSystem + selectOnAnyReadable:(Array with:fd) writable:nil exception:nil + readableInto:nil writableInto:nil exceptionInto:nil + withTimeOut:0. + + result < 0 ifTrue:[ + 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. + readFdArray at:idx put:nil. + readCheckArray at:idx put:nil. + (sema := readSemaphoreArray at:idx) notNil ifTrue:[ + readSemaphoreArray at:idx put:nil. + sema signalForAll. + ]. + ] + ]. ]. writeFdArray keysAndValuesDo:[:idx :fd | - |result sema| - - fd notNil ifTrue:[ - result := OperatingSystem - selectOnAnyReadable:nil writable:(Array with:fd) exception:nil - readableInto:nil writableInto:nil exceptionInto:nil - withTimeOut:0. - - result < 0 ifTrue:[ - 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. - writeFdArray at:idx put:nil. - writeCheckArray at:idx put:nil. - (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ - writeSemaphoreArray at:idx put:nil. - sema signalForAll. - ]. - ] - ] + |result sema| + + fd notNil ifTrue:[ + result := OperatingSystem + selectOnAnyReadable:nil writable:(Array with:fd) exception:nil + readableInto:nil writableInto:nil exceptionInto:nil + withTimeOut:0. + + result < 0 ifTrue:[ + 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. + writeFdArray at:idx put:nil. + writeCheckArray at:idx put:nil. + (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ + writeSemaphoreArray at:idx put:nil. + sema signalForAll. + ]. + ] + ] ]. exceptFdArray keysAndValuesDo:[:idx :fd | - |result sema| - - fd notNil ifTrue:[ - result := OperatingSystem - selectOnAnyReadable:nil writable:nil exception:(Array with:fd) - readableInto:nil writableInto:nil exceptionInto:nil - withTimeOut:0. - - result < 0 ifTrue:[ - 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. - exceptFdArray at:idx put:nil. - (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[ - exceptSemaphoreArray at:idx put:nil. - sema signalForAll. - ]. - ] - ] + |result sema| + + fd notNil ifTrue:[ + result := OperatingSystem + selectOnAnyReadable:nil writable:nil exception:(Array with:fd) + readableInto:nil writableInto:nil exceptionInto:nil + withTimeOut:0. + + result < 0 ifTrue:[ + 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. + exceptFdArray at:idx put:nil. + (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[ + exceptSemaphoreArray at:idx put:nil. + sema signalForAll. + ]. + ] + ] ]. OperatingSystem isMSWINDOWSlike ifTrue:[ - "/ - "/ win32 does a WaitForMultipleObjects in select... - "/ unix waits for SIGCHLD - "/ - osChildExitActions keysDo:[:eachPid | - |result sema| - - eachPid notNil ifTrue:[ - result := OperatingSystem - selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid) - readableInto:nil writableInto:nil exceptionInto:nil - withTimeOut:0. - - result < 0 ifTrue:[ - 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR. - osChildExitActions safeRemoveKey:eachPid. - ] - ] - ]. + "/ + "/ win32 does a WaitForMultipleObjects in select... + "/ unix waits for SIGCHLD + "/ + osChildExitActions keysDo:[:eachPid | + |result sema| + + eachPid notNil ifTrue:[ + result := OperatingSystem + selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid) + readableInto:nil writableInto:nil exceptionInto:nil + withTimeOut:0. + + result < 0 ifTrue:[ + 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR. + osChildExitActions safeRemoveKey:eachPid. + ] + ] + ]. ]. "Modified: 12.4.1996 / 09:32:58 / stefan" @@ -3593,8 +3628,9 @@ what to do now." activeProcess ~~ scheduler ifTrue:[ - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF). + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] ! @@ -3644,8 +3680,9 @@ of whichever process is currently running." activeProcess ~~ scheduler ifTrue:[ - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF). + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] "Modified: 18.10.1996 / 20:35:54 / cg" @@ -3662,80 +3699,80 @@ doingGC := true. [doingGC] whileTrue:[ - anyTimeouts ifTrue:[ - millis := self timeToNextTimeout. - (millis notNil and:[millis <= 0]) ifTrue:[ - ^ self "oops - hurry up checking" - ]. - ]. - - " - if its worth doing, collect a bit of garbage; - but not, if a backgroundCollector is active - " - ObjectMemory backgroundCollectorRunning ifTrue:[ - doingGC := false - ] ifFalse:[ - doingGC := ObjectMemory gcStepIfUseful. - ]. - - "then do idle actions" - (idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[ - idleActions do:[:aBlock | - aBlock value. - ]. - ^ self "go back checking" - ]. - - doingGC ifTrue:[ - (self checkForIOWithTimeout:0) ifTrue:[ - ^ self "go back checking" - ] - ] + anyTimeouts ifTrue:[ + millis := self timeToNextTimeout. + (millis notNil and:[millis <= 0]) ifTrue:[ + ^ self "oops - hurry up checking" + ]. + ]. + + " + if its worth doing, collect a bit of garbage; + but not, if a backgroundCollector is active + " + ObjectMemory backgroundCollectorRunning ifTrue:[ + doingGC := false + ] ifFalse:[ + doingGC := ObjectMemory gcStepIfUseful. + ]. + + "then do idle actions" + (idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[ + idleActions do:[:aBlock | + aBlock value. + ]. + ^ self "go back checking" + ]. + + doingGC ifTrue:[ + (self checkForIOWithTimeout:0) ifTrue:[ + ^ self "go back checking" + ] + ] ]. exitWhenNoMoreUserProcesses ifTrue:[ - "/ check if there are any processes at all - "/ stop dispatching if there is none - "/ (and anyTimeouts is false, which means that no timeout blocks are present) - "/ and no readSemaphores are present (which means that noone is waiting for input) - "/ and no writeSemaphores are present - - self noMoreUserProcesses ifTrue:[ - dispatching := false. - ^ self - ]. + "/ check if there are any processes at all + "/ stop dispatching if there is none + "/ (and anyTimeouts is false, which means that no timeout blocks are present) + "/ and no readSemaphores are present (which means that noone is waiting for input) + "/ and no writeSemaphores are present + + self noMoreUserProcesses ifTrue:[ + dispatching := false. + ^ self + ]. ]. preWaitActions notNil ifTrue:[ - preWaitActions do:[:action | action value]. + preWaitActions do:[:action | action value]. ]. "/ "/ absolutely nothing to do - simply wait "/ OperatingSystem supportsSelect ifFalse:[ - "SCO instant ShitStation has a bug here, - waiting always 1 sec in the select - therefore we delay a bit and - return - effectively polling in 50ms cycles - " - (self checkForIOWithTimeout:0) ifTrue:[ - ^ self "go back checking" - ]. - OperatingSystem millisecondDelay:EventPollingInterval. - ^ self + "SCO instant ShitStation has a bug here, + waiting always 1 sec in the select - therefore we delay a bit and + return - effectively polling in 50ms cycles + " + (self checkForIOWithTimeout:0) ifTrue:[ + ^ self "go back checking" + ]. + OperatingSystem millisecondDelay:EventPollingInterval. + ^ self ]. useIOInterrupts ifTrue:[ - dT := 999999 + dT := 999999 ] ifFalse:[ - dT := EventPollingInterval + dT := EventPollingInterval ]. millis isNil ifTrue:[ - millis := dT. + millis := dT. ] ifFalse:[ - millis := millis rounded min:dT. + millis := millis rounded min:dT. ]. self checkForIOWithTimeout:millis
--- a/ProjectDefinition.st Sun May 15 08:38:43 2016 +0100 +++ b/ProjectDefinition.st Tue May 17 10:05:14 2016 +0100 @@ -2746,7 +2746,6 @@ "Created: / 18-08-2006 / 12:51:38 / cg" ! ! - !ProjectDefinition class methodsFor:'description - project information'! applicationAdditionalIconFileNames @@ -4790,7 +4789,6 @@ ^ self subProjectMakeCallsUsing:'call vcmake %1 %2'. ! ! - !ProjectDefinition class methodsFor:'file templates'! autopackage_default_dot_apspec @@ -5384,10 +5382,12 @@ self hasAllExtensionsLoaded ifFalse:[ self activityNotification:'Loading extensions'. + "/ evaluating or here - want extensions to be loaded newStuffHasBeenLoaded := newStuffHasBeenLoaded | meOrMySecondIncarnation loadExtensions. ]. (self hasAllClassesLoaded:asAutoloaded not) ifFalse:[ self activityNotification:'Loading classes'. + "/ evaluating or here - want autoloaded classes to be loaded newStuffHasBeenLoaded := newStuffHasBeenLoaded | (meOrMySecondIncarnation loadAllClassesAsAutoloaded:asAutoloaded). ]. "/ no, don't load subProjects here - will lead to a recursion, which leads
--- a/SequenceableCollection.st Sun May 15 08:38:43 2016 +0100 +++ b/SequenceableCollection.st Tue May 17 10:05:14 2016 +0100 @@ -421,6 +421,7 @@ " OrderedCollection writeStream + Text writeStream " "Modified: / 09-01-2011 / 10:37:35 / cg" @@ -448,7 +449,6 @@ ^ self == SequenceableCollection ! ! - !SequenceableCollection methodsFor:'Compatibility-Squeak'! allButFirst @@ -761,7 +761,6 @@ ^ self replaceFrom:start to:stop with:anArray startingAt:repStart ! ! - !SequenceableCollection methodsFor:'accessing'! after:anObject @@ -7874,7 +7873,6 @@ "Created: 14.2.1997 / 16:13:03 / cg" ! ! - !SequenceableCollection methodsFor:'searching'! detect:aBlock startingAt:startIndex
--- a/ShortFloat.st Sun May 15 08:38:43 2016 +0100 +++ b/ShortFloat.st Tue May 17 10:05:14 2016 +0100 @@ -45,29 +45,29 @@ extern errno; #endif -#if !defined (WIN32) +#if !defined (__win32__) # include <locale.h> #endif -#if defined (_AIX) +#if defined (__aix__) # include <float.h> #endif -#if defined(IRIX) +#if defined(__irix__) # include <nan.h> #endif -#if defined(LINUX) +#if defined(__linux__) # ifndef NAN # include <bits/nan.h> # endif #endif -#if defined(solaris) || defined(sunos) +#if defined(__solaris__) || defined(__sunos__) # include <nan.h> #endif -#ifdef WIN32 +#ifdef __win32__ /* * no finite(x) ? * no isnan(x) ? @@ -136,15 +136,15 @@ # include <string.h> # endif -#endif /* WIN32 */ +#endif /* __win32__ */ -#ifdef solaris +#ifdef __solaris__ # ifndef isfinite # define isfinite(f) finite((double)(f)) # endif #endif -#ifdef realIX +#ifdef __realIX__ # ifndef isfinite # define isfinite(x) 1 # endif @@ -408,14 +408,14 @@ self isIEEEFormat ifFalse:[self error:'unsupported operation']. (UninterpretedBytes isBigEndian == msb) ifFalse:[ - "swap the bytes" - 4 to:1 by:-1 do:[:i | - aBasicNewShortFloat basicAt:i put:(aStream next) - ]. - ^ self + "swap the bytes" + 4 to:1 by:-1 do:[:i | + aBasicNewShortFloat basicAt:i put:(aStream next) + ]. + ^ self ]. 1 to:4 do:[:i | - aBasicNewShortFloat basicAt:i put:aStream next + aBasicNewShortFloat basicAt:i put:aStream next ] "not part of libboss, as this is also used by others (TIFFReader)" @@ -866,7 +866,7 @@ float fVal; fVal = __shortFloatVal(self); -#ifdef WIN32 +#ifdef __win32__ if (! isnanf(fVal)) #endif {
--- a/SmallInteger.st Sun May 15 08:38:43 2016 +0100 +++ b/SmallInteger.st Tue May 17 10:05:14 2016 +0100 @@ -46,8 +46,8 @@ " SmallIntegers are Integers in the range of at least +/- 2^30 i.e. 31 bits, but this is not a guaranteed: - on an alpha or x86_64, 63 bits are used, if the system was configured for 64bit mode. - under the Schteam-VM, 64 bits are used (i.e. a full long integer) + on an alpha or x86_64, 63 bits are used, if the system was configured for 64bit mode. + under the Schteam-VM, 64 bits are used (i.e. a full long integer) These are no real objects - they have no instances (not even storage !!) and cannot be subclassed. @@ -62,12 +62,12 @@ with an instance variable holding the value. [author:] - Claus Gittinger + Claus Gittinger [see also:] - Number - Float Fraction FixedPoint - LargeInteger + Number + Float Fraction FixedPoint + LargeInteger " ! ! @@ -297,14 +297,14 @@ : "%0" ((unsigned long)(myValue)), "dmi" ((unsigned long)(otherValue))); # else -# if defined (__GNUC__) && defined(__i386__) +# if defined (__GNUC__) && defined(__x86__) asm ("mull %3" : "=a" ((unsigned long)(productLow)), "=d" ((unsigned long)(productHi)) : "%0" ((unsigned long)(myValue)), "rm" ((unsigned long)(otherValue))); # else -# if defined(WIN32) && defined(__BORLANDC__) +# if defined(__win32__) && defined(__BORLANDC__) asm { mov eax, myValue mov edx, otherValue @@ -374,8 +374,8 @@ productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH); # endif } -# endif /* ! WIN32 */ -# endif /* ! (__GNUC__ && __i386__) */ +# endif /* ! __win32__ */ +# endif /* ! (__GNUC__ && __x86__) */ # endif /* ! (__GNUC__ && __mc68k__) */ if (productHi == 0) { @@ -1406,9 +1406,9 @@ "return the value of the receiver shifted by shiftCount bits; leftShift if shiftCount > 0; rightShift otherwise. Notice: the result of bitShift: on negative receivers is not - defined in the language standard (since the implementation - is free to choose any internal representation for integers). - However, ST/X preserves the sign." + defined in the language standard (since the implementation + is free to choose any internal representation for integers). + However, ST/X preserves the sign." %{ /* NOCONTEXT */ #ifdef __SCHTEAM__ @@ -1417,80 +1417,80 @@ INT bits, count; if (__isSmallInteger(shiftCount)) { - bits = __intVal(self); - if (bits == 0) { - RETURN (self); - } - count = __intVal(shiftCount); - - if (count > 0) { - INT sign = 1; - if (bits < 0) { - bits = -bits; - sign = -1; - } - /* - * a left shift - */ + bits = __intVal(self); + if (bits == 0) { + RETURN (self); + } + count = __intVal(shiftCount); + + if (count > 0) { + INT sign = 1; + if (bits < 0) { + bits = -bits; + sign = -1; + } + /* + * a left shift + */ # if defined(USE_LONGLONG_FOR_SHIFT) - if (count <= N_INT_BITS) { - unsigned LONGLONG result; - - result = (unsigned LONGLONG)bits; - result <<= count; - if (result <= _MAX_INT) { - if (sign < 0) { - RETURN ( __MKINT(-result) ); - } - RETURN ( __mkSmallInteger(result) ); - } - { - RETURN (__MKLARGEINT64(sign, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF))); - } - } + if (count <= N_INT_BITS) { + unsigned LONGLONG result; + + result = (unsigned LONGLONG)bits; + result <<= count; + if (result <= _MAX_INT) { + if (sign < 0) { + RETURN ( __MKINT(-result) ); + } + RETURN ( __mkSmallInteger(result) ); + } + { + RETURN (__MKLARGEINT64(sign, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF))); + } + } # else - /* - * check for overflow - */ - if (count < (N_INT_BITS-1)) { - if (! (bits >> (N_INT_BITS - 1 - count))) { - INT result = bits << count; - - if (sign < 0) { - RETURN ( __MKINT(-result) ); - } - RETURN ( __mkSmallInteger(result) ); - } - /* - * so, there is an overflow ... - * handle it as largeInteger - */ - /* FALL THROUGH */ - } + /* + * check for overflow + */ + if (count < (N_INT_BITS-1)) { + if (! (bits >> (N_INT_BITS - 1 - count))) { + INT result = bits << count; + + if (sign < 0) { + RETURN ( __MKINT(-result) ); + } + RETURN ( __mkSmallInteger(result) ); + } + /* + * so, there is an overflow ... + * handle it as largeInteger + */ + /* FALL THROUGH */ + } # endif - } else { - if (count == 0) { - RETURN (self); - } - - /* - * right shifts cannot overflow - * - * some machines ignore shifts bigger than - * the number of bits in an int ... - */ - count = -count; - if (count > (N_INT_BITS-1)) { - RETURN (__mkSmallInteger(0)); - } - - RETURN ( __mkSmallInteger(bits >> count) ); - } + } else { + if (count == 0) { + RETURN (self); + } + + /* + * right shifts cannot overflow + * + * some machines ignore shifts bigger than + * the number of bits in an int ... + */ + count = -count; + if (count > (N_INT_BITS-1)) { + RETURN (__mkSmallInteger(0)); + } + + RETURN ( __mkSmallInteger(bits >> count) ); + } } #endif /* not __SCHTEAM__ */ %}. (shiftCount isMemberOf:SmallInteger) ifTrue:[ - ^ (LargeInteger value:self) bitShift:shiftCount + ^ (LargeInteger value:self) bitShift:shiftCount ]. ^ self bitShift:shiftCount asInteger "/ is this a good idea ? ! @@ -1546,38 +1546,38 @@ ! highBit - "return the bitIndex of the highest bit set. + "return the bitIndex of the highest bit set. The returned bitIndex starts at 1 for the least significant bit. Returns 0 if no bit is set." %{ /* NOCONTEXT */ #ifdef __SCHTEAM__ { - long bits = self.longValue(); - int bitNr = 0; - - if (bits != 0) { - if ((bits & 0xFFFFFFFF00000000L) != 0) { - bitNr += 32; bits >>= 32; - } - if ((bits & 0xFFFF0000L) != 0) { - bitNr += 16; bits >>= 16; - } - if ((bits & 0xFF00) != 0) { - bitNr += 8; bits >>= 8; - } - if ((bits & 0xF0) != 0) { - bitNr += 4; bits >>= 4; - } - if ((bits & 0xC) != 0) { - bitNr += 2; bits >>= 2; - } - if ((bits & 0x2) != 0) { - bitNr += 1; bits >>= 1; - } - bitNr += 1; - } - return context._RETURN( STInteger._new(bitNr) ); + long bits = self.longValue(); + int bitNr = 0; + + if (bits != 0) { + if ((bits & 0xFFFFFFFF00000000L) != 0) { + bitNr += 32; bits >>= 32; + } + if ((bits & 0xFFFF0000L) != 0) { + bitNr += 16; bits >>= 16; + } + if ((bits & 0xFF00) != 0) { + bitNr += 8; bits >>= 8; + } + if ((bits & 0xF0) != 0) { + bitNr += 4; bits >>= 4; + } + if ((bits & 0xC) != 0) { + bitNr += 2; bits >>= 2; + } + if ((bits & 0x2) != 0) { + bitNr += 1; bits >>= 1; + } + bitNr += 1; + } + return context._RETURN( STInteger._new(bitNr) ); } /* NOTREACHED */ #else @@ -1586,7 +1586,7 @@ bits = __intVal(self); if (bits == 0) { - RETURN ( __mkSmallInteger(0) ); + RETURN ( __mkSmallInteger(0) ); } # ifdef __BSR @@ -1602,23 +1602,23 @@ # if __POINTER_SIZE__ == 8 if (bits & 0xFFFFFFFF00000000L) { - index += 32; bits >>= 32; + index += 32; bits >>= 32; } # endif if (bits & 0xFFFF0000L) { - index += 16; bits >>= 16; + index += 16; bits >>= 16; } if (bits & 0xFF00) { - index += 8; bits >>= 8; + index += 8; bits >>= 8; } if (bits & 0xF0) { - index += 4; bits >>= 4; + index += 4; bits >>= 4; } if (bits & 0xC) { - index += 2; bits >>= 2; + index += 2; bits >>= 2; } if (bits & 0x2) { - index += 1; bits >>= 1; + index += 1; bits >>= 1; } # endif /* no BSR instruction */ @@ -1636,38 +1636,38 @@ 2r100000000000 highBit ((0 to:64) collect:[:s | 1 bitShift:s]) - collect:[:n | n highBit] + collect:[:n | n highBit] (((0 to:64) collect:[:s | 1 bitShift:s]) - collect:[:n | n highBit]) = (1 to:65) + collect:[:n | n highBit]) = (1 to:65) " " Time millisecondsToRun:[ - 1000000 timesRepeat:[ - 2r1 highBit - ] + 1000000 timesRepeat:[ + 2r1 highBit + ] ] " " Time millisecondsToRun:[ - 1000000 timesRepeat:[ - 2r1111 highBit - ] + 1000000 timesRepeat:[ + 2r1111 highBit + ] ] " " Time millisecondsToRun:[ - 1000000 timesRepeat:[ - 2r11111111111111 highBit - ] + 1000000 timesRepeat:[ + 2r11111111111111 highBit + ] ] " " Time millisecondsToRun:[ - 1000000 timesRepeat:[ - 2r11111111111111111111111111 highBit - ] + 1000000 timesRepeat:[ + 2r11111111111111111111111111 highBit + ] ] " @@ -2166,7 +2166,7 @@ # if __POINTER_SIZE__ == 8 v &= 0xFFFFFFFF; -# if defined(__x86_64__) && defined(__GNUC__) && !defined(__clang__) +# if defined(__x86_64__) && defined(__GNUC__) && !defined(__CLANG__) # define HAVE_BSWAP asm("movq %1, %%rax \n\ @@ -2623,21 +2623,21 @@ if (val < 0) val = -val; if ((val & 0xFFFFFFFF00000000L) != 0) { - val >>= 32; - offs = 4; + val >>= 32; + offs = 4; } if ((val & 0xFFFF0000) != 0) { - if ((val & 0xFF000000) != 0) { - offs += 4; - } else { - offs += 3; - } + if ((val & 0xFF000000) != 0) { + offs += 4; + } else { + offs += 3; + } } else { - if ((val & 0x0000FF00)!= 0) { - offs += 2; - } else { - offs += 1; - } + if ((val & 0x0000FF00)!= 0) { + offs += 2; + } else { + offs += 1; + } } return __c__._RETURN( STInteger._qnew(offs) ); #else @@ -2645,27 +2645,27 @@ int offs = 0; if (val < 0) { - val = -val; + val = -val; } # if __POINTER_SIZE__ == 8 if (val & 0xFFFFFFFF00000000L) { - val >>= 32; - offs = 4; + val >>= 32; + offs = 4; } # endif if (val & 0xFFFF0000) { - if (val & 0xFF000000) { - RETURN ( __mkSmallInteger(4+offs)); - } else { - RETURN ( __mkSmallInteger(3+offs)); - } + if (val & 0xFF000000) { + RETURN ( __mkSmallInteger(4+offs)); + } else { + RETURN ( __mkSmallInteger(3+offs)); + } } else { - if (val & 0x0000FF00) { - RETURN ( __mkSmallInteger(2+offs)); - } else { - RETURN ( __mkSmallInteger(1+offs)); - } + if (val & 0x0000FF00) { + RETURN ( __mkSmallInteger(2+offs)); + } else { + RETURN ( __mkSmallInteger(1+offs)); + } } #endif /* not SCHTEAM */ %}. @@ -4776,14 +4776,14 @@ : "%0" ((unsigned long)(myValue)), "dmi" ((unsigned long)(otherValue))); # else -# if defined (__GNUC__) && defined(__i386__) +# if defined (__GNUC__) && defined(__x86__) asm ("mull %3" : "=a" ((unsigned long)(productLow)), "=d" ((unsigned long)(productHi)) : "%0" ((unsigned long)(myValue)), "rm" ((unsigned long)(otherValue))); # else -# if defined(WIN32) && defined(__BORLANDC__) +# if defined(__win32__) && defined(__BORLANDC__) asm { mov eax, myValue mov edx, otherValue @@ -4853,8 +4853,8 @@ productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH); # endif } -# endif /* ! WIN32 */ -# endif /* ! (__GNUC__ && __i386__) */ +# endif /* ! __win32__ */ +# endif /* ! (__GNUC__ && __x86__) */ # endif /* ! (__GNUC__ && __mc68k__) */ if (negative < 0) {
--- a/Smalltalk.st Sun May 15 08:38:43 2016 +0100 +++ b/Smalltalk.st Tue May 17 10:05:14 2016 +0100 @@ -2502,6 +2502,7 @@ extensionsLoaded := false. ProgrammingLanguage allDo:[:programmingLanguage| + "/ evaluating or here - want all extensions to be loaded extensionsLoaded := extensionsLoaded | (self loadExtensionsForPackage:aPackageId language: programmingLanguage) ]. ^ extensionsLoaded @@ -2600,6 +2601,7 @@ extensionsLoaded := false. ProgrammingLanguage allDo:[:programmingLanguage| + "/ evaluating or here - want all extensions to be loaded extensionsLoaded := extensionsLoaded | (self loadExtensionsFromDirectory: packageDirOrString language: programmingLanguage) ]. ^ extensionsLoaded
--- a/SmalltalkLanguage.st Sun May 15 08:38:43 2016 +0100 +++ b/SmalltalkLanguage.st Tue May 17 10:05:14 2016 +0100 @@ -41,7 +41,6 @@ "Modified: / 16-08-2009 / 10:53:52 / Jan Vrany <vranyj1@fel.cvut.cz>" ! ! - !SmalltalkLanguage methodsFor:'accessing-classes'! codeGeneratorClass @@ -166,16 +165,16 @@ aSelector numArgs > 0 ifTrue:[ aSelector isKeyword ifTrue:[ - ^ String streamContents:[:stream | + ^ Text streamContents:[:stream | aSelector keywords with:argNames do:[:eachKeyword :eachArgName| - stream nextPutAll:eachKeyword; nextPutAll:eachArgName; space. + stream bold; nextPutAll:eachKeyword; normal; nextPutAll:eachArgName; space. ]. stream backStep. "remove the last space" ]. ]. - ^ aSelector , ' ' , (argNames at:1) + ^ aSelector allBold , ' ' , (argNames at:1) ]. - ^ aSelector + ^ aSelector allBold " SmalltalkLanguage instance
--- a/String.st Sun May 15 08:38:43 2016 +0100 +++ b/String.st Tue May 17 10:05:14 2016 +0100 @@ -1,3 +1,5 @@ +"{ Encoding: utf8 }" + " COPYRIGHT (c) 1988 by Claus Gittinger All Rights Reserved @@ -505,6 +507,7 @@ + !String class methodsFor:'queries'! defaultPlatformClass @@ -547,6 +550,7 @@ "Modified: / 12-01-2011 / 12:33:58 / cg" ! ! + !String methodsFor:'accessing'! at:index @@ -1343,7 +1347,7 @@ 'hello world' indexOfAny:'AOE' startingAt:1 'hello world' indexOfAny:'o' startingAt:6 'hello world' indexOfAny:'o' startingAt:6 - 'hello world' indexOfAny:'#$' startingAt:6 + 'hello world§' indexOfAny:'#§$' startingAt:6 " ! @@ -1443,97 +1447,97 @@ %{ /* NOCONTEXT */ if (__isSmallInteger(start)) { - REGISTER unsigned char *cp; - int len, index; - OBJ cls; - - index = __intVal(start)-1; - // is this a good idea? - if (index < 0) { - index = 0; - } - len = __stringSize(self); - cp = __stringVal(self); - - // care for subclasses of string - if ((cls = __qClass(self)) != String) { - int numInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars)); - - cp += numInstBytes; - len -= numInstBytes; - } - - // these pre-loops do fast skip over non-separators - // (anything above 0x32) + REGISTER unsigned char *cp; + int len, index; + OBJ cls; + + index = __intVal(start)-1; + // is this a good idea? + if (index < 0) { + index = 0; + } + len = __stringSize(self); + cp = __stringVal(self); + + // care for subclasses of string + if ((cls = __qClass(self)) != String) { + int numInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars)); + + cp += numInstBytes; + len -= numInstBytes; + } + + // these pre-loops do fast skip over non-separators + // (anything above 0x32) #if __POINTER_SIZE__ == 8 - if ((index & 7) == 0) { - int len8 = len-8; - while (index < len8) { - REGISTER unsigned INT eightChars; - REGISTER unsigned INT eightCharsMasked; - - eightChars = ((unsigned INT *)(cp+index))[0]; - eightCharsMasked = eightChars & 0xE0E0E0E0E0E0E0E0ULL; - - // any control char? - // (these are 0..31 and also the space); - // so we need two compares. + if ((index & 7) == 0) { + int len8 = len-8; + while (index < len8) { + REGISTER unsigned INT eightChars; + REGISTER unsigned INT eightCharsMasked; + + eightChars = ((unsigned INT *)(cp+index))[0]; + eightCharsMasked = eightChars & 0xE0E0E0E0E0E0E0E0ULL; + + // any control char? + // (these are 0..31 and also the space); + // so we need two compares. # define hasZeroByte(v) (((v) - 0x0101010101010101ULL) & ~(v) & 0x8080808080808080ULL) # define hasByteM(v,m) hasZeroByte( (v) ^ m) # define maskSpace (~0ULL/255 * (32)) - if (hasByteM(eightChars, maskSpace)) break; - if (hasZeroByte(eightCharsMasked)) break; + if (hasByteM(eightChars, maskSpace)) break; + if (hasZeroByte(eightCharsMasked)) break; # undef hasZeroByte # undef hasByteM # undef maskSpace - index += 8; - } - } + index += 8; + } + } #endif /* POINTER_SIZE == 8*/ - if ((index & 3) == 0) { - int len4 = len-4; - while (index < len4) { - REGISTER unsigned int fourChars; - REGISTER unsigned int fourCharsMasked; - - fourChars = ((unsigned int *)(cp+index))[0]; - fourCharsMasked = fourChars & 0xE0E0E0E0UL; - - // any control char? - // (these are 0..31 and also the space); - // so we need two compares. + if ((index & 3) == 0) { + int len4 = len-4; + while (index < len4) { + REGISTER unsigned int fourChars; + REGISTER unsigned int fourCharsMasked; + + fourChars = ((unsigned int *)(cp+index))[0]; + fourCharsMasked = fourChars & 0xE0E0E0E0UL; + + // any control char? + // (these are 0..31 and also the space); + // so we need two compares. # define hasZeroByte(v) (((v) - 0x01010101UL) & ~(v) & 0x80808080UL) # define hasByteM(v,m) hasZeroByte( (v) ^ m) # define maskSpace (~0UL/255 * (32)) - if (hasByteM(fourChars, maskSpace)) break; - if (hasZeroByte(fourCharsMasked)) break; + if (hasByteM(fourChars, maskSpace)) break; + if (hasZeroByte(fourCharsMasked)) break; # undef hasZeroByte # undef hasByteM # undef maskSpace - index += 4; - } - } - - while (index < len) { - REGISTER unsigned char c; - - c = cp[index]; - if (c <= ' ') { - if ((c == ' ') || (c == '\t') || (c == '\n') - || (c == '\r') || (c == '\f')) { - RETURN ( __mkSmallInteger(index+1) ); - } - } - index++; - } - RETURN ( __mkSmallInteger(0) ); + index += 4; + } + } + + while (index < len) { + REGISTER unsigned char c; + + c = cp[index]; + if (c <= ' ') { + if ((c == ' ') || (c == '\t') || (c == '\n') + || (c == '\r') || (c == '\f')) { + RETURN ( __mkSmallInteger(index+1) ); + } + } + index++; + } + RETURN ( __mkSmallInteger(0) ); } %}. ^ super indexOfSeparatorStartingAt:start @@ -1551,7 +1555,7 @@ s := String new:1000 withAll:$a. self assert:(s indexOfSeparatorStartingAt:1) == 0. Time millisecondsToRun:[ - 1000000 timesRepeat:[ s indexOfSeparatorStartingAt:1 ] + 1000000 timesRepeat:[ s indexOfSeparatorStartingAt:1 ] ] original (char-wise):760 760 750 with 4-byte at a time: 640 650 620 @@ -1563,7 +1567,7 @@ s at:400 put:(Character return). self assert:(s indexOfSeparatorStartingAt:1) == 400. Time millisecondsToRun:[ - 1000000 timesRepeat:[ s indexOfSeparatorStartingAt:1 ] + 1000000 timesRepeat:[ s indexOfSeparatorStartingAt:1 ] ] original (char-wise):340 350 with 4-byte at a time: 310 290 280 @@ -1575,7 +1579,7 @@ s at:999 put:(Character space). self assert:(s indexOfSeparatorStartingAt:1) == 999. Time millisecondsToRun:[ - 1000000 timesRepeat:[ s indexOfSeparatorStartingAt:1 ] + 1000000 timesRepeat:[ s indexOfSeparatorStartingAt:1 ] ] original (char-wise): 750 750 790 with 4-byte at a time: 640 640 620 @@ -1913,11 +1917,11 @@ ^ self compareWith:aString collating:true " - 'hallo' compareWith:'hllo' - 'hbllo' compareWith:'hllo' - - 'hallo' compareCollatingWith:'hllo' - 'hbllo' compareCollatingWith:'hllo' + 'hallo' compareWith:'hällo' + 'hbllo' compareWith:'hällo' + + 'hallo' compareCollatingWith:'hällo' + 'hbllo' compareCollatingWith:'hällo' " ! @@ -3247,41 +3251,6 @@ ! ! -!String methodsFor:'encoding'! - -utf8Encoded - "Return my UTF-8 representation as a new String" - - self containsNon7BitAscii ifTrue:[ - ^ CharacterEncoderImplementations::ISO10646_to_UTF8 new encodeString:self - ]. - "speed up common case" - ^ self. -! - -utf8EncodedOn:aStream - "write to aStream in utf8 encoding" - - self containsNon7BitAscii ifTrue:[ - aStream nextPutAllUtf8:self. - ] ifFalse:[ - "speed up common case" - aStream nextPutAll:self. - ]. - - " - String streamContents:[:w| - 'abcde1234' utf8EncodedOn:w - ]. - String streamContents:[:w| - 'abcde' utf8EncodedOn:w - ]. - String streamContents:[:w| - 'abcde' asUnicode16String utf8EncodedOn:w - ]. - " -! ! - !String methodsFor:'filling & replacing'! atAllPut:aCharacter @@ -3731,8 +3700,8 @@ " 'hello world' asUnicode16String errorPrint (Character value:356) asString errorPrint - 'Bnnigheim' errorPrint - 'Bnnigheim' asUnicodeString errorPrint + 'Bönnigheim' errorPrint + 'Bönnigheim' asUnicodeString errorPrint " ! @@ -4120,6 +4089,65 @@ stringSpecies ^ self species +! + +utf8DecodedMaxBytes + "return the number of charcters needed when this string is + decoded from UTF-8." + +%{ /* NOCONTEXT */ + + unsigned char *cp = __stringVal(self); + unsigned char *last = cp + __stringSize(self); + int max = 1; + + if (!__isStringLike(self)) { + cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars)); + } + + for ( ; cp < last; cp++) { + unsigned char mask = *cp & 0xF0; + if (mask != 0) { + if ((mask & 0xE0 )== 0xC0) { if (max < 2) max = 2; } + else if (mask == 0xE0) { if (max < 3) max = 3; } + else if (mask == 0xF0) { max = 4; break;} + } + } + RETURN (__mkSmallInteger(max)); +%}. + + " + 'hello world' utf8DecodedMaxBytes + 'ä' utf8Encoded utf8DecodedMaxBytes + 'äΣΔΨӕἤῴ' utf8Encoded utf8DecodedMaxBytes + " +! + +utf8DecodedSize + "return the number of charcters needed when this string is + decoded from UTF-8." + +%{ /* NOCONTEXT */ + + unsigned char *cp = __stringVal(self); + unsigned char *last = cp + __stringSize(self); + unsigned INT len = 0; + + if (!__isStringLike(self)) { + cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars)); + } + // count the number of start-bytes + for ( ; cp < last; cp++) { + if ((*cp & 0xC0) != 0x80) len++; + } + RETURN (__mkSmallInteger(len)); +%}. + + " + 'hello world' utf8DecodedSize + 'ä' utf8Encoded utf8DecodedSize + 'äΣΔΨӕἤῴ' utf8Encoded utf8DecodedSize + " ! ! !String methodsFor:'sorting & reordering'!
--- a/Time.st Sun May 15 08:38:43 2016 +0100 +++ b/Time.st Tue May 17 10:05:14 2016 +0100 @@ -627,13 +627,16 @@ milliseconds "get the milliseconds part (notice: that is NOT the total number of millis (since midnight), - but the fractional part only. Use this only for printing" + but the fractional part only. Use this only for printing. + asMilliseconds or getMilliseconds is probably what you want" ^ timeEncoding \\ 1000 ! minutes - "return the number of minutes within the hour (i.e. 0..59)" + "return the number of minutes within the hour (i.e. 0..59). + (notice: that is NOT the total number of minutes (since midnight), + but the fractional part only. Use this only for printing." ^ (self getSeconds \\ 3600) // 60 @@ -643,7 +646,10 @@ ! seconds - "return the number of seconds within the minute (i.e. 0..59)" + "return the number of seconds within the minute (i.e. 0..59). + (notice: that is NOT the total number of seconds (since midnight), + but the fractional part only. Use this only for printing. + asSeconds or getSeconds give you the nr of seconds since midnight" ^ self getSeconds \\ 60 @@ -1077,10 +1083,10 @@ !Time class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Time.st,v 1.104 2015-06-06 12:57:19 cg Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Time.st,v 1.104 2015-06-06 12:57:19 cg Exp $' + ^ '$Header$' ! !
--- a/TimeDuration.st Sun May 15 08:38:43 2016 +0100 +++ b/TimeDuration.st Tue May 17 10:05:14 2016 +0100 @@ -15,7 +15,7 @@ Time subclass:#TimeDuration instanceVariableNames:'' - classVariableNames:'TimeDurationZero DefaultFormatForPrinting' + classVariableNames:'DefaultFormatForPrinting TimeDurationZero' poolDictionaries:'' category:'Magnitude-Time' ! @@ -484,7 +484,8 @@ milliseconds "get the milliseconds part (notice: that is NOT the total number of millis, - but the fractional part only. Use this only for printing" + but the fractional part only. Use this only for printing. + asMilliseconds or getMilliseconds is probably what you want" ^ timeEncoding \\ 1000 @@ -502,7 +503,8 @@ seconds "get the number of seconds. (notice: that is NOT the total number of seconds, - but the fractional part only. Use this only for printing" + but the fractional part only. Use this only for printing. + asSeconds or getSeconds is probably what you want" ^ timeEncoding // 1000 \\ 60 ! ! @@ -673,7 +675,6 @@ ^ aTimestamp addMilliseconds:(self getMilliseconds) ! ! - !TimeDuration methodsFor:'printing'! addPrintBindingsTo:aDictionary language:languageOrNil
--- a/TwoByteString.st Sun May 15 08:38:43 2016 +0100 +++ b/TwoByteString.st Tue May 17 10:05:14 2016 +0100 @@ -115,44 +115,6 @@ ^ super basicAt:index. ! ! -!TwoByteString methodsFor:'encoding'! - -utf8Encoded - "Return my UTF-8 representation as a new String" - - ^ CharacterEncoderImplementations::ISO10646_to_UTF8 new encodeString:self - - - " - 'abcdef' asUnicode16String utf8Encoded - 'abcdefäöü' asUnicode16String utf8Encoded - " -! - -utf8EncodedOn:aStream - "write to aStream in utf8 encoding" - - self containsNon7BitAscii ifTrue:[ - aStream nextPutAllUtf8:self. - ] ifFalse:[ - |sz "{Class: SmallInteger}"| - - sz := self size. - 1 to:sz do:[:idx| - aStream nextPut:(self basicAt:idx). - ]. - ]. - - " - String streamContents:[:w| - 'abcde1234' asUnicode16String utf8EncodedOn:w - ]. - String streamContents:[:w| - 'abcdeäöüß' asUnicode16String utf8EncodedOn:w - ]. - " -! ! - !TwoByteString methodsFor:'filling and replacing'! replaceFrom:start to:stop with:aString startingAt:repStart
--- a/UserPreferences.st Sun May 15 08:38:43 2016 +0100 +++ b/UserPreferences.st Tue May 17 10:05:14 2016 +0100 @@ -2579,6 +2579,36 @@ !UserPreferences methodsFor:'accessing-prefs-browser'! +acceptCancelBarOrder + "the original order was accept-cancel-compare. + However, we found that the danger of pressing cancel by accident + was too high, so we changed the default. + If you want to go back, return #acceptCancelCompare here" + + ^ self at:#acceptCancelBarOrder ifAbsent:#acceptCompareCancel + + " + UserPreferences current acceptCancelBarOrder + UserPreferences current acceptCancelBarOrder: #acceptCompareCancel + UserPreferences current acceptCancelBarOrder: #acceptCancelCompare + " +! + +acceptCancelBarOrder:aSymbol + "the original order was accept-cancel-compare. + However, we found that the danger of pressing cancel by accident + was too high, so we changed the default. + If you want to go back, return #acceptCancelCompare here" + + self at:#acceptCancelBarOrder put:aSymbol + + " + UserPreferences current acceptCancelBarOrder + UserPreferences current acceptCancelBarOrder: #acceptCompareCancel + UserPreferences current acceptCancelBarOrder: #acceptCancelCompare + " +! + autoFormatting "return the flag which controls automatic formatting of code (in some browsers) Notice, the regular browser does not (yet) do automatic formating."