[Vm-dev] Re: [Pharo-project] is there a way to avoid all the #tryNamedPrimitive:with: * in ProtoObject

[Eliot Miranda]

On Mon, Jan 23, 2012 at 8:52 AM, Mariano Martinez Peck <
marianopeck at gmail.com> wrote:

> Hi guys. I usually like to take a look to ProtoObject and see what is
> really needed for the minimal object. But having 30% of the methods being
> #tryNamedPrimitive:with: *  is not fun.
> So...I wonder, do you think there could be another way so that to avoid
> having all those methods in ProtoObject ?
>

Yes there is.  I implemented primitive 218 in
Cog, primitiveDoNamedPrimitiveWithArgs, which is accessed via


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 := #(
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}].
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

(cf tryPrimitive: withArgs:) and used in


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. Any primitive which
provokes
 execution needs to be intercepted and simulated to avoid execution running
away."
 | value |
"If successful, push result and return resuming context, else ^ {
PrimitiveFailToken. errorCode }"
(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])
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:...]"
ifTrue: [^receiver pushArgs: arguments from: self].
(primitiveIndex = 82 and: [(self objectClass: receiver) == 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
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
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].
 ^(value isArray
    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
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 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: [arguments last class == 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]].
^(value isArray
    and: [value size = 2
    and: [value first == PrimitiveFailToken]])
ifTrue: [value]
ifFalse: [self push: value]

(find attached).  But these need implementing in the standard VM before
they can be used in Pharo, Squeak, etc.


> Thanks
>
> --
> Mariano
> http://marianopeck.wordpress.com
>
>


-- 
best,
Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20120123/52faf157/attachment-0001.htm