| author | Jan Vrany <jan.vrany@fit.cvut.cz> |
| Wed, 22 Apr 2015 07:33:07 +0100 | |
| branch | jv |
| changeset 18261 | 22bdfc405bca |
| parent 18260 | e55af242e134 (current diff) |
| parent 18256 | 70138be99d04 (diff) |
| child 18274 | 042d13555f1f |
--- a/Array.st Tue Apr 21 17:27:23 2015 +0100 +++ b/Array.st Wed Apr 22 07:33:07 2015 +0100 @@ -38,7 +38,7 @@ documentation " - Instances of Array store general objects; + Instances of Array store general objects; an array's size is fixed, therefore add:/remove: are not allowed. (actually, #add: is implemented for compatibility with smalltalks which provide it, but it is very slow and outputs an annoying warning message...) @@ -59,7 +59,7 @@ Literal arrays (i.e. array-constants) are entered in source as: - #( element1 element2 ... element-N) + #( element1 element2 ... element-N) where each element must be itself a literal constant. Array, symbol and byteArray constants within an array can be written @@ -77,37 +77,37 @@ Also, a syntactic sugar piece allows for Array instances to be created dynamcially at runtime with the brace syntax: - { expr1 . expr2 . ... . expr-N } + { expr1 . expr2 . ... . expr-N } where each expr-i evaluates to an element of the new array instance. Notice that the expressions are separated by a period. Semantically, this is equivalent to ``Array with:expr1 with:expr2 ... with:expr-N'' Examples: - { 1 . 2 . 3 } -> a new 3 element array; similar to #( 1 2 3 ), - but in contrast, a new array instance is created - { - { 'foo' . [ Transcript showCR:'foo' ] } . - { 'bar' . [ Transcript showCR:'bar' ] } - { 'baz' . [ Transcript showCR:'baz' ] } - } - -> a new 3 element array, consisting of 3 new - 2-element array instances, consisting of a string - and a block each + { 1 . 2 . 3 } -> a new 3 element array; similar to #( 1 2 3 ), + but in contrast, a new array instance is created + { + { 'foo' . [ Transcript showCR:'foo' ] } . + { 'bar' . [ Transcript showCR:'bar' ] } + { 'baz' . [ Transcript showCR:'baz' ] } + } + -> a new 3 element array, consisting of 3 new + 2-element array instances, consisting of a string + and a block each [memory requirements:] - OBJ-HEADER + (size * ptr-size) + OBJ-HEADER + (size * ptr-size) [warning:] - read the warning about 'growing fixed size collection' - in ArrayedCollection's documentation + read the warning about 'growing fixed size collection' + in ArrayedCollection's documentation [author:] - Claus Gittinger + Claus Gittinger [see also:] - OrderedCollection - ByteArray FloatArray DoubleArray IntegerArray BitArray - CharacterArray String + OrderedCollection + ByteArray FloatArray DoubleArray IntegerArray BitArray + CharacterArray String " ! ! @@ -452,7 +452,7 @@ "could be an instance of a subclass..." self class == Array ifTrue:[ - ^ self + ^ self ]. ^ super asArray @@ -473,7 +473,7 @@ "could be an instance of a subclass..." self class == Array ifTrue:[ - ^ self copy + ^ self copy ]. ^ super asArray ! @@ -491,31 +491,31 @@ , aCollection %{ if (__isArray(aCollection)) { - if (__isArray(self)) { - OBJ newArray; - int mySize = __arraySize(self); - int otherSize = __arraySize(aCollection); - REGISTER OBJ src; - int srcIdx, dstIdx; - newArray = __ARRAY_NEW_INT(mySize+otherSize); + if (__isArray(self)) { + OBJ newArray; + int mySize = __arraySize(self); + int otherSize = __arraySize(aCollection); + REGISTER OBJ src; + int srcIdx, dstIdx; + newArray = __ARRAY_NEW_INT(mySize+otherSize); - src = self; - for (dstIdx=0; dstIdx<mySize; dstIdx++) { - OBJ el = __ArrayInstPtr(src)->a_element[dstIdx]; + src = self; + for (dstIdx=0; dstIdx<mySize; dstIdx++) { + OBJ el = __ArrayInstPtr(src)->a_element[dstIdx]; - __ArrayInstPtr(newArray)->a_element[dstIdx] = el; - __STORE(newArray, el); - } + __ArrayInstPtr(newArray)->a_element[dstIdx] = el; + __STORE(newArray, el); + } - src = aCollection; - for (srcIdx=0; srcIdx<otherSize; srcIdx++, dstIdx++) { - OBJ el = __ArrayInstPtr(src)->a_element[srcIdx]; + src = aCollection; + for (srcIdx=0; srcIdx<otherSize; srcIdx++, dstIdx++) { + OBJ el = __ArrayInstPtr(src)->a_element[srcIdx]; - __ArrayInstPtr(newArray)->a_element[dstIdx] = el; - __STORE(newArray, el); - } - RETURN (newArray); - } + __ArrayInstPtr(newArray)->a_element[dstIdx] = el; + __STORE(newArray, el); + } + RETURN (newArray); + } } %}. ^ super , aCollection @@ -1748,50 +1748,50 @@ "append a printed representation of the receiver to aStream" self isLiteral ifTrue:[ - |limit firstOne s| + |limit firstOne s| - thisContext isRecursive ifTrue:[ - 'Array [error]: printOn: of self referencing collection.' errorPrintCR. - aStream nextPutAll:'#("recursive")'. - ^ self - ]. + thisContext isRecursive ifTrue:[ + 'Array [error]: printOn: of self referencing collection.' errorPrintCR. + aStream nextPutAll:'#("recursive")'. + ^ self + ]. - aStream nextPutAll:'#('. - firstOne := true. + aStream nextPutAll:'#('. + firstOne := true. - " - if aStream is not positionable, create an temporary positionable stream - (needed for limit calculation) - " - aStream isPositionable ifTrue:[ - s := aStream. - ] ifFalse:[ - s := WriteStream on:(String uninitializedNew:50). - ]. - limit := s position + self maxPrint. + " + if aStream is not positionable, create an temporary positionable stream + (needed for limit calculation) + " + aStream isPositionable ifTrue:[ + s := aStream. + ] ifFalse:[ + s := WriteStream on:(String uninitializedNew:50). + ]. + limit := s position + self maxPrint. - self printElementsDo:[:element | - firstOne ifFalse:[ - s space - ] ifTrue:[ - firstOne := false - ]. - (s position >= limit) ifTrue:[ - s ~~ aStream ifTrue:[ - aStream nextPutAll:(s contents). - ]. - aStream nextPutAll:'...etc...)'. - ^ self - ] ifFalse:[ - element printOn:s. - ]. - ]. - s ~~ aStream ifTrue:[ - aStream nextPutAll:(s contents). - ]. - aStream nextPut:$) + self printElementsDo:[:element | + firstOne ifFalse:[ + s space + ] ifTrue:[ + firstOne := false + ]. + (s position >= limit) ifTrue:[ + s ~~ aStream ifTrue:[ + aStream nextPutAll:(s contents). + ]. + aStream nextPutAll:'...etc...)'. + ^ self + ] ifFalse:[ + element printOn:s. + ]. + ]. + s ~~ aStream ifTrue:[ + aStream nextPutAll:(s contents). + ]. + aStream nextPut:$) ] ifFalse:[ - super printOn:aStream + super printOn:aStream ] " @@ -1849,9 +1849,13 @@ "return the number of indexed elements in the receiver" %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context._RETURN (STInteger._new(self.basicSize())); +#else REGISTER OBJ slf = self; RETURN ( __mkSmallInteger(__arraySize(slf) - __intVal(__ClassInstPtr(__qClass(slf))->c_ninstvars) )); +#endif %} ! @@ -1860,10 +1864,10 @@ receiver refers to aLiteral (i.e. a deep search)" self do: [ :el | - el == aLiteral ifTrue:[^true]. - el class == Array ifTrue:[ - (el refersToLiteral: aLiteral) ifTrue: [^true] - ] + el == aLiteral ifTrue:[^true]. + el class == Array ifTrue:[ + (el refersToLiteral: aLiteral) ifTrue: [^true] + ] ]. ^ false @@ -1906,9 +1910,13 @@ This method is the same as basicSize." %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context._RETURN (STInteger._new(self.basicSize())); +#else REGISTER OBJ slf = self; RETURN ( __mkSmallInteger(__arraySize(slf) - __intVal(__ClassInstPtr(__qClass(slf))->c_ninstvars) )); +#endif %} ! ! @@ -2639,10 +2647,9 @@ !Array class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.165 2015-02-03 13:54:47 stefan Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.166 2015-04-20 14:04:23 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.165 2015-02-03 13:54:47 stefan Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.166 2015-04-20 14:04:23 cg Exp $' ! ! -
--- a/Behavior.st Tue Apr 21 17:27:23 2015 +0100 +++ b/Behavior.st Wed Apr 22 07:33:07 2015 +0100 @@ -4597,7 +4597,7 @@ implements:aSelector "return true, if the receiver implements aSelector. (i.e. implemented in THIS class - NOT in a superclass). - This is semantically equivalent to includesSelector: (which is ST/80/Squeak compatibility). + This is semantically equivalent to includesSelector: (which is ST/80/Squeak compatibility). Caveat: This simply checks for the selector being present in the classes @@ -5089,7 +5089,6 @@ "Modified: 16.4.1996 / 18:12:14 / cg" ! ! - !Behavior methodsFor:'tracing'! traceInto:aRequestor level:level from:referrer @@ -5111,10 +5110,10 @@ !Behavior class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.371 2015-03-26 10:04:19 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.372 2015-04-20 13:16:30 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.371 2015-03-26 10:04:19 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.372 2015-04-20 13:16:30 cg Exp $' ! !
--- a/Block.st Tue Apr 21 17:27:23 2015 +0100 +++ b/Block.st Wed Apr 22 07:33:07 2015 +0100 @@ -65,11 +65,11 @@ A return (via ^-statement) out of a block will force a return from the blocks method context (if it is still living) - this make the implementation of long-jumps and control structures possible. - (If the method is not alive (i.e. has already returned), a return out of the + (If the method is not alive (i.e. has already returned), a return out of the block will trigger an error) Long-jump is done by defining a catchBlock as ''[^ self]'' - somewhere up in the calling-tree. Then, to do the long-jump from out of some + somewhere up in the calling-tree. Then, to do the long-jump from out of some deeply nested method, simply do: ''catchBlock value''. [Instance variables:] @@ -105,71 +105,71 @@ examples " define a block and evaluate it: - [exBegin] - |b| - - b := [ Transcript showCR:'hello' ]. - - Transcript showCR:'now evaluating the block ...'. - b value. - [exEnd] - - - - even here, blocks are involved: + [exBegin] + |b| + + b := [ Transcript showCR:'hello' ]. + + Transcript showCR:'now evaluating the block ...'. + b value. + [exEnd] + + + + even here, blocks are involved: (although, the compiler optimizes things if possible) - [exBegin] - Transcript showCR:'now evaluating one of two blocks ...'. - 1 > 4 ifTrue:[ - Transcript showCR:'foo' - ] ifFalse:[ - Transcript showCR:'bar' - ] - [exEnd] + [exBegin] + Transcript showCR:'now evaluating one of two blocks ...'. + 1 > 4 ifTrue:[ + Transcript showCR:'foo' + ] ifFalse:[ + Transcript showCR:'bar' + ] + [exEnd] here things become obvious: - [exBegin] - |yesBlock noBlock| - - yesBlock := [ Transcript showCR:'foo' ]. - noBlock := [ Transcript showCR:'bar' ]. - - Transcript showCR:'now evaluating one of two blocks ...'. - 1 > 4 ifTrue:yesBlock - ifFalse:noBlock - [exEnd] + [exBegin] + |yesBlock noBlock| + + yesBlock := [ Transcript showCR:'foo' ]. + noBlock := [ Transcript showCR:'bar' ]. + + Transcript showCR:'now evaluating one of two blocks ...'. + 1 > 4 ifTrue:yesBlock + ifFalse:noBlock + [exEnd] simple loops: not very objectOriented: - [exBegin] - |i| - - i := 1. - [i < 10] whileTrue:[ - Transcript showCR:i. - i := i + 1 - ] - [exEnd] + [exBegin] + |i| + + i := 1. + [i < 10] whileTrue:[ + Transcript showCR:i. + i := i + 1 + ] + [exEnd] using integer protocol: - [exBegin] - 1 to:10 do:[:i | - Transcript showCR:i. - ] - [exEnd] + [exBegin] + 1 to:10 do:[:i | + Transcript showCR:i. + ] + [exEnd] interval protocol: - [exBegin] - (1 to:10) do:[:i | - Transcript showCR:i. - ] - [exEnd] + [exBegin] + (1 to:10) do:[:i | + Transcript showCR:i. + ] + [exEnd] @@ -177,131 +177,131 @@ bad code: (only works with numeric-indexable collections) - [exBegin] - |i coll| - - coll := #(9 8 7 6 5). - i := 1. - [i <= coll size] whileTrue:[ - Transcript showCR:(coll at:i). - i := i + 1. - ] - [exEnd] + [exBegin] + |i coll| + + coll := #(9 8 7 6 5). + i := 1. + [i <= coll size] whileTrue:[ + Transcript showCR:(coll at:i). + i := i + 1. + ] + [exEnd] just as bad (well, marginally better ;-): (only works with numeric-indexable collections) - [exBegin] - |coll| - - coll := #(9 8 7 6 5). - 1 to:coll size do:[:i | - Transcript showCR:(coll at:i). - ] - [exEnd] + [exBegin] + |coll| + + coll := #(9 8 7 6 5). + 1 to:coll size do:[:i | + Transcript showCR:(coll at:i). + ] + [exEnd] the smalltalk way: (works with any collection) - [exBegin] - |coll| - - coll := #(9 8 7 6 5). - coll do:[:element | - Transcript showCR:element. - ] - [exEnd] - + [exBegin] + |coll| + + coll := #(9 8 7 6 5). + coll do:[:element | + Transcript showCR:element. + ] + [exEnd] + Rule: use enumeration protocol of the collection instead of - manually indexing it. [with few exceptions] + manually indexing it. [with few exceptions] processes: forking a lightweight process (thread): - [exBegin] - [ - Transcript showCR:'waiting ...'. - Delay waitForSeconds:2. - Transcript showCR:'here I am'. - ] fork - [exEnd] - - - + [exBegin] + [ + Transcript showCR:'waiting ...'. + Delay waitForSeconds:2. + Transcript showCR:'here I am'. + ] fork + [exEnd] + + + some with low prio: - [exBegin] - [ - Transcript showCR:'computing ...'. - 10000 factorial. - Transcript showCR:'here I am'. - ] forkAt:(Processor userBackgroundPriority) - [exEnd] + [exBegin] + [ + Transcript showCR:'computing ...'. + 10000 factorial. + Transcript showCR:'here I am'. + ] forkAt:(Processor userBackgroundPriority) + [exEnd] handling exceptions: - [exBegin] - Error handle:[:ex | - Transcript showCR:'exception handler forces return'. - ex return - ] do:[ - Transcript showCR:'now, doing something bad ...'. - 1 / 0. - Transcript showCR:'not reached' - ] - [exEnd] + [exBegin] + Error handle:[:ex | + Transcript showCR:'exception handler forces return'. + ex return + ] do:[ + Transcript showCR:'now, doing something bad ...'. + 1 / 0. + Transcript showCR:'not reached' + ] + [exEnd] performing cleanup actions: - [exBegin] - Error handle:[:ex | - Transcript showCR:'exception handler forces return'. - ex return - ] do:[ - [ - Transcript showCR:'doing something bad ...'. - 1 / 0. - Transcript showCR:'not reached' - ] ifCurtailed:[ - Transcript showCR:'cleanup' - ] - ] - [exEnd] + [exBegin] + Error handle:[:ex | + Transcript showCR:'exception handler forces return'. + ex return + ] do:[ + [ + Transcript showCR:'doing something bad ...'. + 1 / 0. + Transcript showCR:'not reached' + ] ifCurtailed:[ + Transcript showCR:'cleanup' + ] + ] + [exEnd] delayed execution (visitor pattern): - (looking carefully into the example, + (looking carefully into the example, C/C++ programmers may raise their eyes ;-) - [exBegin] - |showBlock countBlock - howMany - top panel b1 b2| - - howMany := 0. - - showBlock := [ Transcript showCR:howMany ]. - countBlock := [ howMany := howMany + 1 ]. - - top := StandardSystemView extent:200@200. - panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top. - - b1 := Button label:'count up' in:panel. - b1 action:countBlock. - - b2 := Button label:'show value' in:panel. - b2 action:showBlock. - - top open. - - Transcript showCR:'new process started;'. - Transcript showCR:'notice: the blocks can still access the'. - Transcript showCR:' howMany local variable.'. - [exEnd] + [exBegin] + |showBlock countBlock + howMany + top panel b1 b2| + + howMany := 0. + + showBlock := [ Transcript showCR:howMany ]. + countBlock := [ howMany := howMany + 1 ]. + + top := StandardSystemView extent:200@200. + panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top. + + b1 := Button label:'count up' in:panel. + b1 action:countBlock. + + b2 := Button label:'show value' in:panel. + b2 action:showBlock. + + top open. + + Transcript showCR:'new process started;'. + Transcript showCR:'notice: the blocks can still access the'. + Transcript showCR:' howMany local variable.'. + [exEnd] " ! ! @@ -311,9 +311,9 @@ "create signals raised by various errors" InvalidNewSignal isNil ifTrue:[ - InvalidNewSignal := Error newSignalMayProceed:false. - InvalidNewSignal nameClass:self message:#invalidNewSignal. - InvalidNewSignal notifierString:'blocks are only created by the system'. + InvalidNewSignal := Error newSignalMayProceed:false. + InvalidNewSignal nameClass:self message:#invalidNewSignal. + InvalidNewSignal notifierString:'blocks are only created by the system'. ] "Modified: 22.4.1996 / 16:34:20 / cg" @@ -335,7 +335,7 @@ |newBlock| - newBlock := (super basicNew:(literals size)) + newBlock := (super basicNew:(literals size)) byteCode:bCode numArgs:numArgs numVars:numVars @@ -408,24 +408,24 @@ " [ - [ - Transcript showCR:'one'. - Processor activeProcess terminate. - Transcript showCR:'two'. - ] ensure:[ - Transcript showCR:'three'. - ]. + [ + Transcript showCR:'one'. + Processor activeProcess terminate. + Transcript showCR:'two'. + ] ensure:[ + Transcript showCR:'three'. + ]. ] fork. " " [ - [ - Transcript showCR:'one'. - Transcript showCR:'two'. - ] ensure:[ - Transcript showCR:'three'. - ]. + [ + Transcript showCR:'one'. + Transcript showCR:'two'. + ] ensure:[ + Transcript showCR:'three'. + ]. ] fork. " ! @@ -452,23 +452,23 @@ s := 'Makefile' asFilename readStream. [ - ^ self + ^ self ] ifCurtailed:[ - Transcript showCR:'closing the stream - even though a return occurred'. - s close + Transcript showCR:'closing the stream - even though a return occurred'. + s close ] " " [ - |s| - - s := 'Makefile' asFilename readStream. - [ - Processor activeProcess terminate - ] ifCurtailed:[ - Transcript showCR:'closing the stream - even though process was terminated'. - s close - ] + |s| + + s := 'Makefile' asFilename readStream. + [ + Processor activeProcess terminate + ] ifCurtailed:[ + Transcript showCR:'closing the stream - even though process was terminated'. + s close + ] ] fork " ! ! @@ -488,15 +488,15 @@ "Dolphin compatibility method - do not use in new code. Dolphin's alias for futureValue" - ^ Future new - priority:priority block:self + ^ Future new + priority:priority block:self "Created: / 04-10-2011 / 14:55:56 / cg" ! ! !Block methodsFor:'Compatibility-Squeak'! -cull: optionalFirstArg +cull: optionalFirstArg "activate the receiver with one or zero arguments. Squeak compatibility, but also present in VW Smalltalk" @@ -518,10 +518,10 @@ Squeak compatibility, but also present in VW Smalltalk" nargs >= 2 ifTrue:[ - nargs >= 3 ifTrue:[ - ^ self value:optionalFirstArg value:optionalSecondArg value:optionalThirdArg - ]. - ^ self value:optionalFirstArg value:optionalSecondArg + nargs >= 3 ifTrue:[ + ^ self value:optionalFirstArg value:optionalSecondArg value:optionalThirdArg + ]. + ^ self value:optionalFirstArg value:optionalSecondArg ]. nargs = 1 ifTrue:[^ self value:optionalFirstArg]. ^ self value @@ -539,22 +539,22 @@ numArgs := handlerBlock isBlock ifTrue:[handlerBlock numArgs] ifFalse:[0]. numArgs == 1 ifTrue:[ - ^ self on:Error do:handlerBlock + ^ self on:Error do:handlerBlock ]. - ^ self - on:Error - do:[:ex | - |errString errReceiver| - - numArgs == 0 ifTrue:[ - ex return:handlerBlock value - ] ifFalse:[ - errString := ex description. - errReceiver := ex suspendedContext receiver. - ex return:(handlerBlock value:errString value:errReceiver) - ]. - ] + ^ self + on:Error + do:[:ex | + |errString errReceiver| + + numArgs == 0 ifTrue:[ + ex return:handlerBlock value + ] ifFalse:[ + errString := ex description. + errReceiver := ex suspendedContext receiver. + ex return:(handlerBlock value:errString value:errReceiver) + ]. + ] " |a| @@ -594,7 +594,7 @@ apply:aCollection from:start to:end "VisualAge compatibility: - Evaluate the receiver for each variable slot of aCollection from start to end. + Evaluate the receiver for each variable slot of aCollection from start to end. Answer aCollection." aCollection from:start to:end do:self. @@ -602,7 +602,7 @@ " [:i | Transcript showCR:i ] - apply:#(10 20 30 40 50 60) from:2 to:4 + apply:#(10 20 30 40 50 60) from:2 to:4 " "Created: / 16-05-2012 / 11:20:55 / cg" @@ -610,7 +610,7 @@ applyWithIndex:aCollection from:start to:end "VisualAge compatibility: - Evaluate the receiver for each variable slot and index of aCollection from start to end. + Evaluate the receiver for each variable slot and index of aCollection from start to end. Answer aCollection." aCollection from:start to:end doWithIndex:self. @@ -618,7 +618,7 @@ " [:el :i | Transcript showCR:(i -> el) ] - applyWithIndex:#(10 20 30 40 50 60) from:2 to:4 + applyWithIndex:#(10 20 30 40 50 60) from:2 to:4 " "Created: / 16-05-2012 / 11:22:01 / cg" @@ -628,7 +628,7 @@ "VisualAge compatibility: alias for #ensure: evaluate the receiver - when the block returns either a local return or an unwind (i.e. does a long return), evaluate the argument, aBlock. - This is used to make certain that cleanup actions + This is used to make certain that cleanup actions (for example closing files etc.) are executed regardless of error actions." ^ [self value:arg1] ensure:aBlock @@ -640,7 +640,7 @@ "VisualAge compatibility: alias for #ensure: evaluate the receiver - when the block returns either a local return or an unwind (i.e. does a long return), evaluate the argument, aBlock. - This is used to make certain that cleanup actions + This is used to make certain that cleanup actions (for example closing files etc.) are executed regardless of error actions." ^ [self value:arg1 value:arg2] ensure:aBlock @@ -652,7 +652,7 @@ "VisualAge compatibility: alias for #ensure: evaluate the receiver - when the block returns either a local return or an unwind (i.e. does a long return), evaluate the argument, aBlock. - This is used to make certain that cleanup actions + This is used to make certain that cleanup actions (for example closing files etc.) are executed regardless of error actions." ^ [self value:arg1 value:arg2 value:arg3] ensure:aBlock @@ -664,7 +664,7 @@ "VisualAge compatibility: alias for #ensure: evaluate the receiver - when the block returns either a local return or an unwind (i.e. does a long return), evaluate the argument, aBlock. - This is used to make certain that cleanup actions + This is used to make certain that cleanup actions (for example closing files etc.) are executed regardless of error actions." ^ self ensure:aBlock @@ -697,8 +697,8 @@ |m| home notNil ifTrue:[ - m := home method. - m notNil ifTrue:[^ m]. + m := home method. + m notNil ifTrue:[^ m]. ]. m := self literalAt:1 ifAbsent:nil. m isMethod ifTrue:[^ m]. @@ -708,7 +708,7 @@ ! method - "return the receivers method + "return the receivers method (the method where the block was created). Obsolete: use #homeMethod for ST80 compatibility." @@ -724,7 +724,7 @@ defined). For cheap blocks, nil is returned" home notNil ifTrue:[ - ^ home methodHome + ^ home methodHome ]. ^ nil ! @@ -763,8 +763,8 @@ " |b| - b := [:argList | Transcript - show:'invoked with args:'; + b := [:argList | Transcript + show:'invoked with args:'; showCR:argList ] asVarArgBlock. b value. @@ -789,12 +789,12 @@ |b b1 b2 b3| b := [:a :b :c | a + b + c] beCurryingBlock. - b numArgs. + b numArgs. b value:1 value:2 value:3. b1 := b value:10. - b1 numArgs. - b1 value:2 value:3. + b1 numArgs. + b1 value:2 value:3. b2 := b value:10 value:20. b2 numArgs. @@ -833,7 +833,7 @@ |copyOfHome copyOfMe| home isNil ifTrue:[ - ^ super deepCopyUsing:aDictionary postCopySelector:postCopySelector + ^ super deepCopyUsing:aDictionary postCopySelector:postCopySelector ]. copyOfHome := home deepCopyUsing:aDictionary. copyOfMe := self shallowCopy. @@ -860,21 +860,21 @@ Transcript show:anInfoString. micros < 1000 ifTrue:[ - Transcript show:micros; show:' µs'. + Transcript show:micros; show:' µs'. ] ifFalse:[ - micros < 100000 ifTrue:[ - millis := (micros / 1000.0) asFixedPointRoundedToScale:2. - Transcript show:millis; show:' ms'. - ] ifFalse:[ - millis := micros // 1000. - Transcript show:(TimeDuration milliseconds:millis). - ]. + micros < 100000 ifTrue:[ + millis := (micros / 1000.0) asFixedPointRoundedToScale:2. + Transcript show:millis; show:' ms'. + ] ifFalse:[ + millis := micros // 1000. + Transcript show:(TimeDuration milliseconds:millis). + ]. ]. Transcript cr. " - [10 factorial] benchmark:'10 factorial:' - [100 factorial] benchmark:'100 factorial:' + [10 factorial] benchmark:'10 factorial:' + [100 factorial] benchmark:'100 factorial:' " ! ! @@ -890,8 +890,8 @@ someone played around." ^ InvalidCodeError - raiseRequestWith:self - errorString:'invalid block - not executable' + raiseRequestWith:self + errorString:'invalid block - not executable' "Modified: 4.11.1996 / 22:46:39 / cg" ! ! @@ -899,88 +899,97 @@ !Block methodsFor:'evaluation'! value - "evaluate the receiver with no block args. + "evaluate the receiver with no block args. The receiver must be a block without arguments." %{ /* NOCONTEXT */ - +#ifdef __SCHTEAM__ + return context.TAILCALL0( self.asSTCallable() ); + /* NOTREACHED */ +#else REGISTER OBJFUNC thecode; OBJ home; if (__INST(nargs) == __mkSmallInteger(0)) { -#if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); -#endif - - thecode = __BlockInstPtr(self)->b_code; -#ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - /* compiled machine code */ - RETURN ( (*thecode)(self) ); - } - /* interpreted code */ -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 0, nil, nil, nil, nil) ); +# if defined(THIS_CONTEXT) + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); +# endif + + thecode = __BlockInstPtr(self)->b_code; +# ifdef NEW_BLOCK_CALL + if (thecode != (OBJFUNC)nil) { + /* compiled machine code */ + RETURN ( (*thecode)(self) ); + } + /* interpreted code */ +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 0, nil, nil, nil, nil) ); +# else + RETURN ( __interpret(self, 0, nil, nil, nil, nil) ); +# endif # else - RETURN ( __interpret(self, 0, nil, nil, nil, nil) ); + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + /* compiled machine code */ + RETURN ( (*thecode)(home) ); + } + /* interpreted code */ +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 0, nil, home, nil, nil) ); +# else + RETURN ( __interpret(self, 0, nil, home, nil, nil) ); +# endif # endif -#else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - /* compiled machine code */ - RETURN ( (*thecode)(home) ); - } - /* interpreted code */ -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 0, nil, home, nil, nil) ); -# else - RETURN ( __interpret(self, 0, nil, home, nil, nil) ); -# endif -#endif } +#endif /* not SCHTEAM */ %}. ^ self wrongNumberOfArguments:0 ! value:arg - "evaluate the receiver with one argument. + "evaluate the receiver with one argument. The receiver must be a 1-arg block." %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context.TAILCALL1( self.asSTCallable(), arg ); + /* NOTREACHED */ +#else REGISTER OBJFUNC thecode; OBJ home; if (__INST(nargs) == __mkSmallInteger(1)) { -#if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); -#endif - thecode = __BlockInstPtr(self)->b_code; -#ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg) ); - } - /* interpreted code */ -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 1, nil, nil, nil, nil, &arg) ); +# if defined(THIS_CONTEXT) + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); +# endif + thecode = __BlockInstPtr(self)->b_code; +# ifdef NEW_BLOCK_CALL + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg) ); + } + /* interpreted code */ +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 1, nil, nil, nil, nil, &arg) ); +# else + RETURN ( __interpret(self, 1, nil, nil, nil, nil, arg) ); +# endif # else - RETURN ( __interpret(self, 1, nil, nil, nil, nil, arg) ); + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg) ); + } + /* interpreted code */ +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 1, nil, home, nil, nil, &arg) ); +# else + RETURN ( __interpret(self, 1, nil, home, nil, nil, arg) ); +# endif # endif -#else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg) ); - } - /* interpreted code */ -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 1, nil, home, nil, nil, &arg) ); -# else - RETURN ( __interpret(self, 1, nil, home, nil, nil, arg) ); -# endif -#endif } +#endif /* not SCHTEAM */ %}. ^ self wrongNumberOfArguments:1 ! @@ -990,7 +999,7 @@ Optionally pass up one or to two arguments (if the receiver is a one/two arg block)." nargs == 2 ifTrue:[ - ^ self value:arg1 value:arg2 + ^ self value:arg1 value:arg2 ]. ^ self value:arg1 @@ -998,10 +1007,10 @@ |block| block := [:arg | Transcript showCR:arg ]. - block value:2 optionalArgument:3. + block value:2 optionalArgument:3. block := [:arg1 :arg2 | Transcript show:arg1; space; showCR:arg2 ]. - block value:2 optionalArgument:3. + block value:2 optionalArgument:3. " ! @@ -1010,10 +1019,10 @@ Optionally pass up one, two or three arguments (if the receiver is a 1/2/3-arg block)." nargs == 3 ifTrue:[ - ^ self value:arg1 value:arg2 value:arg3 + ^ self value:arg1 value:arg2 value:arg3 ]. nargs == 2 ifTrue:[ - ^ self value:arg1 value:arg2 + ^ self value:arg1 value:arg2 ]. ^ self value:arg1 @@ -1021,49 +1030,54 @@ |block| block := [:arg | Transcript showCR:arg ]. - block value:2 optionalArgument:3. + block value:2 optionalArgument:3. block := [:arg1 :arg2 | Transcript show:arg1; space; showCR:arg2 ]. - block value:2 optionalArgument:3. + block value:2 optionalArgument:3. " ! value:arg1 value:arg2 - "evaluate the receiver with two arguments. + "evaluate the receiver with two arguments. The receiver must be a 2-arg block." %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context.TAILCALL2( self.asSTCallable(), arg1, arg2 ); + /* NOTREACHED */ +#else REGISTER OBJFUNC thecode; OBJ home; if (__INST(nargs) == __mkSmallInteger(2)) { -#if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); -#endif - thecode = __BlockInstPtr(self)->b_code; -#ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 2, nil, nil, nil, nil, &arg1) ); +# if defined(THIS_CONTEXT) + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); +# endif + thecode = __BlockInstPtr(self)->b_code; +# ifdef NEW_BLOCK_CALL + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 2, nil, nil, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 2, nil, nil, nil, nil, arg1, arg2) ); +# endif # else - RETURN ( __interpret(self, 2, nil, nil, nil, nil, arg1, arg2) ); + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 2, nil, home, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 2, nil, home, nil, nil, arg1, arg2) ); +# endif # endif -#else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 2, nil, home, nil, nil, &arg1) ); -# else - RETURN ( __interpret(self, 2, nil, home, nil, nil, arg1, arg2) ); -# endif -#endif } +#endif /* not SCHTEAM */ %}. ^ self wrongNumberOfArguments:2 ! @@ -1073,167 +1087,187 @@ Optionally pass two or threearguments (if the receiver is a 2/3-arg block)." nargs == 3 ifTrue:[ - ^ self value:arg1 value:arg2 value:arg3 + ^ self value:arg1 value:arg2 value:arg3 ]. ^ self value:arg1 value:arg2 ! value:arg1 value:arg2 value:arg3 - "evaluate the receiver with three arguments. + "evaluate the receiver with three arguments. The receiver must be a 3-arg block." %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context.TAILCALL3( self.asSTCallable(), arg1, arg2, arg3 ); + /* NOTREACHED */ +#else REGISTER OBJFUNC thecode; OBJ home; if (__INST(nargs) == __mkSmallInteger(3)) { -#if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); -#endif - thecode = __BlockInstPtr(self)->b_code; -#ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 3, nil, nil, nil, nil, &arg1) ); +# if defined(THIS_CONTEXT) + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); +# endif + thecode = __BlockInstPtr(self)->b_code; +# ifdef NEW_BLOCK_CALL + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 3, nil, nil, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 3, nil, nil, nil, nil, arg1, arg2, arg3) ); +# endif # else - RETURN ( __interpret(self, 3, nil, nil, nil, nil, arg1, arg2, arg3) ); + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 3, nil, home, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 3, nil, home, nil, nil, arg1, arg2, arg3) ); +# endif # endif -#else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 3, nil, home, nil, nil, &arg1) ); -# else - RETURN ( __interpret(self, 3, nil, home, nil, nil, arg1, arg2, arg3) ); -# endif -#endif } +#endif /* not SCHTEAM */ %}. ^ self wrongNumberOfArguments:3 ! value:arg1 value:arg2 value:arg3 value:arg4 - "evaluate the receiver with four arguments. + "evaluate the receiver with four arguments. The receiver must be a 4-arg block." %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context.TAILCALL4( self.asSTCallable(), arg1, arg2, arg3, arg4 ); + /* NOTREACHED */ +#else REGISTER OBJFUNC thecode; OBJ home; if (__INST(nargs) == __mkSmallInteger(4)) { -#if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); -#endif - thecode = __BlockInstPtr(self)->b_code; -#ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 4, nil, nil, nil, nil, &arg1) ); +# if defined(THIS_CONTEXT) + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); +# endif + thecode = __BlockInstPtr(self)->b_code; +# ifdef NEW_BLOCK_CALL + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 4, nil, nil, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 4, nil, nil, nil, nil, arg1, arg2, arg3, arg4) ); +# endif # else - RETURN ( __interpret(self, 4, nil, nil, nil, nil, arg1, arg2, arg3, arg4) ); + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 4, nil, home, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 4, nil, home, nil, nil, arg1, arg2, arg3, arg4) ); +# endif # endif -#else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 4, nil, home, nil, nil, &arg1) ); -# else - RETURN ( __interpret(self, 4, nil, home, nil, nil, arg1, arg2, arg3, arg4) ); -# endif + } #endif - } %}. ^ self wrongNumberOfArguments:4 ! value:arg1 value:arg2 value:arg3 value:arg4 value:arg5 - "evaluate the receiver with five arguments. + "evaluate the receiver with five arguments. The receiver must be a 5-arg block." %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context.TAILCALL5( self.asSTCallable(), arg1, arg2, arg3, arg4, arg5 ); + /* NOTREACHED */ +#else REGISTER OBJFUNC thecode; OBJ home; if (__INST(nargs) == __mkSmallInteger(5)) { -#if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); -#endif - thecode = __BlockInstPtr(self)->b_code; -#ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 5, nil, nil, nil, nil, &arg1) ); +# if defined(THIS_CONTEXT) + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); +# endif + thecode = __BlockInstPtr(self)->b_code; +# ifdef NEW_BLOCK_CALL + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 5, nil, nil, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 5, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5) ); +# endif # else - RETURN ( __interpret(self, 5, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5) ); + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 5, nil, home, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 5, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5) ); +# endif # endif -#else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 5, nil, home, nil, nil, &arg1) ); -# else - RETURN ( __interpret(self, 5, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5) ); -# endif -#endif } +#endif /* not SCHTEAM */ %}. ^ self wrongNumberOfArguments:5 ! value:arg1 value:arg2 value:arg3 value:arg4 value:arg5 value:arg6 - "evaluate the receiver with six arguments. + "evaluate the receiver with six arguments. The receiver must be a 6-arg block." %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context.TAILCALL6( self.asSTCallable(), arg1, arg2, arg3, arg4, arg5, arg6 ); + /* NOTREACHED */ +#else REGISTER OBJFUNC thecode; OBJ home; if (__INST(nargs) == __mkSmallInteger(6)) { -#if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); -#endif - thecode = __BlockInstPtr(self)->b_code; -#ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 6, nil, nil, nil, nil, &arg1) ); +# if defined(THIS_CONTEXT) + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); +# endif + thecode = __BlockInstPtr(self)->b_code; +# ifdef NEW_BLOCK_CALL + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 6, nil, nil, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 6, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6) ); +# endif # else - RETURN ( __interpret(self, 6, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6) ); + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 6, nil, home, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 6, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6) ); +# endif # endif -#else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 6, nil, home, nil, nil, &arg1) ); -# else - RETURN ( __interpret(self, 6, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6) ); -# endif -#endif } +#endif /* not SCHTEAM */ %}. ^ self wrongNumberOfArguments:6 ! @@ -1243,37 +1277,42 @@ The receiver must be a 7-arg block." %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context.TAILCALL7( self.asSTCallable(), arg1, arg2, arg3, arg4, arg5, arg6, arg7 ); + /* NOTREACHED */ +#else REGISTER OBJFUNC thecode; OBJ home; if (__INST(nargs) == __mkSmallInteger(7)) { -#if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); -#endif - thecode = __BlockInstPtr(self)->b_code; -#ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 7, nil, nil, nil, nil, &arg1) ); +# if defined(THIS_CONTEXT) + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); +# endif + thecode = __BlockInstPtr(self)->b_code; +# ifdef NEW_BLOCK_CALL + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 7, nil, nil, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 7, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7) ); +# endif # else - RETURN ( __interpret(self, 7, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7) ); + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7) ); + } +# ifdef PASS_ARG_POINTER + RETURN ( __interpret(self, 7, nil, home, nil, nil, &arg1) ); +# else + RETURN ( __interpret(self, 7, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7) ); +# endif # endif -#else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7) ); - } -# ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 7, nil, home, nil, nil, &arg1) ); -# else - RETURN ( __interpret(self, 7, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7) ); -# endif + } #endif - } %}. ^ self wrongNumberOfArguments:7 ! @@ -1289,28 +1328,28 @@ if (__INST(nargs) == __mkSmallInteger(8)) { #if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); #endif - thecode = __BlockInstPtr(self)->b_code; + thecode = __BlockInstPtr(self)->b_code; #ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) ); - } + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 8, nil, nil, nil, nil, &arg1) ); + RETURN ( __interpret(self, 8, nil, nil, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 8, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) ); + RETURN ( __interpret(self, 8, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) ); # endif #else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) ); - } + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 8, nil, home, nil, nil, &arg1) ); + RETURN ( __interpret(self, 8, nil, home, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 8, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) ); + RETURN ( __interpret(self, 8, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) ); # endif #endif } @@ -1329,28 +1368,28 @@ if (__INST(nargs) == __mkSmallInteger(9)) { #if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); #endif - thecode = __BlockInstPtr(self)->b_code; + thecode = __BlockInstPtr(self)->b_code; #ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) ); - } + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 9, nil, nil, nil, nil, &arg1) ); + RETURN ( __interpret(self, 9, nil, nil, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 9, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) ); + RETURN ( __interpret(self, 9, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) ); # endif #else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) ); - } + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 9, nil, home, nil, nil, &arg1) ); + RETURN ( __interpret(self, 9, nil, home, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 9, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) ); + RETURN ( __interpret(self, 9, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) ); # endif #endif } @@ -1369,28 +1408,28 @@ if (__INST(nargs) == __mkSmallInteger(10)) { #if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); #endif - thecode = __BlockInstPtr(self)->b_code; + thecode = __BlockInstPtr(self)->b_code; #ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) ); - } + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 10, nil, nil, nil, nil, &arg1) ); + RETURN ( __interpret(self, 10, nil, nil, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 10, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) ); + RETURN ( __interpret(self, 10, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) ); # endif #else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) ); - } + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 10, nil, home, nil, nil, &arg1) ); + RETURN ( __interpret(self, 10, nil, home, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 10, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) ); + RETURN ( __interpret(self, 10, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) ); # endif #endif } @@ -1409,28 +1448,28 @@ if (__INST(nargs) == __mkSmallInteger(11)) { #if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); #endif - thecode = __BlockInstPtr(self)->b_code; + thecode = __BlockInstPtr(self)->b_code; #ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) ); - } + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 11, nil, nil, nil, nil, &arg1) ); + RETURN ( __interpret(self, 11, nil, nil, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 11, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) ); + RETURN ( __interpret(self, 11, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) ); # endif #else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) ); - } + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 11, nil, home, nil, nil, &arg1) ); + RETURN ( __interpret(self, 11, nil, home, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 11, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) ); + RETURN ( __interpret(self, 11, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11) ); # endif #endif } @@ -1449,28 +1488,28 @@ if (__INST(nargs) == __mkSmallInteger(12)) { #if defined(THIS_CONTEXT) - if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); + if (__ISVALID_ILC_LNO(__pilc)) + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); #endif - thecode = __BlockInstPtr(self)->b_code; + thecode = __BlockInstPtr(self)->b_code; #ifdef NEW_BLOCK_CALL - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) ); - } + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 12, nil, nil, nil, nil, &arg1) ); + RETURN ( __interpret(self, 12, nil, nil, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 12, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) ); + RETURN ( __interpret(self, 12, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) ); # endif #else - home = __BlockInstPtr(self)->b_home; - if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) ); - } + home = __BlockInstPtr(self)->b_home; + if (thecode != (OBJFUNC)nil) { + RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) ); + } # ifdef PASS_ARG_POINTER - RETURN ( __interpret(self, 12, nil, home, nil, nil, &arg1) ); + RETURN ( __interpret(self, 12, nil, home, nil, nil, &arg1) ); # else - RETURN ( __interpret(self, 12, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) ); + RETURN ( __interpret(self, 12, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12) ); # endif #endif } @@ -1488,18 +1527,18 @@ activeProcess := Processor activeProcess. oldPrio := Processor activePriority. [ - activeProcess priority:priority. - retVal := self value. + activeProcess priority:priority. + retVal := self value. ] ensure:[ - activeProcess priority:oldPrio + activeProcess priority:oldPrio ]. ^ retVal " [ - 1000 timesRepeat:[ - 1000 factorial - ] + 1000 timesRepeat:[ + 1000 factorial + ] ] valueAt:3 " @@ -1514,13 +1553,13 @@ |a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15| (argArray notNil and:[(argArray class ~~ Array) and:[argArray isArray not]]) ifTrue:[ - argArray isCollection ifTrue:[ - ^ self valueWithArguments:argArray asArray - ]. - ^ self badArgumentArray:argArray + argArray isCollection ifTrue:[ + ^ self valueWithArguments:argArray asArray + ]. + ^ self badArgumentArray:argArray ]. (argArray size == nargs) ifFalse:[ - ^ self wrongNumberOfArguments:argArray size + ^ self wrongNumberOfArguments:argArray size ]. %{ @@ -1531,7 +1570,7 @@ #if defined(THIS_CONTEXT) if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); #endif thecode = __BlockInstPtr(self)->b_code; @@ -1540,96 +1579,96 @@ #ifndef NEW_BLOCK_CALL home = __BlockInstPtr(self)->b_home; if (thecode != (OBJFUNC)nil) { - /* the most common case (0 args) here (without a switch) */ - - if (nA == __mkSmallInteger(0)) { - RETURN ( (*thecode)(home) ); - } - - ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ - switch ((INT)(nA)) { - default: - goto error; - case (INT)__mkSmallInteger(15): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13], ap[14]) ); - case (INT)__mkSmallInteger(14): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13]) ); - case (INT)__mkSmallInteger(13): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12]) ); - case (INT)__mkSmallInteger(12): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11]) ); - case (INT)__mkSmallInteger(11): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10]) ); - case (INT)__mkSmallInteger(10): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9]) ); - case (INT)__mkSmallInteger(9): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) ); - case (INT)__mkSmallInteger(8): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) ); - case (INT)__mkSmallInteger(7): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) ); - case (INT)__mkSmallInteger(6): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) ); - case (INT)__mkSmallInteger(5): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4]) ); - case (INT)__mkSmallInteger(4): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3]) ); - case (INT)__mkSmallInteger(3): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2]) ); - case (INT)__mkSmallInteger(2): - RETURN ( (*thecode)(home, ap[0], ap[1]) ); - case (INT)__mkSmallInteger(1): - RETURN ( (*thecode)(home, ap[0]) ); - case (INT)__mkSmallInteger(0): - RETURN ( (*thecode)(home) ); - break; - } + /* the most common case (0 args) here (without a switch) */ + + if (nA == __mkSmallInteger(0)) { + RETURN ( (*thecode)(home) ); + } + + ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ + switch ((INT)(nA)) { + default: + goto error; + case (INT)__mkSmallInteger(15): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13], ap[14]) ); + case (INT)__mkSmallInteger(14): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13]) ); + case (INT)__mkSmallInteger(13): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12]) ); + case (INT)__mkSmallInteger(12): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11]) ); + case (INT)__mkSmallInteger(11): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10]) ); + case (INT)__mkSmallInteger(10): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9]) ); + case (INT)__mkSmallInteger(9): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) ); + case (INT)__mkSmallInteger(8): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) ); + case (INT)__mkSmallInteger(7): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) ); + case (INT)__mkSmallInteger(6): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) ); + case (INT)__mkSmallInteger(5): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4]) ); + case (INT)__mkSmallInteger(4): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3]) ); + case (INT)__mkSmallInteger(3): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2]) ); + case (INT)__mkSmallInteger(2): + RETURN ( (*thecode)(home, ap[0], ap[1]) ); + case (INT)__mkSmallInteger(1): + RETURN ( (*thecode)(home, ap[0]) ); + case (INT)__mkSmallInteger(0): + RETURN ( (*thecode)(home) ); + break; + } } #endif if (nA != __mkSmallInteger(0)) { - ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ - switch ((INT)nA) { - default: - goto error; - case (INT)__mkSmallInteger(15): - a15 = ap[14]; - case (INT)__mkSmallInteger(14): - a14 = ap[13]; - case (INT)__mkSmallInteger(13): - a13 = ap[12]; - case (INT)__mkSmallInteger(12): - a12 = ap[11]; - case (INT)__mkSmallInteger(11): - a11 = ap[10]; - case (INT)__mkSmallInteger(10): - a10 = ap[9]; - case (INT)__mkSmallInteger(9): - a9 = ap[8]; - case (INT)__mkSmallInteger(8): - a8 = ap[7]; - case (INT)__mkSmallInteger(7): - a7 = ap[6]; - case (INT)__mkSmallInteger(6): - a6 = ap[5]; - case (INT)__mkSmallInteger(5): - a5 = ap[4]; - case (INT)__mkSmallInteger(4): - a4 = ap[3]; - case (INT)__mkSmallInteger(3): - a3 = ap[2]; - case (INT)__mkSmallInteger(2): - a2 = ap[1]; - case (INT)__mkSmallInteger(1): - a1 = ap[0]; - case (INT)__mkSmallInteger(0): - break; - } + ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ + switch ((INT)nA) { + default: + goto error; + case (INT)__mkSmallInteger(15): + a15 = ap[14]; + case (INT)__mkSmallInteger(14): + a14 = ap[13]; + case (INT)__mkSmallInteger(13): + a13 = ap[12]; + case (INT)__mkSmallInteger(12): + a12 = ap[11]; + case (INT)__mkSmallInteger(11): + a11 = ap[10]; + case (INT)__mkSmallInteger(10): + a10 = ap[9]; + case (INT)__mkSmallInteger(9): + a9 = ap[8]; + case (INT)__mkSmallInteger(8): + a8 = ap[7]; + case (INT)__mkSmallInteger(7): + a7 = ap[6]; + case (INT)__mkSmallInteger(6): + a6 = ap[5]; + case (INT)__mkSmallInteger(5): + a5 = ap[4]; + case (INT)__mkSmallInteger(4): + a4 = ap[3]; + case (INT)__mkSmallInteger(3): + a3 = ap[2]; + case (INT)__mkSmallInteger(2): + a2 = ap[1]; + case (INT)__mkSmallInteger(1): + a1 = ap[0]; + case (INT)__mkSmallInteger(0): + break; + } } #ifdef NEW_BLOCK_CALL if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) ); + RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) ); } # ifdef PASS_ARG_POINTER RETURN ( __interpret(self, __intVal(nA), nil, nil, nil, nil, &a1) ); @@ -1653,8 +1692,8 @@ the above code only supports up-to 15 arguments " ^ ArgumentError - raiseRequestWith:self - errorString:'only blocks with up-to 15 arguments supported' + raiseRequestWith:self + errorString:'only blocks with up-to 15 arguments supported' ! valueWithOptionalArgument:arg @@ -1662,7 +1701,7 @@ Optionally pass an argument (if the receiver is a one arg block)." nargs == 1 ifTrue:[ - ^ self value:arg + ^ self value:arg ]. ^ self value @@ -1670,10 +1709,10 @@ |block| block := [ Transcript showCR:'hello' ]. - block valueWithOptionalArgument:2. + block valueWithOptionalArgument:2. block := [:arg | Transcript showCR:arg ]. - block valueWithOptionalArgument:2. + block valueWithOptionalArgument:2. " ! @@ -1682,10 +1721,10 @@ Optionally pass up to two arguments (if the receiver is a one/two arg block)." nargs == 2 ifTrue:[ - ^ self value:arg1 value:arg2 + ^ self value:arg1 value:arg2 ]. nargs == 1 ifTrue:[ - ^ self value:arg1 + ^ self value:arg1 ]. ^ self value @@ -1693,13 +1732,13 @@ |block| block := [ Transcript showCR:'hello' ]. - block valueWithOptionalArgument:2. + block valueWithOptionalArgument:2. block := [:arg | Transcript showCR:arg ]. - block valueWithOptionalArgument:2. + block valueWithOptionalArgument:2. block := [:arg1 :arg2 | Transcript showCR:arg1. Transcript showCR:arg2 ]. - block valueWithOptionalArgument:10 and:20. + block valueWithOptionalArgument:10 and:20. " ! @@ -1708,13 +1747,13 @@ Optionally pass up to three arguments (if the receiver is a one/two/three arg block)." nargs == 3 ifTrue:[ - ^ self value:arg1 value:arg2 value:arg3 + ^ self value:arg1 value:arg2 value:arg3 ]. nargs == 2 ifTrue:[ - ^ self value:arg1 value:arg2 + ^ self value:arg1 value:arg2 ]. nargs == 1 ifTrue:[ - ^ self value:arg1 + ^ self value:arg1 ]. ^ self value @@ -1722,13 +1761,13 @@ |block| block := [ Transcript showCR:'hello' ]. - block valueWithOptionalArgument:2. + block valueWithOptionalArgument:2. block := [:arg | Transcript showCR:arg ]. - block valueWithOptionalArgument:2. + block valueWithOptionalArgument:2. block := [:arg1 :arg2 | Transcript showCR:arg1. Transcript showCR:arg2 ]. - block valueWithOptionalArgument:10 and:20. + block valueWithOptionalArgument:10 and:20. " ! @@ -1737,16 +1776,16 @@ Optionally pass up to four arguments (if the receiver is a one/two/three/four arg block)." nargs == 4 ifTrue:[ - ^ self value:arg1 value:arg2 value:arg3 value:arg4 + ^ self value:arg1 value:arg2 value:arg3 value:arg4 ]. nargs == 3 ifTrue:[ - ^ self value:arg1 value:arg2 value:arg3 + ^ self value:arg1 value:arg2 value:arg3 ]. nargs == 2 ifTrue:[ - ^ self value:arg1 value:arg2 + ^ self value:arg1 value:arg2 ]. nargs == 1 ifTrue:[ - ^ self value:arg1 + ^ self value:arg1 ]. ^ self value @@ -1754,13 +1793,13 @@ |block| block := [ Transcript showCR:'hello' ]. - block valueWithOptionalArgument:2. + block valueWithOptionalArgument:2. block := [:arg | Transcript showCR:arg ]. - block valueWithOptionalArgument:2. + block valueWithOptionalArgument:2. block := [:arg1 :arg2 | Transcript showCR:arg1. Transcript showCR:arg2 ]. - block valueWithOptionalArgument:10 and:20. + block valueWithOptionalArgument:10 and:20. " ! @@ -1773,13 +1812,13 @@ |numArgsProvided a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15| (argArray notNil and:[(argArray class ~~ Array) and:[argArray isArray not]]) ifTrue:[ - argArray isCollection ifTrue:[ - ^ self valueWithArguments:argArray asArray - ]. - ^ self badArgumentArray:argArray + argArray isCollection ifTrue:[ + ^ self valueWithArguments:argArray asArray + ]. + ^ self badArgumentArray:argArray ]. (argArray size >= nargs) ifFalse:[ - ^ self wrongNumberOfArguments:argArray size + ^ self wrongNumberOfArguments:argArray size ]. %{ REGISTER OBJFUNC thecode; @@ -1790,109 +1829,109 @@ #if defined(THIS_CONTEXT) if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); #endif thecode = __BlockInstPtr(self)->b_code; nA = __INST(nargs); if (argArray == nil) { - ap = 0; + ap = 0; } else { - ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ + ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ } #ifndef NEW_BLOCK_CALL home = __BlockInstPtr(self)->b_home; if (thecode != (OBJFUNC)nil) { - /* the most common case (0 args) here (without a switch) */ - - if (nA == __mkSmallInteger(0)) { - RETURN ( (*thecode)(home) ); - } - - switch ((INT)(nA)) { - default: - goto error; - case (INT)__mkSmallInteger(15): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13], ap[14]) ); - case (INT)__mkSmallInteger(14): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13]) ); - case (INT)__mkSmallInteger(13): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12]) ); - case (INT)__mkSmallInteger(12): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11]) ); - case (INT)__mkSmallInteger(11): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10]) ); - case (INT)__mkSmallInteger(10): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9]) ); - case (INT)__mkSmallInteger(9): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) ); - case (INT)__mkSmallInteger(8): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) ); - case (INT)__mkSmallInteger(7): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) ); - case (INT)__mkSmallInteger(6): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) ); - case (INT)__mkSmallInteger(5): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4]) ); - case (INT)__mkSmallInteger(4): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3]) ); - case (INT)__mkSmallInteger(3): - RETURN ( (*thecode)(home, ap[0], ap[1], ap[2]) ); - case (INT)__mkSmallInteger(2): - RETURN ( (*thecode)(home, ap[0], ap[1]) ); - case (INT)__mkSmallInteger(1): - RETURN ( (*thecode)(home, ap[0]) ); - case (INT)__mkSmallInteger(0): - RETURN ( (*thecode)(home) ); - break; - } + /* the most common case (0 args) here (without a switch) */ + + if (nA == __mkSmallInteger(0)) { + RETURN ( (*thecode)(home) ); + } + + switch ((INT)(nA)) { + default: + goto error; + case (INT)__mkSmallInteger(15): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13], ap[14]) ); + case (INT)__mkSmallInteger(14): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12], ap[13]) ); + case (INT)__mkSmallInteger(13): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11], ap[12]) ); + case (INT)__mkSmallInteger(12): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11]) ); + case (INT)__mkSmallInteger(11): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10]) ); + case (INT)__mkSmallInteger(10): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9]) ); + case (INT)__mkSmallInteger(9): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) ); + case (INT)__mkSmallInteger(8): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) ); + case (INT)__mkSmallInteger(7): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) ); + case (INT)__mkSmallInteger(6): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) ); + case (INT)__mkSmallInteger(5): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4]) ); + case (INT)__mkSmallInteger(4): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3]) ); + case (INT)__mkSmallInteger(3): + RETURN ( (*thecode)(home, ap[0], ap[1], ap[2]) ); + case (INT)__mkSmallInteger(2): + RETURN ( (*thecode)(home, ap[0], ap[1]) ); + case (INT)__mkSmallInteger(1): + RETURN ( (*thecode)(home, ap[0]) ); + case (INT)__mkSmallInteger(0): + RETURN ( (*thecode)(home) ); + break; + } } #endif if (nA != __mkSmallInteger(0)) { - ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ - switch ((INT)nA) { - default: - goto error; - case (INT)__mkSmallInteger(15): - a15 = ap[14]; - case (INT)__mkSmallInteger(14): - a14 = ap[13]; - case (INT)__mkSmallInteger(13): - a13 = ap[12]; - case (INT)__mkSmallInteger(12): - a12 = ap[11]; - case (INT)__mkSmallInteger(11): - a11 = ap[10]; - case (INT)__mkSmallInteger(10): - a10 = ap[9]; - case (INT)__mkSmallInteger(9): - a9 = ap[8]; - case (INT)__mkSmallInteger(8): - a8 = ap[7]; - case (INT)__mkSmallInteger(7): - a7 = ap[6]; - case (INT)__mkSmallInteger(6): - a6 = ap[5]; - case (INT)__mkSmallInteger(5): - a5 = ap[4]; - case (INT)__mkSmallInteger(4): - a4 = ap[3]; - case (INT)__mkSmallInteger(3): - a3 = ap[2]; - case (INT)__mkSmallInteger(2): - a2 = ap[1]; - case (INT)__mkSmallInteger(1): - a1 = ap[0]; - case (INT)__mkSmallInteger(0): - break; - } + ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ + switch ((INT)nA) { + default: + goto error; + case (INT)__mkSmallInteger(15): + a15 = ap[14]; + case (INT)__mkSmallInteger(14): + a14 = ap[13]; + case (INT)__mkSmallInteger(13): + a13 = ap[12]; + case (INT)__mkSmallInteger(12): + a12 = ap[11]; + case (INT)__mkSmallInteger(11): + a11 = ap[10]; + case (INT)__mkSmallInteger(10): + a10 = ap[9]; + case (INT)__mkSmallInteger(9): + a9 = ap[8]; + case (INT)__mkSmallInteger(8): + a8 = ap[7]; + case (INT)__mkSmallInteger(7): + a7 = ap[6]; + case (INT)__mkSmallInteger(6): + a6 = ap[5]; + case (INT)__mkSmallInteger(5): + a5 = ap[4]; + case (INT)__mkSmallInteger(4): + a4 = ap[3]; + case (INT)__mkSmallInteger(3): + a3 = ap[2]; + case (INT)__mkSmallInteger(2): + a2 = ap[1]; + case (INT)__mkSmallInteger(1): + a1 = ap[0]; + case (INT)__mkSmallInteger(0): + break; + } } #ifdef NEW_BLOCK_CALL if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) ); + RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) ); } # ifdef PASS_ARG_POINTER RETURN ( __interpret(self, __intVal(nA), nil, nil, nil, nil, &a1) ); @@ -1916,13 +1955,13 @@ the above code only supports up-to 15 arguments " ^ ArgumentError - raiseRequestWith:self - errorString:'only blocks with up-to 15 arguments supported' + raiseRequestWith:self + errorString:'only blocks with up-to 15 arguments supported' ! valueWithPossibleArguments:argArray "evaluate the receiver with arguments as required taken from argArray. - If argArray provides less than the required number of arguments, + If argArray provides less than the required number of arguments, nil is assumed for any remaining argument. (i.e. argArray may be smaller than the required number). Only the required number of arguments is taken from argArray or nil; @@ -1931,10 +1970,10 @@ |numArgsProvided a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15| (argArray notNil and:[(argArray class ~~ Array) and:[argArray isArray not]]) ifTrue:[ - argArray isCollection ifTrue:[ - ^ self valueWithArguments:argArray asArray - ]. - ^ self badArgumentArray:argArray + argArray isCollection ifTrue:[ + ^ self valueWithArguments:argArray asArray + ]. + ^ self badArgumentArray:argArray ]. numArgsProvided := argArray size. %{ @@ -1946,89 +1985,89 @@ #if defined(THIS_CONTEXT) if (__ISVALID_ILC_LNO(__pilc)) - __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); + __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc); #endif thecode = __BlockInstPtr(self)->b_code; nA = __INST(nargs); if (argArray == nil) { - ap = 0; + ap = 0; } else { - ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ + ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */ } switch (__numArgsProvided) { - default: - case 15: a15 = ap[14]; - case 14: a14 = ap[13]; - case 13: a13 = ap[12]; - case 12: a12 = ap[11]; - case 11: a11 = ap[10]; - case 10: a10 = ap[9]; - case 9: a9 = ap[8]; - case 8: a8 = ap[7]; - case 7: a7 = ap[6]; - case 6: a6 = ap[5]; - case 5: a5 = ap[4]; - case 4: a4 = ap[3]; - case 3: a3 = ap[2]; - case 2: a2 = ap[1]; - case 1: a1 = ap[0]; - case 0: ; + default: + case 15: a15 = ap[14]; + case 14: a14 = ap[13]; + case 13: a13 = ap[12]; + case 12: a12 = ap[11]; + case 11: a11 = ap[10]; + case 10: a10 = ap[9]; + case 9: a9 = ap[8]; + case 8: a8 = ap[7]; + case 7: a7 = ap[6]; + case 6: a6 = ap[5]; + case 5: a5 = ap[4]; + case 4: a4 = ap[3]; + case 3: a3 = ap[2]; + case 2: a2 = ap[1]; + case 1: a1 = ap[0]; + case 0: ; } #ifndef NEW_BLOCK_CALL home = __BlockInstPtr(self)->b_home; if (thecode != (OBJFUNC)nil) { - /* the most common case (0 args) here (without a switch) */ - - if (nA == __mkSmallInteger(0)) { - RETURN ( (*thecode)(home) ); - } - - switch ((INT)(nA)) { - default: - goto error; - case (INT)__mkSmallInteger(15): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) ); - case (INT)__mkSmallInteger(14): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) ); - case (INT)__mkSmallInteger(13): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) ); - case (INT)__mkSmallInteger(12): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) ); - case (INT)__mkSmallInteger(11): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) ); - case (INT)__mkSmallInteger(10): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) ); - case (INT)__mkSmallInteger(9): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9) ); - case (INT)__mkSmallInteger(8): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8) ); - case (INT)__mkSmallInteger(7): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7) ); - case (INT)__mkSmallInteger(6): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6) ); - case (INT)__mkSmallInteger(5): - RETURN ( (*thecode)(home, a1, a2, a3, a4, a5) ); - case (INT)__mkSmallInteger(4): - RETURN ( (*thecode)(home, a1, a2, a3, a4) ); - case (INT)__mkSmallInteger(3): - RETURN ( (*thecode)(home, a1, a2, a3) ); - case (INT)__mkSmallInteger(2): - RETURN ( (*thecode)(home, a1, a2) ); - case (INT)__mkSmallInteger(1): - RETURN ( (*thecode)(home, a1) ); - case (INT)__mkSmallInteger(0): - RETURN ( (*thecode)(home) ); - break; - } + /* the most common case (0 args) here (without a switch) */ + + if (nA == __mkSmallInteger(0)) { + RETURN ( (*thecode)(home) ); + } + + switch ((INT)(nA)) { + default: + goto error; + case (INT)__mkSmallInteger(15): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) ); + case (INT)__mkSmallInteger(14): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) ); + case (INT)__mkSmallInteger(13): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) ); + case (INT)__mkSmallInteger(12): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) ); + case (INT)__mkSmallInteger(11): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) ); + case (INT)__mkSmallInteger(10): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) ); + case (INT)__mkSmallInteger(9): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8, a9) ); + case (INT)__mkSmallInteger(8): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7, a8) ); + case (INT)__mkSmallInteger(7): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6, a7) ); + case (INT)__mkSmallInteger(6): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5, a6) ); + case (INT)__mkSmallInteger(5): + RETURN ( (*thecode)(home, a1, a2, a3, a4, a5) ); + case (INT)__mkSmallInteger(4): + RETURN ( (*thecode)(home, a1, a2, a3, a4) ); + case (INT)__mkSmallInteger(3): + RETURN ( (*thecode)(home, a1, a2, a3) ); + case (INT)__mkSmallInteger(2): + RETURN ( (*thecode)(home, a1, a2) ); + case (INT)__mkSmallInteger(1): + RETURN ( (*thecode)(home, a1) ); + case (INT)__mkSmallInteger(0): + RETURN ( (*thecode)(home) ); + break; + } } #endif #ifdef NEW_BLOCK_CALL if (thecode != (OBJFUNC)nil) { - RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) ); + RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) ); } # ifdef PASS_ARG_POINTER RETURN ( __interpret(self, __intVal(nA), nil, nil, nil, nil, &a1) ); @@ -2052,15 +2091,15 @@ the above code only supports up-to 15 arguments " ^ ArgumentError - raiseRequestWith:self - errorString:'only blocks with up-to 15 arguments supported' + raiseRequestWith:self + errorString:'only blocks with up-to 15 arguments supported' ! ! !Block methodsFor:'exception handling'! on:aSignalOrSignalSetOrException do:exceptionBlock "added for ANSI compatibility; evaluate the receiver, - handling aSignalOrSignalSetOrException. + handling aSignalOrSignalSetOrException. The 2nd argument, exceptionBlock is evaluated if the signal is raised during evaluation." @@ -2072,15 +2111,15 @@ " [ - 1 foo + 1 foo ] on:MessageNotUnderstood do:[:ex | self halt] [ - 1 foo + 1 foo ] on:(MessageNotUnderstood , AbortOperationRequest) do:[:ex | self halt] [ - 1 foo + 1 foo ] on:SignalSet anySignal do:[:ex| 2 bar. self halt] " @@ -2089,7 +2128,7 @@ on:aSignalOrSignalSetOrException do:exceptionBlock ensure:ensureBlock "added for ANSI compatibility; evaluate the receiver, - handling aSignalOrSignalSetOrException. + handling aSignalOrSignalSetOrException. The 2nd argument, exceptionBlock is evaluated if the signal is raised during evaluation. The 3rd argument, ensureBlock is evaluated in any case - even if the activity @@ -2111,8 +2150,8 @@ e := 0. [ - 1 foo - ] on:MessageNotUnderstood + 1 foo + ] on:MessageNotUnderstood do:[:ex | self halt] ensure:[ e := 1 ]. self assert:(e == 1). @@ -2123,8 +2162,8 @@ e := 0. [ - 1 negated - ] on:MessageNotUnderstood + 1 negated + ] on:MessageNotUnderstood do:[:ex | self halt] ensure:[ e := 1 ]. self assert:(e == 1). @@ -2133,7 +2172,7 @@ on:anExceptionHandler do:exceptionBlock on:anExceptionHandler2 do:anExceptionBlock2 "added for ANSI compatibility; evaluate the receiver, - handling aSignalOrSignalSetOrException. + handling aSignalOrSignalSetOrException. The 2nd argument, exceptionBlock is evaluated if the signal is raised during evaluation." @@ -2145,13 +2184,13 @@ " [ - 1 foo - ] on:MessageNotUnderstood do:[:ex | self halt:'Got MessageNotUnderstood'] + 1 foo + ] on:MessageNotUnderstood do:[:ex | self halt:'Got MessageNotUnderstood'] on:Error do:[:ex| self halt:'Got Error'] [ - 1 // 0 - ] on:MessageNotUnderstood do:[:ex | self halt:'Got MessageNotUnderstood'] + 1 // 0 + ] on:MessageNotUnderstood do:[:ex | self halt:'Got MessageNotUnderstood'] on:Error do:[:ex| self halt:'Got Error'] " @@ -2180,22 +2219,22 @@ " [ - 1 to:15 do:[:round | - Transcript showCR:round. - Delay waitForMilliseconds:20. - ]. - true - ] valueWithTimeout:(TimeDuration seconds:1) + 1 to:15 do:[:round | + Transcript showCR:round. + Delay waitForMilliseconds:20. + ]. + true + ] valueWithTimeout:(TimeDuration seconds:1) " " [ - 1 to:100 do:[:round | - Transcript showCR:round. - Delay waitForMilliseconds:20. - ]. - true - ] valueWithTimeout:(TimeDuration seconds:1) + 1 to:100 do:[:round | + Transcript showCR:round. + Delay waitForMilliseconds:20. + ]. + true + ] valueWithTimeout:(TimeDuration seconds:1) " ! @@ -2210,47 +2249,47 @@ done := false. me := Processor activeProcess. - showStopper := - [ - done ifFalse:[ - me interruptWith:[ - (Processor activeProcess state ~~ #debug) ifTrue:[ - done ifFalse:[ TimeoutNotification raiseRequest ] - ] - ] - ] - ]. + showStopper := + [ + done ifFalse:[ + me interruptWith:[ + (Processor activeProcess state ~~ #debug) ifTrue:[ + done ifFalse:[ TimeoutNotification raiseRequest ] + ] + ] + ] + ]. TimeoutNotification handle:[:ex | - inError ifTrue:[ - ex proceed - ]. - retVal := exceptionBlock value. + inError ifTrue:[ + ex proceed + ]. + retVal := exceptionBlock value. ] do:[ - NoHandlerError handle:[:ex | - inError := true. - ex reject. - ] do:[ - [ - Processor - addTimedBlock:showStopper - for:me - afterMilliseconds:aTimeLimit. - - retVal := self value. - done := true. - ] ensure:[ - Processor removeTimedBlock:showStopper - ]. - ] + NoHandlerError handle:[:ex | + inError := true. + ex reject. + ] do:[ + [ + Processor + addTimedBlock:showStopper + for:me + afterMilliseconds:aTimeLimit. + + retVal := self value. + done := true. + ] ensure:[ + Processor removeTimedBlock:showStopper + ]. + ] ]. ^ retVal " [ - Delay waitForSeconds:5. - true - ] valueWithWatchDog:[false] afterMilliseconds:2000 + Delay waitForSeconds:5. + true + ] valueWithWatchDog:[false] afterMilliseconds:2000 " "Modified: / 21-05-2010 / 12:19:57 / sr" @@ -2263,53 +2302,53 @@ "answer the exceptionHandler (the Error or signal) for anException from aContext." aContext selector == #on:do:on:do: ifTrue:[ - |exceptionCreator exceptionHandlerInContext| - - exceptionCreator := anException creator. - exceptionHandlerInContext := aContext argAt:1. - exceptionHandlerInContext isExceptionHandler ifFalse:[ - exceptionHandlerInContext isNil ifTrue:[ - 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. - ] ifFalse:[ - (exceptionHandlerInContext isBehavior - and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ - "If the exception class is still autoloaded, - it does not accept our exception. Raising the exception would load the class" - ^ nil - ] ifFalse:[ - 'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR. - ] - ]. - aContext fullPrintString errorPrintCR. - self breakPoint:#cg. - ^ nil. - ]. - (exceptionHandlerInContext accepts:exceptionCreator) ifTrue:[ - ^ exceptionHandlerInContext. - ]. - - exceptionHandlerInContext := aContext argAt:3. - exceptionHandlerInContext isExceptionHandler ifFalse:[ - exceptionHandlerInContext isNil ifTrue:[ - 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. - ] ifFalse:[ - (exceptionHandlerInContext isBehavior - and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ - "If the exception class is still autoloaded, - it does not accept our exception. Raising the exception would load the class" - ^ nil - ] ifFalse:[ - 'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR. - ] - ]. - aContext fullPrintString errorPrintCR. - self breakPoint:#cg. - ^ nil. - ]. - (exceptionHandlerInContext accepts:exceptionCreator) ifTrue:[ - ^ exceptionHandlerInContext. - ]. - ^ nil. + |exceptionCreator exceptionHandlerInContext| + + exceptionCreator := anException creator. + exceptionHandlerInContext := aContext argAt:1. + exceptionHandlerInContext isExceptionHandler ifFalse:[ + exceptionHandlerInContext isNil ifTrue:[ + 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. + ] ifFalse:[ + (exceptionHandlerInContext isBehavior + and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ + "If the exception class is still autoloaded, + it does not accept our exception. Raising the exception would load the class" + ^ nil + ] ifFalse:[ + 'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR. + ] + ]. + aContext fullPrintString errorPrintCR. + self breakPoint:#cg. + ^ nil. + ]. + (exceptionHandlerInContext accepts:exceptionCreator) ifTrue:[ + ^ exceptionHandlerInContext. + ]. + + exceptionHandlerInContext := aContext argAt:3. + exceptionHandlerInContext isExceptionHandler ifFalse:[ + exceptionHandlerInContext isNil ifTrue:[ + 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. + ] ifFalse:[ + (exceptionHandlerInContext isBehavior + and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ + "If the exception class is still autoloaded, + it does not accept our exception. Raising the exception would load the class" + ^ nil + ] ifFalse:[ + 'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR. + ] + ]. + aContext fullPrintString errorPrintCR. + self breakPoint:#cg. + ^ nil. + ]. + (exceptionHandlerInContext accepts:exceptionCreator) ifTrue:[ + ^ exceptionHandlerInContext. + ]. + ^ nil. ]. "aContext selector must be #on:do: , #on:do:ensure: or #valueWithExceptionHandler:" @@ -2327,73 +2366,73 @@ (selector == #on:do: or:[ selector == #on:do:ensure: ]) ifTrue:[ - exceptionHandlerInContext := theContext argAt:1. - exceptionHandlerInContext isExceptionHandler ifFalse:[ - exceptionHandlerInContext isNil ifTrue:[ - 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. - ] ifFalse:[(exceptionHandlerInContext isBehavior - and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ - "If the exception class is still autoloaded, - it does not accept our exception. Raising the exception would load the class" - ^ nil - ] ifFalse:[ - 'Block [warning]: non-ExceptionHandler in on:do:-context' errorPrintCR. - ]]. - theContext fullPrint. - ^ nil. - ]. - (exceptionHandlerInContext == exceptionHandler - or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[ - ^ (theContext argAt:2) ? [nil]. - ]. - ^ nil + exceptionHandlerInContext := theContext argAt:1. + exceptionHandlerInContext isExceptionHandler ifFalse:[ + exceptionHandlerInContext isNil ifTrue:[ + 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. + ] ifFalse:[(exceptionHandlerInContext isBehavior + and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ + "If the exception class is still autoloaded, + it does not accept our exception. Raising the exception would load the class" + ^ nil + ] ifFalse:[ + 'Block [warning]: non-ExceptionHandler in on:do:-context' errorPrintCR. + ]]. + theContext fullPrint. + ^ nil. + ]. + (exceptionHandlerInContext == exceptionHandler + or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[ + ^ (theContext argAt:2) ? [nil]. + ]. + ^ nil ]. selector == #on:do:on:do: ifTrue:[ - exceptionHandlerInContext := theContext argAt:1. - exceptionHandlerInContext isExceptionHandler ifFalse:[ - exceptionHandlerInContext isNil ifTrue:[ - 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. - ] ifFalse:[(exceptionHandlerInContext isBehavior - and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ - "If the exception class is still autoloaded, - it does not accept our exception. Raising the exception would load the class" - ^ nil - ] ifFalse:[ - 'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR. - ]]. - theContext fullPrint. - ^ nil. - ]. - (exceptionHandlerInContext == exceptionHandler - or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[ - ^ (theContext argAt:2) ? [nil]. - ]. - - exceptionHandlerInContext := theContext argAt:3. - exceptionHandlerInContext isExceptionHandler ifFalse:[ - exceptionHandlerInContext isNil ifTrue:[ - 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. - ] ifFalse:[(exceptionHandlerInContext isBehavior - and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ - "If the exception class is still autoloaded, - it does not accept our exception. Raising the exception would load the class" - ^ nil - ] ifFalse:[ - 'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR. - ]]. - theContext fullPrint. - ^ nil. - ]. - (exceptionHandlerInContext == exceptionHandler - or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[ - ^ (theContext argAt:4) ? [nil]. - ]. - ^ nil + exceptionHandlerInContext := theContext argAt:1. + exceptionHandlerInContext isExceptionHandler ifFalse:[ + exceptionHandlerInContext isNil ifTrue:[ + 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. + ] ifFalse:[(exceptionHandlerInContext isBehavior + and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ + "If the exception class is still autoloaded, + it does not accept our exception. Raising the exception would load the class" + ^ nil + ] ifFalse:[ + 'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR. + ]]. + theContext fullPrint. + ^ nil. + ]. + (exceptionHandlerInContext == exceptionHandler + or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[ + ^ (theContext argAt:2) ? [nil]. + ]. + + exceptionHandlerInContext := theContext argAt:3. + exceptionHandlerInContext isExceptionHandler ifFalse:[ + exceptionHandlerInContext isNil ifTrue:[ + 'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR. + ] ifFalse:[(exceptionHandlerInContext isBehavior + and:[exceptionHandlerInContext isLoaded not]) ifTrue:[ + "If the exception class is still autoloaded, + it does not accept our exception. Raising the exception would load the class" + ^ nil + ] ifFalse:[ + 'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR. + ]]. + theContext fullPrint. + ^ nil. + ]. + (exceptionHandlerInContext == exceptionHandler + or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[ + ^ (theContext argAt:4) ? [nil]. + ]. + ^ nil ]. selector == #valueWithExceptionHandler: ifTrue:[ - ^ (theContext argAt:1) handlerForSignal:exceptionHandler. + ^ (theContext argAt:1) handlerForSignal:exceptionHandler. ]. "/ mhmh - should not arrive here @@ -2456,7 +2495,7 @@ ! loop - "repeat the receiver forever + "repeat the receiver forever (the receiver block should contain a return somewhere). The implementation below was inspired by a corresponding Self method." @@ -2468,9 +2507,9 @@ n := 1. [ - n printCR. - n >= 10 ifTrue:[^ nil]. - n := n + 1 + n printCR. + n >= 10 ifTrue:[^ nil]. + n := n + 1 ] loop " @@ -2478,8 +2517,8 @@ ! loopWithExit - "the receiver must be a block of one argument. It is evaluated in a loop forever, - and is passed a block, which, if sent a value:-message, will exit the receiver block, + "the receiver must be a block of one argument. It is evaluated in a loop forever, + and is passed a block, which, if sent a value:-message, will exit the receiver block, returning the parameter of the value:-message. Used for loops with exit in the middle. Inspired by a corresponding Self method." @@ -2492,9 +2531,9 @@ |i| i := 1. [:exit | - Transcript showCR:i. - i == 5 ifTrue:[exit value:'thats it']. - i := i + 1 + Transcript showCR:i. + i == 5 ifTrue:[exit value:'thats it']. + i := i + 1 ] loopWithExit " ! @@ -2510,13 +2549,13 @@ ! repeat:n - "repeat the receiver n times - similar to timesRepeat, but optionally passes the + "repeat the receiver n times - similar to timesRepeat, but optionally passes the loop counter as argument" self numArgs == 0 ifTrue:[ - n timesRepeat:self + n timesRepeat:self ] ifFalse:[ - 1 to:n do:self + 1 to:n do:self ]. " @@ -2527,7 +2566,7 @@ valueWithExit "the receiver must be a block of one argument. It is evaluated, and is passed a block, - which, if sent a value:-message, will exit the receiver block, returning the parameter of the + which, if sent a value:-message, will exit the receiver block, returning the parameter of the value:-message. Used for premature returns to the caller. Taken from a manchester goody (a similar construct also appears in Self)." @@ -2558,9 +2597,9 @@ " [:restart | - (self confirm:'try again ?') ifTrue:[ - restart value. - ] + (self confirm:'try again ?') ifTrue:[ + restart value. + ] ] valueWithRestart " @@ -2579,18 +2618,18 @@ " [:restart :exit | - |i| - - i := 0. - [ - i := i + 1. - (self confirm:('i is ',i printString,'; start over ?')) ifTrue:[ - restart value. - ]. - (self confirm:'enough ?') ifTrue:[ - exit value:nil. - ]. - ] loop + |i| + + i := 0. + [ + i := i + 1. + (self confirm:('i is ',i printString,'; start over ?')) ifTrue:[ + restart value. + ]. + (self confirm:'enough ?') ifTrue:[ + exit value:nil. + ]. + ] loop ] valueWithRestartAndExit " ! @@ -2613,7 +2652,7 @@ whileFalse:aBlock "evaluate the argument, aBlock while the receiver evaluates to false. - - usually open coded by compilers, but needed here for #perform + - usually open coded by compilers, but needed here for #perform and expression evaluation." "this implementation is for purists ... :-)" @@ -2627,8 +2666,8 @@ n := 1. [n > 10] whileFalse:[ - n printCR. - n := n + 1 + n printCR. + n := n + 1 ] " ! @@ -2651,7 +2690,7 @@ whileTrue:aBlock "evaluate the argument, aBlock while the receiver evaluates to true. - - usually open coded by compilers, but needed here for #perform + - usually open coded by compilers, but needed here for #perform and expression evaluation." "this implementation is for purists ... :-)" @@ -2665,8 +2704,8 @@ n := 1. [n <= 10] whileTrue:[ - n printCR. - n := n + 1 + n printCR. + n := n + 1 ] " ! ! @@ -2674,52 +2713,52 @@ !Block methodsFor:'parallel evaluation'! futureValue - "Fork a synchronised evaluation of myself. + "Fork a synchronised evaluation of myself. Starts the evaluation in parallel now, but synchronizes any access to wait until the result is computed." ^ Future new block:self ! -futureValue:aValue - "Fork a synchronised evaluation of myself. +futureValue:aValue + "Fork a synchronised evaluation of myself. Starts the evaluation in parallel now, but synchronizes any access to wait until the result is computed." - + ^ Future new block:self value:aValue ! -futureValue:aValue value:anotherValue - "Fork a synchronised evaluation of myself. +futureValue:aValue value:anotherValue + "Fork a synchronised evaluation of myself. Starts the evaluation in parallel now, but synchronizes any access to wait until the result is computed." - - ^ Future new - block:self - value:aValue - value:anotherValue + + ^ Future new + block:self + value:aValue + value:anotherValue ! -futureValue:aValue value:anotherValue value:bValue - "Fork a synchronised evaluation of myself. +futureValue:aValue value:anotherValue value:bValue + "Fork a synchronised evaluation of myself. Starts the evaluation in parallel now, but synchronizes any access to wait until the result is computed." - - ^ Future new - block:self - value:aValue - value:anotherValue - value:bValue + + ^ Future new + block:self + value:aValue + value:anotherValue + value:bValue ! -futureValueWithArguments:anArray - "Fork a synchronised evaluation of myself. +futureValueWithArguments:anArray + "Fork a synchronised evaluation of myself. Starts the evaluation in parallel now, but synchronizes any access to wait until the result is computed." - - ^ Future new - block:self - valueWithArguments:anArray + + ^ Future new + block:self + valueWithArguments:anArray "Modified (format): / 04-10-2011 / 14:55:40 / cg" ! @@ -2727,49 +2766,49 @@ lazyValue "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." - + ^ Lazy new block:self ! -lazyValue:aValue +lazyValue:aValue "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." - + ^ Lazy new block:self value:aValue ! -lazyValue:aValue value:anotherValue +lazyValue:aValue value:anotherValue "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." - - ^ Lazy new - block:self - value:aValue - value:anotherValue + + ^ Lazy new + block:self + value:aValue + value:anotherValue ! -lazyValue:aValue value:anotherValue value:bValue +lazyValue:aValue value:anotherValue value:bValue "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." - - ^ Lazy new - block:self - value:aValue - value:anotherValue - value:bValue + + ^ Lazy new + block:self + value:aValue + value:anotherValue + value:bValue ! -lazyValueWithArguments:anArray +lazyValueWithArguments:anArray "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." - + ^ Lazy new block:self valueWithArguments:anArray ! ! !Block methodsFor:'printing & storing'! printBlockBracketsOn:aStream - aStream nextPutAll:'[]'. + aStream nextPutAll:'[]'. ! printOn:aStream @@ -2780,18 +2819,18 @@ "cheap blocks have no home context, but a method instead" (home isNil or:[home isContext not]) ifTrue:[ - aStream nextPutAll:'[] in '. - - " - currently, some cheap blocks don't know where they have been created - " - aStream nextPutAll:' ??? (optimized)'. - ^ self + aStream nextPutAll:'[] in '. + + " + currently, some cheap blocks don't know where they have been created + " + aStream nextPutAll:' ??? (optimized)'. + ^ self ]. "a full blown block (with home, but without method)" self printBlockBracketsOn:aStream. - aStream nextPutAll:' in '. + aStream nextPutAll:' in '. h := self methodHome. sel := h selector. "/ old: @@ -2800,9 +2839,9 @@ "/ (h searchClass whichClassImplements:sel) name printOn:aStream. methodClass := h methodClass. methodClass isNil ifTrue:[ - 'UnboundMethod' printOn:aStream. + 'UnboundMethod' printOn:aStream. ] ifFalse:[ - methodClass name printOn:aStream. + methodClass name printOn:aStream. ]. aStream nextPutAll:'>>'. sel printOn:aStream. @@ -2815,7 +2854,7 @@ "/ aStream space. "/ (homeClass selectorForMethod:home) printOn:aStream "/ ] ifFalse:[ -"/ aStream nextPutAll:' ???' +"/ aStream nextPutAll:' ???' "/ ] "/ ! @@ -2846,13 +2885,13 @@ "Created: 13.4.1997 / 00:00:57 / cg" ! -initialPC +initialPC "return the initial pc for evaluation." ^ initialPC ! -initialPC:initial +initialPC:initial "set the initial pc for evaluation. DANGER ALERT: this interface is for the compiler only." @@ -2874,27 +2913,27 @@ home := aContext ! -source +source |m| sourcePos isString ifTrue:[ "/ misuses the sourcePosition slot - ^ sourcePos + ^ sourcePos ]. m := self method. m notNil ifTrue:[ - ^ m source + ^ m source ]. ^ nil ! -source:aString +source:aString "set the source - only to be used, if the block is not contained in a method. This interface is for knowledgable users only." sourcePos := aString "/ misuse the sourcePosition slot ! -sourcePosition:position +sourcePosition:position "set the position of the source within my method. This interface is for the compiler only." @@ -2948,12 +2987,12 @@ ! forkNamed:aString - "create a new process, give it a name and let it start + "create a new process, give it a name and let it start executing the receiver at the current priority." |newProcess| - newProcess := self newProcess. + newProcess := self newProcess. newProcess name:aString. newProcess resume. ^ newProcess. @@ -3042,10 +3081,10 @@ selector := aContext selector. selector == #'value:onUnwindDo:' ifTrue:[ - ^ aContext argAt:2 + ^ aContext argAt:2 ]. selector == #'on:do:ensure:' ifTrue:[ - ^ aContext argAt:3 + ^ aContext argAt:3 ]. "/ for now, only #valueNowOrOnUnwindDo: @@ -3191,11 +3230,11 @@ !Block class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.210 2015-03-27 11:23:34 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.211 2015-04-21 19:40:04 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.210 2015-03-27 11:23:34 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.211 2015-04-21 19:40:04 cg Exp $' ! !
--- a/CachingRegistry.st Tue Apr 21 17:27:23 2015 +0100 +++ b/CachingRegistry.st Wed Apr 22 07:33:07 2015 +0100 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1999 by eXept Software AG - 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 @@ -10,6 +10,7 @@ hereby transferred. " "{ Package: 'stx:libbasic' }" +"{ Package: 'stx:libbasic' }" Registry subclass:#CachingRegistry instanceVariableNames:'keptReferences cacheSize' @@ -23,7 +24,7 @@ copyright " COPYRIGHT (c) 1999 by eXept Software AG - 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 @@ -49,13 +50,13 @@ [author:] - Claus Gittinger (cg@exept) + Claus Gittinger (cg@exept) [see also:] [instance variables:] - keptObjects Collection hard referenced objects - cacheSize Integer number of hard references + keptObjects Collection hard referenced objects + cacheSize Integer number of hard references [class variables:] " @@ -74,7 +75,7 @@ keptReferences removeIdentical:anObject ifAbsent:nil. keptReferences addLast:anObject. keptReferences size > cacheSize ifTrue:[ - keptReferences removeFirst. + keptReferences removeFirst. ]. super register:anObject as:aHandle. ! @@ -92,7 +93,7 @@ !CachingRegistry class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/CachingRegistry.st,v 1.1 1999/07/22 23:17:43 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/CachingRegistry.st,v 1.2 2015-04-21 16:01:16 cg Exp $' ! version_SVN
--- a/Character.st Tue Apr 21 17:27:23 2015 +0100 +++ b/Character.st Wed Apr 22 07:33:07 2015 +0100 @@ -138,7 +138,7 @@ "return a character with codePoint anInteger" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ { char ch = (char)(context.stArg(0).intValue("[codePoint:]")); @@ -840,7 +840,7 @@ (which is more than mozilla does, btw. ;-)" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ { char ch = self.charValue("[asLowercase]"); @@ -1009,7 +1009,7 @@ } RETURN (self); allocationError: ; -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ ObjectMemory allocationFailureSignal raise. @@ -1155,7 +1155,7 @@ (which is more than mozilla does, btw. ;-)" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ { char ch = self.charValue("[asUppercase]"); @@ -1336,7 +1336,7 @@ } RETURN (self); allocationError: ; -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ ObjectMemory allocationFailureSignal raise. @@ -3035,10 +3035,9 @@ !Character class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.160 2015-04-15 00:30:56 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.161 2015-04-20 10:48:54 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.160 2015-04-15 00:30:56 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.161 2015-04-20 10:48:54 cg Exp $' ! ! -
--- a/CharacterEncoderImplementations__JIS0208_to_SJIS.st Tue Apr 21 17:27:23 2015 +0100 +++ b/CharacterEncoderImplementations__JIS0208_to_SJIS.st Wed Apr 22 07:33:07 2015 +0100 @@ -1,3 +1,5 @@ +"{ Encoding: utf8 }" + " COPYRIGHT (c) 2004 by eXept Software AG All Rights Reserved @@ -240,7 +242,7 @@ ! encodeString:aJISString - "return a new string with aJISStrings characters as SJIS encoded 8bit string. + "return a new string with aJISString's characters as SJIS encoded 8bit string. The resulting string is only useful to be stored on some external file, not for being displayed in an ST/X view." @@ -339,16 +341,10 @@ !JIS0208_to_SJIS class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__SJIS.st,v 1.12 2009/11/05 16:26:27 stefan Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0208_to_SJIS.st,v 1.2 2015-04-20 11:05:35 cg Exp $' ! version_CVS - ^ '§Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__SJIS.st,v 1.12 2009/11/05 16:26:27 stefan Exp §' -! - -version_SVN - ^ '$Id: CharacterEncoderImplementations__JIS0208_to_SJIS.st 10807 2012-05-05 21:58:24Z vranyj1 $' + ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__JIS0208_to_SJIS.st,v 1.2 2015-04-20 11:05:35 cg Exp $' ! ! - -
--- a/CharacterEncoderImplementations__SJIS.st Tue Apr 21 17:27:23 2015 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,347 +0,0 @@ -" - COPYRIGHT (c) 2004 by eXept Software AG - All Rights Reserved - - This software is furnished under a license and may be used - only in accordance with the terms of that license and with the - inclusion of the above copyright notice. This software may not - be provided or otherwise made available to, or used by, any - other person. No title to or ownership of the software is - hereby transferred. -" -"{ Package: 'stx:libbasic' }" - -"{ NameSpace: CharacterEncoderImplementations }" - -TwoByteEncoder subclass:#JIS0208_to_SJIS - instanceVariableNames:'' - classVariableNames:'' - poolDictionaries:'' - category:'Collections-Text-Encodings' -! - -!JIS0208_to_SJIS class methodsFor:'documentation'! - -copyright -" - COPYRIGHT (c) 2004 by eXept Software AG - All Rights Reserved - - This software is furnished under a license and may be used - only in accordance with the terms of that license and with the - inclusion of the above copyright notice. This software may not - be provided or otherwise made available to, or used by, any - other person. No title to or ownership of the software is - hereby transferred. -" -! ! - -!JIS0208_to_SJIS class methodsFor:'mapping'! - -mapFileURL1_relativePathName - ^ 'OBSOLETE/EASTASIA/JIS/SHIFTJIS.TXT' -! ! - -!JIS0208_to_SJIS class methodsFor:'queries'! - -nameOfDecodedCode - "I encode sjis into jis" - - ^ #'jis0208' -! ! - -!JIS0208_to_SJIS methodsFor:'encoding & decoding'! - -decodeString:aString - "return a new JIS-Encoded-String containing the characters from aString, - which are interpreted as Shift-JIS encoded singleByte chars. - Shift-JIS is a leadyByte code, with a variable-length encoding." - - |newString char1 char2 - sz "{ Class: SmallInteger }" - dstIdx "{ Class: SmallInteger }" - srcIdx "{ Class: SmallInteger }" - b1 "{ Class: SmallInteger }" - b2 "{ Class: SmallInteger }" - val "{ Class: SmallInteger }" - any16bit romans| - - sz := aString size. - sz == 0 ifTrue:[^ aString]. - - newString := TwoByteString new:sz. - any16bit := false. - dstIdx := 1. - srcIdx := 1. - - romans := CharacterEncoderImplementations::JIS0208 romanTable. - -%{ - if (__isStringLike(aString) - && (__Class(newString) == @global(TwoByteString))) { - INT _dstIdx = 0, _srcIdx = 0; - int _sz = __intVal(sz); - unsigned char *_cp = __stringVal(aString); - unsigned char _c1, _c2; - unsigned short *_jcp = (unsigned short *)__stringVal(newString); - - while (_srcIdx < _sz) { - int _val; - - _c1 = _cp[_srcIdx]; - _srcIdx++; - - if ((_srcIdx < _sz) - && (((_c1 >= 129) && (_c1 <= 159)) - || ((_c1 >= 224) && (_c1 <= 239)))) { - _c2 = _cp[_srcIdx]; - _srcIdx++; - if ((_c2 >= 64) && (_c2 <= 252)) { - int _adjust, _rowOffs, _cellOffs; - int _b1, _b2; - - _adjust = (_c2 < 159) ? 1 : 0; - _rowOffs = (_c1 < 160) ? 112 : 176; - if (_adjust) { - _cellOffs = 31 + ((_c2 > 127) ? 1 : 0); - } else { - _cellOffs = 126; - } - _b1 = ((_c1 - _rowOffs) << 1) - _adjust; - _b2 = (_c2 - _cellOffs); - _val = (_b1<<8) + _b2; - if (_val <= 0) { - /* decoder error - let smalltalk handle that */ - _srcIdx -= 2; - goto getOutOfHere; - } - if (_val > 0xFF) any16bit = true; - _jcp[_dstIdx] = _val; - } else { - /* mhmh - append untranslated */ - - _jcp[_dstIdx] = _c1; - _dstIdx++; - _jcp[_dstIdx] = _c2; - } - } else { - if ((_c1 >= 0xA1 /* 161 */) && (_c1 <= 0xDF /* 223 */)) { - /* HALFWIDTH KATAKANA - * map half-width katakana to 8E:xx - */ - _val = _c1 - 128; - _val = _val + 0x8E00; - any16bit = true; - _jcp[_dstIdx] = _val; - } else { - /* roman characters are translated as per romanTable */ - _jcp[_dstIdx] = _c1; - if ((romans != nil) - && (__isArray(romans)) - && ((_c1 - 0x20) < __arraySize(romans))) { - any16bit = true; - _jcp[_dstIdx] = __intVal(__ArrayInstPtr(romans)->a_element[(_c1 - 0x20)]); - } - } - } - _dstIdx++; - } - getOutOfHere: ; - dstIdx = __mkSmallInteger(_dstIdx+1); - srcIdx = __mkSmallInteger(_srcIdx+1); - } -%}. - - [srcIdx <= sz] whileTrue:[ - "/ - "/ scan for next character in 129..159 or 224..239 - "/ - char1 := aString at:srcIdx. - srcIdx := srcIdx + 1. - b1 := char1 codePoint. - - ((srcIdx <= sz) - and:[(b1 >= 16r81"129" and:[b1 <= 16r9F"159"]) "/ SJIS1 81 .. 9F - or:[b1 >= 16rE0"224" and:[b1 <= 16rEF"239"]]]) ifTrue:[ "/ E0 .. EF - char2 := aString at:srcIdx. - srcIdx := srcIdx + 1. - b2 := char2 codePoint. - (b2 >= 16r40"64" and:[b2 <= 16rFC"252"]) ifTrue:[ "/ SJIS2 40 .. FC - |adjust rowOffs cellOffs| - - adjust := (b2 < 16r9F"159") ifTrue:[1] ifFalse:[0]. - rowOffs := b1 < 16rA0"160" ifTrue:[112] ifFalse:[176]. - adjust == 1 ifTrue:[ - cellOffs := 31 + (b2 > 127 ifTrue:[1] ifFalse:[0]). - ] ifFalse:[ - cellOffs := 126. - ]. - b1 := ((b1 - rowOffs) bitShift:1) - adjust. - b2 := (b2 - cellOffs). - val := (b1 bitShift:8) + b2. - val <= 0 ifTrue:[ - DecodingError - raiseWith:aString - errorString:'SJIS decoding failed (not SJIS encoded ?)'. - newString at:dstIdx put:char1. - dstIdx := dstIdx + 1. - newString at:dstIdx put:char2. - ] ifFalse:[ - val > 16rFF ifTrue:[any16bit := true]. - newString at:dstIdx put:(Character value:val). - ] - ] ifFalse:[ - "/ mhmh - append untranslated - - newString at:dstIdx put:char1. - dstIdx := dstIdx + 1. - newString at:dstIdx put:char2. - ] - ] ifFalse:[ - (b1 >= 16rA1 "161" and:[b1 <= 16rDF "223"]) ifTrue:[ "/ HALFWIDTH KATAKANA - "/ map half-width katakan to 8E:xx - val := b1 - 128. - val := val + (16r8E"142" bitShift:8). - any16bit := true. - newString at:dstIdx put:(Character value:val). - ] ifFalse:[ - "/ roman characters translated as per romanTable - newString at:dstIdx put:char1 - romans isArray ifTrue:[ - char1 codePoint < romans size ifTrue:[ - any16bit := true. - newString at:dstIdx put:(Character value:(romans at:char1 codePoint-32+1)). - ] - ] - ] - ]. - dstIdx := dstIdx + 1. - ]. - any16bit ifFalse:[ - newString := String fromString:newString - ]. - - (dstIdx-1) ~~ sz ifTrue:[ - newString := newString copyTo:dstIdx - 1. - ]. - - ^ newString - - "simple: - - CharacterEncoderImplementations::JIS0208_to_SJIS decodeString:'hello' - (CharacterEncoder encoderFor:#sjis) decodeString:'hello' - - CharacterEncoderImplementations::JIS0208_to_SJIS decodeString:('../../doc/online/japanese/TOP.html' asFilename contents asString) - - '../../doc/online/japanese/TOP.html' asFilename contents asString - decodeFrom:#sjis - " -! - -encodeString:aJISString - "return a new string with aJISStrings characters as SJIS encoded 8bit string. - The resulting string is only useful to be stored on some external file, - not for being displayed in an ST/X view." - - |sz "{ Class: SmallInteger }" - rval "{ Class: SmallInteger }" - val "{ Class: SmallInteger }" - romans c out isSJIS| - - romans := JIS0208 romanTable. - - sz := aJISString size. - sz == 0 ifTrue:[^ '']. - - out := WriteStream on:(String new:(sz * 2)). - - 1 to:sz do:[:srcIndex | - val := (c := aJISString at:srcIndex) codePoint. - (val <= 128) ifTrue:[ - "/ a control or ascii character - out nextPut:c. - ] ifFalse:[ - (val == 16rFFFF "invalid-char") ifTrue:[ - out nextPut:Character space. - ] ifFalse:[ - (val > 150 and:[val < 224]) ifTrue:[ - "/ ascii subset - out nextPut:c. - ] ifFalse:[ - "/ should not happen ... - val <= 255 ifTrue:[ - out nextPut:c. - ] ifFalse:[ - isSJIS := true. - - "/ check for HALFWIDTH KATAKANA - "/ 8E:xx - "/ NO: halfwidth katakana no longer generated - "/ remains there as full-width katakana - -"/ (val bitAnd:16rFF00) == 16r8E00 ifTrue:[ -"/ |b| -"/ -"/ b := (val bitAnd:16rFF) + 128. -"/ (b >= 16rA1 "161" and:[b <= 16rDF "223"]) ifTrue:[ -"/ out nextPut:(Character value:b). -"/ isSJIS := false. -"/ ]. -"/ ]. - - isSJIS ifTrue:[ - "/ check for a roman character - (val between:"romanTable min" 16r2121 and:"romanTable max" 16r2573) ifTrue:[ - rval := romans indexOf:val. - rval ~~ 0 ifTrue:[ - rval := rval - 1 + 32. - rval <= 16r7F ifTrue:[ "/ do not translate halfwidth katakana - out nextPut:(Character value:rval). - isSJIS := false. - ] - ]. - ]. - ]. - - isSJIS ifTrue:[ - |b1 b2 rowOffset cellOffset| - - b1 := (val bitShift:-8). - b2 := (val bitAnd:16rFF). - rowOffset := (b1 < 95) ifTrue:[112] ifFalse:[176]. - cellOffset := b1 odd ifTrue:[(b2 > 95) ifTrue:[32] ifFalse:[31]] - ifFalse:[126]. - - out nextPut:(Character value:(((b1 + 1) bitShift:-1) + rowOffset)). - out nextPut:(Character value:b2 + cellOffset). - ] - ] - ] - ] - ]. - ]. - ^ out contents -! ! - -!JIS0208_to_SJIS methodsFor:'private'! - -newString:size - ^ JISEncodedString new:size -! ! - -!JIS0208_to_SJIS methodsFor:'queries'! - -nameOfEncoding - ^ #'sjis' -! ! - -!JIS0208_to_SJIS class methodsFor:'documentation'! - -version - ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__SJIS.st,v 1.12 2009-11-05 16:26:27 stefan Exp $' -! - -version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/CharacterEncoderImplementations__SJIS.st,v 1.12 2009-11-05 16:26:27 stefan Exp $' -! !
--- a/Context.st Tue Apr 21 17:27:23 2015 +0100 +++ b/Context.st Wed Apr 22 07:33:07 2015 +0100 @@ -252,7 +252,7 @@ |c| %{ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ OBJ __c__; __c__ = __ContextInstPtr(__thisContext)->c_sender; @@ -345,7 +345,7 @@ "ANSI alias for numArgs: return the number of arguments to the Block/Method" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( STInteger._new( ((STContinuation)self).numStArgs() ) ); #else RETURN ( __mkSmallInteger( (__intVal(__INST(flags)) >> __NARG_SHIFT) & __NARG_MASK) ); @@ -360,7 +360,7 @@ "/ some machines have the arguments/receiver etc. kept in register vars ... "/ the unfix updates the machine-stack version of the receiver. %{ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ __UNFIXCONTEXT(self, 0); #endif %}. @@ -392,7 +392,7 @@ |what| %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ { int idx = context.stArg(0).intValue("[instVarAt:]"); @@ -428,7 +428,7 @@ extension to get this automatically)." %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else if (index == __MKSMALLINT(__SLOT_CONTEXT_SENDER)) { // sender - not allowed to change @@ -446,7 +446,7 @@ "/ some machines have the arguments kept in register vars ... "/ the unfix updates the machine-stack version of the receiver. %{ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ __UNFIXCONTEXT(self, 0); #endif %}. @@ -670,8 +670,8 @@ "return the number of arguments to the Block/Method" %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + return context._RETURN(STInteger._new(self.numStArgs())); #else RETURN ( __mkSmallInteger( (__intVal(__INST(flags)) >> __NARG_SHIFT) & __NARG_MASK) ); #endif @@ -692,8 +692,8 @@ "return the number of local variables of the Block/Method" %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + return context._RETURN(STInteger._new(self.numLocals(context))); #else RETURN ( __mkSmallInteger( (__intVal(__INST(flags)) >> __NVAR_SHIFT) & __NVAR_MASK) ); #endif @@ -721,7 +721,11 @@ receiver "return the receiver of the context" - +%{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context._RETURN( self.stReceiver(context) ); +#endif +%}. ^ receiver ! @@ -734,7 +738,7 @@ "/ some machines have the arguments kept in register vars ... "/ the unfix updates the machine-stack version of the receiver. %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else __UNFIXCONTEXT(self, 0); @@ -756,6 +760,12 @@ selector "return the selector of the method for which the context was created" +%{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + return context._RETURN(self.selector()); + /* NOTREACHED */ +#endif +%}. ^ selector ! @@ -763,8 +773,9 @@ "return the sender of the context" %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + return context._RETURN(self.sender()); + /* NOTREACHED */ #else OBJ theContext; @@ -806,7 +817,7 @@ invalid until needed." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else if ( __INST(sender_) == nil ) { @@ -827,7 +838,7 @@ "set the number of arguments and variables" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else INT flg; @@ -995,7 +1006,7 @@ fixAllLineNumbers %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else __PATCHUPCONTEXTS(__thisContext); @@ -1156,7 +1167,7 @@ If such a context is restarted, a runtime error is raised." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else if (__INST(sender_) == nil) { @@ -1216,7 +1227,7 @@ " %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else OBJ sndr; @@ -1267,7 +1278,7 @@ " %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else OBJ theContext, sndr; @@ -1313,7 +1324,7 @@ " %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else OBJ theContext, sndr; @@ -1367,7 +1378,7 @@ If such a context is restarted, a runtime error is raised." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else if (__INST(sender_) == nil) { @@ -1402,7 +1413,7 @@ If such a context is restarted, a runtime error is raised." %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else if (__INST(sender_) == nil) { @@ -1665,7 +1676,7 @@ argStringFor:someObject |s| %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else /* @@ -2006,15 +2017,21 @@ ! safeReceiverClassName - "return the receivers class-name string or nil, if the receiver is invalid. + "return the receiver's class-name string or nil, if the receiver is invalid. This cares for invalid (free) objects which may appear with bad primitive code, and prevents a crash in such a case." |receiverClassName| %{ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + { + STObject rcvr = self.stReceiver(context); + STClass cls = rcvr.clazz(); + + return context._RETURN( cls.className() ); + } + /* NOT REACHED */ #else /* * special handling for (invalid) free objects. @@ -2039,10 +2056,10 @@ this context - a highly internal mechanism and not for public use." %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + context._RETURN (self.isMarkedForUnwind() ? STObject.True : STObject.False); #else - RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__UNWIND_MARK)) ? true : false ); + RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__UNWIND_MARK)) ? true : false ); #endif %} " @@ -2056,8 +2073,8 @@ this context - a highly internal mechanism and not for public use." %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + self.markForHandle(); #else __INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__HANDLE_MARK)); #endif @@ -2072,8 +2089,8 @@ this context upon return - a highly internal mechanism and not for public use." %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + self.markForInterrupt(); #else __markInterrupted(__ContextInstPtr(self)); #endif @@ -2087,8 +2104,8 @@ - a highly internal mechanism and not for public use." %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + self.markForInterruptOnUnwind(); #else __INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__IRQ_ON_UNWIND)); #endif @@ -2101,8 +2118,8 @@ this context - a highly internal mechanism and not for public use." %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + self.markForRaise(); #else __INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__RAISE_MARK)); #endif @@ -2117,8 +2134,8 @@ this context - a highly internal mechanism and not for public use." %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + self.markForUnwind(); #else __INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__UNWIND_MARK)); #endif @@ -2139,7 +2156,7 @@ DANGER: this is for experimental, internal use only (byteCode interpreters)" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else __INST(sender_) = aContext; @@ -2153,8 +2170,8 @@ this context - a highly internal mechanism and not for public use." %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + self.unmarkForUnwind(); #else __INST(flags) = (OBJ)((INT)__INST(flags) & ~__MASKSMALLINT(__UNWIND_MARK)); #endif @@ -2186,8 +2203,19 @@ "/ although they aren't really - this is expert knowledge, no need to understand that ...) %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + { + STObject caller = self.sender(); + + while (caller != Nil) { + if (caller.isExceptionalSmalltalkContext()) { + return context._RETURN(caller); + } + caller = caller.sender(); + } + return context._RETURN( STObject.Nil ); + } + /* NOTREACHED */ #else OBJ theContext; @@ -2214,7 +2242,7 @@ } theContext = __ContextInstPtr(theContext)->c_sender; } -#endif +#endif /* not SCHTEAM */ %}. ^ nil ! @@ -2241,9 +2269,9 @@ "/ although they aren't really - this is expert knowledge, no need to understand that ...) %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ { - STObject caller = self.asSTContinuation("sender").caller(); + STObject caller = self.sender(); STObject sel1 = context.stArg(0); STObject sel2 = context.stArg(1); STObject sel3 = context.stArg(2); @@ -2258,7 +2286,7 @@ break; } } - caller = caller.asSTContinuation("sender").caller(); + caller = caller.sender(); } return context._RETURN(caller); } @@ -2341,7 +2369,7 @@ "/ although they aren't really - this is expert knowledge, no need to understand that ...) %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else OBJ theContext; @@ -2401,7 +2429,7 @@ "/ although they aren't really - this is expert knowledge, no need to understand that ...) %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else OBJ theContext; @@ -2574,8 +2602,8 @@ (i.e. the one that I have called) and return from it. " %{ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + return context._RETURN( STObject.True ); #else OBJ sndr; @@ -2611,8 +2639,8 @@ are all compiled with this flag turned on." %{ /* NOCONTEXT */ -#ifdef __JAVA__ - ERROR("unimplemented"); +#ifdef __SCHTEAM__ + return context._RETURN( STObject.True ); #else RETURN ( ((INT)(__INST(flags)) & __MASKSMALLINT(__CANNOT_RETURN)) ? false : true ); #endif @@ -2635,7 +2663,7 @@ "return true, if this is a context with exception-handle flag set" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__HANDLE_MARK)) ? true : false ); @@ -2652,7 +2680,7 @@ debug query, which may be removed without notice." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__NONLIFO)) ? true : false ); @@ -2667,7 +2695,7 @@ debug query, which may be removed without notice." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else RETURN ( (__qSpace(self) >= STACKSPACE) ? true : false ); @@ -2679,7 +2707,7 @@ "return true, if this is a context with exception-raise flag set" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__RAISE_MARK)) ? true : false ); @@ -2691,7 +2719,7 @@ "return true, if this is either a nonLifo or interrupted context" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__SPECIAL)) ? true : false ); @@ -2703,7 +2731,7 @@ "return true, if this is an unwindContext" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("unimplemented"); #else RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__UNWIND_MARK)) ? true : false ); @@ -2832,11 +2860,11 @@ !Context class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.213 2015-04-15 00:31:34 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.215 2015-04-21 19:40:22 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.213 2015-04-15 00:31:34 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.215 2015-04-21 19:40:22 cg Exp $' ! version_HG
--- a/ExternalLibraryFunction.st Tue Apr 21 17:27:23 2015 +0100 +++ b/ExternalLibraryFunction.st Wed Apr 22 07:33:07 2015 +0100 @@ -231,7 +231,7 @@ DLLPATH isNil ifTrue:[ DLLPATH := #('.'). %{ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ @global(FLAG_VIRTUAL) = __MKSMALLINT(__EXTL_FLAG_VIRTUAL); // a virtual c++ call @global(FLAG_NONVIRTUAL) = __MKSMALLINT(__EXTL_FLAG_NONVIRTUAL); // a non-virtual c++ call @global(FLAG_OBJECTIVEC) = __MKSMALLINT(__EXTL_FLAG_OBJECTIVEC); // an objectiveC message send @@ -1693,7 +1693,7 @@ !ExternalLibraryFunction class methodsFor:'documentation'! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.96 2015-04-19 09:45:21 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.97 2015-04-20 10:48:54 cg Exp $' ! version_SVN
--- a/Fraction.st Tue Apr 21 17:27:23 2015 +0100 +++ b/Fraction.st Wed Apr 22 07:33:07 2015 +0100 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1989 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 @@ -23,7 +23,7 @@ copyright " COPYRIGHT (c) 1989 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 @@ -38,34 +38,34 @@ " Instances of Fraction represent fractional numbers consisting of a numerator and denominator. Both are themselfes arbitrary precision - integers. + integers. Fractions are usually created by dividing Integers using / (for exact division). Notice, that all operations on fractions reduce their result; this means, that the result of a fraction-operation may return an integer. Aka: - (1 / 7) * 7 -> 1 (not 0.99999999...) + (1 / 7) * 7 -> 1 (not 0.99999999...) Mixed mode arithmetic: - fraction op fraction -> fraction/integer - fraction op fix -> fix; scale is fix's scale - fraction op integer -> fraction/integer - fraction op float -> float + fraction op fraction -> fraction/integer + fraction op fix -> fix; scale is fix's scale + fraction op integer -> fraction/integer + fraction op float -> float [classVariables:] - PrintWholeNumbers Booolean experimental: - controls how fractions which are greater than 1 are printed. - if true, print them as a sum of an integral and the fractional part. - (Large ones are easier to read this way) - (17/3) printString -> '(5+(2/3))' - for now, the default is false, for backward compatibility + PrintWholeNumbers Booolean experimental: + controls how fractions which are greater than 1 are printed. + if true, print them as a sum of an integral and the fractional part. + (Large ones are easier to read this way) + (17/3) printString -> '(5+(2/3))' + for now, the default is false, for backward compatibility [author:] - Claus Gittinger + Claus Gittinger [see also:] - Number - FixedPoint Float ShortFloat LongFloat Integer Complex + Number + FixedPoint Float ShortFloat LongFloat Integer Complex " ! ! @@ -84,43 +84,48 @@ |newFraction| %{ /* NOCONTEXT */ - +#ifdef __SCHTEAM__ + if (self == Fraction.Class) { + return context._RETURN(new STFraction(num, den)); + } +#else /* this check allows subclassing .. */ if (self == Fraction) { - if (__bothSmallInteger(num, den)) { - if (den != __mkSmallInteger(0)) { - if (__CanDoQuickAlignedNew(sizeof(struct __Fraction))) { /* OBJECT ALLOCATION */ - OBJ newFraction; - int spc; - INT iDen; + if (__bothSmallInteger(num, den)) { + if (den != __mkSmallInteger(0)) { + if (__CanDoQuickAlignedNew(sizeof(struct __Fraction))) { /* OBJECT ALLOCATION */ + OBJ newFraction; + int spc; + INT iDen; - __qCheckedAlignedNew(newFraction, sizeof(struct __Fraction)); - __InstPtr(newFraction)->o_class = self; - __qSTORE(newFraction, self); - iDen = __intVal(den); - if (iDen != 0) { - if (iDen < 0) { - __FractionInstPtr(newFraction)->f_numerator = __mkSmallInteger(- __intVal(num)); - __FractionInstPtr(newFraction)->f_denominator = __mkSmallInteger(- iDen); - } else { - __FractionInstPtr(newFraction)->f_numerator = num; - __FractionInstPtr(newFraction)->f_denominator = den; - } - if (num == __mkSmallInteger(1)) { - /* no need to reduce */ - RETURN ( newFraction ); - } - } - } - } - } + __qCheckedAlignedNew(newFraction, sizeof(struct __Fraction)); + __InstPtr(newFraction)->o_class = self; + __qSTORE(newFraction, self); + iDen = __intVal(den); + if (iDen != 0) { + if (iDen < 0) { + __FractionInstPtr(newFraction)->f_numerator = __mkSmallInteger(- __intVal(num)); + __FractionInstPtr(newFraction)->f_denominator = __mkSmallInteger(- iDen); + } else { + __FractionInstPtr(newFraction)->f_numerator = num; + __FractionInstPtr(newFraction)->f_denominator = den; + } + if (num == __mkSmallInteger(1)) { + /* no need to reduce */ + RETURN ( newFraction ); + } + } + } + } + } } +#endif /* not __SCHTEAM__ */ %}. den = 0 ifTrue:[ - ^ ZeroDivide raiseRequestWith:thisContext. + ^ ZeroDivide raiseRequestWith:thisContext. ]. newFraction isNil ifTrue:[ - newFraction := self basicNew setNumerator:num denominator:den. + newFraction := self basicNew setNumerator:num denominator:den. ]. ^ newFraction reduced @@ -145,13 +150,13 @@ anyDigit := false. [ - ch := s peekOrNil. - ch notNil and:[ch isDigit]. + ch := s peekOrNil. + ch notNil and:[ch isDigit]. ] whileTrue: [ - s next. - anyDigit := true. - fraction := (ch digitValue) * factor + fraction. - factor := (factor / 10). + s next. + anyDigit := true. + fraction := (ch digitValue) * factor + fraction. + factor := (factor / 10). ]. anyDigit ifFalse: [^ exceptionBlock valueWithOptionalArgument: 'Missing digits in fraction']. @@ -159,9 +164,9 @@ " Fraction readDecimalFractionFrom:'1' onError:[nil] -> 0.1 - Fraction readDecimalFractionFrom:'123' onError:[nil] -> 0.123 - Fraction readDecimalFractionFrom:'5' onError:[nil] -> 0.5 - Fraction readDecimalFractionFrom:'005' onError:[nil] -> 0.005 + Fraction readDecimalFractionFrom:'123' onError:[nil] -> 0.123 + Fraction readDecimalFractionFrom:'5' onError:[nil] -> 0.5 + Fraction readDecimalFractionFrom:'005' onError:[nil] -> 0.005 Fraction readDecimalFractionFrom:'' onError:[nil] -> nil Fraction readDecimalFractionFrom:'aa' onError:[nil] -> nil " @@ -172,33 +177,33 @@ "/ sigh - care for subclasses... self == Fraction ifFalse:[ - ^ super readFrom:aStringOrStream onError:exceptionBlock + ^ super readFrom:aStringOrStream onError:exceptionBlock ]. s := aStringOrStream readStream. s skipSeparators. s peek == $( ifTrue:[ - s next. - + s next. + ]. numerator := super readFrom:s onError:[^ exceptionBlock value]. numerator isInteger ifTrue:[ - s skipSeparators. - (s peek == $/) ifTrue:[ - s next. - denominator := Integer readFrom:s onError:[^ exceptionBlock value]. - ^ self numerator:numerator denominator:denominator - ]. - ^ numerator + s skipSeparators. + (s peek == $/) ifTrue:[ + s next. + denominator := Integer readFrom:s onError:[^ exceptionBlock value]. + ^ self numerator:numerator denominator:denominator + ]. + ^ numerator ]. ^ numerator asFraction " - Fraction readFrom:'1' - Fraction readFrom:'2' - Fraction readFrom:'1.5' - Fraction readFrom:'1/5' + Fraction readFrom:'1' + Fraction readFrom:'2' + Fraction readFrom:'1.5' + Fraction readFrom:'1/5' " ! ! @@ -206,8 +211,8 @@ initialize FractionZero isNil ifTrue:[ - FractionZero := self numerator:0 denominator:1. - FractionOne := self numerator:1 denominator:1 + FractionZero := self numerator:0 denominator:1. + FractionOne := self numerator:1 denominator:1 ] ! ! @@ -217,18 +222,18 @@ "return an approximation of the constant pi as Fraction. The approx. returned here has an error smaller than representable by float instances" - ^ self - numerator:314159265358979323846264343 - denominator:100000000000000000000000000 + ^ self + numerator:314159265358979323846264343 + denominator:100000000000000000000000000 -"/ ^ self +"/ ^ self "/ numerator: 314159265358979323846264338327950288419716939937510582097494459 "/ denominator:100000000000000000000000000000000000000000000000000000000000000 " - Fraction pi + Fraction pi Fraction pi asFloat - Float pi - Float pi + Float pi " "Modified: / 03-05-2011 / 11:08:46 / cg" @@ -240,14 +245,14 @@ The value might be useful to avoid floating point numbers in graphic rendering code, where 6 digits of precision are usually good enough." - ^ self - numerator:355 - denominator:113 + ^ self + numerator:355 + denominator:113 " - Fraction pi + Fraction pi Fraction pi asFloat - Float pi - Fraction pi_approximation asFloat + Float pi - Fraction pi_approximation asFloat " ! @@ -308,12 +313,12 @@ "/ (see the message send at the bottom) (aNumber isMemberOf:SmallInteger) ifTrue:[ - ^ self class - numerator:(numerator * aNumber) - denominator:denominator + ^ self class + numerator:(numerator * aNumber) + denominator:denominator ]. (aNumber isMemberOf:Float) ifTrue:[ - ^ (numerator * aNumber) / denominator + ^ (numerator * aNumber) / denominator ]. ^ aNumber productFromFraction:self @@ -335,12 +340,12 @@ "/ (see the message send at the bottom) (aNumber isMemberOf:SmallInteger) ifTrue:[ - ^ self class - numerator:(numerator + (denominator * aNumber)) - denominator:denominator + ^ self class + numerator:(numerator + (denominator * aNumber)) + denominator:denominator ]. (aNumber isMemberOf:Float) ifTrue:[ - ^ (numerator asFloat / denominator asFloat) + aNumber + ^ (numerator asFloat / denominator asFloat) + aNumber ]. ^ aNumber sumFromFraction:self @@ -362,22 +367,22 @@ "/ (see the message send at the bottom) (aNumber isMemberOf:SmallInteger) ifTrue:[ - ^ self class - numerator:(numerator - (denominator * aNumber)) - denominator:denominator + ^ self class + numerator:(numerator - (denominator * aNumber)) + denominator:denominator ]. (aNumber isMemberOf:Float) ifTrue:[ - ^ (numerator asFloat / denominator asFloat) - aNumber + ^ (numerator asFloat / denominator asFloat) - aNumber ]. ^ aNumber differenceFromFraction:self " - (1/3) - (1/9) - (1/9) - (1/3) - (999/1000) - (1/1000) - (999/1000) - (1/1000000) - (999000/1000000) - (1/1000000) + (1/3) - (1/9) + (1/9) - (1/3) + (999/1000) - (1/1000) + (999/1000) - (1/1000000) + (999000/1000000) - (1/1000000) " "Modified: 28.7.1997 / 19:09:11 / cg" @@ -397,12 +402,12 @@ "/ (see the message send at the bottom) (aNumber isMemberOf:SmallInteger) ifTrue:[ - ^ self class - numerator:numerator - denominator:(denominator * aNumber) + ^ self class + numerator:numerator + denominator:(denominator * aNumber) ]. (aNumber isMemberOf:Float) ifTrue:[ - ^ numerator / (denominator * aNumber) + ^ numerator / (denominator * aNumber) ]. ^ aNumber quotientFromFraction:self @@ -430,9 +435,9 @@ negated "optional - could use inherited method ..." - ^ self class - numerator:(numerator negated) - denominator:denominator + ^ self class + numerator:(numerator negated) + denominator:denominator "Modified: 5.11.1996 / 10:29:11 / cg" ! @@ -441,9 +446,9 @@ "optional - could use inherited method ..." numerator == 1 ifTrue:[^ denominator]. - ^ self class - numerator:denominator - denominator:numerator + ^ self class + numerator:denominator + denominator:numerator "Modified: 5.11.1996 / 10:29:22 / cg" ! ! @@ -470,11 +475,11 @@ ^ FixedPoint numerator:numerator denominator:denominator scale:scale " - (1/2) asFixedPoint:2 - (1/3) asFixedPoint:2 - (1/3) asFixedPoint:5 - (2/3) asFixedPoint:2 - (2/3) asFixedPoint:5 + (1/2) asFixedPoint:2 + (1/3) asFixedPoint:2 + (1/3) asFixedPoint:5 + (2/3) asFixedPoint:2 + (2/3) asFixedPoint:5 " "Created: 5.11.1996 / 15:15:54 / cg" @@ -488,7 +493,7 @@ |num den numShift denShift bits rslt| (numerator class == SmallInteger and:[denominator class == SmallInteger]) ifTrue:[ - ^ (numerator asFloat) / (denominator asFloat) + ^ (numerator asFloat) / (denominator asFloat) ]. "Do it the hard way: reduce magnitude and undo reduction on the quotient" @@ -506,7 +511,7 @@ numerator negative ifTrue:[ ^ rslt negated ]. ^ rslt. - " + " (5/9) asFloat (-5/9) asFloat (500000000000/900000000000) asFloat @@ -518,14 +523,14 @@ ( 180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125 - / + / 180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250 ) asFloat 180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125 - asFloat / + asFloat / 180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250 - asFloat + asFloat " ! @@ -566,7 +571,7 @@ |num den numShift denShift numBits rslt| (numerator class == SmallInteger and:[denominator class == SmallInteger]) ifTrue:[ - ^ (numerator asLongFloat) / (denominator asLongFloat) + ^ (numerator asLongFloat) / (denominator asLongFloat) ]. "Do it the hard way: reduce magnitude and undo reduction on the quotient" @@ -584,31 +589,31 @@ numerator negative ifTrue:[ ^ rslt negated ]. ^ rslt. - " - (5/9) asLongFloat - (-5/9) asLongFloat + " + (5/9) asLongFloat + (-5/9) asLongFloat (Fraction basicNew setNumerator:500000000000 denominator:900000000000) asLongFloat = (5/9) asLongFloat (Fraction basicNew setNumerator:500000000001 denominator:900000000000) asLongFloat = (5/9) asLongFloat - (500000000001/900000000000) asLongFloat - (-500000000001/900000000000) asLongFloat + (500000000001/900000000000) asLongFloat + (-500000000001/900000000000) asLongFloat (500000000001/900000000000) asLongFloat = (5/9) asLongFloat - (500000000000/9) asLongFloat - (5/900000000000) asLongFloat - 89012345678901234567 asFloat / 123456789123456789 asLongFloat - (89012345678901234567 / 123456789123456789) asLongFloat - (-89012345678901234567 / 123456789123456789) asLongFloat + (500000000000/9) asLongFloat + (5/900000000000) asLongFloat + 89012345678901234567 asFloat / 123456789123456789 asLongFloat + (89012345678901234567 / 123456789123456789) asLongFloat + (-89012345678901234567 / 123456789123456789) asLongFloat ( 180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125 - / + / 180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250 - ) asLongFloat + ) asLongFloat 180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125 - asLongFloat / + asLongFloat / 180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250 - asLongFloat + asLongFloat " ! @@ -616,7 +621,7 @@ "return a short float with (approximately) my value" (numerator class == SmallInteger and:[denominator class == SmallInteger]) ifTrue:[ - ^ (numerator asShortFloat) / (denominator asShortFloat) + ^ (numerator asShortFloat) / (denominator asShortFloat) ]. ^ self asFloat asShortFloat @@ -647,7 +652,7 @@ than aNumber, false otherwise." (aNumber isMemberOf:SmallInteger) ifTrue:[ - ^ numerator < (denominator * aNumber) + ^ numerator < (denominator * aNumber) ]. ^ aNumber lessFromFraction:self @@ -659,10 +664,10 @@ as the receiver, false otherwise" (aNumber isMemberOf:SmallInteger) ifTrue:[ - (denominator == 1) ifFalse:[ - ^ numerator = (aNumber * denominator) - ]. - ^ numerator = aNumber + (denominator == 1) ifFalse:[ + ^ numerator = (aNumber * denominator) + ]. + ^ numerator = aNumber ]. ^ aNumber equalFromFraction:self @@ -675,7 +680,7 @@ "optional - could use inherited method ..." (aNumber isMemberOf:SmallInteger) ifTrue:[ - ^ numerator > (denominator * aNumber) + ^ numerator > (denominator * aNumber) ]. ^ aNumber < self ! @@ -690,15 +695,15 @@ ^ self asFloat hash " - 3 hash - (9/3) hash - 3.0 hash - (1/2) hash - (1/4) hash - 0.0 hash - 0.5 hash - 0.25 hash - 0.4 hash + 3 hash + (9/3) hash + 3.0 hash + (1/2) hash + (1/4) hash + 0.0 hash + 0.5 hash + 0.25 hash + 0.4 hash " ! @@ -711,7 +716,7 @@ rSelf := self reduced. rNum := aNumber reduced. rSelf denominator = rNum denominator ifTrue:[ - ^ rSelf numerator = rNum numerator + ^ rSelf numerator = rNum numerator ]. ^ false ! ! @@ -726,20 +731,20 @@ "save a multiplication if possible" otherDenominator == denominator ifTrue:[ - n := otherNumerator - numerator. - d := otherDenominator. + n := otherNumerator - numerator. + d := otherDenominator. ] ifFalse:[ - n := (otherNumerator * denominator) - (numerator * otherDenominator). - d := otherDenominator * denominator. + n := (otherNumerator * denominator) - (numerator * otherDenominator). + d := otherDenominator * denominator. ]. - ^ aFixedPoint class - numerator:n - denominator:d - scale:(aFixedPoint scale) + ^ aFixedPoint class + numerator:n + denominator:d + scale:(aFixedPoint scale) " - ((1/3) asFixedPoint:2) - (1/3) - ((1/3) asFixedPoint:2) - (2/3) + ((1/3) asFixedPoint:2) - (1/3) + ((1/3) asFixedPoint:2) - (2/3) " ! @@ -757,36 +762,36 @@ "save a multiplication if possible" otherDenominator == denominator ifTrue:[ - n := otherNumerator - numerator. - d := otherDenominator. + n := otherNumerator - numerator. + d := otherDenominator. ] ifFalse:[ - n := (otherNumerator * denominator) - (numerator * otherDenominator). - d := otherDenominator * denominator. + n := (otherNumerator * denominator) - (numerator * otherDenominator). + d := otherDenominator * denominator. ]. - ^ aFraction class - numerator:n - denominator:d + ^ aFraction class + numerator:n + denominator:d " - ((1/3) asFixedPoint:2) - (1/3) - ((1/3) asFixedPoint:2) - (2/3) + ((1/3) asFixedPoint:2) - (1/3) + ((1/3) asFixedPoint:2) - (2/3) " ! differenceFromInteger:anInteger "sent when an integer does not know how to subtract the receiver, a fraction" - ^ self class - numerator:((anInteger * denominator) - numerator) - denominator:denominator + ^ self class + numerator:((anInteger * denominator) - numerator) + denominator:denominator "Modified: 28.7.1997 / 19:08:53 / cg" ! equalFromFraction:aFraction denominator = aFraction denominator ifFalse:[ - ^ false " must always be reduced " - "/ ^ (numerator * aFraction denominator) = (aFraction numerator * denominator) + ^ false " must always be reduced " + "/ ^ (numerator * aFraction denominator) = (aFraction numerator * denominator) ]. ^ numerator = aFraction numerator ! @@ -799,7 +804,7 @@ which might be encountered internally" denominator = 1 ifFalse:[ - ^ numerator = (anInteger * denominator) + ^ numerator = (anInteger * denominator) ]. ^ numerator = anInteger @@ -825,9 +830,9 @@ "/ save a multiplication if possible d == denominator ifTrue:[ - ^ n < numerator + ^ n < numerator ]. - ^ (denominator * n) < (numerator * d) + ^ (denominator * n) < (numerator * d) ! lessFromInteger:anInteger @@ -837,15 +842,15 @@ ! productFromFixedPoint:aFixedPoint - ^ aFixedPoint class - numerator:(aFixedPoint numerator * numerator) - denominator:(aFixedPoint denominator * denominator) - scale:(aFixedPoint scale) + ^ aFixedPoint class + numerator:(aFixedPoint numerator * numerator) + denominator:(aFixedPoint denominator * denominator) + scale:(aFixedPoint scale) " - ((1/3) asFixedPoint:2) * 2 - ((1/3) asFixedPoint:2) * (1/2) - ((1/3) asFixedPoint:2) * (3/2) + ((1/3) asFixedPoint:2) * 2 + ((1/3) asFixedPoint:2) * (1/2) + ((1/3) asFixedPoint:2) * (3/2) " ! @@ -856,23 +861,23 @@ ! productFromFraction:aFraction - ^ aFraction class - numerator:(aFraction numerator * numerator) - denominator:(aFraction denominator * denominator) + ^ aFraction class + numerator:(aFraction numerator * numerator) + denominator:(aFraction denominator * denominator) " - ((1/3) asFixedPoint:2) * 2 - ((1/3) asFixedPoint:2) * (1/2) - ((1/3) asFixedPoint:2) * (3/2) + ((1/3) asFixedPoint:2) * 2 + ((1/3) asFixedPoint:2) * (1/2) + ((1/3) asFixedPoint:2) * (3/2) " ! productFromInteger:anInteger "sent when an integer does not know how to multiply the receiver, a fraction" - ^ self class - numerator:(anInteger * numerator) - denominator:denominator + ^ self class + numerator:(anInteger * numerator) + denominator:denominator "Modified: 28.7.1997 / 19:06:22 / cg" ! @@ -881,14 +886,14 @@ "Return the quotient of the argument, aFixedPoint and the receiver. Sent when aFixedPoint does not know how to divide by the receiver." - ^ aFixedPoint class - numerator:(aFixedPoint numerator * denominator) - denominator:(aFixedPoint denominator * numerator) - scale:(aFixedPoint scale) + ^ aFixedPoint class + numerator:(aFixedPoint numerator * denominator) + denominator:(aFixedPoint denominator * numerator) + scale:(aFixedPoint scale) " - ((1/3) asFixedPoint:2) / 2 - ((1/3) asFixedPoint:2) / (1/2) + ((1/3) asFixedPoint:2) / 2 + ((1/3) asFixedPoint:2) / (1/2) " ! @@ -903,13 +908,13 @@ "Return the quotient of the argument, aFraction and the receiver. Sent when aFraction does not know how to divide by the receiver." - ^ aFraction class - numerator:(aFraction numerator * denominator) - denominator:(aFraction denominator * numerator) + ^ aFraction class + numerator:(aFraction numerator * denominator) + denominator:(aFraction denominator * numerator) " - (1/3) / (1/2) - (1/3) / (3/2) + (1/3) / (1/2) + (1/3) / (3/2) " ! @@ -917,9 +922,9 @@ "Return the quotient of the argument, anInteger and the receiver. Sent when anInteger does not know how to divide by the receiver." - ^ self class - numerator:(anInteger * denominator) - denominator:numerator + ^ self class + numerator:(anInteger * denominator) + denominator:numerator "Modified: 28.7.1997 / 19:08:46 / cg" ! @@ -932,20 +937,20 @@ "save a multiplication if possible" otherDenominator == denominator ifTrue:[ - n := otherNumerator + numerator. - d := otherDenominator. + n := otherNumerator + numerator. + d := otherDenominator. ] ifFalse:[ - n := (otherNumerator * denominator) + (numerator * otherDenominator). - d := otherDenominator * denominator. + n := (otherNumerator * denominator) + (numerator * otherDenominator). + d := otherDenominator * denominator. ]. - ^ aFixedPoint class - numerator:n - denominator:d - scale:(aFixedPoint scale) + ^ aFixedPoint class + numerator:n + denominator:d + scale:(aFixedPoint scale) " - ((1/3) asFixedPoint:2) + (1/3) - ((1/3) asFixedPoint:2) + (2/3) + ((1/3) asFixedPoint:2) + (1/3) + ((1/3) asFixedPoint:2) + (2/3) " ! @@ -963,28 +968,28 @@ "save a multiplication if possible" otherDenominator == denominator ifTrue:[ - n := otherNumerator + numerator. - d := otherDenominator. + n := otherNumerator + numerator. + d := otherDenominator. ] ifFalse:[ - n := (otherNumerator * denominator) + (numerator * otherDenominator). - d := otherDenominator * denominator. + n := (otherNumerator * denominator) + (numerator * otherDenominator). + d := otherDenominator * denominator. ]. - ^ aFraction class - numerator:n - denominator:d + ^ aFraction class + numerator:n + denominator:d " - (1/3) + (1/3) - (1/3) + (2/3) + (1/3) + (1/3) + (1/3) + (2/3) " ! sumFromInteger:anInteger "sent when an integer does not know how to add the receiver, a fraction" - ^ self class - numerator:(numerator + (anInteger * denominator)) - denominator:denominator + ^ self class + numerator:(numerator + (anInteger * denominator)) + denominator:denominator "Modified: 28.7.1997 / 19:08:40 / cg" ! ! @@ -998,19 +1003,19 @@ |t| PrintWholeNumbers == true ifTrue:[ - "/ experimental: print fractions which are greater than 1 as a sum of - "/ an integral and the fractional part. They are easier to read this way. - numerator > denominator ifTrue:[ - aStream nextPut:$(. - t := numerator // denominator. - t printOn:aStream. - aStream nextPutAll:'+('. - (numerator - (t*denominator)) printOn:aStream. - aStream nextPut:$/. - denominator printOn:aStream. - aStream nextPutAll:'))'. - ^ self - ]. + "/ experimental: print fractions which are greater than 1 as a sum of + "/ an integral and the fractional part. They are easier to read this way. + numerator > denominator ifTrue:[ + aStream nextPut:$(. + t := numerator // denominator. + t printOn:aStream. + aStream nextPutAll:'+('. + (numerator - (t*denominator)) printOn:aStream. + aStream nextPut:$/. + denominator printOn:aStream. + aStream nextPutAll:'))'. + ^ self + ]. ]. aStream nextPut:$(. @@ -1035,8 +1040,8 @@ den := denominator. den < 0 ifTrue:[ - numerator := numerator negated. - den := denominator := den negated. + numerator := numerator negated. + den := denominator := den negated. ]. den == 1 ifTrue:[^ numerator]. @@ -1045,12 +1050,12 @@ gcd := numerator gcd:den. (gcd ~~ 1) ifTrue:[ - gcd < 0 ifTrue:[ - gcd := gcd negated. - ]. - numerator := numerator // gcd. - denominator := den := den // gcd. - (den == 1) ifTrue:[^ numerator]. + gcd < 0 ifTrue:[ + gcd := gcd negated. + ]. + numerator := numerator // gcd. + denominator := den := den // gcd. + (den == 1) ifTrue:[^ numerator]. ]. ^ self ! @@ -1083,7 +1088,7 @@ "return true if the receiver is negative" (numerator < 0) ifTrue:[ - ^ (denominator < 0) not + ^ (denominator < 0) not ]. ^ (denominator < 0) ! ! @@ -1095,21 +1100,21 @@ such that (self truncated + self fractionPart) = self" numerator abs < denominator abs ifTrue:[ - ^ self + ^ self ]. ^ (numerator rem: denominator) / denominator " - (3/2) fractionPart + (3/2) truncated - (-3/2) fractionPart + (-3/2) truncated + (3/2) fractionPart + (3/2) truncated + (-3/2) fractionPart + (-3/2) truncated - (3/2) fractionPart - (-3/2) fractionPart - (3/2) asFloat fractionPart - (-3/2) asFloat fractionPart - (2/3) fractionPart - ((3/2)*(15/4)) fractionPart - ((2/3)*(4/15)) fractionPart + (3/2) fractionPart + (-3/2) fractionPart + (3/2) asFloat fractionPart + (-3/2) asFloat fractionPart + (2/3) fractionPart + ((3/2)*(15/4)) fractionPart + ((2/3)*(4/15)) fractionPart " "Modified: / 5.11.2001 / 17:55:25 / cg" @@ -1119,16 +1124,16 @@ "extract the pre-decimal integer part." numerator abs < denominator abs ifTrue:[ - ^ 0 + ^ 0 ]. ^ super integerPart " - (3/2) integerPart - (-3/2) integerPart - (2/3) integerPart - ((3/2)*(15/4)) integerPart - ((2/3)*(4/15)) integerPart + (3/2) integerPart + (-3/2) integerPart + (2/3) integerPart + ((3/2)*(15/4)) integerPart + ((2/3)*(4/15)) integerPart " "Modified: / 5.11.2001 / 17:55:01 / cg" @@ -1142,21 +1147,21 @@ |t| self negative ifTrue:[ - t := self - (1/2) + t := self - (1/2) ] ifFalse:[ - t := self + (1/2) + t := self + (1/2) ]. ^ t truncated. " - (1/3) rounded - (1/3) negated rounded - (1/2) rounded - (1/2) negated rounded - 0.5 rounded - -0.5 rounded - (2/3) rounded - (2/3) negated rounded + (1/3) rounded + (1/3) negated rounded + (1/2) rounded + (1/2) negated rounded + 0.5 rounded + -0.5 rounded + (2/3) rounded + (2/3) negated rounded " "Modified: 5.11.1996 / 11:32:32 / cg" @@ -1168,8 +1173,8 @@ ^ numerator quo: denominator " - (3/2) truncated - (3/2) negated truncated + (3/2) truncated + (3/2) negated truncated " "Modified: 5.11.1996 / 12:18:46 / cg" @@ -1186,11 +1191,11 @@ !Fraction class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.84 2014-11-06 16:41:42 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.86 2015-04-20 10:48:54 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.84 2014-11-06 16:41:42 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.86 2015-04-20 10:48:54 cg Exp $' ! !
--- a/LargeInteger.st Tue Apr 21 17:27:23 2015 +0100 +++ b/LargeInteger.st Wed Apr 22 07:33:07 2015 +0100 @@ -1553,7 +1553,7 @@ "return 8 bits of value, starting at byte index" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( ((STLargeInteger)self).digitAt( index.intValue() ) ); #endif %}. @@ -1565,7 +1565,7 @@ "set the 8 bits, index is a byte index" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ ERROR("cannot modify the digits of a LargeInteger"); #endif %}. @@ -1580,7 +1580,7 @@ |t digits| %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( ((STLargeInteger)self).digitByteAt( index.intValue() ) ); #endif %}. @@ -1615,7 +1615,7 @@ Least significant byte is first!!" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( ((STLargeInteger)self).digitBytes() ); #endif %}. @@ -1659,7 +1659,7 @@ |l "{ Class: SmallInteger }" | %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( ((STLargeInteger)self).digitLength() ); #endif %}. @@ -5390,7 +5390,7 @@ "return true, if the receiver is < 0" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( ((STLargeInteger)self).largeValue.signum() < 0 ? STObject.True : STObject.False); #endif %}. @@ -5409,7 +5409,7 @@ "return true, if the receiver is >= 0" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( ((STLargeInteger)self).largeValue.signum() >= 0 ? STObject.True : STObject.False); #endif %}. @@ -5420,7 +5420,7 @@ "return the sign of the receiver (-1, 0 or 1)" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( STInteger._new( ((STLargeInteger)self).largeValue.signum() )); #endif %}. @@ -5431,7 +5431,7 @@ "return true, if the receiver is > 0" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( ((STLargeInteger)self).largeValue.signum() > 0 ? STObject.True : STObject.False); #endif %}. @@ -5441,9 +5441,9 @@ !LargeInteger class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.224 2015-04-19 22:31:45 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.225 2015-04-20 10:48:54 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.224 2015-04-19 22:31:45 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.225 2015-04-20 10:48:54 cg Exp $' ! !
--- a/Object.st Tue Apr 21 17:27:23 2015 +0100 +++ b/Object.st Wed Apr 22 07:33:07 2015 +0100 @@ -808,7 +808,7 @@ This method should NOT be redefined in any subclass (except with great care, for tuning)" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ { int idx1Based = context.stArg(0).intValue(); // st index is 1 based return context.RETURN( self.basicAt( idx1Based )); @@ -1071,7 +1071,7 @@ break; } } -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ self indexNotIntegerOrOutOfBounds:index ! @@ -1084,7 +1084,7 @@ This method should NOT be redefined in any subclass (except with great care, for tuning)" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ { int idx1Based = context.stArg(0).intValue(); // st index is 1 based STObject val = context.stArg(1); @@ -1367,7 +1367,7 @@ break; } } -#endif /* ! JAVA */ +#endif /* ! __SCHTEAM__ */ %}. index isInteger ifFalse:[ " @@ -1548,7 +1548,9 @@ - use with care (needed for copy, inspector etc.)" %{ /* NOCONTEXT */ - +#ifdef __SCHTEAM__ + return context._RETURN( self.instVarAt(index.intValue()-1) ); +#else OBJ myClass; int idx, ninstvars; @@ -1570,6 +1572,7 @@ RETURN ( __InstPtr(self)->i_instvars[idx] ); } } +#endif /* not SCHTEAM */ %}. ^ self indexNotIntegerOrOutOfBounds:index ! @@ -1580,7 +1583,10 @@ - use with care (needed for copy, inspector etc.)" %{ /* NOCONTEXT */ - +#ifdef __SCHTEAM__ + self.instVarAt_put(index.intValue()-1, value); + return context._RETURN( value ); +#else OBJ myClass; int idx, ninstvars; @@ -1604,6 +1610,7 @@ RETURN ( value ); } } +#endif /* not SCHTEAM */ %}. ^ self indexNotIntegerOrOutOfBounds:index ! @@ -1715,7 +1722,9 @@ ! nilAllInstvars - "overwrite all inst vars of the object with nil." + "overwrite all inst vars of the object with nil. + Used by the crypto package to clear objects with + keys when no longer in use." %{ /* NOCONTEXT */ int flags; @@ -2067,7 +2076,7 @@ - redefining it may not work as expected." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( (self == context.stArg(0)) ? STObject.True : STObject.False ); #else RETURN ( (self == anObject) ? true : false ); @@ -2294,7 +2303,7 @@ - redefining it may not work as expected." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( (self == context.stArg(0)) ? STObject.False : STObject.True ); #else RETURN ( (self == anObject) ? false : true ); @@ -5490,7 +5499,8 @@ <resource: #skipInDebuggersWalkBack> %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ + return context.PERFORM(self, aSelector); #else REGISTER OBJ sel = aSelector; int hash0; @@ -5562,7 +5572,7 @@ static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1); RETURN (_SEND0(self, aSelector, nil, &ilc0)); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ self perform:aSelector withArguments:#() ! @@ -5592,7 +5602,7 @@ ^ nil ]. %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ #else REGISTER OBJ *argP; int nargs, i; @@ -5763,7 +5773,7 @@ } bad:; -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. "/ arrive here, if bad number of arguments (too many) "/ ST/X (currently) only allows up to 15 method arguments @@ -5775,7 +5785,8 @@ "send the one-arg-message aSelector to the receiver" %{ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ + return context.PERFORM_WITH(self, aSelector, arg); #else REGISTER OBJ sel = aSelector; int hash0; @@ -5849,7 +5860,7 @@ static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1); RETURN (_SEND1(self, aSelector, nil, &ilc1, arg)); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ self perform:aSelector withArguments:(Array with:arg) ! @@ -5858,8 +5869,6 @@ "send the two-arg-message aSelector to the receiver" %{ -#ifndef __JAVA__ -#else REGISTER OBJ sel = aSelector; struct inlineCache *pIlc; int hash0; @@ -5932,7 +5941,6 @@ static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1); RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2)); } -#endif /* not JAVA */ %}. ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2) ! @@ -5941,8 +5949,6 @@ "send the three-arg-message aSelector to the receiver" %{ -#ifndef __JAVA__ -#else struct inlineCache *pIlc; static struct inlineCache ilc_0 = __ILCPERF3(@line); static struct inlineCache ilc_1 = __ILCPERF3(@line); @@ -5978,7 +5984,6 @@ static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1); RETURN (_SEND3(self, aSelector, nil, &ilc3, arg1, arg2, arg3)); } -#endif %}. ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3) @@ -6132,6 +6137,9 @@ |numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15| %{ +#ifdef __SCHTEAM__ + return context.PERFORM_WITH_ARGUMENTS(self, aSelector, argArray); +#else REGISTER OBJ *argP; int nargs; OBJ l; @@ -6531,6 +6539,7 @@ } } bad:; +#endif %}. "/ arrive here, if bad number of arguments (too many) @@ -7732,7 +7741,7 @@ This method should NOT be redefined in any subclass (except with great care, for tuning)" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context.RETURN( STInteger._new( self.basicSize() ) ); #else REGISTER INT nbytes; @@ -7787,7 +7796,7 @@ nbytes -= nInstBytes; RETURN ( __mkSmallInteger(nbytes>>3) ); /* notice the hardcoded 8 here - not sizeof(long long) */ } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ 0 ! @@ -7851,7 +7860,7 @@ "return the receivers class" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN(self.clazz()); #else RETURN ( __Class(self) ); @@ -10259,11 +10268,11 @@ !Object class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.797 2015-04-19 13:55:32 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.800 2015-04-21 19:40:51 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.797 2015-04-19 13:55:32 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.800 2015-04-21 19:40:51 cg Exp $' ! version_HG
--- a/SmallInteger.st Tue Apr 21 17:27:23 2015 +0100 +++ b/SmallInteger.st Wed Apr 22 07:33:07 2015 +0100 @@ -114,7 +114,7 @@ For very special uses only - not constant across implementations" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ // longs are always 64bits return context._RETURN ( STInteger._new(64) ); #else @@ -131,7 +131,7 @@ For very special uses only - not constant across implementations" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ // longs are always 8 bytes return context._RETURN ( STInteger._new(8) ); #else @@ -148,7 +148,7 @@ For very special uses only - not constant across implementations" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN ( STInteger._MAX_INTVAL ); #else RETURN ( __mkSmallInteger(_MAX_INT) ); @@ -164,7 +164,7 @@ For very special uses only - not constant across implementations" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN ( STInteger._MIN_INTVAL ); #else RETURN ( __mkSmallInteger(_MIN_INT) ); @@ -213,7 +213,7 @@ "return the product of the receiver and the argument" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.times( aNumber )); #else /* @@ -407,7 +407,7 @@ __qMKSFLOAT(newFloat, val); RETURN ( newFloat ); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ aNumber productFromInteger:self ! @@ -416,7 +416,7 @@ "return the sum of the receivers value and the arguments value" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.plus( aNumber )); #else /* @@ -456,7 +456,7 @@ __qMKSFLOAT(newFloat, val); RETURN ( newFloat ); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ aNumber sumFromInteger:self ! @@ -465,7 +465,7 @@ "return the difference of the receivers value and the arguments value" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.minus( aNumber )); #else /* @@ -505,7 +505,7 @@ __qMKSFLOAT(newFloat, val); RETURN ( newFloat ); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ aNumber differenceFromInteger:self ! @@ -514,7 +514,7 @@ "return the quotient of the receivers value and the arguments value" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.quotient( aNumber )); #else @@ -564,7 +564,7 @@ } } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. aNumber isInteger ifTrue:[ aNumber == 0 ifTrue:[ @@ -603,7 +603,7 @@ See #quo: which returns -2 in the above case and #rem: which is the corresponding remainder." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.quotientTruncated( aNumber )); #else /* @@ -669,7 +669,7 @@ } } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. (aNumber = 0) ifTrue:[ ^ ZeroDivide raiseRequestWith:thisContext. @@ -717,7 +717,7 @@ Redefined here for speed." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.remainder( aNumber )); #else /* @@ -756,7 +756,7 @@ } RETURN ( __mkSmallInteger(rem) ); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. (aNumber = 0) ifTrue:[ ^ ZeroDivide raiseRequestWith:thisContext. @@ -781,7 +781,7 @@ reimplemented here for speed" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.abs()); #else INT val = __intVal(self); @@ -804,7 +804,7 @@ reimplemented here for speed" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.negated()); #else INT val = __intVal(self); @@ -833,7 +833,7 @@ in contrast: '9 quo: 4 = 2' and '-9 quo: 4 = -2'" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.quotient(aNumber)); #else INT val; @@ -859,7 +859,7 @@ } } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. (aNumber = 0) ifTrue:[ ^ ZeroDivide raiseRequestWith:thisContext. @@ -881,14 +881,14 @@ "return the bitwise-and of the receiver and the argument, anInteger" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.bitAnd(anInteger)); #else /* anding the tags doesn't change it */ if (__isSmallInteger(anInteger)) { RETURN ( ((OBJ) ((INT)self & (INT)anInteger)) ); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. anInteger class == LargeInteger ifTrue:[ ^ anInteger bitAnd:self @@ -905,7 +905,7 @@ is free to choose any internal representation for integers)" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.bitAt(anIntegerIndex)); #else if (__isSmallInteger(anIntegerIndex)) { @@ -917,7 +917,7 @@ RETURN((__smallIntegerVal(self) & (1 << (idx-1))) ? __mkSmallInteger(1) : __mkSmallInteger(0)); } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ SubscriptOutOfBoundsError @@ -958,14 +958,14 @@ returning the receiver with bits of the argument cleared." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.bitClear(anInteger)); #else /* anding the tags doesn't change it */ if (__isSmallInteger(anInteger)) { RETURN ( ((OBJ) (((INT)self & ~(INT)anInteger) | TAG_INT)) ); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ self retry:#bitClear: coercing:anInteger @@ -979,7 +979,7 @@ "return the number of 1-bits in the receiver" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ unsigned int _cnt; unsigned INT _self = __intVal(self); @@ -1034,7 +1034,7 @@ # endif RETURN ( __MKSMALLINT(_cnt)); -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super bitCount. @@ -1070,7 +1070,7 @@ "return the value of the receiver with all bits inverted" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ #else /* invert anything except tag bits */ RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) ); @@ -1083,7 +1083,7 @@ "return the bitwise-or of the receiver and the argument, anInteger" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.bitOr( anInteger )); #else /* oring the tags doesn't change it */ @@ -1111,7 +1111,7 @@ However, ST/X preserves the sign." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.bitShift( shiftCount )); #else INT bits, count; @@ -1175,7 +1175,7 @@ RETURN ( __mkSmallInteger(bits >> count) ); } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. (shiftCount isMemberOf:SmallInteger) ifTrue:[ ^ (LargeInteger value:self) bitShift:shiftCount @@ -1189,7 +1189,7 @@ is non-0, false otherwise." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( ( self.bitAnd( aMask ) == STInteger._0 ) ? STObject.False : STObject.True ); @@ -1199,7 +1199,7 @@ if (__isSmallInteger(aMask)) { RETURN ( ((INT)self & ((INT)aMask & ~TAG_MASK)) ? true : false ); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. aMask class == LargeInteger ifTrue:[ ^ (aMask bitAnd:self) ~~ 0 @@ -1221,14 +1221,14 @@ "return the bitwise-exclusive-or of the receiver and the argument, anInteger" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.bitXor( anInteger )); #else /* xoring the tags turns it off - or it in again */ if (__isSmallInteger(anInteger)) { RETURN ( (OBJ)( ((INT)self ^ (INT)anInteger) | TAG_INT) ); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ self retry:#bitXor: coercing:anInteger ! @@ -1240,7 +1240,7 @@ but a new number is returned. Should be named #withBitCleared:" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ #else if (__isSmallInteger(anInteger)) { int index = __intVal(anInteger); @@ -1259,7 +1259,7 @@ RETURN (self); /* nothing to do ... */ } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super clearBit:anInteger @@ -1287,7 +1287,7 @@ Returns 0 if no bit is set." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ { long bits = self.longValue(); int bitNr = 0; @@ -1359,7 +1359,7 @@ # endif /* no BSR instruction */ RETURN ( __mkSmallInteger(index+1) ); -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super highBit @@ -1423,7 +1423,7 @@ but a new number is returned. Should be named #withBitInverted:" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ #else if (__isSmallInteger(anInteger)) { int index = __intVal(anInteger); @@ -1441,7 +1441,7 @@ } } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super invertBit:anInteger @@ -1465,7 +1465,7 @@ Returns 0 if no bit is set." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ #else unsigned INT bits; int index; @@ -1512,7 +1512,7 @@ # endif RETURN ( __mkSmallInteger(index) ); -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super lowBit @@ -1565,7 +1565,7 @@ However, ST/X preserves the sign." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ #else INT bits, count; @@ -1628,7 +1628,7 @@ RETURN ( __mkSmallInteger(bits >> count) ); } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. (shiftCount isMemberOf:SmallInteger) ifTrue:[ ^ (LargeInteger value:self) rightShift:shiftCount @@ -1649,7 +1649,7 @@ but a new number is returned. Should be named #withBitSet:" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ #else if (__isSmallInteger(anInteger)) { int index = __intVal(anInteger); @@ -1667,7 +1667,7 @@ } } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super setBit:anInteger @@ -1710,7 +1710,7 @@ i.e. a.b -> b.a" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ unsigned INT v = __intVal(self); unsigned INT swapped; @@ -1733,7 +1733,7 @@ i.e. a.b.c.d -> d.c.b.a" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ unsigned INT v = __intVal(self); unsigned INT swapped; @@ -1791,7 +1791,7 @@ # endif RETURN (__MKUINT(swapped)); -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super byteSwapped32 @@ -1809,7 +1809,7 @@ i.e. a.b.c.d.e.f.g.h -> h.g.f.e.d.c.b.a" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ unsigned INT v = __intVal(self); unsigned INT swapped; @@ -1846,7 +1846,7 @@ "return 8 bits of value, starting at byte index" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ int idx = index.intValue() - 1; if (idx <= 7) { @@ -1896,7 +1896,7 @@ RETURN ( __mkSmallInteger( val & 0xFF) ); } bad: ; -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. index > 0 ifFalse:[ " @@ -1921,7 +1921,7 @@ for negative ones, the actual bit representation is returned." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ REGISTER INT val; INT idx; @@ -1964,7 +1964,7 @@ RETURN ( __mkSmallInteger( val & 0xFF) ); } bad: ; -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. index > 0 ifFalse:[ " @@ -2204,7 +2204,7 @@ is returned." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT val = __intVal(self); if (val < 0) { @@ -2269,7 +2269,7 @@ This case is handled in the superclass." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ unsigned INT v = __intVal(self); if ((INT)v >= 0) { @@ -2346,7 +2346,7 @@ Redefined for performance (machine can do it faster)" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( STDouble._new((double)(self.longValue())) ); #else OBJ newFloat; @@ -2370,7 +2370,7 @@ Redefined for performance (machine can do it faster)" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( STFloat._new((float)(self.longValue())) ); #else OBJ dummy = @global(ShortFloat); @@ -2408,7 +2408,7 @@ May be useful for communication interfaces" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT i = __intVal(self); if (i & 0x800000) { @@ -2434,7 +2434,7 @@ May be useful for communication interfaces" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT i = __intVal(self); if (i & 0x80) { @@ -2460,7 +2460,7 @@ May be useful for communication interfaces" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT i = __intVal(self); if (i & 0x80000000) { @@ -2486,7 +2486,7 @@ May be useful for communication interfaces" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT i = __intVal(self); if (i & 0x8000) { @@ -2513,7 +2513,7 @@ "return true, if the argument is greater than the receiver" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.ltP( aNumber )); #else if (__isSmallInteger(aNumber)) { @@ -2537,7 +2537,7 @@ "return true, if the argument is greater or equal" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.leP( aNumber )); #else @@ -2564,7 +2564,7 @@ as the receiver, false otherwise" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.eqP( aNumber )); #else @@ -2591,7 +2591,7 @@ "return true, if the argument is less than the receiver" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.gtP( aNumber )); #else @@ -2617,7 +2617,7 @@ "return true, if the argument is less or equal" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.geP( aNumber )); #else @@ -2677,7 +2677,7 @@ "return the receiver or the argument, whichever is greater" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ if (__isSmallInteger(aNumber)) { # if TAG_INT == 1 @@ -2709,7 +2709,7 @@ "return the receiver or the argument, whichever is smaller" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ if (__isSmallInteger(aNumber)) { # if TAG_INT == 1 @@ -2741,7 +2741,7 @@ "return true, if the arguments value is not equal to mine" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( (self.eqP( aNumber ) == STObject.True) ? STObject.False : STObject.True); /* NOTREACHED */ #else @@ -2803,7 +2803,7 @@ Reimplemented as primitive for speed" %{ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ REGISTER INT tmp; static struct inlineCache blockVal = __ILC0(0); @@ -2986,7 +2986,7 @@ "reimplemented as primitive for speed" %{ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ REGISTER INT tmp, step; REGISTER INT final; static struct inlineCache blockVal = __ILC1(0); @@ -3201,7 +3201,7 @@ Reimplemented as primitive for speed" %{ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ REGISTER INT tmp; INT final; static struct inlineCache blockVal = __ILC1(0); @@ -3475,7 +3475,7 @@ } RETURN ( self ); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. "/ @@ -3565,7 +3565,7 @@ This is redefined here for more performance" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT val, div, mod, mySelf; if (__isSmallInteger(aNumber) @@ -3616,7 +3616,7 @@ some code. (thanx to MessageTally)" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ if (__isSmallInteger(anInteger)) { INT orgArg, ttt, selfInt, orgSelfInt, temp; @@ -3725,7 +3725,7 @@ or control systems, which represent numbers this way..." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ int i; INT _10000000s = 0, _1000000s = 0; INT _100000s = 0, _10000s = 0, _1000s = 0; @@ -3833,7 +3833,7 @@ upon the printOn: method." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( new STString( java.lang.Long.toString(self.longValue()) )); #else char buffer[30]; /* enough for 64 bit machines */ @@ -3887,7 +3887,7 @@ if (newString != nil) { RETURN (newString); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. "/ only arrive here, "/ when having memory problems (i.e. no space for string) ... @@ -3913,7 +3913,7 @@ |s| %{ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ char buffer[64+3]; /* for 64bit machines, base 2, plus sign, plus 0-byte */ char *cp; OBJ newString; @@ -3992,7 +3992,7 @@ } # endif } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. "/ arrive here, for bad base, "/ or when having memory problems (i.e. no space for string) ... @@ -4043,7 +4043,7 @@ Please use the printf: method, which is safe as it is completely implemented in Smalltalk." %{ /* STACK: 400 */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ char buffer[256]; OBJ s; int len; @@ -4068,7 +4068,7 @@ } } fail: ; -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. self primitiveFailed @@ -4114,7 +4114,7 @@ This is of course not always correct, but allows for C/Java behavior to be emulated." %{ /* NOCONTEXT */ -#ifndef _JAVA__ +#ifndef __SCHTEAM__ INT sum; sum = __unsignedLongIntVal(self) + __unsignedLongIntVal(aNumber); @@ -4122,7 +4122,7 @@ sum &= 0xFFFFFFFFL; # endif RETURN ( __MKUINT(sum)); -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. self primitiveFailed @@ -4141,8 +4141,15 @@ and can therefore speed things up by not going through LargeIntegers." %{ /* NOCONTEXT */ -#ifndef _JAVA__ - +#ifdef __SCHTEAM__ + { + long myValue = self.longValue(); + long otherValue = aNumber.longValue(); + long sum = myValue + otherValue; + return context._RETURN( STInteger._new(sum) ); + } + /* NOT REACHED */ +#else if (__isSmallInteger(aNumber)) { INT sum; @@ -4175,7 +4182,15 @@ and can therefore speed things up by not going through LargeIntegers." %{ /* NOCONTEXT */ -#ifndef _JAVA__ +#ifdef __SCHTEAM__ + { + long myValue = self.longValue(); + long otherValue = aNumber.longValue(); + long diference = myValue - otherValue; + return context._RETURN( STInteger._new(diference) ); + } + /* NOT REACHED */ +#else if (__isSmallInteger(aNumber)) { INT diff; @@ -4209,8 +4224,15 @@ and can therefore speed things up by not going through LargeIntegers." %{ /* NOCONTEXT */ -#ifndef _JAVA__ - +#ifdef __SCHTEAM__ + { + long myValue = self.longValue(); + long otherValue = aNumber.longValue(); + long product = myValue * otherValue; + return context._RETURN( STInteger._new(product) ); + } + /* NOT REACHED */ +#else INT myValue, otherValue; unsigned INT productLow, productHi; int negative; @@ -4359,7 +4381,7 @@ RETURN ( __mkSmallInteger((INT)(productLow & _MAX_INT))); # endif /* ! USE_LONGLONG */ } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. self primitiveFailed @@ -4380,7 +4402,7 @@ (changes the sign)" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ unsigned INT v; v = __intVal(self); @@ -4407,7 +4429,7 @@ Useful for crypt algorithms, or to emulate C/Java semantics." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ unsigned INT bits; int count; @@ -4454,7 +4476,7 @@ or to emulate C/Java semantics." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT bits, count; @@ -4495,7 +4517,7 @@ This is of course not always correct, but allows for C/Java behavior to be emulated." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT rslt; rslt = __unsignedLongIntVal(self) ^ __unsignedLongIntVal(aNumber); @@ -4521,7 +4543,7 @@ or to emulate C/Java semantics." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ unsigned INT bits; INT count; @@ -4567,7 +4589,7 @@ - reimplemented here for speed" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ if (__bothSmallInteger(min, max)) { # if TAG_INT == 1 @@ -4603,7 +4625,7 @@ "return true, if the receiver is even" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? false : true ); #endif %}. @@ -4639,7 +4661,7 @@ reimplemented here for speed" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.ltP(0) ); /* NOTREACHED */ #else @@ -4659,7 +4681,7 @@ Useful for padding." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT x; x = __intVal(self) - 1; @@ -4697,7 +4719,7 @@ "return true, if the receiver is odd" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? true : false ); #endif %}. @@ -4711,7 +4733,7 @@ Undefined for negative values (smalltalk does not require the machine to use 2's complement)" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ // tricky, but very fast (google for it, to understand) # if __POINTER_SIZE__ == 4 @@ -4749,7 +4771,7 @@ reimplemented here for speed" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( (self.ltP(0) == STObject.True) ? STObject.False : STObject.True); #else @@ -4770,7 +4792,7 @@ reimplemented here for speed" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ INT val = __intVal(self); @@ -4791,7 +4813,7 @@ reimplemented here for speed" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ # if TAG_INT == 1 /* tag bit does not change sign */ @@ -4813,11 +4835,11 @@ !SmallInteger class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.231 2015-04-19 22:55:08 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.233 2015-04-21 19:41:11 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.231 2015-04-19 22:55:08 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.233 2015-04-21 19:41:11 cg Exp $' ! !
--- a/Smalltalk.st Tue Apr 21 17:27:23 2015 +0100 +++ b/Smalltalk.st Wed Apr 22 07:33:07 2015 +0100 @@ -69,130 +69,130 @@ [Instance variables:] - none - all handling is done in the VM + none - all handling is done in the VM [Class variables:] - StartBlocks <Collection> blocks to be executed in a separate process after - everything has been initialized. These blocks will - be deleted after execution and therefore not be - executed after an image restart. Initial processes - (such as the Launcher) are usually started here. - These blocks are added by smalltalk.rc/private.rc etc. - via #addStartBlock during early initialization. - - ImageStartBlocks - <Collection> blocks to be executed in a separate process after - everything has been initialized. These blocks will be - executed after an image restart. - These blocks are usually added by smalltalk_r.rc etc. - - ExitBlocks <Collection> blocks to evaluate before system is - left. Not currently used (GNU-ST compatibility). - - SystemPath <Collection> path to search for system files (sources, bitmaps etc) - Set to a default here, but typically changed from some - startup.rc file - - PackagePath <Collection> path to search for package. - This is going to replace the above systemPath, and a classes - resources will eventually searched in its package directory. - This list defines the path, where packages are searched for, - initially this is something like /opt/smalltalk/packages. - Set to a default here, but typically changed from some - startup.rc file - - StartupClass <Class> class and selector, where the system starts up - StartupSelector <Symbol> (right after VM initialization) - StartupArguments <Array> If an image is saved while those being nonNil, - the image will come up there. - Allows for customized images to be generated from a standard ST/X. - StandAlone programs also set those during initialization. - - CommandLine <String> Unix (OS-) command line - - CommandName <String> the command (i.e. argv[0]) - - CommandLineArguments <Array> Unix (OS-) command line arguments broken into words - CommandName has been stripped off. - (initially set by the VM) - - SilentLoading <Boolean> OBSOLETE: - suppresses messages during fileIn and in compiler - (can be set to true from a customized main.c) - - VerboseLoading <Boolean> generate messages during fileIn and in compiler - (can be set to true from a customized main.c) - - Initializing <Boolean> true while (re-)initializing - Controls the behavior of certain error - reporters (for example: suppress dialogBoxes) - while the system is not yet fit for full operation. - - StandAlone <Boolean> true, if this is a standalone app; - if true the process scheduler watches for - which processes are still running, and - exits ST/X, when the last non-background - and non-system process exits. - Can be set in an application-specific startup script, - or, for standAlone programs, by C-code during initialization. - - HeadlessOperation if true, a non-existing Display connection - <Boolean> will NOT lead to an error-exit during startup. - Default is false. - Can be set in an application-specific startup script, - or, for standAlone programs, by C-code during initialization. - - LogDoits <Boolean> if true, doits are also logged in the changes - file. Default is false, since the changes file - may become huge if every tiny doIt is saved there ... - - LoadBinaries <Boolean> if true, we attempt to load classes rom a binary - file, if present. If false, this is always suppressed. - - SaveEmergencyImage <Boolean> if true (the default), an emergency image - is saved, if the main Display looses its - connection. This is useful if you have a - flaky display connection (serial line) - and want to have your stuff saved automatically - in case of a broken connection. - - IgnoreAssertions <Boolean> if true, assertions are ignored (i.e. no errors reported). - Usually false in the development system, true in a standalone deployed app. + StartBlocks <Collection> blocks to be executed in a separate process after + everything has been initialized. These blocks will + be deleted after execution and therefore not be + executed after an image restart. Initial processes + (such as the Launcher) are usually started here. + These blocks are added by smalltalk.rc/private.rc etc. + via #addStartBlock during early initialization. + + ImageStartBlocks + <Collection> blocks to be executed in a separate process after + everything has been initialized. These blocks will be + executed after an image restart. + These blocks are usually added by smalltalk_r.rc etc. + + ExitBlocks <Collection> blocks to evaluate before system is + left. Not currently used (GNU-ST compatibility). + + SystemPath <Collection> path to search for system files (sources, bitmaps etc) + Set to a default here, but typically changed from some + startup.rc file + + PackagePath <Collection> path to search for package. + This is going to replace the above systemPath, and a classes + resources will eventually searched in its package directory. + This list defines the path, where packages are searched for, + initially this is something like /opt/smalltalk/packages. + Set to a default here, but typically changed from some + startup.rc file + + StartupClass <Class> class and selector, where the system starts up + StartupSelector <Symbol> (right after VM initialization) + StartupArguments <Array> If an image is saved while those being nonNil, + the image will come up there. + Allows for customized images to be generated from a standard ST/X. + StandAlone programs also set those during initialization. + + CommandLine <String> Unix (OS-) command line + + CommandName <String> the command (i.e. argv[0]) + + CommandLineArguments <Array> Unix (OS-) command line arguments broken into words + CommandName has been stripped off. + (initially set by the VM) + + SilentLoading <Boolean> OBSOLETE: + suppresses messages during fileIn and in compiler + (can be set to true from a customized main.c) + + VerboseLoading <Boolean> generate messages during fileIn and in compiler + (can be set to true from a customized main.c) + + Initializing <Boolean> true while (re-)initializing + Controls the behavior of certain error + reporters (for example: suppress dialogBoxes) + while the system is not yet fit for full operation. + + StandAlone <Boolean> true, if this is a standalone app; + if true the process scheduler watches for + which processes are still running, and + exits ST/X, when the last non-background + and non-system process exits. + Can be set in an application-specific startup script, + or, for standAlone programs, by C-code during initialization. + + HeadlessOperation if true, a non-existing Display connection + <Boolean> will NOT lead to an error-exit during startup. + Default is false. + Can be set in an application-specific startup script, + or, for standAlone programs, by C-code during initialization. + + LogDoits <Boolean> if true, doits are also logged in the changes + file. Default is false, since the changes file + may become huge if every tiny doIt is saved there ... + + LoadBinaries <Boolean> if true, we attempt to load classes rom a binary + file, if present. If false, this is always suppressed. + + SaveEmergencyImage <Boolean> if true (the default), an emergency image + is saved, if the main Display looses its + connection. This is useful if you have a + flaky display connection (serial line) + and want to have your stuff saved automatically + in case of a broken connection. + + IgnoreAssertions <Boolean> if true, assertions are ignored (i.e. no errors reported). + Usually false in the development system, true in a standalone deployed app. strictly private classVariables (helpers): - CachedClasses <Collection> known classes (cached for faster class enumeration) - - CachedAbbreviations - <Dictionary> className to filename mappings - - RealSystemPath <Collection> cached collection of directories along the path - which really exist. Caching avoids long checks - for existing directories on broken NFS volumes. - - SourcePath <Collection> cached names of really existing directories - These are remembered, as in NFS systems, - ResourcePath the time to lookup files may become long - BinaryPath (especially, if some directories are on machines - FileInPath which are not up ...). - Therefore, the set of really - existing directories is cached when the SystemPath - is walked the first time. - A consequence is that you have to invoke - flushSystemPath, when you create any of those - directories while running - (and want the running ST/X to look there) + CachedClasses <Collection> known classes (cached for faster class enumeration) + + CachedAbbreviations + <Dictionary> className to filename mappings + + RealSystemPath <Collection> cached collection of directories along the path + which really exist. Caching avoids long checks + for existing directories on broken NFS volumes. + + SourcePath <Collection> cached names of really existing directories + These are remembered, as in NFS systems, + ResourcePath the time to lookup files may become long + BinaryPath (especially, if some directories are on machines + FileInPath which are not up ...). + Therefore, the set of really + existing directories is cached when the SystemPath + is walked the first time. + A consequence is that you have to invoke + flushSystemPath, when you create any of those + directories while running + (and want the running ST/X to look there) [author:] - Claus Gittinger + Claus Gittinger [see also:] - ObjectMemory - StandaloneStartup - GetOpt - ReadEvalPrintLoop + ObjectMemory + StandaloneStartup + GetOpt + ReadEvalPrintLoop " ! @@ -232,17 +232,17 @@ right after startup, usually immediately followed by Smalltalk>>start. Notice: - this is NOT called when an image is restarted; in this - case the show starts in Smalltalk>>restart." + this is NOT called when an image is restarted; in this + case the show starts in Smalltalk>>restart." Compiler := ByteCodeCompiler. Compiler isNil ifTrue:[ - " - ByteCodeCompiler is not in the system (i.e. has not been linked in) - this allows at least immediate evaluations for runtime systems without compiler - NOTICE: a parser is always needed, otherwise we cannot read resource files etc. - " - Compiler := Parser + " + ByteCodeCompiler is not in the system (i.e. has not been linked in) + this allows at least immediate evaluations for runtime systems without compiler + NOTICE: a parser is always needed, otherwise we cannot read resource files etc. + " + Compiler := Parser ]. "/ @@ -280,7 +280,7 @@ "/ in case, someone needs the objectFileLoader early "/ ObjectFileLoader notNil ifTrue:[ - ObjectFileLoader initialize. + ObjectFileLoader initialize. ]. "/ @@ -297,7 +297,7 @@ "/ flush them here, so they are reread in any case. "/ required for some apps, for example to show the menu correctly (see launcher's help menu) ApplicationModel notNil ifTrue:[ - ApplicationModel flushAllClassResources. + ApplicationModel flushAllClassResources. ]. "/ @@ -602,8 +602,8 @@ Here, a few specific initializations are done, then the actual initialization is done inside an error handler in basicInitializeSystem. Notice: - this is NOT called when an image is restarted; - in this case the show starts in Smalltalk>>restart." + this is NOT called when an image is restarted; + in this case the show starts in Smalltalk>>restart." |idx| @@ -613,7 +613,7 @@ AbstractOperatingSystem initializeConcreteClass. CommandLineArguments isNil ifTrue:[ - CommandLineArguments := #('stx'). + CommandLineArguments := #('stx'). ]. CommandLine := CommandLineArguments copy. CommandLineArguments := CommandLineArguments asOrderedCollection. @@ -625,42 +625,42 @@ DebuggingStandAlone := false. StandAlone ifTrue:[ - InfoPrinting := false. - ObjectMemory infoPrinting:false. - IgnoreAssertions := true. - - idx := CommandLineArguments indexOf:'--debug'. - idx ~~ 0 ifTrue:[ - DebuggingStandAlone := true. - ]. - DebuggingStandAlone ifTrue:[ - Inspector := MiniInspector. - Debugger := MiniDebugger. - IgnoreAssertions := false. - ]. + InfoPrinting := false. + ObjectMemory infoPrinting:false. + IgnoreAssertions := true. + + idx := CommandLineArguments indexOf:'--debug'. + idx ~~ 0 ifTrue:[ + DebuggingStandAlone := true. + ]. + DebuggingStandAlone ifTrue:[ + Inspector := MiniInspector. + Debugger := MiniDebugger. + IgnoreAssertions := false. + ]. ] ifFalse:[ - "/ - "/ define low-level debugging tools - graphical classes are not prepared yet - "/ to handle things. - "/ This will bring us into the MiniDebugger when an error occurs during startup. - "/ - Inspector := MiniInspector. - Debugger := MiniDebugger. - IgnoreAssertions := true. + "/ + "/ define low-level debugging tools - graphical classes are not prepared yet + "/ to handle things. + "/ This will bring us into the MiniDebugger when an error occurs during startup. + "/ + Inspector := MiniInspector. + Debugger := MiniDebugger. + IgnoreAssertions := false. ]. Error handle:[:ex | - StandAlone ifTrue:[ - DebuggingStandAlone ifFalse:[ - 'Startup Error - use --debug command line argument for more info' errorPrintCR. - Smalltalk exit:1. - ]. - 'Startup Error' errorPrintCR. - thisContext fullPrintAll. - ]. - ex reject. + StandAlone ifTrue:[ + DebuggingStandAlone ifFalse:[ + 'Startup Error - use --debug command line argument for more info' errorPrintCR. + Smalltalk exit:1. + ]. + 'Startup Error' errorPrintCR. + thisContext fullPrintAll. + ]. + ex reject. ] do:[ - self basicInitializeSystem + self basicInitializeSystem ]. "Modified: / 12-10-2010 / 11:27:47 / cg" @@ -672,6 +672,7 @@ Especially, the whole display/viewing stuff and process escheduling is not working correctly until initialized." + Initializing isNil ifTrue:[^ false]. "/ if called very early ^ Initializing not ! @@ -779,8 +780,8 @@ | oldClass | (oldClass := self at: aName asSymbol ifAbsent: [nil]) isNil ifTrue:[ - Transcript showCR: 'Removal of class named ', aName, ' ignored because it does not exist.'. - ^ self + Transcript showCR: 'Removal of class named ', aName, ' ignored because it does not exist.'. + ^ self ]. oldClass removeFromSystem ! ! @@ -2473,7 +2474,7 @@ "/ a little convenience: so you can stx packages with loadPackage:'goodies/soap' (packageString includes:$:) ifFalse:[ - packageString := 'stx:',packageString. + packageString := 'stx:',packageString. ]. "if I am here, so must my package" @@ -2484,25 +2485,25 @@ "/ if there is a projectDefinition, let it load itself... def := packageId projectDefinitionClass. (def notNil and:[def isLoaded]) ifTrue:[ - def loadAsAutoloaded:doLoadAsAutoloaded. - ^ true. + def loadAsAutoloaded:doLoadAsAutoloaded. + ^ true. ]. packageDir := self packageDirectoryForPackageId:packageId. [ - self - loadPackage:packageString - fromDirectory:packageDir - asAutoloaded:doLoadAsAutoloaded. + self + loadPackage:packageString + fromDirectory:packageDir + asAutoloaded:doLoadAsAutoloaded. ] on:PackageLoadError do:[:ex| - AbstractSourceCodeManager notNil ifTrue:[ - sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage:packageString. - sourceCodeManager notNil ifTrue:[ - ^ sourceCodeManager loadPackageWithId:packageString fromRepositoryAsAutoloaded:doLoadAsAutoloaded - ]. - ]. - ex reject. + AbstractSourceCodeManager notNil ifTrue:[ + sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage:packageString. + sourceCodeManager notNil ifTrue:[ + ^ sourceCodeManager loadPackageWithId:packageString fromRepositoryAsAutoloaded:doLoadAsAutoloaded + ]. + ]. + ex reject. ]. ^ true @@ -5078,21 +5079,21 @@ |dirsConsulted| LoadInProgressQuery answerNotifyLoadingDo:[ - dirsConsulted := Set new. - - "/ along the package-path - self packagePath do:[:eachPathComponent | - (dirsConsulted includes:eachPathComponent) ifFalse:[ - self - recursiveInstallAutoloadedClassesFrom:eachPathComponent - rememberIn:dirsConsulted - maxLevels:15 - noAutoload:false - packageTop:eachPathComponent - showSplashInLevels:2. - ] - ]. - self splashInfo:nil. + dirsConsulted := Set new. + + "/ along the package-path + self packagePath do:[:eachPathComponent | + (dirsConsulted includes:eachPathComponent) ifFalse:[ + self + recursiveInstallAutoloadedClassesFrom:eachPathComponent + rememberIn:dirsConsulted + maxLevels:15 + noAutoload:false + packageTop:eachPathComponent + showSplashInLevels:2. + ] + ]. + self splashInfo:nil. ]. " @@ -5838,315 +5839,315 @@ ClassLoadInProgressQuery answerNotifyLoading:aClassName do:[ - wasLazy := Compiler compileLazy:loadLazy. - beSilent notNil ifTrue:[ - wasSilent := self silentLoading:beSilent. - ]. - - classFileName := Smalltalk fileNameForClass:aClassName. - (classFileName = aClassName) ifTrue:[ - "/ no abbrev.stc translation for className - (aClassName includes:$:) ifTrue:[ - "/ a nameSpace name - alternativeClassFileName := classFileName copyFrom:(classFileName lastIndexOf:$:)+1 - ]. - ]. - - classFileName asFilename isAbsolute ifTrue:[ - classFileName asFilename suffix notEmptyOrNil ifTrue:[ - ok := self fileIn:classFileName lazy:loadLazy silent:beSilent. - ] ifFalse:[ - ok := self fileInSourceFile:classFileName lazy:loadLazy silent:beSilent. - ] - ] ifFalse:[ - classFileName := classFileName copyReplaceAll:$: with:$_ ifNone:classFileName. - [ - Class withoutUpdatingChangesDo:[ - |zarFn zar entry| - - ok := false. - - package notNil ifTrue:[ - packageDir := package asPackageId projectDirectory. - "/ packageDir := package asString. - "/ packageDir := packageDir copyReplaceAll:$: with:$/. - packageDir isNil ifTrue:[ - packageDir := self packageDirectoryForPackageId:package - ]. - packageDir notNil ifTrue:[ - packageDir := packageDir asFilename. - ]. - ]. - - Class packageQuerySignal answer:package do:[ - " - then, if dynamic linking is available, - " - (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[ - sharedLibExtension := ObjectFileLoader sharedLibraryExtension. - " - first look for a class packages shared binary in binary/xxx.o - " - libName := self libraryFileNameOfClass:aClassName. - libName notNil ifTrue:[ - (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension)) - ifFalse:[ - sharedLibExtension ~= '.o' ifTrue:[ - ok := self fileInClass:aClassName fromObject:(libName, '.o') - ] - ]. - ]. - " - then, look for a shared binary in binary/xxx.o - " - ok ifFalse:[ - (ok := self fileInClass:aClassName fromObject:(classFileName, sharedLibExtension)) - ifFalse:[ - sharedLibExtension ~= '.o' ifTrue:[ - ok := self fileInClass:aClassName fromObject:(classFileName, '.o') - ]. - ok ifFalse:[ - alternativeClassFileName notNil ifTrue:[ - (ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, sharedLibExtension)) - ifFalse:[ - sharedLibExtension ~= '.o' ifTrue:[ - ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, '.o') - ] - ] - ]. - ]. - ]. - ]. - ]. - - " - if that did not work, look for a compiled-bytecode file ... - " - ok ifFalse:[ - (ok := self fileIn:(classFileName , '.cls') lazy:loadLazy silent:beSilent) - ifFalse:[ - alternativeClassFileName notNil ifTrue:[ - ok := self fileIn:(alternativeClassFileName , '.cls') lazy:loadLazy silent:beSilent - ] - ] - ]. - " - if that did not work, and the classes package is known, - look for an st-cls file - in a package subdir of the source-directory ... - " - ok ifFalse:[ - (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[ - packageFile := self getPackageFileName:((packageDir / 'classes' / classFileName) addSuffix:'cls'). - packageFile isNil ifTrue:[ - packageFile := (packageDir / 'classes' / classFileName) addSuffix:'cls'. - ]. - (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent) - ifFalse:[ - alternativeClassFileName notNil ifTrue:[ - packageFile := self getPackageFileName:((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls'). - packageFile isNil ifTrue:[ - packageFile := ((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls'). - ]. - ok := self fileIn:packageFile lazy:loadLazy silent:beSilent - ] - ]. - - zarFn := self getPackageFileName:(packageDir / 'classes.zip'). - zarFn notNil ifTrue:[ - zar := ZipArchive oldFileNamed:zarFn. - zar notNil ifTrue:[ - entry := zar extract:(classFileName , '.cls'). - (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[ - entry := zar extract:(alternativeClassFileName , '.cls'). - ]. - entry notNil ifTrue:[ - bos := BinaryObjectStorage onOld:(entry asByteArray readStream). - bos next. - bos close. - ok := true - ]. - ] - ] - ] - ]. - - " - if that did not work, look for an st-source file ... - " - ok ifFalse:[ - filenameToSet := classFileName. - (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent) - ifFalse:[ - alternativeClassFileName notNil ifTrue:[ - filenameToSet := alternativeClassFileName. - ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent - ]. - ok ifFalse:[ - " - ... and in the standard source-directory - " - filenameToSet := 'source' asFilename / classFileName. - (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent) - ifFalse:[ - alternativeClassFileName notNil ifTrue:[ - filenameToSet := 'source' asFilename / alternativeClassFileName. - ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent - ] - ] - ] - ]. - " - if that did not work, and the classes package is known, - look for an st-source file - in a package subdir of the source-directory ... - " - ok ifFalse:[ - packageDir notNil ifTrue:[ - packageFile := self getPackageSourceFileName:(packageDir / 'source' / classFileName). - packageFile isNil ifTrue:[ - packageFile := (packageDir / 'source' / classFileName). - ]. - filenameToSet := packageFile. - (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent) - ifFalse:[ - alternativeClassFileName notNil ifTrue:[ - packageFile := self getPackageSourceFileName:(packageDir / 'source' / alternativeClassFileName). - packageFile isNil ifTrue:[ - packageFile := (packageDir / 'source' / alternativeClassFileName). - ]. - filenameToSet := packageFile. - ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent - ]. - ok ifFalse:[ - packageFile := self getPackageSourceFileName:(packageDir / classFileName). - packageFile isNil ifTrue:[ - packageFile := (packageDir / classFileName). - ]. - filenameToSet := packageFile. - (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent) - ifFalse:[ - alternativeClassFileName notNil ifTrue:[ - packageFile := self getPackageFileName:(packageDir / alternativeClassFileName). - packageFile isNil ifTrue:[ - packageFile := packageDir / alternativeClassFileName. - ]. - filenameToSet := packageFile. - ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent - ]. - ok ifFalse:[ - " - ... and in the standard source-directory - " - filenameToSet := 'source' asFilename / packageDir / classFileName. - (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent) - ifFalse:[ - alternativeClassFileName notNil ifTrue:[ - filenameToSet := 'source' asFilename / packageDir / alternativeClassFileName. - ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent - ] - ] - ] - ]. - ]. - ]. - ] - ]. - " - if that did not work, and the classes package is known, - look for a zipArchive containing a class entry. - " - ok ifFalse:[ - packageDir notNil ifTrue:[ - zarFn := self getPackageFileName:(packageDir / 'source.zip'). - zarFn isNil ifTrue:[ - zarFn := packageDir withSuffix:'zip'. - zarFn := self getSourceFileName:zarFn. - ]. - (zarFn notNil and:[zarFn asFilename exists]) ifTrue:[ - zar := ZipArchive oldFileNamed:zarFn. - zar notNil ifTrue:[ - entry := zar extract:(classFileName , '.st'). - (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[ - entry := zar extract:(alternativeClassFileName , '.st'). - ]. - entry notNil ifTrue:[ - filenameToSet := zarFn. - ok := self - fileInStream:(entry asString readStream) - lazy:loadLazy - silent:beSilent - logged:false - addPath:nil - ]. - ] - ] - ] - ]. - - " - if that did not work, - look for a zipArchive containing a class entry. - " - ok ifFalse:[ - zarFn := self getSourceFileName:'source.zip'. - zarFn notNil ifTrue:[ - zar := ZipArchive oldFileNamed:zarFn. - zar notNil ifTrue:[ - entry := zar extract:(zarFn := classFileName , '.st'). - (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[ - entry := zar extract:(zarFn := alternativeClassFileName , '.st'). - ]. - entry notNil ifTrue:[ - filenameToSet := zarFn. - ok := self - fileInStream:(entry asString readStream) - lazy:loadLazy - silent:beSilent - logged:false - addPath:nil - ]. - ] - ] - ]. - ok ifFalse:[ - " - if there is a sourceCodeManager, ask it for the classes sourceCode - " - (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[ - inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName inPackage:package. - inStream notNil ifTrue:[ - filenameToSet := nil. - ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil. - ] - ]. - ]. - ]. - ] - ]. - ] ensure:[ - Compiler compileLazy:wasLazy. - wasSilent notNil ifTrue:[ - self silentLoading:wasSilent - ] - ]. - ]. - - ok ifTrue:[ - newClass := self at:(aClassName asSymbol). - newClass notNil ifTrue:[ - "set the classes name - but do not change if already set" - filenameToSet notNil ifTrue:[ - newClass getClassFilename isNil ifTrue:[ - newClass setClassFilename:(filenameToSet asFilename baseName) - ]. - ]. - - doInit ifTrue:[ - newClass initialize - ] - ] - ]. + wasLazy := Compiler compileLazy:loadLazy. + beSilent notNil ifTrue:[ + wasSilent := self silentLoading:beSilent. + ]. + + classFileName := Smalltalk fileNameForClass:aClassName. + (classFileName = aClassName) ifTrue:[ + "/ no abbrev.stc translation for className + (aClassName includes:$:) ifTrue:[ + "/ a nameSpace name + alternativeClassFileName := classFileName copyFrom:(classFileName lastIndexOf:$:)+1 + ]. + ]. + + classFileName asFilename isAbsolute ifTrue:[ + classFileName asFilename suffix notEmptyOrNil ifTrue:[ + ok := self fileIn:classFileName lazy:loadLazy silent:beSilent. + ] ifFalse:[ + ok := self fileInSourceFile:classFileName lazy:loadLazy silent:beSilent. + ] + ] ifFalse:[ + classFileName := classFileName copyReplaceAll:$: with:$_ ifNone:classFileName. + [ + Class withoutUpdatingChangesDo:[ + |zarFn zar entry| + + ok := false. + + package notNil ifTrue:[ + packageDir := package asPackageId projectDirectory. + "/ packageDir := package asString. + "/ packageDir := packageDir copyReplaceAll:$: with:$/. + packageDir isNil ifTrue:[ + packageDir := self packageDirectoryForPackageId:package + ]. + packageDir notNil ifTrue:[ + packageDir := packageDir asFilename. + ]. + ]. + + Class packageQuerySignal answer:package do:[ + " + then, if dynamic linking is available, + " + (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[ + sharedLibExtension := ObjectFileLoader sharedLibraryExtension. + " + first look for a class packages shared binary in binary/xxx.o + " + libName := self libraryFileNameOfClass:aClassName. + libName notNil ifTrue:[ + (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension)) + ifFalse:[ + sharedLibExtension ~= '.o' ifTrue:[ + ok := self fileInClass:aClassName fromObject:(libName, '.o') + ] + ]. + ]. + " + then, look for a shared binary in binary/xxx.o + " + ok ifFalse:[ + (ok := self fileInClass:aClassName fromObject:(classFileName, sharedLibExtension)) + ifFalse:[ + sharedLibExtension ~= '.o' ifTrue:[ + ok := self fileInClass:aClassName fromObject:(classFileName, '.o') + ]. + ok ifFalse:[ + alternativeClassFileName notNil ifTrue:[ + (ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, sharedLibExtension)) + ifFalse:[ + sharedLibExtension ~= '.o' ifTrue:[ + ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, '.o') + ] + ] + ]. + ]. + ]. + ]. + ]. + + " + if that did not work, look for a compiled-bytecode file ... + " + ok ifFalse:[ + (ok := self fileIn:(classFileName , '.cls') lazy:loadLazy silent:beSilent) + ifFalse:[ + alternativeClassFileName notNil ifTrue:[ + ok := self fileIn:(alternativeClassFileName , '.cls') lazy:loadLazy silent:beSilent + ] + ] + ]. + " + if that did not work, and the classes package is known, + look for an st-cls file + in a package subdir of the source-directory ... + " + ok ifFalse:[ + (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[ + packageFile := self getPackageFileName:((packageDir / 'classes' / classFileName) addSuffix:'cls'). + packageFile isNil ifTrue:[ + packageFile := (packageDir / 'classes' / classFileName) addSuffix:'cls'. + ]. + (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent) + ifFalse:[ + alternativeClassFileName notNil ifTrue:[ + packageFile := self getPackageFileName:((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls'). + packageFile isNil ifTrue:[ + packageFile := ((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls'). + ]. + ok := self fileIn:packageFile lazy:loadLazy silent:beSilent + ] + ]. + + zarFn := self getPackageFileName:(packageDir / 'classes.zip'). + zarFn notNil ifTrue:[ + zar := ZipArchive oldFileNamed:zarFn. + zar notNil ifTrue:[ + entry := zar extract:(classFileName , '.cls'). + (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[ + entry := zar extract:(alternativeClassFileName , '.cls'). + ]. + entry notNil ifTrue:[ + bos := BinaryObjectStorage onOld:(entry asByteArray readStream). + bos next. + bos close. + ok := true + ]. + ] + ] + ] + ]. + + " + if that did not work, look for an st-source file ... + " + ok ifFalse:[ + filenameToSet := classFileName. + (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent) + ifFalse:[ + alternativeClassFileName notNil ifTrue:[ + filenameToSet := alternativeClassFileName. + ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent + ]. + ok ifFalse:[ + " + ... and in the standard source-directory + " + filenameToSet := 'source' asFilename / classFileName. + (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent) + ifFalse:[ + alternativeClassFileName notNil ifTrue:[ + filenameToSet := 'source' asFilename / alternativeClassFileName. + ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent + ] + ] + ] + ]. + " + if that did not work, and the classes package is known, + look for an st-source file + in a package subdir of the source-directory ... + " + ok ifFalse:[ + packageDir notNil ifTrue:[ + packageFile := self getPackageSourceFileName:(packageDir / 'source' / classFileName). + packageFile isNil ifTrue:[ + packageFile := (packageDir / 'source' / classFileName). + ]. + filenameToSet := packageFile. + (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent) + ifFalse:[ + alternativeClassFileName notNil ifTrue:[ + packageFile := self getPackageSourceFileName:(packageDir / 'source' / alternativeClassFileName). + packageFile isNil ifTrue:[ + packageFile := (packageDir / 'source' / alternativeClassFileName). + ]. + filenameToSet := packageFile. + ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent + ]. + ok ifFalse:[ + packageFile := self getPackageSourceFileName:(packageDir / classFileName). + packageFile isNil ifTrue:[ + packageFile := (packageDir / classFileName). + ]. + filenameToSet := packageFile. + (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent) + ifFalse:[ + alternativeClassFileName notNil ifTrue:[ + packageFile := self getPackageFileName:(packageDir / alternativeClassFileName). + packageFile isNil ifTrue:[ + packageFile := packageDir / alternativeClassFileName. + ]. + filenameToSet := packageFile. + ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent + ]. + ok ifFalse:[ + " + ... and in the standard source-directory + " + filenameToSet := 'source' asFilename / packageDir / classFileName. + (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent) + ifFalse:[ + alternativeClassFileName notNil ifTrue:[ + filenameToSet := 'source' asFilename / packageDir / alternativeClassFileName. + ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent + ] + ] + ] + ]. + ]. + ]. + ] + ]. + " + if that did not work, and the classes package is known, + look for a zipArchive containing a class entry. + " + ok ifFalse:[ + packageDir notNil ifTrue:[ + zarFn := self getPackageFileName:(packageDir / 'source.zip'). + zarFn isNil ifTrue:[ + zarFn := packageDir withSuffix:'zip'. + zarFn := self getSourceFileName:zarFn. + ]. + (zarFn notNil and:[zarFn asFilename exists]) ifTrue:[ + zar := ZipArchive oldFileNamed:zarFn. + zar notNil ifTrue:[ + entry := zar extract:(classFileName , '.st'). + (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[ + entry := zar extract:(alternativeClassFileName , '.st'). + ]. + entry notNil ifTrue:[ + filenameToSet := zarFn. + ok := self + fileInStream:(entry asString readStream) + lazy:loadLazy + silent:beSilent + logged:false + addPath:nil + ]. + ] + ] + ] + ]. + + " + if that did not work, + look for a zipArchive containing a class entry. + " + ok ifFalse:[ + zarFn := self getSourceFileName:'source.zip'. + zarFn notNil ifTrue:[ + zar := ZipArchive oldFileNamed:zarFn. + zar notNil ifTrue:[ + entry := zar extract:(zarFn := classFileName , '.st'). + (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[ + entry := zar extract:(zarFn := alternativeClassFileName , '.st'). + ]. + entry notNil ifTrue:[ + filenameToSet := zarFn. + ok := self + fileInStream:(entry asString readStream) + lazy:loadLazy + silent:beSilent + logged:false + addPath:nil + ]. + ] + ] + ]. + ok ifFalse:[ + " + if there is a sourceCodeManager, ask it for the classes sourceCode + " + (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[ + inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName inPackage:package. + inStream notNil ifTrue:[ + filenameToSet := nil. + ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil. + ] + ]. + ]. + ]. + ] + ]. + ] ensure:[ + Compiler compileLazy:wasLazy. + wasSilent notNil ifTrue:[ + self silentLoading:wasSilent + ] + ]. + ]. + + ok ifTrue:[ + newClass := self at:(aClassName asSymbol). + newClass notNil ifTrue:[ + "set the classes name - but do not change if already set" + filenameToSet notNil ifTrue:[ + newClass getClassFilename isNil ifTrue:[ + newClass setClassFilename:(filenameToSet asFilename baseName) + ]. + ]. + + doInit ifTrue:[ + newClass initialize + ] + ] + ]. ]. ^ newClass @@ -8208,11 +8209,11 @@ !Smalltalk class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1119 2015-04-09 12:03:15 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1121 2015-04-21 19:15:00 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1119 2015-04-09 12:03:15 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1121 2015-04-21 19:15:00 cg Exp $' ! version_HG
--- a/String.st Tue Apr 21 17:27:23 2015 +0100 +++ b/String.st Wed Apr 22 07:33:07 2015 +0100 @@ -160,7 +160,7 @@ can be directly used as separator or for formatting." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.basicNew( anInteger.intValue() )); #else OBJ newString; @@ -293,7 +293,7 @@ } } fail: ;; -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. " invalid argument, or out-of-memory: @@ -352,7 +352,7 @@ used as a stream buffer." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.basicNew( anInteger.intValue() )); #else OBJ newString; @@ -422,7 +422,7 @@ } } fail: ;; -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. " invalid argument, or out-of-memory: @@ -559,7 +559,7 @@ This method is the same as at:." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ if (index.isSmallInteger()) { int idx1Based = context.stArg(0).intValue(); // st index is 1 based return context.RETURN( self.basicAt( idx1Based )); @@ -581,7 +581,7 @@ } } badIndex: ; -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ self basicAt:index ! @@ -594,7 +594,7 @@ This method is the same as basicAt:put:." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ if (index.isSmallInteger()) { int idx1Based = index.intValue(); // st index is 1 based @@ -620,7 +620,7 @@ } } } -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ self basicAt:index put:aCharacter ! @@ -630,7 +630,7 @@ - reimplemented here since we return characters" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ if (index.isSmallInteger()) { int idx1Based = index.intValue(); // st index is 1 based return context.RETURN( self.basicAt( idx1Based )); @@ -652,7 +652,7 @@ } } badIndex: ; -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. index isInteger ifFalse:[ ^ self indexNotInteger:index @@ -669,7 +669,7 @@ - reimplemented here since we store characters" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ if (index.isSmallInteger()) { int idx1Based = index.intValue(); // st index is 1 based @@ -700,7 +700,7 @@ } } badIndex: ; -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. (aCharacter isMemberOf:Character) ifFalse:[ " @@ -1438,7 +1438,7 @@ This may change." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.stringLtP(aString) ); /* NOTREACHED */ #else @@ -1499,7 +1499,7 @@ Use sameAs: to compare with case ignored." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.stringEqualP(aString) ); /* NOTREACHED */ #else @@ -1591,7 +1591,7 @@ RETURN (true); # endif } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super = aString @@ -1622,7 +1622,7 @@ This may change." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( aString.stringLtP( self ) ); /* NOTREACHED */ #else @@ -1671,7 +1671,7 @@ RETURN ( false ); } } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super > aString ! @@ -2025,7 +2025,7 @@ extra message send." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.stringEqualP( aString.not()) ); /* NOTREACHED */ #else @@ -2114,7 +2114,7 @@ } RETURN (false); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ super ~= aString ! ! @@ -2275,7 +2275,7 @@ "Return a unique symbol with the name taken from the receivers characters." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( self.asSTSymbol() ); #else OBJ newSymbol; @@ -2291,7 +2291,7 @@ if (newSymbol) { RETURN ( newSymbol); } -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ ObjectMemory allocationFailureSignal raise. @@ -2308,7 +2308,7 @@ performed once." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( STSymbol.asSymbolIfInterned( self.asString() )); #else OBJ cls; @@ -2321,7 +2321,7 @@ indx = 0; } RETURN ( __SYMBOL_OR_NIL(__stringVal(self) + indx)); -#endif /* not JAVA */ +#endif /* not __SCHTEAM__ */ %}. ^ self primitiveFailed " @@ -3420,7 +3420,7 @@ (but only, as long as Stdout is nil, which is set later after startup)." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ if (Smalltalk.getBindingOrNull(STSymbol._new("Stdout")) == null) { System.out.print(self.toString()); return context._RETURN(self); @@ -3447,7 +3447,7 @@ (but only, as long as Stdout is nil, which is set later after startup)." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ if (Smalltalk.getBindingOrNull(STSymbol._new("Stdout")) == null) { System.out.println(self.toString()); return context._RETURN(self); @@ -3474,7 +3474,7 @@ Please use the printf: method, which is safe as it is completely implemented in Smalltalk." %{ /* STACK: 1000 */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ char buffer[800]; char *buf = buffer; int bufsize = sizeof(buffer); @@ -3566,7 +3566,7 @@ Redefined here to exclude the 0-byte at the end." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context.RETURN( STInteger._new( self.basicSize() ) ); #else REGISTER OBJ slf, cls; @@ -3663,7 +3663,7 @@ Can be used to check for existance of a symbol without creating one" %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context._RETURN( (STSymbol.asSymbolIfInterned(self.asSTString("[knownAsSymbol]").asString("")) != null) ? True : False ); #else OBJ cls; @@ -3676,7 +3676,7 @@ indx = 0; } RETURN ( __KNOWNASSYMBOL(__stringVal(self) + indx) ); -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. "/ ^ self asSymbolIfInterned notNil. self primitiveFailed @@ -3701,7 +3701,7 @@ This method is the same as basicSize." %{ /* NOCONTEXT */ -#ifdef __JAVA__ +#ifdef __SCHTEAM__ return context.RETURN( STInteger._new( self.basicSize() ) ); #else REGISTER OBJ cls, slf; @@ -3732,7 +3732,7 @@ "Q: is there a need to redefine it here ?" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ REGISTER char c; REGISTER unsigned char *hip, *lowp; @@ -3761,7 +3761,7 @@ |notFound| %{ /* STACK:4000 */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ if (__qIsStringLike(self) && __isStringLike(aSubString) && (caseSensitive == true) @@ -3870,7 +3870,7 @@ notFound = true; } } -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. notFound == true ifTrue:[ ^ exceptionValue value. @@ -3887,7 +3887,7 @@ If aStringOrChar is an empty string, true is returned" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ int len1, len2; REGISTER unsigned char *src1, *src2; unsigned char c; @@ -3921,7 +3921,7 @@ } RETURN ( false ); } -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ super endsWith:aStringOrChar @@ -3941,7 +3941,7 @@ Q: should we care for whiteSpace in general here ?" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ REGISTER unsigned char *src; REGISTER unsigned char c; OBJ cls; @@ -3968,7 +3968,7 @@ } } RETURN ( true ); -# endif /* ! __JAVA__ */ +# endif /* ! __SCHTEAM__ */ %}. ^ super isBlank ! @@ -3978,14 +3978,14 @@ Redefined here for performance" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ OBJ cls; cls = __qClass(self); if ((cls == String) || (cls == Symbol)) { RETURN ( (__stringSize(self) == 0) ? true : false); } -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ self size == 0 ! @@ -4002,7 +4002,7 @@ substitution, case-change, insertion and deletion of a character." %{ /* STACK: 2000 */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ /* * this is very heavy used when correcting errors * (all symbols are searched for best match) - therefore it must be fast @@ -4090,7 +4090,7 @@ RETURN ( __mkSmallInteger(m) ); } mallocFailed: ; -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ super levenshteinTo:aString @@ -4114,14 +4114,14 @@ Redefined here for performance" %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ OBJ cls; cls = __qClass(self); if ((cls == String) || (cls == Symbol)) { RETURN ( (__stringSize(self) != 0) ? true : false); } -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ self size ~~ 0 ! @@ -4133,7 +4133,7 @@ which are both inconsistent w.r.t. an empty argument." %{ /* NOCONTEXT */ -#ifndef __JAVA__ +#ifndef __SCHTEAM__ int len1, len2; REGISTER unsigned char *src1, *src2; unsigned char c; @@ -4216,7 +4216,7 @@ } RETURN ( false ); } -#endif /* ! __JAVA__ */ +#endif /* ! __SCHTEAM__ */ %}. ^ super startsWith:aStringOrChar @@ -4253,9 +4253,9 @@ !String class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.334 2015-04-19 22:55:08 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.335 2015-04-20 10:48:54 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.334 2015-04-19 22:55:08 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.335 2015-04-20 10:48:54 cg Exp $' ! !
--- a/UnboundedExternalStream.st Tue Apr 21 17:27:23 2015 +0100 +++ b/UnboundedExternalStream.st Wed Apr 22 07:33:07 2015 +0100 @@ -10,6 +10,8 @@ hereby transferred. " +"{ Package: 'stx:libbasic' }" + ExternalStream subclass:#UnboundedExternalStream instanceVariableNames:'' classVariableNames:'' @@ -40,7 +42,7 @@ Sockets, TTYStreams etc. [author:] - Claus Gittinger + Claus Gittinger " ! ! @@ -67,7 +69,7 @@ !UnboundedExternalStream class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/UnboundedExternalStream.st,v 1.8 1996/04/25 17:02:20 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/UnboundedExternalStream.st,v 1.9 2015-04-21 16:06:59 cg Exp $' ! !
--- a/UnixOperatingSystem.st Tue Apr 21 17:27:23 2015 +0100 +++ b/UnixOperatingSystem.st Wed Apr 22 07:33:07 2015 +0100 @@ -1855,9 +1855,9 @@ RETURN ( __mkSmallInteger(SIGINFO) ); } #endif - - RETURN ( __mkSmallInteger(0) ); -%} +%}. + ^ 0 + " OperatingSystem signalNamed:#SIGABRT OperatingSystem signalNamed:#SIGCHLD @@ -5858,18 +5858,28 @@ Use only for fully debugged stand alone applications." %{ /* NOCONTEXT */ - +#ifdef __SCHTEAM__ + if (signalNumber.isSmallInteger()) { + int sigNo = signalNumber.intValue(); + + if (sigNo != 0) { + System.err.println("ignored disable-signal: "+sigNo); + } + return context._RETURN(self); + } +#else if (__isSmallInteger(signalNumber)) { int sigNo = __intVal(signalNumber); if (sigNo == 0) { RETURN (self); } -#ifdef SIG_IGN +# ifdef SIG_IGN signal(sigNo, SIG_IGN); RETURN (self); -#endif - } +# endif + } +#endif %}. " this error is triggered on non-integer argument @@ -6043,171 +6053,181 @@ a signal." %{ /* NOCONTEXT */ - -#ifdef NSIG -# define SIG_LIMIT NSIG +#ifdef __SCHTEAM__ + if (signalNumber.isSmallInteger()) { + int sigNo = signalNumber.intValue(); + + if (sigNo != 0) { + System.err.println("ignored enable-signal: "+sigNo); + } + return context._RETURN(self); + } #else -# ifdef SIGUSR2 -# define SIG_LIMIT SIGUSR2 + +# ifdef NSIG +# define SIG_LIMIT NSIG # else -# ifdef SIGUSR -# define SIG_LIMIT SIGUSR -# endif -# endif -#endif - -#if defined(SIGPOLL) && !defined(SIGIO) -# define SIGIO SIGPOLL -#endif - -#ifdef SIGCHLD -# define CHILD_SIGNAL SIGCHLD -#else -# ifdef SIGCLD -# define CHILD_SIGNAL SIGCLD -# endif -#endif +# ifdef SIGUSR2 +# define SIG_LIMIT SIGUSR2 +# else +# ifdef SIGUSR +# define SIG_LIMIT SIGUSR +# endif +# endif +# endif + +# if defined(SIGPOLL) && !defined(SIGIO) +# define SIGIO SIGPOLL +# endif + +# ifdef SIGCHLD +# define CHILD_SIGNAL SIGCHLD +# else +# ifdef SIGCLD +# define CHILD_SIGNAL SIGCLD +# endif +# endif int sigNr; -#if defined(SIGINT) || defined(SIGQUIT) -# ifndef __signalUserInterrupt +# if defined(SIGINT) || defined(SIGQUIT) +# ifndef __signalUserInterrupt extern void __signalUserInterrupt(SIGHANDLER_ARG); -# endif -#endif -#ifdef SIGFPE -# ifndef __signalFpExceptionInterrupt +# endif +# endif +# ifdef SIGFPE +# ifndef __signalFpExceptionInterrupt extern void __signalFpExceptionInterrupt(SIGHANDLER_ARG); -# endif -#endif -#ifdef SIGIO -# ifndef __signalIoInterrupt +# endif +# endif +# ifdef SIGIO +# ifndef __signalIoInterrupt extern void __signalIoInterrupt(SIGHANDLER_ARG); -# endif -#endif -#ifdef CHILD_SIGNAL -# ifndef __signalChildInterrupt +# endif +# endif +# ifdef CHILD_SIGNAL +# ifndef __signalChildInterrupt extern void __signalChildInterrupt(SIGHANDLER_ARG); -# endif -#endif -#ifdef SIGPIPE -# ifndef __signalPIPEInterrupt +# endif +# endif +# ifdef SIGPIPE +# ifndef __signalPIPEInterrupt extern void __signalPIPEInterrupt(SIGHANDLER_ARG); -# endif -#endif -#ifdef SIGBUS -# ifndef __signalBUSInterrupt +# endif +# endif +# ifdef SIGBUS +# ifndef __signalBUSInterrupt extern void __signalBUSInterrupt(SIGHANDLER_ARG); -# endif -#endif -#ifdef SIGSEGV -# ifndef __signalSEGVInterrupt +# endif +# endif +# ifdef SIGSEGV +# ifndef __signalSEGVInterrupt extern void __signalSEGVInterrupt(SIGHANDLER_ARG); -# endif -#endif -#if defined(SIGILL) || defined(SIGEMT) -# ifndef __signalTrapInterrupt +# endif +# endif +# if defined(SIGILL) || defined(SIGEMT) +# ifndef __signalTrapInterrupt extern void __signalTrapInterrupt(SIGHANDLER_ARG); -# endif -#endif -#ifdef SIGALRM -# ifndef __signalTimerInterrupt +# endif +# endif +# ifdef SIGALRM +# ifndef __signalTimerInterrupt extern void __signalTimerInterrupt(SIGHANDLER_ARG); -# endif -#endif -#ifdef SIGABRT -# ifndef __signalAbortInterrupt +# endif +# endif +# ifdef SIGABRT +# ifndef __signalAbortInterrupt extern void __signalAbortInterrupt(SIGHANDLER_ARG); -# endif -#endif -#ifndef __signalInterrupt +# endif +# endif +# ifndef __signalInterrupt extern void __signalInterrupt(SIGHANDLER_ARG); -#endif +# endif void (*handler)(SIGHANDLER_ARG); if (__isSmallInteger(signalNumber) && ((sigNr = __intVal(signalNumber)) >= 0) -#ifdef SIG_LIMIT +# ifdef SIG_LIMIT && (sigNr <= SIG_LIMIT) -#endif +# endif ) { /* * standard signals are forced into standard handlers * - all others go into general signalInterrupt */ -#if defined(SIGPOLL) && defined(SIGIO) +# if defined(SIGPOLL) && defined(SIGIO) if (sigNr == SIGPOLL) sigNr = SIGIO; -#endif +# endif switch (sigNr) { case 0: /* enabling a non-supported signal */ RETURN (self); -#ifdef SIGBREAK +# ifdef SIGBREAK case SIGBREAK: -#endif -#ifdef SIGINT +# endif +# ifdef SIGINT case SIGINT: -#endif -#ifdef SIGQUIT +# endif +# ifdef SIGQUIT case SIGQUIT: -#endif -#if defined(SIGINT) || defined(SIGQUIT) || defined(SIGBREAK) +# endif +# if defined(SIGINT) || defined(SIGQUIT) || defined(SIGBREAK) handler = __signalUserInterrupt; break; -#endif -#ifdef SIGFPE +# endif +# ifdef SIGFPE case SIGFPE: handler = __signalFpExceptionInterrupt; break; -#endif - -#ifdef SIGPIPE +# endif + +# ifdef SIGPIPE case SIGPIPE: handler = __signalPIPEInterrupt; break; -#endif -#ifdef SIGBUS +# endif +# ifdef SIGBUS case SIGBUS: handler = __signalBUSInterrupt; break; -#endif -#ifdef SIGSEGV +# endif +# ifdef SIGSEGV case SIGSEGV: handler = __signalSEGVInterrupt; break; -#endif -#ifdef SIGABRT +# endif +# ifdef SIGABRT case SIGABRT: handler = __signalAbortInterrupt; break; -#endif -#ifdef SIGILL +# endif +# ifdef SIGILL case SIGILL: handler = __signalTrapInterrupt; break; -#endif -#ifdef SIGEMT +# endif +# ifdef SIGEMT case SIGEMT: handler = __signalTrapInterrupt; break; -#endif -#ifdef SIGIO +# endif +# ifdef SIGIO case SIGIO: handler = __signalIoInterrupt; break; -#endif - -#ifdef CHILD_SIGNAL +# endif + +# ifdef CHILD_SIGNAL case CHILD_SIGNAL: handler = __signalChildInterrupt; break; -#endif -#ifdef SIGALRM +# endif +# ifdef SIGALRM case SIGALRM: handler = __signalTimerInterrupt; break; -#endif +# endif default: handler = __signalInterrupt; @@ -6215,7 +6235,7 @@ } { -#ifdef HAS_SIGACTION +# ifdef HAS_SIGACTION struct sigaction act; /* @@ -6229,18 +6249,18 @@ sigemptyset(&act.sa_mask); act.sa_handler = handler; sigaction(sigNr, &act, 0); -#else -# ifdef HAS_SIGVEC +# else +# ifdef HAS_SIGVEC struct sigvec vec; vec.sv_flags = SV_INTERRUPT; sigemptyset(&vec.sv_mask); vec.sv_handler = handler; sigvec(sigNr, &vec, NULL); -# else +# else (void) signal(sigNr, handler); -# endif -#endif +# endif +# endif } /* @@ -6249,8 +6269,8 @@ */ RETURN (self); } -%}. - +#endif /* not SCHTEAM */ +%}. " this error is triggered on non-integer argument, or if the signal number is not in the valid range (1..NSIG) @@ -6262,44 +6282,52 @@ "setup for a timerInterrupt, to be signalled after some (real) time." %{ /* NOCONTEXT */ +#ifdef __SCHTEAM__ + if (milliSeconds.isSmallInteger()) { + long millis = milliSeconds.longValue(); + + System.err.println("ignored enable-timer"); + return context._RETURN(self); + } +#else int millis; millis = __intVal(milliSeconds); -#ifdef SIGALRM +# ifdef SIGALRM { static int firstCall = 1; -# ifndef __signalTimerInterrupt +# ifndef __signalTimerInterrupt extern void __signalTimerInterrupt(SIGHANDLER_ARG); -# endif +# endif if (firstCall) { -# ifdef HAS_SIGACTION +# ifdef HAS_SIGACTION struct sigaction act; act.sa_flags = SA_SIGINFO; /* <- if you add more, remember dummys at the top */ sigemptyset(&act.sa_mask); act.sa_handler = __signalTimerInterrupt; sigaction(SIGALRM, &act, 0); -# else -# ifdef HAS_SIGVEC +# else +# ifdef HAS_SIGVEC struct sigvec vec; vec.sv_flags = SV_INTERRUPT; sigemptyset(&vec.sv_mask); vec.sv_handler = __signalTimerInterrupt; sigvec(SIGALRM, &vec, NULL); -# else /* neither SIGACTION nor SIGVEC */ +# else /* neither SIGACTION nor SIGVEC */ signal(SIGALRM, __signalTimerInterrupt); -# endif /* stupid system */ -# endif +# endif /* stupid system */ +# endif firstCall = 0; } } -#endif /* SIGALRM */ - - -#if defined(ITIMER_REAL) && !defined(NO_SETITIMER) +# endif /* SIGALRM */ + + +# if defined(ITIMER_REAL) && !defined(NO_SETITIMER) { struct itimerval dt; @@ -6310,9 +6338,9 @@ setitimer(ITIMER_REAL, &dt, 0); RETURN (true); } -#else /* no ITIMER_REAL */ - -# ifdef USE_SLOW_ALARM +# else /* no ITIMER_REAL */ + +# ifdef USE_SLOW_ALARM { /* * last fallback - use alarm (which only gives 1 second resolution). @@ -6323,8 +6351,9 @@ alarm(1); RETURN(true); } -# endif -#endif /* ITIMER_REAL */ +# endif +# endif /* ITIMER_REAL */ +#endif /* not SCHTEAM */ %}. ^ false ! @@ -7057,7 +7086,20 @@ "get an environment string" %{ /* NOCONTEXT */ - +#ifdef __SCHTEAM__ + { + java.lang.String val = System.getenv( aStringOrSymbol.asString() ); + STObject retVal; + + if (val == null) { + retVal = STObject.Nil; + } else { + retVal = new STString( val ); + } + return context._RETURN( retVal ); + /* NOTREACHED */ + } +#else extern char *getenv(); if (__isStringLike(aStringOrSymbol)) { @@ -7067,6 +7109,7 @@ } RETURN ( nil ); } +#endif /* not SCHTEAM */ %}. ^ self primitiveFailed @@ -14202,11 +14245,11 @@ !UnixOperatingSystem class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.435 2015-04-19 09:43:40 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.436 2015-04-21 19:41:36 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.435 2015-04-19 09:43:40 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.436 2015-04-21 19:41:36 cg Exp $' ! !