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

commits at source.squeak.org commits at source.squeak.org
Sat Nov 30 21:26:51 UTC 2013


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

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

Name: Kernel-eem.822
Author: eem
Time: 30 November 2013, 1:21:56.41 pm
UUID: b991e66c-90bb-4118-91c7-4b7dbe38d440
Ancestors: Kernel-cmm.821

Change the execution simulation machinery (as used by the
Debugger) to:

- use the mirror primitives to access the receiver and literal
  variables, avoiding sending messages to these objects,
  hence mimicking the VMs behaviour, and simulating the
  execution of code using proxies correctly.

- retrieve the primitive error code form failing primitives

- fix the simulation of Object>>perform:withArguments:inSuperclass:

=============== Diff against Kernel-cmm.821 ===============

Item was changed:
+ ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') -----
- ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'evaluating') -----
  simulateValueWithArguments: anArray caller: aContext
  	| newContext sz |
  	(anArray class ~~ Array
  	 or: [numArgs ~= anArray size]) ifTrue:
+ 		[^ContextPart primitiveFailTokenFor: nil].
- 		[^ContextPart primitiveFailToken].
  	newContext := (MethodContext newForMethod: outerContext method)
  						setSender: aContext
  						receiver: outerContext receiver
  						method: outerContext method
  						closure: self
  						startpc: startpc.
  	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:
  InstructionStream subclass: #ContextPart
  	instanceVariableNames: 'stackp'
+ 	classVariableNames: 'MaxLengthForASingleDebugLogReport MaxStackDepthForASingleDebugLogReport PrimitiveFailToken QuickStep ValueIndex'
- 	classVariableNames: 'MaxLengthForASingleDebugLogReport MaxStackDepthForASingleDebugLogReport PrimitiveFailToken QuickStep'
  	poolDictionaries: ''
  	category: 'Kernel-Methods'!
  
  !ContextPart commentStamp: '<historical>' prior: 0!
  To the instruction parsing ability of InstructionStream I add the actual semantics for execution. The execution state is stored in the indexable fields of my subclasses. This includes temporary variables and a stack of values used in evaluating expressions. The actual semantics of execution can be found in my category "system simulation" and "instruction decode". These methods exactly parallel the operation of the Smalltalk machine itself.
  	
  The simulator is a group of my methods that do what the Smalltalk interpreter does: execute Smalltalk bytecodes. By adding code to the simulator, you may take statistics on the running of Smalltalk methods. For example,
  	Transcript show: (ContextPart runSimulated: [3 factorial]) printString.!

Item was changed:
+ ----- Method: ContextPart class>>initialize (in category 'class initialization') -----
- ----- Method: ContextPart class>>initialize (in category 'simulation') -----
  initialize
+ 	ValueIndex := 2.
+ 	self assert: (Association instVarNameForIndex:ValueIndex) = 'value'.
+ 	PrimitiveFailToken class ~~ Object ifTrue:
+ 		[PrimitiveFailToken := Object new]!
- 
- 	"A unique object to be returned when a primitive fails during simulation"
- 	PrimitiveFailToken := Object new  !

Item was added:
+ ----- Method: ContextPart class>>primitiveFailTokenFor: (in category 'simulation') -----
+ primitiveFailTokenFor: errorCode
+ 
+ 	^{PrimitiveFailToken. errorCode}!

Item was changed:
  ----- Method: ContextPart>>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 ^ 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 primtiive 19 with care :-)"
  	"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
  	primitiveIndex = 19 ifTrue:
  		[ToolSet 
  			debugContext: self
  			label:'Code simulation error'
  			contents: nil].
  
  	"ContextPart>>blockCopy:; simulated to get startpc right"
+ 	(primitiveIndex = 80 and: [(self objectClass: receiver) includesBehavior: ContextPart]) 
- 	(primitiveIndex = 80 and: [receiver isKindOf: ContextPart]) 
  		ifTrue: [^self push: ((BlockContext newForMethod: receiver method)
  						home: receiver home
  						startpc: pc + 2
  						nargs: (arguments at: 1))].
+ 	(primitiveIndex = 81 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>value[:value:...]"
- 	(primitiveIndex = 81 and: [receiver isMemberOf: BlockContext]) "BlockContext>>value[:value:...]"
  		ifTrue: [^receiver pushArgs: arguments from: self].
+ 	(primitiveIndex = 82 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>valueWithArguments:"
- 	(primitiveIndex = 82 and: [receiver isMemberOf: BlockContext]) "BlockContext>>valueWithArguments:"
  		ifTrue: [^receiver pushArgs: arguments first from: self].
  	primitiveIndex = 83 "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
+ 		ifTrue: [^self send: arguments first
+ 					to: receiver
- 		ifTrue: [^self send: arguments first to: receiver
  					with: arguments allButFirst
  					super: false].
+ 	primitiveIndex = 84 "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
+ 		ifTrue: [^self send: arguments first
+ 					to: receiver
- 	primitiveIndex = 84 "afr 9/11/1998 19:50" "Object>>perform:withArguments:"
- 		ifTrue: [^self send: arguments first to: receiver
  					with: (arguments at: 2)
+ 					startClass: nil].
+ 	primitiveIndex = 100 "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
+ 		ifTrue: [^self send: arguments first
+ 					to: receiver
+ 					with: (arguments at: 2)
+ 					startClass: (arguments at: 3)].
+ 
+ 	"Mutex>>primitiveEnterCriticalSection
+ 	 Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
+ 	(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
+ 		[| active effective |
+ 		 active := Processor activeProcess.
+ 		 effective := active effectiveProcess.
+ 		 "active == effective"
+ 		 value := primitiveIndex = 186
+ 					ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
+ 					ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
+ 		 ^((self objectClass: value) == Array
+ 		    and: [value size = 2
+ 		    and: [value first == PrimitiveFailToken]])
+ 			ifTrue: [value]
+ 			ifFalse: [self push: value]].
+ 
+ 	primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
+ 		[^MethodContext
- 					super: false].
- 	primitiveIndex = 188 ifTrue: [
- 		arguments size = 2 ifTrue: [ "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
- 			^MethodContext
- 				sender: self
- 				receiver: receiver
- 				method: (arguments at: 2)
- 				arguments: (arguments at: 1) ].
- 		arguments size = 3 ifTrue: [ "CompiledMethod class >> #receiver:withArguments:executeMethod:"
- 			^MethodContext
- 				sender: self
- 				receiver: (arguments at: 1)
- 				method: (arguments at: 3)
- 				arguments: (arguments at: 2) ] ].
- 	primitiveIndex = 189 ifTrue: [ "Object >> (#with:)*executeMethod"
- 		^MethodContext
  			sender: self
  			receiver: receiver
+ 			method: (arguments at: 2)
+ 			arguments: (arguments at: 1)].
- 			method: arguments last
- 			arguments: arguments allButLast ].
  
  	"Closure primitives"
+ 	(primitiveIndex = 200 and: [self == receiver]) ifTrue:
- 	(primitiveIndex = 200 and: [receiver == self]) ifTrue:
  		"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
  		[^self push: (BlockClosure
  						outerContext: receiver
  						startpc: pc + 2
  						numArgs: arguments first
  						copiedValues: arguments last)].
  	((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 = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
+ 		[(arguments size = 2
+ 		 and: [arguments first isInteger
+ 		 and: [(self objectClass: arguments last) == Array]]) ifFalse:
+ 			[^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:
+ 							[receiver tryPrimitive: primitiveIndex withArgs: arguments]].
+ 	^((self objectClass: value) == Array
+ 	    and: [value size = 2
+ 	    and: [value first == PrimitiveFailToken]])
+ 		ifTrue: [value]
- 	primitiveIndex = 120 ifTrue:[ "FFI method"
- 		value := meth literals first tryInvokeWithArguments: arguments.
- 	] ifFalse:[
- 		arguments size > 6 ifTrue: [^PrimitiveFailToken].
- 		value := primitiveIndex = 117 "named primitives"
- 				ifTrue:[self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
- 				ifFalse:[receiver tryPrimitive: primitiveIndex withArgs: arguments].
- 	].
- 	^value == PrimitiveFailToken
- 		ifTrue: [PrimitiveFailToken]
  		ifFalse: [self push: value]!

Item was changed:
  ----- Method: ContextPart>>objectClass: (in category 'mirror primitives') -----
  objectClass: anObject
+ 	"Answer the class of the argument anObject without sending it a message.
+ 	 This mimics the action of the VM when it fetches an object's class.  Used to
+ 	 simulate the execution machinery by, for example, the debugger.
+ 	 Primitive.  See Object documentation whatIsAPrimitive."
  
  	<primitive: 111>
  	self primitiveFailed!

Item was changed:
  ----- Method: ContextPart>>popIntoLiteralVariable: (in category 'instruction decoding') -----
  popIntoLiteralVariable: value 
  	"Simulate the action of bytecode that removes the top of the stack and 
  	stores it into a literal variable of my method."
  
+ 	self object: value instVarAt: ValueIndex put: self pop!
- 	value value: self pop!

Item was changed:
  ----- Method: ContextPart>>popIntoReceiverVariable: (in category 'instruction decoding') -----
  popIntoReceiverVariable: offset 
  	"Simulate the action of bytecode that removes the top of the stack and 
  	stores it into an instance variable of my receiver."
  
+ 	self object: self receiver instVarAt: offset + 1 put: self pop!
- 	self receiver instVarAt: offset + 1 put: self pop!

Item was changed:
  ----- Method: ContextPart>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
  popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
  	"Simulate the action of bytecode that removes the top of the stack and  stores
  	 it into an offset in one of my local variables being used as a remote temp vector."
  
+ 	self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self pop!
- 	(self at: tempVectorIndex + 1) at: remoteTempIndex + 1 put: self pop!

Item was changed:
  ----- Method: ContextPart>>printOn: (in category 'printing') -----
  printOn: aStream 
+ 	| method selector class mclass |
+ 	(method := self method) ifNil: [^super printOn: aStream].
+ 	class := self objectClass: self receiver.
+ 	mclass := method methodClass.
+ 	selector := method selector ifNil: [method defaultSelector].
- 	| selector class mclass |
- 	self method == nil ifTrue: [^ super printOn: aStream].
- 	class := self receiver class.
- 	mclass := self methodClass.
- 	selector := self selector ifNil:[self method defaultSelector].
  	aStream nextPutAll: class name.
+ 	mclass ~~ class ifTrue:
+ 		[aStream nextPut: $(; nextPutAll: mclass name; nextPut: $)].
+ 	aStream nextPutAll: '>>'; nextPutAll: selector.
+ 	(selector == #doesNotUnderstand:
+ 	 and: [self closure isNil
+ 	 and: [(self objectClass: (self tempAt: 1)) == Message]]) ifTrue:
+ 		[aStream space.
+ 		(self tempAt: 1) selector printOn: aStream]!
- 	mclass == class 
- 		ifFalse: 
- 			[aStream nextPut: $(.
- 			aStream nextPutAll: mclass name.
- 			aStream nextPut: $)].
- 	aStream nextPutAll: '>>'.
- 	aStream nextPutAll: selector.
- 	selector = #doesNotUnderstand: ifTrue: [
- 		aStream space.
- 		(self tempAt: 1) selector printOn: aStream.
- 	].
- !

Item was changed:
  ----- Method: ContextPart>>pushLiteralVariable: (in category 'instruction decoding') -----
  pushLiteralVariable: value 
  	"Simulate the action of bytecode that pushes the contents of the literal 
  	variable whose index is the argument, index, on the top of the stack."
  
+ 	self push: (self object: value instVarAt: ValueIndex)!
- 	self push: value value!

Item was changed:
  ----- Method: ContextPart>>pushReceiverVariable: (in category 'instruction decoding') -----
  pushReceiverVariable: offset 
  	"Simulate the action of bytecode that pushes the contents of the receiver's 
  	instance variable whose index is the argument, index, on the top of the 
  	stack."
  
+ 	self push: (self object: self receiver instVarAt: offset + 1)!
- 	self push: (self receiver instVarAt: offset + 1)!

Item was changed:
  ----- Method: ContextPart>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
  pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
  	"Simulate the action of bytecode that pushes the value at remoteTempIndex
  	 in one of my local variables being used as a remote temp vector."
+ 	self push: (self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1)!
- 	self push: ((self at: tempVectorIndex + 1) at: remoteTempIndex + 1)!

Item was changed:
  ----- Method: ContextPart>>quickSend:to:with:super: (in category 'controlling') -----
  quickSend: selector to: receiver with: arguments super: superFlag
+ 	"Send the given selector with arguments in an environment which closely resembles
+ 	 the non-simulating environment, with an interjected unwind-protected block to catch
+ 	 nonlocal returns.  Attention: don't get lost!!  This beautiful method is due to
+ 	 Hans-Martin Mosner.  Eliot Miranda merely added the mirror primitive code."
+ 	| oldSender contextToReturnTo result lookupClass |
- 	"Send the given selector with arguments in an environment which closely resembles the non-simulating environment, with an interjected unwind-protected block to catch nonlocal returns.
- 	Attention: don't get lost!!"
- 	| lookupClass contextToReturnTo result |
  	contextToReturnTo := self.
  	lookupClass := superFlag
+ 					ifTrue: [self method methodClassAssociation value superclass]
+ 					ifFalse: [self objectClass: self receiver].
+ 	[oldSender := thisContext sender swapSender: self.
+ 	result := self object: receiver perform: selector withArguments: arguments inClass: lookupClass.
+ 	thisContext sender swapSender: oldSender] ifCurtailed:
+ 		[contextToReturnTo := thisContext sender receiver.	"The block context returning nonlocally"
- 					ifTrue: [(self method literalAt: self method numLiterals) value superclass]
- 					ifFalse: [receiver class].
- 	[ | oldSender |
- 	oldSender := thisContext sender swapSender: self.
- 	result := receiver perform: selector withArguments: arguments inSuperclass: lookupClass.
- 	thisContext sender swapSender: oldSender] ifCurtailed: [
- 		contextToReturnTo := thisContext sender receiver.	"The block context returning nonlocally"
  		contextToReturnTo jump: -1.	"skip to front of return bytecode causing this unwind"
+ 		contextToReturnTo nextByte = 16r7C ifTrue:
- 		contextToReturnTo nextByte = 16r7C ifTrue: [
  			"If it was a returnTop, push the value to be returned.
  			Otherwise the value is implicit in the bytecode"
+ 			[contextToReturnTo push: (thisContext sender tempAt: 1)].
- 			contextToReturnTo push: (thisContext sender tempAt: 1)].
  		thisContext swapSender: thisContext home sender.	"Make this block return to the method's sender"
  		contextToReturnTo].
  	contextToReturnTo push: result.
  	^contextToReturnTo!

Item was added:
+ ----- Method: ContextPart>>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:
+ 		[^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: ContextPart>>send:to:with:super: (in category 'controlling') -----
  send: selector to: rcvr with: args super: superFlag 
+ 	"Simulate the action of sending a message with selector, selector, and
+ 	 arguments, args, to receiver. The argument, superFlag, tells whether the
+ 	 receiver of the message was specified with 'super' in the source method."
- 	"Simulate the action of sending a message with selector, selector, and 
- 	arguments, args, to receiver. The argument, superFlag, tells whether the 
- 	receiver of the message was specified with 'super' in the source method."
  
+ 	| class meth val ctxt |
- 	| class meth val |
  	class := superFlag
+ 				ifTrue: [self method methodClassAssociation value superclass]
+ 					ifFalse: [self objectClass: rcvr].
- 			ifTrue: [(self method literalAt: self method numLiterals) value superclass]
- 			ifFalse: [rcvr class].
  	meth := class lookupSelector: selector.
+ 	meth == nil ifTrue:
+ 		[^self
+ 			send: #doesNotUnderstand:
+ 			to: rcvr
+ 			with: (Array with: (Message selector: selector arguments: args))
+ 			super: superFlag].
+ 	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!
- 	meth == nil
- 		ifTrue: [^ self send: #doesNotUnderstand:
- 					to: rcvr
- 					with: (Array with: (Message selector: selector arguments: args))
- 					super: superFlag]
- 		ifFalse: [val := self tryPrimitiveFor: meth
- 						receiver: rcvr
- 						args: args.
- 				val == PrimitiveFailToken ifFalse: [^ val].
- 				(selector == #doesNotUnderstand: and: [class == ProtoObject]) ifTrue:
- 					[^ self error: 'Simulated message ' , (args at: 1) selector
- 									, ' not understood'].
- 				^ self activateMethod: meth
- 					withArgs: args
- 					receiver: rcvr
- 					class: class]!

Item was changed:
  ----- Method: ContextPart>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
  storeIntoLiteralVariable: value 
  	"Simulate the action of bytecode that stores the top of the stack into a 
  	literal variable of my method."
  
+ 	self object: value instVarAt: ValueIndex put: self top!
- 	value value: self top!

Item was changed:
  ----- Method: ContextPart>>storeIntoReceiverVariable: (in category 'instruction decoding') -----
  storeIntoReceiverVariable: offset 
  	"Simulate the action of bytecode that stores the top of the stack into an 
  	instance variable of my receiver."
  
+ 	self object: self receiver instVarAt: offset + 1 put: self top!
- 	self receiver instVarAt: offset + 1 put: self top!

Item was changed:
  ----- Method: ContextPart>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
  storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
  	"Simulate the action of bytecode that stores the top of the stack at
  	 an offset in one of my local variables being used as a remote temp vector."
  
+ 	self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self top!
- 	(self at: tempVectorIndex + 1) at: remoteTempIndex + 1 put: self top!

Item was changed:
  ----- Method: ContextPart>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') -----
  tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
+ 	| selector theMethod spec receiverClass |
+ 	<primitive: 218 error: ec>
+ 	ec ifNotNil:
+ 		["If ec is an integer other than -1 there was a problem with primitive 218,
+ 		  not with the external primitive itself.  -1 indicates a generic failure (where
+ 		  ec should be nil) but ec = nil means primitive 218 is not implemented.  So
+ 		  interpret -1 to mean the external primitive failed with a nil error code."
+ 		 ec isInteger ifTrue:
+ 			[ec = -1
+ 				ifTrue: [ec := nil]
+ 				ifFalse: [self primitiveFailed]].
+ 		^{PrimitiveFailToken. ec}].
+ 	"Assume a nil error code implies the primitive is not implemented and fall back on the old code."
  	"Hack. Attempt to execute the named primitive from the given compiled method"
+ 	arguments size > 8 ifTrue:
+ 		[^{PrimitiveFailToken. nil}].
- 	| selector theMethod spec |
- 	arguments size > 8 ifTrue:[^PrimitiveFailToken].
  	selector := #(
  		tryNamedPrimitive 
  		tryNamedPrimitive: 
  		tryNamedPrimitive:with: 
  		tryNamedPrimitive:with:with: 
  		tryNamedPrimitive:with:with:with:
  		tryNamedPrimitive:with:with:with:with:
  		tryNamedPrimitive:with:with:with:with:with:
  		tryNamedPrimitive:with:with:with:with:with:with:
  		tryNamedPrimitive:with:with:with:with:with:with:with:) at: arguments size+1.
+ 	receiverClass := self objectClass: aReceiver.
+ 	theMethod := receiverClass lookupSelector: selector.
+ 	theMethod == nil ifTrue:
+ 		[^{PrimitiveFailToken. nil}].
- 	theMethod := aReceiver class lookupSelector: selector.
- 	theMethod == nil ifTrue:[^PrimitiveFailToken].
  	spec := theMethod literalAt: 1.
  	spec replaceFrom: 1 to: spec size with: (aCompiledMethod literalAt: 1) startingAt: 1.
+ 	Smalltalk unbindExternalPrimitives.
+ 	^self object: aReceiver perform: selector withArguments: arguments inClass: receiverClass!
- 	theMethod flushCache.
- 	selector flushCache.
- 	^aReceiver perform: selector withArguments: arguments!

Item was changed:
  ----- Method: ContextPart>>tryPrimitiveFor:receiver:args: (in category 'private') -----
  tryPrimitiveFor: method receiver: receiver args: arguments 
  	"If this method has a primitive index, then run the primitive and return its result.
  	Otherwise (and also if the primitive fails) return PrimitiveFailToken,
  	as an indication that the method should be activated and run as bytecodes."
  	| primIndex |
+ 	(primIndex := method primitive) = 0 ifTrue: [^{PrimitiveFailToken. nil}].
- 	(primIndex := method primitive) = 0 ifTrue: [^ PrimitiveFailToken].
  	^ self doPrimitive: primIndex method: method receiver: receiver args: arguments!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive:'' module:''>
- 	^ ContextPart primitiveFailToken!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive:'' module:''>
- 	^ ContextPart primitiveFailToken!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive:'' module:''>
- 	^ ContextPart primitiveFailToken!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive:'' module:''>
- 	^ ContextPart primitiveFailToken!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive:'' module:''>
- 	^ ContextPart primitiveFailToken!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive:'' module:''>
- 	^ ContextPart primitiveFailToken!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive:'' module:''>
- 	^ ContextPart primitiveFailToken!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive:'' module:''>
- 	^ ContextPart primitiveFailToken!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive:'' module:''>
- 	^ ContextPart primitiveFailToken!

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>
+ 	^ContextPart primitiveFailTokenFor: errorCode!
- 	<primitive: 118>
- 	^ ContextPart primitiveFailToken!



More information about the Squeak-dev mailing list