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

commits at source.squeak.org commits at source.squeak.org
Thu Apr 13 16:23:00 UTC 2017


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

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

Name: Kernel-eem.1094
Author: eem
Time: 13 April 2017, 9:22:45.544636 am
UUID: ef197114-f2d6-437c-920f-1940bfe2b414
Ancestors: Kernel-eem.1093

Correct the SistaV1 bytecoders decoders up to immedately before the ensure4llocableSlots: bytecode (which is subject to change).

Add incomplete directedSuperSend:numArgs: support.

=============== Diff against Kernel-eem.1093 ===============

Item was added:
+ ----- Method: InstructionClient>>directedSuperSend:numArgs: (in category 'instruction decoding') -----
+ directedSuperSend: selector numArgs: numArgs
+ 	"Send Message Above Specific Class With Selector, selector, bytecode.
+ 	 Start the lookup above the class that is the value of the association on
+ 	 top of stack. The arguments  of the message are found in the top numArgs
+ 	 stack locations beneath the association, and the receiver just below them."!

Item was added:
+ ----- Method: InstructionPrinter>>directedSuperSend:numArgs: (in category 'instruction decoding') -----
+ directedSuperSend: selector "<Symbol>" numArgs: numArgs "<SmallInteger>"
+ 	self print: 'directedSuperSend: ' , (self stringForSelector: selector numArgs: numArgs)!

Item was changed:
  ----- 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 pushTemporaryVariable: byte].
  			^self unusedBytecode: client at: startPC].
  		bytecode = 231 ifTrue:
  			[^byte < 128
  				ifTrue: [client pushNewArrayOfSize: byte]
  				ifFalse: [client pushConsArrayWithElements: byte - 128]].
  		bytecode = 232 ifTrue:
  			[^client pushConstant: ((extB < 128 ifTrue: [extB] ifFalse: [extB - 256]) bitShift: 8) + byte].
  		^client pushConstant: (Character value: (extB bitShift: 8) + byte)].
  	bytecode < 240 ifTrue: "sends, trap and jump"
  		[bytecode < 236 ifTrue: "sends"
+ 			[(bytecode = 235 and: [extB >= 64]) ifTrue:
+ 				[^client
+ 					directedSuperSend: (method literalAt: (extA bitShift: 5) + (byte // 8) + 1)
+ 					numArgs: (extB - 64 bitShift: 3) + (byte \\ 8)].
+ 			 ^client
- 			[^client
  				send: (method literalAt: (extA bitShift: 5) + (byte // 8) + 1)
  				super: bytecode = 235
  				numArgs: (extB bitShift: 3) + (byte \\ 8)].
  		 bytecode = 236 ifTrue:
+ 			[^self unusedBytecode: client at: startPC]. "reserved for ensureAllocableSlots:"
- 			[^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 changed:
  ----- 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 literal |
- 	| method byte2 byte3 |
  	method := self method.
  	byte2 := method at: pc.
  	byte3 := method at: pc + 1.
  	pc := pc + 2.
+ 
+ 	"**	248	(2)	11111000 	iiiiiiii		mssjjjjj		Call Primitive #iiiiiiii + (jjjjj * 256) 
+ 									m=1 means inlined primitive, no hard return after execution. 
+ 									ss defines the unsafe operation set used to encode the operations. 
+ 									(ss = 0 means sista unsafe operations, ss = 01 means lowcode operations, other numbers are not used)
+ 									Lowcode inlined primitives may have extensions."
- 	"we search the bytecodes by what we expect to be the static frequency."
  	bytecode = 248 ifTrue:
+ 		[| primitiveSetSelector primitiveNumber |
+ 		 byte3 < 128 ifTrue:
+ 			[ "Maybe this should be restricted to the 13 bit primitiveNumber too..."
+ 			 ^client callPrimitive: byte2 + (byte3 bitShift: 8)].
+ 		 primitiveSetSelector := (byte3 bitShift: -5) bitAnd: 3.
+ 		 primitiveNumber := byte2 + ((byte3 bitAnd: 31) bitShift: 8).
+ 		 primitiveSetSelector = 0 ifTrue: "Sista inline primitives"
+ 			[^client callInlinePrimitive: byte2 + (byte3 - 128 bitShift: 8)].
+ 		 primitiveSetSelector = 1 ifTrue: "Lowcode inline primitives"
+ 			[^client callLowcodeInlinePrimitive: byte2 + (byte3 - 128 bitShift: 8) extA: extA extB: extB].
+ 		 "fall through to ^self unusedBytecode: client at: startPC below"].
+ 
+ 	"*	249		11111001	xxxxxxxx	siyyyyyy	push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1"
+ 	bytecode = 249 ifTrue:
+ 		[literal := method literalAt: (extA bitShift: 8) + byte2 + 1.
+ 		 (byte3 noMask: 16rC0) ifTrue:
+ 			[^client pushFullClosure: literal numCopied: byte3].
+ 		 ^client
+ 			pushFullClosure: literal
+ 			numCopied: (byte3 bitAnd: 16r3F)
+ 			receiverOnStack: (byte3 anyMask: 16r80)
+ 			ignoreOuterContext: (byte3 anyMask: 16r40)].
- 		[^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 storeIntoRemoteTemp: byte2 inVectorAt: byte3].
  	bytecode = 253 ifTrue:
  		[^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
+ 	"**	254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
+ 	bytecode = 254 ifTrue: "The sign bit of extB inverts the operation.  Would like to have extB < -128, but this is good enough for now."
+ 		[literal := method literalAt: (extA bitShift: 8) + byte2 + 1.
+ 		 extB < 0 ifTrue: [^client branchIfInstanceOf: literal distance: (extB + 128 bitShift: 8) + byte3].
+ 		 ^client branchIfNotInstanceOf: literal distance: (extB bitShift: 8) + byte3].
- 	"249		11111001 	xxxxxxxx	syyyyyyy	Reserved for Push Float"
- 	"254-255	1111111 i	xxxxxxxx	yyyyyyyy	UNASSIGNED"
  	^self unusedBytecode: client at: startPC!

Item was changed:
  ----- 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 = 2 ifTrue:
  				[^self interpretSistaV1ExtendedPush: extB for: client].
  			 offset = 3 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 = 8 ifTrue:
  			[^client doPop].
  		 offset = 9 ifTrue:
+ 			[^client trap].
- 			[^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!



More information about the Packages mailing list