"======================================================================
|
|   CompiledCode Method Definitions
|
|
 ======================================================================"


"======================================================================
|
| Copyright 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
| Written by Paolo Bonzini.
|
| 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.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02110-1301, 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: 'tables'!

specialSelectors
    ^#(#+ #- #< #> #<= #>= #= #~= #* #/ #\\ #bitXor: #bitShift: #// #bitAnd:
     #bitOr: #at: #at:put: #size #class #isNil #notNil #value #value: #==
     #javaAsInt #javaAsLong nil nil nil nil nil
     #new: #thisContext #callFrom:into: #narrow #nextPutAll: #yourself #,
     #on: #subclassResponsibility #add: #nl #printString #contents #name
     #isEmpty #properties #container #error: #first #tclEval: #collect:
     #tclResult #key #asTkString #abs #basicNew #negated #not #close
     #includes: #at:ifAbsent: #asSymbol #with: #copy #copyFrom:to: #print:
     #last #initialize #tclEval:with:with: #assert: #primitiveFailed
     #initialize: #asString #cr #should: #arguments #x #readStream
     #y #tclEval:with:with:with: #asInteger #space #new #shouldNotImplement
     #-> #numArgs #with:with: #species #blox #step #signal #parent
     #selector #at:ifPresent: #to: #addLast: #squared #generality
     #signalOn:mustBe: #ensure: #body #max: #keysAndValuesDo: #printOn:
     #isKindOf: #visitNode: #addAll: #isInteger #name: #hash #sqrt #beep
     #primAt: #environment #position #at:ifAbsentPut: #signal: #postCopy
     #readFrom: #coefficients: #clientPI #flush #value:value: #asFloatD
     #on:do: #basicAt:put: #primSize #evaluate #connected #reset
     #copyEmpty: #start #signalOn: #basicAt: #asClass #ln #implementation
     #checkResponse #average #upTo: #receiver #peek #basicSize #x:y:
     #foregroundColor: #rows: #text #exp #statements #body: #| #sizeof
     #includesKey: #pi #completedSuccessfully #writeStream #superclass
     #arguments: #state #truncated #inject:into: #replaceFrom:to:with:startingAt:
     #current #between:and: #retryRelationalOp:coercing: #connectIfClosed
     #detect:ifNone: #checkError #executeAndWait:arguments: #min: #width
     #parentContext #removeLast #zero #bindWith:with: #temporaries #asOop
     #width:height: #methodDictionary #accumulate: #count #asLowercase #asArray
     #exists #signalOn:what: #select: #parent: #selector: #signalOn:withIndex:
     #bind:to:of:parameters: #return: #~~ #changeState: #sign #variance #asVector
     #getResponse #wait #instanceClass #asOrderedCollection #keys #asFloat #random
     #origin #superspace #stop #perform: #backgroundColor: #login #data: #nextToken
     #primAt:put: #method #allSatisfy: #position: #default #atAllPut: #asSortedCollection
     #invalidArgsError: #nameIn: #allSubclassesDo: #signalError #height #source
     #asNumber #primitive #store: #updateViews #errorContents: #displayString
     #skipSeparators #origin:corner: #activeProcess #bindWith: #beConsistent
     #at:type: #skip: #days #tclEval:with: #fromSeconds: #& #upToEnd
     #variable #become: #with:do: #findIndexOrNil: #asSeconds #copyWith:
     #background #status #selectors:receiver:argument: #create: #coerce:
     #bytecodeAt:)!

specialSelectorsNumArgs
    ^#[1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 0 0 0 0 0 1 1 0 0
       255 255 255 255 255
       1 0 2 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0 1 2 0
       1 0 2 1 0 0 3 1 0 1 0 0 1 0 0 0 0 4 0 0 0 0 1 0 2 0 0 0 0 0 0 2
       1 1 0 0 2 1 0 1 1 1 1 1 1 0 1 0 0 0 1 0 0 2 1 0 1 1 0 0 2 0 2 2
       0 0 0 0 1 0 1 1 0 0 0 0 0 1 0 0 0 2 1 1 0 0 0 1 1 0 1 0 0 0 0 1
       0 0 2 4 0 2 2 0 2 0 2 1 0 0 0 0 2 0 0 2 0 1 0 0 0 0 2 1 1 1 2 4
       1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 2 0 1 1 0 1 0 1 1 1 0
       0 0 0 0 1 0 1 0 0 2 0 1 0 2 1 0 2 1 1 0 0 1 2 1 0 1 0 0 3 1 1 1]!

bytecodeInfoTable
    "Return a ByteArray which defines some properties of the bytecodes.
     For each bytecode, 4 bytes are reserved.  The fourth byte is a
     flag byte: bit 7 means that the argument is a line number to be
     used in creating the bytecode->line number map.

     The first three have a meaning only for those bytecodes that
     represent a combination of operations: the combination can be
         BC1 ARG BC2 OPERAND      if the fourth byte's bit 0 = 0
     or  BC1 OPERAND BC2 ARG      if the fourth byte's bit 0 = 1

     where BC1 is the first byte, BC2 is the second, ARG is the third
     and OPERAND is the bytecode argument as it appears in the bytecode
     stream."

    "Automatically generated by superops.  Do not modify this definition!"
    ^#[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
       0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
       0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
       0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
       0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
       0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
       0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 128 0 0 0 0
       0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
       55 28 1 1 54 48 0 129 55 28 0 1 56 51 0 0 54 56 0 129 32 30 0 0 46 49 0 1 54 32 0 129
       55 28 2 1 48 52 0 0 65 56 0 129 55 33 1 1 45 51 0 1 44 0 0 1 54 34 0 129 32 30 1 0
       56 30 0 0 32 28 0 0 39 67 0 1 20 43 0 0 44 6 0 1 36 48 0 1 32 51 0 1 55 28 3 1
       32 64 0 0 32 32 0 0 44 1 0 1 44 16 0 1 54 32 1 129 56 66 0 0 32 16 0 1 34 30 84 1
       68 28 0 129 46 30 36 1 24 43 0 0 54 35 0 129 52 43 0 0 32 77 1 1 73 54 0 128 54 32 2 129
       56 28 0 0 32 66 0 0 46 30 38 1 32 18 0 1 55 37 1 1 44 30 32 1 46 6 0 1 65 32 0 129
       70 30 76 1 32 30 2 0 54 35 1 129 46 64 1 1 32 0 0 1 48 54 0 128 48 30 0 0 44 36 1 0
       32 64 1 0 32 22 0 1 46 30 1 0 32 8 0 1 44 3 0 1 65 32 1 129 32 1 0 1 54 33 1 129
       52 42 0 0 36 65 1 128 32 17 0 1 46 30 0 0 32 30 3 0 48 40 0 0 54 35 2 129 68 32 0 129
       54 46 0 129 56 18 0 0 44 8 0 1 20 42 0 0 54 35 3 129 54 34 1 129 39 48 0 1 44 2 0 1
       46 64 2 1 55 33 2 1 35 18 0 1 48 32 0 0 32 90 1 1 73 101 0 0 21 43 0 0 36 54 1 128
       65 32 2 129 52 54 0 128 54 75 1 129 68 30 84 129 68 81 1 129 54 32 3 129 32 6 0 1 44 51 0 1
       36 65 2 128 89 28 1 0 35 28 0 1 56 32 0 0 36 65 0 128 36 74 1 128 32 23 0 1 35 30 1 0
       70 30 1 0 44 14 0 1 46 30 2 0 32 32 1 0 117 30 37 129 46 24 0 1 44 13 0 1 46 17 0 1
       35 51 0 1 34 30 0 0 70 64 2 1 68 30 40 129 36 54 2 128 35 1 0 1 46 2 0 1 78 30 84 129
       32 64 2 0 70 64 3 1 48 35 0 0 35 8 0 1 78 51 0 129 36 54 0 128 56 64 0 0 68 46 0 129
       34 30 2 0 34 32 0 1 71 28 0 129 36 74 0 128 68 19 0 129 34 30 1 0 46 64 3 1 35 0 0 1
       46 51 0 1 108 51 0 1 56 19 0 0 54 35 4 129 54 35 5 129 54 75 2 129 33 30 1 0 35 30 0 0
       32 30 4 0 36 65 3 128 68 30 130 129 70 64 1 1 55 28 5 1 55 28 4 1 45 50 0 1 46 72 2 1
       32 28 1 0 44 9 0 1 54 44 1 129 54 76 0 129 54 44 0 129 33 64 1 0 32 32 2 0 45 39 0 0
       52 97 0 0 73 68 0 128 24 42 0 0 32 72 0 0 36 74 2 128 52 101 0 0 46 130 0 1 44 17 0 1
       48 65 0 128 68 66 1 129 34 30 3 0 70 64 5 1 70 30 52 1 52 30 0 0 35 9 0 1 34 32 1 1
       73 30 0 0 56 69 0 0 32 9 0 1 38 67 0 1 65 86 0 129 32 66 3 0 44 28 1 1 44 5 0 1
       56 81 0 0 34 66 0 0 54 32 4 129 141 66 2 129 46 30 3 0 65 86 1 129 52 32 1 1 44 30 0 0 ]! !

!CompiledCode class methodsFor: 'instance creation'!

new: numBytecodes header: anInteger numLiterals: numLiterals
    "Answer a new instance of the receiver with room for the given
     number of bytecodes and the given header"

    ^self
	new: numBytecodes
	header: anInteger
	literals: (Array new: numLiterals)
!

new: numBytecodes header: anInteger literals: literals
    "Answer a new instance of the receiver with room for the given
     number of bytecodes and the given header"

    anInteger isInteger
        ifFalse: [ SystemExceptions.WrongClass signalOn: anInteger mustBe: Integer ].

    ^(self new: numBytecodes)
	initialize;
	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: 'literals - iteration'!

allLiteralSymbolsDo: aBlock
    literals isNil ifTrue: [ ^self ].
    self traverseLiteral: literals with: [ :each |
	each isSymbol ifTrue: [ aBlock value: each ]
    ]
!

allLiteralsDo: aBlock
    literals isNil ifTrue: [ ^self ].
    self traverseLiteral: literals with: aBlock
!

traverseLiteral: anArray with: aBlock
    anArray do: [ :each |
	aBlock value: each.
	each class == Array
	    ifTrue: [ self traverseLiteral: each with: aBlock ].
	each class == Message
	    ifTrue: [
		aBlock value: each selector.
		self traverseLiteral: each arguments with: aBlock ]
    ]
!

literalsDo: aBlock
    literals isNil ifTrue: [ ^self ].
    literals do: aBlock
!


!CompiledCode methodsFor: 'accessing'!

at: anIndex put: aBytecode
    "Store aBytecode as the anIndex-th bytecode"
    self basicAt: anIndex put: aBytecode.
    CompiledMethod flushTranslatorCache.
    ^aBytecode
!

blockAt: anIndex
    "Answer the CompiledBlock attached to the anIndex-th literal,
     assuming that the literal is a CompiledBlock or a BlockClosure."
    | lit |
    lit := literals at: anIndex.
    lit class == BlockClosure ifTrue: [ lit := lit block ].
    ^lit
!

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
!

isAnnotated
    ^false
!

literals
    ^literals isNil ifTrue: [ #() ] ifFalse: [ 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."

    | instVars lit object output |
    instVars := self class allInstVarNames.
    Transcript
	nextPutAll: 'An instance of ';
	print: self class;
	nl.

    2 to: instVars size do: [ :i | 
	object := self instVarAt: i.
    	output := [ object printString ]
		      on: Error
		      do: [ :ex | ex return: ('%1 %2'
				      bindWith: object class article
				      with: object class name asString) ].
    	Transcript
    	    nextPutAll: '  ';
    	    nextPutAll: (instVars at: i);
    	    nextPutAll: ': ';
    	    nextPutAll: output;
    	    nl.
				   
	i = 2 ifTrue: [ self printHeaderOn: Transcript ].
    ].

    self numLiterals > 0 ifTrue: [
	Transcript nextPutAll: '  literals: ['; nl.
	1 to: self numLiterals do: [ :i |
	    self bytecodeIndex: i with: Transcript.
	    Transcript tab.
	    lit := self literalAt: i.
	    lit printNl.
	].
	Transcript nextPutAll: '  ]'; nl
    ].

    self numBytecodes > 0 ifTrue: [
	Transcript nextPutAll: '  byte codes: ['; nl.
	self printByteCodesOn: Transcript.
	Transcript nextPutAll: '  ]'; nl
    ].
! !



!CompiledCode methodsFor: 'testing accesses'!

containsLiteral: anObject
    "Answer if the receiver contains a literal which is equal to anObject."
    self allLiteralsDo: [ :lit |
	lit = anObject ifTrue: [^true ].
    ].
    ^false
!

refersTo: anObject
    "Answer whether the receiver refers to the given object"
    | byte |
    (self containsLiteral: anObject) ifTrue: [ ^true ].
    anObject isSymbol ifFalse: [ ^false ].

    "Look for symbols referenced to by special message sends"
    byte := self class specialSelectors indexOf: anObject.
    byte = 0 ifTrue: [ ^false ].
    byte := byte - 1.

    self allByteCodeIndicesDo: [ :i :bytecode :operand |
	(byte <= 26 and: [ byte = bytecode ]) ifTrue: [^true].
	((byte bitAnd: 254) = 30 and: [ byte = operand ]) 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 :operand |
	i > lastIndex ifTrue: [ ^false ].
	(i >= firstIndex and: [ byte = bytecode ])
	    ifTrue: [^true].
    ].
    ^false
!

sourceCodeMap
    "Answer an array which maps bytecode indices to source code
     line numbers.  0 values represent invalid instruction
     pointer indices."

    | map line |
    map := ByteArray new: self size.
    line := 1.
    self allByteCodeIndicesDo: [ :each :byte :operand |
        (self class bytecodeInfoTable at: byte * 4 + 4) > 128 ifTrue: [
	    line := operand.
            operand > 255 ifTrue: [ map := map asArray ]
        ].

        map at: each put: line
    ].

    ^map!

jumpDestinationAt: anIndex
    "Answer where the jump at bytecode index `anIndex' lands"
    | result ofs byte |
    ofs := anIndex.
    [ anIndex > 2 and: [ (self bytecodeAt: ofs - 2) = 55 ] ]
	whileTrue: [ ofs := ofs - 2 ].

    result := 0.
    [ result := result * 256 + (self bytecodeAt: ofs + 1).
      byte := self bytecodeAt: ofs.
      ofs := ofs + 2.
      byte = 55 ] whileTrue.

    ^byte = 40
	ifTrue: [ ofs - result ]
        ifFalse: [ ofs + result ].
!

reads: instVarIndex
    "Answer whether the receiver reads the instance variable with the given
     index"

    self flags = 2
	ifTrue: [ ^((header bitShift: -6) bitAnd: 16r1F) = instVarIndex].

    self allByteCodeIndicesDo: [ :i :byte :operand |
	(byte = 35 and: [ operand = instVarIndex ])
	    ifTrue: [ ^true ].
    ].
    ^false
!

assigns: instVarIndex
    "Answer whether the receiver writes to the instance variable with the given
     index"

    self allByteCodeIndicesDo: [ :i :byte :operand |
	(byte = 39 and: [ operand = instVarIndex ])
	    ifTrue: [ ^true ].
    ].
    ^false
!

accesses: instVarIndex
    "Answer whether the receiver accesses the instance variable with the given
     index"

    | byte nextByte |
    self flags = 2
	ifTrue: [ ^((header bitShift: -6) bitAnd: 16r1F) = instVarIndex].

    self allByteCodeIndicesDo: [ :i :byte :operand |
	((byte = 35 or: [ byte = 39 ])
	    and: [ operand = instVarIndex ])
	        ifTrue: [ ^true ].
    ].
    ^false
! !

!CompiledCode methodsFor: 'decoding bytecodes'!

dispatchTo: anObject with: param
    "Disassemble the bytecodes and tell anObject about them in the form
     of message sends.  param is given as an argument to every message
     send."
    | lastOfs |
    self allByteCodeIndicesDo: [ :i :byte :arg |
	lastOfs = i ifFalse: [
	    anObject bytecodeIndex: i with: param.
	    lastOfs := i.
	].
	self dispatchByte: byte with: arg at: i to: anObject with: param
    ]
! !

!CompiledCode methodsFor: 'private-decoding bytecodes'!

dispatchByte: byte with: operand at: anIndex to: anObject with: param
    "Private - Print the byte bytecode (starting at anIndex) on param"

    byte <= 26 ifTrue:
	[ ^self dispatchSend: 30 with: byte to: anObject with: param ].
    byte < 32 ifTrue:
	[ ^self dispatchSend: byte with: operand to: anObject with: param ].
    byte < 40 ifTrue:
	[ ^self dispatchVariableOp: byte with: operand to: anObject with: param ].
    byte < 44 ifTrue:
	[ ^self dispatchJump: byte at: anIndex to: anObject with: param ].
    byte < 48 ifTrue:
	[ ^self dispatchOtherStack: byte with: operand to: anObject with: param ].
    byte < 54 ifTrue:
	[ ^self dispatchOneByte: byte to: anObject with: param ].
    byte = 54 ifTrue:
	[ ^anObject lineNo: operand with: param ].
    byte = 56 ifTrue:
	[ ^anObject pushSelf: param ].
    ^anObject invalidOpcode: param
!

dispatchSuperoperator: byte with: operand at: ofs to: aBlock
    "Private - Split the superoperator and call back to aBlock for
     the two components (recursive calls are possible to several
     levels)."

    | index bc1 bc2 arg1 arg2 arg kind |
    index := byte * 4.
    bc1 := self class bytecodeInfoTable at: index + 1.
    bc2 := self class bytecodeInfoTable at: index + 2.
    arg := self class bytecodeInfoTable at: index + 3.
    kind := self class bytecodeInfoTable at: index + 4.
    kind \\ 2 = 0
	ifTrue: [ arg1 := arg. arg2 := operand ]
	ifFalse: [ arg1 := operand. arg2 := arg ].

    bc1 = 55
	ifTrue: [ arg2 := arg1 * 256 + arg2 ]
	ifFalse: [
	    bc1 < 64
		ifTrue: [
		    aBlock
			value: ofs
			value: bc1
			value: arg1 ]
		ifFalse: [
		    self
		        dispatchSuperoperator: bc1
			with: arg1
			at: ofs
			to: aBlock ].
	].

    bc2 < 64
	ifTrue: [
	    aBlock
		value: ofs
		value: bc2
		value: arg2 ]
	ifFalse: [
	     self
		dispatchSuperoperator: bc2
		with: arg2
		at: ofs
		to: aBlock ]!

dispatchSend: byte with: operand to: anObject with: param
    byte = 28 ifTrue: [
	^anObject
	    send: (self literalAt: operand // 256 + 1)
	    numArgs: operand \\ 256
	    with: param ].
    byte = 29 ifTrue: [
	^anObject
	    superSend: (self literalAt: operand // 256 + 1)
	    numArgs: operand \\ 256
	    with: param ].
    byte = 30 ifTrue: [
	^anObject
	    send: (self class specialSelectors at: operand + 1)
	    numArgs: (self class specialSelectorsNumArgs at: operand + 1)
	    with: param ].
    byte = 31 ifTrue: [
	^anObject
	    superSend: (self class specialSelectors at: operand + 1)
	    numArgs: (self class specialSelectorsNumArgs at: operand + 1)
	    with: param ].
    ^anObject invalidOpcode: param
!

dispatchVariableOp: byte with: operand to: anObject with: param
    byte = 32 ifTrue:
    	[ ^anObject pushTemporary: operand with: param ].
    byte = 33 ifTrue:
    	[ ^anObject pushTemporary: (operand // 256) outer: (operand \\ 256) with: param ].
    byte = 34 ifTrue:
    	[ ^anObject pushGlobal: (self literalAt: operand + 1) with: param ].
    byte = 35 ifTrue:
    	[ ^anObject pushInstVar: operand with: param ].
    byte = 36 ifTrue:
    	[ ^anObject storeTemporary: operand with: param ].
    byte = 37 ifTrue:
    	[ ^anObject storeTemporary: (operand // 256) outer: (operand \\ 256) with: param ].
    byte = 38 ifTrue:
    	[ ^anObject storeGlobal: (self literalAt: operand + 1) with: param ].
    byte = 39 ifTrue:
    	[ ^anObject storeInstVar: operand with: param ].
!

dispatchOneByte: byte to: anObject with: param 
    byte == 48 ifTrue: [ ^anObject popStackTop: param ].
    byte == 49 ifTrue: [ ^anObject makeDirtyBlock: param ].
    byte == 50 ifTrue: [ ^anObject returnFromMethod: param ].
    byte == 51 ifTrue: [ ^anObject returnFromContext: param ].
    byte == 52 ifTrue: [ ^anObject dupStackTop: param ].
    byte == 53 ifTrue: [ ^anObject exitInterpreter: param ].
!

dispatchOtherStack: byte with: operand to: anObject with: param
    byte = 44 ifTrue:
    	[ ^anObject pushLiteral: operand with: param ].
    byte = 46 ifTrue:
    	[ ^anObject pushLiteral: (self literalAt: operand + 1) with: param ].
    byte = 47 ifTrue:
    	[ ^anObject popIntoArray: operand with: param ].
    operand = 0 ifTrue:
    	[ ^anObject pushLiteral: nil with: param ].
    operand = 1 ifTrue:
    	[ ^anObject pushLiteral: true with: param ].
    operand = 2 ifTrue:
    	[ ^anObject pushLiteral: false with: param ].
    ^anObject invalidOpcode: param
!

dispatchJump: byte at: anIndex to: anObject with: param
    | destination |
    destination := self jumpDestinationAt: anIndex.

    byte < 42 ifTrue:
	[ ^anObject jumpTo: destination with: param ].
    byte = 42 ifTrue:
	[ ^anObject popJumpIfTrueTo: destination with: param ].
    byte = 43 ifTrue:
	[ ^anObject popJumpIfFalseTo: destination with: param ].
! !


!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 dispatchTo: self with: aStream
!

invalidOpcode: aStream
    aStream tab; nextPutAll: 'invalid opcode'; nl!

pushInstVar: anIndex with: aStream
    aStream tab; nextPutAll: ('push Instance Variable[%1]' bindWith: anIndex); nl!

storeInstVar: anIndex with: aStream
    aStream tab; nextPutAll: ('store into Instance Variable[%1]' bindWith: anIndex); nl!

popIntoArray: anIndex with: aStream
    aStream tab; nextPutAll: ('pop and store into array element[%1]' bindWith: anIndex); nl!

pushTemporary: anIndex outer: scopes with: aStream
    aStream tab; nextPutAll: ('push Temporary[%1] from outer context #%2' bindWith: anIndex with: scopes); nl!

storeTemporary: anIndex outer: scopes with: aStream
    aStream tab; nextPutAll: ('store into Temporary[%1] from outer context #%2' bindWith: anIndex with: scopes); nl!

pushTemporary: anIndex with: aStream
    aStream tab; nextPutAll: ('push Temporary[%1]' bindWith: anIndex); nl!

storeTemporary: anIndex with: aStream
    aStream tab; nextPutAll: ('store into Temporary[%1]' bindWith: anIndex); nl!

pushLiteral: anObject with: aStream
    | printString |
    printString := anObject printString.
    (anObject isClass not and: [ printString size > 30 ])
	ifTrue: [ printString := '%1 %2' bindWith: anObject class article with: anObject class name asString ].

    aStream tab; nextPutAll: 'push '; nextPutAll: printString; nl!

pushGlobal: anObject with: aStream
    aStream tab; nextPutAll: 'push Global Variable '; print: anObject; nl!

storeGlobal: anObject with: aStream
    aStream tab; nextPutAll: 'store into Global Variable '; print: anObject; nl!

pushSelf: aStream
    aStream tab; nextPutAll: 'push self'; nl!

popStackTop: aStream
    aStream tab; nextPutAll: 'pop stack top'; nl!

makeDirtyBlock: aStream
    aStream tab; nextPutAll: 'make dirty block'; nl!

lineNo: n with: aStream
    aStream tab; nextPutAll: 'source code line number '; print: n; nl!

dupStackTop: aStream
    aStream tab; nextPutAll: 'dup stack top'; nl!

exitInterpreter: aStream
    aStream tab; nextPutAll: 'exit interpreter'; nl!

returnFromContext: aStream
    aStream tab; nextPutAll: 'return stack top'; nl!

returnFromMethod: aStream
    aStream tab; nextPutAll: 'return from method'; nl!

popJumpIfFalseTo: destination with: aStream
    aStream tab; nextPutAll: 'pop and if false jump to '; print: destination; nl!

popJumpIfTrueTo: destination with: aStream
    aStream tab; nextPutAll: 'pop and if true jump to '; print: destination; nl!

jumpTo: destination with: aStream
    aStream tab; nextPutAll: 'jump to '; print: destination; nl!

superSend: aSymbol numArgs: anInteger with: aStream
    aStream tab; nextPutAll: ('send %2 args message %1 to super' bindWith: aSymbol with: anInteger); nl!

send: aSymbol numArgs: anInteger with: aStream
    aStream tab; nextPutAll: ('send %2 args message %1' bindWith: aSymbol with: anInteger); nl!

bytecodeIndex: byte with: aStream
    "Private - Print the bytecode index for byte"

    | s |
    s := byte printString.
    aStream
	space: 5 - s size;
	nextPut: $[;
	nextPutAll: s;
	nextPut: $].
! !


!CompiledCode methodsFor: 'private'!

nextBytecodeIndex: anIndex
    "Private - Answer the index of the bytecode after the one at
     index `anIndex'"

    | byte ofs |
    ofs := anIndex.
    [
	byte := self bytecodeAt: ofs.
        ofs := ofs + 2.
        byte = 55 
    ] whileTrue.
    ^ofs
!

allByteCodeIndicesDo: aBlock
    "Private - Evaluate aBlock passing each of the index where a
     new bytecode instruction starts"

    | numBytes i byte operand ofs |
    i := 1.
    numBytes := self numBytecodes.
    [ i <= numBytes ] whileTrue: [
	ofs := i.
	operand := 0.
	[
	    byte := self bytecodeAt: i.
	    operand := operand * 256 + (self bytecodeAt: i + 1).
	    i := i + 2.
	    byte = 55 
	] whileTrue.

	byte >= 64
	    ifTrue: [
	        self
		    dispatchSuperoperator: byte
		    with: operand
		    at: ofs
		    to: aBlock
	    ]
	    ifFalse: [
		aBlock
		    value: ofs
		    value: byte
		    value: operand
	    ]
    ]
!

bytecodeSizeAt: anIndex
    "Private - Answer the size of the bytecode instruction starting at anIndex"

    ^(self nextBytecodeIndex: anIndex) - anIndex
!

header: hdr literals: lits
    | oldHeader |
    oldHeader := header.
    header := hdr.
    literals := lits.
    oldHeader isNil ifFalse: [ Behavior flushCache ].
!

initialize
    "Do nothing"
!

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
! !
