'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 24 August 2008 at 10:51:03 am'! "Change Set: Context Inst Var Access Date: 19 June 2008 Author: Eliot Miranda Make sure ContextPart and all superclasses and subclasses access inst vars using long-form bytecodes. Needed for efficient context-to-stack mapping in the interpreter"! TestCase subclass: #ContextCompilationTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-Tests'! InstanceVariableNode subclass: #MaybeContextInstanceVariableNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-ParseNodes'! !MaybeContextInstanceVariableNode commentStamp: '' prior: 0! This class conspires to arrange that inst var access for contexts is done exclusively using the long-form instance variabl;e access bytecodes. See InstructionStream class>>variablesAndOffsetsDo:. A virtual machine can benefit in performance by organizing method and block activations using a more conventional stack organization than by using first-class activation records (contexts). But such a virtual machine is also cabable of hiding the stack and making it appear as if contexts are still used. This means the system has better performance but still has all the benefits of first-class activation records. To pull this off the VM needs to intercept any and all accesses to context objects so that it can make contexts function as proxy objects for stack frames. Without help from the image such a virtual machine based on an interpreter would have to perform an expensive check on all instance variable accesses to determine if the instance variable was that of a context serving as a proxy for a stack frame. A simple hack is to take advantage of the short and long forms of instance variable access bytecodes. The BlueBook instruction set (and likely any bytecode set evolved from it) has short form bytecodes for fetching and storing the first few bytecodes (BlueBook fetch first 16, store first 8). Contexts typically have at most 6 instance variables. If we arrange to use the long-form bytecodes for all context inst var accesses then we only have to check for context inst var access in long-form bytecodes, and then only if the index is within the context inst var range. This effectively makes the check free because on modern processors checking an index fetched from memory into a register against a constant costs far less than the memry read to fetch the index.! ]style[(1792)i! !ContextCompilationTest methodsFor: 'tests' stamp: 'eem 6/19/2008 10:11'! testVariablesAndOffsetsDo "ContextCompilationTest new testVariablesAndOffsetsDo" | contextClasses | contextClasses := ContextPart withAllSuperclasses, ContextPart allSubclasses asArray. contextClasses do: [:class| class variablesAndOffsetsDo: [:var :offset| self assert: offset < 0. self assert: (class instVarNameForIndex: offset negated) == var]]. InstructionStream withAllSuperclasses, InstructionStream allSubclasses asArray do: [:class| (contextClasses includes: class) ifFalse: [class variablesAndOffsetsDo: [:var :offset| (InstructionStream instVarNames includes: var) ifFalse: [self assert: offset > 0. self assert: (class instVarNameForIndex: offset) == var]]]]! ! !MaybeContextInstanceVariableNode methodsFor: 'accessing' stamp: 'eem 6/19/2008 09:27'! code "Answer a bogus code to avoid creating quick methods. See MethodNode>>generate:ifQuick:" ^LoadLong! ! !MaybeContextInstanceVariableNode methodsFor: 'code generation (new scheme)' stamp: 'eem 6/19/2008 09:36'! emitCodeForStorePop: stack encoder: encoder encoder genStorePopInstVarLong: index. stack pop: 1! ! !MaybeContextInstanceVariableNode methodsFor: 'code generation (new scheme)' stamp: 'eem 5/14/2008 18:08'! emitCodeForStore: stack encoder: encoder encoder genStoreInstVarLong: index! ! !MaybeContextInstanceVariableNode methodsFor: 'code generation (new scheme)' stamp: 'eem 5/14/2008 18:08'! emitCodeForValue: stack encoder: encoder stack push: 1. ^encoder genPushInstVarLong: index! ! !MaybeContextInstanceVariableNode methodsFor: 'code generation (new scheme)' stamp: 'eem 5/14/2008 18:07'! sizeCodeForStorePop: encoder ^encoder sizeStorePopInstVarLong: index! ! !MaybeContextInstanceVariableNode methodsFor: 'code generation (new scheme)' stamp: 'eem 5/14/2008 17:57'! sizeCodeForStore: encoder ^encoder sizeStoreInstVarLong: index! ! !MaybeContextInstanceVariableNode methodsFor: 'code generation (new scheme)' stamp: 'eem 5/14/2008 17:53'! sizeCodeForValue: encoder ^encoder sizePushInstVarLong: index! ! !ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 10:45'! 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." "The number of indexable fields of fixed-length objects is 0" ^self primitiveFail! ! !ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 10:46'! 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." "The number of indexable fields of fixed-length objects is 0" ^self primitiveFail! ! !BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 6/19/2008 08:54'! sizePushInstVarLong: instVarIndex ^self sizeOpcodeSelector: #genPushInstVarLong: withArguments: {instVarIndex}! ! !BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 6/19/2008 08:54'! sizeStoreInstVarLong: instVarIndex ^self sizeOpcodeSelector: #genStoreInstVarLong: withArguments: {instVarIndex}! ! !BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 6/19/2008 08:54'! sizeStorePopInstVarLong: instVarIndex ^self sizeOpcodeSelector: #genStorePopInstVarLong: withArguments: {instVarIndex}! ! !EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'! genPushInstVarLong: instVarIndex "See BlueBook page 596" "See also MaybeContextInstanceVariableNode" (instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" stream nextPut: 132; nextPut: 64; nextPut: instVarIndex. ^self]. ^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! ! !EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'! genStoreInstVarLong: instVarIndex "See BlueBook page 596" "See also MaybeContextInstanceVariableNode" (instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" stream nextPut: 132; nextPut: 160; nextPut: instVarIndex. ^self]. ^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! ! !EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'! genStorePopInstVarLong: instVarIndex "See BlueBook page 596" "See also MaybeContextInstanceVariableNode" (instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" stream nextPut: 132; nextPut: 192; nextPut: instVarIndex. ^self]. ^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! ! !EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'! genPushInstVarLong: instVarIndex "See BlueBook page 596" "See also MaybeContextInstanceVariableNode" (instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" stream nextPut: 132; nextPut: 64; nextPut: instVarIndex. ^self]. ^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! ! !EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'! genStoreInstVarLong: instVarIndex "See BlueBook page 596" "See also MaybeContextInstanceVariableNode" (instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" stream nextPut: 132; nextPut: 160; nextPut: instVarIndex. ^self]. ^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! ! !EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:52'! genStorePopInstVarLong: instVarIndex "See BlueBook page 596" "See also MaybeContextInstanceVariableNode" (instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: ["132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj" stream nextPut: 132; nextPut: 192; nextPut: instVarIndex. ^self]. ^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! ! !InstructionStream class methodsFor: 'compiling' stamp: 'eem 6/19/2008 10:00'! isContextClass ^false! ! !ContextPart class methodsFor: 'private' stamp: 'eem 6/19/2008 10:00'! isContextClass ^true! ! !Behavior methodsFor: 'compiling' stamp: 'eem 6/19/2008 09:08'! variablesAndOffsetsDo: aBinaryBlock "This is the interface between the compiler and a class's instance or field names. The class should enumerate aBinaryBlock with the field definitions (with nil offsets) followed by the instance variable name strings and their integer offsets (1-relative). The order is important; names evaluated later will override the same names occurring earlier." "Only need to do instance variables here. CProtoObject introduces field definitions." self instVarNamesAndOffsetsDo: aBinaryBlock! ! !CompiledMethod methodsFor: 'scanning' stamp: 'eem 6/19/2008 09:21'! readsField: varIndex "Answer whether the receiver loads the instance variable indexed by the argument." "eem 5/24/2008 Rewritten to no longer assume the compiler uses the most compact encoding available (for EncoderForLongFormV3 support)." | varIndexCode scanner | varIndexCode := varIndex - 1. self isReturnField ifTrue: [^self returnField = varIndexCode]. ^(scanner := InstructionStream on: self) scanFor: [:b| b < 16 ifTrue: [b = varIndexCode] ifFalse: [b = 128 ifTrue: [scanner followingByte = varIndexCode and: [varIndexCode <= 63]] ifFalse: [b = 132 and: [(scanner followingByte between: 64 and: 95) and: [scanner thirdByte = varIndexCode]]]]]! ! !ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 15:55'! 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." index isInteger ifTrue: [self errorSubscriptBounds: index]. index isNumber ifTrue: [^self at: index asInteger] ifFalse: [self errorNonIntegerIndex]! ! !ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 15:57'! 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." index isInteger ifTrue: [self errorSubscriptBounds: index]. index isNumber ifTrue: [^self at: index asInteger put: value] ifFalse: [self errorNonIntegerIndex]! ! !ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 15:56'! 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." index isInteger ifTrue: [self errorSubscriptBounds: index]. index isNumber ifTrue: [^self at: index asInteger] ifFalse: [self errorNonIntegerIndex]! ! !ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 15:57'! 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." index isInteger ifTrue: [self errorSubscriptBounds: index]. index isNumber ifTrue: [^self at: index asInteger put: value] ifFalse: [self errorNonIntegerIndex]! ! !Encoder methodsFor: 'initialize-release' stamp: 'eem 6/24/2008 14:24'! init: aClass context: aContext notifying: req requestor := req. class := aClass. nTemps := 0. supered := false. self initScopeAndLiteralTables. class variablesAndOffsetsDo: [:variable "" :offset "" | offset isNil ifTrue: [scopeTable at: variable name put: (FieldNode new fieldDefinition: variable)] ifFalse: [scopeTable at: variable put: (offset >= 0 ifTrue: [InstanceVariableNode new name: variable index: offset] ifFalse: [MaybeContextInstanceVariableNode new name: variable index: offset negated])]]. aContext ~~ nil ifTrue: [| homeNode | homeNode := self bindTemp: self doItInContextName. "0th temp = aContext passed as arg" aContext tempNames withIndexDo: [:variable :index| scopeTable at: variable put: (MessageAsTempNode new receiver: homeNode selector: #namedTempAt: arguments: (Array with: (self encodeLiteral: index)) precedence: 3 from: self)]]. sourceRanges := Dictionary new: 32. globalSourceRanges := OrderedCollection new: 32! ! !EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:46'! genPushInstVar: instVarIndex "See BlueBook page 596" (instVarIndex >= 0 and: [instVarIndex < 64]) ifTrue: ["128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk" stream nextPut: 128; nextPut: instVarIndex. ^self]. self genPushInstVarLong: instVarIndex! ! !EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:48'! genStoreInstVar: instVarIndex "See BlueBook page 596" (instVarIndex >= 0 and: [instVarIndex < 64]) ifTrue: ["129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" stream nextPut: 129; nextPut: instVarIndex. ^self]. self genStoreInstVarLong: instVarIndex! ! !EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:50'! genStorePopInstVar: instVarIndex "See BlueBook page 596" (instVarIndex >= 0 and: [instVarIndex < 64]) ifTrue: ["130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" stream nextPut: 130; nextPut: instVarIndex. ^self]. self genStorePopInstVarLong: instVarIndex! ! !EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:40'! genPushInstVar: instVarIndex "See BlueBook page 596" instVarIndex >= 0 ifTrue: [instVarIndex < 16 ifTrue: ["0-15 0000iiii Push Receiver Variable #iiii" stream nextPut: 0 + instVarIndex. ^self]. instVarIndex < 64 ifTrue: ["128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk" stream nextPut: 128; nextPut: instVarIndex. ^self]]. self genPushInstVarLong: instVarIndex! ! !EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:37'! genStoreInstVar: instVarIndex "See BlueBook page 596" (instVarIndex >= 0 and: [instVarIndex < 64]) ifTrue: ["129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" stream nextPut: 129; nextPut: instVarIndex. ^self]. self genStoreInstVarLong: instVarIndex! ! !EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:43'! genStorePopInstVar: instVarIndex "See BlueBook page 596" instVarIndex >= 0 ifTrue: [instVarIndex < 8 ifTrue: ["96-103 01100iii Pop and Store Receiver Variable #iii" stream nextPut: 96 + instVarIndex. ^self]. instVarIndex < 64 ifTrue: ["130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk" stream nextPut: 130; nextPut: instVarIndex. ^self]]. self genStorePopInstVarLong: instVarIndex! ! !InstructionStream class methodsFor: 'compiling' stamp: 'eem 7/17/2008 13:16'! 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 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]! ! !MethodContext methodsFor: 'accessing' stamp: 'eem 8/20/2008 09:28'! 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." ^self at: index! ! !MethodContext methodsFor: 'accessing' stamp: 'eem 8/20/2008 09:29'! 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." ^self at: index put: value! ! "Postscript: Recompile methods in ContextPart, superclasses and subclasses that access inst vars" ContextPart withAllSuperclasses, ContextPart allSubclasses asArray do: [:class| class instSize > 0 ifTrue: [class allInstVarNames do: [:ivn| (class whichSelectorsAccess: ivn) do: [:sel| class recompile: sel]]]] !