[Vm-dev] VM Maker: BytecodeSets-eem.8.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Aug 1 17:49:39 UTC 2014


Eliot Miranda uploaded a new version of BytecodeSets to project VM Maker:
http://source.squeak.org/VMMaker/BytecodeSets-eem.8.mcz

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

Name: BytecodeSets-eem.8
Author: eem
Time: 1 August 2014, 7:49:32.498 am
UUID: cc38f5a1-1f71-4460-bae8-dcabb95e0bc4
Ancestors: BytecodeSets-eem.7

Implement the 1-byte and jump bytecode decoders for
SistaV1 and add the blockReturnConstant: bytecode (for
blockReturnNil)..

Implement the genTrapIfNotInstanceOf: encoder.

=============== Diff against BytecodeSets-eem.7 ===============

Item was added:
+ ----- Method: BlockLocalTempCounter>>blockReturnConstant: (in category '*BytecodeSets-instruction decoding') -----
+ blockReturnConstant: value
+ 	"Return Constant From Block bytecode."
+ 	scanner pc < blockEnd ifTrue:
+ 		[self doJoin]!

Item was added:
+ ----- Method: ClosureExtractor>>blockReturnConstant: (in category '*BytecodeSets-instruction decoding') -----
+ blockReturnConstant: value
+ 	currentContext := currentContext sender!

Item was added:
+ ----- Method: Decompiler>>blockReturnConstant: (in category '*BytecodeSets-instruction decoding') -----
+ blockReturnConstant: value
+ 
+ 	self pushConstant: value; blockReturnTop!

Item was added:
+ ----- Method: EncoderForSistaV1>>genTrapIfNotInstanceOf: (in category 'bytecode generation') -----
+ genTrapIfNotInstanceOf: literalIndex
+ 	"*	236		11101100	iiiiiiii		Trap If Not Instance Of Behavior/Array Of Behavior #iiiiiiii (+ Extend A * 256, where Extend A >= 0)"
+ 
+ 	| extendedIndex |
+ 	(literalIndex < 0 or: [literalIndex > 65535]) ifTrue:
+ 		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65536].
+ 	(extendedIndex := literalIndex) > 255 ifTrue:
+ 		[self genUnsignedSingleExtendA: extendedIndex // 256.
+ 		 extendedIndex := extendedIndex \\ 256].
+ 	stream
+ 		nextPut: 236;
+ 		nextPut: extendedIndex!

Item was added:
+ ----- Method: InstructionClient>>blockReturnConstant: (in category '*BytecodeSets-instruction decoding') -----
+ blockReturnConstant: value
+ 	"Return Constant From Block bytecode."
+ 
+ !

Item was added:
+ ----- Method: InstructionPrinter>>blockReturnConstant: (in category '*BytecodeSets-instruction decoding') -----
+ blockReturnConstant: value 
+ 	"Print the Return Constant From Block bytecode."
+ 
+ 	self print: 'blockReturn: ', value printString!

Item was added:
+ ----- Method: InstructionStream>>interpretNextSistaV1InstructionFor: (in category '*BytecodeSets-SistaV1-decoding') -----
+ interpretNextSistaV1InstructionFor: client
+ 	"Send to the argument, client, a message that specifies the next instruction."
+ 
+ 	| byte div16 offset method extA extB savedPC |
+ 	method := self method.
+ 	"For a table of the bytecode set, see EncoderForSistaV1's class comment."
+ 	"consume and compute any extensions first."
+ 	extA := extB := 0.
+ 	savedPC := pc.
+ 	[byte := self method at: pc.
+ 	 pc := pc + 1.
+ 	 byte >= 16rE0 and: [byte <= 16rE1]] whileTrue:
+ 		[| extByte |
+ 		 extByte := self method at: pc.
+ 		 pc := pc + 1.
+ 		 byte = 16rE0
+ 			ifTrue:
+ 				[extA := (extA bitShift: 8) + extByte]
+ 			ifFalse:
+ 				[extB := (extB = 0 and: [extByte > 127])
+ 							ifTrue: [extByte - 256]
+ 							ifFalse: [(extB bitShift: 8) + extByte]]].
+ 	div16 := byte // 16.
+ 	offset := byte \\ 16.
+ 	"We do an inline quasi-binary search on each of the possible 16 values of div16"
+ 	div16 < 11 ifTrue:
+ 		[div16 < 5 ifTrue:
+ 			[div16 < 2 ifTrue:
+ 				[div16 = 0 ifTrue:
+ 					 [^client pushReceiverVariable: offset].
+ 				^client pushLiteralVariable: (method literalAt: offset + 1)]. "div16 = 1"
+ 			 ^client pushConstant: (method literalAt: byte \\ 32 + 1)].
+ 		 div16 < 6
+ 			ifTrue:
+ 				[div16 = 4 ifTrue:
+ 					[offset < 12 ifTrue:
+ 						[^client pushTemporaryVariable: offset].
+ 					 offset = 12 ifTrue:
+ 						[^client pushReceiver].
+ 					 offset = 13 ifTrue:
+ 						[^client pushConstant: true].
+ 					 offset = 14 ifTrue:
+ 						[^client pushConstant: false].
+ 					 offset = 15 ifTrue:
+ 						[^client pushConstant: nil]].
+ 				 offset < 2 ifTrue:
+ 					[^client pushConstant: offset].
+ 				 offset = 3 ifTrue:
+ 					[^self interpretSistaV1ExtendedPush: extB for: client].
+ 				 offset = 4 ifTrue:
+ 					[^client doDup].
+ 				 offset = 8 ifTrue:
+ 					[^client methodReturnReceiver].
+ 				 offset = 9 ifTrue:
+ 					[^client methodReturnConstant: true].
+ 				 offset = 10 ifTrue:
+ 					[^client methodReturnConstant: false].
+ 				 offset = 11 ifTrue:
+ 					[^client methodReturnConstant: nil].
+ 				 offset = 12 ifTrue:
+ 					[^client methodReturnTop].
+ 				 offset = 13 ifTrue:
+ 					[^client blockReturnConstant: nil].
+ 				 offset = 14 ifTrue:
+ 					[^client blockReturnTop].
+ 				 offset = 15 ifTrue:
+ 					[^client doNop].
+ 				 ^self unusedBytecode: client at: savedPC].
+ 		"short sends"
+ 		div16 < 8 ifTrue: "special selector sends"
+ 			[div16 = 6 ifTrue:
+ 				[^client
+ 					send: (Smalltalk specialSelectorAt: offset + 1)
+ 					super: false
+ 					numArgs: (Smalltalk specialNargsAt: offset + 1)].
+ 			 ^client
+ 				send: (Smalltalk specialSelectorAt: offset + 17)
+ 				super: false
+ 				numArgs: (Smalltalk specialNargsAt: offset + 17)].
+ 		^client
+ 			send: (method literalAt: offset + 1)
+ 			super: false
+ 			numArgs: div16 - 8].
+ 	"div16 >= 11; bytecode >= 176"
+ 	div16 < 14 ifTrue:
+ 		[div16 = 11 ifTrue:
+ 			[offset < 8 ifTrue:
+ 				[^client jump: offset + 1].
+ 			 ^client jump: offset - 7 if: true].
+ 		 div16 = 12 ifTrue:
+ 			[offset < 8 ifTrue:
+ 				[^client jump: offset + 1 if: false].
+ 			 ^client popIntoReceiverVariable: offset - 8].
+ 		 "div16 = 13"
+ 		 offset < 8 ifTrue:
+ 		 	[^client popIntoTemporaryVariable: offset].
+ 		 offset = 9 ifTrue:
+ 			[^client doDup].
+ 		 ^self unusedBytecode: client at: savedPC].
+ 	"2 byte and 3 byte codes"
+ 	byte < 248 ifTrue:
+ 		[^self interpretNext2ByteSistaV1Instruction: byte for: client extA: extA extB: extB startPC: savedPC].
+ 	^self interpretNext3ByteSistaV1Instruction: byte for: client extA: extA extB: extB startPC: savedPC!

Item was added:
+ ----- Method: InstructionStream>>interpretSistaV1ExtendedPush:for: (in category '*BytecodeSets-SistaV1-decoding') -----
+ interpretSistaV1ExtendedPush: extB for: client
+ 	"Implement the extended push for non-zero extensions."
+ 	"*	82			01010010			Push thisContext, (then Extend B = 1 => push thisProcess)"
+ 	extB = 0 ifTrue:
+ 		[^client pushActiveContext].
+ 	extB = 1 ifTrue:
+ 		[^client pushActiveProcess].
+ 	self error: 'undefined extended push'!

Item was added:
+ ----- Method: InstructionStream>>interpretSistaV1Jump (in category '*BytecodeSets-SistaV1-decoding') -----
+ interpretSistaV1Jump
+ 	"If the instruction at pc is an unconditional jump, interpret it, advancing the pc,
+ 	 and answering the jump distance. Otherwise answer nil."
+ 
+ 	"	176-183	10110 iii				Jump iii + 1 (i.e., 1 through 8)
+ 	 *	225/16rE1	11100001	sbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
+ 	 *	237		11101101	iiiiiiii		Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
+ 	| method byte nextpc extB |
+ 	method := self method.
+ 	"consume and compute any extension first."
+ 	extB := 0.
+ 	nextpc := pc. "must not advance pc unless this is a jump."
+ 	[byte := self method at: nextpc.
+ 	 nextpc := nextpc + 1.
+ 	 byte = 16rE1] whileTrue:
+ 		[| extByte |
+ 		 extByte := self method at: nextpc.
+ 		 nextpc := nextpc + 1.
+ 		 extB := (extB = 0 and: [extByte > 127])
+ 					ifTrue: [extByte - 256]
+ 					ifFalse: [(extB bitShift: 8) + extByte]].
+ 	(byte between: 176 and: 183) ifTrue:
+ 		[pc := nextpc.
+ 		 ^byte - 191].
+ 	byte = 237 ifTrue:
+ 		[byte := method at: nextpc.
+ 		 pc := nextpc + 1.
+ 		 ^(extB bitShift: 8) + byte].
+ 	^nil!

Item was added:
+ ----- Method: InstructionStream>>interpretSistaV1JumpIfCond (in category '*BytecodeSets-SistaV1-decoding') -----
+ interpretSistaV1JumpIfCond
+ 	"If the instruction at pc is a conditional jump, interpret it, advancing the pc,
+ 	 and answering the jump distance. Otherwise answer nil."
+ 
+ 	"	184-191	10111 iii				Pop and Jump 0n True iii +1 (i.e., 1 through 8)
+ 		192-199	11000 iii				Pop and Jump 0n False iii +1 (i.e., 1 through 8)
+ 	 *	225/E1		11100001	sbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
+ 	 *	238		11101110	iiiiiiii		Pop and Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0)
+ 	 *	239		11101111	iiiiiiii		Pop and Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0)"
+ 	| method byte nextpc extB |
+ 	method := self method.
+ 	"consume and compute any extension first."
+ 	extB := 0.
+ 	nextpc := pc. "must not advance pc unless this is a jump."
+ 	[byte := self method at: nextpc.
+ 	 nextpc := nextpc + 1.
+ 	 byte = 16rE1] whileTrue:
+ 		[| extByte |
+ 		 extByte := self method at: nextpc.
+ 		 nextpc := nextpc + 1.
+ 		 extB := (extB = 0 and: [extByte > 127])
+ 					ifTrue: [extByte - 256]
+ 					ifFalse: [(extB bitShift: 8) + extByte]].
+ 	(byte between: 184 and: 199) ifTrue:
+ 		[pc := nextpc.
+ 		 ^(byte bitAnd: 7) + 1].
+ 	(byte between: 238 and: 239) ifTrue:
+ 		[byte := method at: nextpc.
+ 		 pc := nextpc + 1.
+ 		 ^(extB bitShift: 8) + byte].
+ 	^nil!

Item was added:
+ ----- Method: MethodContext>>blockReturnConstant: (in category '*BytecodeSets-instruction decoding') -----
+ blockReturnConstant: value
+ 	"Simulate the interpreter's action when a ReturnConstantToCaller bytecode is 
+ 	 encountered in the receiver.  This should only happen in a closure activation."
+ 	self assert: closureOrNil isClosure.
+ 	^self return: value from: self!



More information about the Vm-dev mailing list