"====================================================================== | | CompiledCode Method Definitions | | $Revision: 1.7.5$ | $Date: 2000/05/28 16:56:52$ | $Author: pb$ | ======================================================================" "====================================================================== | | Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc. | Written by Steve Byrne. | | This file is part of the GNU Smalltalk class library. | | The GNU Smalltalk class library is free software; you can redistribute it | and/or modify it under the terms of the GNU Lesser General Public License | as published by the Free Software Foundation; either version 2.1, or (at | your option) any later version. | | The GNU Smalltalk class library is distributed in the hope that it will be | useful, but WITHOUT ANY WARRANTY; without even the implied warranty of | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser | General Public License for more details. | | You should have received a copy of the GNU Lesser General Public License | along with the GNU Smalltalk class library; see the file COPYING.LESSER. | If not, write to the Free Software Foundation, 59 Temple Place - Suite | 330, Boston, MA 02111-1307, USA. | ======================================================================" ArrayedCollection variableByteSubclass: #CompiledCode instanceVariableNames: 'literals header ' classVariableNames: '' poolDictionaries: '' category: 'Language-Implementation' ! CompiledCode comment: 'I represent code that has been compiled. I am an abstract superclass for blocks and methods' ! !CompiledCode class methodsFor: 'instance creation'! newMethod: numBytecodes header: anInteger numLiterals: numLiterals "Answer a new CompiledMethod with room for the given bytes and the given header" ^(self new: numBytecodes) header: anInteger literals: (Array new: numLiterals) ! newMethod: numBytecodes header: anInteger literals: literals "Answer a new CompiledMethod with room for the given bytes and the given header" ^(self new: numBytecodes) header: anInteger literals: literals ! ! !CompiledCode methodsFor: 'basic'! methodCategory "Answer the method category" self subclassResponsibility ! methodCategory: aCategory "Set the method category to the given string" self subclassResponsibility ! methodSourceCode "Answer the method source code (a FileSegment or String or nil)" self subclassResponsibility ! methodSourceString "Answer the method source code as a string" self subclassResponsibility ! methodSourceFile "Answer the file where the method source code is stored" self subclassResponsibility ! methodSourcePos "Answer the location where the method source code is stored in the methodSourceFile" self subclassResponsibility ! = aMethod "Answer whether the receiver and aMethod are equal" self == aMethod ifTrue: [ ^true ]. self class == aMethod class ifFalse: [ ^false ]. header = aMethod getHeader ifFalse: [ ^false ]. 1 to: self numLiterals do: [ :i | (self literalAt: i) = (aMethod literalAt: i) ifFalse: [ ^false ] ]. 1 to: self numBytecodes do: [ :i | (self bytecodeAt: i) = (aMethod bytecodeAt: i) ifFalse: [ ^false ] ]. ^true ! hash "Answer an hash value for the receiver" | hashValue | hashValue := (header hash bitAnd: 16r1FFFFFFF) + (literals hash bitAnd: 16r1FFFFFFF). 1 to: self basicSize do: [ :i | hashValue := ((hashValue bitShift: 1) bitAnd: 16r1FFFFFFF) + (self basicAt: i) ]. ^hashValue ! ! !CompiledCode methodsFor: 'accessing'! at: anIndex put: aBytecode "Store aBytecode as the anIndex-th bytecode" self basicAt: anIndex put: aBytecode. CompiledMethod flushTranslatorCache. ^aBytecode ! methodClass "Answer the class in which the receiver is installed." self subclassResponsibility ! methodClass: methodClass "Set the receiver's class instance variable" self subclassResponsibility ! selector: aSymbol "Set the selector through which the method is called" self subclassResponsibility ! selector "Answer the selector through which the method is called" self subclassResponsibility ! literals ^literals ! literalAt: anIndex "Answer the anIndex-th literal" ^literals at: anIndex ! literalAt: anInteger put: aValue "Store aValue as the anIndex-th literal" ^literals at: anInteger put: aValue ! bytecodeAt: anIndex "Answer the anIndex-th bytecode" ^self basicAt: (anIndex + self bytecodeStart) ! bytecodeAt: anIndex put: aBytecode "Store aBytecode as the anIndex-th bytecode" self basicAt: (anIndex + self bytecodeStart) put: aBytecode. CompiledMethod flushTranslatorCache. ^aBytecode ! flags "Private - Answer the optimization flags for the receiver" ^0 ! primitive "Answer the primitive called by the receiver" ^0 ! numArgs "Answer the number of arguments for the receiver" self subclassResponsibility ! numTemps "Answer the number of temporaries for the receiver" self subclassResponsibility ! stackDepth "Answer the number of stack slots needed for the receiver" self subclassResponsibility ! numLiterals "Answer the number of literals for the receiver" ^literals size ! ! !CompiledCode methodsFor: 'copying'! deepCopy "Answer a deep copy of the receiver" ^self shallowCopy postCopy ! ! !CompiledCode methodsFor: 'debugging'! inspect "Print the contents of the receiver in a verbose way." | class instVars lit | class := self class. instVars := class allInstVarNames. Transcript nextPutAll: 'An instance of '; print: class; nl. 2 to: instVars size do: [ :i | Transcript nextPutAll: ' '; nextPutAll: (instVars at: i); nextPutAll: ': '; print: (self instVarAt: i); nl. i = 2 ifTrue: [ self printHeaderOn: Transcript ]. ]. self numLiterals > 0 ifTrue: [ Transcript nextPutAll: ' literals: ['; nl. 1 to: self numLiterals do: [ :i | Transcript nextPutAll: ' ['; print: (i - 1); nextPutAll: ']: '. lit := self literalAt: i. "Avoid an infinite loop" (lit class == Association) ifTrue: [ Transcript nextPutAll: '(Reference to global/pool variable ', lit key, ')'; nl ] ifFalse: [ lit printNl ]. ]. Transcript nextPutAll: ' ]'; nl ]. Transcript nextPutAll: ' byte codes: ['; nl. self printByteCodesOn: Transcript. Transcript nextPutAll: ' ]'; nl. ! ! !CompiledCode methodsFor: 'debugging'! breakpointAt: byteIndex "Put a break-point at the given bytecode" Debugger recordOldByte: (self bytecodeAt: byteIndex) atIndex: byteIndex forMethod: self. self bytecodeAt: byteIndex put: Debugger debugByte ! breakAtLine: lineNumber self notYetImplemented ! removeBreakpointAt: byteIndex "Remove the break-point at the given bytecode (don't fail if none was set" | oldByte | oldByte := Debugger origByteAt: byteIndex forMethod: self. oldByte notNil ifTrue: [ self bytecodeAt: byteIndex put: oldByte ] ! ! !CompiledCode methodsFor: 'testing accesses'! containsLiteral: anObject "Answer if the receiver contains a literal which is equal to anObject." | lit | 1 to: self numLiterals do: [ :i | lit := self literalAt: i. lit = anObject ifTrue: [^true ]. ]. ^false ! refersTo: anObject "Answer whether the receiver refers to the given object" | byte | (self containsLiteral: anObject) ifTrue: [ ^true ]. "Look for symbols referenced to by special message sends" byte := #(+ - < > <= >= = ~= * / \\ @ bitShift: // bitAnd: bitOr: at: at:put: size next nextPut: atEnd == class blockCopy: value value: do: new new: isNil notNil) indexOf: anObject ifAbsent: [ ^false ]. byte := byte + 175. self allByteCodeIndicesDo: [ :i :bytecode | byte = bytecode ifTrue: [^true]. ]. ^false ! hasBytecode: byte between: firstIndex and: lastIndex "Answer whether the receiver includes the `byte' bytecode in any of the indices between firstIndex and lastIndex." self allByteCodeIndicesDo: [ :i :bytecode | i > lastIndex ifTrue: [ ^false ]. (i >= firstIndex and: [ byte = bytecode ]) ifTrue: [^true]. ]. ^false ! jumpDestinationAt: anIndex "Answer where the jump at bytecode index `anIndex' lands" | byte ofs | byte := self bytecodeAt: anIndex. ofs := anIndex + 2. byte <= 159 ifTrue: [ ^(byte bitAnd: 7) + ofs]. ofs := (byte bitAnd: 3) * 256 + ofs. byte <= 163 ifTrue: [ ofs := ofs - 1024 ]. ^(self bytecodeAt: anIndex + 1) + ofs ! accesses: instVarIndex "Answer whether the receiver access the instance variable with the given index" | byte | self flags = 2 ifTrue: [ ^((header bitShift: -6) bitAnd: 16r1F) = instVarIndex]. self allByteCodeIndicesDo: [ :i :byte | (byte < 16) & (byte = instVarIndex) ifTrue: [^true]. "push" (byte >= 96) & (byte < 104) & (byte - 96 = instVarIndex) ifTrue: [^true]. "pop" (#[128 129 130 142] includes: byte) ifTrue: [ "2 byte stack operation" "This deserves an explanation. The correct test would be (nextByte < 64) & ((nextByte bitAnd: 63) = instVarIndex, but: a) if the next byte is < 64 the bitwise and has no effect; b) instVarIndex must be < 64, so the next byte must be < 64 too for it to be equal to instVarIndex... OUCH!!" (self bytecodeAt: i + 1) = instVarIndex ifTrue: [^true] ] ]. ^false ! ! !CompiledCode methodsFor: 'private-printing'! printHeaderOn: aStream "Private - Disassemble the method header to aStream" self subclassResponsibility ! printByteCodesOn: aStream "Private - Disassemble the bytecode instructions to aStream" self allByteCodeIndicesDo: [ :i :byte | self printByte: byte at: i on: aStream ] ! printByte: byte at: anIndex on: aStream "Private - Print the byte bytecode (starting at anIndex) on aStream" aStream nextPutAll: ' ['; print: anIndex; nextPutAll: ']: '. byte < 95 ifTrue: [ self printIndexedAt: anIndex on: aStream ]. (byte between: 96 and: 111) ifTrue: [ self emitSimplePop: byte on: aStream ]. (byte between: 112 and: 125) ifTrue: [ self emitBuiltin: byte on: aStream ]. byte == 126 ifTrue: [ self print3ByteOp: anIndex + 1 on: aStream ]. "127 is the debugger breakpoint and we don't get it here" byte == 128 ifTrue: [ self print2ByteStackOp: 'push' at: anIndex on: aStream ]. byte == 129 ifTrue: [ self print2ByteStoreOp: 'store' at: anIndex on: aStream ]. byte == 130 ifTrue: [ self print2ByteStoreOp: 'pop and store' at: anIndex on: aStream ]. (byte between: 131 and: 133) ifTrue: [ self emitIndexedSend: anIndex on: aStream ]. byte == 134 ifTrue: [ aStream nextPutAll: 'invalid bytecode 134!! ' ]. byte == 135 ifTrue: [ aStream nextPutAll: 'pop stack top ' ]. byte == 136 ifTrue: [ aStream nextPutAll: 'duplicate stack top' ]. byte == 137 ifTrue: [ aStream nextPutAll: 'push current context' ]. byte == 138 ifTrue: [ self emitOuterStackOp: anIndex + 1 on: aStream ]. byte == 139 ifTrue: [ aStream nextPutAll: 'no operation' ]. byte == 140 ifTrue: [ aStream nextPutAll: 'set stack top to self' ]. byte == 141 ifTrue: [ aStream nextPutAll: 'set stack top to 1' ]. byte == 142 ifTrue: [ self print2ByteStackOp: 'set stack top to' at: anIndex on: aStream ]. byte == 143 ifTrue: [ aStream nextPutAll: 'exit interpreter' ]. (byte between: 144 and: 175) ifTrue: [ self printJump: anIndex on: aStream ]. (byte between: 176 and: 191) ifTrue: [ aStream nextPutAll: 'send arithmetic message '. (#(+ - < > <= >= = ~= * / \\ @ bitShift: // bitAnd: bitOr:) at: byte - 175) printOn: aStream. ]. (byte between: 192 and: 207) ifTrue: [ aStream nextPutAll: 'send special message '. (#(at: at:put: size next nextPut: atEnd == class blockCopy: value value: do: new new: isNil notNil) at: byte - 191) printOn: aStream. ]. (byte between: 208 and: 255) ifTrue: [ self printSmallArgSend: byte on: aStream ]. aStream nextPut: (Character nl). ! printIndexedAt: anIndex on: aStream "Private - Print the push bytecode starting at anIndex on aStream, byte<=95" | byte index | byte := self bytecodeAt: anIndex. byte <= 15 ifTrue: [ ^self pushIndexed: 'Instance Variable' withIndex: (byte bitAnd: 15) on: aStream ]. byte <= 31 ifTrue: [ ^self pushIndexed: 'Temporary' withIndex: (byte bitAnd: 15) on: aStream ]. byte <= 63 ifTrue: [ ^self pushIndexed: 'Literal' withIndex: (byte bitAnd: 31) on: aStream ]. " >= 64 case here " aStream nextPutAll: 'push Global Variable['. (byte bitAnd: 31) printOn: aStream. aStream nextPutAll: '] = '. self printAssociationKeyFor: (byte bitAnd: 31) on: aStream ! pushIndexed: indexLabel withIndex: anIndex on: aStream "Private - Print a push bytecode on aStream" aStream nextPutAll: 'push '. aStream nextPutAll: indexLabel. aStream nextPut: $[. aStream print: anIndex. aStream nextPut: $] ! emitSimplePop: byte on: aStream "Private - Print the byte bytecode (a pop) on aStream, 96<=byte<=111" (byte between: 96 and: 103) ifTrue: [ aStream nextPutAll: 'pop and store instance variable['. (byte bitAnd: 7) printOn: aStream. aStream nextPut: $] ]. (byte between: 104 and: 111) ifTrue: [ aStream nextPutAll: 'pop and store Temporary['. (byte bitAnd: 7) printOn: aStream. aStream nextPut: $] ]. ! emitBuiltin: byte on: aStream "Private - Print the byte bytecode (a special push or a return) on aStream, 112<=byte<=125" byte == 112 ifTrue: [ aStream nextPutAll: 'push self' ]. byte == 113 ifTrue: [ aStream nextPutAll: 'push true' ]. byte == 114 ifTrue: [ aStream nextPutAll: 'push false' ]. byte == 115 ifTrue: [ aStream nextPutAll: 'push nil' ]. byte == 116 ifTrue: [ aStream nextPutAll: 'push -1' ]. byte == 117 ifTrue: [ aStream nextPutAll: 'push 0' ]. byte == 118 ifTrue: [ aStream nextPutAll: 'push 1' ]. byte == 119 ifTrue: [ aStream nextPutAll: 'push 2' ]. byte == 120 ifTrue: [ aStream nextPutAll: 'return self from context' ]. byte == 121 ifTrue: [ aStream nextPutAll: 'return true from context' ]. byte == 122 ifTrue: [ aStream nextPutAll: 'return false from context' ]. byte == 123 ifTrue: [ aStream nextPutAll: 'return nil from context' ]. byte == 124 ifTrue: [ aStream nextPutAll: 'return from method' ]. byte == 125 ifTrue: [ aStream nextPutAll: 'return from context' ]. ! print3ByteOp: index on: aStream "Private - Decode the 3-byte push literal bytecode (126) onto aStream" | what num | what := self bytecodeAt: index. num := self bytecodeAt: index + 1. num := what * 256 + num. what := what // 64. what = 0 ifTrue: [ aStream nextPutAll: 'push Literal[' ]. what = 1 ifTrue: [ aStream nextPutAll: 'push Global Variable[' ]. what = 2 ifTrue: [ aStream nextPutAll: 'store Global Variable[' ]. what = 3 ifTrue: [ aStream nextPutAll: 'pop and store Global Variable[' ]. aStream print: num; nextPut: $]. what = 0 ifTrue: [ ^self ] aStream nextPutAll: ' = '. self printAssociationKeyFor: num on: aStream ! print2ByteStackOp: opName at: anIndex on: aStream | nextByte locationName locIndex | nextByte := self bytecodeAt: anIndex + 1. locIndex := nextByte bitShift: -6. locationName := self indexedLocationName: locIndex. aStream nextPutAll: opName; space; nextPutAll: locationName; nextPutAll:'['. (nextByte bitAnd: 63) printOn: aStream. aStream nextPut: $]. locIndex == 3 ifTrue: [ aStream nextPutAll: ' = '. self printAssociationKeyFor: (nextByte bitAnd: 63) on: aStream ] ! indexedLocationName: locIndex "Private - Answer the location name for the given index" ^#('Instance Variable' 'Temporary' 'Literal' 'Global Variable') at: locIndex + 1 ! print2ByteStoreOp: opName at: anIndex on: aStream | nextByte locationName locIndex | nextByte := self bytecodeAt: anIndex + 1. locIndex := nextByte bitShift: -6. locationName := self indexedLocationName: locIndex. locIndex == 2 ifTrue: [ aStream nextPutAll: 'INVALID ' ]. aStream nextPutAll: opName; space; nextPutAll: locationName; nextPutAll:'['. (nextByte bitAnd: 63) printOn: aStream. aStream nextPut: $]. locIndex == 3 ifTrue: [ aStream nextPutAll: ' = '. self printAssociationKeyFor: (nextByte bitAnd: 63) on: aStream ] ! emitOuterStackOp: anIndex on: aStream "Private - Decode the 3-byte outer-temporary bytecode (138) onto aStream" | what num | what := self bytecodeAt: anIndex. what := what // 64. what = 0 ifTrue: [ aStream nextPutAll: '(invalid)' ]. what = 1 ifTrue: [ aStream nextPutAll: 'push' ]. what = 2 ifTrue: [ aStream nextPutAll: 'store' ]. what = 3 ifTrue: [ aStream nextPutAll: 'pop and store' ]. aStream nextPutAll: ' outer Temporary['; print: ((self bytecodeAt: anIndex) bitAnd: 63); nextPutAll: '] scopes = '; print: (self bytecodeAt: anIndex + 1) ! emitIndexedSend: anIndex on: aStream | byte byte1 byte2 toSuper | byte := self bytecodeAt: anIndex. byte1 := self bytecodeAt: anIndex + 1. toSuper := ''. byte = 132 ifTrue: [ byte2 := self bytecodeAt: anIndex + 2. byte2 := byte2 + (byte1 * 4 bitAnd: 768). byte1 := byte1 bitAnd: 63. byte1 > 32 ifTrue: [ toSuper := 'to Super '. byte1 := byte1 - 32 ]. self emitGenericSend: toSuper index: byte2 args: byte1 on: aStream. ^3 ]. byte = 133 ifTrue: [ toSuper := 'to Super ' ]. self emitGenericSend: toSuper index: (byte1 bitAnd: 31) args: (byte1 bitShift: -5) on: aStream. ^2 ! emitGenericSend: toSuper index: anIndex args: numArgs on: aStream aStream nextPutAll: 'send '; nextPutAll: toSuper; nextPutAll: 'selector '. anIndex printOn: aStream. aStream nextPutAll: ', '. numArgs printOn: aStream. aStream nextPutAll: ' args = '. self printLiteralSymbolAt: anIndex on: aStream ! printJump: anIndex on: aStream | byte description | byte := self bytecodeAt: anIndex. byte <= 175 ifTrue: [ description := 'pop and jump to %1 if false' ]. byte <= 171 ifTrue: [ description := 'pop and jump to %1 if true' ]. byte <= 167 ifTrue: [ description := 'jump to %1' ]. byte <= 159 ifTrue: [ description := 'pop and jump to %1 if false' ]. byte <= 151 ifTrue: [ description := 'jump to %1' ]. description := description bindWith: (self jumpDestinationAt: anIndex) printString. aStream nextPutAll: description. ^byte <= 159 ifTrue: [ 1 ] ifFalse: [ 2 ]. ! printSmallArgSend: byte on: aStream | numArgs index | index := (byte - 208) bitAnd: 15. numArgs := (byte - 208) // 16. aStream nextPutAll: 'send selector '. index printOn: aStream. aStream nextPutAll: ', '. numArgs printOn: aStream. numArgs == 1 ifTrue: [ aStream nextPutAll: ' arg' ] ifFalse: [ aStream nextPutAll: ' args' ]. aStream nextPutAll: ' = '. self printLiteralSymbolAt: index on: aStream ! printAssociationKeyFor: anIndex on: aStream | assoc | assoc := self literalAt: anIndex + 1. aStream nextPutAll: assoc key ! printLiteralSymbolAt: anIndex on: aStream (self literalAt: anIndex + 1) printOn: aStream ! ! !CompiledCode methodsFor: 'private'! postCopy "Private - Make a deep copy of the literals. Don't need to replace the method header and bytecodes, since they are integers." literals := literals deepCopy. ! allByteCodeIndicesDo: aBlock "Private - Evaluate aBlock passing each of the index where a new bytecode instruction starts" | numBytes i byte | i := 1. numBytes := self numBytecodes. [ i <= numBytes ] whileTrue: [ byte := self bytecodeAt: i. byte == 127 ifTrue: [ byte := Debugger origByteAt: i forMethod: self ]. aBlock value: i value: byte. i := i + (self bytecodeSizeAt: i) ] ! bytecodeSizeAt: anIndex "Private - Answer the size of the bytecode instruction starting at anIndex" | byte | byte := self bytecodeAt: anIndex. byte == 127 ifTrue: [ byte := Debugger origByteAt: anIndex forMethod: self ]. byte == 126 ifTrue: [ ^3 ]. byte < 128 ifTrue: [^1]. byte > 175 ifTrue: [^1]. byte == 128 ifTrue: [ ^2]. byte == 129 ifTrue: [ ^2]. byte == 130 ifTrue: [ ^2]. byte < 135 ifTrue: [^(byte - 131) bitOr: 2]. "2 or 3" byte == 138 ifTrue: [^3]. byte == 142 ifTrue: [^2]. byte < 160 ifTrue: [^1]. ^2 ! header: hdr literals: lits header := hdr. literals := lits. Behavior flushCache ! getHeader ^header ! numBytecodes "Answer the number of bytecodes in the receiver" ^(self basicSize) - (self bytecodeStart) ! bytecodeStart "Answer the index where the bytecodes start - 1" ^0 ! !