Hi James,

2010/8/11 James Ladd <james_l...@hotmail.com>

>  Hi Eliot,
>
> That is a very nice blog you linked me to. Lots for me to read there.
>
> I read this ...
>
> The final bytecode is more interesting.
>         143         10001111 llllkkkk jjjjjjjj iiiiiiii         Push
> Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii
> This creates a closure, initializing it from the arguments and the current
> context.
>
> I'm missing something, is "num copied  llll"  the number of temps copied
> from the containing method?
>

It is the number of values copied from the stack that become locals of the
closure.  In
Collection>>inject: thisValue into: binaryBlock
"Accumulate a running value associated with evaluating the argument,
binaryBlock, with the current value of the argument, thisValue, and the
receiver as block arguments. For instance, to sum the numeric elements
of a collection, aCollection inject: 0 into: [:subTotal :next | subTotal +
next]."

| nextValue |
nextValue := thisValue.
self do: [:each | nextValue := binaryBlock value: nextValue value: each].
^nextValue

the closure [:each | nextValue := binaryBlock value: nextValue value:
each] accesses two non-local variables binaryBlock & nextValue.
 Because binaryBlock is not modified its value can be copied directly but
because nextValue is modified it cannot be copied and a shared location must
be used to hold the value.  So the compiler arranges to create an (in this
case one-element) array (an indirection vector) to hold nextValue.  The
hidden variable holding the indirection vector is not modified so its value
(the indirection vector) can be copied.  Hence [:each | nextValue :=
binaryBlock value: nextValue value: each] has two copied values, one the
value of binaryBlock and another a hidden Array that holds nextValue.  Hence
the bytecode:

push: (Array new: 1)  # create the indirection vector
popIntoTemp: 2   # store it as the 3rd temp (after firstValue & binaryBlock)
pushTemp: 0   # push firstValue
popIntoTemp: 0 inVectorAt: 2 # initialize nextValue with firstValue
self    # push the receiver of #do:
pushTemp: 1   # push the first copied value binaryBlock
pushTemp: 2   # push the second copied value, the indirection vector holding
nextValue
closureNumCopied: 2 numArgs: 1 bytes 31 to 40 # create the closure with 1
arg and 2 copied values
pushTemp: 1  # push binaryBlock (the 1st copied value, the 2nd temp after
each)
pushTemp: 0 inVectorAt: 2 # push nextValue, the 1st slot in the indirection
vector which is the 3rd temp
pushTemp: 0  # push each
send: #value:value: (2 args) # evaluate binaryBlock value: nextValue value:
each
storeIntoTemp: 0 inVectorAt: 2 # store the result into nextValue (1st slot
in indirection vector)
blockReturn  # return nextValue as the result of the block
send: #do: (1 arg)  # evaluate self do: [:each|...]
pop    # discard the result of elf do: [:each|...]
pushTemp: 0 inVectorAt: 2  # push nextValue
returnTop   # return nextValue as the result of inject:into:

If this still doesn't make sense look at the version in the first blog post
that uses an explicit array and compare it with the above.

HTH
Eliot


> Rgs, James.
>
> _______________________________________________
> Pharo-project mailing list
> Pharo-project@lists.gforge.inria.fr
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>
_______________________________________________
Pharo-project mailing list
Pharo-project@lists.gforge.inria.fr
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project

Reply via email to