[squeak-dev] The Trunk: Kernel-eem.1075.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Mar 30 19:26:31 UTC 2017


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

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

Name: Kernel-eem.1075
Author: eem
Time: 29 March 2017, 2:44:46.228466 pm
UUID: 31d3d682-f16d-4295-82d3-07689acf53b4
Ancestors: Kernel-eem.1074

Change senders of primitiveFailTokenFor: to send to MethodContext not ContextPart.

=============== Diff against Kernel-eem.1074 ===============

Item was changed:
  ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') -----
  simulateValueWithArguments: anArray caller: aContext
  	"Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
  	| newContext sz |
  	newContext := (MethodContext newForMethod: outerContext method)
  						setSender: aContext
  						receiver: outerContext receiver
  						method: outerContext method
  						closure: self
  						startpc: startpc.
  	((newContext objectClass: anArray) ~~ Array
  	 or: [numArgs ~= anArray size]) ifTrue:
+ 		[^MethodContext primitiveFailTokenFor: nil].
- 		[^ContextPart primitiveFailTokenFor: nil].
  	sz := self basicSize.
  	newContext stackp: sz + numArgs.
  	1 to: numArgs do:
  		[:i| newContext at: i put: (anArray at: i)].
  	1 to: sz do:
  		[:i| newContext at: i + numArgs put: (self at: i)].
  	^newContext!

Item was changed:
  ----- Method: MethodContext>>doPrimitive:method:receiver:args: (in category 'private') -----
  doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
  	"Simulate a primitive method whose index is primitiveIndex.  The simulated receiver and
  	 arguments are given as arguments to this message. If successful, push result and return
  	 resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
  	 execution needs to be intercepted and simulated to avoid execution running away."
  
  	| value |
  	"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
  	 the debugger from entering various run-away activities such as spawning a new
  	 process, etc.  Injudicious use results in the debugger not being able to debug
  	 interesting code, such as the debugger itself.  hence use primitive 19 with care :-)"
  	"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
  	primitiveIndex = 19 ifTrue:
  		[ToolSet 
  			debugContext: self
  			label:'Code simulation error'
  			contents: nil].
  
  	((primitiveIndex between: 201 and: 222)
  	 and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
  		[((primitiveIndex between: 201 and: 205)			 "BlockClosure>>value[:value:...]"
  		  or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
  			[^receiver simulateValueWithArguments: arguments caller: self].
  		 primitiveIndex = 206 ifTrue:						"BlockClosure>>valueWithArguments:"
  			[^receiver simulateValueWithArguments: arguments first caller: self]].
  
  	primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
  		[^self send: arguments first to: receiver with: arguments allButFirst super: false].
  	primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
  		[^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
  	primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
  		[^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
  
  	"Mutex>>primitiveEnterCriticalSection
  	 Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
  	(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
  		[| effective |
  		 effective := Processor activeProcess effectiveProcess.
  		 "active == effective"
  		 value := primitiveIndex = 186
  					ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
  					ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
  		 ^(self isPrimFailToken: value)
  			ifTrue: [value]
  			ifFalse: [self push: value]].
  
  	primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
  		[((self objectClass: (arguments at: 1)) == Array
  		  and: [(self objectClass: (arguments at: 2)) includesBehavior: CompiledMethod]) ifFalse:
+ 			[^MethodContext primitiveFailTokenFor: #'bad argument'].
- 			[^ContextPart primitiveFailTokenFor: #'bad argument'].
  		 (arguments at: 2) numArgs = (arguments at: 1) size ifFalse:
+ 			[^MethodContext primitiveFailTokenFor: #'bad number of arguments'].
- 			[^ContextPart primitiveFailTokenFor: #'bad number of arguments'].
  		 (arguments at: 2) primitive > 0 ifTrue:
  			[(arguments at: 2) isQuick ifTrue:
  				[^self push: (receiver withArgs: (arguments at: 1) executeMethod: (arguments at: 2))].
  			 ^self doPrimitive: (arguments at: 2) primitive method: (arguments at: 2) receiver: receiver args: (arguments at: 1)].
  		 ^MethodContext
  			sender: self
  			receiver: receiver
  			method: (arguments at: 2)
  			arguments: (arguments at: 1)].
  
- 	"Closure primitives"
- 	(primitiveIndex = 200 and: [self == receiver]) ifTrue:
- 		"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
- 		[^self push: (BlockClosure
- 						outerContext: receiver
- 						startpc: pc + 2
- 						numArgs: arguments first
- 						copiedValues: arguments last)].
- 
  	primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM"
  		[(arguments size = 3
  		  and: [(self objectClass: arguments second) == SmallInteger
  		  and: [(self objectClass: arguments last) == Array]]) ifTrue:
  			[^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last].
  		 (arguments size = 2
  		 and: [(self objectClass: arguments first) == SmallInteger
  		 and: [(self objectClass: arguments last) == Array]]) ifFalse:
+ 			[^MethodContext primitiveFailTokenFor: nil].
- 			[^ContextPart primitiveFailTokenFor: nil].
  		 ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
  
  	value := primitiveIndex = 120 "FFI method"
  				ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
  				ifFalse:
  					[primitiveIndex = 117 "named primitives"
  						ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
  						ifFalse:
  							["should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs"
  							receiver tryPrimitive: primitiveIndex withArgs: arguments]].
  
  	^(self isPrimFailToken: value)
  		ifTrue: [value]
  		ifFalse: [self push: value]!

Item was changed:
  ----- Method: MethodContext>>send:to:with:startClass: (in category 'controlling') -----
  send: selector to: rcvr with: args startClass: startClassOrNil 
  	"Simulate the action of sending a message with selector, selector, and
  	 arguments, args, to receiver. The argument, startClassOrNil, tells whether
  	 the selector should be looked up in startClassOrNil or the class of the receiver."
  
  	| class meth val ctxt |
  	class := startClassOrNil ifNil: [self objectClass: rcvr].
  	meth := class lookupSelector: selector.
  	meth == nil ifTrue:
  		[^self
  			send: #doesNotUnderstand:
  			to: rcvr
  			with: (Array with: (Message selector: selector arguments: args))
  			startClass: class].
  	(args isArray
  	 and: [args size = meth numArgs]) ifFalse:
+ 		[^MethodContext primitiveFailTokenFor: nil].
- 		[^ContextPart primitiveFailTokenFor: nil].
  	val := self tryPrimitiveFor: meth receiver: rcvr args: args.
  	((self objectClass: val) == Array
  	 and: [val size = 2
  	 and: [val first == PrimitiveFailToken]]) ifFalse:
  		[^val].
  	(selector == #doesNotUnderstand:
  	 and: [class == ProtoObject]) ifTrue:
  		[^self error: 'Simulated message ' , (args at: 1) selector, ' not understood'].
  	ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class.
  	((self objectClass: val) == Array
  	 and: [val size = 2
  	 and: [val first == PrimitiveFailToken
  	 and: [val last notNil
  	 and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue:
  		[ctxt at: ctxt stackPtr put: val last].
  	^ctxt!

Item was changed:
  ----- Method: Mutex>>primitiveEnterCriticalSectionOnBehalfOf: (in category 'system simulation') -----
  primitiveEnterCriticalSectionOnBehalfOf: effectiveProcess
  	"Primitive. Simulate primitiveEnterCriticalSection.  The receiver
  	 must be unowned or owned by the effectiveProcess to proceed.
  	 Answer if the process is already owned by the current process."
  	<primitive: 186>
+ 	^MethodContext primitiveFailTokenFor: nil!
- 	^{ContextPart primitiveFailToken. nil}!

Item was changed:
  ----- Method: Mutex>>primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: (in category 'system simulation') -----
  primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effectiveProcess
  	"Primitive. Simulate primitiveEnterCriticalSection.  Attempt to set the ownership
  	 of the receiver.  If the receiver is unowned set its owningProcess to the
  	 effectiveProcess and answer false.  If the receiver is owned by the effectiveProcess
  	 answer true.  If the receiver is owned by some other process answer nil."
  	<primitive: 187>
+ 	^MethodContext primitiveFailTokenFor: nil!
- 	^{ContextPart primitiveFailToken. nil}!

Item was changed:
  ----- Method: ProtoObject>>tryNamedPrimitive (in category 'apply primitives') -----
  tryNamedPrimitive
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  	<primitive:'' module:'' error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryNamedPrimitive: (in category 'apply primitives') -----
  tryNamedPrimitive: arg1
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  	<primitive:'' module:'' error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryNamedPrimitive:with: (in category 'apply primitives') -----
  tryNamedPrimitive: arg1 with: arg2
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  	<primitive:'' module:'' error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryNamedPrimitive:with:with: (in category 'apply primitives') -----
  tryNamedPrimitive: arg1 with: arg2 with: arg3
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  	<primitive:'' module:'' error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with: (in category 'apply primitives') -----
  tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  	<primitive:'' module:'' error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with: (in category 'apply primitives') -----
  tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  	<primitive:'' module:'' error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with: (in category 'apply primitives') -----
  tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  	<primitive:'' module:'' error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with:with: (in category 'apply primitives') -----
  tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  	<primitive:'' module:'' error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with:with:with: (in category 'apply primitives') -----
  tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  	<primitive:'' module:'' error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryPrimitive:withArgs: (in category 'apply primitives') -----
  tryPrimitive: primIndex withArgs: argumentArray
  	"This method is a template that the Smalltalk simulator uses to 
  	execute primitives. See Object documentation whatIsAPrimitive."
  
  	<primitive: 118 error: errorCode>
+ 	^MethodContext primitiveFailTokenFor: errorCode!
- 	^ContextPart primitiveFailTokenFor: errorCode!



More information about the Squeak-dev mailing list