Squeak-dev March 2017

squeak-dev@lists.squeakfoundation.org

50 participants
281 discussions

The Trunk: Compiler-eem.336.mcz
by commits＠source.squeak.org 31 Mar '17

31 Mar '17

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-eem.336.mcz ==================== Summary ==================== Name: Compiler-eem.336 Author: eem Time: 30 March 2017, 6:03:14.217388 pm UUID: bcc6a515-1159-462a-9ab9-89faeeadfadc Ancestors: Compiler-eem.335 Replace mention of MethodContext with Context in class comments as appropriate. =============== Diff against Compiler-eem.335 =============== Item was changed: Object subclass: #CompilationCue instanceVariableNames: 'source context receiver class environment requestor' classVariableNames: '' poolDictionaries: '' category: 'Compiler-Kernel'! + !CompilationCue commentStamp: 'eem 3/30/2017 17:32' prior: 0! - !CompilationCue commentStamp: 'nice 9/20/2013 02:07' prior: 0! A CompilationCue is a helper class holding enough context for evaluating/compiling Smalltalk code. That is mainly the source code, and the source code editor to interact with if the Compiler is used interactively. But that is also any additional information necessary to resolve variable names. When compiling a method, the Compiler typically need to know the target class in which to install the method. When evaluating an expression, the Compiler also needs a receiver (for accessing the value of its instance variables), its class (for resolving instance/class variable names), and optionnally a context of execution when debugging a method (for accessing values of temporaries and parameters). Instance Variables + class: <Behavior> + context: <Context | nil> + environment: <Environment | nil> - class: <Behavior> - context: <ContextPart | nil> - environment: <Environment | nil> receiver: <Object> requestor: <TextEditor | nil> + source: <Stream> - source: <Stream> class - the target class in which to install the compiled method; this enables to resolve the instance variable names, class variable names and shared pool variable names. When evaluating, this should be the receiver class context - the context introspected when evaluating the code: this is typically for accessing parameters and temporary variables when debugging environment - the environment in which to resolve global variable names receiver - the receiver into which to evaluate the code: this is typically for accessing instance variables in an inspector requestor - typically the text editor containing the source code being compiled/evaluated. This enables the Compiler to interact in case of syntax error. source - a ReadStream on the source code to be compiled !

1 0

The Trunk: Collections-eem.743.mcz
by commits＠source.squeak.org 31 Mar '17

31 Mar '17

Eliot Miranda uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-eem.743.mcz ==================== Summary ==================== Name: Collections-eem.743 Author: eem Time: 30 March 2017, 6:02:18.123591 pm UUID: c8c62336-051e-4025-82d1-7dc2bebe4b6e Ancestors: Collections-ul.742 Replace mention of MethodContext with Context in class comments as appropriate. =============== Diff against Collections-ul.742 =============== Item was changed: Stream subclass: #Generator instanceVariableNames: 'block next continue home' classVariableNames: '' poolDictionaries: '' category: 'Collections-Streams'! + !Generator commentStamp: 'eem 3/30/2017 17:31' prior: 0! - !Generator commentStamp: 'ar 2/10/2010 20:51' prior: 0! A Generator transforms callback interfaces into stream interfaces. When a producer algorithm provide results as callbacks (blocks) and a consumer algorithm expects streamable input, a Generator transforms one into the other, for example: | generator | generator := Generator on: [:g| Integer primesUpTo: 100 do:[:prime| g yield: prime]]. [generator atEnd] whileFalse:[Transcript show: generator next]. Instance Variables + block: <BlockClosure> The block associated with the generator. + continue: <Context> The continuation to return to. + home: <Context> The home (root) context of the activated block + next: <Object> The next object to return from the Generator.! - block: <BlockClosure> The block associated with the generator. - continue: <MethodContext> The continuation to return to. - home: <MethodContext> The home (root) context of the activated block - next: <Object> The next object to return from the Generator. - ! Item was changed: Dictionary subclass: #PluggableDictionary instanceVariableNames: 'hashBlock equalBlock' classVariableNames: '' poolDictionaries: '' category: 'Collections-Unordered'! + !PluggableDictionary commentStamp: 'eem 3/30/2017 17:44' prior: 0! - !PluggableDictionary commentStamp: '<historical>' prior: 0! Class PluggableDictionary allows the redefinition of hashing and equality by clients. This is in particular useful if the clients know about specific properties of the objects stored in the dictionary. See the class comment of PluggableSet for an example. Instance variables: + hashBlock <BlockClosure> A one argument block used for hashing the elements. + equalBlock <BlockClosure> A two argument block used for comparing the elements. - hashBlock <BlockContext> A one argument block used for hashing the elements. - equalBlock <BlockContext> A two argument block used for comparing the elements. ! Item was changed: Set subclass: #PluggableSet instanceVariableNames: 'hashBlock equalBlock' classVariableNames: '' poolDictionaries: '' category: 'Collections-Unordered'! + !PluggableSet commentStamp: 'eem 3/30/2017 17:59' prior: 0! - !PluggableSet commentStamp: 'nice 3/25/2010 23:02' prior: 0! PluggableSets allow the redefinition of hashing and equality by clients. This is in particular useful if the clients know about specific properties of the objects stored in the set which in turn can heavily improve the performance of sets and dictionaries. Instance variables: + hashBlock <BlockClosure> A one argument block used for hashing the elements. + equalBlock <BlockClosure> A two argument block used for comparing the elements. - hashBlock <BlockContext> A one argument block used for hashing the elements. - equalBlock <BlockContext> A two argument block used for comparing the elements. + Example: Adding 1000000 integer points in the range (0@0) to: (100@100) to a set. - Example: Adding 1000 integer points in the range (0@0) to: (100@100) to a set. + ( | n rnd set max points | + set := Set new: (n := 1000000). - | rnd set max pt | - set := Set new: 1000. rnd := Random new. max := 100. + points := (1 to: n) collect: [:ign| (rnd next @ rnd next * max) truncated]. + Smalltalk garbageCollectMost. "to reduce variability in the run-to-run times" + [1 to: 1000000 do: [:i| set add: (points at: i)]] + timeToRun + ) - Time millisecondsToRun:[ - 1 to: 1000 do:[:i| - pt := (rnd next * max) truncated @ (rnd next * max) truncated. - set add: pt. - ]. - ]. The above is way slow since the default hashing function of points leads to an awful lot of collisions in the set. And now the same, with a somewhat different hash function: + ( | n rnd set max points | + set := PluggableSet new: (n := 1000000). + set hashBlock: [:item| (item x bitShift: 10) + item y]. - | rnd set max pt | - set := PluggableSet new: 1000. - set hashBlock:[:item| (item x bitShift: 16) + item y]. rnd := Random new. max := 100. + points := (1 to: n) collect: [:ign| (rnd next @ rnd next * max) truncated]. + Smalltalk garbageCollectMost. "to reduce variability in the run-to-run times" + [1 to: 1000000 do: [:i| set add: (points at: i)]] + timeToRun + )! - Time millisecondsToRun:[ - 1 to: 1000 do:[:i| - pt := (rnd next * max) truncated @ (rnd next * max) truncated. - set add: pt. - ]. - ]. - ! Item was changed: OrderedCollection subclass: #SortedCollection instanceVariableNames: 'sortBlock' classVariableNames: '' poolDictionaries: '' category: 'Collections-Sequenceable'! + !SortedCollection commentStamp: 'eem 3/30/2017 17:33' prior: 0! + I represent a collection of objects ordered by some property of the objects themselves. The ordering is specified in a two argument BlockClosure. The default sorting function is a <= comparison on elements.! - !SortedCollection commentStamp: 'dtl 9/6/2009 16:02' prior: 0! - I represent a collection of objects ordered by some property of the objects themselves. The ordering is specified in a BlockContext. The default sorting function is a <= comparison on elements.!

1 0

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

31 Mar '17

Eliot Miranda uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-eem.753.mcz ==================== Summary ==================== Name: Tools-eem.753 Author: eem Time: 30 March 2017, 5:24:31.941311 pm UUID: 55e72d95-e5b4-4bcb-801b-167d4786b8f6 Ancestors: Tools-eem.752 Replace mention of BlockContext with BlockClosure in comments as appropriate. =============== Diff against Tools-eem.752 =============== Item was changed: ----- Method: Context>>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 Context>>stackOfSize: since this method may be called during a low space condition and we might run out of space for allocating the full stack." - "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] - aContext := aContext sender]. !

1 0

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

31 Mar '17

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.946.mcz ==================== Summary ==================== Name: System-eem.946 Author: eem Time: 30 March 2017, 5:19:24.525317 pm UUID: ab09aaa3-d125-4b1b-9612-1535dc3d4f88 Ancestors: System-eem.945 Eliminate unnecessary named reference to #MethodContext. Add some additional expected variable classes to SmartRefStream. Bert would you mind reviewing this? =============== Diff against System-eem.945 =============== Item was changed: ----- Method: SmalltalkImage>>recreateSpecialObjectsArray (in category 'special objects') ----- recreateSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "To external package developers: **** DO NOT OVERRIDE THIS METHOD. ***** If you are writing a plugin and need additional special object(s) for your own use, use addGCRoot() function and use own, separate special objects registry " "The Special Objects Array is an array of objects used by the Squeak virtual machine. Its contents are critical and accesses to it by the VM are unchecked, so don't even think of playing here unless you know what you are doing." | newArray | newArray := Array new: 60. "Nil false and true get used throughout the interpreter" newArray at: 1 put: nil. newArray at: 2 put: false. newArray at: 3 put: true. "This association holds the active process (a ProcessScheduler)" newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias". "Numerous classes below used for type checking and instantiation" newArray at: 5 put: Bitmap. newArray at: 6 put: SmallInteger. newArray at: 7 put: ByteString. newArray at: 8 put: Array. newArray at: 9 put: Smalltalk. newArray at: 10 put: BoxedFloat64. + newArray at: 11 put: (self globals at: #Context). - newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]). newArray at: 12 put: nil. "was BlockContext." newArray at: 13 put: Point. newArray at: 14 put: LargePositiveInteger. newArray at: 15 put: Display. newArray at: 16 put: Message. newArray at: 17 put: CompiledMethod. newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore" newArray at: 19 put: Semaphore. newArray at: 20 put: Character. newArray at: 21 put: #doesNotUnderstand:. newArray at: 22 put: #cannotReturn:. newArray at: 23 put: nil. "This is the process signalling low space." "An array of the 32 selectors that are compiled as special bytecodes, paired alternately with the number of arguments each takes." newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1 #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1 #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0 #~~ 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ). "An array of the 255 Characters in ascii order. Cog inlines table into machine code at: prim so do not regenerate it. This is nil in Spur, which has immediate Characters." newArray at: 25 put: (self specialObjectsArray at: 25). newArray at: 26 put: #mustBeBoolean. newArray at: 27 put: ByteArray. newArray at: 28 put: Process. "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur" newArray at: 29 put: self compactClassesArray. newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore" newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore" "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization" newArray at: 32 put: nil. "was the prototype Float" newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger" newArray at: 34 put: nil. "was the prototype Point" newArray at: 35 put: #cannotInterpret:. newArray at: 36 put: nil. "was the prototype MethodContext" newArray at: 37 put: BlockClosure. newArray at: 38 put: nil. "was the prototype BlockContext" "array of objects referred to by external code" newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores" newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs" newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT" newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore" newArray at: 43 put: LargeNegativeInteger. "External objects for callout. Note: Written so that one can actually completely remove the FFI." newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []). newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []). newArray at: 46 put: (self at: #ExternalData ifAbsent: []). newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []). newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []). newArray at: 49 put: #aboutToReturn:through:. newArray at: 50 put: #run:with:in:. "51 reserved for immutability message" newArray at: 51 put: #attemptToAssign:withIndex:. newArray at: 52 put: #(nil "nil => generic error" #'bad receiver' #'bad argument' #'bad index' #'bad number of arguments' #'inappropriate operation' #'unsupported operation' #'no modification' #'insufficient object memory' #'insufficient C memory' #'not found' #'bad method' #'internal error in named primitive machinery' #'object may move' #'resource limit exceeded' #'object is pinned' #'primitive write beyond end of object' #'object moved' #'object not pinned' #'callback error'). "53 to 55 are for Alien" newArray at: 53 put: (self at: #Alien ifAbsent: []). newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks." newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []). "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support." newArray at: 56 put: nil. "reserved for foreign callback process" newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []). newArray at: 58 put: #unusedBytecode. "59 reserved for Sista counter tripped message" newArray at: 59 put: #conditionalBranchCounterTrippedOn:. "60 reserved for Sista class trap message" newArray at: 60 put: #classTrapFor:. "Now replace the interpreter's reference in one atomic operation" self specialObjectsArray becomeForward: newArray! Item was changed: ----- Method: SmartRefStream>>mapClass:origName: (in category 'import image segment') ----- mapClass: newClass origName: originalName "See if instances changed shape. If so, make a fake class for the old shape and return it. Remember the original class name." | newName oldInstVars fakeClass | newClass isMeta ifTrue: [^ newClass]. newName := newClass name. (steady includes: newClass) & (newName == originalName) ifTrue: [^ newClass]. "instances in the segment have the right shape" oldInstVars := structures at: originalName ifAbsent: [ self error: 'class is not in structures list']. "Missing in object file" "Allow mapping from old to new string names" (newName == #ByteString and:[originalName == #String]) ifTrue:[^newClass]. (newName == #WideString and:[originalName == #MultiString]) ifTrue:[^newClass]. (newName == #WideSymbol and:[originalName == #MultiSymbol]) ifTrue:[^newClass]. "Variable classes are not handled fully. This one is fine. --bf" newName == #MethodContext ifTrue: [^newClass]. + "As I hope are these? --eem" + (#(Context BlockClosure AdditionalMethodState) includes: newName) ifTrue: + [^newClass]. fakeClass := Object subclass: ('Fake37', originalName) asSymbol instanceVariableNames: oldInstVars allButFirst classVariableNames: '' poolDictionaries: '' category: 'Obsolete'. ChangeSet current removeClassChanges: fakeClass name. "reduce clutter" ^ fakeClass !

1 0

The Trunk: ST80-eem.225.mcz
by commits＠source.squeak.org 31 Mar '17

31 Mar '17

Eliot Miranda uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-eem.225.mcz ==================== Summary ==================== Name: ST80-eem.225 Author: eem Time: 30 March 2017, 5:17:50.795656 pm UUID: 4d0e7040-3099-47d8-b1d7-af4a54e67e80 Ancestors: ST80-ul.224 Replace mention of BlockContext with BlockClosure in the non-Morphic explainer code. =============== Diff against ST80-ul.224 =============== Item was changed: ----- Method: ParagraphEditor>>explainChar: (in category 'explain') ----- explainChar: string "Does string start with a special character?" | char | char := string at: 1. char = $. ifTrue: [^'"Period marks the end of a Smalltalk statement. A period in the middle of a number means a decimal point. (The number is an instance of class Float)."']. char = $' ifTrue: [^'"The characters between two single quotes are made into an instance of class String"']. char = $" ifTrue: [^'"Double quotes enclose a comment. Smalltalk ignores everything between double quotes."']. char = $# ifTrue: [^'"The characters following a hash mark are made into an instance of class Symbol. If parenthesis follow a hash mark, an instance of class Array is made. It contains literal constants."']. (char = $( or: [char = $)]) ifTrue: [^'"Expressions enclosed in parenthesis are evaluated first"']. + (char = $[ or: [char = $]]) ifTrue: [^'"The code inside square brackets is an unevaluated block of code. It becomes an instance of BlockClosure and is usually passed as an argument."']. - (char = $[ or: [char = $]]) ifTrue: [^'"The code inside square brackets is an unevaluated block of code. It becomes an instance of BlockContext and is usually passed as an argument."']. (char = ${ or: [char = $}]) ifTrue: [^ '"A sequence of expressions separated by periods, when enclosed in curly braces, are evaluated to yield the elements of a new Array"']. (char = $< or: [char = $>]) ifTrue: [^'"<primitive: xx> means that this method is usually preformed directly by the virtual machine. If this method is primitive, its Smalltalk code is executed only when the primitive fails."']. char = $^ ifTrue: [^'"Uparrow means return from this method. The value returned is the expression following the ^"']. char = $| ifTrue: [^'"Vertical bars enclose the names of the temporary variables used in this method. In a block, the vertical bar separates the argument names from the rest of the code."']. char = $_ ifTrue: [^'"Left arrow means assignment. The value of the expression after the left arrow is stored into the variable before it."']. char = $; ifTrue: [^'"Semicolon means cascading. The message after the semicolon is sent to the same object which received the message before the semicolon."']. char = $: ifTrue: [^'"A colon at the end of a keyword means that an argument is expected to follow. Methods which take more than one argument have selectors with more than one keyword. (One keyword, ending with a colon, appears before each argument).', '\\' withCRs, 'A colon before a variable name just inside a block means that the block takes an agrument. (When the block is evaluated, the argument will be assigned to the variable whose name appears after the colon)."']. char = $$ ifTrue: [^'"The single character following a dollar sign is made into an instance of class Character"']. char = $- ifTrue: [^'"A minus sign in front of a number means a negative number."']. char = $e ifTrue: [^'"An e in the middle of a number means that the exponent follows."']. char = $r ifTrue: [^'"An r in the middle of a bunch of digits is an instance of Integer expressed in a certain radix. The digits before the r denote the base and the digits after it express a number in that base."']. char = Character space ifTrue: [^'"the space Character"']. char = Character tab ifTrue: [^'"the tab Character"']. char = Character cr ifTrue: [^'"the carriage return Character"']. char = Character lf ifTrue: [^'"the line feed Character"']. ^nil! Item was changed: ----- Method: ParagraphEditor>>explainCtxt: (in category 'explain') ----- explainCtxt: symbol "Is symbol a context variable?" | reply classes text cls | symbol = #nil ifTrue: [reply := '"is a constant. It is the only instance of class UndefinedObject. nil is the initial value of all variables."']. symbol = #true ifTrue: [reply := '"is a constant. It is the only instance of class True and is the receiver of many control messages."']. symbol = #false ifTrue: [reply := '"is a constant. It is the only instance of class False and is the receiver of many control messages."']. + symbol = #thisContext ifTrue: [reply := '"is a context variable. Its value is always the Context which is executing this method."']. - symbol = #thisContext ifTrue: [reply := '"is a context variable. Its value is always the MethodContext which is executing this method."']. (model respondsTo: #selectedClassOrMetaClass) ifTrue: [ cls := model selectedClassOrMetaClass]. cls ifNil: [^ reply]. "no class known" symbol = #self ifTrue: [classes := cls withAllSubclasses. classes size > 12 ifTrue: [text := cls printString , ' or a subclass'] ifFalse: [classes := classes printString. text := 'one of these classes' , (classes copyFrom: 4 to: classes size)]. reply := '"is the receiver of this message; an instance of ' , text , '"']. symbol = #super ifTrue: [reply := '"is just like self. Messages to super are looked up in the superclass (' , cls superclass printString , ')"']. ^reply!

1 0

The Trunk: Morphic-eem.1332.mcz
by commits＠source.squeak.org 31 Mar '17

31 Mar '17

Eliot Miranda uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-eem.1332.mcz ==================== Summary ==================== Name: Morphic-eem.1332 Author: eem Time: 30 March 2017, 5:16:31.544874 pm UUID: b9f51007-d896-4a7e-9390-1fa7bf41cb56 Ancestors: Morphic-bf.1331 Replace mention of BlockContext with BlockClosure in teh Morphic explainer code. =============== Diff against Morphic-bf.1331 =============== Item was changed: ----- Method: TextEditor>>explainChar: (in category 'explain') ----- explainChar: string "Does string start with a special character?" | char | char := string at: 1. char = $. ifTrue: [^'"Period marks the end of a Smalltalk statement. A period in the middle of a number means a decimal point. (The number is an instance of class Float)."']. char = $' ifTrue: [^'"The characters between two single quotes are made into an instance of class String"']. char = $" ifTrue: [^'"Double quotes enclose a comment. Smalltalk ignores everything between double quotes."']. char = $# ifTrue: [^'"The characters following a hash mark are made into an instance of class Symbol. If parenthesis follow a hash mark, an instance of class Array is made. It contains literal constants."']. (char = $( or: [char = $)]) ifTrue: [^'"Expressions enclosed in parenthesis are evaluated first"']. + (char = $[ or: [char = $]]) ifTrue: [^'"The code inside square brackets is an unevaluated block of code. It becomes an instance of BlockClosure and is usually passed as an argument."']. - (char = $[ or: [char = $]]) ifTrue: [^'"The code inside square brackets is an unevaluated block of code. It becomes an instance of BlockContext and is usually passed as an argument."']. (char = ${ or: [char = $}]) ifTrue: [^ '"A sequence of expressions separated by periods, when enclosed in curly braces, are evaluated to yield the elements of a new Array"']. (char = $< or: [char = $>]) ifTrue: [^'"<primitive: xx> means that this method is usually preformed directly by the virtual machine. If this method is primitive, its Smalltalk code is executed only when the primitive fails."']. char = $^ ifTrue: [^'"Uparrow means return from this method. The value returned is the expression following the ^"']. char = $| ifTrue: [^'"Vertical bars enclose the names of the temporary variables used in this method. In a block, the vertical bar separates the argument names from the rest of the code."']. char = $_ ifTrue: [^'"Left arrow means assignment. The value of the expression after the left arrow is stored into the variable before it."']. char = $; ifTrue: [^'"Semicolon means cascading. The message after the semicolon is sent to the same object which received the message before the semicolon."']. char = $: ifTrue: [^'"A colon at the end of a keyword means that an argument is expected to follow. Methods which take more than one argument have selectors with more than one keyword. (One keyword, ending with a colon, appears before each argument).', '\\' withCRs, 'A colon before a variable name just inside a block means that the block takes an agrument. (When the block is evaluated, the argument will be assigned to the variable whose name appears after the colon)."']. char = $$ ifTrue: [^'"The single character following a dollar sign is made into an instance of class Character"']. char = $- ifTrue: [^'"A minus sign in front of a number means a negative number."']. char = $e ifTrue: [^'"An e in the middle of a number means that the exponent follows."']. char = $r ifTrue: [^'"An r in the middle of a bunch of digits is an instance of Integer expressed in a certain radix. The digits before the r denote the base and the digits after it express a number in that base."']. char = Character space ifTrue: [^'"the space Character"']. char = Character tab ifTrue: [^'"the tab Character"']. char = Character cr ifTrue: [^'"the carriage return Character"']. char = Character lf ifTrue: [^'"the line feed Character"']. ^nil! Item was changed: ----- Method: TextEditor>>explainCtxt: (in category 'explain') ----- explainCtxt: symbol "Is symbol a context variable?" | reply classes text cls | symbol = #nil ifTrue: [reply := '"is a constant. It is the only instance of class UndefinedObject. nil is the initial value of all variables."']. symbol = #true ifTrue: [reply := '"is a constant. It is the only instance of class True and is the receiver of many control messages."']. symbol = #false ifTrue: [reply := '"is a constant. It is the only instance of class False and is the receiver of many control messages."']. + symbol = #thisContext ifTrue: [reply := '"is a context variable. Its value is always the Context which is executing this method."']. - symbol = #thisContext ifTrue: [reply := '"is a context variable. Its value is always the MethodContext which is executing this method."']. (model respondsTo: #selectedClassOrMetaClass) ifTrue: [ cls := model selectedClassOrMetaClass]. cls ifNil: [^ reply]. "no class known" symbol = #self ifTrue: [classes := cls withAllSubclasses. classes size > 12 ifTrue: [text := cls printString , ' or a subclass'] ifFalse: [classes := classes printString. text := 'one of these classes' , (classes copyFrom: 4 to: classes size)]. reply := '"is the receiver of this message; an instance of ' , text , '"']. symbol = #super ifTrue: [reply := '"is just like self. Messages to super are looked up in the superclass (' , cls superclass printString , ')"']. ^reply!

1 0

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

31 Mar '17

Eliot Miranda uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-eem.325.mcz ==================== Summary ==================== Name: KernelTests-eem.325 Author: eem Time: 30 March 2017, 5:14:42.144182 pm UUID: d5ee2084-6cd3-4c9c-8000-58e3713a970a Ancestors: KernelTests-eem.324 Make MethodContextTest Context-aware/sensitive/savvy... =============== Diff against KernelTests-eem.324 =============== Item was changed: ----- Method: MethodContextTest>>setUp (in category 'running') ----- setUp super setUp. aCompiledMethod := Rectangle methodDict at: #rightCenter. aReceiver := 100@100 corner: 200@200. aSender := thisContext. + aMethodContext := Context sender: aSender receiver: aReceiver method: aCompiledMethod arguments: #(). ! - aMethodContext := MethodContext sender: aSender receiver: aReceiver method: aCompiledMethod arguments: #(). ! Item was changed: ----- Method: MethodContextTest>>testActivateReturnValue (in category 'tests') ----- testActivateReturnValue + self assert: (aSender activateReturn: aMethodContext value: #()) isContext. - self assert: ((aSender activateReturn: aMethodContext value: #()) isKindOf: MethodContext). self assert: ((aSender activateReturn: aMethodContext value: #()) receiver = aMethodContext).! Item was changed: ----- Method: MethodContextTest>>testSetUp (in category 'tests') ----- testSetUp "Note: In addition to verifying that the setUp worked the way it was expected to, testSetUp is used to illustrate the meaning of the simple access methods, methods that are not normally otherwise 'tested'" self assert: aMethodContext isContext. + self deny: aMethodContext isExecutingBlock. - self assert: aMethodContext isMethodContext. self deny: aMethodContext isClosure. self deny: aMethodContext isDead. "self assert: aMethodContext home = aReceiver." "self assert: aMethodContext blockHome = aReceiver." self assert: aMethodContext receiver = aReceiver. self assert: aMethodContext method isCompiledMethod. self assert: aMethodContext method = aCompiledMethod. self assert: aMethodContext methodNode selector = #rightCenter. self assert: (aMethodContext methodNodeFormattedAndDecorated: true) selector = #rightCenter. self assert: aMethodContext client printString = 'MethodContextTest>>#testSetUp'. !

1 0

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

31 Mar '17

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1079.mcz ==================== Summary ==================== Name: Kernel-eem.1079 Author: eem Time: 30 March 2017, 5:12:50.577477 pm UUID: 2c378b83-0ed9-4add-8a90-5169c20dd173 Ancestors: Kernel-eem.1078 Replace mention of MethodContext with Context in comments as appropriate. Make isMethodContext accurate. Nuke the bootstrapContext script now it's done its job. Nuke the left-over UndefinedObject>>allSuperclassesDo: which clearly does /not/ need to be implemented :-) =============== Diff against Kernel-eem.1078 =============== Item was changed: ----- Method: Behavior>>elementSize (in category 'accessing instances and variables') ----- elementSize "Answer the size in bytes of an element in the receiver. The formats are 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" | instSpec | instSpec := self instSpec. instSpec < 9 ifTrue: [^Smalltalk wordSize]. instSpec >= 16 ifTrue: [^1]. instSpec >= 12 ifTrue: [^2]. instSpec >= 10 ifTrue: [^4]. ^8! Item was changed: ----- Method: Behavior>>instSpec (in category 'testing') ----- instSpec "Answer the instance specification part of the format that defines what kind of object an instance of the receiver is. The formats are 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) (plus one odd bit, unused in 32-bits) 12-15 = 16-bit indexable (plus two odd bits, one unused in 32-bits) 16-23 = 8-bit indexable (plus three odd bits, one unused in 32-bits) 24-31 = compiled methods (CompiledMethod) (plus three odd bits, one unused in 32-bits) Note that in the VM instances also have a 5 bit format field that relates to their class's format. Formats 11, 13-15, 17-23 & 25-31 are unused in classes but used in instances to define the number of elements missing up to the slot size. For example, a 2-byte ByteString instance has format 18 in 32-bits, since its size is one 32-bit slot - 2 bytes ((18 bitAnd: 3) = 2), and 22 in 64 bits, since its size is one 64-bit slot - 6 bytes ((22 bitAnd: 7) = 6)." ^(format bitShift: -16) bitAnd: 16r1F! Item was changed: ----- Method: Behavior>>isBits (in category 'testing') ----- isBits "Answer whether the receiver contains just bits (not pointers). Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^self instSpec >= 7! Item was changed: ----- Method: Behavior>>isBytes (in category 'testing') ----- isBytes "Answer whether the receiver's instances have indexed 8-bit integer instance variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^self instSpec >= 16! Item was changed: ----- Method: Behavior>>isLongs (in category 'testing') ----- isLongs "Answer whether the receiver's instances have indexed 64-bit integer instance variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^self instSpec = 9! Item was changed: ----- Method: Behavior>>isShorts (in category 'testing') ----- isShorts "Answer whether the receiver's instances have indexed 16-bit integer instance variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^self instSpec = 12! Item was changed: ----- Method: Behavior>>isVariable (in category 'testing') ----- isVariable "Answer whether the receiver has indexable variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" | instSpec | instSpec := self instSpec. ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]! Item was changed: ----- Method: Behavior>>isWords (in category 'testing') ----- isWords "Answer whether the receiver's instances have indexed 32-bit integer instance variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^self instSpec = 10! Item was changed: ----- Method: BlockClosure>>asContext (in category 'scheduling') ----- asContext + "Create a Context that is ready to execute self. Assumes self takes no args (if it does the args will be nil)" - "Create a MethodContext that is ready to execute self. Assumes self takes no args (if it does the args will be nil)" ^self asContextWithSender: nil! Item was changed: ----- Method: BlockClosure>>value (in category 'evaluating') ----- value + "Activate the receiver, creating a closure activation (Context) - "Activate the receiver, creating a closure activation (MethodContext) whose closure is the receiver and whose caller is the sender of this message. Supply the copied values to the activation as its copied temps. Primitive. Essential." <primitive: 201> | newContext | numArgs ~= 0 ifTrue: [self numArgsError: 0]. false ifTrue: "Old code to simulate the closure value primitive on VMs that lack it." [newContext := self asContextWithSender: thisContext sender. thisContext privSender: newContext] ifFalse: [self primitiveFailed]! Item was changed: ----- Method: BlockClosure>>value: (in category 'evaluating') ----- value: firstArg + "Activate the receiver, creating a closure activation (Context) - "Activate the receiver, creating a closure activation (MethodContext) whose closure is the receiver and whose caller is the sender of this message. Supply the argument and copied values to the activation as its argument and copied temps. Primitive. Essential." <primitive: 202> | newContext | numArgs ~= 1 ifTrue: [self numArgsError: 1]. false ifTrue: "Old code to simulate the closure value primitive on VMs that lack it." [newContext := self asContextWithSender: thisContext sender. newContext at: 1 put: firstArg. thisContext privSender: newContext] ifFalse: [self primitiveFailed]! Item was changed: ----- Method: BlockClosure>>value:value: (in category 'evaluating') ----- value: firstArg value: secondArg + "Activate the receiver, creating a closure activation (Context) - "Activate the receiver, creating a closure activation (MethodContext) whose closure is the receiver and whose caller is the sender of this message. Supply the arguments and copied values to the activation as its arguments and copied temps. Primitive. Essential." <primitive: 203> | newContext | numArgs ~= 2 ifTrue: [self numArgsError: 2]. false ifTrue: "Old code to simulate the closure value primitive on VMs that lack it." [newContext := self asContextWithSender: thisContext sender. newContext at: 1 put: firstArg. newContext at: 2 put: secondArg. thisContext privSender: newContext] ifFalse: [self primitiveFailed]! Item was changed: ----- Method: BlockClosure>>value:value:value: (in category 'evaluating') ----- value: firstArg value: secondArg value: thirdArg + "Activate the receiver, creating a closure activation (Context) - "Activate the receiver, creating a closure activation (MethodContext) whose closure is the receiver and whose caller is the sender of this message. Supply the arguments and copied values to the activation as its arguments and copied temps. Primitive. Essential." <primitive: 204> | newContext | numArgs ~= 3 ifTrue: [self numArgsError: 3]. false ifTrue: "Old code to simulate the closure value primitive on VMs that lack it." [newContext := self asContextWithSender: thisContext sender. newContext at: 1 put: firstArg. newContext at: 2 put: secondArg. newContext at: 3 put: thirdArg. thisContext privSender: newContext] ifFalse: [self primitiveFailed]! Item was changed: ----- Method: BlockClosure>>value:value:value:value: (in category 'evaluating') ----- value: firstArg value: secondArg value: thirdArg value: fourthArg + "Activate the receiver, creating a closure activation (Context) - "Activate the receiver, creating a closure activation (MethodContext) whose closure is the receiver and whose caller is the sender of this message. Supply the arguments and copied values to the activation as its arguments and copied temps. Primitive. Essential." <primitive: 205> | newContext | numArgs ~= 4 ifTrue: [self numArgsError: 4]. false ifTrue: "Old code to simulate the closure value primitive on VMs that lack it." [newContext := self asContextWithSender: thisContext sender. newContext at: 1 put: firstArg. newContext at: 2 put: secondArg. newContext at: 3 put: thirdArg. newContext at: 4 put: fourthArg. thisContext privSender: newContext] ifFalse: [self primitiveFailed]! Item was changed: ----- Method: BlockClosure>>valueWithArguments: (in category 'evaluating') ----- valueWithArguments: anArray + "Activate the receiver, creating a closure activation (Context) - "Activate the receiver, creating a closure activation (MethodContext) whose closure is the receiver and whose caller is the sender of this message. Supply the arguments in an anArray and copied values to the activation as its arguments and copied temps. Primitive. Essential." <primitive: 206> | newContext | numArgs ~= anArray size ifTrue: [self numArgsError: anArray size]. false ifTrue: "Old code to simulate the closure value primitive on VMs that lack it." [newContext := self asContextWithSender: thisContext sender. 1 to: numArgs do: [:i| newContext at: i put: (anArray at: i)]. thisContext privSender: newContext] ifFalse: [self primitiveFailed]! Item was changed: ----- Method: ClassBuilder>>format:variable:bitsUnitSize:pointers:weak: (in category 'class format') ----- format: nInstVars variable: isVar bitsUnitSize: bitsUnitSize pointers: isPointers weak: isWeak "Compute the format for the given instance specfication. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character, SmallFloat64) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap, WideString) 12-15 = 16-bit indexable 16-23 = 8-bit indexable (ByteString) 24-31 = compiled methods (CompiledMethod)" | instSpec | instSpec := isWeak ifTrue: [isVar ifTrue: [4] ifFalse: [5]] ifFalse: [isPointers ifTrue: [isVar ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]] ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]] ifFalse: [isVar ifTrue: [bitsUnitSize caseOf: { [1] -> [16]. [2] -> [12]. [4] -> [10]. [8] -> [9] }] ifFalse: [7]]]. ^(instSpec bitShift: 16) + nInstVars! Item was changed: ----- Method: ClassBuilder>>format:variable:words:pointers:weak: (in category 'class format') ----- format: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak "Compute the format for the given instance specfication. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = reserved for 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" | instSpec | instSpec := isWeak ifTrue: [isVar ifTrue: [4] ifFalse: [5]] ifFalse: [isPointers ifTrue: [isVar ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]] ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]] ifFalse: [isVar ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]] ifFalse: [7]]]. ^(instSpec bitShift: 16) + nInstVars! Item was changed: ----- Method: Context>>activateMethod:withArgs:receiver:class: (in category 'controlling') ----- activateMethod: newMethod withArgs: args receiver: rcvr class: class + "Answer a Context initialized with the arguments." - "Answer a ContextPart initialized with the arguments." ^Context sender: self receiver: rcvr method: newMethod arguments: args! Item was changed: ----- Method: Context>>isMethodContext (in category 'testing') ----- isMethodContext + ^closureOrNil == nil! - ^ true! Item was changed: ----- Method: Context>>pushArgs:from: (in category 'system simulation') ----- + pushArgs: args "<Array>" from: sendr "<Context>" - 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 changed: ----- Method: Context>>receiver (in category 'accessing') ----- + receiver + "Answer the receiver of the message that created this context." - receiver - "Refer to the comment in ContextPart|receiver." ^receiver! Item was removed: - ----- Method: InstructionStream class>>bootstrapContext (in category 'bootstrap context') ----- - bootstrapContext - "Rename MethodContext to Context." - "InstructionStream bootstrapContext" - thisContext class name = #Context ifTrue: - [self assert: (Smalltalk classNamed: #MethodContext) == thisContext class. - self assert: (Smalltalk classNamed: #Context) == thisContext class. - ^self]. - 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. - Smalltalk at: #MethodContext ifAbsentPut: [Smalltalk classNamed: #Context]. - self assert: (Smalltalk classNamed: #MethodContext) == thisContext class. - self assert: (Smalltalk classNamed: #Context) == thisContext class! Item was changed: ----- Method: InstructionStream class>>instVarNamesAndOffsetsDo: (in category 'compiling') ----- instVarNamesAndOffsetsDo: aBinaryBlock "This is part of the interface between the compiler and a class's instance or field names. We override here to arrange that the compiler will use MaybeContextInstanceVariableNodes + for instances variables of Context or any of its superclasses and subclasses. The - for instances variables of ContextPart or any of its superclasses and subclasses. The convention to make the compiler use the special nodes is to use negative indices" | superInstSize | (self withAllSubclasses noneSatisfy: [:class|class isContextClass]) ifTrue: [^super instVarNamesAndOffsetsDo: aBinaryBlock]. (superInstSize := superclass notNil ifTrue: [superclass instSize] ifFalse: [0]) > 0 ifTrue: [superclass instVarNamesAndOffsetsDo: aBinaryBlock]. 1 to: self instSize - superInstSize do: [:i| aBinaryBlock value: (instanceVariables at: i) value: (i + superInstSize) negated]! Item was removed: - ----- Method: UndefinedObject>>allSuperclassesDo: (in category 'class hierarchy') ----- - allSuperclassesDo: aBlockContext - self shouldBeImplemented!

1 0

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

31 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: 30 March 2017, 4:30:20.121048 pm UUID: 3258fc02-4f0d-4d17-b8e9-1bca86434dc3 Ancestors: Kernel-eem.1077 Commit with MethodContext renamed to Context, and BlockContext and ContextPart gone. All references to methodCOntext and ContextPart have been replaced by references to Context. Scripts have been removed. =============== Diff against Kernel-eem.1077 =============== Item was removed: - (PackageInfo named: 'Kernel') preamble: 'CompiledMethod addCompiledCodeAndCompiledBlock. - [InstructionStream bootstrapContext] valueSupplyingAnswer: #default'! Item was changed: ----- Method: BlockClosure>>asContextWithSender: (in category 'private') ----- asContextWithSender: aContext "Inner private support method for evaluation. Do not use unless you know what you're doing." + ^(Context newForMethod: outerContext method) - ^(MethodContext newForMethod: outerContext method) setSender: aContext receiver: outerContext receiver method: outerContext method closure: self startpc: startpc; privRefresh! 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 := (Context newForMethod: outerContext method) - 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: + [^Context primitiveFailTokenFor: nil]. - [^MethodContext 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 removed: - ContextPart variableSubclass: #BlockContext - instanceVariableNames: 'nargs startpc home' - classVariableNames: '' - poolDictionaries: '' - category: 'Kernel-Methods'! - - !BlockContext commentStamp: '<historical>' prior: 0! - My instances function similarly to instances of MethodContext, but they hold the dynamic state for execution of a block in Smalltalk. They access all temporary variables and the method sender via their home pointer, so that those values are effectively shared. Their indexable part is used to store their independent value stack during execution. - - My instance must hold onto its home in order to work. This can cause circularities if the home is also pointing (via a temp, perhaps) to the instance. In the rare event that this happens (as in SortedCollection sortBlock:) the message fixTemps will replace home with a copy of home, thus defeating the sharing of temps but, nonetheless, eliminating the circularity. - - BlockContexts must only be created using the method newForMethod:. Note that it is impossible to determine the real object size of a BlockContext 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: BlockContext>>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 home return: result! Item was removed: - ----- Method: BlockContext>>activeHome (in category 'accessing') ----- - activeHome - "Search senders for the home context. If the home - context is not found on the sender chain answer nil." - ^self caller findContextSuchThat: [:ctxt | ctxt = home]! Item was removed: - ----- Method: BlockContext>>argumentCount (in category 'accessing') ----- - argumentCount - "Answers the number of arguments needed to evaluate the receiver." - #Valuable. - ^ self numArgs! Item was removed: - ----- Method: BlockContext>>asContext (in category 'scheduling') ----- - asContext - - ^ self! Item was removed: - ----- Method: BlockContext>>assert (in category 'exceptions') ----- - assert - self assert: self! Item was removed: - ----- Method: BlockContext>>bench (in category 'evaluating') ----- - bench - "See how many times I can value in 5 seconds. I'll answer a meaningful description." - - | startTime endTime count | - count := 0. - endTime := Time millisecondClockValue + 5000. - startTime := Time millisecondClockValue. - [ Time millisecondClockValue > endTime ] whileFalse: [ self value. count := count + 1 ]. - endTime := Time millisecondClockValue. - ^count = 1 - ifTrue: [ ((endTime - startTime) // 1000) printString, ' seconds.' ] - ifFalse: - [ ((count * 1000) / (endTime - startTime)) asFloat printString, ' per second.' ]! Item was removed: - ----- Method: BlockContext>>blockReturnTop (in category 'instruction decoding') ----- - blockReturnTop - "Simulate the interpreter's action when a ReturnTopOfStack bytecode is - encountered in the receiver." - - | save dest | - save := home. "Needed because return code will nil it" - dest := self return: self pop from: self. - home := save. - sender := nil. - ^ dest! Item was removed: - ----- Method: BlockContext>>caller (in category 'accessing') ----- - caller - ^sender! Item was removed: - ----- Method: BlockContext>>cannotReturn: (in category 'private') ----- - cannotReturn: result - "The receiver tried to return result to a method context that no longer exists." - - | ex newResult | - ex := BlockCannotReturn new. - ex result: result. - newResult := ex signal. - ^newResult! Item was removed: - ----- Method: BlockContext>>closureHome (in category 'accessing') ----- - closureHome - "Answer the context from which an ^-return should return from." - - ^self home! Item was removed: - ----- Method: BlockContext>>contextForLocalVariables (in category 'accessing') ----- - contextForLocalVariables - "Answer the context in which local variables (temporaries) are stored." - - ^home! Item was removed: - ----- Method: BlockContext>>copyForSaving (in category 'accessing') ----- - copyForSaving - "Fix the values of the temporary variables used in the block that are - ordinarily shared with the method in which the block is defined." - - home := home copy. - home swapSender: nil! Item was removed: - ----- Method: BlockContext>>cull: (in category 'evaluating') ----- - cull: firstArg - "Activate the receiver, with one or zero arguments." - - self numArgs >= 1 ifTrue: [ ^self value: firstArg ]. - ^self value! Item was removed: - ----- Method: BlockContext>>cull:cull: (in category 'evaluating') ----- - cull: firstArg cull: secondArg - "Activate the receiver, with two or less arguments." - - self numArgs >= 2 ifTrue: [ ^self value: firstArg value: secondArg ]. - self numArgs = 1 ifTrue: [ ^self value: firstArg ]. - ^self value! Item was removed: - ----- Method: BlockContext>>cull:cull:cull: (in category 'evaluating') ----- - cull: firstArg cull: secondArg cull: thirdArg - "Activate the receiver, with three or less arguments." - - self numArgs >= 2 ifTrue: [ - self numArgs >= 3 ifTrue: [ ^self value: firstArg value: secondArg value: thirdArg ]. - ^self value: firstArg value: secondArg ]. - self numArgs = 1 ifTrue: [ ^self value: firstArg ]. - ^self value! Item was removed: - ----- Method: BlockContext>>cull:cull:cull:cull: (in category 'evaluating') ----- - cull: firstArg cull: secondArg cull: thirdArg cull: fourthArg - "Activate the receiver, with four or less arguments." - - self numArgs >= 3 ifTrue: [ - self numArgs >= 4 ifTrue: [ - ^self value: firstArg value: secondArg value: thirdArg value: fourthArg ]. - ^self value: firstArg value: secondArg value: thirdArg ]. - self numArgs = 2 ifTrue: [ ^self value: firstArg value: secondArg ]. - self numArgs = 1 ifTrue: [ ^self value: firstArg ]. - ^self value! Item was removed: - ----- Method: BlockContext>>decompile (in category 'printing') ----- - decompile - ^ home method decompilerClass new decompileBlock: self! Item was removed: - ----- Method: BlockContext>>decompileString (in category 'printing') ----- - decompileString - ^self decompile decompileString.! Item was removed: - ----- Method: BlockContext>>doWhileFalse: (in category 'controlling') ----- - doWhileFalse: conditionBlock - "Evaluate the receiver once, then again as long the value of conditionBlock is false." - - | result | - [result := self value. - conditionBlock value] whileFalse. - - ^ result! Item was removed: - ----- Method: BlockContext>>doWhileTrue: (in category 'controlling') ----- - doWhileTrue: conditionBlock - "Evaluate the receiver once, then again as long the value of conditionBlock is true." - - | result | - [result := self value. - conditionBlock value] whileTrue. - - ^ result! Item was removed: - ----- Method: BlockContext>>durationToRun (in category 'evaluating') ----- - durationToRun - "Answer the duration taken to execute this block." - - ^ Duration milliSeconds: self timeToRun - - ! Item was removed: - ----- Method: BlockContext>>endPC (in category 'private') ----- - endPC - "Determine end of block from long jump preceding it" - ^(self method at: startpc - 2) - \\ 16 - 4 * 256 - + (self method at: startpc - 1) + startpc - 1.! Item was removed: - ----- Method: BlockContext>>ensure: (in category 'exceptions') ----- - ensure: aBlock - "Evaluate a termination block after evaluating the receiver, regardless of - whether the receiver's evaluation completes. N.B. This method is *not* - implemented as a primitive. Primitive 198 always fails. The VM uses prim - 198 in a context's method as the mark for an ensure:/ifCurtailed: activation." - - | complete returnValue | - <primitive: 198> - returnValue := self value. - complete ifNil:[ - complete := true. - aBlock value. - ]. - ^ returnValue! Item was removed: - ----- Method: BlockContext>>fixTemps (in category 'accessing') ----- - fixTemps - "Fix the values of the temporary variables used in the block that are - ordinarily shared with the method in which the block is defined." - - home := home copy. - home swapSender: nil! Item was removed: - ----- Method: BlockContext>>fork (in category 'scheduling') ----- - fork - "Create and schedule a Process running the code in the receiver." - - ^ self newProcess resume! Item was removed: - ----- Method: BlockContext>>forkAndWait (in category 'scheduling') ----- - forkAndWait - "Suspend current process and execute self in new process, when it completes resume current process" - - | semaphore | - semaphore := Semaphore new. - [self ensure: [semaphore signal]] fork. - semaphore wait. - ! Item was removed: - ----- Method: BlockContext>>forkAt: (in category 'scheduling') ----- - forkAt: priority - "Create and schedule a Process running the code in the receiver at the given priority. Answer the newly created process." - - | forkedProcess | - forkedProcess := self newProcess. - forkedProcess priority: priority. - ^ forkedProcess resume - ! Item was removed: - ----- Method: BlockContext>>forkAt:named: (in category 'scheduling') ----- - forkAt: priority named: name - "Create and schedule a Process running the code in the receiver at the - given priority and having the given name. Answer the newly created - process." - - | forkedProcess | - forkedProcess := self newProcess. - forkedProcess priority: priority. - forkedProcess name: name. - ^ forkedProcess resume! Item was removed: - ----- Method: BlockContext>>forkNamed: (in category 'scheduling') ----- - forkNamed: aString - "Create and schedule a Process running the code in the receiver and - having the given name." - - ^ self newProcess name: aString; resume! Item was removed: - ----- Method: BlockContext>>fullPrintOn: (in category 'printing') ----- - fullPrintOn: aStream - aStream print: self; cr. - (self decompile ifNil: ['--source missing--']) printOn: aStream indent: 0! Item was removed: - ----- Method: BlockContext>>hasInstVarRef (in category 'accessing') ----- - hasInstVarRef - "Answer whether the receiver references an instance variable." - - | method scanner end printer | - - home ifNil: [^false]. - method := self method. - end := self endPC. - scanner := InstructionStream new method: method pc: startpc. - printer := InstVarRefLocator new. - - [scanner pc <= end] whileTrue: [ - (printer interpretNextInstructionUsing: scanner) ifTrue: [^true]. - ]. - ^false! Item was removed: - ----- Method: BlockContext>>hasMethodReturn (in category 'accessing') ----- - hasMethodReturn - "Answer whether the receiver has a return ('^') in its code." - - | method scanner end | - method := self method. - "Determine end of block from long jump preceding it" - end := (method at: startpc-2)\\16-4*256 + (method at: startpc-1) + startpc - 1. - scanner := InstructionStream new method: method pc: startpc. - scanner scanFor: [:byte | (byte between: 120 and: 124) or: [scanner pc > end]]. - ^scanner pc <= end! Item was removed: - ----- Method: BlockContext>>home (in category 'accessing') ----- - home - "Answer the context in which the receiver was defined." - - ^home! Item was removed: - ----- Method: BlockContext>>home:startpc:nargs: (in category 'initialize-release') ----- - home: aContextPart startpc: position nargs: anInteger - "This is the initialization message. The receiver has been initialized with - the correct size only." - - home := aContextPart. - pc := startpc := position. - nargs := anInteger. - stackp := 0.! Item was removed: - ----- Method: BlockContext>>ifCurtailed: (in category 'exceptions') ----- - ifCurtailed: aBlock - "Evaluate the receiver with an abnormal termination action. - Evaluate aBlock only if execution is unwound during execution - of the receiver. If execution of the receiver finishes normally do - not evaluate aBlock. N.B. This method is *not* implemented as a - primitive. Primitive 198 always fails. The VM uses prim 198 in a - context's method as the mark for an ensure:/ifCurtailed: activation." - | complete result | - <primitive: 198> - result := self value. - complete := true. - ^result! Item was removed: - ----- Method: BlockContext>>ifError: (in category 'evaluating') ----- - ifError: errorHandlerBlock - "Evaluate the block represented by the receiver, and normally return it's value. If an error occurs, the errorHandlerBlock is evaluated, and it's value is instead returned. The errorHandlerBlock must accept zero, one, or two parameters (the error message and the receiver)." - "Examples: - [1 whatsUpDoc] ifError: [:err :rcvr | 'huh?']. - [1 / 0] ifError: [:err :rcvr | - 'ZeroDivide' = err - ifTrue: [Float infinity] - ifFalse: [self error: err]] - " - - ^ self on: Error do: [:ex | - errorHandlerBlock cull: ex description cull: ex receiver]! Item was removed: - ----- Method: BlockContext>>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: BlockContext>>isBlock (in category 'accessing') ----- - isBlock - - ^ true! Item was removed: - ----- Method: BlockContext>>isExecutingBlock (in category 'accessing') ----- - isExecutingBlock - - ^ true! Item was removed: - ----- Method: BlockContext>>method (in category 'accessing') ----- - method - "Answer the compiled method in which the receiver was defined." - - ^home method! Item was removed: - ----- Method: BlockContext>>methodReturnContext (in category 'accessing') ----- - methodReturnContext - "Answer the context from which an ^-return should return from." - - ^home! Item was removed: - ----- Method: BlockContext>>myEnv (in category 'private') ----- - myEnv - "polymorphic with MethodContext" - - ^ nil! Item was removed: - ----- Method: BlockContext>>newProcess (in category 'scheduling') ----- - newProcess - "Answer a Process running the code in the receiver. The process is not - scheduled." - <primitive: 19> "Simulation guard" - ^Process - forContext: - [self value. - Processor terminateActive] asContext - priority: Processor activePriority! Item was removed: - ----- Method: BlockContext>>newProcessWith: (in category 'scheduling') ----- - newProcessWith: anArray - "Answer a Process running the code in the receiver. The receiver's block - arguments are bound to the contents of the argument, anArray. The - process is not scheduled." - <primitive: 19> "Simulation guard" - ^Process - forContext: - [self valueWithArguments: anArray. - Processor terminateActive] asContext - priority: Processor activePriority! Item was removed: - ----- Method: BlockContext>>numArgs (in category 'accessing') ----- - numArgs - "Answer the number of arguments that must be used to evaluate this block" - - ^nargs! Item was removed: - ----- Method: BlockContext>>on:do: (in category 'exceptions') ----- - on: exceptionOrExceptionSet do: handlerAction - "Evaluate the receiver in the scope of an exception handler." - | handlerActive | - <primitive: 199> - handlerActive := true. - ^self value! Item was removed: - ----- Method: BlockContext>>on:do:on:do: (in category 'exceptions') ----- - on: exception1 do: block1 on: exception2 do: block2 - - ^[ - self - on: exception1 - do: block1 ] - on: exception2 - do: block2! Item was removed: - ----- Method: BlockContext>>on:do:on:do:on:do: (in category 'exceptions') ----- - on: exception1 do: block1 on: exception2 do: block2 on: exception3 do: block3 - - ^[ - self - on: exception1 - do: block1 ] - on: exception2 - do: block2 - on: exception3 - do: block3! Item was removed: - ----- Method: BlockContext>>onDNU:do: (in category 'exceptions') ----- - onDNU: selector do: handleBlock - "Catch MessageNotUnderstood exceptions but only those of the given selector (DNU stands for doesNotUnderstand:)" - - ^ self on: MessageNotUnderstood do: [:exception | - exception message selector = selector - ifTrue: [handleBlock valueWithPossibleArgs: {exception}] - ifFalse: [exception pass] - ]! Item was removed: - ----- Method: BlockContext>>printOn: (in category 'printing') ----- - printOn: aStream - | decompilation blockString truncatedBlockString | - - home == nil ifTrue: [^aStream nextPutAll: 'a BlockContext with home=nil']. - aStream nextPutAll: '[] in '. - super printOn: aStream. - decompilation := [self decompile ifNil: ['--source missing--']] - on: Error - do: [:ex| ' (error in decompilation)']. - blockString := ((decompilation isString - ifTrue: [decompilation] - ifFalse: [decompilation printString]) - replaceAll: Character cr with: Character space) - replaceAll: Character tab with: Character space. - truncatedBlockString := blockString truncateWithElipsisTo: 80. - truncatedBlockString size < blockString size ifTrue: - [truncatedBlockString := truncatedBlockString, ']}']. - aStream space; nextPutAll: truncatedBlockString! Item was removed: - ----- Method: BlockContext>>privHome: (in category 'private') ----- - privHome: context - - home := context! Item was removed: - ----- Method: BlockContext>>privRefresh (in category 'initialize-release') ----- - privRefresh - "Reinitialize the receiver so that it is in the state it was at its creation." - - pc := startpc. - self stackp: 0. - nargs timesRepeat: [ "skip arg popping" - self nextInstruction selector = #popIntoTemporaryVariable: - ifFalse: [self halt: 'unexpected bytecode instruction'] - ]. - ! Item was removed: - ----- Method: BlockContext>>pushArgs:from: (in category 'system simulation') ----- - pushArgs: args from: sendr - "Simulates action of the value primitive." - - args size ~= nargs ifTrue: [^self error: 'incorrect number of args']. - self stackp: 0. - args do: [:arg | self push: arg]. - sender := sendr. - pc := startpc! Item was removed: - ----- Method: BlockContext>>receiver (in category 'accessing') ----- - receiver - "Refer to the comment in ContextPart|receiver." - - ^home receiver! Item was removed: - ----- Method: BlockContext>>reentrant (in category 'accessing') ----- - reentrant - "Copy before calling so multiple activations can exist" - - ^ self copy! Item was removed: - ----- Method: BlockContext>>repeat (in category 'controlling') ----- - repeat - "Evaluate the receiver repeatedly, ending only if the block explicitly returns." - - [self value. true] whileTrue! Item was removed: - ----- Method: BlockContext>>repeatWithGCIf: (in category 'controlling') ----- - repeatWithGCIf: testBlock - | ans | - "run the receiver, and if testBlock returns true, garbage collect and run the receiver again" - ans := self value. - (testBlock value: ans) ifTrue: [ Smalltalk garbageCollect. ans := self value ]. - ^ans! Item was removed: - ----- Method: BlockContext>>startpc (in category 'private') ----- - startpc - "for use by the System Tracer only" - - ^startpc! Item was removed: - ----- Method: BlockContext>>stepToSendOrReturn (in category 'system simulation') ----- - stepToSendOrReturn - pc = startpc ifTrue: [ - "pop args first" - self numArgs timesRepeat: [self step]]. - ^super stepToSendOrReturn! Item was removed: - ----- Method: BlockContext>>tempAt: (in category 'accessing') ----- - tempAt: index - "Refer to the comment in ContextPart|tempAt:." - - ^home at: index! Item was removed: - ----- Method: BlockContext>>tempAt:put: (in category 'accessing') ----- - tempAt: index put: value - "Refer to the comment in ContextPart|tempAt:put:." - - ^home at: index put: value! Item was removed: - ----- Method: BlockContext>>timeToRun (in category 'evaluating') ----- - timeToRun - "Answer the number of milliseconds taken to execute this block." - - ^ Time millisecondsToRun: self - ! Item was removed: - ----- Method: BlockContext>>value (in category 'evaluating') ----- - value - "Primitive. Evaluate the block represented by the receiver. Fail if the - block expects any arguments or if the block is already being executed. - Optional. No Lookup. See Object documentation whatIsAPrimitive." - - <primitive: 81> - ^self valueWithArguments: #()! Item was removed: - ----- Method: BlockContext>>value: (in category 'evaluating') ----- - value: arg - "Primitive. Evaluate the block represented by the receiver. Fail if the - block expects other than one argument or if the block is already being - executed. Optional. No Lookup. See Object documentation - whatIsAPrimitive." - - <primitive: 81> - ^self valueWithArguments: (Array with: arg)! Item was removed: - ----- Method: BlockContext>>value:value: (in category 'evaluating') ----- - value: arg1 value: arg2 - "Primitive. Evaluate the block represented by the receiver. Fail if the - block expects other than two arguments or if the block is already being - executed. Optional. See Object documentation whatIsAPrimitive." - - <primitive: 81> - ^self valueWithArguments: (Array with: arg1 with: arg2)! Item was removed: - ----- Method: BlockContext>>value:value:value: (in category 'evaluating') ----- - value: arg1 value: arg2 value: arg3 - "Primitive. Evaluate the block represented by the receiver. Fail if the - block expects other than three arguments or if the block is already being - executed. Optional. See Object documentation whatIsAPrimitive." - - <primitive: 81> - ^self valueWithArguments: - (Array - with: arg1 - with: arg2 - with: arg3)! Item was removed: - ----- Method: BlockContext>>value:value:value:value: (in category 'evaluating') ----- - value: arg1 value: arg2 value: arg3 value: arg4 - "Primitive. Evaluate the block represented by the receiver. Fail if the - block expects other than three arguments or if the block is already being - executed. Optional. See Object documentation whatIsAPrimitive." - - <primitive: 81> - ^self valueWithArguments: - (Array - with: arg1 - with: arg2 - with: arg3 - with: arg4)! Item was removed: - ----- Method: BlockContext>>valueAt: (in category 'scheduling') ----- - valueAt: blockPriority - "Evaluate the receiver (block), with another priority as the actual one - and restore it afterwards. The caller should be careful with using - higher priorities." - | activeProcess result outsidePriority | - activeProcess := Processor activeProcess. - outsidePriority := activeProcess priority. - activeProcess priority: blockPriority. - result := self - ensure: [activeProcess priority: outsidePriority]. - "Yield after restoring lower priority to give the preempted processes a - chance to run." - blockPriority > outsidePriority - ifTrue: [Processor yield]. - ^ result! Item was removed: - ----- Method: BlockContext>>valueError (in category 'private') ----- - valueError - - self error: 'Incompatible number of args, or already active'! Item was removed: - ----- Method: BlockContext>>valueSupplyingAnswer: (in category 'evaluating') ----- - valueSupplyingAnswer: anObject - - ^ (anObject isCollection and: [anObject isString not]) - ifTrue: [self valueSupplyingAnswers: {anObject}] - ifFalse: [self valueSupplyingAnswers: {{'*'. anObject}}]! Item was removed: - ----- Method: BlockContext>>valueSupplyingAnswers: (in category 'evaluating') ----- - valueSupplyingAnswers: aListOfPairs - "evaluate the block using a list of questions / answers that might be called upon to - automatically respond to Object>>confirm: or FillInTheBlank requests" - - ^self - on: ProvideAnswerNotification - do: - [:notify | | answer caption | - - caption := notify messageText withSeparatorsCompacted. "to remove new lines" - answer := aListOfPairs - detect: - [:each | caption = each first - or: [(caption includesSubstring: each first caseSensitive: false) - or: [each first match: caption]]] - ifNone: [nil]. - answer - ifNotNil: [notify resume: answer second] - ifNil: - [ | outerAnswer | - outerAnswer := ProvideAnswerNotification signal: notify messageText. - outerAnswer - ifNil: [notify resume] - ifNotNil: [notify resume: outerAnswer]]]! Item was removed: - ----- Method: BlockContext>>valueSuppressingAllMessages (in category 'evaluating') ----- - valueSuppressingAllMessages - - ^ self valueSuppressingMessages: #('*')! Item was removed: - ----- Method: BlockContext>>valueSuppressingMessages: (in category 'evaluating') ----- - valueSuppressingMessages: aListOfStrings - - ^ self - valueSuppressingMessages: aListOfStrings - supplyingAnswers: #()! Item was removed: - ----- Method: BlockContext>>valueSuppressingMessages:supplyingAnswers: (in category 'evaluating') ----- - valueSuppressingMessages: aListOfStrings supplyingAnswers: aListOfPairs - - ^ self valueSupplyingAnswers: aListOfPairs, (aListOfStrings collect: [:each | {each. true}])! Item was removed: - ----- Method: BlockContext>>valueUninterruptably (in category 'exceptions') ----- - valueUninterruptably - "Temporarily make my home Context unable to return control to its sender, to guard against circumlocution of the ensured behavior." - - ^ self ifCurtailed: [^ self]! Item was removed: - ----- Method: BlockContext>>valueUnpreemptively (in category 'private') ----- - valueUnpreemptively - "Evaluate the receiver (block), without the possibility of preemption by higher priority processes. Use this facility VERY sparingly!!" - "Think about using Block>>valueUninterruptably first, and think about using Semaphore>>critical: before that, and think about redesigning your application even before that!! - After you've done all that thinking, go right ahead and use it..." - | activeProcess oldPriority result | - activeProcess := Processor activeProcess. - oldPriority := activeProcess priority. - activeProcess priority: Processor highestPriority. - result := self ensure: [activeProcess priority: oldPriority]. - "Yield after restoring priority to give the preempted processes a chance to run" - Processor yield. - ^result! Item was removed: - ----- Method: BlockContext>>valueWithArguments: (in category 'evaluating') ----- - valueWithArguments: anArray - "Primitive. Evaluate the block represented by the receiver. The argument - is an Array whose elements are the arguments for the block. Fail if the - length of the Array is not the same as the the number of arguments that - the block was expecting. Fail if the block is already being executed. - Essential. See Object documentation whatIsAPrimitive." - - <primitive: 82> - - anArray isArray ifFalse: [^self error: 'valueWithArguments: expects an array']. - self numArgs = anArray size - ifTrue: [self error: 'Attempt to evaluate a block that is already being evaluated.'] - ifFalse: [self error: - 'This block accepts ' ,self numArgs printString, ' argument', (self numArgs = 1 ifTrue:[''] ifFalse:['s']) , - ', but was called with ', anArray size printString, '.'] - - ! Item was removed: - ----- Method: BlockContext>>valueWithEnoughArguments: (in category 'evaluating') ----- - valueWithEnoughArguments: anArray - "call me with enough arguments from anArray" - | args | - (anArray size == self numArgs) - ifTrue: [ ^self valueWithArguments: anArray ]. - - args := Array new: self numArgs. - args replaceFrom: 1 - to: (anArray size min: args size) - with: anArray - startingAt: 1. - - ^ self valueWithArguments: args! Item was removed: - ----- Method: BlockContext>>valueWithExit (in category 'evaluating') ----- - valueWithExit - self value: [ ^nil ]! Item was removed: - ----- Method: BlockContext>>valueWithPossibleArgs: (in category 'evaluating') ----- - valueWithPossibleArgs: anArray - - "Evaluate the block represented by the receiver. - If the block requires arguments, take them from anArray. If anArray is too - large, the rest is ignored, if it is too small, use nil for the other arguments" - - self numArgs = 0 ifTrue: [^self value]. - self numArgs = anArray size ifTrue: [^self valueWithArguments: anArray]. - self numArgs > anArray size ifTrue: [ - ^self valueWithArguments: anArray, - (Array new: (self numArgs - anArray size)) - ]. - ^self valueWithArguments: (anArray copyFrom: 1 to: self numArgs) - - ! Item was removed: - ----- Method: BlockContext>>valueWithPossibleArgument: (in category 'evaluating') ----- - valueWithPossibleArgument: anArg - - "Evaluate the block represented by the receiver. - If the block requires one argument, use anArg, if it requires more than one, - fill up the rest with nils." - - self numArgs = 0 ifTrue: [^self value]. - self numArgs = 1 ifTrue: [^self value: anArg]. - self numArgs > 1 ifTrue: [^self valueWithArguments: {anArg}, (Array new: self numArgs - 1)]! Item was removed: - ----- Method: BlockContext>>valueWithin:onTimeout: (in category 'evaluating') ----- - valueWithin: aDuration onTimeout: timeoutBlock - "Evaluate the receiver. - If the evaluation does not complete in less than aDuration evaluate the timeoutBlock instead" - - | theProcess delay watchdog tag | - - aDuration <= Duration zero ifTrue: [^ timeoutBlock value ]. - - "the block will be executed in the current process" - theProcess := Processor activeProcess. - delay := aDuration asDelay. - tag := self. - - "make a watchdog process" - watchdog := [ - delay wait. "wait for timeout or completion" - theProcess ifNotNil:[ theProcess signalException: (TimedOut new tag: tag)] - ] newProcess. - - "Watchdog needs to run at high priority to do its job (but not at timing priority)" - watchdog priority: Processor timingPriority-1. - - "catch the timeout signal" - ^ [ watchdog resume. "start up the watchdog" - self ensure:[ "evaluate the receiver" - theProcess := nil. "it has completed, so ..." - delay delaySemaphore signal. "arrange for the watchdog to exit" - ]] on: TimedOut do: [ :e | - e tag == tag - ifTrue:[ timeoutBlock value ] - ifFalse:[ e pass]].! Item was removed: - ----- Method: BlockContext>>whileFalse (in category 'controlling') ----- - whileFalse - "Ordinarily compiled in-line, and therefore not overridable. - This is in case the message is sent to other than a literal block. - Evaluate the receiver, as long as its value is false." - - ^ [self value] whileFalse: []! Item was removed: - ----- Method: BlockContext>>whileFalse: (in category 'controlling') ----- - whileFalse: aBlock - "Ordinarily compiled in-line, and therefore not overridable. - This is in case the message is sent to other than a literal block. - Evaluate the argument, aBlock, as long as the value of the receiver is false." - - ^ [self value] whileFalse: [aBlock value]! Item was removed: - ----- Method: BlockContext>>whileTrue (in category 'controlling') ----- - whileTrue - "Ordinarily compiled in-line, and therefore not overridable. - This is in case the message is sent to other than a literal block. - Evaluate the receiver, as long as its value is true." - - ^ [self value] whileTrue: []! Item was removed: - ----- Method: BlockContext>>whileTrue: (in category 'controlling') ----- - whileTrue: aBlock - "Ordinarily compiled in-line, and therefore not overridable. - This is in case the message is sent to other than a literal block. - Evaluate the argument, aBlock, as long as the value of the receiver is true." - - ^ [self value] whileTrue: [aBlock value]! 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" + InstructionStream Context BlockClosure - InstructionStream ContextPart BlockContext MethodContext BlockClosure "Superclasses of basic collections" Collection SequenceableCollection ArrayedCollection "Collections known to the VM" + Array Bitmap String Symbol ByteArray CompiledCode CompiledMethod CompiledBlock + "Basic Numbers & Magnitudes" + Magnitude Number SmallInteger Float BoxedFloat64 SmallFloat64 Character - Array Bitmap String Symbol ByteArray CompiledMethod - "Basic Numbers" - Magnitude Number SmallInteger Float "Misc other" LookupKey Association Link Point Rectangle Behavior PositionableStream UndefinedObject ) ! Item was changed: ----- Method: ClosureExtractor>>scanner: (in category 'accessing') ----- scanner: anInstructionStream scanner := anInstructionStream. + currentContext := Context - currentContext := MethodContext sender: nil receiver: nil method: scanner method arguments: (Array new: scanner method numArgs)! 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." + + ^Context + 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" + + ^Context + sender: self + receiver: aContext + method: Context 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>>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: + [^self class primitiveFailTokenFor: #'bad argument']. + (arguments at: 2) numArgs = (arguments at: 1) size ifFalse: + [^self class 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)]. + ^Context + 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: + [^self class 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 := Context 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: + [^self class 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: - InstructionStream subclass: #ContextPart - instanceVariableNames: 'stackp' - classVariableNames: 'MaxLengthForASingleDebugLogReport MaxStackDepthForASingleDebugLogReport PrimitiveFailToken QuickStep ValueIndex' - poolDictionaries: '' - category: 'Kernel-Methods'! - - !ContextPart commentStamp: '<historical>' prior: 0! - To the instruction parsing ability of InstructionStream I add the actual semantics for execution. The execution state is stored in the indexable fields of my subclasses. This includes temporary variables and a stack of values used in evaluating expressions. The actual semantics of execution can be found in my category "system simulation" and "instruction decode". These methods exactly parallel the operation of the Smalltalk machine itself. - - The simulator is a group of my methods that do what the Smalltalk interpreter does: execute Smalltalk bytecodes. By adding code to the simulator, you may take statistics on the running of Smalltalk methods. For example, - Transcript show: (ContextPart runSimulated: [3 factorial]) printString.! Item was removed: - ----- Method: ContextPart 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: ContextPart 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: ContextPart 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: ContextPart 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: ContextPart 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: ContextPart class>>initializedInstance (in category 'instance creation') ----- - initializedInstance - ^ nil! Item was removed: - ----- Method: ContextPart class>>isContextClass (in category 'private') ----- - isContextClass - ^true! Item was removed: - ----- Method: ContextPart 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: ContextPart class>>maxLengthForASingleDebugLogReport: (in category 'preferences') ----- - maxLengthForASingleDebugLogReport: anInteger - MaxLengthForASingleDebugLogReport := anInteger! Item was removed: - ----- Method: ContextPart 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: ContextPart class>>maxStackDepthForASingleDebugLogReport: (in category 'preferences') ----- - maxStackDepthForASingleDebugLogReport: anInteger - MaxStackDepthForASingleDebugLogReport := anInteger! Item was removed: - ----- Method: ContextPart class>>new (in category 'instance creation') ----- - new - - self error: 'Contexts must only be created with newForMethod:'! Item was removed: - ----- Method: ContextPart class>>new: (in category 'instance creation') ----- - new: size - - self error: 'Contexts must only be created with newForMethod:'! Item was removed: - ----- Method: ContextPart 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: ContextPart class>>primitiveFailToken (in category 'simulation') ----- - primitiveFailToken - - ^ PrimitiveFailToken! Item was removed: - ----- Method: ContextPart class>>primitiveFailTokenFor: (in category 'simulation') ----- - primitiveFailTokenFor: errorCode - - ^{PrimitiveFailToken. errorCode}! Item was removed: - ----- Method: ContextPart 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] - - "ContextPart runSimulated: [Pen new defaultNib: 5; go: 100]"! Item was removed: - ----- Method: ContextPart 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 - - "ContextPart tallyInstructions: [3.14159 printString]"! Item was removed: - ----- Method: ContextPart 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 - - "ContextPart tallyMethods: [3.14159 printString]"! Item was removed: - ----- Method: ContextPart 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: ContextPart class>>trace: (in category 'examples') ----- - trace: aBlock "ContextPart 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: ContextPart class>>trace:on: (in category 'examples') ----- - trace: aBlock on: aStream "ContextPart 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: ContextPart class>>trace:onFileNamed: (in category 'examples') ----- - trace: aBlock onFileNamed: fileName - "ContextPart 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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>contextForLocalVariables (in category 'accessing') ----- - contextForLocalVariables - "Answer the context in which local variables (temporaries) are stored." - - self subclassResponsibility! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>copyStack (in category 'query') ----- - copyStack - - ^ self copyTo: nil! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>doDup (in category 'instruction decoding') ----- - doDup - "Simulate the action of a 'duplicate top of stack' bytecode." - - self push: self top! Item was removed: - ----- Method: ContextPart>>doPop (in category 'instruction decoding') ----- - doPop - "Simulate the action of a 'remove top of stack' bytecode." - - self pop! Item was removed: - ----- Method: ContextPart>>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: - [^ContextPart primitiveFailTokenFor: #'bad argument']. - (arguments at: 2) numArgs = (arguments at: 1) size ifFalse: - [^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: - [^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 removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>home (in category 'accessing') ----- - home - "Answer the context in which the receiver was defined." - - self subclassResponsibility! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>isClosureContext (in category 'query') ----- - isClosureContext - - ^ false! Item was removed: - ----- Method: ContextPart>>isContext (in category 'query') ----- - isContext - ^true! Item was removed: - ----- Method: ContextPart>>isDead (in category 'query') ----- - isDead - "Has self finished" - - ^ pc isNil! Item was removed: - ----- Method: ContextPart>>isHandlerContext (in category 'private-exceptions') ----- - isHandlerContext - ^false! Item was removed: - ----- Method: ContextPart>>isPrimFailToken: (in category 'private') ----- - isPrimFailToken: anObject - ^(self objectClass: anObject) == Array - and: [anObject size = 2 - and: [anObject first == PrimitiveFailToken]]! Item was removed: - ----- Method: ContextPart>>isUnwindContext (in category 'private-exceptions') ----- - isUnwindContext - - ^false! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>method (in category 'accessing') ----- - method - "Answer the method of this context." - - self subclassResponsibility! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>methodNode (in category 'accessing') ----- - methodNode - ^ self method methodNode.! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>methodReturnContext (in category 'accessing') ----- - methodReturnContext - "Answer the context from which an ^-return should return from." - - self subclassResponsibility! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>nextHandlerContext (in category 'private-exceptions') ----- - nextHandlerContext - - ^ self sender findNextHandlerContextStarting! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>pc (in category 'debugger access') ----- - pc - "Answer the index of the next bytecode to be executed." - - ^pc! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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 contextForLocalVariables at: offset + 1 put: self pop! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>printDetails: (in category 'printing') ----- - printDetails: strm - "Put my class>>selector and arguments and temporaries on the stream. Protect against errors during printing." - - | str | - self printOn: strm. - - strm cr; tab; nextPutAll: 'Arguments and temporary variables: '; cr. - str := [self tempsAndValuesLimitedTo: 160 indent: 2] ifError: [:err :rcvr | - '<<error during printing>>']. - strm nextPutAll: str. - strm peekLast == Character cr ifFalse: [strm cr].! Item was removed: - ----- Method: ContextPart>>printOn: (in category 'printing') ----- - printOn: aStream - | method selector class mclass | - (method := self method) ifNil: [^super 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 closure isNil - and: [(self objectClass: (self tempAt: 1)) == Message]]) ifTrue: - [aStream space. - (self tempAt: 1) selector printOn: aStream]! Item was removed: - ----- Method: ContextPart>>privSender: (in category 'private') ----- - privSender: aContext - - sender := aContext! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>pushNewArrayOfSize: (in category 'instruction decoding') ----- - pushNewArrayOfSize: arraySize - self push: (Array new: arraySize)! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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 contextForLocalVariables at: offset + 1)! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>receiver (in category 'accessing') ----- - receiver - "Answer the receiver of the message that created this context." - - self subclassResponsibility! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>return (in category 'controlling') ----- - return - "Unwind until my sender is on top" - - self return: self receiver! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: - [^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 removed: - ----- Method: ContextPart>>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: ContextPart>>sender (in category 'debugger access') ----- - sender - "Answer the context that sent the message that created the receiver." - - ^sender! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>stackPtr (in category 'private') ----- - stackPtr "For use only by the SystemTracer and the Debugger, Inspectors etc" - ^ stackp! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>stepToCallee (in category 'system simulation') ----- - stepToCallee - "Step to callee or sender" - - | ctxt | - ctxt := self. - [(ctxt := ctxt step) == self] whileTrue. - ^ ctxt! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>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 contextForLocalVariables at: offset + 1 put: self top! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>tempAt: (in category 'accessing') ----- - tempAt: index - "Answer the value of the temporary variable whose index is the - argument, index." - - self subclassResponsibility! Item was removed: - ----- Method: ContextPart>>tempAt:put: (in category 'accessing') ----- - tempAt: index put: value - "Store the argument, value, as the temporary variable whose index is the - argument, index." - - self subclassResponsibility! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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: ContextPart>>terminate (in category 'controlling') ----- - terminate - "Make myself unresumable." - - sender := nil. - pc := nil. - ! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>top (in category 'controlling') ----- - top - "Answer the top of the receiver's stack." - - ^self at: stackp! Item was removed: - ----- Method: ContextPart>>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: ContextPart>>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: ContextPart>>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 changed: ----- Method: InstructionPrinter>>send:super:numArgs: (in category 'instruction decoding') ----- send: selector super: supered numArgs: numArgs "Print the Send Message With Selector, selector, bytecode. The argument, supered, indicates whether the receiver of the message is specified with 'super' in the source method. The arguments of the message are found in the top numArguments locations on the stack and the receiver just below them." self print: (supered ifTrue: ['superSend: '] ifFalse: ['send: ']) + , (self stringForSelector: selector numArgs: numArgs)! - , (self stringForSelector: selector numArgs: numArgs). - indentSpanOfFollowingJump := #(blockCopy: #closureCopy:copiedValues:) includes: selector! 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>>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] - ]. - ! 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> + ^Context primitiveFailTokenFor: nil! - ^MethodContext primitiveFailTokenFor: 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> + ^Context primitiveFailTokenFor: nil! - ^MethodContext primitiveFailTokenFor: nil! Item was changed: ----- Method: Process>>restartTopWith: (in category 'changing suspended state') ----- restartTopWith: method "Rollback top context and replace with new method. Assumes self is suspended" method isQuick ifTrue: [self popTo: suspendedContext sender] ifFalse: [suspendedContext method frameSize >= method frameSize ifTrue: [suspendedContext privRefreshWith: method] ifFalse: [self assert: suspendedContext isExecutingBlock not. + suspendedContext := Context - suspendedContext := MethodContext sender: suspendedContext sender receiver: suspendedContext receiver method: method arguments: ((1 to: method numArgs) collect: [:i| suspendedContext tempAt: i])]]. ! Item was changed: ----- Method: Process>>signalException: (in category 'signaling') ----- signalException: anException "Signal an exception in the receiver process...if the receiver is currently suspended, the exception will get signaled when the receiver is resumed. If the receiver is blocked on a Semaphore, it will be immediately re-awakened and the exception will be signaled; if the exception is resumed, then the receiver will return to a blocked state unless the blocking Semaphore has excess signals" | oldList | "If we are the active process, go ahead and signal the exception" self isActiveProcess ifTrue: [^anException signal]. "Suspend myself first to ensure that I won't run away in the midst of the following modifications." myList ifNotNil:[oldList := self suspend]. "Add a new method context to the stack that will signal the exception" + suspendedContext := Context - suspendedContext := MethodContext sender: suspendedContext receiver: self method: (self class lookupSelector: #pvtSignal:list:) arguments: (Array with: anException with: oldList). "If we are on a list to run, then suspend and restart the receiver (this lets the receiver run if it is currently blocked on a semaphore). If we are not on a list to be run (i.e. this process is suspended), then when the process is resumed, it will signal the exception" + oldList ifNotNil: [self resume]! - oldList ifNotNil: [self resume]. - ! 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext 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> + ^Context primitiveFailTokenFor: errorCode! - ^MethodContext primitiveFailTokenFor: errorCode! Item was removed: - (PackageInfo named: 'Kernel') postscript: '"below, add code to be run after the loading of this package" - - "Arrange that SmalFloat64 has identityHash 4 and is in the class table first page if possible. - Don''t bother to rehash all hashed collections; SmallFloat64 is not in any in the default image" - Smalltalk garbageCollect. - (Array someInstance size = 1024 - and: [(Array someInstance allSatisfy: [:e| e == nil or: [e isBehavior]]) - and: [(Array someInstance first: 17) = {nil . SmallInteger . Character . SmallInteger . nil . nil . nil . nil . nil . nil . nil . nil . nil . nil . nil . nil . Array}]]) ifTrue: - [SmallFloat64 tryPrimitive: 161 withArgs: #(4). - Array someInstance at: 5 put: SmallFloat64]'!

1 0

The Trunk: Compiler-eem.335.mcz
by commits＠source.squeak.org 31 Mar '17

31 Mar '17

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-eem.335.mcz ==================== Summary ==================== Name: Compiler-eem.335 Author: eem Time: 30 March 2017, 4:45:15.534619 pm UUID: c564b5dc-1858-413a-8138-7d322cfad902 Ancestors: Compiler-eem.334 Fix the regression properly. =============== Diff against Compiler-eem.334 =============== Item was removed: - ----- Method: Decompiler>>checkForBlock:selector:arguments: (in category 'control') ----- - checkForBlock: receiver selector: selector arguments: arguments - ^self checkForClosureCopy: receiver arguments: arguments! Item was changed: ----- Method: Decompiler>>send:super:numArgs: (in category 'instruction decoding') ----- send: selector super: superFlag numArgs: numArgs + + | args rcvr selNode msgNode messages | - | args rcvr | args := Array new: numArgs. (numArgs to: 1 by: -1) do: [:i | args at: i put: stack removeLast]. rcvr := stack removeLast. + superFlag ifTrue: [rcvr := constructor codeSuper]. + (#closureCopy:copiedValues: == selector + and: [self checkForClosureCopy: rcvr arguments: args]) ifFalse: + [selNode := constructor codeAnySelector: selector. + rcvr == CascadeFlag + ifTrue: + ["May actually be a cascade or an ifNil: for value." + self willJumpIfFalse + ifTrue: "= generated by a case macro" + [selector == #= ifTrue: + [" = signals a case statement..." + statements addLast: args first. + stack addLast: rcvr. "restore CascadeFlag" + ^ self]. + selector == #== ifTrue: + [" == signals an ifNil: for value..." + stack removeLast; removeLast. + rcvr := stack removeLast. + stack addLast: IfNilFlag; + addLast: (constructor + codeMessage: rcvr + selector: selNode + arguments: args). + ^ self]] + ifFalse: + [(self willJumpIfTrue and: [selector == #==]) ifTrue: + [" == signals an ifNotNil: for value..." + stack removeLast; removeLast. + rcvr := stack removeLast. + stack addLast: IfNilFlag; + addLast: (constructor + codeMessage: rcvr + selector: selNode + arguments: args). + ^ self]]. + msgNode := constructor + codeCascadedMessage: selNode + arguments: args. + stack last == CascadeFlag ifFalse: + ["Last message of a cascade" + statements addLast: msgNode. + messages := self popTo: stack removeLast. "Depth saved by first dup" + msgNode := constructor + codeCascade: stack removeLast + messages: messages]] + ifFalse: + [msgNode := constructor + codeMessage: rcvr + selector: selNode + arguments: args]. + stack addLast: msgNode]! - superFlag ifTrue: [rcvr := constructor codeSuper]!

1 0

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

Jump to page: