[squeak-dev] The Trunk: Compiler-eem.282.mcz

commits at source.squeak.org commits at source.squeak.org
Mon May 19 16:04:25 UTC 2014


Eliot Miranda uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-eem.282.mcz

==================== Summary ====================

Name: Compiler-eem.282
Author: eem
Time: 19 May 2014, 9:04:01.39 am
UUID: caa1adc9-fcd0-47d2-bf81-6e6330e0d7c7
Ancestors: Compiler-eem.281

Flesh out (complete?) the support for testing/scanning in
InstructionStream and CompiledMethod for multiple
bytecode sets.

=============== Diff against Compiler-eem.281 ===============

Item was added:
+ ----- Method: BytecodeEncoder class>>bindingReadScanBlockFor:using: (in category 'compiled method support') -----
+ bindingReadScanBlockFor: litVarIndex using: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for reads of the value of the binding with zero-relative index litVarIndex.
+ 	 N.B. Don't assume the compiler uses the most compact encoding available."
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>bindingWriteScanBlockFor:using: (in category 'compiled method support') -----
+ bindingWriteScanBlockFor: litVarIndex using: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for writes of the value of the binding with zero-relative index litVarIndex.
+ 	 N.B. Don't assume the compiler uses the most compact encoding available."
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>bytecodeSize: (in category 'instruction stream support') -----
+ bytecodeSize: bytecode
+ 	"Answer the number of bytes in the (unextended) bytecode."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>createClosureScanBlock (in category 'compiled method support') -----
+ createClosureScanBlock
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for block closure creation bytecodes."
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: BytecodeEncoder class>>extensionsAt:in:into: (in category 'instruction stream support') -----
  extensionsAt: pc in: aCompiledMethod into: trinaryBlock
  	"If the bytecode at pc is an extension then evaluate aTrinaryBlock
  	 with the values of extA and extB and number of extension *bytes*.
+ 	 If the bytecode at pc is not extended then evaluate with 0, 0, 0."
+ 
- 	 If the bytecode at pc is not extended then evaluate with 0, 0, 0." 
  	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>instVarReadScanBlockFor:using: (in category 'compiled method support') -----
+ instVarReadScanBlockFor: varIndexCode using: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for reads of the inst var with zero-relative index varIndexCode.
+ 	 N.B. Don't assume the compiler uses the most compact encoding available."
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>instVarWriteScanBlockFor:using: (in category 'compiled method support') -----
+ instVarWriteScanBlockFor: varIndexCode using: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for writes of the inst var with zero-relative index varIndexCode.
+ 	 N.B. Don't assume the compiler uses the most compact encoding available."
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: BytecodeEncoder class>>interpretJumpIfCondIn: (in category 'instruction stream support') -----
  interpretJumpIfCondIn: anInstructionStream
  	"Double-dispatch through the encoder to select the correct conditional jump decoder for the instruction set."
+ 
  	self subclassResponsibility!

Item was changed:
  ----- Method: BytecodeEncoder class>>interpretJumpIn: (in category 'instruction stream support') -----
  interpretJumpIn: anInstructionStream
  	"Double-dispatch through the encoder to select the correct jump decoder for the instruction set."
+ 
  	self subclassResponsibility!

Item was changed:
  ----- Method: BytecodeEncoder class>>interpretNextInstructionFor:in: (in category 'instruction stream support') -----
  interpretNextInstructionFor: aClient in: anInstructionStream
+ 	"Double-dispatch instruction interpretation through the encoder
+ 	 to select the correct instruction set decoder."
+ 
- 	"Double-dispatch through the encoder to select the correct instruction set decoder."
  	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isBlockReturnAt:in: (in category 'instruction stream support') -----
+ isBlockReturnAt: pc in: method
+ 	"Answer whether the bytecode at pc is a return from block."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isBranchIfFalseAt:in: (in category 'instruction stream support') -----
+ isBranchIfFalseAt: pc in: method
+ 	"Answer whether the bytecode at pc is a conditional branch-if-false."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isBranchIfTrueAt:in: (in category 'instruction stream support') -----
+ isBranchIfTrueAt: pc in: method
+ 	"Answer whether the bytecode at pc is a conditional branch-if-true."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isExtension: (in category 'instruction stream support') -----
+ isExtension: bytecode
+ 	"Answer if the bytecode is an extension bytecode, i.e. one that extends
+ 	 the range of the following bytecode."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isJumpAt:in: (in category 'instruction stream support') -----
+ isJumpAt: pc in: method
+ 	"Answer whether the bytecode at pc is an (unconditional) jump."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isJustPopAt:in: (in category 'instruction stream support') -----
+ isJustPopAt: pc in: method
+ 	"Answer whether the bytecode at pc is a pop."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isRealSendAt:in: (in category 'instruction stream support') -----
+ isRealSendAt: pc in: method
+ 	"Answer whether the bytecode at pc is a real message-send, not blockCopy:."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isReturnAt:in: (in category 'instruction stream support') -----
+ isReturnAt: pc in: method
+ 	"Answer whether the bytecode at pc is a return."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isSendAt:in: (in category 'instruction stream support') -----
+ isSendAt: pc in: method
+ 	"Answer whether the bytecode at pc is a message-send."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isStoreAt:in: (in category 'instruction stream support') -----
+ isStoreAt: pc in: method
+ 	"Answer whether the bytecode at pc is a store or store-pop."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>isStorePopAt:in: (in category 'instruction stream support') -----
+ isStorePopAt: pc in: method
+ 	"Answer whether the bytecode at pc is a store-pop."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>nonExtensionBytecodeAt:in: (in category 'instruction stream support') -----
+ nonExtensionBytecodeAt: pc in: method
+ 	"Answer the actual bytecode at pc in method, skipping past any preceeding extensions."
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>superSendScanBlockUsing: (in category 'compiled method support') -----
+ superSendScanBlockUsing: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor:
+ 	 that answers true for super sends."
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: BytecodeEncoder class>>supportsClosures (in category 'compiled method support') -----
+ supportsClosures
+ 	"Answer if the instruction set supports closures (contains
+ 	 closure creation and indirect temp access bytecodes)."
+ 	
+ 	self subclassResponsibility!

Item was changed:
  BytecodeEncoder subclass: #EncoderForV3
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Compiler-Kernel'!
  
+ !EncoderForV3 commentStamp: 'eem 5/17/2014 11:58' prior: 0!
+ I add behaviour to Encoder to size and emit bytecodes for the Squeak V3.x VM bytecode set, a close variant of the original Smalltalk-80 bytecode set defined in the Blue Book.
+ 
+ 	0-15 		0000iiii 	Push Receiver Variable #iiii
+ 	16-31 		0001iiii 	Push Temporary Location #iiii
+ 	32-63 		001iiiii 		Push Literal Constant #iiiii
+ 	64-95 		010iiiii 		Push Literal Variable #iiiii
+ 	96-103 	01100iii 	Pop and Store Receiver Variable #iii
+ 	104-111 	01101iii 	Pop and Store Temporary Location #iii
+ 	112-119 	01110iii 	Push (receiver, true, false, nil, -1, 0, 1, 2) [iii]
+ 	120-123 	011110ii 	Return (receiver, true, false, nil) [ii] From Message
+ 	124-125 	0111110i 	Return Stack Top From (Message, Block) [i]
+ 	(126-127 unassigned)
+ 	128 		10000000 jjkkkkkk 	Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
+ 	129 		10000001 jjkkkkkk 	Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
+ 	130 		10000010 jjkkkkkk 	Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
+ 	131 		10000011 jjjkkkkk 	Send Literal Selector #kkkkk With jjj Arguments
+ 	132 		10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)
+ 	133 		10000011 jjjkkkkk 	Send Literal Selector #kkkkk To Superclass With jjj Arguments
+ 	134 		10000011 jjjkkkkk 	Send Literal Selector #kkkkk With jjj Arguments
+ 	135 		10000111 	Pop Stack Top
+ 	136 		10001000 	Duplicate Stack Top
+ 	137 		10001001 	Push Active Context
+ 	(138-143 unassigned)
+ 	144-151 	10010iii 		Jump iii + 1 (i.e., 1 through 8)
+ 	152-159 	10011iii 		Pop and Jump 0n False iii +1 (i.e., 1 through 8)
+ 	160-167 	10100iii jjjjjjjj 	Jump(iii - 4) *256+jjjjjjjj
+ 	168-171 	101010ii jjjjjjjj 	Pop and Jump On True ii *256+jjjjjjjj
+ 	172-175 	101011ii jjjjjjjj 	Pop and Jump On False ii *256+jjjjjjjj
+ 	176-191 	1011iiii 		Send Arithmetic Message #iiii
+ 	192-207 	1100iiii 		Send Special Message #iiii
+ 	208-223 	1101iiii 		Send Literal Selector #iiii With No Arguments
+ 	224-239 	1110iiii 		Send Literal Selector #iiii With 1 Argument
+ 	240-255 	1111iiii 		Send Literal Selector #iiii With 2 Arguments
+ !
- !EncoderForV3 commentStamp: '<historical>' prior: 0!
- I add behaviour to Encoder to size and emit bytecodes for the Squeak V3.x VM bytecode set.  The intention is for another subclass to restrict the range of bytecodes used to long forms only, allowing the bytecode set to be redefined by avoiding using the many short forms.  The short forms may then be reassigned.!

Item was added:
+ ----- Method: EncoderForV3 class>>bindingReadScanBlockFor:using: (in category 'compiled method support') -----
+ bindingReadScanBlockFor: bindingLitIndex using: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for reads of the value of the binding with zero-relative index litVarIndex.
+ 	 N.B. Don't assume the compiler uses the most compact encoding available."
+ 	^[:b|
+ 	   b >= 64
+ 	   and: [b <= 95
+ 			ifTrue: [b - 64 = bindingLitIndex]
+ 			ifFalse:
+ 				[b = 128
+ 					ifTrue: [scanner followingByte - 192 = bindingLitIndex]
+ 					ifFalse:
+ 						[b = 132
+ 						 and: [(scanner followingByte between: 128 and: 159)
+ 						 and: [scanner thirdByte = bindingLitIndex]]]]]]!

Item was added:
+ ----- Method: EncoderForV3 class>>bindingWriteScanBlockFor:using: (in category 'compiled method support') -----
+ bindingWriteScanBlockFor: bindingLitIndex using: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for writes of the value of the binding with zero-relative index bindingLitIndex.
+ 	 N.B. Don't assume the compiler uses the most compact encoding available."
+ 	^[:b|
+ 	  (b = 129 or: [b = 130])
+ 		ifTrue: [scanner followingByte - 192 = bindingLitIndex]
+ 		ifFalse:
+ 			[b = 132
+ 			 and: [scanner followingByte >= 224
+ 			 and: [scanner thirdByte = bindingLitIndex]]]]!

Item was added:
+ ----- Method: EncoderForV3 class>>bytecodeSize: (in category 'instruction stream support') -----
+ bytecodeSize: bytecode
+ 	"Answer the number of bytes in the bytecode."
+ 	bytecode <= 125 ifTrue:
+ 		[^1].
+ 	bytecode >= 176 ifTrue:
+ 		[^1].
+ 	bytecode >= 160 ifTrue: "long jumps"
+ 		[^2].
+ 	bytecode >= 144 ifTrue: "short jumps"
+ 		[^1].
+ 	"extensions"
+ 	bytecode >= 128 ifTrue:
+ 		[^#(2 2 2 2 3 2 2 1 1 1 nil nil nil nil nil nil) at: bytecode - 127].
+ 	^nil!

Item was added:
+ ----- Method: EncoderForV3 class>>createClosureScanBlock (in category 'compiled method support') -----
+ createClosureScanBlock
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for block closure creation bytecodes."
+ 	^[:b| false]!

Item was added:
+ ----- Method: EncoderForV3 class>>instVarReadScanBlockFor:using: (in category 'compiled method support') -----
+ instVarReadScanBlockFor: varIndexCode using: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for reads of the inst var with zero-relative index varIndexCode.
+ 	 N.B. Don't assume the compiler uses the most compact encoding available."
+ 	^[:b|
+ 	   b < 16
+ 		ifTrue: [b = varIndexCode]
+ 		ifFalse:
+ 			[b = 128
+ 				ifTrue: [scanner followingByte = varIndexCode and: [varIndexCode <= 63]]
+ 				ifFalse:
+ 					[b = 132
+ 					 and: [(scanner followingByte between: 64 and: 95)
+ 					 and: [scanner thirdByte = varIndexCode]]]]]!

Item was added:
+ ----- Method: EncoderForV3 class>>instVarWriteScanBlockFor:using: (in category 'compiled method support') -----
+ instVarWriteScanBlockFor: varIndexCode using: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for writes of the inst var with zero-relative index varIndexCode.
+ 	 N.B. Don't assume the compiler uses the most compact encoding available."
+ 	^[:b|
+ 	   b >= 96
+ 	   and: [b <= 103
+ 			ifTrue: [b - 96 = varIndexCode]
+ 			ifFalse:
+ 				[(b = 129 or: [b = 130])
+ 					ifTrue: [scanner followingByte = varIndexCode and: [varIndexCode <= 63]]
+ 					ifFalse:
+ 						[b = 132
+ 						 and: [(scanner followingByte between: 160 and: 223)
+ 						 and: [scanner thirdByte = varIndexCode]]]]]]!

Item was added:
+ ----- Method: EncoderForV3 class>>isBlockReturnAt:in: (in category 'instruction stream support') -----
+ isBlockReturnAt: pc in: method
+ 	"Answer whether the bytecode at pc is a return from block."
+ 
+ 	^(method at: pc) = 125!

Item was added:
+ ----- Method: EncoderForV3 class>>isBranchIfFalseAt:in: (in category 'instruction stream support') -----
+ isBranchIfFalseAt: pc in: method
+ 	"Answer whether the bytecode at pc is a conditional branch-if-false."
+ 	| bytecode |
+ 	bytecode := method at: pc.
+ 	^(bytecode between: 152 and: 159) or: [bytecode between: 172 and: 175]!

Item was added:
+ ----- Method: EncoderForV3 class>>isBranchIfTrueAt:in: (in category 'instruction stream support') -----
+ isBranchIfTrueAt: pc in: method
+ 	"Answer whether the bytecode at pc is a conditional branch-if-true."
+ 	^(method at: pc) between: 168 and: 171!

Item was added:
+ ----- Method: EncoderForV3 class>>isExtension: (in category 'instruction stream support') -----
+ isExtension: bytecode
+ 	"Answer if the bytecode is an extension bytecode, i.e. one that extends the
+ 	 range of the following bytecode.  The Smalltalk-80/V3 sets don't use extensions."
+ 	^false!

Item was added:
+ ----- Method: EncoderForV3 class>>isJumpAt:in: (in category 'instruction stream support') -----
+ isJumpAt: pc in: method
+ 	"Answer whether the bytecode at pc is an (unconditional) jump."
+ 	| bytecode |
+ 	bytecode := method at: pc.
+ 	^(bytecode between: 144 and: 151) or: [bytecode between: 160 and: 167]!

Item was added:
+ ----- Method: EncoderForV3 class>>isJustPopAt:in: (in category 'instruction stream support') -----
+ isJustPopAt: pc in: method
+ 	"Answer whether the bytecode at pc is a pop."
+ 
+ 	^(method at: pc) = 135	"135 		10000111 	Pop Stack Top"!

Item was added:
+ ----- Method: EncoderForV3 class>>isRealSendAt:in: (in category 'instruction stream support') -----
+ isRealSendAt: pc in: method
+ 	"Answer whether the bytecode at pc is a real message-send, not blockCopy:."
+ 
+ 	| byte |
+ 	byte := method at: pc.
+ 	^(byte >= 176			"special send or short send"
+ 	   and: [byte ~= 200	"special selector blockCopy:"
+ 			or: [(Smalltalk specialSelectorAt: 200 - 175) ~~ #blockCopy:]])
+ 	 or: [byte >= 131
+ 		 and: [byte <= 134	"long sends"	
+ 		 and: [byte ~= 132	"double extended do anything"
+ 			or: [(method at: pc + 1) // 32 <= 1]]]]!

Item was added:
+ ----- Method: EncoderForV3 class>>isReturnAt:in: (in category 'instruction stream support') -----
+ isReturnAt: pc in: method
+ 	"Answer whether the bytecode at pc is a return."
+ 
+ 	^(method at: pc) between: 120 and: 125!

Item was added:
+ ----- Method: EncoderForV3 class>>isSendAt:in: (in category 'instruction stream support') -----
+ isSendAt: pc in: method
+ 	"Answer whether the bytecode at pc is a message-send."
+ 
+ 	| byte |
+ 	byte := method at: pc.
+ 	^byte >= 176			"special send or short send"
+ 	 or: [byte >= 131
+ 		 and: [byte <= 134	"long sends"	
+ 		 and: [byte ~= 132	"double extended do anything"
+ 			or: [(method at: pc + 1) // 32 <= 1]]]]!

Item was added:
+ ----- Method: EncoderForV3 class>>isStoreAt:in: (in category 'instruction stream support') -----
+ isStoreAt: pc in: method
+ 	"Answer whether the bytecode at pc is a store or store-pop."
+ 
+ 	| byte |
+ 	byte := method at: pc.
+ 	^(byte between: 96 and: 132)
+ 		and: [byte <= 111				"96 103	storeAndPopReceiverVariableBytecode"
+ 										"104 111	storeAndPopTemporaryVariableBytecode"
+ 			or: [byte >= 129			"129		extendedStoreBytecode"
+ 				and: [byte <= 130		"130		extendedStoreAndPopBytecode"
+ 					or: [byte = 132		"132		doubleExtendedDoAnythingBytecode"
+ 						and: [(method at: pc+1) >= 160]]]]]!

Item was added:
+ ----- Method: EncoderForV3 class>>isStorePopAt:in: (in category 'instruction stream support') -----
+ isStorePopAt: pc in: method
+ 	"Answer whether the bytecode at pc is a store-pop."
+ 
+ 	| byte |
+ 	byte := method at: pc.
+ 	^(byte between: 96 and: 111)	"96 103	storeAndPopReceiverVariableBytecode"
+ 									"104 111	storeAndPopTemporaryVariableBytecode"
+ 	  or: [byte = 130]				"130		extendedStoreAndPopBytecode"!

Item was added:
+ ----- Method: EncoderForV3 class>>nonExtensionBytecodeAt:in: (in category 'instruction stream support') -----
+ nonExtensionBytecodeAt: pc in: method
+ 	"Answer the actual bytecode at pc in method, skipping past any preceeding extensions."
+ 	^method at: pc!

Item was added:
+ ----- Method: EncoderForV3 class>>superSendScanBlockUsing: (in category 'compiled method support') -----
+ superSendScanBlockUsing: scanner
+ 	"Answer a block argument for InstructionStream>>scanFor:
+ 	 that answers true for super sends."
+ 	^[:instr |
+ 	   instr = 16r85
+ 	   or: [instr = 16r84
+ 		and: [scanner followingByte between: 16r20 and: 16r3F]]]!

Item was added:
+ ----- Method: EncoderForV3 class>>supportsClosures (in category 'compiled method support') -----
+ supportsClosures
+ 	"Answer if the instruction set supports closures (contains
+ 	 closure creation and indirect temp access bytecodes)."
+ 
+ 	^false!

Item was added:
+ ----- Method: EncoderForV3PlusClosures class>>bytecodeSize: (in category 'instruction stream support') -----
+ bytecodeSize: bytecode
+ 	"Answer the number of bytes in the bytecode."
+ 	bytecode <= 125 ifTrue:
+ 		[^1].
+ 	bytecode >= 176 ifTrue:
+ 		[^1].
+ 	bytecode >= 160 ifTrue: "long jumps"
+ 		[^2].
+ 	bytecode >= 144 ifTrue: "short jumps"
+ 		[^1].
+ 	"extensions"
+ 	bytecode >= 128 ifTrue:
+ 		[^#(2 2 2 2 3 2 2 1 1 1 2 nil 3 3 3 4) at: bytecode - 127].
+ 	^nil!

Item was added:
+ ----- Method: EncoderForV3PlusClosures class>>createClosureScanBlock (in category 'compiled method support') -----
+ createClosureScanBlock
+ 	"Answer a block argument for InstructionStream>>scanFor: that answers true
+ 	 for block closure creation bytecodes."
+ 	^[ :bc | bc = 143]!

Item was added:
+ ----- Method: EncoderForV3PlusClosures class>>isStoreAt:in: (in category 'instruction stream support') -----
+ isStoreAt: pc in: method
+ 	"Answer whether the bytecode at pc is a store or store-pop."
+ 
+ 	| byte |
+ 	byte := method at: pc.
+ 	^(byte between: 96 and: 142)
+ 		and: [byte <= 111				"96 103	storeAndPopReceiverVariableBytecode"
+ 										"104 111	storeAndPopTemporaryVariableBytecode"
+ 			or: [byte >= 129			"129		extendedStoreBytecode"
+ 				and: [byte <= 130		"130		extendedStoreAndPopBytecode"
+ 					or: [(byte = 132	"132		doubleExtendedDoAnythingBytecode"
+ 						and: [(method at: pc+1) >= 160])
+ 					or: [byte = 141		"141		storeRemoteTempLongBytecode"
+ 					or: [byte = 142		"142		storeAndPopRemoteTempLongBytecode"]]]]]]!

Item was added:
+ ----- Method: EncoderForV3PlusClosures class>>isStorePopAt:in: (in category 'instruction stream support') -----
+ isStorePopAt: pc in: method
+ 	"Answer whether the bytecode at pc is a store-pop."
+ 
+ 	| byte |
+ 	byte := method at: pc.
+ 	^(byte between: 96 and: 111)	"96 103	storeAndPopReceiverVariableBytecode"
+ 									"104 111	storeAndPopTemporaryVariableBytecode"
+ 	  or: [byte = 130				"130		extendedStoreAndPopBytecode"
+ 	  or: [byte = 142]]				"142		storeAndPopRemoteTempLongBytecode"!

Item was added:
+ ----- Method: EncoderForV3PlusClosures class>>supportsClosures (in category 'compiled method support') -----
+ supportsClosures
+ 	"Answer if the instruction set supports closures (contains
+ 	 closure creation and indirect temp access bytecodes)."
+ 
+ 	^true!



More information about the Squeak-dev mailing list