I am attaching the "real" (AFAIK) image level implementation of
continuations, just like in Scheme, but a comment is due first.

  Ian Piumarta writes:
  > This was for 1.21, but it probably still works in 2.2...
  > 
  >   ftp://alix.inria.fr/pub/squeak/goodies/continuations.5Augu602pm.cs
  > 
  > Ian

This implementation is incorrect in the same sense the attempt at
continuations in VW I described on c.l.s. was (and possibly the
approach Allen Wirfs-Brock described).  They all share the same idea
of copying and reinstalling the original sender chain each time a
continuation is invoked. Each new invocation rolls back over a fresh
copy of the original stack, so the variables of the contexts of the
sender chain are not shared between the invocations.  With the "real"
continuations they should be.  Dybvig's example you use does not
illustrate this point.  Here is one that does.  After evaluating:

  | sum |
  sum _ 0.
  sum _ [:k | Undeclared at: #K put: k. 0] callCC + sum.
  Transcript show: sum printString; cr

we are supposed to be able to evaluate:

  (Undeclared at: #K) value: <...aNumber...>

multiple times and see the sum of the numbers so far passed to the
continuation printed on the Transcript.  An implementation that always
uses a fresh copy of the original sender chain actually prints only
the current continuation argument (since it always uses the original
value of sum = 0).

The key to the correct implementation is to reuse the original sender
chain.  A continuation holds onto the original chain as well as onto
its copy.  Before each execution, it refers to the copy to undo the
damage done to the original chain's contexts by the previous
execution, then uses the original chain.  The damage includes the
sender, the pc, the stackp, and the indexed variables that are not the
context's temps (the stack).

--Vassili


---------------- Continuation.st -------------------

'From Squeak 2.2 of Sept 23, 1998 on 21 October 1998 at 10:25:18 pm'!
Object subclass: #Continuation
	instanceVariableNames: 'topContext copiedStack '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Kernel-Methods'!

!Continuation methodsFor: 'initialize-release' stamp: 'vb 10/20/1998 23:10'!
initialize: returnContext

	self captureSenderChain: returnContext! !


!Continuation methodsFor: 'invocation' stamp: 'vb 10/20/1998 23:00'!
value: anObject

	self restoreSenderChain.
	thisContext swapSender: topContext.
	^anObject! !


!Continuation methodsFor: 'private' stamp: 'vb 10/21/1998 20:22'!
captureSenderChain: aContext

	| chainCopy currentSender copiedContext |
	topContext _ aContext.
	copiedStack _ OrderedCollection new: 16.
	chainCopy _ aContext copySenderChain.
	currentSender _ topContext sender.
	copiedContext _ chainCopy.
	[copiedContext == nil] whileFalse:
		[copiedStack add: copiedContext.
		copiedContext _ copiedContext swapSender: currentSender.
		currentSender _ currentSender ifNotNil: [currentSender sender]]! !

!Continuation methodsFor: 'private' stamp: 'vb 10/21/1998 20:22'!
restoreSenderChain

	| currentContext |
	currentContext _ topContext.
	copiedStack do: 
		[:contextCopy |
		currentContext
			method: contextCopy sender pc: contextCopy pc;
			copyStackFrom: contextCopy.
		currentContext _ currentContext sender]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Continuation class
	instanceVariableNames: ''!

!Continuation class methodsFor: 'instance creation' stamp: 'vb 10/21/1998 20:23'!
returningTo: aContext

	^self new initialize: aContext! !


!Continuation class methodsFor: 'testing' stamp: 'vb 10/20/1998 23:09'!
testAccumulator
	"Continuation testAccumulator"
	"(Undeclared at: #K) value: 2"
	"(Undeclared at: #K) value: 5"
	"(Undeclared at: #K) value: 13"
	"Undeclared removeKey: #K"

	| sum |
	sum _ 0.
	sum _ [:k | Undeclared at: #K put: k. 0]
		valueWithCurrentContinuation + sum.
	Transcript show: sum printString; cr! !


!BlockContext methodsFor: 'continuations' stamp: 'vb 10/20/1998 23:31'!
valueWithCC

	^self value: (Continuation returningTo: thisContext sender)! !


!BlockContext methodsFor: 'continuations' stamp: 'vb 10/20/1998 23:07'!
valueWithCurrentContinuation

	^self value: (Continuation returningTo: thisContext sender)! !


!ContextPart methodsFor: 'continuation support' stamp: 'vb 10/20/1998 20:41'!
copySenderChain

	^sender == nil
		ifTrue: [self copy]
		ifFalse: [self copy swapSender: sender copySenderChain; yourself]! !


!ContextPart methodsFor: 'continuation support' stamp: 'vb 10/21/1998 20:09'!
copyStackFrom: myCopy

	self method numTemps + 1 to: self size do:
		[:index |
		self at: index put: (myCopy at: index)].
	stackp _ myCopy stackPtr
	! !

---------------- eof ------------------