[Pkg] The Trunk: Kernel-eem.1087.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Apr 6 01:52:31 UTC 2017


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

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

Name: Kernel-eem.1087
Author: eem
Time: 5 April 2017, 6:52:09.802183 pm
UUID: 79b19c31-bee8-4906-95da-83f2a3b61396
Ancestors: Kernel-eem.1086

Add the SistaV1 bytecode set decoders and some of the new SistaV1 bytecode support (enough for printing).

=============== Diff against Kernel-eem.1086 ===============

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

Item was added:
+ ----- Method: Context>>blockReturnConstant: (in category '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!

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

Item was changed:
  ----- Method: InstructionClient>>callPrimitive: (in category 'instruction decoding') -----
  callPrimitive: pimIndex
+ 	"SqueakV3PlusClosures:	239 11101111	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ 	 NewsqueakV4:				249 11111001	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ 	 SistaV1:					248 11111000 iiiiiiii mjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjj * 256)
+ 									m=1 means inlined primitive, no hard return after execution."!
- 	"V3PlusClosures:	139 10001011	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- 	 NewsqueakV4:		249 11111001	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- 	 SistaV1:			248 11111000 iiiiiiii mjjjjjjj  Call Primitive #iiiiiiii + ( jjjjjjj * 256)
- 							m=1 means inlined primitive, no hard return after execution."!

Item was added:
+ ----- Method: InstructionClient>>trapIfNotInstanceOf: (in category 'instruction decoding') -----
+ trapIfNotInstanceOf: behaviorOrArrayOfBehavior
+ 	"If the top of stack is not an instance of either the argument, or, if the argument is an Array,
+ 	  any of the elements of the argument, send the class trap message to the current context."!

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

Item was added:
+ ----- Method: InstructionPrinter>>trapIfNotInstanceOf: (in category 'instruction decoding') -----
+ trapIfNotInstanceOf: behaviorOrArrayOfBehavior
+ 	"If the top of stack is not an instance of either the argument, or, if the argument is an Array,
+ 	  any of the elements of the argument, send the class trap message to the current context."
+ 	self print: 'trapIfNotInstanceOf: ', behaviorOrArrayOfBehavior printString!

Item was added:
+ ----- Method: InstructionStream>>interpretNext2ByteSistaV1Instruction:for:extA:extB:startPC: (in category 'decoding - private - sista v1') -----
+ interpretNext2ByteSistaV1Instruction: bytecode for: client extA: extA extB: extB startPC: startPC
+ 	"Send to the argument, client, a message that specifies the next instruction.
+ 	 This method handles the two-byte codes.
+ 	 For a table of the bytecode set, see EncoderForV1's class comment."
+ 
+ 	| byte method |
+ 	method := self method.
+ 	byte := self method at: pc.
+ 	pc := pc + 1.
+ 	"We do an inline quasi-binary search on bytecode"
+ 	bytecode < 234 ifTrue: "pushes"
+ 		[bytecode < 231 ifTrue:
+ 			[bytecode < 229 ifTrue:
+ 				[| literal |
+ 				 bytecode = 226 ifTrue:
+ 					[^client pushReceiverVariable: (extA bitShift: 8) + byte].
+ 				 literal := method literalAt: (extA bitShift: 8) + byte + 1.
+ 				 bytecode = 227 ifTrue:
+ 					[^client pushLiteralVariable: literal].
+ 				 ^client pushConstant: literal].
+ 			bytecode = 229 ifTrue:
+ 				[^client pushClosureTemps: byte].
+ 			^client pushTemporaryVariable: byte].
+ 		bytecode = 231 ifTrue:
+ 			[^byte < 128
+ 				ifTrue: [client pushNewArrayOfSize: byte]
+ 				ifFalse: [client pushConsArrayWithElements: byte - 128]].
+ 		bytecode = 232 ifTrue:
+ 			[^client pushConstant: (extB bitShift: 8) + byte].
+ 		^client pushConstant: (Character value: (extB bitShift: 8) + byte)].
+ 	bytecode < 240 ifTrue: "sends, trap and jump"
+ 		[bytecode < 236 ifTrue: "sends"
+ 			[^client
+ 				send: (method literalAt: (extA bitShift: 5) + (byte // 8) + 1)
+ 				super: bytecode = 239
+ 				numArgs: (extB bitShift: 3) + (byte \\ 8)].
+ 		 bytecode = 236 ifTrue:
+ 			[^client trapIfNotInstanceOf: (method literalAt: (extA bitShift: 8) + byte + 1)].
+ 		bytecode = 237 ifTrue:
+ 			[^client jump: (extB bitShift: 8) + byte].
+ 		 ^client jump: (extB bitShift: 8) + byte if: bytecode = 238].
+ 	bytecode < 243 ifTrue:
+ 		[bytecode = 240 ifTrue:
+ 			[^client popIntoReceiverVariable: (extA bitShift: 8) + byte].
+ 		 bytecode = 241 ifTrue:
+ 			[^client popIntoLiteralVariable: (method literalAt: (extA bitShift: 8) + byte + 1)].
+ 		 ^client popIntoTemporaryVariable: byte].
+ 	bytecode = 243 ifTrue:
+ 		[^client storeIntoReceiverVariable: (extA bitShift: 8) + byte].
+ 	bytecode = 244 ifTrue:
+ 		[^client storeIntoLiteralVariable: (method literalAt: (extA bitShift: 8) + byte + 1)].
+ 	bytecode = 245 ifTrue:
+ 		[^client storeIntoTemporaryVariable: byte].
+ 	"246-247	1111011 i	xxxxxxxx	UNASSIGNED"
+ 	^self unusedBytecode: client at: startPC!

Item was added:
+ ----- Method: InstructionStream>>interpretNext3ByteSistaV1Instruction:for:extA:extB:startPC: (in category 'decoding - private - sista v1') -----
+ interpretNext3ByteSistaV1Instruction: bytecode for: client extA: extA extB: extB startPC: startPC
+ 	"Send to the argument, client, a message that specifies the next instruction.
+ 	 This method handles the three-byte codes.
+ 	 For a table of the bytecode set, see EncoderForSistaV1's class comment."
+ 
+ 	| method byte2 byte3 |
+ 	method := self method.
+ 	byte2 := method at: pc.
+ 	byte3 := method at: pc + 1.
+ 	pc := pc + 2.
+ 	"we search the bytecodes by what we expect to be the static frequency."
+ 	bytecode = 248 ifTrue:
+ 		[^client callPrimitive: byte2 + (byte3 bitShift: 8)].
+ 	bytecode = 250 ifTrue:
+ 		["**	250  11111010  eeiiikkk  jjjjjjjj  Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions"
+ 		 ^client
+ 			pushClosureCopyNumCopiedValues: ((byte2 bitShift: -3) bitAnd: 7) + (extA // 16 bitShift: 3)
+ 			numArgs: (byte2 bitAnd: 7) + (extA \\ 16 bitShift: 3)
+ 			blockSize: byte3 + (extB bitShift: 8)].
+ 	bytecode = 251 ifTrue:
+ 		[^client pushRemoteTemp: byte2 inVectorAt: byte3].
+ 	bytecode = 252 ifTrue:
+ 		[^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
+ 	bytecode = 253 ifTrue:
+ 		[^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
+ 	"249		11111001 	xxxxxxxx	syyyyyyy	Reserved for Push Float"
+ 	"254-255	1111111 i	xxxxxxxx	yyyyyyyy	UNASSIGNED"
+ 	^self unusedBytecode: client at: startPC!

Item was added:
+ ----- Method: InstructionStream>>interpretNextSistaV1InstructionFor: (in category 'decoding - private - sista v1') -----
+ 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 < 6 ifTrue:
+ 			[div16 < 4 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 = 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]].
+ 			"div16 = 5"
+ 			 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 = 6 ifTrue:
+ 			[^client
+ 				send: (Smalltalk specialSelectorAt: offset + 1)
+ 				super: false
+ 				numArgs: (Smalltalk specialNargsAt: offset + 1)].
+ 		 div16 = 7 ifTrue:
+ 			[^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 'decoding - private - sista v1') -----
+ 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 'decoding - private - sista v1') -----
+ 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 'decoding - private - sista v1') -----
+ 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!



More information about the Packages mailing list