Packages March 2017

packages@lists.squeakfoundation.org

1 participants
168 discussions

The Trunk: Tests-eem.372.mcz
by commits＠source.squeak.org 30 Mar '17

30 Mar '17

Eliot Miranda uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-eem.372.mcz ==================== Summary ==================== Name: Tests-eem.372 Author: eem Time: 30 March 2017, 12:52:24.488537 pm UUID: 601d9b7e-c9b0-4c2f-b22a-dae01b776c61 Ancestors: Tests-eem.371 Remove an explcit reference to ContextPart in the compiler tests. =============== Diff against Tests-eem.371 =============== Item was changed: ----- Method: ContextCompilationTest>>testVariablesAndOffsetsDo (in category 'tests') ----- testVariablesAndOffsetsDo "ContextCompilationTest new testVariablesAndOffsetsDo" | contextClasses | + contextClasses := thisContext class withAllSuperclasses, thisContext class allSubclasses asArray. - contextClasses := ContextPart withAllSuperclasses, ContextPart allSubclasses asArray. contextClasses do: [:class| class variablesAndOffsetsDo: [:var :offset| self assert: offset < 0. self assert: (class instVarNameForIndex: offset negated) == var]]. InstructionStream withAllSuperclasses, InstructionStream allSubclasses asArray do: [:class| (contextClasses includes: class) ifFalse: [class variablesAndOffsetsDo: [:var :offset| (InstructionStream instVarNames includes: var) ifFalse: [self assert: offset > 0. self assert: (class instVarNameForIndex: offset) == var]]]]!

1 0

The Trunk: System-eem.942.mcz
by commits＠source.squeak.org 30 Mar '17

30 Mar '17

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.942.mcz ==================== Summary ==================== Name: System-eem.942 Author: eem Time: 30 March 2017, 12:46:19.668474 pm UUID: fb603eb0-6114-4316-8737-dcd157a44ec9 Ancestors: System-eem.941 Eliminate an explicit reference to ContextPart and make the derivation of the class of a contexts' receiver robust in the presence of forwarders. =============== Diff against System-eem.941 =============== Item was changed: ----- Method: ImageSegment>>restoreEndianness: (in category 'fileIn') ----- restoreEndianness: endiannessHasToBeFixed "If endiannessHasToBeFixed, then fix endianness (byte order) of any objects not already fixed. Do this by discovering classes that need a startUp message sent to each instance, and sending it. I have just been brought in and converted to live objects. Find all Sets and Dictionaries in the newly created objects and rehash them. Segment is near then end of memory, since is was newly brought in (and a new object created for it). Also, collect all classes of receivers of blocks which refer to instance variables. Return them. Caller will check if they have been reshaped." | sets receiverClasses noStartUpNeeded startUps cls msg | sets := OrderedCollection new. "have to collect them, because Dictionary makes a copy, and that winds up at the end of memory and gets rehashed and makes another one." receiverClasses := IdentitySet new. noStartUpNeeded := IdentitySet new. "classes that don't have a per-instance startUp message" startUps := IdentityDictionary new. "class -> MessageSend of a startUp message" self allObjectsDo: [:object | object isInMemory ifTrue: [ (object isKindOf: HashedCollection) ifTrue: [sets add: object]. + (object isContext and: [object hasInstVarRef]) ifTrue: [ + receiverClasses add: (object objectClass: object receiver) class]. - ((object isKindOf: ContextPart) and: [object hasInstVarRef]) ifTrue: [ - receiverClasses add: object receiver class]. (noStartUpNeeded includes: object class) ifFalse: [ cls := object class. (msg := startUps at: cls ifAbsent: [nil]) ifNil: [ msg := cls startUpFrom: endiannessHasToBeFixed. "a Message, if we need to swap bytes this time" msg ifNil: [noStartUpNeeded add: cls] ifNotNil: [startUps at: cls put: msg]]. msg ifNotNil: [msg sentTo: object]]]]. self rehashDictionaries: sets. "our purpose" + ^ receiverClasses "our secondary job"! - ^ receiverClasses "our secondary job" - !

1 0

The Trunk: Kernel-eem.1075.mcz
by commits＠source.squeak.org 30 Mar '17

30 Mar '17

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1075.mcz ==================== Summary ==================== Name: Kernel-eem.1075 Author: eem Time: 29 March 2017, 2:44:46.228466 pm UUID: 31d3d682-f16d-4295-82d3-07689acf53b4 Ancestors: Kernel-eem.1074 Change senders of primitiveFailTokenFor: to send to MethodContext not ContextPart. =============== Diff against Kernel-eem.1074 =============== Item was changed: ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') ----- simulateValueWithArguments: anArray caller: aContext "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity." | newContext sz | newContext := (MethodContext newForMethod: outerContext method) setSender: aContext receiver: outerContext receiver method: outerContext method closure: self startpc: startpc. ((newContext objectClass: anArray) ~~ Array or: [numArgs ~= anArray size]) ifTrue: + [^MethodContext primitiveFailTokenFor: nil]. - [^ContextPart primitiveFailTokenFor: nil]. sz := self basicSize. newContext stackp: sz + numArgs. 1 to: numArgs do: [:i| newContext at: i put: (anArray at: i)]. 1 to: sz do: [:i| newContext at: i + numArgs put: (self at: i)]. ^newContext! Item was changed: ----- Method: MethodContext>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ToolSet debugContext: self label:'Code simulation error' contents: nil]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]. primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [^self send: arguments first to: receiver with: arguments allButFirst super: false]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" [((self objectClass: (arguments at: 1)) == Array and: [(self objectClass: (arguments at: 2)) includesBehavior: CompiledMethod]) ifFalse: + [^MethodContext primitiveFailTokenFor: #'bad argument']. - [^ContextPart primitiveFailTokenFor: #'bad argument']. (arguments at: 2) numArgs = (arguments at: 1) size ifFalse: + [^MethodContext primitiveFailTokenFor: #'bad number of arguments']. - [^ContextPart primitiveFailTokenFor: #'bad number of arguments']. (arguments at: 2) primitive > 0 ifTrue: [(arguments at: 2) isQuick ifTrue: [^self push: (receiver withArgs: (arguments at: 1) executeMethod: (arguments at: 2))]. ^self doPrimitive: (arguments at: 2) primitive method: (arguments at: 2) receiver: receiver args: (arguments at: 1)]. ^MethodContext sender: self receiver: receiver method: (arguments at: 2) arguments: (arguments at: 1)]. - "Closure primitives" - (primitiveIndex = 200 and: [self == receiver]) ifTrue: - "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right" - [^self push: (BlockClosure - outerContext: receiver - startpc: pc + 2 - numArgs: arguments first - copiedValues: arguments last)]. - primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: + [^MethodContext primitiveFailTokenFor: nil]. - [^ContextPart primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: ["should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs" receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]! Item was changed: ----- Method: MethodContext>>send:to:with:startClass: (in category 'controlling') ----- send: selector to: rcvr with: args startClass: startClassOrNil "Simulate the action of sending a message with selector, selector, and arguments, args, to receiver. The argument, startClassOrNil, tells whether the selector should be looked up in startClassOrNil or the class of the receiver." | class meth val ctxt | class := startClassOrNil ifNil: [self objectClass: rcvr]. meth := class lookupSelector: selector. meth == nil ifTrue: [^self send: #doesNotUnderstand: to: rcvr with: (Array with: (Message selector: selector arguments: args)) startClass: class]. (args isArray and: [args size = meth numArgs]) ifFalse: + [^MethodContext primitiveFailTokenFor: nil]. - [^ContextPart primitiveFailTokenFor: nil]. val := self tryPrimitiveFor: meth receiver: rcvr args: args. ((self objectClass: val) == Array and: [val size = 2 and: [val first == PrimitiveFailToken]]) ifFalse: [^val]. (selector == #doesNotUnderstand: and: [class == ProtoObject]) ifTrue: [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood']. ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class. ((self objectClass: val) == Array and: [val size = 2 and: [val first == PrimitiveFailToken and: [val last notNil and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue: [ctxt at: ctxt stackPtr put: val last]. ^ctxt! Item was changed: ----- Method: Mutex>>primitiveEnterCriticalSectionOnBehalfOf: (in category 'system simulation') ----- primitiveEnterCriticalSectionOnBehalfOf: effectiveProcess "Primitive. Simulate primitiveEnterCriticalSection. The receiver must be unowned or owned by the effectiveProcess to proceed. Answer if the process is already owned by the current process." <primitive: 186> + ^MethodContext primitiveFailTokenFor: nil! - ^{ContextPart primitiveFailToken. nil}! Item was changed: ----- Method: Mutex>>primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: (in category 'system simulation') ----- primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effectiveProcess "Primitive. Simulate primitiveEnterCriticalSection. Attempt to set the ownership of the receiver. If the receiver is unowned set its owningProcess to the effectiveProcess and answer false. If the receiver is owned by the effectiveProcess answer true. If the receiver is owned by some other process answer nil." <primitive: 187> + ^MethodContext primitiveFailTokenFor: nil! - ^{ContextPart primitiveFailToken. nil}! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive (in category 'apply primitives') ----- tryNamedPrimitive "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive:'' module:'' error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive:'' module:'' error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive:'' module:'' error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive:'' module:'' error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive:'' module:'' error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive:'' module:'' error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive:'' module:'' error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive:'' module:'' error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode! Item was changed: ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with:with:with: (in category 'apply primitives') ----- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive:'' module:'' error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode! Item was changed: ----- Method: ProtoObject>>tryPrimitive:withArgs: (in category 'apply primitives') ----- tryPrimitive: primIndex withArgs: argumentArray "This method is a template that the Smalltalk simulator uses to execute primitives. See Object documentation whatIsAPrimitive." <primitive: 118 error: errorCode> + ^MethodContext primitiveFailTokenFor: errorCode! - ^ContextPart primitiveFailTokenFor: errorCode!

1 0

The Trunk: Graphics-cbc.372.mcz
by commits＠source.squeak.org 30 Mar '17

30 Mar '17

David T. Lewis uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-cbc.372.mcz ==================== Summary ==================== Name: Graphics-cbc.372 Author: cbc Time: 28 March 2017, 5:18:09.019402 pm UUID: 7b9783b1-87c5-3549-ac32-42acd6abcb12 Ancestors: Graphics-eem.371 Added method to allow creating a rectangle based on teh center of the rectangle. =============== Diff against Graphics-eem.371 =============== Item was added: + ----- Method: Rectangle class>>exactCenter:extent: (in category 'instance creation') ----- + exactCenter: centerPoint extent: extentPoint + "Answer an instance of me whose center is centerPoint and width + by height is extentPoint. " + ^ self origin: centerPoint - (extentPoint / 2) extent: extentPoint + !

1 0

The Trunk: Kernel-eem.1078.mcz
by commits＠source.squeak.org 30 Mar '17

30 Mar '17

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1078.mcz ==================== Summary ==================== Name: Kernel-eem.1078 Author: eem Time: 29 March 2017, 3:15:00.742332 pm UUID: f7975049-bf65-45d3-bcdc-f43f5276bb5f Ancestors: Kernel-eem.1077 Rewrite references to ContextPart (toodangerousClasses). Remove the explicit scripts. =============== Diff against Kernel-eem.1077 =============== Item was removed: - (PackageInfo named: 'Kernel') preamble: 'CompiledMethod addCompiledCodeAndCompiledBlock. - thisContext class name == #Context ifFalse: - [MethodContext bootstrapContext]'! Item was changed: ----- Method: ClassBuilder>>tooDangerousClasses (in category 'private') ----- tooDangerousClasses "Return a list of class names which will not be modified in the public interface" ^#( "Object will break immediately" ProtoObject Object + "Contexts and their superclasses, and blocks" + InstructionStream Context BlockClosure - "Contexts and their superclasses" - InstructionStream ContextPart BlockContext MethodContext BlockClosure "Superclasses of basic collections" Collection SequenceableCollection ArrayedCollection "Collections known to the VM" Array Bitmap String Symbol ByteArray CompiledMethod "Basic Numbers" Magnitude Number SmallInteger Float "Misc other" LookupKey Association Link Point Rectangle Behavior PositionableStream UndefinedObject ) ! Item was removed: - ----- Method: CompiledMethod class>>addCompiledCodeAndCompiledBlock (in category 'full block bootstrap') ----- - addCompiledCodeAndCompiledBlock - | cmHash cmInstCount cc | - "Ensure that - - CompiledMethod is a subclass of CompiledCode - - CompiledMethod has a sibling called CompiledBlock, - - CompiledMethod's class vars are moved to CompiledCode - - CompiledMethod preserves its identityHash and instances" - self compiledCodeAndCompiledBlockArePresent ifTrue: - [^self]. - cmHash := CompiledMethod identityHash. - cmInstCount := CompiledMethod instanceCount. - cc := CompiledMethod variableByteSubclass: #CompiledCode - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Kernel-Methods'. - self assert: cc == (ByteArray variableByteSubclass: #CompiledCode - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Kernel-Methods'). - self assert: cc typeOfClass == #compiledMethod. - cc ensureClassPool. - CompiledMethod classPool keys do: - [:classVar| - cc classPool declare: classVar from: CompiledMethod classPool]. - self assert: CompiledMethod classPool isEmpty. - CompiledMethod superclass: cc. - CompiledMethod class superclass: cc class. - cc addSubclass: CompiledMethod. - self assert: cmHash = CompiledMethod identityHash. - self assert: cmInstCount = CompiledMethod instanceCount. - self assert: (CompiledMethod inheritsFrom: cc). - self assert: (CompiledMethod class inheritsFrom: cc class). - cc variableByteSubclass: #CompiledBlock - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Kernel-Methods'. - self assert: self compiledCodeAndCompiledBlockArePresent! Item was added: + InstructionStream variableSubclass: #Context + instanceVariableNames: 'stackp method closureOrNil receiver' + classVariableNames: 'MaxLengthForASingleDebugLogReport MaxStackDepthForASingleDebugLogReport PrimitiveFailToken QuickStep ValueIndex' + poolDictionaries: '' + category: 'Kernel-Methods'! + + !Context commentStamp: '<historical>' prior: 0! + My instances hold all the dynamic state associated with the execution of either a method activation resulting from a message send or a block activation resulting from a block evaluation. In addition to their inherited state, this includes the receiver (self), the closure for a BlockClosure activation (which is nil for a method activation), a CompiledMethod, and space in the variable part of the context for arguments and temporary variables. + + MethodContexts, though normal in their variable size, are actually only used in two sizes, small and large, which are determined by the temporary space required by the method being executed. + + MethodContexts must only be created using the method newForMethod:. Note that it is impossible to determine the real object size of a MethodContext except by asking for the frameSize of its method. Any fields above the stack pointer (stackp) are truly invisible -- even (and especially!!) to the garbage collector. Any store into stackp other than by the primitive method stackp: is potentially fatal.! Item was added: + ----- Method: Context class>>allInstances (in category 'enumerating') ----- + allInstances + "Answer all instances of the receiver." + <primitive: 177> + "The primitive can fail because memory is low. If so, fall back on the old + enumeration code, which gives the system a chance to GC and/or grow. + Because aBlock might change the class of inst (for example, using become:), + it is essential to compute next before aBlock value: inst. + Only count until thisContext since this context has been created only to + compute the existing instances." + | inst insts next | + insts := WriteStream on: (Array new: 64). + inst := self someInstance. + [inst == thisContext or: [inst == nil]] whileFalse: + [next := inst nextInstance. + insts nextPut: inst. + inst := next]. + ^insts contents! Item was added: + ----- Method: Context class>>allInstancesDo: (in category 'private') ----- + allInstancesDo: aBlock + "Evaluate aBlock with each of the current instances of the receiver." + | instances inst next | + instances := self allInstancesOrNil. + instances ifNotNil: + [instances do: aBlock. + ^self]. + "allInstancesOrNil can fail because memory is low. If so, fall back on the old + enumeration code. Because aBlock might change the class of inst (for example, + using become:), it is essential to compute next before aBlock value: inst. + Only count until thisContext since evaluation of aBlock will create new contexts." + inst := self someInstance. + [inst == thisContext or: [inst == nil]] whileFalse: + [next := inst nextInstance. + aBlock value: inst. + inst := next]! Item was added: + ----- Method: Context class>>basicNew: (in category 'instance creation') ----- + basicNew: size + ^ (size = CompiledMethod smallFrameSize or: [ size = CompiledMethod fullFrameSize ]) + ifTrue: [ super basicNew: size ] + ifFalse: [ self error: 'Contexts must be ' , CompiledMethod smallFrameSize , ' or ' , CompiledMethod fullFrameSize , ' bytes.' ]! Item was added: + ----- Method: Context class>>carefullyPrint:on: (in category 'private') ----- + carefullyPrint: anObject on: aStream + aStream nextPutAll: ([anObject printString] + on: Error + do: ['unprintable ' , anObject class name])! Item was added: + ----- Method: Context class>>contextEnsure: (in category 'special context creation') ----- + contextEnsure: block + "Create an #ensure: context that is ready to return from executing its receiver" + + | ctxt chain | + ctxt := thisContext. + [chain := thisContext sender cut: ctxt. ctxt jump] ensure: block. + "jump above will resume here without unwinding chain" + ^ chain! Item was added: + ----- Method: Context class>>contextOn:do: (in category 'special context creation') ----- + contextOn: exceptionClass do: block + "Create an #on:do: context that is ready to return from executing its receiver" + + | ctxt chain | + ctxt := thisContext. + [chain := thisContext sender cut: ctxt. ctxt jump] on: exceptionClass do: block. + "jump above will resume here without unwinding chain" + ^ chain! Item was added: + ----- Method: Context class>>initialize (in category 'class initialization') ----- + initialize + ValueIndex := 2. + self assert: (Association instVarNameForIndex:ValueIndex) = 'value'. + PrimitiveFailToken class ~~ Object ifTrue: + [PrimitiveFailToken := Object new]! Item was added: + ----- Method: Context class>>initializedInstance (in category 'instance creation') ----- + initializedInstance + ^ nil! Item was added: + ----- Method: Context class>>isContextClass (in category 'private') ----- + isContextClass + ^true! Item was added: + ----- Method: Context class>>maxLengthForASingleDebugLogReport (in category 'preferences') ----- + maxLengthForASingleDebugLogReport + <preference: 'Max. Debug Report Length' + category: 'debug' + description: 'The description of an Exception stack will be truncated so as to not exceed this value' + type: #Number> + ^MaxLengthForASingleDebugLogReport ifNil: [40000]! Item was added: + ----- Method: Context class>>maxLengthForASingleDebugLogReport: (in category 'preferences') ----- + maxLengthForASingleDebugLogReport: anInteger + MaxLengthForASingleDebugLogReport := anInteger! Item was added: + ----- Method: Context class>>maxStackDepthForASingleDebugLogReport (in category 'preferences') ----- + maxStackDepthForASingleDebugLogReport + <preference: 'Max. Debug Report Stack Depth' + category: 'debug' + description: 'In an exception stack, any sender deeper than this value will not be logged.' + type: #Number> + ^MaxStackDepthForASingleDebugLogReport ifNil: [60]! Item was added: + ----- Method: Context class>>maxStackDepthForASingleDebugLogReport: (in category 'preferences') ----- + maxStackDepthForASingleDebugLogReport: anInteger + MaxStackDepthForASingleDebugLogReport := anInteger! Item was added: + ----- Method: Context class>>new (in category 'instance creation') ----- + new + + self error: 'Contexts must only be created with newForMethod:'! Item was added: + ----- Method: Context class>>new: (in category 'instance creation') ----- + new: size + + self error: 'Contexts must only be created with newForMethod:'! Item was added: + ----- Method: Context class>>newForMethod: (in category 'instance creation') ----- + newForMethod: aMethod + "This is the only method for creating new contexts, other than primitive cloning. + Any other attempts, such as inherited methods like shallowCopy, should be + avoided or must at least be rewritten to determine the proper size from the + method being activated. This is because asking a context its size (even basicSize!!) + will not return the real object size but only the number of fields currently + accessible, as determined by stackp." + + ^ super basicNew: aMethod frameSize! Item was added: + ----- Method: Context class>>primitiveFailToken (in category 'simulation') ----- + primitiveFailToken + + ^ PrimitiveFailToken! Item was added: + ----- Method: Context class>>primitiveFailTokenFor: (in category 'simulation') ----- + primitiveFailTokenFor: errorCode + + ^{PrimitiveFailToken. errorCode}! Item was added: + ----- Method: Context class>>runSimulated: (in category 'simulation') ----- + runSimulated: aBlock + "Simulate the execution of the argument, current. Answer the result it + returns." + + ^ thisContext sender + runSimulated: aBlock + contextAtEachStep: [:ignored] + + "Context runSimulated: [Pen new defaultNib: 5; go: 100]"! Item was added: + ----- Method: Context class>>sender:receiver:method:arguments: (in category 'instance creation') ----- + sender: s receiver: r method: m arguments: args + "Answer an instance of me with attributes set to the arguments." + + ^(self newForMethod: m) setSender: s receiver: r method: m arguments: args! Item was added: + ----- Method: Context class>>tallyInstructions: (in category 'examples') ----- + tallyInstructions: aBlock + "This method uses the simulator to count the number of occurrences of + each of the Smalltalk instructions executed during evaluation of aBlock. + Results appear in order of the byteCode set." + | tallies | + tallies := Bag new. + thisContext sender + runSimulated: aBlock + contextAtEachStep: + [:current | tallies add: current nextByte]. + ^tallies sortedElements + + "Context tallyInstructions: [3.14159 printString]"! Item was added: + ----- Method: Context class>>tallyMethods: (in category 'examples') ----- + tallyMethods: aBlock + "This method uses the simulator to count the number of calls on each method + invoked in evaluating aBlock. Results are given in order of decreasing counts." + | prev tallies | + tallies := Bag new. + prev := aBlock. + thisContext sender + runSimulated: aBlock + contextAtEachStep: + [:current | + current == prev ifFalse: "call or return" + [prev sender == nil ifFalse: "call only" + [tallies add: current printString]. + prev := current]]. + ^tallies sortedCounts + + "Context tallyMethods: [3.14159 printString]"! Item was added: + ----- Method: Context class>>theReturnMethod (in category 'special context creation') ----- + theReturnMethod + + | meth | + meth := self lookupSelector: #return:. + meth primitive = 0 ifFalse: [^ self error: 'expected #return: to not be a primitive']. + ^ meth! Item was added: + ----- Method: Context class>>trace: (in category 'examples') ----- + trace: aBlock "Context trace: [3 factorial]" + "This method uses the simulator to print calls and returned values in the Transcript." + + Transcript clear. + ^ self trace: aBlock on: Transcript! Item was added: + ----- Method: Context class>>trace:on: (in category 'examples') ----- + trace: aBlock on: aStream "Context trace: [3 factorial]" + "This method uses the simulator to print calls to a file." + | prev | + prev := aBlock. + ^ thisContext sender + runSimulated: aBlock + contextAtEachStep: + [:current | + Sensor anyButtonPressed ifTrue: [^ nil]. + current == prev + ifFalse: + [prev sender ifNil: + [aStream space; nextPut: $^. + self carefullyPrint: current top on: aStream]. + aStream cr. + (current depthBelow: aBlock) timesRepeat: [aStream space]. + self carefullyPrint: current receiver on: aStream. + aStream space; nextPutAll: current selector; flush. + prev := current]]! Item was added: + ----- Method: Context class>>trace:onFileNamed: (in category 'examples') ----- + trace: aBlock onFileNamed: fileName + "Context trace: [3 factorial] onFileNamed: 'trace'" + "This method uses the simulator to print calls to a file." + + ^FileStream fileNamed: fileName do: [ :file | + self trace: aBlock on: file ]! Item was added: + ----- Method: Context>>aboutToReturn:through: (in category 'private') ----- + aboutToReturn: result through: firstUnwindContext + "Called from VM when an unwindBlock is found between self and its home. + Return to home's sender, executing unwind blocks on the way." + + self methodReturnContext return: result through: firstUnwindContext! Item was added: + ----- Method: Context>>activateMethod:withArgs:receiver:class: (in category 'controlling') ----- + activateMethod: newMethod withArgs: args receiver: rcvr class: class + "Answer a ContextPart initialized with the arguments." + + ^MethodContext + sender: self + receiver: rcvr + method: newMethod + arguments: args! Item was added: + ----- Method: Context>>activateReturn:value: (in category 'private') ----- + activateReturn: aContext value: value + "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender" + + ^MethodContext + sender: self + receiver: aContext + method: MethodContext theReturnMethod + arguments: {value}! Item was added: + ----- Method: Context>>activeHome (in category 'accessing') ----- + activeHome + "If executing closure, search senders for the activation of the original + (outermost) method that (indirectly) created my closure (the closureHome). + If the closureHome is not found on the sender chain answer nil." + + | methodReturnContext | + self isExecutingBlock ifFalse: [^self]. + self sender ifNil: [^nil]. + methodReturnContext := self methodReturnContext. + ^self sender findContextSuchThat: [:ctxt | ctxt = methodReturnContext]! Item was added: + ----- Method: Context>>activeOuterContext (in category 'accessing') ----- + activeOuterContext + "If executing closure, search senders for the activation in which the receiver's + closure was created (the receiver's outerContext). If the outerContext is not + found on the sender chain answer nil." + + | outerContext | + self isExecutingBlock ifFalse: [^self]. + self sender ifNil: [^nil]. + outerContext := self outerContext. + ^self sender findContextSuchThat: [:ctxt | ctxt = outerContext]! Item was added: + ----- Method: Context>>actualStackSize (in category 'private-debugger') ----- + actualStackSize "For use only by Debugger, Inspectors etc" + ^ stackp - method numTemps! Item was added: + ----- Method: Context>>arguments (in category 'accessing') ----- + arguments + + ^ Array new: self numArgs streamContents: [:args | + 1 to: self numArgs do: [: i | + args nextPut: (self tempAt: i)]]! Item was added: + ----- Method: Context>>asContext (in category 'closure support') ----- + asContext + + ^ self! Item was added: + ----- Method: Context>>asMessage (in category 'converting') ----- + asMessage + | selector args | + selector := sender method selector. + args := Array new: selector numArgs. + 1 to: selector numArgs do: [ :i | args at: i put: (sender tempAt: i)]. + ^ Message selector: selector arguments: args.! Item was added: + ----- Method: Context>>at: (in category 'accessing') ----- + at: index + "Primitive. Assumes receiver is indexable. Answer the value of an + indexable element in the receiver. Fail if the argument index is not an + Integer or is out of bounds. Essential. See Object documentation + whatIsAPrimitive. Override the default primitive to give latitude to + the VM in context management." + + <primitive: 210> + index isInteger ifTrue: + [self errorSubscriptBounds: index]. + index isNumber + ifTrue: [^self at: index asInteger] + ifFalse: [self errorNonIntegerIndex]! Item was added: + ----- Method: Context>>at:put: (in category 'accessing') ----- + at: index put: value + "Primitive. Assumes receiver is indexable. Answer the value of an + indexable element in the receiver. Fail if the argument index is not + an Integer or is out of bounds. Essential. See Object documentation + whatIsAPrimitive. Override the default primitive to give latitude to + the VM in context management." + + <primitive: 211> + index isInteger ifTrue: + [self errorSubscriptBounds: index]. + index isNumber + ifTrue: [^self at: index asInteger put: value] + ifFalse: [self errorNonIntegerIndex]! Item was added: + ----- Method: Context>>atEnd (in category 'testing') ----- + atEnd + ^ self isExecutingBlock + ifTrue: [ self closure startpc + self closure size - 1 = self pc ] + ifFalse: [ self pc >= self method endPC ]! Item was added: + ----- Method: Context>>basicAt: (in category 'accessing') ----- + basicAt: index + "Primitive. Assumes receiver is indexable. Answer the value of an + indexable element in the receiver. Fail if the argument index is not an + Integer or is out of bounds. Essential. See Object documentation + whatIsAPrimitive. Override the default primitive to give latitude to + the VM in context management." + + <primitive: 210> + index isInteger ifTrue: + [self errorSubscriptBounds: index]. + index isNumber + ifTrue: [^self at: index asInteger] + ifFalse: [self errorNonIntegerIndex]! Item was added: + ----- Method: Context>>basicAt:put: (in category 'accessing') ----- + basicAt: index put: value + "Primitive. Assumes receiver is indexable. Answer the value of an + indexable element in the receiver. Fail if the argument index is not + an Integer or is out of bounds. Essential. See Object documentation + whatIsAPrimitive. Override the default primitive to give latitude to + the VM in context management." + + <primitive: 211> + index isInteger ifTrue: + [self errorSubscriptBounds: index]. + index isNumber + ifTrue: [^self at: index asInteger put: value] + ifFalse: [self errorNonIntegerIndex]! Item was added: + ----- Method: Context>>basicSize (in category 'accessing') ----- + basicSize + "Primitive. Answer the number of indexable variables in the receiver. + This value is the same as the largest legal subscript. Essential. Do not + override in any subclass. See Object documentation whatIsAPrimitive. Override the default primitive to give latitude to + the VM in context management." + + <primitive: 212> + "The number of indexable fields of fixed-length objects is 0" + ^self primitiveFailed! Item was added: + ----- Method: Context>>blockCopy: (in category 'controlling') ----- + blockCopy: numArgs + "Primitive. Distinguish a block of code from its enclosing method by + creating a new BlockContext for that block. The compiler inserts into all + methods that contain blocks the bytecodes to send the message + blockCopy:. Do not use blockCopy: in code that you write!! Only the + compiler can decide to send the message blockCopy:. Fail if numArgs is + not a SmallInteger. Optional. No Lookup. See Object documentation + whatIsAPrimitive." + + <primitive: 80> + ^ (BlockContext newForMethod: self method) + home: self home + startpc: pc + 2 + nargs: numArgs! Item was added: + ----- Method: Context>>blockReturnTop (in category 'instruction decoding (closures)') ----- + blockReturnTop + "Simulate the interpreter's action when a ReturnTopOfStackToCaller bytecode is + encountered in the receiver. This should only happen in a closure activation." + self assert: closureOrNil isClosure. + ^self return: self pop from: self! Item was added: + ----- Method: Context>>bottomContext (in category 'query') ----- + bottomContext + "Return the last context (the first context invoked) in my sender chain" + + ^ self findContextSuchThat: [:c | c sender isNil]! Item was added: + ----- Method: Context>>callPrimitive: (in category 'instruction decoding') ----- + callPrimitive: primNumber + "Evaluate the primitive, either normal or inlined, and answer the new context resulting from that + (either the sender if a successful non-inlined primitive, or the current context, if not)." + | maybePrimFailToken | + primNumber >= (1 << 15) ifTrue: "Inlined primitive, cannot fail" + [^self callInlinedPrimitive: primNumber]. + maybePrimFailToken := self doPrimitive: primNumber + method: method + receiver: receiver + args: self arguments. + "Normal primitive. Always at the beginning of methods." + (self isPrimFailToken: maybePrimFailToken) ifFalse: "On success return the result" + [^self methodReturnTop]. + "On failure, store the error code if appropriate and keep interpreting the method" + (method encoderClass isStoreAt: pc in: method) ifTrue: + [self at: stackp put: maybePrimFailToken last]. + ^self! Item was added: + ----- Method: Context>>canHandleSignal: (in category 'private-exceptions') ----- + canHandleSignal: exception + "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception then return true, otherwise forward this message to the next handler context. If none left, return false (see nil>>canHandleSignal:)" + + ^ (((self tempAt: 1) handles: exception) and: [self tempAt: 3]) + or: [self nextHandlerContext canHandleSignal: exception]. + ! Item was added: + ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- + cannotReturn: result + + closureOrNil notNil ifTrue: + [^self cannotReturn: result to: self home sender]. + ToolSet + debugContext: thisContext + label: 'computation has been terminated' + contents: nil! Item was added: + ----- Method: Context>>cannotReturn:to: (in category 'private') ----- + cannotReturn: result to: homeContext + "The receiver tried to return result to homeContext that no longer exists." + + ^ BlockCannotReturn new + result: result; + deadHome: homeContext; + signal! Item was added: + ----- Method: Context>>client (in category 'accessing') ----- + client + "Answer the client, that is, the object that sent the message that created this context." + + ^sender receiver! Item was added: + ----- Method: Context>>closure (in category 'accessing') ----- + closure + ^closureOrNil! Item was added: + ----- Method: Context>>closureCopy:copiedValues: (in category 'controlling') ----- + closureCopy: numArgs copiedValues: anArray + "Distinguish a block of code from its enclosing method by + creating a BlockClosure for that block. The compiler inserts into all + methods that contain blocks the bytecodes to send the message + closureCopy:copiedValues:. Do not use closureCopy:copiedValues: in code that you write!! Only the + compiler can decide to send the message closureCopy:copiedValues:. Fail if numArgs is + not a SmallInteger. Optional. No Lookup. See Object documentation + whatIsAPrimitive." + + <primitive: 200> + ^BlockClosure outerContext: self startpc: pc + 2 numArgs: numArgs copiedValues: anArray! Item was added: + ----- Method: Context>>completeCallee: (in category 'system simulation') ----- + completeCallee: aContext + "Simulate the execution of bytecodes until a return to the receiver." + | ctxt current ctxt1 | + ctxt := aContext. + [ctxt == current or: [ctxt hasSender: self]] + whileTrue: + [current := ctxt. + ctxt1 := ctxt quickStep. + ctxt1 ifNil: [self halt]. + ctxt := ctxt1]. + ^self stepToSendOrReturn! Item was added: + ----- Method: Context>>contextForLocalVariables (in category 'accessing') ----- + contextForLocalVariables + "Answer the context in which local variables (temporaries) are stored." + + self subclassResponsibility! Item was added: + ----- Method: Context>>contextStack (in category 'debugger access') ----- + contextStack + "Answer an Array of the contexts on the receiver's sender chain." + + ^self stackOfSize: 100000! Item was added: + ----- Method: Context>>contextTag (in category 'closure support') ----- + contextTag + "Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag." + ^self! Item was added: + ----- Method: Context>>copyStack (in category 'query') ----- + copyStack + + ^ self copyTo: nil! Item was added: + ----- Method: Context>>copyTo: (in category 'query') ----- + copyTo: aContext + "Copy self and my sender chain down to, but not including, aContext. End of copied chain will have nil sender." + + | copy | + self == aContext ifTrue: [ ^nil ]. + copy := self copy. + sender ifNotNil: [ copy privSender: (sender copyTo: aContext) ]. + ^copy! Item was added: + ----- Method: Context>>copyTo:bottomContextDo: (in category 'query') ----- + copyTo: aContext bottomContextDo: aBlock + "Copy self and my sender chain down to, but not including, aContext. End of copied chain will have nil sender. Evaluate aBlock with the copy of bottom context when it still points to the original sender." + + | copy | + self == aContext ifTrue: [ ^nil ]. + copy := self copy. + sender + ifNil: [ aBlock value: copy ] + ifNotNil: [ + sender == aContext ifTrue: [ aBlock value: copy ]. + copy privSender: (sender copyTo: aContext bottomContextDo: aBlock) ]. + ^copy! Item was added: + ----- Method: Context>>cut: (in category 'private') ----- + cut: aContext + "Cut aContext and its senders from my sender chain" + + | ctxt callee | + ctxt := self. + [ctxt == aContext] whileFalse: [ + callee := ctxt. + ctxt := ctxt sender. + ctxt ifNil: [aContext ifNotNil: [self error: 'aContext not a sender']]. + ]. + callee privSender: nil. + ! Item was added: + ----- Method: Context>>depthBelow: (in category 'debugger access') ----- + depthBelow: aContext + "Answer how many calls there are between this and aContext." + + | this depth | + this := self. + depth := 0. + [this == aContext or: [this == nil]] + whileFalse: + [this := this sender. + depth := depth + 1]. + ^depth! Item was added: + ----- Method: Context>>doDup (in category 'instruction decoding') ----- + doDup + "Simulate the action of a 'duplicate top of stack' bytecode." + + self push: self top! Item was added: + ----- Method: Context>>doPop (in category 'instruction decoding') ----- + doPop + "Simulate the action of a 'remove top of stack' bytecode." + + self pop! Item was added: + ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') ----- + doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments + "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and + arguments are given as arguments to this message. If successful, push result and return + resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes + execution needs to be intercepted and simulated to avoid execution running away." + + | value | + "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents + the debugger from entering various run-away activities such as spawning a new + process, etc. Injudicious use results in the debugger not being able to debug + interesting code, such as the debugger itself. hence use primitive 19 with care :-)" + "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" + primitiveIndex = 19 ifTrue: + [ToolSet + debugContext: self + label:'Code simulation error' + contents: nil]. + + ((primitiveIndex between: 201 and: 222) + and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: + [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" + or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" + [^receiver simulateValueWithArguments: arguments caller: self]. + primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" + [^receiver simulateValueWithArguments: arguments first caller: self]]. + + primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" + [^self send: arguments first to: receiver with: arguments allButFirst super: false]. + primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" + [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. + primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" + [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. + + "Mutex>>primitiveEnterCriticalSection + Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" + (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: + [| effective | + effective := Processor activeProcess effectiveProcess. + "active == effective" + value := primitiveIndex = 186 + ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] + ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. + ^(self isPrimFailToken: value) + ifTrue: [value] + ifFalse: [self push: value]]. + + primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" + [((self objectClass: (arguments at: 1)) == Array + and: [(self objectClass: (arguments at: 2)) includesBehavior: CompiledMethod]) ifFalse: + [^MethodContext primitiveFailTokenFor: #'bad argument']. + (arguments at: 2) numArgs = (arguments at: 1) size ifFalse: + [^MethodContext primitiveFailTokenFor: #'bad number of arguments']. + (arguments at: 2) primitive > 0 ifTrue: + [(arguments at: 2) isQuick ifTrue: + [^self push: (receiver withArgs: (arguments at: 1) executeMethod: (arguments at: 2))]. + ^self doPrimitive: (arguments at: 2) primitive method: (arguments at: 2) receiver: receiver args: (arguments at: 1)]. + ^MethodContext + sender: self + receiver: receiver + method: (arguments at: 2) + arguments: (arguments at: 1)]. + + primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" + [(arguments size = 3 + and: [(self objectClass: arguments second) == SmallInteger + and: [(self objectClass: arguments last) == Array]]) ifTrue: + [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. + (arguments size = 2 + and: [(self objectClass: arguments first) == SmallInteger + and: [(self objectClass: arguments last) == Array]]) ifFalse: + [^MethodContext primitiveFailTokenFor: nil]. + ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. + + value := primitiveIndex = 120 "FFI method" + ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] + ifFalse: + [primitiveIndex = 117 "named primitives" + ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] + ifFalse: + ["should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs" + receiver tryPrimitive: primitiveIndex withArgs: arguments]]. + + ^(self isPrimFailToken: value) + ifTrue: [value] + ifFalse: [self push: value]! Item was added: + ----- Method: Context>>endPC (in category 'private') ----- + endPC + ^closureOrNil + ifNil: [self method endPC] + ifNotNil: [closureOrNil endPC]! Item was added: + ----- Method: Context>>exceptionMessage (in category 'accessing') ----- + exceptionMessage + ^ self selector caseOf: { + [#doesNotUnderstand:] -> [self tempAt: 1]. + [#notYetImplemented] -> [self asMessage]. + [#shouldBeImplemented] -> [self asMessage]. + [#subclassResponsibility] -> [self asMessage]} + otherwise: [self error: 'This context is not the result of a message exception.'].! Item was added: + ----- Method: Context>>failPrimitiveWith: (in category 'system simulation') ----- + failPrimitiveWith: maybePrimFailToken + "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive: + bytecode and store the primitive fail code if there is one and the method consumes it." + self skipCallPrimitive. + ((self isPrimFailToken: maybePrimFailToken) + and: [method encoderClass isStoreAt: pc in: method]) ifTrue: + [self at: stackp put: maybePrimFailToken last]! Item was added: + ----- Method: Context>>findContextSuchThat: (in category 'query') ----- + findContextSuchThat: testBlock + "Search self and my sender chain for first one that satisfies testBlock. Return nil if none satisfy" + + | ctxt | + ctxt := self. + [ctxt isNil] whileFalse: [ + (testBlock value: ctxt) ifTrue: [^ ctxt]. + ctxt := ctxt sender. + ]. + ^ nil! Item was added: + ----- Method: Context>>findNextHandlerContextStarting (in category 'private-exceptions') ----- + findNextHandlerContextStarting + "Return the next handler marked context, returning nil if there is none. Search starts with self and proceeds up to nil." + + | ctx | + <primitive: 197> + ctx := self. + [ctx isHandlerContext ifTrue:[^ctx]. + (ctx := ctx sender) == nil ] whileFalse. + ^nil! Item was added: + ----- Method: Context>>findNextUnwindContextUpTo: (in category 'private-exceptions') ----- + findNextUnwindContextUpTo: aContext + "Return the next unwind marked above the receiver, returning nil if there is none. Search proceeds up to but not including aContext." + + | ctx | + <primitive: 195> + ctx := self. + [(ctx := ctx sender) == nil or: [ctx == aContext]] whileFalse: + [ ctx isUnwindContext ifTrue: [^ctx]]. + ^nil! Item was added: + ----- Method: Context>>findSecondToOldestSimilarSender (in category 'query') ----- + findSecondToOldestSimilarSender + "Search the stack for the second-to-oldest occurance of self's method. Very useful for an infinite recursion. Gets back to the second call so you can see one complete recursion cycle, and how it was called at the beginning." + + | sec ctxt bot | + sec := self. + ctxt := self. + [ bot := ctxt findSimilarSender. + bot isNil + ] whileFalse: [ + sec := ctxt. + ctxt := bot. + ]. + ^ sec + ! Item was added: + ----- Method: Context>>findSimilarSender (in category 'query') ----- + findSimilarSender + "Return the closest sender with the same method, return nil if none found" + + | meth | + meth := self method. + ^ self sender findContextSuchThat: [:c | c method == meth]! Item was added: + ----- Method: Context>>handleSignal: (in category 'private-exceptions') ----- + handleSignal: exception + "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception + and the handler is active then execute my handle block (second arg), otherwise forward + this message to the next handler context. If none left, execute exception's defaultAction + (see nil>>handleSignal:)." + + | handlerActive val | + "If the context has been returned from the handlerActive temp var may not be accessible." + handlerActive := stackp >= 3 and: [(self tempAt: 3) == true]. + (((self tempAt: 1) handles: exception) and: [handlerActive]) ifFalse: + [^self nextHandlerContext handleSignal: exception]. + + exception privHandlerContext: self contextTag. + self tempAt: 3 put: false. "disable self while executing handle block" + val := [(self tempAt: 2) cull: exception] + ensure: [self tempAt: 3 put: true]. + self return: val "return from self if not otherwise directed in handle block" + ! Item was added: + ----- Method: Context>>hasContext: (in category 'query') ----- + hasContext: aContext + "Answer whether aContext is me or one of my senders" + + ^ (self findContextSuchThat: [:c | c == aContext]) notNil! Item was added: + ----- Method: Context>>hasInstVarRef (in category 'accessing') ----- + hasInstVarRef + "Answer whether the receiver references an instance variable." + + ^self method hasInstVarRef.! Item was added: + ----- Method: Context>>hasMethodReturn (in category 'accessing') ----- + hasMethodReturn + ^closureOrNil hasMethodReturn! Item was added: + ----- Method: Context>>hasSender: (in category 'controlling') ----- + hasSender: context + "Answer whether the receiver is strictly above context on the stack." + + | s | + self == context ifTrue: [^false]. + s := sender. + [s == nil] + whileFalse: + [s == context ifTrue: [^true]. + s := s sender]. + ^false! Item was added: + ----- Method: Context>>home (in category 'accessing') ----- + home + "Answer the context in which the receiver was defined." + + closureOrNil == nil ifTrue: + [^self]. + ^closureOrNil outerContext home! Item was added: + ----- Method: Context>>insertSender: (in category 'private') ----- + insertSender: aContext + "Insert aContext and its sender chain between me and my sender. Return new callee of my original sender." + + | ctxt | + ctxt := aContext bottomContext. + ctxt privSender: self sender. + self privSender: aContext. + ^ ctxt! Item was added: + ----- Method: Context>>instVarAt:put: (in category 'private') ----- + instVarAt: index put: value + index = 3 ifTrue: [self stackp: value. ^ value]. + ^ super instVarAt: index put: value! Item was added: + ----- Method: Context>>isBottomContext (in category 'query') ----- + isBottomContext + "Answer if this is the last context (the first context invoked) in my sender chain" + + ^sender isNil! Item was added: + ----- Method: Context>>isClosureContext (in category 'closure support') ----- + isClosureContext + ^closureOrNil ~~ nil! Item was added: + ----- Method: Context>>isContext (in category 'query') ----- + isContext + ^true! Item was added: + ----- Method: Context>>isDead (in category 'query') ----- + isDead + "Has self finished" + + ^ pc isNil! Item was added: + ----- Method: Context>>isExecutingBlock (in category 'accessing') ----- + isExecutingBlock + "Is this executing a block versus a method? In the new closure + implemetation this is true if closureOrNil is not nil, in which case + it should be holding a BlockClosure." + + ^closureOrNil isClosure! Item was added: + ----- Method: Context>>isHandlerContext (in category 'private-exceptions') ----- + isHandlerContext + "is this context for method that is marked?" + ^method primitive = 199! Item was added: + ----- Method: Context>>isMethodContext (in category 'testing') ----- + isMethodContext + ^ true! Item was added: + ----- Method: Context>>isPrimFailToken: (in category 'private') ----- + isPrimFailToken: anObject + ^(self objectClass: anObject) == Array + and: [anObject size = 2 + and: [anObject first == PrimitiveFailToken]]! Item was added: + ----- Method: Context>>isUnwindContext (in category 'private-exceptions') ----- + isUnwindContext + "is this context for method that is marked?" + ^method primitive = 198! Item was added: + ----- Method: Context>>jump (in category 'controlling') ----- + jump + "Abandon thisContext and resume self instead (using the same current process). You may want to save thisContext's sender before calling this so you can jump back to it. + Self MUST BE a top context (ie. a suspended context or a abandoned context that was jumped out of). A top context already has its return value on its stack (see Interpreter>>primitiveSuspend and other suspending primitives). + thisContext's sender is converted to a top context (by pushing a nil return value on its stack) so it can be jump back to." + + | top | + "Make abandoned context a top context (has return value (nil)) so it can be jumped back to" + thisContext sender push: nil. + + "Pop self return value then return it to self (since we jump to self by returning to it)" + stackp = 0 ifTrue: [self stepToSendOrReturn]. + stackp = 0 ifTrue: [self push: nil]. "must be quick return self/constant" + top := self pop. + thisContext privSender: self. + ^ top! Item was added: + ----- Method: Context>>jump: (in category 'instruction decoding') ----- + jump: distance + "Simulate the action of a 'unconditional jump' bytecode whose offset is + the argument, distance." + + pc := pc + distance! Item was added: + ----- Method: Context>>jump:if: (in category 'instruction decoding') ----- + jump: distance if: condition + "Simulate the action of a 'conditional jump' bytecode whose offset is the + argument, distance, and whose condition is the argument, condition." + + | bool | + bool := self pop. + (bool == true or: [bool == false]) ifFalse: [ + ^self + send: #mustBeBooleanIn: + to: bool + with: {self} + super: false]. + (bool eqv: condition) ifTrue: [self jump: distance]! Item was added: + ----- Method: Context>>longStack (in category 'debugger access') ----- + longStack + "Answer a String showing the top 100 contexts on my sender chain." + + ^ String streamContents: + [:strm | + (self stackOfSize: 100) + do: [:item | strm print: item; cr]]! Item was added: + ----- Method: Context>>method (in category 'accessing') ----- + method + + ^method! Item was added: + ----- Method: Context>>methodClass (in category 'debugger access') ----- + methodClass + "Answer the class in which the receiver's method was found." + + ^self method methodClass ifNil: [self objectClass: self receiver].! Item was added: + ----- Method: Context>>methodNode (in category 'accessing') ----- + methodNode + ^ self method methodNode.! Item was added: + ----- Method: Context>>methodNodeFormattedAndDecorated: (in category 'accessing') ----- + methodNodeFormattedAndDecorated: decorate + "Answer a method node made from pretty-printed (and colorized, if decorate is true) + source text." + + ^ self method methodNodeFormattedAndDecorated: decorate.! Item was added: + ----- Method: Context>>methodReturnConstant: (in category 'instruction decoding') ----- + methodReturnConstant: value + "Simulate the action of a 'return constant' bytecode whose value is the + argument, value. This corresponds to a source expression like '^0'." + + ^self return: value from: self methodReturnContext! Item was added: + ----- Method: Context>>methodReturnContext (in category 'accessing') ----- + methodReturnContext + "Answer the context from which an ^-return should return from." + + closureOrNil == nil ifTrue: + [^self]. + ^closureOrNil outerContext methodReturnContext! Item was added: + ----- Method: Context>>methodReturnReceiver (in category 'instruction decoding') ----- + methodReturnReceiver + "Simulate the action of a 'return receiver' bytecode. This corresponds to + the source expression '^self'." + + ^self return: self receiver from: self methodReturnContext! Item was added: + ----- Method: Context>>methodReturnTop (in category 'instruction decoding') ----- + methodReturnTop + "Simulate the action of a 'return top of stack' bytecode. This corresponds + to source expressions like '^something'." + + ^self return: self pop from: self methodReturnContext! Item was added: + ----- Method: Context>>namedTempAt: (in category 'debugger access') ----- + namedTempAt: index + "Answer the value of the temp at index in the receiver's sequence of tempNames." + ^self debuggerMap namedTempAt: index in: self! Item was added: + ----- Method: Context>>namedTempAt:put: (in category 'debugger access') ----- + namedTempAt: index put: aValue + "Set the value of the temp at index in the receiver's sequence of tempNames. + (Note that if the value is a copied value it is also set out along the lexical chain, + but alas not in along the lexical chain.)." + ^self debuggerMap namedTempAt: index put: aValue in: self! Item was added: + ----- Method: Context>>nextHandlerContext (in category 'private-exceptions') ----- + nextHandlerContext + + ^ self sender findNextHandlerContextStarting! Item was added: + ----- Method: Context>>numArgs (in category 'accessing') ----- + numArgs + "Answer the number of arguments for this activation." + ^closureOrNil + ifNil: [method numArgs] + ifNotNil: [closureOrNil numArgs]! Item was added: + ----- Method: Context>>numTemps (in category 'accessing') ----- + numTemps + "Answer the number of temporaries for this activation; this includes + the number of arguments, and for blocks, the number of copied values." + ^closureOrNil + ifNil: [method numTemps] + ifNotNil: [closureOrNil numTemps]! Item was added: + ----- Method: Context>>object:basicAt: (in category 'mirror primitives') ----- + object: anObject basicAt: index + "Answer the value of an indexable element in the argument anObject without sending + it a message. Fail if the argument index is not an Integer or is out of bounds, or if + anObject is not indexable. This mimics the action of the VM when it indexes an object. + Used to simulate the execution machinery by, for example, the debugger. + Primitive. See Object documentation whatIsAPrimitive." + + <primitive: 60> + index isInteger ifTrue: [self errorSubscriptBounds: index]. + index isNumber + ifTrue: [^self object: anObject basicAt: index asInteger] + ifFalse: [self errorNonIntegerIndex]! Item was added: + ----- Method: Context>>object:basicAt:put: (in category 'mirror primitives') ----- + object: anObject basicAt: index put: value + "Store the last argument + value in the indexable element of the argument anObject indicated by index without sending + anObject a message. Fail if the argument index is not an Integer or is out of bounds, or if + anObject is not indexable, or if value is an inappropriate value for anObject's indexable slots. + This mimics the action of the VM when it indexes an object. + Used to simulate the execution machinery by, for example, the debugger. + Primitive. See Object documentation whatIsAPrimitive." + + <primitive: 61> + index isInteger + ifTrue: [(index >= 1 and: [index <= (self objectSize: anObject)]) + ifTrue: [self errorImproperStore] + ifFalse: [self errorSubscriptBounds: index]]. + index isNumber + ifTrue: [^self object: anObject basicAt: index asInteger put: value] + ifFalse: [self errorNonIntegerIndex]! Item was added: + ----- Method: Context>>object:eqeq: (in category 'mirror primitives') ----- + object: anObject eqeq: anOtherObject + "Answer whether the first and second arguments are the same object (have the + same object pointer) without sending a message to the first argument. This + mimics the action of the VM when it compares two object pointers. Used to + simulate the execution machinery by, for example, the debugger. + Primitive. See Object documentation whatIsAPrimitive." + + <primitive: 110> + self primitiveFailed! Item was added: + ----- Method: Context>>object:instVarAt: (in category 'mirror primitives') ----- + object: anObject instVarAt: anIndex + "Primitive. Answer a fixed variable in an object. The numbering of the + variables corresponds to the named instance variables. Fail if the index + is not an Integer or is not the index of a fixed variable. Essential for the + debugger. See Object documentation whatIsAPrimitive." + + <primitive: 73> + "Access beyond fixed variables." + ^self object: anObject basicAt: anIndex - (self objectClass: anObject) instSize! Item was added: + ----- Method: Context>>object:instVarAt:put: (in category 'mirror primitives') ----- + object: anObject instVarAt: anIndex put: aValue + "Primitive. Store a value into a fixed variable in the argument anObject. + The numbering of the variables corresponds to the named instance + variables. Fail if the index is not an Integer or is not the index of a + fixed variable. Answer the value stored as the result. Using this + message violates the principle that each object has sovereign control + over the storing of values into its instance variables. Essential for the + debugger. See Object documentation whatIsAPrimitive." + + <primitive: 74> + "Access beyond fixed fields" + ^self object: anObject basicAt: anIndex - (self objectClass: anObject) instSize put: aValue! Item was added: + ----- Method: Context>>object:perform:withArguments:inClass: (in category 'mirror primitives') ----- + object: anObject perform: selector withArguments: argArray inClass: lookupClass + "Send the selector, aSymbol, to anObject with arguments in argArray. + Fail if the number of arguments expected by the selector + does not match the size of argArray, or if lookupClass + cannot be found among the anObject's superclasses. + Primitive. Essential for the debugger." + + <primitive: 100 error: error> + (selector isSymbol) ifFalse: + [^self error: 'selector argument must be a Symbol']. + (argArray isMemberOf: Array) ifFalse: + [^self error: 'argArray must be an Array']. + (selector numArgs = argArray size) + ifFalse: [^self error: 'incorrect number of arguments']. + ((self objectClass: anObject) == lookupClass + or: [(self objectClass: anObject) inheritsFrom: lookupClass]) ifFalse: + [^self error: 'lookupClass is not in anObject''s inheritance chain']. + self primitiveFailed! Item was added: + ----- Method: Context>>objectClass: (in category 'mirror primitives') ----- + objectClass: anObject + "Answer the class of the argument anObject without sending it a message. + This mimics the action of the VM when it fetches an object's class. Used to + simulate the execution machinery by, for example, the debugger. + Primitive. See Object documentation whatIsAPrimitive." + + <primitive: 111> + self primitiveFailed! Item was added: + ----- Method: Context>>objectSize: (in category 'mirror primitives') ----- + objectSize: anObject + "Answer the number of indexable variables in the argument anObject without sending + it a message. This mimics the action of the VM when it fetches an object's variable size. + Used to simulate the execution machinery by, for example, the debugger. + Primitive. See Object documentation whatIsAPrimitive." + + <primitive: 62> + "The number of indexable fields of fixed-length objects is 0" + ^0! Item was added: + ----- Method: Context>>outerContext (in category 'accessing') ----- + outerContext + "Answer the context within which the receiver is nested." + + ^closureOrNil ifNotNil: + [closureOrNil outerContext]! Item was added: + ----- Method: Context>>pc (in category 'debugger access') ----- + pc + "Answer the index of the next bytecode to be executed." + + ^pc! Item was added: + ----- Method: Context>>pop (in category 'controlling') ----- + pop + "Answer the top of the receiver's stack and remove the top of the stack." + | val | + val := self at: stackp. + self stackp: stackp - 1. + ^ val! Item was added: + ----- Method: Context>>popIntoLiteralVariable: (in category 'instruction decoding') ----- + popIntoLiteralVariable: value + "Simulate the action of bytecode that removes the top of the stack and + stores it into a literal variable of my method." + + self object: value instVarAt: ValueIndex put: self pop! Item was added: + ----- Method: Context>>popIntoReceiverVariable: (in category 'instruction decoding') ----- + popIntoReceiverVariable: offset + "Simulate the action of bytecode that removes the top of the stack and + stores it into an instance variable of my receiver." + + self object: self receiver instVarAt: offset + 1 put: self pop! Item was added: + ----- Method: Context>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- + popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex + "Simulate the action of bytecode that removes the top of the stack and stores + it into an offset in one of my local variables being used as a remote temp vector." + + self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self pop! Item was added: + ----- Method: Context>>popIntoTemporaryVariable: (in category 'instruction decoding') ----- + popIntoTemporaryVariable: offset + "Simulate the action of bytecode that removes the top of the stack and + stores it into one of my temporary variables." + + self at: offset + 1 put: self pop! Item was added: + ----- Method: Context>>print:on: (in category 'debugger access') ----- + print: anObject on: aStream + "Safely print anObject in the face of direct ProtoObject subclasses." + | objClass title | + objClass := self objectClass: anObject. + (objClass canUnderstand: #printOn:) ifTrue: + [^anObject printOn: aStream]. + title := objClass name. + aStream + nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']); + nextPutAll: title! Item was added: + ----- Method: Context>>printDetails: (in category 'printing') ----- + printDetails: strm + "Put my class>>selector and instance variables and arguments and temporaries on the stream. Protect against errors during printing." + + | pe str pos | + self printOn: strm. + strm cr. + strm tab; nextPutAll: 'Receiver: '. + pe := '<<error during printing>>'. + strm nextPutAll: ([receiver printStringLimitedTo: 90] ifError: [:err :rcvr | pe]). + + strm cr; tab; nextPutAll: 'Arguments and temporary variables: '; cr. + str := [(self tempsAndValuesLimitedTo: 80 indent: 2) + padded: #right to: 1 with: $x] ifError: [:err :rcvr | pe]. + strm nextPutAll: (str allButLast). + + strm cr; tab; nextPutAll: 'Receiver''s instance variables: '; cr. + pos := strm position. + [receiver longPrintOn: strm limitedTo: 80 indent: 2] ifError: [:err :rcvr | + strm nextPutAll: pe]. + pos = strm position ifTrue: ["normal printString for an Array (it has no inst vars)" + strm nextPutAll: ([receiver printStringLimitedTo: 90] ifError: [:err :rcvr | pe])]. + strm peekLast == Character cr ifFalse: [strm cr].! Item was added: + ----- Method: Context>>printOn: (in category 'printing') ----- + printOn: aStream + | class mclass selector | + method ifNil: + [^super printOn: aStream]. + + closureOrNil ifNotNil: + [aStream nextPutAll: '[] in '. + closureOrNil outerContext printOn: aStream]. + + class := self objectClass: self receiver. + mclass := method methodClass. + selector := method selector ifNil: [method defaultSelector]. + + aStream nextPutAll: class name. + mclass ~~ class ifTrue: + [aStream nextPut: $(; nextPutAll: mclass name; nextPut: $)]. + aStream nextPutAll: '>>'; nextPutAll: selector. + + (selector == #doesNotUnderstand: + and: [(self objectClass: (self tempAt: 1)) == Message]) ifTrue: + [aStream space. + (self tempAt: 1) selector printOn: aStream]! Item was added: + ----- Method: Context>>printString (in category 'printing') ----- + printString + "Answer an emphasized string in case of a breakpoint method" + + ^(self method notNil and: [self method hasBreakpoint]) + ifTrue:[(super printString , ' [break]') asText allBold] + ifFalse:[super printString]! Item was added: + ----- Method: Context>>privRefresh (in category 'initialize-release') ----- + privRefresh + "Reinitialize the receiver so that it is in the state it was at its creation." + + closureOrNil + ifNotNil: + [pc := closureOrNil startpc. + self stackp: closureOrNil numArgs + closureOrNil numCopiedValues. + 1 to: closureOrNil numCopiedValues do: + [:i | self tempAt: closureOrNil numArgs + i put: (closureOrNil at: i)]] + ifNil: + [pc := method initialPC. + self stackp: method numTemps. + method numArgs+1 to: method numTemps do: + [:i | self tempAt: i put: nil]]! Item was added: + ----- Method: Context>>privRefreshWith: (in category 'initialize-release') ----- + privRefreshWith: aCompiledMethod + "Reinitialize the receiver as though it had been for a different method. + Used by a Debugger when one of the methods to which it refers is + recompiled." + + aCompiledMethod isCompiledMethod ifFalse: + [self error: 'method can only be set to aCompiledMethod']. + method := aCompiledMethod. + self assert: closureOrNil == nil. + "was: receiverMap := nil." + self privRefresh! Item was added: + ----- Method: Context>>privSender: (in category 'private') ----- + privSender: aContext + + sender := aContext! Item was added: + ----- Method: Context>>push: (in category 'controlling') ----- + push: val + "Push val on the receiver's stack." + + self stackp: stackp + 1. + self at: stackp put: val! Item was added: + ----- Method: Context>>push:fromIndexable: (in category 'private') ----- + push: numObjects fromIndexable: anIndexableCollection + "Push the elements of anIndexableCollection onto the receiver's stack. + Do not call directly. Called indirectly by {1. 2. 3} constructs." + + 1 to: numObjects do: + [:i | self push: (anIndexableCollection at: i)]! Item was added: + ----- Method: Context>>pushActiveContext (in category 'instruction decoding') ----- + pushActiveContext + "Simulate the action of bytecode that pushes the the active context on the + top of its own stack." + + self push: self! Item was added: + ----- Method: Context>>pushArgs:from: (in category 'system simulation') ----- + pushArgs: args "<Array>" from: sendr "<ContextPart>" + "Helps simulate action of the value primitive for closures. + This is used by ContextPart>>runSimulated:contextAtEachStep:" + + closureOrNil + ifNil: [self error: 'context needs a closure!!'] + ifNotNil: + ["See BlockClosure>>asContextWithSender:" + stackp ~= (closureOrNil numArgs + closureOrNil numCopiedValues) ifTrue: + [self error: 'stack pointer is incorrect!!'].]. + + 1 to: closureOrNil numArgs do: + [:i| self at: i put: (args at: i)]. + sender := sendr! Item was added: + ----- Method: Context>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') ----- + pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize + "Simulate the action of a 'closure copy' bytecode whose result is the + new BlockClosure for the following code" + | copiedValues | + numCopied > 0 + ifTrue: + [copiedValues := Array new: numCopied. + numCopied to: 1 by: -1 do: + [:i| + copiedValues at: i put: self pop]] + ifFalse: + [copiedValues := nil]. + self push: (BlockClosure + outerContext: self + startpc: pc + numArgs: numArgs + copiedValues: copiedValues). + self jump: blockSize! Item was added: + ----- Method: Context>>pushConsArrayWithElements: (in category 'instruction decoding (closures)') ----- + pushConsArrayWithElements: numElements + | array | + array := Array new: numElements. + numElements to: 1 by: -1 do: + [:i| + array at: i put: self pop]. + self push: array! Item was added: + ----- Method: Context>>pushConstant: (in category 'instruction decoding') ----- + pushConstant: value + "Simulate the action of bytecode that pushes the constant, value, on the + top of the stack." + + self push: value! Item was added: + ----- Method: Context>>pushLiteralVariable: (in category 'instruction decoding') ----- + pushLiteralVariable: value + "Simulate the action of bytecode that pushes the contents of the literal + variable whose index is the argument, index, on the top of the stack." + + self push: (self object: value instVarAt: ValueIndex)! Item was added: + ----- Method: Context>>pushNewArrayOfSize: (in category 'instruction decoding') ----- + pushNewArrayOfSize: arraySize + self push: (Array new: arraySize)! Item was added: + ----- Method: Context>>pushReceiver (in category 'instruction decoding') ----- + pushReceiver + "Simulate the action of bytecode that pushes the active context's receiver + on the top of the stack." + + self push: self receiver! Item was added: + ----- Method: Context>>pushReceiverVariable: (in category 'instruction decoding') ----- + pushReceiverVariable: offset + "Simulate the action of bytecode that pushes the contents of the receiver's + instance variable whose index is the argument, index, on the top of the + stack." + + self push: (self object: self receiver instVarAt: offset + 1)! Item was added: + ----- Method: Context>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- + pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex + "Simulate the action of bytecode that pushes the value at remoteTempIndex + in one of my local variables being used as a remote temp vector." + self push: (self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1)! Item was added: + ----- Method: Context>>pushTemporaryVariable: (in category 'instruction decoding') ----- + pushTemporaryVariable: offset + "Simulate the action of bytecode that pushes the contents of the + temporary variable whose index is the argument, index, on the top of + the stack." + + self push: (self at: offset + 1)! Item was added: + ----- Method: Context>>quickSend:to:with:super: (in category 'controlling') ----- + quickSend: selector to: rcvr with: arguments super: superFlag + "Send the given selector with arguments in an environment which closely resembles + the non-simulating environment, with an interjected unwind-protected block to catch + nonlocal returns. Attention: don't get lost!! This beautiful method is due to + Hans-Martin Mosner. Eliot Miranda merely added the mirror primitive code." + | oldSender contextToReturnTo result lookupClass | + contextToReturnTo := self. + lookupClass := superFlag + ifTrue: [self method methodClassAssociation value superclass] + ifFalse: [self objectClass: rcvr]. + [oldSender := thisContext sender swapSender: self. + result := self object: rcvr perform: selector withArguments: arguments inClass: lookupClass. + thisContext sender swapSender: oldSender] ifCurtailed: + [contextToReturnTo := thisContext sender receiver. "The block context returning nonlocally" + contextToReturnTo pc: contextToReturnTo previousPc. "skip to front of return bytecode causing this unwind" + contextToReturnTo willReturnTopFromMethod ifTrue: + "If it was a returnTop, push the value to be returned. + Otherwise the value is implicit in the bytecode" + [contextToReturnTo push: (thisContext sender tempAt: 1)]. + thisContext swapSender: thisContext home sender. "Make this block return to the method's sender" + contextToReturnTo]. + contextToReturnTo push: result. + ^contextToReturnTo! Item was added: + ----- Method: Context>>quickStep (in category 'system simulation') ----- + quickStep + "If the next instruction is a send, just perform it. + Otherwise, do a normal step." + + self willReallySend ifTrue: [QuickStep := self]. + ^self step! Item was added: + ----- Method: Context>>readDataFrom:size: (in category 'objects from disk') ----- + readDataFrom: aDataStream size: varsOnDisk + "Fill in the fields of self based on the contents of aDataStream. Answer self. + Read in the instance-variables written by Object>>storeDataOn:. + NOTE: This method must send beginReference: before reading any objects from aDataStream that might reference it. + Allow aDataStream to have fewer inst vars. See SmartRefStream. + Override to not store nil stack contents beyond stack pointer." + | cntInstVars cntIndexedVars | + + cntInstVars := self class instSize. + cntIndexedVars := varsOnDisk - cntInstVars. + cntIndexedVars < 0 ifTrue: + [self error: 'Class has changed too much. Define a convertxxx method']. + + aDataStream beginReference: self. + 1 to: cntInstVars do: + [:i | self instVarAt: i put: aDataStream next]. + 1 to: stackp do: + [:i | self basicAt: i put: aDataStream next]. + stackp + 1 to: cntIndexedVars do: + [:i | aDataStream next ~~ nil ifTrue: + [self error: 'Reading a Context''s contents expects only nil beyond top of stack']]. + "Total number read MUST be equal to varsOnDisk!!" + ^self "If we ever answer something other than self, fix calls + on (super readDataFrom: aDataStream size: anInteger)"! Item was added: + ----- Method: Context>>rearmHandlerDuring: (in category 'private-exceptions') ----- + rearmHandlerDuring: aBlock + "Sent to handler (on:do:) contexts only. Makes me re-entrant for the duration of aBlock. Only works in a closure-enabled image" + + ^ [self tempAt: 3 put: true. aBlock value] + ensure: [self tempAt: 3 put: false]! Item was added: + ----- Method: Context>>receiver (in category 'accessing') ----- + receiver + "Refer to the comment in ContextPart|receiver." + + ^receiver! Item was added: + ----- Method: Context>>receiver: (in category 'private-exceptions') ----- + receiver: r + + receiver := r! Item was added: + ----- Method: Context>>release (in category 'debugger access') ----- + release + "Remove information from the receiver and all of the contexts on its + sender chain in order to break circularities." + + self releaseTo: nil! Item was added: + ----- Method: Context>>releaseTo: (in category 'debugger access') ----- + releaseTo: caller + "Remove information from the receiver and the contexts on its sender + chain up to caller in order to break circularities." + + | c s | + c := self. + [c == nil or: [c == caller]] + whileFalse: + [s := c sender. + c singleRelease. + c := s]! Item was added: + ----- Method: Context>>removeSelf (in category 'accessing') ----- + removeSelf + "Nil the receiver pointer and answer its former value." + + | tempSelf | + tempSelf := receiver. + receiver := nil. + ^tempSelf! Item was added: + ----- Method: Context>>restart (in category 'controlling') ----- + restart + "Unwind thisContext to self and resume from beginning. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" + + | ctxt unwindBlock | + self isDead ifTrue: [self cannotReturn: nil to: self]. + self privRefresh. + ctxt := thisContext. + [ ctxt := ctxt findNextUnwindContextUpTo: self. + ctxt isNil + ] whileFalse: [ + (ctxt tempAt: 2) ifNil:[ + ctxt tempAt: 2 put: true. + unwindBlock := ctxt tempAt: 1. + thisContext terminateTo: ctxt. + unwindBlock value]. + ]. + thisContext terminateTo: self. + self jump. + ! Item was added: + ----- Method: Context>>restartWithNewReceiver: (in category 'private-exceptions') ----- + restartWithNewReceiver: obj + + self + swapReceiver: obj; + restart! Item was added: + ----- Method: Context>>resume (in category 'controlling') ----- + resume + "Roll back thisContext to self and resume. Execute unwind blocks when rolling back. ASSUMES self is a sender of thisContext" + + self resume: nil! Item was added: + ----- Method: Context>>resume: (in category 'controlling') ----- + resume: value + "Unwind thisContext to self and resume with value as result of last send. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" + + | ctxt unwindBlock | + self isDead ifTrue: [self cannotReturn: value to: self]. + ctxt := thisContext. + [ ctxt := ctxt findNextUnwindContextUpTo: self. + ctxt isNil + ] whileFalse: [ + (ctxt tempAt: 2) ifNil:[ + ctxt tempAt: 2 put: true. + unwindBlock := ctxt tempAt: 1. + thisContext terminateTo: ctxt. + unwindBlock value]. + ]. + thisContext terminateTo: self. + ^ value + ! Item was added: + ----- Method: Context>>resume:through: (in category 'controlling') ----- + resume: value through: firstUnwindCtxt + "Unwind thisContext to self and resume with value as result of last send. + Execute any unwind blocks while unwinding. + ASSUMES self is a sender of thisContext." + + | ctxt unwindBlock | + self isDead ifTrue: [self cannotReturn: value to: self]. + ctxt := firstUnwindCtxt. + [ctxt isNil] whileFalse: + [(ctxt tempAt: 2) ifNil: + [ctxt tempAt: 2 put: true. + unwindBlock := ctxt tempAt: 1. + thisContext terminateTo: ctxt. + unwindBlock value]. + ctxt := ctxt findNextUnwindContextUpTo: self]. + thisContext terminateTo: self. + ^value + ! Item was added: + ----- Method: Context>>return (in category 'controlling') ----- + return + "Unwind until my sender is on top" + + self return: self receiver! Item was added: + ----- Method: Context>>return: (in category 'controlling') ----- + return: value + "Unwind thisContext to self and return value to self's sender. Execute any unwind blocks while unwinding. ASSUMES self is a sender of thisContext" + + sender ifNil: [self cannotReturn: value to: sender]. + sender resume: value! Item was added: + ----- Method: Context>>return:from: (in category 'instruction decoding') ----- + return: value from: aSender + "For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self" + + | newTop ctxt | + aSender isDead ifTrue: [ + ^ self send: #cannotReturn: to: self with: {value} super: false]. + newTop := aSender sender. + ctxt := self findNextUnwindContextUpTo: newTop. + ctxt ifNotNil: [ + ^ self send: #aboutToReturn:through: to: self with: {value. ctxt} super: false]. + self releaseTo: newTop. + newTop ifNotNil: [newTop push: value]. + ^ newTop + ! Item was added: + ----- Method: Context>>return:through: (in category 'controlling') ----- + return: value through: firstUnwindContext + "Unwind thisContext to self and return value to self's sender. + Execute any unwind blocks while unwinding. + ASSUMES self is a sender of thisContext." + + sender ifNil: [self cannotReturn: value to: sender]. + sender resume: value through: firstUnwindContext! Item was added: + ----- Method: Context>>return:to: (in category 'controlling') ----- + return: value to: sendr + "Simulate the return of value to sendr." + + self releaseTo: sendr. + sendr ifNil: [^ nil]. + ^ sendr push: value! Item was added: + ----- Method: Context>>runSimulated:contextAtEachStep: (in category 'system simulation') ----- + runSimulated: aBlock contextAtEachStep: block2 + "Simulate the execution of the argument, aBlock, until it ends. aBlock + MUST NOT contain an '^'. Evaluate block2 with the current context + prior to each instruction executed. Answer the simulated value of aBlock." + | current | + aBlock hasMethodReturn + ifTrue: [self error: 'simulation of blocks with ^ can run loose']. + current := aBlock asContext. + current pushArgs: Array new from: self. + [current == self] + whileFalse: + [block2 value: current. + current := current step]. + ^self pop! Item was added: + ----- Method: Context>>runUntilErrorOrReturnFrom: (in category 'controlling') ----- + runUntilErrorOrReturnFrom: aSender + "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." + "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." + + | error ctxt here topContext | + here := thisContext. + + "Insert ensure and exception handler contexts under aSender" + error := nil. + ctxt := aSender insertSender: (Context + contextOn: UnhandledError do: [:ex | + error ifNil: [ + error := ex exception. + topContext := thisContext. + ex resumeUnchecked: here jump] + ifNotNil: [ex pass] + ]). + ctxt := ctxt insertSender: (Context + contextEnsure: [error ifNil: [ + topContext := thisContext. + here jump] + ]). + self jump. "Control jumps to self" + + "Control resumes here once above ensure block or exception handler is executed" + ^ error ifNil: [ + "No error was raised, remove ensure context by stepping until popped" + [ctxt isDead] whileFalse: [topContext := topContext stepToCallee]. + {topContext. nil} + + ] ifNotNil: [ + "Error was raised, remove inserted above contexts then return signaler context" + aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" + {topContext. error} + ]. + ! Item was added: + ----- Method: Context>>secondFromBottom (in category 'query') ----- + secondFromBottom + "Return the second from bottom of my sender chain" + + self sender ifNil: [^ nil]. + ^ self findContextSuchThat: [:c | c sender sender isNil]! Item was added: + ----- Method: Context>>selector (in category 'debugger access') ----- + selector + "Answer the selector of the method that created the receiver." + + ^self method selector ifNil: [self method defaultSelector].! Item was added: + ----- Method: Context>>selectorCategory (in category 'accessing') ----- + selectorCategory + "Answer the category to which this message belongs (relative to the receiver). + If no superclass categorises this message, use the default." + | rcvrClass organizers | + rcvrClass := self objectClass: self receiver. + organizers := rcvrClass withAllSuperclasses collect: [:ea | ea organization]. + organizers addFirst: rcvrClass organization. + ^(organizers collect: [ :org | org categoryOfElement: self selector]) + detect: [:ea | ea ~= ClassOrganizer default and: [ea ~= nil]] + ifNone: [ClassOrganizer default]! Item was added: + ----- Method: Context>>send:super:numArgs: (in category 'instruction decoding') ----- + send: selector super: superFlag numArgs: numArgs + "Simulate the action of bytecodes that send a message with selector, + selector. The argument, superFlag, tells whether the receiver of the + message was specified with 'super' in the source method. The arguments + of the message are found in the top numArgs locations on the stack and + the receiver just below them." + + | receiver arguments | + arguments := Array new: numArgs. + numArgs to: 1 by: -1 do: [ :i | arguments at: i put: self pop]. + receiver := self pop. + QuickStep == self ifTrue: + [QuickStep := nil. + ^self quickSend: selector to: receiver with: arguments super: superFlag]. + ^self send: selector to: receiver with: arguments super: superFlag! Item was added: + ----- Method: Context>>send:to:with:lookupIn: (in category 'controlling') ----- + send: selector to: rcvr with: arguments lookupIn: lookupClass + "Simulate the action of sending a message with selector and arguments + to rcvr. The argument, lookupClass, is the class in which to lookup the + message. This is the receiver's class for normal messages, but for super + messages it will be some specific class related to the source method." + + | meth primIndex val ctxt | + (meth := lookupClass lookupSelector: selector) ifNil: + [^self send: #doesNotUnderstand: + to: rcvr + with: {Message selector: selector arguments: arguments} + lookupIn: lookupClass]. + meth numArgs ~= arguments size ifTrue: + [^self error: 'Wrong number of arguments in simulated message ', selector printString]. + (primIndex := meth primitive) > 0 ifTrue: + [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments. + (self isPrimFailToken: val) ifFalse: + [^val]]. + (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue: + [^self error: 'Simulated message ', arguments first selector, ' not understood']. + ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments. + primIndex > 0 ifTrue: + [ctxt failPrimitiveWith: val]. + ^ctxt! Item was added: + ----- Method: Context>>send:to:with:startClass: (in category 'controlling') ----- + send: selector to: rcvr with: args startClass: startClassOrNil + "Simulate the action of sending a message with selector, selector, and + arguments, args, to receiver. The argument, startClassOrNil, tells whether + the selector should be looked up in startClassOrNil or the class of the receiver." + + | class meth val ctxt | + class := startClassOrNil ifNil: [self objectClass: rcvr]. + meth := class lookupSelector: selector. + meth == nil ifTrue: + [^self + send: #doesNotUnderstand: + to: rcvr + with: (Array with: (Message selector: selector arguments: args)) + startClass: class]. + (args isArray + and: [args size = meth numArgs]) ifFalse: + [^MethodContext primitiveFailTokenFor: nil]. + val := self tryPrimitiveFor: meth receiver: rcvr args: args. + ((self objectClass: val) == Array + and: [val size = 2 + and: [val first == PrimitiveFailToken]]) ifFalse: + [^val]. + (selector == #doesNotUnderstand: + and: [class == ProtoObject]) ifTrue: + [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood']. + ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class. + ((self objectClass: val) == Array + and: [val size = 2 + and: [val first == PrimitiveFailToken + and: [val last notNil + and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue: + [ctxt at: ctxt stackPtr put: val last]. + ^ctxt! Item was added: + ----- Method: Context>>send:to:with:super: (in category 'controlling') ----- + send: selector to: rcvr with: arguments super: superFlag + "Simulate the action of sending a message with selector arguments + to rcvr. The argument, superFlag, tells whether the receiver of the + message was specified with 'super' in the source method." + + ^self send: selector + to: rcvr + with: arguments + lookupIn: (superFlag + ifTrue: [self method methodClassAssociation value superclass] + ifFalse: [self objectClass: rcvr])! Item was added: + ----- Method: Context>>sender (in category 'debugger access') ----- + sender + "Answer the context that sent the message that created the receiver." + + ^sender! Item was added: + ----- Method: Context>>setSender:receiver:method:arguments: (in category 'private') ----- + setSender: s receiver: r method: m arguments: args + "Create the receiver's initial state." + + sender := s. + receiver := r. + method := m. + closureOrNil := nil. + pc := method initialPC. + self stackp: method numTemps. + 1 to: args size do: [:i | self at: i put: (args at: i)]! Item was added: + ----- Method: Context>>setSender:receiver:method:closure:startpc: (in category 'private') ----- + setSender: s receiver: r method: m closure: c startpc: startpc + "Create the receiver's initial state." + + sender := s. + receiver := r. + method := m. + closureOrNil := c. + pc := startpc. + stackp := 0! Item was added: + ----- Method: Context>>shortStack (in category 'debugger access') ----- + shortStack + "Answer a String showing the top ten contexts on my sender chain." + + ^ String streamContents: + [:strm | + (self stackOfSize: 10) + do: [:item | strm print: item; cr]]! Item was added: + ----- Method: Context>>singleRelease (in category 'debugger access') ----- + singleRelease + "Remove information from the receiver in order to break circularities." + + stackp == nil ifFalse: [1 to: stackp do: [:i | self at: i put: nil]]. + sender := nil. + pc := nil. + ! Item was added: + ----- Method: Context>>size (in category 'accessing') ----- + size + "Primitive. Answer the number of indexable variables in the receiver. + This value is the same as the largest legal subscript. Essential. See Object + documentation whatIsAPrimitive. Override the default primitive to give latitude to + the VM in context management." + + <primitive: 212> + "The number of indexable fields of fixed-length objects is 0" + ^self primitiveFailed! Item was added: + ----- Method: Context>>sourceCode (in category 'debugger access') ----- + sourceCode + ^self method getSource. + + "Note: The above is a bit safer than + ^ methodClass sourceCodeAt: selector + which may fail if the receiver's method has been changed in + the debugger (e.g., the method is no longer in the methodDict + and thus the above selector is something like #Doit:with:with:with:) + but the source code is still available."! Item was added: + ----- Method: Context>>stack (in category 'debugger access') ----- + stack + "Answer an Array of the contexts on the receiver's sender chain." + + ^self stackOfSize: 9999! Item was added: + ----- Method: Context>>stackOfSize: (in category 'debugger access') ----- + stackOfSize: limit + "Answer an OrderedCollection of the top 'limit' contexts + on the receiver's sender chain." + + | stack ctxt | + stack := OrderedCollection new. + stack addLast: (ctxt := self). + [(ctxt := ctxt sender) ~~ nil + and: [stack size < limit]] whileTrue: + [stack addLast: ctxt]. + ^stack! Item was added: + ----- Method: Context>>stackPtr (in category 'private') ----- + stackPtr "For use only by the SystemTracer and the Debugger, Inspectors etc" + ^ stackp! Item was added: + ----- Method: Context>>stackp: (in category 'private') ----- + stackp: newStackp + "Storing into the stack pointer is a potentially dangerous thing. + This primitive stores nil into any cells that become accessible as a result, + and it performs the entire operation atomically." + "Once this primitive is implemented, failure code should cause an error" + + <primitive: 76> + self error: 'stackp store failure'. + " + stackp == nil ifTrue: [stackp := 0]. + newStackp > stackp 'effectively checks that it is a number' + ifTrue: [oldStackp := stackp. + stackp := newStackp. + 'Nil any newly accessible cells' + oldStackp + 1 to: stackp do: [:i | self at: i put: nil]] + ifFalse: [stackp := newStackp] + "! Item was added: + ----- Method: Context>>startpc (in category 'private') ----- + startpc + ^closureOrNil + ifNil: [self method initialPC] + ifNotNil: [closureOrNil startpc]! Item was added: + ----- Method: Context>>step (in category 'system simulation') ----- + step + "Simulate the execution of the receiver's next bytecode. Answer the + context that would be the active context after this bytecode." + + ^self interpretNextInstructionFor: self! Item was added: + ----- Method: Context>>stepToCallee (in category 'system simulation') ----- + stepToCallee + "Step to callee or sender" + + | ctxt | + ctxt := self. + [(ctxt := ctxt step) == self] whileTrue. + ^ ctxt! Item was added: + ----- Method: Context>>stepToSendOrReturn (in category 'system simulation') ----- + stepToSendOrReturn + "Simulate the execution of bytecodes until either sending a message or + returning a value to the receiver (that is, until switching contexts)." + + | ctxt | + [self willReallySend or: [self willReturn or: [self willReallyStore]]] whileFalse: + [ctxt := self step. + ctxt == self ifFalse: + [self halt. + "Caused by mustBeBoolean handling" + ^ctxt]]! Item was added: + ----- Method: Context>>storeDataOn: (in category 'objects from disk') ----- + storeDataOn: aDataStream + "Contexts are not always allowed go to out in DataStreams. They must be included inside an ImageSegment, + or be being saved for a closure." + | cntInstVars cntIndexedVars | + + (aDataStream insideASegment + or: [(Notification new tag: self; signal) == self]) ifFalse: "or perhaps ImageSegments were not used at all" + [self error: 'This Context was not included in the ImageSegment']. + + cntInstVars := self class instSize. + cntIndexedVars := self method frameSize. + aDataStream + beginInstance: self class + size: cntInstVars + cntIndexedVars. + 1 to: cntInstVars do: + [:i | aDataStream nextPut: (self instVarAt: i)]. + 1 to: stackp do: + [:i | aDataStream nextPut: (self basicAt: i)]. + stackp + 1 to: cntIndexedVars do: + [:i | aDataStream nextPut: nil]! Item was added: + ----- Method: Context>>storeIntoLiteralVariable: (in category 'instruction decoding') ----- + storeIntoLiteralVariable: value + "Simulate the action of bytecode that stores the top of the stack into a + literal variable of my method." + + self object: value instVarAt: ValueIndex put: self top! Item was added: + ----- Method: Context>>storeIntoReceiverVariable: (in category 'instruction decoding') ----- + storeIntoReceiverVariable: offset + "Simulate the action of bytecode that stores the top of the stack into an + instance variable of my receiver." + + self object: self receiver instVarAt: offset + 1 put: self top! Item was added: + ----- Method: Context>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- + storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex + "Simulate the action of bytecode that stores the top of the stack at + an offset in one of my local variables being used as a remote temp vector." + + self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self top! Item was added: + ----- Method: Context>>storeIntoTemporaryVariable: (in category 'instruction decoding') ----- + storeIntoTemporaryVariable: offset + "Simulate the action of bytecode that stores the top of the stack into one + of my temporary variables." + + self at: offset + 1 put: self top! Item was added: + ----- Method: Context>>swapReceiver: (in category 'private-exceptions') ----- + swapReceiver: r + + receiver := r! Item was added: + ----- Method: Context>>swapSender: (in category 'debugger access') ----- + swapSender: coroutine + "Replace the receiver's sender with coroutine and answer the receiver's + previous sender. For use in coroutining." + + | oldSender | + oldSender := sender. + sender := coroutine. + ^oldSender! Item was added: + ----- Method: Context>>tempAt: (in category 'accessing') ----- + tempAt: index + "Answer the value of the temporary variable whose index is the + argument, index. Primitive. Assumes receiver is indexable. Answer the + value of an indexable element in the receiver. Fail if the argument index + is not an Integer or is out of bounds. Essential. See Object documentation + whatIsAPrimitive. Override the default at: primitive to give latitude to the + VM in context management." + + <primitive: 210> + ^self at: index! Item was added: + ----- Method: Context>>tempAt:put: (in category 'accessing') ----- + tempAt: index put: value + "Store the argument, value, as the temporary variable whose index is the + argument, index. Primitive. Assumes receiver is indexable. Answer the + value of an indexable element in the receiver. Fail if the argument index + is not an Integer or is out of bounds. Essential. See Object documentation + whatIsAPrimitive. Override the default at:put: primitive to give latitude to + the VM in context management." + + <primitive: 211> + ^self at: index put: value! Item was added: + ----- Method: Context>>tempNames (in category 'debugger access') ----- + tempNames + "Answer a SequenceableCollection of the names of the receiver's temporary + variables, which are strings." + + ^ self debuggerMap tempNamesForContext: self! Item was added: + ----- Method: Context>>tempsAndValues (in category 'debugger access') ----- + tempsAndValues + "Return a string of the temporary variables and their current values" + ^self debuggerMap tempsAndValuesForContext: self! Item was added: + ----- Method: Context>>tempsAndValuesLimitedTo:indent: (in category 'debugger access') ----- + tempsAndValuesLimitedTo: sizeLimit indent: indent + "Return a string of the temporary variabls and their current values" + + | aStream | + aStream := WriteStream on: (String new: 100). + self tempNames + doWithIndex: [:title :index | + indent timesRepeat: [aStream tab]. + aStream nextPutAll: title; nextPut: $:; space; tab. + aStream nextPutAll: + ((self tempAt: index) printStringLimitedTo: (sizeLimit -3 -title size max: 1)). + aStream cr]. + ^aStream contents! Item was added: + ----- Method: Context>>terminate (in category 'controlling') ----- + terminate + "Make myself unresumable." + + sender := nil. + pc := nil. + ! Item was added: + ----- Method: Context>>terminateTo: (in category 'controlling') ----- + terminateTo: previousContext + "Terminate all the Contexts between me and previousContext, if previousContext is on my Context stack. Make previousContext my sender." + + | currentContext sendingContext | + <primitive: 196> + (self hasSender: previousContext) ifTrue: [ + currentContext := sender. + [currentContext == previousContext] whileFalse: [ + sendingContext := currentContext sender. + currentContext terminate. + currentContext := sendingContext]]. + sender := previousContext! Item was added: + ----- Method: Context>>top (in category 'controlling') ----- + top + "Answer the top of the receiver's stack." + + ^self at: stackp! Item was added: + ----- Method: Context>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') ----- + tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments + "Invoke the named primitive for aCompiledMethod, answering its result, or, + if the primiitve fails, answering the error code." + <primitive: 218 error: ec> + ec ifNotNil: + ["If ec is an integer other than -1 there was a problem with primitive 218, + not with the external primitive itself. -1 indicates a generic failure (where + ec should be nil) but ec = nil means primitive 218 is not implemented. So + interpret -1 to mean the external primitive failed with a nil error code." + ec isInteger ifTrue: + [ec = -1 + ifTrue: [ec := nil] + ifFalse: [self primitiveFailed]]]. + ^self class primitiveFailTokenFor: ec! Item was added: + ----- Method: Context>>tryPrimitiveFor:receiver:args: (in category 'private') ----- + tryPrimitiveFor: method receiver: receiver args: arguments + "If this method has a primitive index, then run the primitive and return its result. + Otherwise (and also if the primitive fails) return PrimitiveFailToken, + as an indication that the method should be activated and run as bytecodes." + | primIndex | + (primIndex := method primitive) = 0 ifTrue: [^{PrimitiveFailToken. nil}]. + ^ self doPrimitive: primIndex method: method receiver: receiver args: arguments! Item was added: + ----- Method: Context>>unwindTo: (in category 'private-exceptions') ----- + unwindTo: aContext + + | ctx unwindBlock | + ctx := self. + [(ctx := ctx findNextUnwindContextUpTo: aContext) isNil] whileFalse: [ + (ctx tempAt: 2) ifNil:[ + ctx tempAt: 2 put: true. + unwindBlock := ctx tempAt: 1. + unwindBlock value] + ]. + ! Item was removed: - ContextPart variableSubclass: #MethodContext - instanceVariableNames: 'method closureOrNil receiver' - classVariableNames: '' - poolDictionaries: '' - category: 'Kernel-Methods'! - - !MethodContext commentStamp: '<historical>' prior: 0! - My instances hold all the dynamic state associated with the execution of either a method activation resulting from a message send or a block activation resulting from a block evaluation. In addition to their inherited state, this includes the receiver (self), the closure for a BlockClosure activation (which is nil for a method activation), a CompiledMethod, and space in the variable part of the context for arguments and temporary variables. - - MethodContexts, though normal in their variable size, are actually only used in two sizes, small and large, which are determined by the temporary space required by the method being executed. - - MethodContexts must only be created using the method newForMethod:. Note that it is impossible to determine the real object size of a MethodContext except by asking for the frameSize of its method. Any fields above the stack pointer (stackp) are truly invisible -- even (and especially!!) to the garbage collector. Any store into stackp other than by the primitive method stackp: is potentially fatal.! Item was removed: - ----- Method: MethodContext class>>allInstances (in category 'enumerating') ----- - allInstances - "Answer all instances of the receiver." - <primitive: 177> - "The primitive can fail because memory is low. If so, fall back on the old - enumeration code, which gives the system a chance to GC and/or grow. - Because aBlock might change the class of inst (for example, using become:), - it is essential to compute next before aBlock value: inst. - Only count until thisContext since this context has been created only to - compute the existing instances." - | inst insts next | - insts := WriteStream on: (Array new: 64). - inst := self someInstance. - [inst == thisContext or: [inst == nil]] whileFalse: - [next := inst nextInstance. - insts nextPut: inst. - inst := next]. - ^insts contents! Item was removed: - ----- Method: MethodContext class>>allInstancesDo: (in category 'private') ----- - allInstancesDo: aBlock - "Evaluate aBlock with each of the current instances of the receiver." - | instances inst next | - instances := self allInstancesOrNil. - instances ifNotNil: - [instances do: aBlock. - ^self]. - "allInstancesOrNil can fail because memory is low. If so, fall back on the old - enumeration code. Because aBlock might change the class of inst (for example, - using become:), it is essential to compute next before aBlock value: inst. - Only count until thisContext since evaluation of aBlock will create new contexts." - inst := self someInstance. - [inst == thisContext or: [inst == nil]] whileFalse: - [next := inst nextInstance. - aBlock value: inst. - inst := next]! Item was removed: - ----- Method: MethodContext class>>basicNew: (in category 'instance creation') ----- - basicNew: size - ^ (size = CompiledMethod smallFrameSize or: [ size = CompiledMethod fullFrameSize ]) - ifTrue: [ super basicNew: size ] - ifFalse: [ self error: 'Contexts must be ' , CompiledMethod smallFrameSize , ' or ' , CompiledMethod fullFrameSize , ' bytes.' ]! Item was removed: - ----- Method: MethodContext class>>bootstrapContext (in category 'context bootstrap') ----- - bootstrapContext - "Rename MethodContext to Context." - MethodContext ensureClassPool. - MethodContext classPool addAll: ContextPart classPool associations. - MethodContext superclass: InstructionStream. - MethodContext class superclass: InstructionStream class. - InstructionStream addSubclass: MethodContext. - MethodContext - setInstVarNames: ContextPart instVarNames, MethodContext instVarNames; - rename: #Context! Item was removed: - ----- Method: MethodContext class>>carefullyPrint:on: (in category 'private') ----- - carefullyPrint: anObject on: aStream - aStream nextPutAll: ([anObject printString] - on: Error - do: ['unprintable ' , anObject class name])! Item was removed: - ----- Method: MethodContext class>>contextEnsure: (in category 'special context creation') ----- - contextEnsure: block - "Create an #ensure: context that is ready to return from executing its receiver" - - | ctxt chain | - ctxt := thisContext. - [chain := thisContext sender cut: ctxt. ctxt jump] ensure: block. - "jump above will resume here without unwinding chain" - ^ chain! Item was removed: - ----- Method: MethodContext class>>contextOn:do: (in category 'special context creation') ----- - contextOn: exceptionClass do: block - "Create an #on:do: context that is ready to return from executing its receiver" - - | ctxt chain | - ctxt := thisContext. - [chain := thisContext sender cut: ctxt. ctxt jump] on: exceptionClass do: block. - "jump above will resume here without unwinding chain" - ^ chain! Item was removed: - ----- Method: MethodContext class>>initialize (in category 'class initialization') ----- - initialize - ValueIndex := 2. - self assert: (Association instVarNameForIndex:ValueIndex) = 'value'. - PrimitiveFailToken class ~~ Object ifTrue: - [PrimitiveFailToken := Object new]! Item was removed: - ----- Method: MethodContext class>>initializedInstance (in category 'instance creation') ----- - initializedInstance - ^ nil! Item was removed: - ----- Method: MethodContext class>>isContextClass (in category 'private') ----- - isContextClass - ^true! Item was removed: - ----- Method: MethodContext class>>maxLengthForASingleDebugLogReport (in category 'preferences') ----- - maxLengthForASingleDebugLogReport - <preference: 'Max. Debug Report Length' - category: 'debug' - description: 'The description of an Exception stack will be truncated so as to not exceed this value' - type: #Number> - ^MaxLengthForASingleDebugLogReport ifNil: [40000]! Item was removed: - ----- Method: MethodContext class>>maxLengthForASingleDebugLogReport: (in category 'preferences') ----- - maxLengthForASingleDebugLogReport: anInteger - MaxLengthForASingleDebugLogReport := anInteger! Item was removed: - ----- Method: MethodContext class>>maxStackDepthForASingleDebugLogReport (in category 'preferences') ----- - maxStackDepthForASingleDebugLogReport - <preference: 'Max. Debug Report Stack Depth' - category: 'debug' - description: 'In an exception stack, any sender deeper than this value will not be logged.' - type: #Number> - ^MaxStackDepthForASingleDebugLogReport ifNil: [60]! Item was removed: - ----- Method: MethodContext class>>maxStackDepthForASingleDebugLogReport: (in category 'preferences') ----- - maxStackDepthForASingleDebugLogReport: anInteger - MaxStackDepthForASingleDebugLogReport := anInteger! Item was removed: - ----- Method: MethodContext class>>new (in category 'instance creation') ----- - new - - self error: 'Contexts must only be created with newForMethod:'! Item was removed: - ----- Method: MethodContext class>>new: (in category 'instance creation') ----- - new: size - - self error: 'Contexts must only be created with newForMethod:'! Item was removed: - ----- Method: MethodContext class>>newForMethod: (in category 'instance creation') ----- - newForMethod: aMethod - "This is the only method for creating new contexts, other than primitive cloning. - Any other attempts, such as inherited methods like shallowCopy, should be - avoided or must at least be rewritten to determine the proper size from the - method being activated. This is because asking a context its size (even basicSize!!) - will not return the real object size but only the number of fields currently - accessible, as determined by stackp." - - ^ super basicNew: aMethod frameSize! Item was removed: - ----- Method: MethodContext class>>primitiveFailToken (in category 'simulation') ----- - primitiveFailToken - - ^ PrimitiveFailToken! Item was removed: - ----- Method: MethodContext class>>primitiveFailTokenFor: (in category 'simulation') ----- - primitiveFailTokenFor: errorCode - - ^{PrimitiveFailToken. errorCode}! Item was removed: - ----- Method: MethodContext class>>runSimulated: (in category 'simulation') ----- - runSimulated: aBlock - "Simulate the execution of the argument, current. Answer the result it - returns." - - ^ thisContext sender - runSimulated: aBlock - contextAtEachStep: [:ignored] - - "Context runSimulated: [Pen new defaultNib: 5; go: 100]"! Item was removed: - ----- Method: MethodContext class>>sender:receiver:method:arguments: (in category 'instance creation') ----- - sender: s receiver: r method: m arguments: args - "Answer an instance of me with attributes set to the arguments." - - ^(self newForMethod: m) setSender: s receiver: r method: m arguments: args! Item was removed: - ----- Method: MethodContext class>>tallyInstructions: (in category 'examples') ----- - tallyInstructions: aBlock - "This method uses the simulator to count the number of occurrences of - each of the Smalltalk instructions executed during evaluation of aBlock. - Results appear in order of the byteCode set." - | tallies | - tallies := Bag new. - thisContext sender - runSimulated: aBlock - contextAtEachStep: - [:current | tallies add: current nextByte]. - ^tallies sortedElements - - "Context tallyInstructions: [3.14159 printString]"! Item was removed: - ----- Method: MethodContext class>>tallyMethods: (in category 'examples') ----- - tallyMethods: aBlock - "This method uses the simulator to count the number of calls on each method - invoked in evaluating aBlock. Results are given in order of decreasing counts." - | prev tallies | - tallies := Bag new. - prev := aBlock. - thisContext sender - runSimulated: aBlock - contextAtEachStep: - [:current | - current == prev ifFalse: "call or return" - [prev sender == nil ifFalse: "call only" - [tallies add: current printString]. - prev := current]]. - ^tallies sortedCounts - - "Context tallyMethods: [3.14159 printString]"! Item was removed: - ----- Method: MethodContext class>>theReturnMethod (in category 'special context creation') ----- - theReturnMethod - - | meth | - meth := self lookupSelector: #return:. - meth primitive = 0 ifFalse: [^ self error: 'expected #return: to not be a primitive']. - ^ meth! Item was removed: - ----- Method: MethodContext class>>trace: (in category 'examples') ----- - trace: aBlock "Context trace: [3 factorial]" - "This method uses the simulator to print calls and returned values in the Transcript." - - Transcript clear. - ^ self trace: aBlock on: Transcript! Item was removed: - ----- Method: MethodContext class>>trace:on: (in category 'examples') ----- - trace: aBlock on: aStream "Context trace: [3 factorial]" - "This method uses the simulator to print calls to a file." - | prev | - prev := aBlock. - ^ thisContext sender - runSimulated: aBlock - contextAtEachStep: - [:current | - Sensor anyButtonPressed ifTrue: [^ nil]. - current == prev - ifFalse: - [prev sender ifNil: - [aStream space; nextPut: $^. - self carefullyPrint: current top on: aStream]. - aStream cr. - (current depthBelow: aBlock) timesRepeat: [aStream space]. - self carefullyPrint: current receiver on: aStream. - aStream space; nextPutAll: current selector; flush. - prev := current]]! Item was removed: - ----- Method: MethodContext class>>trace:onFileNamed: (in category 'examples') ----- - trace: aBlock onFileNamed: fileName - "Context trace: [3 factorial] onFileNamed: 'trace'" - "This method uses the simulator to print calls to a file." - - ^FileStream fileNamed: fileName do: [ :file | - self trace: aBlock on: file ]! Item was removed: - ----- Method: MethodContext>>aboutToReturn:through: (in category 'private') ----- - aboutToReturn: result through: firstUnwindContext - "Called from VM when an unwindBlock is found between self and its home. - Return to home's sender, executing unwind blocks on the way." - - self methodReturnContext return: result through: firstUnwindContext! Item was removed: - ----- Method: MethodContext>>activateMethod:withArgs:receiver:class: (in category 'controlling') ----- - activateMethod: newMethod withArgs: args receiver: rcvr class: class - "Answer a ContextPart initialized with the arguments." - - ^MethodContext - sender: self - receiver: rcvr - method: newMethod - arguments: args! Item was removed: - ----- Method: MethodContext>>activateReturn:value: (in category 'private') ----- - activateReturn: aContext value: value - "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender" - - ^MethodContext - sender: self - receiver: aContext - method: MethodContext theReturnMethod - arguments: {value}! Item was removed: - ----- Method: MethodContext>>activeHome (in category 'accessing') ----- - activeHome - "If executing closure, search senders for the activation of the original - (outermost) method that (indirectly) created my closure (the closureHome). - If the closureHome is not found on the sender chain answer nil." - - | methodReturnContext | - self isExecutingBlock ifFalse: [^self]. - self sender ifNil: [^nil]. - methodReturnContext := self methodReturnContext. - ^self sender findContextSuchThat: [:ctxt | ctxt = methodReturnContext]! Item was removed: - ----- Method: MethodContext>>activeOuterContext (in category 'accessing') ----- - activeOuterContext - "If executing closure, search senders for the activation in which the receiver's - closure was created (the receiver's outerContext). If the outerContext is not - found on the sender chain answer nil." - - | outerContext | - self isExecutingBlock ifFalse: [^self]. - self sender ifNil: [^nil]. - outerContext := self outerContext. - ^self sender findContextSuchThat: [:ctxt | ctxt = outerContext]! Item was removed: - ----- Method: MethodContext>>actualStackSize (in category 'private-debugger') ----- - actualStackSize "For use only by Debugger, Inspectors etc" - ^ stackp - method numTemps! Item was removed: - ----- Method: MethodContext>>arguments (in category 'accessing') ----- - arguments - - ^ Array new: self numArgs streamContents: [:args | - 1 to: self numArgs do: [: i | - args nextPut: (self tempAt: i)]]! Item was removed: - ----- Method: MethodContext>>asContext (in category 'closure support') ----- - asContext - - ^ self! Item was removed: - ----- Method: MethodContext>>asMessage (in category 'converting') ----- - asMessage - | selector args | - selector := sender method selector. - args := Array new: selector numArgs. - 1 to: selector numArgs do: [ :i | args at: i put: (sender tempAt: i)]. - ^ Message selector: selector arguments: args.! Item was removed: - ----- Method: MethodContext>>at: (in category 'accessing') ----- - at: index - "Primitive. Assumes receiver is indexable. Answer the value of an - indexable element in the receiver. Fail if the argument index is not an - Integer or is out of bounds. Essential. See Object documentation - whatIsAPrimitive. Override the default primitive to give latitude to - the VM in context management." - - <primitive: 210> - index isInteger ifTrue: - [self errorSubscriptBounds: index]. - index isNumber - ifTrue: [^self at: index asInteger] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- Method: MethodContext>>at:put: (in category 'accessing') ----- - at: index put: value - "Primitive. Assumes receiver is indexable. Answer the value of an - indexable element in the receiver. Fail if the argument index is not - an Integer or is out of bounds. Essential. See Object documentation - whatIsAPrimitive. Override the default primitive to give latitude to - the VM in context management." - - <primitive: 211> - index isInteger ifTrue: - [self errorSubscriptBounds: index]. - index isNumber - ifTrue: [^self at: index asInteger put: value] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- Method: MethodContext>>atEnd (in category 'testing') ----- - atEnd - ^ self isExecutingBlock - ifTrue: [ self closure startpc + self closure size - 1 = self pc ] - ifFalse: [ self pc >= self method endPC ]! Item was removed: - ----- Method: MethodContext>>basicAt: (in category 'accessing') ----- - basicAt: index - "Primitive. Assumes receiver is indexable. Answer the value of an - indexable element in the receiver. Fail if the argument index is not an - Integer or is out of bounds. Essential. See Object documentation - whatIsAPrimitive. Override the default primitive to give latitude to - the VM in context management." - - <primitive: 210> - index isInteger ifTrue: - [self errorSubscriptBounds: index]. - index isNumber - ifTrue: [^self at: index asInteger] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- Method: MethodContext>>basicAt:put: (in category 'accessing') ----- - basicAt: index put: value - "Primitive. Assumes receiver is indexable. Answer the value of an - indexable element in the receiver. Fail if the argument index is not - an Integer or is out of bounds. Essential. See Object documentation - whatIsAPrimitive. Override the default primitive to give latitude to - the VM in context management." - - <primitive: 211> - index isInteger ifTrue: - [self errorSubscriptBounds: index]. - index isNumber - ifTrue: [^self at: index asInteger put: value] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- Method: MethodContext>>basicSize (in category 'accessing') ----- - basicSize - "Primitive. Answer the number of indexable variables in the receiver. - This value is the same as the largest legal subscript. Essential. Do not - override in any subclass. See Object documentation whatIsAPrimitive. Override the default primitive to give latitude to - the VM in context management." - - <primitive: 212> - "The number of indexable fields of fixed-length objects is 0" - ^self primitiveFailed! Item was removed: - ----- Method: MethodContext>>blockCopy: (in category 'controlling') ----- - blockCopy: numArgs - "Primitive. Distinguish a block of code from its enclosing method by - creating a new BlockContext for that block. The compiler inserts into all - methods that contain blocks the bytecodes to send the message - blockCopy:. Do not use blockCopy: in code that you write!! Only the - compiler can decide to send the message blockCopy:. Fail if numArgs is - not a SmallInteger. Optional. No Lookup. See Object documentation - whatIsAPrimitive." - - <primitive: 80> - ^ (BlockContext newForMethod: self method) - home: self home - startpc: pc + 2 - nargs: numArgs! Item was removed: - ----- Method: MethodContext>>blockReturnTop (in category 'instruction decoding (closures)') ----- - blockReturnTop - "Simulate the interpreter's action when a ReturnTopOfStackToCaller bytecode is - encountered in the receiver. This should only happen in a closure activation." - self assert: closureOrNil isClosure. - ^self return: self pop from: self! Item was removed: - ----- Method: MethodContext>>bottomContext (in category 'query') ----- - bottomContext - "Return the last context (the first context invoked) in my sender chain" - - ^ self findContextSuchThat: [:c | c sender isNil]! Item was removed: - ----- Method: MethodContext>>callPrimitive: (in category 'instruction decoding') ----- - callPrimitive: primNumber - "Evaluate the primitive, either normal or inlined, and answer the new context resulting from that - (either the sender if a successful non-inlined primitive, or the current context, if not)." - | maybePrimFailToken | - primNumber >= (1 << 15) ifTrue: "Inlined primitive, cannot fail" - [^self callInlinedPrimitive: primNumber]. - maybePrimFailToken := self doPrimitive: primNumber - method: method - receiver: receiver - args: self arguments. - "Normal primitive. Always at the beginning of methods." - (self isPrimFailToken: maybePrimFailToken) ifFalse: "On success return the result" - [^self methodReturnTop]. - "On failure, store the error code if appropriate and keep interpreting the method" - (method encoderClass isStoreAt: pc in: method) ifTrue: - [self at: stackp put: maybePrimFailToken last]. - ^self! Item was removed: - ----- Method: MethodContext>>canHandleSignal: (in category 'private-exceptions') ----- - canHandleSignal: exception - "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception then return true, otherwise forward this message to the next handler context. If none left, return false (see nil>>canHandleSignal:)" - - ^ (((self tempAt: 1) handles: exception) and: [self tempAt: 3]) - or: [self nextHandlerContext canHandleSignal: exception]. - ! Item was removed: - ----- Method: MethodContext>>cannotReturn: (in category 'private-exceptions') ----- - cannotReturn: result - - closureOrNil notNil ifTrue: - [^self cannotReturn: result to: self home sender]. - ToolSet - debugContext: thisContext - label: 'computation has been terminated' - contents: nil! Item was removed: - ----- Method: MethodContext>>cannotReturn:to: (in category 'private') ----- - cannotReturn: result to: homeContext - "The receiver tried to return result to homeContext that no longer exists." - - ^ BlockCannotReturn new - result: result; - deadHome: homeContext; - signal! Item was removed: - ----- Method: MethodContext>>client (in category 'accessing') ----- - client - "Answer the client, that is, the object that sent the message that created this context." - - ^sender receiver! Item was removed: - ----- Method: MethodContext>>closure (in category 'accessing') ----- - closure - ^closureOrNil! Item was removed: - ----- Method: MethodContext>>closureCopy:copiedValues: (in category 'controlling') ----- - closureCopy: numArgs copiedValues: anArray - "Distinguish a block of code from its enclosing method by - creating a BlockClosure for that block. The compiler inserts into all - methods that contain blocks the bytecodes to send the message - closureCopy:copiedValues:. Do not use closureCopy:copiedValues: in code that you write!! Only the - compiler can decide to send the message closureCopy:copiedValues:. Fail if numArgs is - not a SmallInteger. Optional. No Lookup. See Object documentation - whatIsAPrimitive." - - <primitive: 200> - ^BlockClosure outerContext: self startpc: pc + 2 numArgs: numArgs copiedValues: anArray! Item was removed: - ----- Method: MethodContext>>completeCallee: (in category 'system simulation') ----- - completeCallee: aContext - "Simulate the execution of bytecodes until a return to the receiver." - | ctxt current ctxt1 | - ctxt := aContext. - [ctxt == current or: [ctxt hasSender: self]] - whileTrue: - [current := ctxt. - ctxt1 := ctxt quickStep. - ctxt1 ifNil: [self halt]. - ctxt := ctxt1]. - ^self stepToSendOrReturn! Item was removed: - ----- Method: MethodContext>>contextForLocalVariables (in category 'accessing') ----- - contextForLocalVariables - "Answer the context in which local variables (temporaries) are stored." - - self subclassResponsibility! Item was removed: - ----- Method: MethodContext>>contextStack (in category 'debugger access') ----- - contextStack - "Answer an Array of the contexts on the receiver's sender chain." - - ^self stackOfSize: 100000! Item was removed: - ----- Method: MethodContext>>contextTag (in category 'closure support') ----- - contextTag - "Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag." - ^self! Item was removed: - ----- Method: MethodContext>>copyStack (in category 'query') ----- - copyStack - - ^ self copyTo: nil! Item was removed: - ----- Method: MethodContext>>copyTo: (in category 'query') ----- - copyTo: aContext - "Copy self and my sender chain down to, but not including, aContext. End of copied chain will have nil sender." - - | copy | - self == aContext ifTrue: [ ^nil ]. - copy := self copy. - sender ifNotNil: [ copy privSender: (sender copyTo: aContext) ]. - ^copy! Item was removed: - ----- Method: MethodContext>>copyTo:bottomContextDo: (in category 'query') ----- - copyTo: aContext bottomContextDo: aBlock - "Copy self and my sender chain down to, but not including, aContext. End of copied chain will have nil sender. Evaluate aBlock with the copy of bottom context when it still points to the original sender." - - | copy | - self == aContext ifTrue: [ ^nil ]. - copy := self copy. - sender - ifNil: [ aBlock value: copy ] - ifNotNil: [ - sender == aContext ifTrue: [ aBlock value: copy ]. - copy privSender: (sender copyTo: aContext bottomContextDo: aBlock) ]. - ^copy! Item was removed: - ----- Method: MethodContext>>cut: (in category 'private') ----- - cut: aContext - "Cut aContext and its senders from my sender chain" - - | ctxt callee | - ctxt := self. - [ctxt == aContext] whileFalse: [ - callee := ctxt. - ctxt := ctxt sender. - ctxt ifNil: [aContext ifNotNil: [self error: 'aContext not a sender']]. - ]. - callee privSender: nil. - ! Item was removed: - ----- Method: MethodContext>>depthBelow: (in category 'debugger access') ----- - depthBelow: aContext - "Answer how many calls there are between this and aContext." - - | this depth | - this := self. - depth := 0. - [this == aContext or: [this == nil]] - whileFalse: - [this := this sender. - depth := depth + 1]. - ^depth! Item was removed: - ----- Method: MethodContext>>doDup (in category 'instruction decoding') ----- - doDup - "Simulate the action of a 'duplicate top of stack' bytecode." - - self push: self top! Item was removed: - ----- Method: MethodContext>>doPop (in category 'instruction decoding') ----- - doPop - "Simulate the action of a 'remove top of stack' bytecode." - - self pop! Item was removed: - ----- Method: MethodContext>>doPrimitive:method:receiver:args: (in category 'private') ----- - doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments - "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and - arguments are given as arguments to this message. If successful, push result and return - resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes - execution needs to be intercepted and simulated to avoid execution running away." - - | value | - "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents - the debugger from entering various run-away activities such as spawning a new - process, etc. Injudicious use results in the debugger not being able to debug - interesting code, such as the debugger itself. hence use primitive 19 with care :-)" - "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" - primitiveIndex = 19 ifTrue: - [ToolSet - debugContext: self - label:'Code simulation error' - contents: nil]. - - ((primitiveIndex between: 201 and: 222) - and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: - [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" - or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" - [^receiver simulateValueWithArguments: arguments caller: self]. - primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" - [^receiver simulateValueWithArguments: arguments first caller: self]]. - - primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" - [^self send: arguments first to: receiver with: arguments allButFirst super: false]. - primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" - [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. - primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" - [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. - - "Mutex>>primitiveEnterCriticalSection - Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" - (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: - [| effective | - effective := Processor activeProcess effectiveProcess. - "active == effective" - value := primitiveIndex = 186 - ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] - ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. - ^(self isPrimFailToken: value) - ifTrue: [value] - ifFalse: [self push: value]]. - - primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" - [((self objectClass: (arguments at: 1)) == Array - and: [(self objectClass: (arguments at: 2)) includesBehavior: CompiledMethod]) ifFalse: - [^MethodContext primitiveFailTokenFor: #'bad argument']. - (arguments at: 2) numArgs = (arguments at: 1) size ifFalse: - [^MethodContext primitiveFailTokenFor: #'bad number of arguments']. - (arguments at: 2) primitive > 0 ifTrue: - [(arguments at: 2) isQuick ifTrue: - [^self push: (receiver withArgs: (arguments at: 1) executeMethod: (arguments at: 2))]. - ^self doPrimitive: (arguments at: 2) primitive method: (arguments at: 2) receiver: receiver args: (arguments at: 1)]. - ^MethodContext - sender: self - receiver: receiver - method: (arguments at: 2) - arguments: (arguments at: 1)]. - - primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" - [(arguments size = 3 - and: [(self objectClass: arguments second) == SmallInteger - and: [(self objectClass: arguments last) == Array]]) ifTrue: - [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. - (arguments size = 2 - and: [(self objectClass: arguments first) == SmallInteger - and: [(self objectClass: arguments last) == Array]]) ifFalse: - [^MethodContext primitiveFailTokenFor: nil]. - ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. - - value := primitiveIndex = 120 "FFI method" - ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] - ifFalse: - [primitiveIndex = 117 "named primitives" - ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] - ifFalse: - ["should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs" - receiver tryPrimitive: primitiveIndex withArgs: arguments]]. - - ^(self isPrimFailToken: value) - ifTrue: [value] - ifFalse: [self push: value]! Item was removed: - ----- Method: MethodContext>>endPC (in category 'private') ----- - endPC - ^closureOrNil - ifNil: [self method endPC] - ifNotNil: [closureOrNil endPC]! Item was removed: - ----- Method: MethodContext>>exceptionMessage (in category 'accessing') ----- - exceptionMessage - ^ self selector caseOf: { - [#doesNotUnderstand:] -> [self tempAt: 1]. - [#notYetImplemented] -> [self asMessage]. - [#shouldBeImplemented] -> [self asMessage]. - [#subclassResponsibility] -> [self asMessage]} - otherwise: [self error: 'This context is not the result of a message exception.'].! Item was removed: - ----- Method: MethodContext>>failPrimitiveWith: (in category 'system simulation') ----- - failPrimitiveWith: maybePrimFailToken - "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive: - bytecode and store the primitive fail code if there is one and the method consumes it." - self skipCallPrimitive. - ((self isPrimFailToken: maybePrimFailToken) - and: [method encoderClass isStoreAt: pc in: method]) ifTrue: - [self at: stackp put: maybePrimFailToken last]! Item was removed: - ----- Method: MethodContext>>findContextSuchThat: (in category 'query') ----- - findContextSuchThat: testBlock - "Search self and my sender chain for first one that satisfies testBlock. Return nil if none satisfy" - - | ctxt | - ctxt := self. - [ctxt isNil] whileFalse: [ - (testBlock value: ctxt) ifTrue: [^ ctxt]. - ctxt := ctxt sender. - ]. - ^ nil! Item was removed: - ----- Method: MethodContext>>findNextHandlerContextStarting (in category 'private-exceptions') ----- - findNextHandlerContextStarting - "Return the next handler marked context, returning nil if there is none. Search starts with self and proceeds up to nil." - - | ctx | - <primitive: 197> - ctx := self. - [ctx isHandlerContext ifTrue:[^ctx]. - (ctx := ctx sender) == nil ] whileFalse. - ^nil! Item was removed: - ----- Method: MethodContext>>findNextUnwindContextUpTo: (in category 'private-exceptions') ----- - findNextUnwindContextUpTo: aContext - "Return the next unwind marked above the receiver, returning nil if there is none. Search proceeds up to but not including aContext." - - | ctx | - <primitive: 195> - ctx := self. - [(ctx := ctx sender) == nil or: [ctx == aContext]] whileFalse: - [ ctx isUnwindContext ifTrue: [^ctx]]. - ^nil! Item was removed: - ----- Method: MethodContext>>findSecondToOldestSimilarSender (in category 'query') ----- - findSecondToOldestSimilarSender - "Search the stack for the second-to-oldest occurance of self's method. Very useful for an infinite recursion. Gets back to the second call so you can see one complete recursion cycle, and how it was called at the beginning." - - | sec ctxt bot | - sec := self. - ctxt := self. - [ bot := ctxt findSimilarSender. - bot isNil - ] whileFalse: [ - sec := ctxt. - ctxt := bot. - ]. - ^ sec - ! Item was removed: - ----- Method: MethodContext>>findSimilarSender (in category 'query') ----- - findSimilarSender - "Return the closest sender with the same method, return nil if none found" - - | meth | - meth := self method. - ^ self sender findContextSuchThat: [:c | c method == meth]! Item was removed: - ----- Method: MethodContext>>handleSignal: (in category 'private-exceptions') ----- - handleSignal: exception - "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception - and the handler is active then execute my handle block (second arg), otherwise forward - this message to the next handler context. If none left, execute exception's defaultAction - (see nil>>handleSignal:)." - - | handlerActive val | - "If the context has been returned from the handlerActive temp var may not be accessible." - handlerActive := stackp >= 3 and: [(self tempAt: 3) == true]. - (((self tempAt: 1) handles: exception) and: [handlerActive]) ifFalse: - [^self nextHandlerContext handleSignal: exception]. - - exception privHandlerContext: self contextTag. - self tempAt: 3 put: false. "disable self while executing handle block" - val := [(self tempAt: 2) cull: exception] - ensure: [self tempAt: 3 put: true]. - self return: val "return from self if not otherwise directed in handle block" - ! Item was removed: - ----- Method: MethodContext>>hasContext: (in category 'query') ----- - hasContext: aContext - "Answer whether aContext is me or one of my senders" - - ^ (self findContextSuchThat: [:c | c == aContext]) notNil! Item was removed: - ----- Method: MethodContext>>hasInstVarRef (in category 'accessing') ----- - hasInstVarRef - "Answer whether the receiver references an instance variable." - - ^self method hasInstVarRef.! Item was removed: - ----- Method: MethodContext>>hasMethodReturn (in category 'accessing') ----- - hasMethodReturn - ^closureOrNil hasMethodReturn! Item was removed: - ----- Method: MethodContext>>hasSender: (in category 'controlling') ----- - hasSender: context - "Answer whether the receiver is strictly above context on the stack." - - | s | - self == context ifTrue: [^false]. - s := sender. - [s == nil] - whileFalse: - [s == context ifTrue: [^true]. - s := s sender]. - ^false! Item was removed: - ----- Method: MethodContext>>home (in category 'accessing') ----- - home - "Answer the context in which the receiver was defined." - - closureOrNil == nil ifTrue: - [^self]. - ^closureOrNil outerContext home! Item was removed: - ----- Method: MethodContext>>insertSender: (in category 'private') ----- - insertSender: aContext - "Insert aContext and its sender chain between me and my sender. Return new callee of my original sender." - - | ctxt | - ctxt := aContext bottomContext. - ctxt privSender: self sender. - self privSender: aContext. - ^ ctxt! Item was removed: - ----- Method: MethodContext>>instVarAt:put: (in category 'private') ----- - instVarAt: index put: value - index = 3 ifTrue: [self stackp: value. ^ value]. - ^ super instVarAt: index put: value! Item was removed: - ----- Method: MethodContext>>isBottomContext (in category 'query') ----- - isBottomContext - "Answer if this is the last context (the first context invoked) in my sender chain" - - ^sender isNil! Item was removed: - ----- Method: MethodContext>>isClosureContext (in category 'closure support') ----- - isClosureContext - ^closureOrNil ~~ nil! Item was removed: - ----- Method: MethodContext>>isContext (in category 'query') ----- - isContext - ^true! Item was removed: - ----- Method: MethodContext>>isDead (in category 'query') ----- - isDead - "Has self finished" - - ^ pc isNil! Item was removed: - ----- Method: MethodContext>>isExecutingBlock (in category 'accessing') ----- - isExecutingBlock - "Is this executing a block versus a method? In the new closure - implemetation this is true if closureOrNil is not nil, in which case - it should be holding a BlockClosure." - - ^closureOrNil isClosure! Item was removed: - ----- Method: MethodContext>>isHandlerContext (in category 'private-exceptions') ----- - isHandlerContext - "is this context for method that is marked?" - ^method primitive = 199! Item was removed: - ----- Method: MethodContext>>isMethodContext (in category 'testing') ----- - isMethodContext - ^ true! Item was removed: - ----- Method: MethodContext>>isPrimFailToken: (in category 'private') ----- - isPrimFailToken: anObject - ^(self objectClass: anObject) == Array - and: [anObject size = 2 - and: [anObject first == PrimitiveFailToken]]! Item was removed: - ----- Method: MethodContext>>isUnwindContext (in category 'private-exceptions') ----- - isUnwindContext - "is this context for method that is marked?" - ^method primitive = 198! Item was removed: - ----- Method: MethodContext>>jump (in category 'controlling') ----- - jump - "Abandon thisContext and resume self instead (using the same current process). You may want to save thisContext's sender before calling this so you can jump back to it. - Self MUST BE a top context (ie. a suspended context or a abandoned context that was jumped out of). A top context already has its return value on its stack (see Interpreter>>primitiveSuspend and other suspending primitives). - thisContext's sender is converted to a top context (by pushing a nil return value on its stack) so it can be jump back to." - - | top | - "Make abandoned context a top context (has return value (nil)) so it can be jumped back to" - thisContext sender push: nil. - - "Pop self return value then return it to self (since we jump to self by returning to it)" - stackp = 0 ifTrue: [self stepToSendOrReturn]. - stackp = 0 ifTrue: [self push: nil]. "must be quick return self/constant" - top := self pop. - thisContext privSender: self. - ^ top! Item was removed: - ----- Method: MethodContext>>jump: (in category 'instruction decoding') ----- - jump: distance - "Simulate the action of a 'unconditional jump' bytecode whose offset is - the argument, distance." - - pc := pc + distance! Item was removed: - ----- Method: MethodContext>>jump:if: (in category 'instruction decoding') ----- - jump: distance if: condition - "Simulate the action of a 'conditional jump' bytecode whose offset is the - argument, distance, and whose condition is the argument, condition." - - | bool | - bool := self pop. - (bool == true or: [bool == false]) ifFalse: [ - ^self - send: #mustBeBooleanIn: - to: bool - with: {self} - super: false]. - (bool eqv: condition) ifTrue: [self jump: distance]! Item was removed: - ----- Method: MethodContext>>longStack (in category 'debugger access') ----- - longStack - "Answer a String showing the top 100 contexts on my sender chain." - - ^ String streamContents: - [:strm | - (self stackOfSize: 100) - do: [:item | strm print: item; cr]]! Item was removed: - ----- Method: MethodContext>>method (in category 'accessing') ----- - method - - ^method! Item was removed: - ----- Method: MethodContext>>methodClass (in category 'debugger access') ----- - methodClass - "Answer the class in which the receiver's method was found." - - ^self method methodClass ifNil: [self objectClass: self receiver].! Item was removed: - ----- Method: MethodContext>>methodNode (in category 'accessing') ----- - methodNode - ^ self method methodNode.! Item was removed: - ----- Method: MethodContext>>methodNodeFormattedAndDecorated: (in category 'accessing') ----- - methodNodeFormattedAndDecorated: decorate - "Answer a method node made from pretty-printed (and colorized, if decorate is true) - source text." - - ^ self method methodNodeFormattedAndDecorated: decorate.! Item was removed: - ----- Method: MethodContext>>methodReturnConstant: (in category 'instruction decoding') ----- - methodReturnConstant: value - "Simulate the action of a 'return constant' bytecode whose value is the - argument, value. This corresponds to a source expression like '^0'." - - ^self return: value from: self methodReturnContext! Item was removed: - ----- Method: MethodContext>>methodReturnContext (in category 'accessing') ----- - methodReturnContext - "Answer the context from which an ^-return should return from." - - closureOrNil == nil ifTrue: - [^self]. - ^closureOrNil outerContext methodReturnContext! Item was removed: - ----- Method: MethodContext>>methodReturnReceiver (in category 'instruction decoding') ----- - methodReturnReceiver - "Simulate the action of a 'return receiver' bytecode. This corresponds to - the source expression '^self'." - - ^self return: self receiver from: self methodReturnContext! Item was removed: - ----- Method: MethodContext>>methodReturnTop (in category 'instruction decoding') ----- - methodReturnTop - "Simulate the action of a 'return top of stack' bytecode. This corresponds - to source expressions like '^something'." - - ^self return: self pop from: self methodReturnContext! Item was removed: - ----- Method: MethodContext>>namedTempAt: (in category 'debugger access') ----- - namedTempAt: index - "Answer the value of the temp at index in the receiver's sequence of tempNames." - ^self debuggerMap namedTempAt: index in: self! Item was removed: - ----- Method: MethodContext>>namedTempAt:put: (in category 'debugger access') ----- - namedTempAt: index put: aValue - "Set the value of the temp at index in the receiver's sequence of tempNames. - (Note that if the value is a copied value it is also set out along the lexical chain, - but alas not in along the lexical chain.)." - ^self debuggerMap namedTempAt: index put: aValue in: self! Item was removed: - ----- Method: MethodContext>>nextHandlerContext (in category 'private-exceptions') ----- - nextHandlerContext - - ^ self sender findNextHandlerContextStarting! Item was removed: - ----- Method: MethodContext>>numArgs (in category 'accessing') ----- - numArgs - "Answer the number of arguments for this activation." - ^closureOrNil - ifNil: [method numArgs] - ifNotNil: [closureOrNil numArgs]! Item was removed: - ----- Method: MethodContext>>numTemps (in category 'accessing') ----- - numTemps - "Answer the number of temporaries for this activation; this includes - the number of arguments, and for blocks, the number of copied values." - ^closureOrNil - ifNil: [method numTemps] - ifNotNil: [closureOrNil numTemps]! Item was removed: - ----- Method: MethodContext>>object:basicAt: (in category 'mirror primitives') ----- - object: anObject basicAt: index - "Answer the value of an indexable element in the argument anObject without sending - it a message. Fail if the argument index is not an Integer or is out of bounds, or if - anObject is not indexable. This mimics the action of the VM when it indexes an object. - Used to simulate the execution machinery by, for example, the debugger. - Primitive. See Object documentation whatIsAPrimitive." - - <primitive: 60> - index isInteger ifTrue: [self errorSubscriptBounds: index]. - index isNumber - ifTrue: [^self object: anObject basicAt: index asInteger] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- Method: MethodContext>>object:basicAt:put: (in category 'mirror primitives') ----- - object: anObject basicAt: index put: value - "Store the last argument - value in the indexable element of the argument anObject indicated by index without sending - anObject a message. Fail if the argument index is not an Integer or is out of bounds, or if - anObject is not indexable, or if value is an inappropriate value for anObject's indexable slots. - This mimics the action of the VM when it indexes an object. - Used to simulate the execution machinery by, for example, the debugger. - Primitive. See Object documentation whatIsAPrimitive." - - <primitive: 61> - index isInteger - ifTrue: [(index >= 1 and: [index <= (self objectSize: anObject)]) - ifTrue: [self errorImproperStore] - ifFalse: [self errorSubscriptBounds: index]]. - index isNumber - ifTrue: [^self object: anObject basicAt: index asInteger put: value] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- Method: MethodContext>>object:eqeq: (in category 'mirror primitives') ----- - object: anObject eqeq: anOtherObject - "Answer whether the first and second arguments are the same object (have the - same object pointer) without sending a message to the first argument. This - mimics the action of the VM when it compares two object pointers. Used to - simulate the execution machinery by, for example, the debugger. - Primitive. See Object documentation whatIsAPrimitive." - - <primitive: 110> - self primitiveFailed! Item was removed: - ----- Method: MethodContext>>object:instVarAt: (in category 'mirror primitives') ----- - object: anObject instVarAt: anIndex - "Primitive. Answer a fixed variable in an object. The numbering of the - variables corresponds to the named instance variables. Fail if the index - is not an Integer or is not the index of a fixed variable. Essential for the - debugger. See Object documentation whatIsAPrimitive." - - <primitive: 73> - "Access beyond fixed variables." - ^self object: anObject basicAt: anIndex - (self objectClass: anObject) instSize! Item was removed: - ----- Method: MethodContext>>object:instVarAt:put: (in category 'mirror primitives') ----- - object: anObject instVarAt: anIndex put: aValue - "Primitive. Store a value into a fixed variable in the argument anObject. - The numbering of the variables corresponds to the named instance - variables. Fail if the index is not an Integer or is not the index of a - fixed variable. Answer the value stored as the result. Using this - message violates the principle that each object has sovereign control - over the storing of values into its instance variables. Essential for the - debugger. See Object documentation whatIsAPrimitive." - - <primitive: 74> - "Access beyond fixed fields" - ^self object: anObject basicAt: anIndex - (self objectClass: anObject) instSize put: aValue! Item was removed: - ----- Method: MethodContext>>object:perform:withArguments:inClass: (in category 'mirror primitives') ----- - object: anObject perform: selector withArguments: argArray inClass: lookupClass - "Send the selector, aSymbol, to anObject with arguments in argArray. - Fail if the number of arguments expected by the selector - does not match the size of argArray, or if lookupClass - cannot be found among the anObject's superclasses. - Primitive. Essential for the debugger." - - <primitive: 100 error: error> - (selector isSymbol) ifFalse: - [^self error: 'selector argument must be a Symbol']. - (argArray isMemberOf: Array) ifFalse: - [^self error: 'argArray must be an Array']. - (selector numArgs = argArray size) - ifFalse: [^self error: 'incorrect number of arguments']. - ((self objectClass: anObject) == lookupClass - or: [(self objectClass: anObject) inheritsFrom: lookupClass]) ifFalse: - [^self error: 'lookupClass is not in anObject''s inheritance chain']. - self primitiveFailed! Item was removed: - ----- Method: MethodContext>>objectClass: (in category 'mirror primitives') ----- - objectClass: anObject - "Answer the class of the argument anObject without sending it a message. - This mimics the action of the VM when it fetches an object's class. Used to - simulate the execution machinery by, for example, the debugger. - Primitive. See Object documentation whatIsAPrimitive." - - <primitive: 111> - self primitiveFailed! Item was removed: - ----- Method: MethodContext>>objectSize: (in category 'mirror primitives') ----- - objectSize: anObject - "Answer the number of indexable variables in the argument anObject without sending - it a message. This mimics the action of the VM when it fetches an object's variable size. - Used to simulate the execution machinery by, for example, the debugger. - Primitive. See Object documentation whatIsAPrimitive." - - <primitive: 62> - "The number of indexable fields of fixed-length objects is 0" - ^0! Item was removed: - ----- Method: MethodContext>>outerContext (in category 'accessing') ----- - outerContext - "Answer the context within which the receiver is nested." - - ^closureOrNil ifNotNil: - [closureOrNil outerContext]! Item was removed: - ----- Method: MethodContext>>pc (in category 'debugger access') ----- - pc - "Answer the index of the next bytecode to be executed." - - ^pc! Item was removed: - ----- Method: MethodContext>>pop (in category 'controlling') ----- - pop - "Answer the top of the receiver's stack and remove the top of the stack." - | val | - val := self at: stackp. - self stackp: stackp - 1. - ^ val! Item was removed: - ----- Method: MethodContext>>popIntoLiteralVariable: (in category 'instruction decoding') ----- - popIntoLiteralVariable: value - "Simulate the action of bytecode that removes the top of the stack and - stores it into a literal variable of my method." - - self object: value instVarAt: ValueIndex put: self pop! Item was removed: - ----- Method: MethodContext>>popIntoReceiverVariable: (in category 'instruction decoding') ----- - popIntoReceiverVariable: offset - "Simulate the action of bytecode that removes the top of the stack and - stores it into an instance variable of my receiver." - - self object: self receiver instVarAt: offset + 1 put: self pop! Item was removed: - ----- Method: MethodContext>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- - popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex - "Simulate the action of bytecode that removes the top of the stack and stores - it into an offset in one of my local variables being used as a remote temp vector." - - self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self pop! Item was removed: - ----- Method: MethodContext>>popIntoTemporaryVariable: (in category 'instruction decoding') ----- - popIntoTemporaryVariable: offset - "Simulate the action of bytecode that removes the top of the stack and - stores it into one of my temporary variables." - - self at: offset + 1 put: self pop! Item was removed: - ----- Method: MethodContext>>print:on: (in category 'debugger access') ----- - print: anObject on: aStream - "Safely print anObject in the face of direct ProtoObject subclasses." - | objClass title | - objClass := self objectClass: anObject. - (objClass canUnderstand: #printOn:) ifTrue: - [^anObject printOn: aStream]. - title := objClass name. - aStream - nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']); - nextPutAll: title! Item was removed: - ----- Method: MethodContext>>printDetails: (in category 'printing') ----- - printDetails: strm - "Put my class>>selector and instance variables and arguments and temporaries on the stream. Protect against errors during printing." - - | pe str pos | - self printOn: strm. - strm cr. - strm tab; nextPutAll: 'Receiver: '. - pe := '<<error during printing>>'. - strm nextPutAll: ([receiver printStringLimitedTo: 90] ifError: [:err :rcvr | pe]). - - strm cr; tab; nextPutAll: 'Arguments and temporary variables: '; cr. - str := [(self tempsAndValuesLimitedTo: 80 indent: 2) - padded: #right to: 1 with: $x] ifError: [:err :rcvr | pe]. - strm nextPutAll: (str allButLast). - - strm cr; tab; nextPutAll: 'Receiver''s instance variables: '; cr. - pos := strm position. - [receiver longPrintOn: strm limitedTo: 80 indent: 2] ifError: [:err :rcvr | - strm nextPutAll: pe]. - pos = strm position ifTrue: ["normal printString for an Array (it has no inst vars)" - strm nextPutAll: ([receiver printStringLimitedTo: 90] ifError: [:err :rcvr | pe])]. - strm peekLast == Character cr ifFalse: [strm cr].! Item was removed: - ----- Method: MethodContext>>printOn: (in category 'printing') ----- - printOn: aStream - | class mclass selector | - method ifNil: - [^super printOn: aStream]. - - closureOrNil ifNotNil: - [aStream nextPutAll: '[] in '. - closureOrNil outerContext printOn: aStream]. - - class := self objectClass: self receiver. - mclass := method methodClass. - selector := method selector ifNil: [method defaultSelector]. - - aStream nextPutAll: class name. - mclass ~~ class ifTrue: - [aStream nextPut: $(; nextPutAll: mclass name; nextPut: $)]. - aStream nextPutAll: '>>'; nextPutAll: selector. - - (selector == #doesNotUnderstand: - and: [(self objectClass: (self tempAt: 1)) == Message]) ifTrue: - [aStream space. - (self tempAt: 1) selector printOn: aStream]! Item was removed: - ----- Method: MethodContext>>printString (in category 'printing') ----- - printString - "Answer an emphasized string in case of a breakpoint method" - - ^(self method notNil and: [self method hasBreakpoint]) - ifTrue:[(super printString , ' [break]') asText allBold] - ifFalse:[super printString]! Item was removed: - ----- Method: MethodContext>>privRefresh (in category 'initialize-release') ----- - privRefresh - "Reinitialize the receiver so that it is in the state it was at its creation." - - closureOrNil - ifNotNil: - [pc := closureOrNil startpc. - self stackp: closureOrNil numArgs + closureOrNil numCopiedValues. - 1 to: closureOrNil numCopiedValues do: - [:i | self tempAt: closureOrNil numArgs + i put: (closureOrNil at: i)]] - ifNil: - [pc := method initialPC. - self stackp: method numTemps. - method numArgs+1 to: method numTemps do: - [:i | self tempAt: i put: nil]]! Item was removed: - ----- Method: MethodContext>>privRefreshWith: (in category 'initialize-release') ----- - privRefreshWith: aCompiledMethod - "Reinitialize the receiver as though it had been for a different method. - Used by a Debugger when one of the methods to which it refers is - recompiled." - - aCompiledMethod isCompiledMethod ifFalse: - [self error: 'method can only be set to aCompiledMethod']. - method := aCompiledMethod. - self assert: closureOrNil == nil. - "was: receiverMap := nil." - self privRefresh! Item was removed: - ----- Method: MethodContext>>privSender: (in category 'private') ----- - privSender: aContext - - sender := aContext! Item was removed: - ----- Method: MethodContext>>push: (in category 'controlling') ----- - push: val - "Push val on the receiver's stack." - - self stackp: stackp + 1. - self at: stackp put: val! Item was removed: - ----- Method: MethodContext>>push:fromIndexable: (in category 'private') ----- - push: numObjects fromIndexable: anIndexableCollection - "Push the elements of anIndexableCollection onto the receiver's stack. - Do not call directly. Called indirectly by {1. 2. 3} constructs." - - 1 to: numObjects do: - [:i | self push: (anIndexableCollection at: i)]! Item was removed: - ----- Method: MethodContext>>pushActiveContext (in category 'instruction decoding') ----- - pushActiveContext - "Simulate the action of bytecode that pushes the the active context on the - top of its own stack." - - self push: self! Item was removed: - ----- Method: MethodContext>>pushArgs:from: (in category 'system simulation') ----- - pushArgs: args "<Array>" from: sendr "<ContextPart>" - "Helps simulate action of the value primitive for closures. - This is used by ContextPart>>runSimulated:contextAtEachStep:" - - closureOrNil - ifNil: [self error: 'context needs a closure!!'] - ifNotNil: - ["See BlockClosure>>asContextWithSender:" - stackp ~= (closureOrNil numArgs + closureOrNil numCopiedValues) ifTrue: - [self error: 'stack pointer is incorrect!!'].]. - - 1 to: closureOrNil numArgs do: - [:i| self at: i put: (args at: i)]. - sender := sendr! Item was removed: - ----- Method: MethodContext>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') ----- - pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize - "Simulate the action of a 'closure copy' bytecode whose result is the - new BlockClosure for the following code" - | copiedValues | - numCopied > 0 - ifTrue: - [copiedValues := Array new: numCopied. - numCopied to: 1 by: -1 do: - [:i| - copiedValues at: i put: self pop]] - ifFalse: - [copiedValues := nil]. - self push: (BlockClosure - outerContext: self - startpc: pc - numArgs: numArgs - copiedValues: copiedValues). - self jump: blockSize! Item was removed: - ----- Method: MethodContext>>pushConsArrayWithElements: (in category 'instruction decoding (closures)') ----- - pushConsArrayWithElements: numElements - | array | - array := Array new: numElements. - numElements to: 1 by: -1 do: - [:i| - array at: i put: self pop]. - self push: array! Item was removed: - ----- Method: MethodContext>>pushConstant: (in category 'instruction decoding') ----- - pushConstant: value - "Simulate the action of bytecode that pushes the constant, value, on the - top of the stack." - - self push: value! Item was removed: - ----- Method: MethodContext>>pushLiteralVariable: (in category 'instruction decoding') ----- - pushLiteralVariable: value - "Simulate the action of bytecode that pushes the contents of the literal - variable whose index is the argument, index, on the top of the stack." - - self push: (self object: value instVarAt: ValueIndex)! Item was removed: - ----- Method: MethodContext>>pushNewArrayOfSize: (in category 'instruction decoding') ----- - pushNewArrayOfSize: arraySize - self push: (Array new: arraySize)! Item was removed: - ----- Method: MethodContext>>pushReceiver (in category 'instruction decoding') ----- - pushReceiver - "Simulate the action of bytecode that pushes the active context's receiver - on the top of the stack." - - self push: self receiver! Item was removed: - ----- Method: MethodContext>>pushReceiverVariable: (in category 'instruction decoding') ----- - pushReceiverVariable: offset - "Simulate the action of bytecode that pushes the contents of the receiver's - instance variable whose index is the argument, index, on the top of the - stack." - - self push: (self object: self receiver instVarAt: offset + 1)! Item was removed: - ----- Method: MethodContext>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- - pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex - "Simulate the action of bytecode that pushes the value at remoteTempIndex - in one of my local variables being used as a remote temp vector." - self push: (self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1)! Item was removed: - ----- Method: MethodContext>>pushTemporaryVariable: (in category 'instruction decoding') ----- - pushTemporaryVariable: offset - "Simulate the action of bytecode that pushes the contents of the - temporary variable whose index is the argument, index, on the top of - the stack." - - self push: (self at: offset + 1)! Item was removed: - ----- Method: MethodContext>>quickSend:to:with:super: (in category 'controlling') ----- - quickSend: selector to: rcvr with: arguments super: superFlag - "Send the given selector with arguments in an environment which closely resembles - the non-simulating environment, with an interjected unwind-protected block to catch - nonlocal returns. Attention: don't get lost!! This beautiful method is due to - Hans-Martin Mosner. Eliot Miranda merely added the mirror primitive code." - | oldSender contextToReturnTo result lookupClass | - contextToReturnTo := self. - lookupClass := superFlag - ifTrue: [self method methodClassAssociation value superclass] - ifFalse: [self objectClass: rcvr]. - [oldSender := thisContext sender swapSender: self. - result := self object: rcvr perform: selector withArguments: arguments inClass: lookupClass. - thisContext sender swapSender: oldSender] ifCurtailed: - [contextToReturnTo := thisContext sender receiver. "The block context returning nonlocally" - contextToReturnTo pc: contextToReturnTo previousPc. "skip to front of return bytecode causing this unwind" - contextToReturnTo willReturnTopFromMethod ifTrue: - "If it was a returnTop, push the value to be returned. - Otherwise the value is implicit in the bytecode" - [contextToReturnTo push: (thisContext sender tempAt: 1)]. - thisContext swapSender: thisContext home sender. "Make this block return to the method's sender" - contextToReturnTo]. - contextToReturnTo push: result. - ^contextToReturnTo! Item was removed: - ----- Method: MethodContext>>quickStep (in category 'system simulation') ----- - quickStep - "If the next instruction is a send, just perform it. - Otherwise, do a normal step." - - self willReallySend ifTrue: [QuickStep := self]. - ^self step! Item was removed: - ----- Method: MethodContext>>readDataFrom:size: (in category 'objects from disk') ----- - readDataFrom: aDataStream size: varsOnDisk - "Fill in the fields of self based on the contents of aDataStream. Answer self. - Read in the instance-variables written by Object>>storeDataOn:. - NOTE: This method must send beginReference: before reading any objects from aDataStream that might reference it. - Allow aDataStream to have fewer inst vars. See SmartRefStream. - Override to not store nil stack contents beyond stack pointer." - | cntInstVars cntIndexedVars | - - cntInstVars := self class instSize. - cntIndexedVars := varsOnDisk - cntInstVars. - cntIndexedVars < 0 ifTrue: - [self error: 'Class has changed too much. Define a convertxxx method']. - - aDataStream beginReference: self. - 1 to: cntInstVars do: - [:i | self instVarAt: i put: aDataStream next]. - 1 to: stackp do: - [:i | self basicAt: i put: aDataStream next]. - stackp + 1 to: cntIndexedVars do: - [:i | aDataStream next ~~ nil ifTrue: - [self error: 'Reading a Context''s contents expects only nil beyond top of stack']]. - "Total number read MUST be equal to varsOnDisk!!" - ^self "If we ever answer something other than self, fix calls - on (super readDataFrom: aDataStream size: anInteger)"! Item was removed: - ----- Method: MethodContext>>rearmHandlerDuring: (in category 'private-exceptions') ----- - rearmHandlerDuring: aBlock - "Sent to handler (on:do:) contexts only. Makes me re-entrant for the duration of aBlock. Only works in a closure-enabled image" - - ^ [self tempAt: 3 put: true. aBlock value] - ensure: [self tempAt: 3 put: false]! Item was removed: - ----- Method: MethodContext>>receiver (in category 'accessing') ----- - receiver - "Refer to the comment in ContextPart|receiver." - - ^receiver! Item was removed: - ----- Method: MethodContext>>receiver: (in category 'private-exceptions') ----- - receiver: r - - receiver := r! Item was removed: - ----- Method: MethodContext>>release (in category 'debugger access') ----- - release - "Remove information from the receiver and all of the contexts on its - sender chain in order to break circularities." - - self releaseTo: nil! Item was removed: - ----- Method: MethodContext>>releaseTo: (in category 'debugger access') ----- - releaseTo: caller - "Remove information from the receiver and the contexts on its sender - chain up to caller in order to break circularities." - - | c s | - c := self. - [c == nil or: [c == caller]] - whileFalse: - [s := c sender. - c singleRelease. - c := s]! Item was removed: - ----- Method: MethodContext>>removeSelf (in category 'accessing') ----- - removeSelf - "Nil the receiver pointer and answer its former value." - - | tempSelf | - tempSelf := receiver. - receiver := nil. - ^tempSelf! Item was removed: - ----- Method: MethodContext>>restart (in category 'controlling') ----- - restart - "Unwind thisContext to self and resume from beginning. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" - - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: nil to: self]. - self privRefresh. - ctxt := thisContext. - [ ctxt := ctxt findNextUnwindContextUpTo: self. - ctxt isNil - ] whileFalse: [ - (ctxt tempAt: 2) ifNil:[ - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ]. - thisContext terminateTo: self. - self jump. - ! Item was removed: - ----- Method: MethodContext>>restartWithNewReceiver: (in category 'private-exceptions') ----- - restartWithNewReceiver: obj - - self - swapReceiver: obj; - restart! Item was removed: - ----- Method: MethodContext>>resume (in category 'controlling') ----- - resume - "Roll back thisContext to self and resume. Execute unwind blocks when rolling back. ASSUMES self is a sender of thisContext" - - self resume: nil! Item was removed: - ----- Method: MethodContext>>resume: (in category 'controlling') ----- - resume: value - "Unwind thisContext to self and resume with value as result of last send. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" - - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: value to: self]. - ctxt := thisContext. - [ ctxt := ctxt findNextUnwindContextUpTo: self. - ctxt isNil - ] whileFalse: [ - (ctxt tempAt: 2) ifNil:[ - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ]. - thisContext terminateTo: self. - ^ value - ! Item was removed: - ----- Method: MethodContext>>resume:through: (in category 'controlling') ----- - resume: value through: firstUnwindCtxt - "Unwind thisContext to self and resume with value as result of last send. - Execute any unwind blocks while unwinding. - ASSUMES self is a sender of thisContext." - - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: value to: self]. - ctxt := firstUnwindCtxt. - [ctxt isNil] whileFalse: - [(ctxt tempAt: 2) ifNil: - [ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ctxt := ctxt findNextUnwindContextUpTo: self]. - thisContext terminateTo: self. - ^value - ! Item was removed: - ----- Method: MethodContext>>return (in category 'controlling') ----- - return - "Unwind until my sender is on top" - - self return: self receiver! Item was removed: - ----- Method: MethodContext>>return: (in category 'controlling') ----- - return: value - "Unwind thisContext to self and return value to self's sender. Execute any unwind blocks while unwinding. ASSUMES self is a sender of thisContext" - - sender ifNil: [self cannotReturn: value to: sender]. - sender resume: value! Item was removed: - ----- Method: MethodContext>>return:from: (in category 'instruction decoding') ----- - return: value from: aSender - "For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self" - - | newTop ctxt | - aSender isDead ifTrue: [ - ^ self send: #cannotReturn: to: self with: {value} super: false]. - newTop := aSender sender. - ctxt := self findNextUnwindContextUpTo: newTop. - ctxt ifNotNil: [ - ^ self send: #aboutToReturn:through: to: self with: {value. ctxt} super: false]. - self releaseTo: newTop. - newTop ifNotNil: [newTop push: value]. - ^ newTop - ! Item was removed: - ----- Method: MethodContext>>return:through: (in category 'controlling') ----- - return: value through: firstUnwindContext - "Unwind thisContext to self and return value to self's sender. - Execute any unwind blocks while unwinding. - ASSUMES self is a sender of thisContext." - - sender ifNil: [self cannotReturn: value to: sender]. - sender resume: value through: firstUnwindContext! Item was removed: - ----- Method: MethodContext>>return:to: (in category 'controlling') ----- - return: value to: sendr - "Simulate the return of value to sendr." - - self releaseTo: sendr. - sendr ifNil: [^ nil]. - ^ sendr push: value! Item was removed: - ----- Method: MethodContext>>runSimulated:contextAtEachStep: (in category 'system simulation') ----- - runSimulated: aBlock contextAtEachStep: block2 - "Simulate the execution of the argument, aBlock, until it ends. aBlock - MUST NOT contain an '^'. Evaluate block2 with the current context - prior to each instruction executed. Answer the simulated value of aBlock." - | current | - aBlock hasMethodReturn - ifTrue: [self error: 'simulation of blocks with ^ can run loose']. - current := aBlock asContext. - current pushArgs: Array new from: self. - [current == self] - whileFalse: - [block2 value: current. - current := current step]. - ^self pop! Item was removed: - ----- Method: MethodContext>>runUntilErrorOrReturnFrom: (in category 'controlling') ----- - runUntilErrorOrReturnFrom: aSender - "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." - "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." - - | error ctxt here topContext | - here := thisContext. - - "Insert ensure and exception handler contexts under aSender" - error := nil. - ctxt := aSender insertSender: (ContextPart - contextOn: UnhandledError do: [:ex | - error ifNil: [ - error := ex exception. - topContext := thisContext. - ex resumeUnchecked: here jump] - ifNotNil: [ex pass] - ]). - ctxt := ctxt insertSender: (ContextPart - contextEnsure: [error ifNil: [ - topContext := thisContext. - here jump] - ]). - self jump. "Control jumps to self" - - "Control resumes here once above ensure block or exception handler is executed" - ^ error ifNil: [ - "No error was raised, remove ensure context by stepping until popped" - [ctxt isDead] whileFalse: [topContext := topContext stepToCallee]. - {topContext. nil} - - ] ifNotNil: [ - "Error was raised, remove inserted above contexts then return signaler context" - aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" - {topContext. error} - ]. - ! Item was removed: - ----- Method: MethodContext>>secondFromBottom (in category 'query') ----- - secondFromBottom - "Return the second from bottom of my sender chain" - - self sender ifNil: [^ nil]. - ^ self findContextSuchThat: [:c | c sender sender isNil]! Item was removed: - ----- Method: MethodContext>>selector (in category 'debugger access') ----- - selector - "Answer the selector of the method that created the receiver." - - ^self method selector ifNil: [self method defaultSelector].! Item was removed: - ----- Method: MethodContext>>selectorCategory (in category 'accessing') ----- - selectorCategory - "Answer the category to which this message belongs (relative to the receiver). - If no superclass categorises this message, use the default." - | rcvrClass organizers | - rcvrClass := self objectClass: self receiver. - organizers := rcvrClass withAllSuperclasses collect: [:ea | ea organization]. - organizers addFirst: rcvrClass organization. - ^(organizers collect: [ :org | org categoryOfElement: self selector]) - detect: [:ea | ea ~= ClassOrganizer default and: [ea ~= nil]] - ifNone: [ClassOrganizer default]! Item was removed: - ----- Method: MethodContext>>send:super:numArgs: (in category 'instruction decoding') ----- - send: selector super: superFlag numArgs: numArgs - "Simulate the action of bytecodes that send a message with selector, - selector. The argument, superFlag, tells whether the receiver of the - message was specified with 'super' in the source method. The arguments - of the message are found in the top numArgs locations on the stack and - the receiver just below them." - - | receiver arguments | - arguments := Array new: numArgs. - numArgs to: 1 by: -1 do: [ :i | arguments at: i put: self pop]. - receiver := self pop. - QuickStep == self ifTrue: - [QuickStep := nil. - ^self quickSend: selector to: receiver with: arguments super: superFlag]. - ^self send: selector to: receiver with: arguments super: superFlag! Item was removed: - ----- Method: MethodContext>>send:to:with:lookupIn: (in category 'controlling') ----- - send: selector to: rcvr with: arguments lookupIn: lookupClass - "Simulate the action of sending a message with selector and arguments - to rcvr. The argument, lookupClass, is the class in which to lookup the - message. This is the receiver's class for normal messages, but for super - messages it will be some specific class related to the source method." - - | meth primIndex val ctxt | - (meth := lookupClass lookupSelector: selector) ifNil: - [^self send: #doesNotUnderstand: - to: rcvr - with: {Message selector: selector arguments: arguments} - lookupIn: lookupClass]. - meth numArgs ~= arguments size ifTrue: - [^self error: 'Wrong number of arguments in simulated message ', selector printString]. - (primIndex := meth primitive) > 0 ifTrue: - [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments. - (self isPrimFailToken: val) ifFalse: - [^val]]. - (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue: - [^self error: 'Simulated message ', arguments first selector, ' not understood']. - ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments. - primIndex > 0 ifTrue: - [ctxt failPrimitiveWith: val]. - ^ctxt! Item was removed: - ----- Method: MethodContext>>send:to:with:startClass: (in category 'controlling') ----- - send: selector to: rcvr with: args startClass: startClassOrNil - "Simulate the action of sending a message with selector, selector, and - arguments, args, to receiver. The argument, startClassOrNil, tells whether - the selector should be looked up in startClassOrNil or the class of the receiver." - - | class meth val ctxt | - class := startClassOrNil ifNil: [self objectClass: rcvr]. - meth := class lookupSelector: selector. - meth == nil ifTrue: - [^self - send: #doesNotUnderstand: - to: rcvr - with: (Array with: (Message selector: selector arguments: args)) - startClass: class]. - (args isArray - and: [args size = meth numArgs]) ifFalse: - [^MethodContext primitiveFailTokenFor: nil]. - val := self tryPrimitiveFor: meth receiver: rcvr args: args. - ((self objectClass: val) == Array - and: [val size = 2 - and: [val first == PrimitiveFailToken]]) ifFalse: - [^val]. - (selector == #doesNotUnderstand: - and: [class == ProtoObject]) ifTrue: - [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood']. - ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class. - ((self objectClass: val) == Array - and: [val size = 2 - and: [val first == PrimitiveFailToken - and: [val last notNil - and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue: - [ctxt at: ctxt stackPtr put: val last]. - ^ctxt! Item was removed: - ----- Method: MethodContext>>send:to:with:super: (in category 'controlling') ----- - send: selector to: rcvr with: arguments super: superFlag - "Simulate the action of sending a message with selector arguments - to rcvr. The argument, superFlag, tells whether the receiver of the - message was specified with 'super' in the source method." - - ^self send: selector - to: rcvr - with: arguments - lookupIn: (superFlag - ifTrue: [self method methodClassAssociation value superclass] - ifFalse: [self objectClass: rcvr])! Item was removed: - ----- Method: MethodContext>>sender (in category 'debugger access') ----- - sender - "Answer the context that sent the message that created the receiver." - - ^sender! Item was removed: - ----- Method: MethodContext>>setSender:receiver:method:arguments: (in category 'private') ----- - setSender: s receiver: r method: m arguments: args - "Create the receiver's initial state." - - sender := s. - receiver := r. - method := m. - closureOrNil := nil. - pc := method initialPC. - self stackp: method numTemps. - 1 to: args size do: [:i | self at: i put: (args at: i)]! Item was removed: - ----- Method: MethodContext>>setSender:receiver:method:closure:startpc: (in category 'private') ----- - setSender: s receiver: r method: m closure: c startpc: startpc - "Create the receiver's initial state." - - sender := s. - receiver := r. - method := m. - closureOrNil := c. - pc := startpc. - stackp := 0! Item was removed: - ----- Method: MethodContext>>shortStack (in category 'debugger access') ----- - shortStack - "Answer a String showing the top ten contexts on my sender chain." - - ^ String streamContents: - [:strm | - (self stackOfSize: 10) - do: [:item | strm print: item; cr]]! Item was removed: - ----- Method: MethodContext>>singleRelease (in category 'debugger access') ----- - singleRelease - "Remove information from the receiver in order to break circularities." - - stackp == nil ifFalse: [1 to: stackp do: [:i | self at: i put: nil]]. - sender := nil. - pc := nil. - ! Item was removed: - ----- Method: MethodContext>>size (in category 'accessing') ----- - size - "Primitive. Answer the number of indexable variables in the receiver. - This value is the same as the largest legal subscript. Essential. See Object - documentation whatIsAPrimitive. Override the default primitive to give latitude to - the VM in context management." - - <primitive: 212> - "The number of indexable fields of fixed-length objects is 0" - ^self primitiveFailed! Item was removed: - ----- Method: MethodContext>>sourceCode (in category 'debugger access') ----- - sourceCode - ^self method getSource. - - "Note: The above is a bit safer than - ^ methodClass sourceCodeAt: selector - which may fail if the receiver's method has been changed in - the debugger (e.g., the method is no longer in the methodDict - and thus the above selector is something like #Doit:with:with:with:) - but the source code is still available."! Item was removed: - ----- Method: MethodContext>>stack (in category 'debugger access') ----- - stack - "Answer an Array of the contexts on the receiver's sender chain." - - ^self stackOfSize: 9999! Item was removed: - ----- Method: MethodContext>>stackOfSize: (in category 'debugger access') ----- - stackOfSize: limit - "Answer an OrderedCollection of the top 'limit' contexts - on the receiver's sender chain." - - | stack ctxt | - stack := OrderedCollection new. - stack addLast: (ctxt := self). - [(ctxt := ctxt sender) ~~ nil - and: [stack size < limit]] whileTrue: - [stack addLast: ctxt]. - ^stack! Item was removed: - ----- Method: MethodContext>>stackPtr (in category 'private') ----- - stackPtr "For use only by the SystemTracer and the Debugger, Inspectors etc" - ^ stackp! Item was removed: - ----- Method: MethodContext>>stackp: (in category 'private') ----- - stackp: newStackp - "Storing into the stack pointer is a potentially dangerous thing. - This primitive stores nil into any cells that become accessible as a result, - and it performs the entire operation atomically." - "Once this primitive is implemented, failure code should cause an error" - - <primitive: 76> - self error: 'stackp store failure'. - " - stackp == nil ifTrue: [stackp := 0]. - newStackp > stackp 'effectively checks that it is a number' - ifTrue: [oldStackp := stackp. - stackp := newStackp. - 'Nil any newly accessible cells' - oldStackp + 1 to: stackp do: [:i | self at: i put: nil]] - ifFalse: [stackp := newStackp] - "! Item was removed: - ----- Method: MethodContext>>startpc (in category 'private') ----- - startpc - ^closureOrNil - ifNil: [self method initialPC] - ifNotNil: [closureOrNil startpc]! Item was removed: - ----- Method: MethodContext>>step (in category 'system simulation') ----- - step - "Simulate the execution of the receiver's next bytecode. Answer the - context that would be the active context after this bytecode." - - ^self interpretNextInstructionFor: self! Item was removed: - ----- Method: MethodContext>>stepToCallee (in category 'system simulation') ----- - stepToCallee - "Step to callee or sender" - - | ctxt | - ctxt := self. - [(ctxt := ctxt step) == self] whileTrue. - ^ ctxt! Item was removed: - ----- Method: MethodContext>>stepToSendOrReturn (in category 'system simulation') ----- - stepToSendOrReturn - "Simulate the execution of bytecodes until either sending a message or - returning a value to the receiver (that is, until switching contexts)." - - | ctxt | - [self willReallySend or: [self willReturn or: [self willReallyStore]]] whileFalse: - [ctxt := self step. - ctxt == self ifFalse: - [self halt. - "Caused by mustBeBoolean handling" - ^ctxt]]! Item was removed: - ----- Method: MethodContext>>storeDataOn: (in category 'objects from disk') ----- - storeDataOn: aDataStream - "Contexts are not always allowed go to out in DataStreams. They must be included inside an ImageSegment, - or be being saved for a closure." - | cntInstVars cntIndexedVars | - - (aDataStream insideASegment - or: [(Notification new tag: self; signal) == self]) ifFalse: "or perhaps ImageSegments were not used at all" - [self error: 'This Context was not included in the ImageSegment']. - - cntInstVars := self class instSize. - cntIndexedVars := self method frameSize. - aDataStream - beginInstance: self class - size: cntInstVars + cntIndexedVars. - 1 to: cntInstVars do: - [:i | aDataStream nextPut: (self instVarAt: i)]. - 1 to: stackp do: - [:i | aDataStream nextPut: (self basicAt: i)]. - stackp + 1 to: cntIndexedVars do: - [:i | aDataStream nextPut: nil]! Item was removed: - ----- Method: MethodContext>>storeIntoLiteralVariable: (in category 'instruction decoding') ----- - storeIntoLiteralVariable: value - "Simulate the action of bytecode that stores the top of the stack into a - literal variable of my method." - - self object: value instVarAt: ValueIndex put: self top! Item was removed: - ----- Method: MethodContext>>storeIntoReceiverVariable: (in category 'instruction decoding') ----- - storeIntoReceiverVariable: offset - "Simulate the action of bytecode that stores the top of the stack into an - instance variable of my receiver." - - self object: self receiver instVarAt: offset + 1 put: self top! Item was removed: - ----- Method: MethodContext>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') ----- - storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex - "Simulate the action of bytecode that stores the top of the stack at - an offset in one of my local variables being used as a remote temp vector." - - self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self top! Item was removed: - ----- Method: MethodContext>>storeIntoTemporaryVariable: (in category 'instruction decoding') ----- - storeIntoTemporaryVariable: offset - "Simulate the action of bytecode that stores the top of the stack into one - of my temporary variables." - - self at: offset + 1 put: self top! Item was removed: - ----- Method: MethodContext>>swapReceiver: (in category 'private-exceptions') ----- - swapReceiver: r - - receiver := r! Item was removed: - ----- Method: MethodContext>>swapSender: (in category 'debugger access') ----- - swapSender: coroutine - "Replace the receiver's sender with coroutine and answer the receiver's - previous sender. For use in coroutining." - - | oldSender | - oldSender := sender. - sender := coroutine. - ^oldSender! Item was removed: - ----- Method: MethodContext>>tempAt: (in category 'accessing') ----- - tempAt: index - "Answer the value of the temporary variable whose index is the - argument, index. Primitive. Assumes receiver is indexable. Answer the - value of an indexable element in the receiver. Fail if the argument index - is not an Integer or is out of bounds. Essential. See Object documentation - whatIsAPrimitive. Override the default at: primitive to give latitude to the - VM in context management." - - <primitive: 210> - ^self at: index! Item was removed: - ----- Method: MethodContext>>tempAt:put: (in category 'accessing') ----- - tempAt: index put: value - "Store the argument, value, as the temporary variable whose index is the - argument, index. Primitive. Assumes receiver is indexable. Answer the - value of an indexable element in the receiver. Fail if the argument index - is not an Integer or is out of bounds. Essential. See Object documentation - whatIsAPrimitive. Override the default at:put: primitive to give latitude to - the VM in context management." - - <primitive: 211> - ^self at: index put: value! Item was removed: - ----- Method: MethodContext>>tempNames (in category 'debugger access') ----- - tempNames - "Answer a SequenceableCollection of the names of the receiver's temporary - variables, which are strings." - - ^ self debuggerMap tempNamesForContext: self! Item was removed: - ----- Method: MethodContext>>tempsAndValues (in category 'debugger access') ----- - tempsAndValues - "Return a string of the temporary variables and their current values" - ^self debuggerMap tempsAndValuesForContext: self! Item was removed: - ----- Method: MethodContext>>tempsAndValuesLimitedTo:indent: (in category 'debugger access') ----- - tempsAndValuesLimitedTo: sizeLimit indent: indent - "Return a string of the temporary variabls and their current values" - - | aStream | - aStream := WriteStream on: (String new: 100). - self tempNames - doWithIndex: [:title :index | - indent timesRepeat: [aStream tab]. - aStream nextPutAll: title; nextPut: $:; space; tab. - aStream nextPutAll: - ((self tempAt: index) printStringLimitedTo: (sizeLimit -3 -title size max: 1)). - aStream cr]. - ^aStream contents! Item was removed: - ----- Method: MethodContext>>terminate (in category 'controlling') ----- - terminate - "Make myself unresumable." - - sender := nil. - pc := nil. - ! Item was removed: - ----- Method: MethodContext>>terminateTo: (in category 'controlling') ----- - terminateTo: previousContext - "Terminate all the Contexts between me and previousContext, if previousContext is on my Context stack. Make previousContext my sender." - - | currentContext sendingContext | - <primitive: 196> - (self hasSender: previousContext) ifTrue: [ - currentContext := sender. - [currentContext == previousContext] whileFalse: [ - sendingContext := currentContext sender. - currentContext terminate. - currentContext := sendingContext]]. - sender := previousContext! Item was removed: - ----- Method: MethodContext>>top (in category 'controlling') ----- - top - "Answer the top of the receiver's stack." - - ^self at: stackp! Item was removed: - ----- Method: MethodContext>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') ----- - tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments - "Invoke the named primitive for aCompiledMethod, answering its result, or, - if the primiitve fails, answering the error code." - <primitive: 218 error: ec> - ec ifNotNil: - ["If ec is an integer other than -1 there was a problem with primitive 218, - not with the external primitive itself. -1 indicates a generic failure (where - ec should be nil) but ec = nil means primitive 218 is not implemented. So - interpret -1 to mean the external primitive failed with a nil error code." - ec isInteger ifTrue: - [ec = -1 - ifTrue: [ec := nil] - ifFalse: [self primitiveFailed]]]. - ^self class primitiveFailTokenFor: ec! Item was removed: - ----- Method: MethodContext>>tryPrimitiveFor:receiver:args: (in category 'private') ----- - tryPrimitiveFor: method receiver: receiver args: arguments - "If this method has a primitive index, then run the primitive and return its result. - Otherwise (and also if the primitive fails) return PrimitiveFailToken, - as an indication that the method should be activated and run as bytecodes." - | primIndex | - (primIndex := method primitive) = 0 ifTrue: [^{PrimitiveFailToken. nil}]. - ^ self doPrimitive: primIndex method: method receiver: receiver args: arguments! Item was removed: - ----- Method: MethodContext>>unwindTo: (in category 'private-exceptions') ----- - unwindTo: aContext - - | ctx unwindBlock | - ctx := self. - [(ctx := ctx findNextUnwindContextUpTo: aContext) isNil] whileFalse: [ - (ctx tempAt: 2) ifNil:[ - ctx tempAt: 2 put: true. - unwindBlock := ctx tempAt: 1. - unwindBlock value] - ]. - !

1 0

The Trunk: KernelTests-eem.324.mcz
by commits＠source.squeak.org 30 Mar '17

30 Mar '17

Eliot Miranda uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-eem.324.mcz ==================== Summary ==================== Name: KernelTests-eem.324 Author: eem Time: 29 March 2017, 3:12:01.90127 pm UUID: 39fd2f8f-7407-438e-a8ec-d1afed5aabfa Ancestors: KernelTests-eem.323 Rewrite the tests that refer to ContextPart to refer to Context. =============== Diff against KernelTests-eem.323 =============== Item was changed: ----- Method: BlockClosureTest>>testNew (in category 'tests') ----- testNew + self should: [Context new: 5] raise: Error. + [Context new: 5] - self should: [ContextPart new: 5] raise: Error. - [ContextPart new: 5] on: Error do: [:e| self assert: (e messageText includesSubstring: 'newForMethod:') description: 'Error doesn''t tell you what you did wrong by calling #new:']. + self should: [Context new] raise: Error. + [Context new] - self should: [ContextPart new] raise: Error. - [ContextPart new] on: Error do: [:e| self assert: (e messageText includesSubstring: 'newForMethod:') description: 'Error doesn''t tell you what you did wrong by calling #new']! Item was changed: ----- Method: BlockClosureTest>>testRunSimulated (in category 'tests') ----- testRunSimulated + self assert: Rectangle equals: (Context runSimulated: aBlockClosure asContext) class! - self assert: Rectangle equals: (ContextPart runSimulated: aBlockClosure asContext) class! Item was changed: ----- Method: BlockClosureTest>>testTallyInstructions (in category 'tests') ----- testTallyInstructions + self assert: (Context tallyInstructions: aBlockClosure asContext) size = 15! - self assert: (ContextPart tallyInstructions: aBlockClosure asContext) size = 15!

1 0

The Trunk: Kernel-eem.1077.mcz
by commits＠source.squeak.org 30 Mar '17

30 Mar '17

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1077.mcz ==================== Summary ==================== Name: Kernel-eem.1077 Author: eem Time: 29 March 2017, 3:04:05.986235 pm UUID: 75644985-5261-4c6d-898b-0e0d9cdc8194 Ancestors: Kernel-eem.1076 Add the preamble script to morph MethodContext to Context =============== Diff against Kernel-eem.1076 =============== Item was changed: + (PackageInfo named: 'Kernel') preamble: 'CompiledMethod addCompiledCodeAndCompiledBlock. + thisContext class name == #Context ifFalse: + [MethodContext bootstrapContext]'! - (PackageInfo named: 'Kernel') preamble: 'CompiledMethod addCompiledCodeAndCompiledBlock'!

1 0

The Trunk: Kernel-eem.1076.mcz
by commits＠source.squeak.org 30 Mar '17

30 Mar '17

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1076.mcz ==================== Summary ==================== Name: Kernel-eem.1076 Author: eem Time: 29 March 2017, 3:01:43.924041 pm UUID: b60293c4-14bf-46f0-b254-7bfa9a4287d8 Ancestors: Kernel-eem.1075 Save the explicit script to morph MethodContext into Context =============== Diff against Kernel-eem.1075 =============== Item was added: + ----- Method: MethodContext class>>bootstrapContext (in category 'context bootstrap') ----- + bootstrapContext + "Rename MethodContext to Context." + MethodContext ensureClassPool. + MethodContext classPool addAll: ContextPart classPool associations. + MethodContext superclass: InstructionStream. + MethodContext class superclass: InstructionStream class. + InstructionStream addSubclass: MethodContext. + MethodContext + setInstVarNames: ContextPart instVarNames, MethodContext instVarNames; + rename: #Context!

1 0

The Trunk: Kernel-eem.1075.mcz
by commits＠source.squeak.org 29 Mar '17

29 Mar '17

1 0

The Trunk: Tools-eem.749.mcz
by commits＠source.squeak.org 29 Mar '17

29 Mar '17

Eliot Miranda uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-eem.749.mcz ==================== Summary ==================== Name: Tools-eem.749 Author: eem Time: 29 March 2017, 2:32:55.824435 pm UUID: 6953ef67-4430-4da2-9d44-0fdf9c87e1c7 Ancestors: Tools-eem.748 Compile ContextPart>>errorReportOn: in MethodContext, and refer to MehodContext in informExistingDebugger:label:, not ContextPart, prior to eliminating ContextPart. =============== Diff against Tools-eem.748 =============== Item was changed: ----- Method: Debugger class>>informExistingDebugger:label: (in category 'instance creation') ----- informExistingDebugger: aContext label: aString "Walking the context chain, we try to find out if we're in a debugger stepping situation. + If we find the relevant contexts, we must rearrange them so they look just like they would + if the methods were executed outside of the debugger. + hmm 8/3/2001 13:05" - If we find the relevant contexts, we must rearrange them so they look just like they would - if the methods were excuted outside of the debugger." | ctx quickStepMethod oldSender baseContext | ctx := thisContext. + quickStepMethod := MethodContext compiledMethodAt: #quickSend:to:with:super:. - quickStepMethod := ContextPart compiledMethodAt: #quickSend:to:with:super:. [ctx sender == nil or: [ctx sender method == quickStepMethod]] whileFalse: [ctx := ctx sender]. + ctx sender ifNil: [^self]. - ctx sender == nil ifTrue: [^self]. baseContext := ctx. "baseContext is now the context created by the #quickSend... method." oldSender := ctx := ctx sender home sender. "oldSender is the context which originally sent the #quickSend... method" + [ctx == nil or: [(ctx objectClass: ctx receiver) includesBehavior: self]] whileFalse: [ctx := ctx sender]. + ctx ifNil: [^self]. - [ctx == nil or: [ctx receiver isKindOf: self]] whileFalse: [ctx := ctx sender]. - ctx == nil ifTrue: [^self]. "ctx is the context of the Debugger method #doStep" + ctx receiver + labelString: aString; + externalInterrupt: false; + proceedValue: aContext receiver. - ctx receiver labelString: aString. - ctx receiver externalInterrupt: false; proceedValue: aContext receiver. baseContext swapSender: baseContext sender sender sender. "remove intervening contexts" thisContext swapSender: oldSender. "make myself return to debugger" ErrorRecursion := false. ^aContext! Item was added: + ----- Method: MethodContext>>errorReportOn: (in category '*Tools-debugger access') ----- + errorReportOn: strm + "Write a detailed error report on the stack (above me) on a stream. For both the error file, and emailing a bug report. Suppress any errors while getting printStrings. Limit the length." + + | cnt aContext startPos | + strm print: Date today; space; print: Time now; cr. + strm cr. + strm nextPutAll: 'VM: '; + nextPutAll: Smalltalk platformName asString; + nextPutAll: ' - '; + nextPutAll: Smalltalk asString; + cr. + strm nextPutAll: 'Image: '; + nextPutAll: SystemVersion current version asString; + nextPutAll: ' ['; + nextPutAll: Smalltalk lastUpdateString asString; + nextPutAll: ']'; + cr. + strm cr. + SecurityManager default printStateOn: strm. + + "Note: The following is an open-coded version of ContextPart>>stackOfSize: since this method may be called during a low space condition and we might run out of space for allocating the full stack." + cnt := 0. startPos := strm position. + aContext := self. + [aContext notNil and: [(cnt := cnt + 1) < 20]] whileTrue: + [aContext printDetails: strm. "variable values" + strm cr. + aContext := aContext sender]. + + strm cr; nextPutAll: '--- The full stack ---'; cr. + aContext := self. + cnt := 0. + [aContext == nil] whileFalse: + [cnt := cnt + 1. + cnt = 20 ifTrue: [strm nextPutAll: ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'; cr]. + strm print: aContext; cr. "just class>>selector" + + "exit early if too long..." + strm position > (startPos+ self class maxLengthForASingleDebugLogReport) ifTrue: [strm nextPutAll: '...etc...'. ^ self]. cnt > self class maxStackDepthForASingleDebugLogReport ifTrue: [strm nextPutAll: '-- and more not shown --'. ^ self]. + aContext := aContext sender]. + !

1 0

← Newer
1
2
3
4
5
6
7
...
17
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages March 2017