'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5566] on 24 November 2003 at 6:40:36 pm'! "Change Set: CCP004-IRBuilder Date: 14 November 2003 Author: Marcus Denker v2: removed Decompiler for now, will return after I add the RB-AST. This is Anthony's IRBuilder. It's a symbolic Assembler for Squeak Bytecodes: ir := IRBuilder new rargs: #(self); pushLiteral: 1; returnTop; ir. cm := ir compiledMethod. cm valueWithReceiver: nil arguments: #(). "! Object subclass: #BytecodeGenerator instanceVariableNames: 'seqOrder orderSeq seqBytes jumps literals lastLiteral currentSeqId currentSeqNum bytes lastSpecialReturn instrMaps instrMap maxTemp stacks stack primNum numArgs ' classVariableNames: 'BytecodeTable Bytecodes SpecialConstants SpecialSelectors ' poolDictionaries: '' category: 'Compiler-Bytecodes'! !BytecodeGenerator commentStamp: 'ajh 5/23/2003 10:59' prior: 0! I generate bytecodes in response to 'instructions' messages being sent to me. I rewrite jumps at the end so their jump offsets are correct (see #bytecodes). For example, to create a compiled method that compares first instVar to first arg and returns 'yes' or 'no' (same example as in IRBuilder), do: BytecodeGenerator new numArgs: 1; pushInstVar: 1; pushTemp: 1; send: #>; if: false goto: #else; pushLiteral: 'yes'; returnTop; label: #else; pushLiteral: 'no'; returnTop; compiledMethod You can send #ir to the compiledMethod to decompile to its IRMethod, and you can send #methodNode to either to decompile to its parse tree. ! Object subclass: #IRBuilder instanceVariableNames: 'ir tempMap jumpBackTargetStacks jumpAheadStacks currentSequence sourceMapNodes sourceMapByteIndex ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRBuilder commentStamp: 'ajh 5/23/2003 11:03' prior: 0! I provide a simple interface for constructing an IRMethod. For example, to create an ir method that compares first instVar to first arg and returns 'yes' or 'no' (same example as in BytecodeGenerator), do: IRBuilder new rargs: #(self a); "receiver and args names" addTemps: #(z); "extra temps (not used here)" pushTemp: #self; getField: 1; pushTemp: #a; send: #>; jumpAheadTo: #else if: false; pushLiteral: 'yes'; returnTop; jumpAheadTarget: #else; pushLiteral: 'no'; returnTop; ir Sending #compiledMethod to an ir method will generate its compiledMethod. Sending #methodNode to it will decompile to its parse tree. ! Link subclass: #IRInstruction instanceVariableNames: 'sourceNode bytecodeIndex ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRInstruction commentStamp: 'ajh 3/24/2003 23:38' prior: 0! I am an instruction in the IR (intermediate representation) language. The IR serves as the intermediary between the Smalltalk language and the bytecode language. It is easier to optimize and translate to/from this language than it is to optimize/translate directly from Smalltalk to bytecodes. The IR is generic and simple consisting of just twelve instructions. They are: goto: labelNum if: boolean goto: labelNum1 otherwise: labelNum2 label: labelNum popTop pushDup pushLiteral: object pushTemp: tempIndex remoteReturn returnTop send: selector send: selector toSuperOf: behavior storeTemp: tempIndex Each instruction is reified as an instance of one of my eight subclasses and grouped by basic block (IRSequence) into an IRMethod. IRInterpreter visits each instruction in a IRMethod responding to the above instruction messages sent to it. ! IRInstruction subclass: #IRConstant instanceVariableNames: 'constant ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRConstant commentStamp: 'ajh 3/24/2003 23:56' prior: 0! Instruction "pushLiteral: object"! IRInstruction subclass: #IRDup instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRDup commentStamp: 'ajh 3/24/2003 23:56' prior: 0! Instruction "pushDup"! Object subclass: #IRInterpreter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRInterpreter commentStamp: 'ajh 3/24/2003 23:55' prior: 0! I visit each IRInstruction in an IRMethod in order. Each instruction sends its instruction message to me upon being visited. See my 'instructions' method category for complete list of instructions. Subclasses should override them.! IRInstruction subclass: #IRJump instanceVariableNames: 'destination ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRJump commentStamp: 'ajh 3/24/2003 23:56' prior: 0! Instruction "goto: labelNum"! IRJump subclass: #IRJumpIf instanceVariableNames: 'boolean otherwise ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRJumpIf commentStamp: 'ajh 3/24/2003 23:56' prior: 0! Instruction "if: boolean goto: labelNum1 otherwise: labelNum2"! Object subclass: #IRMethod instanceVariableNames: 'startSequence primitiveNode rargKeys otherTempKeys compiledMethod ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRMethod commentStamp: 'ajh 5/23/2003 11:08' prior: 0! I am a method in the IR (intermediate representation) language consisting of IRInstructions grouped by IRSequence (basic block). The IRSequences form a control graph (therefore I only have to hold onto the starting sequence). #compiledMethod will convert me to a CompiledMethod. #methodNode will convert me back to a parse tree. ! IRInstruction subclass: #IRPop instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRPop commentStamp: 'ajh 3/24/2003 23:57' prior: 0! Instruction "popTop"! IRInterpreter subclass: #IRPrinter instanceVariableNames: 'stream indent ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRPrinter commentStamp: 'ajh 3/25/2003 00:22' prior: 0! I interpret IRMethod instructions and write them out to a print stream.! IRInstruction subclass: #IRReturn instanceVariableNames: 'isRemote ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRReturn commentStamp: 'ajh 3/24/2003 23:57' prior: 0! Instruction "returnTop" or "remoteReturn"! IRInstruction subclass: #IRSend instanceVariableNames: 'selector superOf ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRSend commentStamp: 'ajh 3/24/2003 23:57' prior: 0! Instruction "send: selector" or "send: selector toSuperOf: behavior"! LinkedList subclass: #IRSequence instanceVariableNames: 'orderNumber ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRSequence commentStamp: 'ajh 3/14/2003 00:33' prior: 0! I hold a sequence of IRInstructions where only the last instruction jumps or returns, the rest are guaranteed to execute in order (ie. a basic block).! IRInstruction subclass: #IRTemp instanceVariableNames: 'number isStore ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRTemp commentStamp: 'ajh 3/24/2003 23:58' prior: 0! Instruction "pushTemp: tempIndex" or "storeTemp: tempIndex"! IRInterpreter subclass: #IRTranslator instanceVariableNames: 'pending gen currentInstr ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-IR'! !IRTranslator commentStamp: 'ajh 3/25/2003 00:26' prior: 0! I interpret IRMethod instructions, sending the appropriate bytecode messages to my BytecodeGenerator (gen). I hold some messages back in pending awaiting certain sequences of them that can be consolidated into single bytecode instructions, otherwise the pending messages are executed in order as if they were executed when they first appeared.! OrderedCollection subclass: #LiteralList instanceVariableNames: 'equalitySet ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-Bytecodes'! !LiteralList commentStamp: 'ajh 3/25/2003 00:31' prior: 0! Holds a unique ordered collection of literals! Set subclass: #LiteralSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-Bytecodes'! !LiteralSet commentStamp: 'ajh 3/25/2003 00:33' prior: 0! Holds a unique set of literals. Literal objects are equal if they are #= plus they are the same class. This set uses this rule for finding elements. Example: Set new add: 'anthony'; add: #anthony; size "= 1" LiteralSet new add: 'anthony'; add: #anthony; size "= 2" ! Object subclass: #PrimitiveNode instanceVariableNames: 'primitiveNum spec ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-Syntax'! !PrimitiveNode commentStamp: 'ajh 3/24/2003 21:35' prior: 0! I represent a primitive. I am more than just a number if I am a named primitive. Structure: num Primitive number. spec Stored in first literal when num is 117 or 120. ! Object subclass: #StackCount instanceVariableNames: 'start position length ' classVariableNames: '' poolDictionaries: '' category: 'Compiler-Bytecodes'! !StackCount commentStamp: 'ajh 3/25/2003 00:34' prior: 0! This keeps track of the stack count for the BytecodeGenerator.! !Object methodsFor: 'testing' stamp: 'md 11/21/2003 12:14'! isBlockClosure ^ false! ! !Object methodsFor: 'testing' stamp: 'md 11/21/2003 12:14'! isCompiledMethod ^ false! ! !BytecodeGenerator methodsFor: 'initialize' stamp: 'ajh 5/22/2003 17:11'! initialize literals _ LiteralList new. "The following dicts are keyed by sequence id given by client in label: (and gotos)." seqOrder _ IdentityDictionary new. "seqId -> seq order num" seqBytes _ IdentityDictionary new. "seqId -> seq bytecodes" jumps _ IdentityDictionary new. "seqId -> last jump instr" instrMaps _ IdentityDictionary new. "seqId -> (clientInstr -> bytecode pos)" stacks _ IdentityDictionary new. "seqId -> stackCount" maxTemp _ 0. primNum _ 0. numArgs _ 0. currentSeqNum _ 0. orderSeq _ OrderedCollection new. "reverse map of seqOrder" "starting label in case one is not provided by client" self label: self newDummySeqId. ! ! !BytecodeGenerator methodsFor: 'initialize' stamp: 'ajh 3/13/2003 18:21'! numArgs: n numArgs _ n! ! !BytecodeGenerator methodsFor: 'initialize' stamp: 'ajh 3/13/2003 18:21'! primitiveNode: aPrimitiveNode literals isEmpty ifFalse: [self error: 'init prim before adding instructions']. aPrimitiveNode spec ifNotNil: [literals add: aPrimitiveNode spec]. primNum _ aPrimitiveNode num. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 12:22'! goto: seqId stacks at: seqId put: (stack linkTo: (stacks at: seqId ifAbsentPut: [nil])). self saveLastJump: (Message selector: #from:goto: arguments: {currentSeqId. seqId}). self from: currentSeqId goto: seqId. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 13:26'! if: bool goto: seqId | otherwiseSeqId | otherwiseSeqId _ self newDummySeqId. self if: bool goto: seqId otherwise: otherwiseSeqId. self label: otherwiseSeqId. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 12:26'! if: bool goto: seqId1 otherwise: seqId2 stack pop. stacks at: seqId1 put: (stack linkTo: (stacks at: seqId1 ifAbsentPut: [nil])). stacks at: seqId2 put: (stack linkTo: (stacks at: seqId2 ifAbsentPut: [nil])). self saveLastJump: (Message selector: #from:if:goto:otherwise: arguments: {currentSeqId. bool. seqId1. seqId2}). self from: currentSeqId if: bool goto: seqId1 otherwise: seqId2. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 14:16'! label: seqId (currentSeqId notNil and: [(jumps at: currentSeqId) isNil]) ifTrue: [ "make previous implicit goto explicit" self goto: seqId. ]. lastSpecialReturn _ nil. currentSeqId _ seqId. currentSeqNum _ currentSeqNum + 1. seqOrder at: seqId put: currentSeqNum. orderSeq at: currentSeqNum ifAbsentPut: [seqId]. bytes _ seqBytes at: seqId ifAbsentPut: [OrderedCollection new]. jumps at: seqId ifAbsentPut: [nil]. instrMap _ instrMaps at: seqId ifAbsentPut: [OrderedCollection new]. stack _ stacks at: seqId ifAbsentPut: [StackCount new]. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:48'! popTop stack pop. self nextPut: (Bytecodes at: #popStackBytecode). ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:48'! pushDup stack push. self nextPut: (Bytecodes at: #duplicateTopBytecode). ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:49'! pushInstVar: instVarIndex | interval | stack push. interval _ Bytecodes at: #pushReceiverVariableBytecode. instVarIndex <= interval size ifTrue: [ ^ self nextPut: (interval at: instVarIndex). ]. instVarIndex <= 64 ifTrue: [ self nextPut: (Bytecodes at: #extendedPushBytecode). ^ self nextPut: (0 "instVar" << 6) + instVarIndex - 1. ]. instVarIndex <= 256 ifFalse: [self error: 'can''t reference more than 256 inst vars']. self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode). self nextPut: 2 "pushInstVar" << 5. self nextPut: instVarIndex - 1. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:50'! pushLiteral: object | index interval | stack push. (index _ SpecialConstants identityIndexOf: object) > 0 ifTrue: [ ^ self nextPut: (Bytecodes at: #pushConstantTrueBytecode) + index - 1]. index _ self addLiteral: object. interval _ Bytecodes at: #pushLiteralConstantBytecode. (index <= interval size) ifTrue: [ ^ self nextPut: (interval at: index) ]. index <= 64 ifTrue: [ self nextPut: (Bytecodes at: #extendedPushBytecode). ^ self nextPut: 2 "lit constant" << 6 + index - 1 ]. index > 256 ifTrue: [self error: 'too many literals (>256)']. self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode). self nextPut: 3 "lit constant" << 5. self nextPut: index - 1. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:50'! pushReceiver stack push. self nextPut: (Bytecodes at: #pushReceiverBytecode)! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:51'! pushTemp: index | interval | stack push. maxTemp _ index max: maxTemp. interval _ Bytecodes at: #pushTemporaryVariableBytecode. index <= interval size ifTrue: [ ^ self nextPut: (interval at: index). ]. index <= 64 ifFalse: [self error: 'too many temp vars (>64)']. self nextPut: (Bytecodes at: #extendedPushBytecode). self nextPut: (1 "temp" << 6) + index - 1. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:51'! pushThisContext stack push. self nextPut: (Bytecodes at: #pushActiveContextBytecode). ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 14:01'! remoteReturn self saveLastJump: #return. self send: #remoteReturnTo:. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 14:02'! returnConstant: obj self saveLastJump: #return. bytes size = 0 ifTrue: [ lastSpecialReturn _ Message selector: #returnConstant: argument: obj]. obj caseOf: { [true] -> [self nextPut: (Bytecodes at: #returnTrue)]. [false] -> [self nextPut: (Bytecodes at: #returnFalse)]. [nil] -> [self nextPut: (Bytecodes at: #returnNil)] } otherwise: [ self pushLiteral: obj. self returnTop. ] ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 14:02'! returnInstVar: index self saveLastJump: #return. bytes size = 0 ifTrue: [ lastSpecialReturn _ Message selector: #returnInstVar: argument: index]. self pushInstVar: index. self returnTop. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 14:02'! returnReceiver self saveLastJump: #return. bytes size = 0 ifTrue: [ lastSpecialReturn _ Message selector: #returnReceiver]. self nextPut: (Bytecodes at: #returnReceiver). ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 14:02'! returnTop self saveLastJump: #return. self nextPut: (Bytecodes at: #returnTopFromMethod). ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/16/2003 14:43'! send: selector | index nArgs | nArgs _ selector numArgs. stack pop: nArgs. SpecialSelectors at: selector ifPresent: [:i | ^ self nextPut: (Bytecodes at: #bytecodePrimAdd) + i]. index _ self addLiteral: selector. (index <= 16 and: [nArgs <= 2]) ifTrue: [ "short send" ^ self nextPut: (Bytecodes at: #sendLiteralSelectorBytecode) first + (nArgs * 16) + index - 1 ]. (index <= 32 and: [nArgs <= 7]) ifTrue: [ "extended (2-byte) send" self nextPut: (Bytecodes at: #singleExtendedSendBytecode). ^ self nextPut: nArgs * 32 + index - 1 ]. (index <= 64 and: [nArgs <= 3]) ifTrue: [ "new extended (2-byte)" self nextPut: (Bytecodes at: #secondExtendedSendBytecode). ^ self nextPut: nArgs * 64 + index - 1 ]. "long (3-byte) send" self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode). self nextPut: nArgs. self nextPut: index - 1. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/16/2003 14:43'! send: selector toSuperOf: behavior | index nArgs | nArgs _ selector numArgs. stack pop: nArgs. self addLastLiteral: behavior holder. index _ self addLiteral: selector. (index <= 32 and: [nArgs <= 7]) ifTrue: [ "extended (2-byte) send" self nextPut: (Bytecodes at: #singleExtendedSuperBytecode). ^ self nextPut: nArgs * 32 + index - 1 ]. "long (3-byte) send" self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode). self nextPut: 1 << 5 "super" + nArgs. self nextPut: index - 1. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 20:36'! storeInstVar: index index <= 64 ifTrue: [ self nextPut: (Bytecodes at: #extendedStoreBytecode). ^ self nextPut: (0 "instVar" << 6) + index - 1. ]. index <= 256 ifFalse: [self error: 'can''t reference more than 256 inst vars']. self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode). self nextPut: 5 "storeInstVar" << 5. self nextPut: index - 1. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 18:00'! storePopInstVar: index | interval | stack pop. interval _ Bytecodes at: #storeAndPopReceiverVariableBytecode. index <= interval size ifTrue: [ ^ self nextPut: (interval at: index) ]. index <= 64 ifTrue: [ self nextPut: (Bytecodes at: #extendedStoreAndPopBytecode). ^ self nextPut: (0 "instVar" << 6) + index - 1. ]. index <= 256 ifFalse: [ self error: 'can''t reference more than 256 inst vars']. self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode). self nextPut: 6 "storePopInstVar" << 5. self nextPut: index - 1. ! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 18:01'! storePopTemp: index | interval | stack pop. maxTemp _ index max: maxTemp. interval _ Bytecodes at: #storeAndPopTemporaryVariableBytecode. index <= interval size ifTrue: [ ^ self nextPut: (interval at: index) ]. index <= 64 ifTrue: [ self nextPut: (Bytecodes at: #extendedStoreAndPopBytecode). ^ self nextPut: (1 "temp" << 6) + index - 1. ]. self error: 'too many temps (>64)'! ! !BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 18:01'! storeTemp: index maxTemp _ index max: maxTemp. index <= 64 ifFalse: [self error: 'too many temps (>64)']. self nextPut: (Bytecodes at: #extendedStoreBytecode). self nextPut: (1 "temp" << 6) + index - 1. ! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/6/2003 22:48'! addLastLiteral: object lastLiteral ifNil: [^ lastLiteral _ object]. (lastLiteral literalEqual: object) ifFalse: [self error: 'there can only be one last literal'].! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/8/2003 20:56'! addLiteral: object literals add: object. ^ literals indexOf: object! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 5/22/2003 13:00'! from: fromSeqId goto: toSeqId | distance from to | from _ seqOrder at: fromSeqId. to _ seqOrder at: toSeqId ifAbsent: [^ self]. from + 1 = to ifTrue: [^ self]. "fall through, no jump needed" from < to ifTrue: [ "jump forward" distance _ (from + 1 to: to - 1) inject: 0 into: [:size :i | size + (seqBytes at: (orderSeq at: i)) size]. self jumpForward: distance. ] ifFalse: [ "jump backward" distance _ ((to to: from - 1) inject: 0 into: [:size :i | size + (seqBytes at: (orderSeq at: i)) size]) + bytes size. self jumpBackward: distance. ]. ! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 5/22/2003 13:22'! from: fromSeqId if: bool goto: toSeqId otherwise: otherwiseSeqId | distance from to otherwise | from _ seqOrder at: fromSeqId. to _ seqOrder at: toSeqId ifAbsent: [^ self jump: 0 if: bool]. "not done yet" otherwise _ seqOrder at: otherwiseSeqId ifAbsent: [^ self jump: 0 if: bool]. "not done yet" from < to ifFalse: [self errorConditionalJumpBackwards]. from + 1 = otherwise ifFalse: [self errorFallThroughSequenceNotNext]. distance _ (from + 1 to: to - 1) inject: 0 into: [:size :i | size + (seqBytes at: (orderSeq at: i)) size]. self jump: distance if: bool. ! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/24/2003 17:48'! jump: distance if: condition | hi | distance = 0 ifTrue: [ "jumps to fall through, no-op" ^ self nextPut: (Bytecodes at: #popStackBytecode)]. condition ifTrue: [ hi _ distance // 256. hi < 8 ifFalse: [self error: 'true jump too big']. self nextPut: (Bytecodes at: #longJumpIfTrue) first + hi. self nextPut: distance \\ 256. ] ifFalse: [ distance <= 8 ifTrue: [ self nextPut: (Bytecodes at: #shortConditionalJump) first + distance - 1. ] ifFalse: [ hi _ distance // 256. hi < 8 ifFalse: [self error: 'false jump too big']. self nextPut: (Bytecodes at: #longJumpIfFalse) first + hi. self nextPut: distance \\ 256. ]. ] ! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/24/2003 17:46'! jumpBackward: distance | dist | distance = 0 ifTrue: [^ self]. "no-op" dist _ 1024 - distance - 2. dist < 0 ifTrue: [self error: 'back jump to big']. self nextPut: (Bytecodes at: #longUnconditionalJump) first + (dist // 256). self nextPut: dist \\ 256. ! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/24/2003 17:46'! jumpForward: distance distance = 0 ifTrue: [^ self]. "no-op" distance <= 8 ifTrue: [ self nextPut: (Bytecodes at: #shortUnconditionalJump) first + distance - 1. ] ifFalse: [ distance > 1023 ifTrue: [self error: 'forward jump too big']. self nextPut: (Bytecodes at: #longUnconditionalJump) first + (distance // 256) + 4. self nextPut: distance \\ 256. ]. ! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 5/22/2003 13:28'! newDummySeqId ^ Object new! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/13/2003 13:00'! nextPut: byte bytes add: byte! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 5/22/2003 12:23'! saveLastJump: message jumps at: currentSeqId put: {bytes size. message}. ! ! !BytecodeGenerator methodsFor: 'private' stamp: 'ajh 6/22/2003 14:41'! updateJump: seqId "Recalculate final jump bytecodes. Return true if jump bytecodes SIZE has changed, otherwise return false" | pair s1 | pair _ jumps at: seqId. pair last == #return ifTrue: [^ false]. "no jump, a return" bytes _ seqBytes at: seqId. s1 _ bytes size. bytes removeLast: (bytes size - pair first). pair last sendTo: self. ^ s1 ~= bytes size! ! !BytecodeGenerator methodsFor: 'results' stamp: 'ajh 5/22/2003 13:06'! bytecodes | stream | [ orderSeq inject: false into: [:changed :seqId | (self updateJump: seqId) | changed] ] whileTrue. stream _ (ByteArray new: 100) writeStream. orderSeq do: [:seqId | (instrMaps at: seqId) do: [:assoc | assoc key "instr" bytecodeIndex: stream position + assoc value. ]. stream nextPutAll: (seqBytes at: seqId). ]. ^ stream contents! ! !BytecodeGenerator methodsFor: 'results' stamp: 'ajh 5/23/2003 10:48'! compiledMethod ^ self compiledMethodWith: #(0)! ! !BytecodeGenerator methodsFor: 'results' stamp: 'md 11/14/2003 19:43'! compiledMethodWith: trailer ^ (CompiledMethod primitive: (self primNum > 0 ifTrue: [self primNum] ifFalse: [self quickMethodPrim]) numArgs: self numArgs numTemps: (self numTemps max: self numArgs) stackSize: self stackSize literals: self literals bytecodes: self bytecodes trailer: trailer)! ! !BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/16/2003 13:57'! literals ^ lastLiteral ifNil: [literals] ifNotNil: [literals asArray copyWith: lastLiteral]! ! !BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:27'! numArgs ^ numArgs! ! !BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:03'! numTemps ^ maxTemp! ! !BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:27'! primNum ^ primNum! ! !BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:28'! quickMethodPrim | i | self numArgs = 0 ifFalse: [^ 0]. lastSpecialReturn ifNil: [^ 0]. seqBytes size = 1 ifFalse: [^ 0]. ^ lastSpecialReturn selector caseOf: { [#returnReceiver] -> [256]. [#returnConstant:] -> [ (i _ SpecialConstants indexOf: lastSpecialReturn argument) > 0 ifTrue: [256 + i] ifFalse: [0]]. [#returnInstVar:] -> [263 + lastSpecialReturn argument] }! ! !BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:03'! stackSize ^ (stacks collect: [:s | s length]) max! ! !BytecodeGenerator methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:00'! mapBytesTo: instr "Associate next byte with instr" instrMap add: instr -> (bytes size + 1)! ! !BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:44'! bytecodeTableFrom: specArray "SpecArray is an array of either (index selector) or (index1 index2 selector)." | contiguous | Bytecodes _ IdentityDictionary new: 256. BytecodeTable _ Array new: 256. contiguous _ 0. specArray do: [ :spec | (spec at: 1) = contiguous ifFalse: [self error: 'Non-contiguous table entry']. spec size = 2 ifTrue: [ Bytecodes at: (spec at: 2) put: (spec at: 1). BytecodeTable at: (spec at: 1) + 1 put: (spec at: 2). contiguous _ contiguous + 1. ] ifFalse: [ spec size = 3 ifFalse: [self error: 'bad spec size']. Bytecodes at: (spec at: 3) put: ((spec at: 1) to: (spec at: 2)). (spec at: 1) to: (spec at: 2) do: [ :i | BytecodeTable at: i + 1 put: (spec at: 3). ]. contiguous _ contiguous + ((spec at: 2) - (spec at: 1)) + 1. ]. ]. ^ BytecodeTable! ! !BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:40'! initialize self initializeBytecodeTable. self initializeSpecialSelectors. self initializeSpecialConstants. ! ! !BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:42'! initializeBytecodeTable "BytecodeWriteStream initialize" "Defines all the bytecode instructions for the Compiler and the Interpreter. The following bytecode tuple format is: #(bytecode bytecodeSelector) bytecodeSelector is the method in the Interpreter that gets executed for the given bytecode. Common Send selector position within the specialSelectorsArray is hard code in the Interpreter, see senders of Interpreter specialSelector:." ^ self bytecodeTableFrom: #( ( 0 15 pushReceiverVariableBytecode) ( 16 31 pushTemporaryVariableBytecode) ( 32 63 pushLiteralConstantBytecode) ( 64 95 pushLiteralVariableBytecode) ( 96 103 storeAndPopReceiverVariableBytecode) (104 111 storeAndPopTemporaryVariableBytecode) (112 pushReceiverBytecode) (113 pushConstantTrueBytecode) (114 pushConstantFalseBytecode) (115 pushConstantNilBytecode) (116 pushConstantMinusOneBytecode) (117 pushConstantZeroBytecode) (118 pushConstantOneBytecode) (119 pushConstantTwoBytecode) (120 returnReceiver) (121 returnTrue) (122 returnFalse) (123 returnNil) (124 returnTopFromMethod) (125 returnTopFromBlock) (126 unknownBytecode) (127 unknownBytecode) (128 extendedPushBytecode) (129 extendedStoreBytecode) (130 extendedStoreAndPopBytecode) (131 singleExtendedSendBytecode) (132 doubleExtendedDoAnythingBytecode) (133 singleExtendedSuperBytecode) (134 secondExtendedSendBytecode) (135 popStackBytecode) (136 duplicateTopBytecode) (137 pushActiveContextBytecode) (138 143 experimentalBytecode) (144 151 shortUnconditionalJump) (152 159 shortConditionalJump) (160 167 longUnconditionalJump) (168 171 longJumpIfTrue) (172 175 longJumpIfFalse) "176-191 were sendArithmeticSelectorBytecode" (176 bytecodePrimAdd) (177 bytecodePrimSubtract) (178 bytecodePrimLessThan) (179 bytecodePrimGreaterThan) (180 bytecodePrimLessOrEqual) (181 bytecodePrimGreaterOrEqual) (182 bytecodePrimEqual) (183 bytecodePrimNotEqual) (184 bytecodePrimMultiply) (185 bytecodePrimDivide) (186 bytecodePrimMod) (187 bytecodePrimMakePoint) (188 bytecodePrimBitShift) (189 bytecodePrimDiv) (190 bytecodePrimBitAnd) (191 bytecodePrimBitOr) "192-207 were sendCommonSelectorBytecode" (192 bytecodePrimAt) (193 bytecodePrimAtPut) (194 bytecodePrimSize) (195 bytecodePrimNext) (196 bytecodePrimNextPut) (197 bytecodePrimAtEnd) (198 bytecodePrimEquivalent) (199 bytecodePrimClass) (200 bytecodePrimBlockCopy) (201 bytecodePrimValue) (202 bytecodePrimValueWithArg) (203 bytecodePrimDo) (204 bytecodePrimNew) (205 bytecodePrimNewWithArg) (206 bytecodePrimPointX) (207 bytecodePrimPointY) (208 255 sendLiteralSelectorBytecode) ) ! ! !BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:45'! initializeSpecialConstants SpecialConstants _ {true. false. nil. -1. 0. 1. 2}! ! !BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:40'! initializeSpecialSelectors "Create a map from specialSelector -> bytecode offset from sendAdd (the first one)" | array | SpecialSelectors _ IdentityDictionary new. array _ self specialSelectorsArray. "Smalltalk specialObjectsArray at: 24" 1 to: array size by: 2 "skip numArgs" do: [:i | SpecialSelectors at: (array at: i) put: i - 1 / 2]. ! ! !BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/15/2003 15:43'! specialConstants ^ SpecialConstants! ! !BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:45'! specialSelectorsArray ^ #(#+ 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 #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0)! ! !CompiledMethod methodsFor: 'testing' stamp: 'md 11/21/2003 12:15'! isCompiledMethod ^ true! ! !CompiledMethod class methodsFor: 'instance creation' stamp: 'ajh 3/9/2003 15:09'! primitive: primNum numArgs: numArgs numTemps: numTemps stackSize: stackSize literals: literals bytecodes: bytecodes trailer: trailerBytes "Create method with given attributes. numTemps includes numArgs. stackSize does not include numTemps." | compiledMethod | compiledMethod _ self newBytes: bytecodes size trailerBytes: trailerBytes nArgs: numArgs nTemps: numTemps nStack: stackSize nLits: literals size primitive: primNum. (WriteStream with: compiledMethod) position: compiledMethod initialPC - 1; nextPutAll: bytecodes. literals withIndexDo: [:obj :i | compiledMethod literalAt: i put: obj]. ^ compiledMethod! ! !IRBuilder methodsFor: 'initialize' stamp: 'ajh 3/10/2003 14:06'! addTemp: tempName self addTemps: {tempName}! ! !IRBuilder methodsFor: 'initialize' stamp: 'ajh 3/17/2003 11:07'! addTemps: tempKeys | otherKeys i | otherKeys _ ir otherTempKeys. i _ ir numArgs + otherKeys size. tempKeys do: [:key | tempMap at: key put: (i _ i + 1)]. ir otherTempKeys: otherKeys, tempKeys. ! ! !IRBuilder methodsFor: 'initialize' stamp: 'ajh 3/10/2003 14:10'! primitiveNode: primNode ir primitiveNode: primNode! ! !IRBuilder methodsFor: 'initialize' stamp: 'ajh 3/17/2003 11:12'! rargs: tempKeys tempKeys withIndexDo: [:key :i | tempMap at: key put: i - 1]. ir rargKeys: tempKeys. ! ! !IRBuilder methodsFor: 'initialize' stamp: 'ajh 3/17/2003 11:06'! thisContext: tempKey tempMap at: tempKey put: -1! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/11/2003 10:58'! getField: instVarIndex "Receiver must be on top" self pushLiteral: instVarIndex. self send: #getInstVar:. ! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:25'! jumpAheadTarget: labelSymbol "Pop latest jumpAheadTo: with this labelSymbol and have it point to this new instruction sequence" | jumpInstr | self startNewSequence. jumpInstr _ (jumpAheadStacks at: labelSymbol ifAbsent: [self error: 'Missing jumpAheadTo: ', labelSymbol printString]) removeLast. jumpInstr destination: currentSequence. ! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:44'! jumpAheadTo: labelSymbol "Jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self. This is and its corresponding target is only good for one use. Other jumpAheadTo: with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called." "jumpAheadTarget: label will pop this and replace destination with its basic block" (jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new]) addLast: (self add: IRJump new). self startNewSequence. ! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:44'! jumpAheadTo: labelSymbol if: boolean "Conditional jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self. This and its corresponding target is only good for one use. Other jumpAheadTo:... with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called." | instr | "jumpAheadTarget: label will pop this and replace destination with its basic block" (jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new]) addLast: (instr _ self add: (IRJumpIf new boolean: boolean)). self startNewSequence. instr otherwise: currentSequence. ! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:44'! jumpBackTarget: labelSymbol "Remember this basic block for a future jumpBackTo: labelSymbol. Stack up remembered targets with same name and remove them from stack for each jumpBackTo: called with same name." self startNewSequence. (jumpBackTargetStacks at: labelSymbol ifAbsentPut: [OrderedCollection new]) addLast: currentSequence. ! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:25'! jumpBackTo: labelSymbol "Pop last remembered position with this label and write an unconditional jump to it" | sequence | sequence _ (jumpBackTargetStacks at: labelSymbol ifAbsent: [self error: 'Missing jumpBackTarget: ', labelSymbol printString]) removeLast. self add: (IRJump new destination: sequence). self startNewSequence. ! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'! popTop self add: IRInstruction popTop! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'! pushDup self add: IRInstruction pushDup! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'! pushLiteral: object self add: (IRInstruction pushLiteral: object)! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 14:52'! pushReceiver self add: (IRInstruction pushTemp: 0)! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/17/2003 11:06'! pushTemp: key | index | index _ tempMap at: key. self add: (IRInstruction pushTemp: index)! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 14:52'! pushThisContext self add: (IRInstruction pushTemp: -1)! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/15/2003 01:55'! remoteReturn self add: IRInstruction remoteReturn. self startNewSequence. ! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/15/2003 01:55'! returnTop self add: IRInstruction returnTop. self startNewSequence. ! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'! send: selector self add: (IRInstruction send: selector)! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'! send: selector toSuperOf: behavior self add: (IRInstruction send: selector toSuperOf: behavior)! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 15:03'! setField: instVarIndex "receiver must be on top with new field value underneath" self pushLiteral: instVarIndex. self send: #storeIn:instVar:. ! ! !IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/17/2003 11:06'! storeTemp: key | index | index _ tempMap at: key. self add: (IRInstruction storeTemp: index)! ! !IRBuilder methodsFor: 'private' stamp: 'ajh 3/13/2003 13:20'! add: instr "Associate instr with current parse node or byte range" instr sourceNode: self sourceNode. instr bytecodeIndex: self sourceByteIndex. ^ currentSequence add: instr! ! !IRBuilder methodsFor: 'private' stamp: 'ajh 3/17/2003 11:06'! initialize ir _ IRMethod new. tempMap _ Dictionary new. jumpAheadStacks _ IdentityDictionary new. jumpBackTargetStacks _ IdentityDictionary new. sourceMapNodes _ OrderedCollection new. "stack" "Leave an empty sequence up front (guaranteed not to be in loop)" ir startSequence: (IRSequence new orderNumber: 0). currentSequence _ IRSequence new orderNumber: 1. ir startSequence add: (IRJump new destination: currentSequence). ! ! !IRBuilder methodsFor: 'private' stamp: 'ajh 3/10/2003 17:45'! startNewSequence "End current instruction sequence and start a new sequence to add instructions to. If ending block just falls through to new block then add an explicit jump to it so they stay linked" | newSequence | currentSequence isEmpty ifTrue: [^ self]. "block is still empty, continue using it" newSequence _ IRSequence new orderNumber: currentSequence orderNumber + 1. currentSequence last isJumpOrReturn ifFalse: [ self add: (IRJump new destination: newSequence)]. currentSequence _ newSequence. ! ! !IRBuilder methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:17'! mapToByteIndex: index "decompiling" sourceMapByteIndex _ index! ! !IRBuilder methodsFor: 'mapping' stamp: 'ajh 6/22/2003 14:45'! mapToNode: object "new instructions will be associated with object" sourceMapNodes addLast: object! ! !IRBuilder methodsFor: 'mapping' stamp: 'ajh 6/22/2003 14:25'! popMap sourceMapNodes removeLast! ! !IRBuilder methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:19'! sourceByteIndex "decompiling" ^ sourceMapByteIndex! ! !IRBuilder methodsFor: 'mapping' stamp: 'ajh 6/22/2003 21:03'! sourceNode ^ sourceMapNodes isEmpty ifTrue: [nil] ifFalse: [sourceMapNodes last]! ! !IRBuilder methodsFor: 'results' stamp: 'ajh 3/10/2003 15:51'! ir ^ ir! ! !IRBuilder methodsFor: 'decompiling' stamp: 'ajh 6/22/2003 14:44'! addJumpBackTarget: label to: sequence (jumpBackTargetStacks at: label ifAbsentPut: [OrderedCollection new]) addLast: sequence! ! !IRBuilder methodsFor: 'decompiling' stamp: 'ajh 3/21/2003 01:48'! testJumpAheadTarget: label jumpAheadStacks at: label ifPresent: [:stack | [stack isEmpty] whileFalse: [self jumpAheadTarget: label] ]! ! !IRBuilder class methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 17:56'! new ^ super new initialize! ! !IRInstruction methodsFor: 'accessing' stamp: 'ajh 3/6/2003 14:32'! executeOn: interpreter "Send approriate message to interpreter" self subclassResponsibility! ! !IRInstruction methodsFor: 'accessing' stamp: 'ajh 3/6/2003 14:32'! successorSequences "sent to last instruction in sequence which is expected to be a jump and return instruction" ^ #()! ! !IRInstruction methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:12'! isConstant: valueTest ^ false! ! !IRInstruction methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:19'! isGoto "is unconditional jump" ^ false! ! !IRInstruction methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:21'! isIf ^ false! ! !IRInstruction methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:22'! isJump "goto or if" ^ false! ! !IRInstruction methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:13'! isJumpOrReturn ^ self isJump or: [self isReturn]! ! !IRInstruction methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:09'! isReturn ^ false! ! !IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:07'! bytecodeIndex ^ bytecodeIndex! ! !IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:14'! bytecodeIndex: index bytecodeIndex _ index! ! !IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/6/2003 14:32'! sourceNode ^ sourceNode ! ! !IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/6/2003 14:32'! sourceNode: parseNode sourceNode _ parseNode ! ! !IRConstant methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:43'! constant ^ constant! ! !IRConstant methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:43'! constant: object constant _ object! ! !IRConstant methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:46'! executeOn: interpreter ^ interpreter pushLiteral: constant! ! !IRConstant methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 16:12'! isConstant: valueTest ^ valueTest value: constant! ! !IRDup methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:46'! executeOn: interpreter ^ interpreter pushDup! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:07'! goto: seq ^ IRJump new destination: seq! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:07'! if: bool goto: seq1 otherwise: seq2 ^ IRJumpIf new boolean: bool; destination: seq1; otherwise: seq2! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:07'! popTop ^ IRPop new! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'! pushDup ^ IRDup new! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'! pushLiteral: object ^ IRConstant new constant: object! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/12/2003 12:16'! pushTemp: index ^ IRTemp new number: index; isStore: false! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'! remoteReturn ^ IRReturn new isRemote: true! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'! returnTop ^ IRReturn new isRemote: false! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'! send: selector ^ IRSend new selector: selector! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'! send: selector toSuperOf: behavior ^ IRSend new selector: selector; superOf: behavior! ! !IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/12/2003 12:16'! storeTemp: index ^ IRTemp new number: index; isStore: true! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 13:26'! goto: seqNum! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 13:26'! if: bool goto: seqNum1 otherwise: seqNum2! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 13:25'! label: seqNum! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 14:11'! popTop! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 14:12'! pushDup! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:08'! pushLiteral: object! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:09'! pushTemp: index! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:10'! remoteReturn! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:08'! returnTop! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:11'! send: selector! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:11'! send: selector toSuperOf: behavior! ! !IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:11'! storeTemp: index! ! !IRInterpreter methodsFor: 'interpret' stamp: 'ajh 3/9/2003 12:33'! interpret: ir self interpretAll: ir allSequences! ! !IRInterpreter methodsFor: 'interpret' stamp: 'ajh 3/10/2003 23:30'! interpretAll: irSequences irSequences do: [:seq | self interpretSequence: seq]! ! !IRInterpreter methodsFor: 'interpret' stamp: 'ajh 3/6/2003 15:31'! interpretInstruction: irInstruction irInstruction executeOn: self! ! !IRInterpreter methodsFor: 'interpret' stamp: 'ajh 3/9/2003 13:20'! interpretSequence: instructionSequence self label: instructionSequence orderNumber. instructionSequence do: [:instr | self interpretInstruction: instr]. ! ! !IRJump methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 23:08'! destination ^ destination! ! !IRJump methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 23:08'! destination: sequence destination _ sequence! ! !IRJump methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:47'! executeOn: interpreter ^ interpreter goto: destination orderNumber! ! !IRJump methodsFor: 'as yet unclassified' stamp: 'ajh 3/11/2003 00:19'! isGoto "is unconditional jump" ^ true! ! !IRJump methodsFor: 'as yet unclassified' stamp: 'ajh 3/11/2003 00:22'! isJump "goto or if" ^ true! ! !IRJump methodsFor: 'as yet unclassified' stamp: 'ajh 3/11/2003 00:02'! successorSequences ^ {destination}! ! !IRJumpIf methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:43'! boolean ^ boolean! ! !IRJumpIf methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:43'! boolean: bool boolean _ bool! ! !IRJumpIf methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:47'! executeOn: interpreter ^ interpreter if: boolean goto: destination orderNumber otherwise: otherwise orderNumber! ! !IRJumpIf methodsFor: 'as yet unclassified' stamp: 'ajh 3/11/2003 00:19'! isGoto "is unconditional jump" ^ false! ! !IRJumpIf methodsFor: 'as yet unclassified' stamp: 'ajh 3/11/2003 00:21'! isIf ^ true! ! !IRJumpIf methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:43'! otherwise ^ otherwise! ! !IRJumpIf methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:44'! otherwise: sequence otherwise _ sequence! ! !IRJumpIf methodsFor: 'as yet unclassified' stamp: 'ajh 3/11/2003 00:02'! successorSequences ^ {destination. otherwise}! ! !IRMethod methodsFor: 'initialize' stamp: 'ajh 3/17/2003 11:07'! initialize primitiveNode _ PrimitiveNode null. rargKeys _ #(self). otherTempKeys _ #(). ! ! !IRMethod methodsFor: 'initialize' stamp: 'ajh 3/17/2003 11:04'! otherTempKeys: tempKeys otherTempKeys _ tempKeys! ! !IRMethod methodsFor: 'initialize' stamp: 'ajh 3/10/2003 23:08'! primitiveNode: aPrimitiveNode primitiveNode _ aPrimitiveNode! ! !IRMethod methodsFor: 'initialize' stamp: 'ajh 3/17/2003 11:12'! rargKeys: tempKeys rargKeys _ tempKeys! ! !IRMethod methodsFor: 'initialize' stamp: 'ajh 3/10/2003 17:52'! startSequence: irSequence startSequence _ irSequence! ! !IRMethod methodsFor: 'accessing' stamp: 'ajh 3/9/2003 15:35'! allSequences ^ startSequence withAllSuccessors! ! !IRMethod methodsFor: 'accessing' stamp: 'ajh 3/17/2003 11:11'! numArgs ^ rargKeys size - 1! ! !IRMethod methodsFor: 'accessing' stamp: 'ajh 3/17/2003 11:07'! otherTempKeys ^ otherTempKeys! ! !IRMethod methodsFor: 'accessing' stamp: 'ajh 3/10/2003 18:10'! primitiveNode ^ primitiveNode! ! !IRMethod methodsFor: 'accessing' stamp: 'ajh 3/17/2003 11:13'! rargKeys ^ rargKeys! ! !IRMethod methodsFor: 'accessing' stamp: 'ajh 3/10/2003 17:53'! startSequence ^ startSequence! ! !IRMethod methodsFor: 'accessing' stamp: 'ajh 3/17/2003 11:07'! tempKeys ^ rargKeys allButFirst, otherTempKeys! ! !IRMethod methodsFor: 'printing' stamp: 'ajh 3/9/2003 15:53'! longPrintOn: stream IRPrinter new indent: 0; stream: stream; interpret: self! ! !IRMethod methodsFor: 'optimizing' stamp: 'ajh 3/10/2003 15:45'! absorbConstantConditionalJumps startSequence absorbConstantConditionalJumps: IdentitySet new! ! !IRMethod methodsFor: 'optimizing' stamp: 'ajh 3/10/2003 15:45'! absorbJumpsToSingleInstrs startSequence absorbJumpToSingleInstr: IdentitySet new! ! !IRMethod methodsFor: 'optimizing' stamp: 'ajh 3/18/2003 19:05'! optimize self removeEmptyStart. self absorbJumpsToSingleInstrs. "do before next to get in right form" self absorbConstantConditionalJumps. self absorbJumpsToSingleInstrs. "do again since new opportunities may have arised after last step" ! ! !IRMethod methodsFor: 'optimizing' stamp: 'ajh 3/18/2003 19:25'! removeEmptyStart startSequence size = 1 ifTrue: [ "startSeq is just unconditional jump, forget it" startSequence _ startSequence last destination]. ! ! !IRMethod methodsFor: 'translating' stamp: 'ajh 3/10/2003 15:55'! compiledMethod ^ compiledMethod ifNil: [self compiledMethodWith: #(0)]! ! !IRMethod methodsFor: 'translating' stamp: 'ajh 3/15/2003 02:02'! compiledMethodWith: trailer ^ compiledMethod _ IRTranslator new interpret: self; compiledMethodWith: trailer! ! !IRMethod methodsFor: 'translating' stamp: 'ajh 3/10/2003 15:54'! privCompiledMethod: aCompiledMethod compiledMethod _ aCompiledMethod! ! !IRMethod methodsFor: 'mapping' stamp: 'ajh 3/19/2003 13:38'! sourceMap "Return a mapping from bytecode pcs to source code ranges" | start map | "Besides getting start position, make sure bytecodeIndices are filled in" start _ self compiledMethod initialPC - 1. map _ OrderedCollection new. self allSequences do: [:seq | seq do: [:instr | | node | ((node _ instr sourceNode) notNil and: [node debugHighlightStart notNil and: [node debugHighlightStop notNil and: [instr bytecodeIndex notNil]]]) ifTrue: [ map add: instr bytecodeIndex + start -> (node debugHighlightStart to: node debugHighlightStop)] ] ]. ^ map! ! !IRMethod class methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 23:17'! new ^ super new initialize! ! !IRPop methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:47'! executeOn: interpreter ^ interpreter popTop! ! !IRPrinter methodsFor: 'initialize' stamp: 'ajh 3/9/2003 15:49'! indent: tabs indent _ tabs! ! !IRPrinter methodsFor: 'initialize' stamp: 'ajh 3/9/2003 15:50'! stream: stringWriteStream stream _ stringWriteStream! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:41'! goto: seqNum stream nextPutAll: 'goto: '. seqNum printOn: stream. ! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:42'! if: bool goto: seqNum1 otherwise: seqNum2 stream nextPutAll: 'if: '. bool printOn: stream. stream nextPutAll: ' goto: '. seqNum1 printOn: stream. stream nextPutAll: ' else: '. seqNum2 printOn: stream. ! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/11/2003 00:36'! label: seqNum "add tab and cr since this does not get called within interpretInstruction:" stream cr. "extra cr just to space out sequences" indent timesRepeat: [stream tab]. stream nextPutAll: 'label: '. seqNum printOn: stream. stream cr. ! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:42'! popTop stream nextPutAll: 'popTop'! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:42'! pushDup stream nextPutAll: 'pushDup'! ! !IRPrinter methodsFor: 'instructions' stamp: 'md 11/21/2003 12:16'! pushLiteral: object stream nextPutAll: 'pushLiteral: '. object isVariableBinding ifTrue: [^ stream nextPutAll: object key]. object printOn: stream. ((object isBlockClosure) or: [object isCompiledMethod]) ifTrue: [ IRPrinter new indent: indent + 1; stream: stream; interpret: object method ir removeEmptyStart]. ! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/10/2003 14:12'! pushTemp: index stream nextPutAll: 'pushTemp: '. index printOn: stream. index = 0 ifTrue: [stream nextPutAll: ' "receiver"']. index = -1 ifTrue: [stream nextPutAll: ' "thisContext"']. ! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:43'! remoteReturn stream nextPutAll: 'remoteReturn'. ! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:43'! returnTop stream nextPutAll: 'returnTop'. ! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:44'! send: selector stream nextPutAll: 'send: '. selector printOn: stream. ! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:44'! send: selector toSuperOf: behavior stream nextPutAll: 'send: '. selector printOn: stream. stream nextPutAll: ' toSuperOf: '. behavior printOn: stream. ! ! !IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:44'! storeTemp: index stream nextPutAll: 'storeTemp: '. index printOn: stream. ! ! !IRPrinter methodsFor: 'interpret' stamp: 'ajh 3/9/2003 15:48'! interpretInstruction: irInstruction indent timesRepeat: [stream tab]. super interpretInstruction: irInstruction. stream cr. ! ! !IRReturn methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:48'! executeOn: interpreter ^ isRemote ifTrue: [interpreter remoteReturn] ifFalse: [interpreter returnTop]! ! !IRReturn methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:44'! isRemote ^ isRemote! ! !IRReturn methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:44'! isRemote: boolean isRemote _ boolean! ! !IRReturn methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 16:10'! isReturn ^ true! ! !IRSend methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:48'! executeOn: interpreter ^ superOf ifNil: [interpreter send: selector] ifNotNil: [interpreter send: selector toSuperOf: superOf]! ! !IRSend methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:44'! selector ^ selector! ! !IRSend methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:44'! selector: symbol selector _ symbol! ! !IRSend methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:45'! superOf ^ superOf! ! !IRSend methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:45'! superOf: behavior superOf _ behavior! ! !IRSequence methodsFor: 'comparing' stamp: 'ajh 3/11/2003 00:29'! = other "Override collection equal with identity equal" ^ self == other! ! !IRSequence methodsFor: 'comparing' stamp: 'ajh 6/18/2002 15:09'! hash ^ self identityHash! ! !IRSequence methodsFor: 'successor sequences' stamp: 'ajh 3/19/2003 22:22'! nextSequence | sequences i | sequences _ self withAllSuccessors. i _ sequences findFirst: [:seq | seq orderNumber = self orderNumber]. (i = 0 or: [i = sequences size]) ifTrue: [^ nil]. ^ sequences at: i + 1! ! !IRSequence methodsFor: 'successor sequences' stamp: 'ajh 3/19/2003 01:24'! successorSequences self isEmpty ifTrue: [^ #()]. ^ self last successorSequences! ! !IRSequence methodsFor: 'successor sequences' stamp: 'ajh 9/26/2002 16:14'! withAllSuccessors "Return me and all my successors sorted by sequence orderNumber" | list | list _ OrderedCollection new: 20. self withAllSuccessorsDo: [:seq | list add: seq]. ^ list asSortedCollection: [:x :y | x orderNumber <= y orderNumber]! ! !IRSequence methodsFor: 'successor sequences' stamp: 'ajh 7/18/2002 01:37'! withAllSuccessorsDo: block "Iterate over me and all my successors only once" self withAllSuccessorsDo: block alreadySeen: IdentitySet new! ! !IRSequence methodsFor: 'successor sequences' stamp: 'ajh 3/6/2003 01:31'! withAllSuccessorsDo: block alreadySeen: set "Iterate over me and all my successors only once" (set includes: self) ifTrue: [^ self]. set add: self. block value: self. self successorSequences do: [:seq | seq ifNotNil: [seq withAllSuccessorsDo: block alreadySeen: set]]. ! ! !IRSequence methodsFor: 'optimizing' stamp: 'ajh 3/13/2003 00:26'! absorbConstantConditionalJumps: alreadySeen "Collapse sequences that look like: [if] goto s1 ... s1: pushConst: true/false goto s2 s2: if true/false goto s3 else s4 into: [if] goto s3/s4 These sequences are produced by and:/or: messages" | seq bool if | (alreadySeen includes: self) ifTrue: [^ self]. alreadySeen add: self. [(seq _ self successorSequences) size > 0 "not return" and: [(seq _ seq first "destination") size = 2 and: [(seq first isConstant: [:obj | (bool _ obj) isKindOf: Boolean]) and: [seq last isGoto and: [(if _ seq last destination first) isIf]]]] ] whileTrue: [ "absorb" self last destination: (bool == if boolean ifTrue: [if destination] ifFalse: [if otherwise]). ]. self successorSequences do: [:instrs | instrs absorbConstantConditionalJumps: alreadySeen]. ! ! !IRSequence methodsFor: 'optimizing' stamp: 'ajh 3/20/2003 00:10'! absorbJumpToSingleInstr: alreadySeen "Collapse jumps to single return instructions into caller" | seqs seq | (alreadySeen includes: self) ifTrue: [^ self]. alreadySeen add: self. [ (seqs _ self successorSequences) size = 1 "unconditional jump..." and: [(seq _ seqs first) size = 1 "...to single instruction..." and: [seq successorSequences size < 2]] "...but don't collapse conditional jumps so their otherwiseSequences can stay right after them" ] whileTrue: [ "replace goto with single instruction" self removeLast. seq do: [:instr | self add: instr copy]. ]. seqs do: [:instrs | instrs absorbJumpToSingleInstr: alreadySeen]. ! ! !IRSequence methodsFor: 'printing' stamp: 'ajh 3/11/2003 00:57'! longPrintOn: stream [IRPrinter new indent: 0; stream: stream; interpretSequence: self ] onDNU: #orderNumber do: [:ex | ex resume: ex receiver]! ! !IRSequence methodsFor: 'printing' stamp: 'ajh 3/11/2003 00:25'! printOn: stream stream nextPutAll: 'an '. self class printOn: stream. stream space. stream nextPut: $(. self orderNumber printOn: stream. stream nextPut: $). ! ! !IRSequence methodsFor: 'manipulating' stamp: 'ajh 3/19/2003 22:25'! splitAfter: instruction | newSeq instr next | next _ self nextSequence. next _ next ifNil: [self orderNumber + 1] ifNotNil: [(next orderNumber + self orderNumber) / 2]. newSeq _ IRSequence new orderNumber: next. instr _ instruction. [(instr _ instr nextLink) isNil] whileFalse: [newSeq add: instr]. instruction nextLink: nil. lastLink _ instruction. self add: (IRJump new destination: newSeq). ^ newSeq! ! !IRSequence methodsFor: 'initializing' stamp: 'ajh 7/18/2002 01:23'! orderNumber: n "Sequences are sorted by this number" orderNumber _ n! ! !IRSequence methodsFor: 'accessing' stamp: 'ajh 7/18/2002 01:23'! orderNumber "Sequences are sorted by this number" ^ orderNumber! ! !IRTemp methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 12:18'! executeOn: interpreter ^ isStore ifTrue: [interpreter storeTemp: number] ifFalse: [interpreter pushTemp: number]! ! !IRTemp methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:45'! isStore ^ isStore! ! !IRTemp methodsFor: 'as yet unclassified' stamp: 'ajh 3/10/2003 00:45'! isStore: boolean isStore _ boolean! ! !IRTemp methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 12:17'! number ^ number! ! !IRTemp methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 12:16'! number: n number _ n! ! !IRTranslator methodsFor: 'initialize' stamp: 'ajh 3/9/2003 22:02'! initialize gen _ BytecodeGenerator new. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:09'! goto: seqNum self doPending. gen goto: seqNum. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:09'! if: bool goto: seqNum1 otherwise: seqNum2 self doPending. gen if: bool goto: seqNum1 otherwise: seqNum2. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:10'! label: seqNum pending _ OrderedCollection new. gen label: seqNum. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:35'! popTop "if last was storeTemp or storeInstVar then convert to storePopTemp or storePopInstVar" #storeTemp: == self pendingSelector ifTrue: [ ^ self pendingSelector: #storePopTemp:]. #storeInstVar: == self pendingSelector ifTrue: [ ^ self pendingSelector: #storePopInstVar:]. "otherwise do normal pop" self doPending. gen popTop. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:10'! pushDup self doPending. gen pushDup. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/12/2003 11:58'! pushLiteral: object self addPending: (Message selector: #pushLiteral: argument: object)! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 23:39'! pushTemp: index index = 0 ifTrue: [ ^ self addPending: (Message selector: #pushReceiver)]. (self pendingMatches: { [:m | m selector == #storePopTemp: and: [m argument = index]]} ) ifTrue: [ ^ self pendingSelector: #storeTemp:]. self doPending. index = -1 ifTrue: [^ gen pushThisContext]. gen pushTemp: index. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:12'! remoteReturn self doPending. gen remoteReturn. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/10/2003 16:27'! returnTop #pushReceiver == self pendingSelector ifTrue: [ self pendingSelector: #returnReceiver. ^ self doPending ]. #pushLiteral: == self pendingSelector ifTrue: [ self pendingSelector: #returnConstant:. ^ self doPending ]. #pushInstVar: == self pendingSelector ifTrue: [ self pendingSelector: #returnInstVar:. ^ self doPending ]. self doPending. gen returnTop. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 04:26'! send: selector "If get/set inst var, access it directly" | index | ((#(getInstVar: #storeIn:instVar:) identityIncludes: selector) and: [self pendingMatches: { [:m | m selector == #pushReceiver]. [:m | m selector == #pushLiteral: and: [m argument isInteger]]}] ) ifTrue: [ index _ self popPending argument. self popPending. "pop pushReceiver" self addPending: (Message selector: (selector == #getInstVar: ifTrue: [#pushInstVar:] ifFalse: [#storeInstVar:]) argument: index). (self pendingMatches: { [:m | m selector == #storePopInstVar: and: [m argument = index]]. [:m | m selector == #pushInstVar: and: [m argument = index]]} ) ifTrue: [ self popPending. self pendingSelector: #storeInstVar:. ]. ^ self ]. "otherwise do normal send" self doPending. gen send: selector. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:14'! send: selector toSuperOf: behavior self doPending. gen send: selector toSuperOf: behavior. ! ! !IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/12/2003 11:58'! storeTemp: index self addPending: (Message selector: #storeTemp: argument: index)! ! !IRTranslator methodsFor: 'interpret' stamp: 'ajh 3/15/2003 02:02'! interpret: ir ir optimize. gen primitiveNode: ir primitiveNode. gen numArgs: ir numArgs. super interpret: ir. ! ! !IRTranslator methodsFor: 'interpret' stamp: 'ajh 3/13/2003 18:07'! interpretAll: irSequences irSequences withIndexDo: [:seq :i | seq orderNumber: i]. super interpretAll: irSequences. ! ! !IRTranslator methodsFor: 'interpret' stamp: 'ajh 3/13/2003 04:50'! interpretInstruction: irInstruction currentInstr _ irInstruction. super interpretInstruction: irInstruction. ! ! !IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/22/2003 14:54'! addPending: message pending addLast: currentInstr -> message! ! !IRTranslator methodsFor: 'priv pending' stamp: 'ajh 3/13/2003 04:49'! doPending "execute pending instructions" | assoc | [pending isEmpty] whileFalse: [ assoc _ pending removeFirst. gen mapBytesTo: assoc key "instr". assoc value "message" sendTo: gen. ]. gen mapBytesTo: currentInstr. ! ! !IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/5/2003 12:41'! pendingMatches: blocks "Return true if each message at end of pending list satisfies its corresponding block. The number of elements tested equals the number of blocks. If not enough elements return false" | messages i | messages _ pending collect: [:assoc | assoc value]. blocks size > messages size ifTrue: [^ false]. i _ messages size - blocks size. blocks do: [:b | (b value: (messages at: (i _ i + 1))) ifFalse: [^ false]. ]. ^ true! ! !IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/22/2003 21:06'! pendingSelector pending isEmpty ifTrue: [^ nil]. ^ pending last value "message" selector! ! !IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/22/2003 21:06'! pendingSelector: selector pending last value "message" setSelector: selector! ! !IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/22/2003 14:27'! popPending ^ pending removeLast value "message"! ! !IRTranslator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:28'! compiledMethodWith: trailer ^ gen compiledMethodWith: trailer! ! !LiteralList methodsFor: 'adding' stamp: 'ajh 3/6/2003 18:00'! addLast: object "Only add if not already in list" (equalitySet includes: object) ifTrue: [^ object]. equalitySet add: object. super addLast: object. ^ object ! ! !LiteralList methodsFor: 'private' stamp: 'ajh 1/21/2003 12:21'! setCollection: anArray super setCollection: anArray. equalitySet _ LiteralSet new: anArray size. ! ! !LiteralList methodsFor: 'accessing' stamp: 'ajh 1/21/2003 12:21'! indexOf: anElement startingAt: start ifAbsent: exceptionBlock start to: self size do: [:index | ((self at: index) literalEqual: anElement) ifTrue: [^ index]]. ^ exceptionBlock value! ! !LiteralSet methodsFor: 'as yet unclassified' stamp: 'ajh 12/9/2001 16:03'! add: newObject "Include newObject as one of the receiver's elements. If equivalent is already present don't add and return equivalent object" | index | newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element']. index _ self findElementOrNil: newObject. ^ (array at: index) ifNil: [self atNewIndex: index put: newObject. newObject] ifNotNil: [array at: index]! ! !LiteralSet methodsFor: 'as yet unclassified' stamp: 'ajh 2/2/2002 19:16'! scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." | element start finish | start _ (anObject hash \\ array size) + 1. finish _ array size. "Search from (hash mod size) to the end." start to: finish do: [:index | ((element _ array at: index) == nil or: [element literalEqual: anObject]) ifTrue: [^ index ]]. "Search from 1 to where we started." 1 to: start-1 do: [:index | ((element _ array at: index) == nil or: [element literalEqual: anObject]) ifTrue: [^ index ]]. ^ 0 "No match AND no empty slot"! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:37'! num ^ primitiveNum! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:23'! num: n primitiveNum _ n! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 12:26'! printOn: aStream aStream nextPutAll: 'primitive '; print: primitiveNum! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/19/2003 22:06'! printPrimitiveOn: aStream "Print the primitive on aStream" | primIndex primDecl | primIndex _ primitiveNum. primIndex = 0 ifTrue: [^ self]. primIndex = 120 ifTrue: [ "External call spec" ^ aStream print: spec]. aStream nextPutAll: '. (primIndex ~= 117 and: [primIndex ~= 120]) ifTrue: [ Smalltalk at: #Interpreter ifPresent: [:cls | aStream nextPutAll: ' "', ((cls classPool at: #PrimitiveTable) at: primIndex + 1) , '" ' ]. ]. ! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/19/2003 22:02'! sourceText ^ String streamContents: [:stream | self printPrimitiveOn: stream]! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:37'! spec ^ spec! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:30'! spec: literal spec _ literal! ! !PrimitiveNode class methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:47'! null ^ self new num: 0! ! !StackCount methodsFor: 'initialize' stamp: 'ajh 3/13/2003 01:48'! startAt: pos start _ position _ length _ pos! ! !StackCount methodsFor: 'affecting' stamp: 'ajh 3/13/2003 01:32'! pop ^ self pop: 1! ! !StackCount methodsFor: 'affecting' stamp: 'ajh 3/13/2003 01:32'! pop: n (position _ position - n) "< 0 ifTrue: [self error: 'Parse stack underflow']"! ! !StackCount methodsFor: 'affecting' stamp: 'ajh 3/13/2003 01:32'! push ^ self push: 1! ! !StackCount methodsFor: 'affecting' stamp: 'ajh 3/13/2003 01:32'! push: n (position _ position + n) > length ifTrue: [length _ position]! ! !StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:32'! length ^length! ! !StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 18:37'! linkTo: stackOrNil stackOrNil ifNil: [^ self class startAt: self position]. ^ self position = stackOrNil start ifTrue: [stackOrNil] ifFalse: [self errorStackOutOfSync: stackOrNil]! ! !StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:32'! position ^position! ! !StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:32'! size ^length! ! !StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:36'! start ^ start! ! !StackCount methodsFor: 'printing' stamp: 'ajh 3/13/2003 01:38'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' start '; print: start; nextPutAll: ' stop '; print: position; nextPutAll: ' max '; print: length. ! ! !StackCount methodsFor: 'comparing' stamp: 'ajh 3/13/2003 01:39'! = other ^ self class == other class and: [start = other start and: [position = other position and: [length = other size]]]! ! !StackCount methodsFor: 'comparing' stamp: 'ajh 3/13/2003 01:51'! hash ^ position hash bitXor: (length hash bitXor: start hash)! ! !StackCount class methodsFor: 'as yet unclassified' stamp: 'ajh 3/13/2003 01:49'! new ^ super new startAt: 0! ! !StackCount class methodsFor: 'as yet unclassified' stamp: 'ajh 3/13/2003 01:49'! startAt: pos ^ super new startAt: pos! ! BytecodeGenerator initialize!