'From Squeak3.2gamma[BC] of 15 January 2002 [latest update: #4743] on 14 February 2002 at 4:04:03 am'! "Change Set: BCDebugSelectionFix-ajh Date: 14 February 2002 Author: Anthony Hannan Adds a MethodContext2 method used by the debugger, fixes a Process method, and updates recreateSpecialObjectsArray. These were overlooked in the prebuilt image."! !MethodContext2 methodsFor: 'debugger access' stamp: 'ajh 2/14/2002 02:21'! previousPc "Answer the index of the last bytecode executed." ^ InstructionStream2 ipBefore: self pc in: self method! ! !Process2 methodsFor: 'testing' stamp: 'ajh 2/14/2002 04:01'! isSuspended "is self suspended, not waiting on a Semaphore, not queued to run, not even unwound (terminated), just hanging" ^ myList isNil and: [callStack notNil and: [callStack ~= 0]] "If callStack were also nil then I would be terminated (not resumable, and therefore not merely suspended)"! ! !SystemDictionary methodsFor: 'special objects' stamp: 'ajh 2/14/2002 02:40'! recreateSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "The Special Objects Array is an array of object pointers used by the Smalltalk virtual machine. Its contents are critical and unchecked, so don't even think of playing here unless you know what you are doing." | newArray | newArray _ Array new: 49. "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: (Smalltalk associationAt: #Processor). "Numerous classes below used for type checking and instantiation" newArray at: 5 put: Bitmap. newArray at: 6 put: SmallInteger. newArray at: 7 put: String. newArray at: 8 put: Array. newArray at: 9 put: Smalltalk. newArray at: 10 put: Float. newArray at: 11 put: MethodContext2. newArray at: 12 put: BlockClosure. newArray at: 13 put: Point. newArray at: 14 put: LargePositiveInteger. newArray at: 15 put: Display. newArray at: 16 put: Message. newArray at: 17 put: CompiledMethod2. newArray at: 18 put: (Smalltalk specialObjectsArray at: 18) "(low space Semaphore)". newArray at: 19 put: Semaphore. newArray at: 20 put: Character. newArray at: 21 put: #doesNotUnderstand:. newArray at: 22 put: #cannotReturn:from:. newArray at: 23 put: nil. "the input semaphore" "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 value 0 value: 1 do: 1 new 0 new: 1 x 0 y 0 ). "An array of the 255 Characters in ascii order." newArray at: 25 put: ((0 to: 255) collect: [:ascii | Character value: ascii]). newArray at: 26 put: #mustBeBoolean. newArray at: 27 put: ByteArray. newArray at: 28 put: Process2. "An array of up to 31 classes whose instances will have compact headers" newArray at: 29 put: (Smalltalk compactClassesArray copy at: 4 put: CallStack; yourself). "We don't just add CallStack to the current image because the current VM assumes classes at compact index 4 are contexts (PseudoContext)" newArray at: 30 put: (Smalltalk specialObjectsArray at: 30) "(delay Semaphore)". newArray at: 31 put: (Smalltalk specialObjectsArray at: 31) "(user input Semaphore)". "Prototype instances that can be copied for fast initialization" newArray at: 32 put: (Float new: 2). newArray at: 33 put: (LargePositiveInteger new: 4). newArray at: 34 put: Point new. newArray at: 35 put: #cannotInterpret:. newArray at: 36 put: #couldNotReturn:from:. newArray at: 37 put: CallStack. newArray at: 38 put: SharedTemp. newArray at: 39 put: Array new. "array of objects referred to by external code" "newArray at: 40 put: PseudoContext." newArray at: 41 put: TranslatedMethod. "finalization Semaphore" newArray at: 42 put: ((Smalltalk specialObjectsArray at: 42) ifNil:[Semaphore new]). newArray at: 43 put: LargeNegativeInteger. "External objects for callout. Note: Written so that one can actually completely remove the FFI." newArray at: 44 put: (Smalltalk at: #ExternalAddress ifAbsent:[nil]). newArray at: 45 put: (Smalltalk at: #ExternalStructure ifAbsent:[nil]). newArray at: 46 put: (Smalltalk at: #ExternalData ifAbsent:[nil]). newArray at: 47 put: (Smalltalk at: #ExternalFunction ifAbsent:[nil]). newArray at: 48 put: (Smalltalk at: #ExternalLibrary ifAbsent:[nil]). newArray at: 49 put: #executeThenReturn:from:. "was #aboutToReturn:through:" "Now replace the interpreter's reference in one atomic operation" self specialObjectsArray become: newArray! !