Exception classes initialize themself.
Use exception class names instead of class variables.
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libbasic' }"
CompiledCode variableSubclass:#Block
instanceVariableNames:'home nargs sourcePos initialPC'
classVariableNames:'InvalidNewSignal'
poolDictionaries:''
category:'Kernel-Methods'
!
!Block class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
Blocks are pieces of executable code which can be evaluated by sending
them a value-message (''value'', ''value:'', ''value:value:'' etc).
In smalltalk, Blocks provide the basic (and heavily used) mechanism
for looping, enumerating collection elements, visitors, exception
handling, unwinding, delayed execution and processes.
Blocks are never created explicitely; the only creation
is done by the compilers, when some sourceCode is compiled to either
machine or byteCode.
Blocks with arguments need a message of type ''value:arg1 ... value:argn''
for evaluation; the number of arguments passed when evaluating must match
the number of arguments the block was declared with otherwise an error is
raised. Blocks without args need a ''value'' message for evaluation.
Blocks keep a reference to the context where the block was declared -
this allows blocks to access the methods arguments and/or variables.
This is still true after the method has returned - since the
block keeps this reference, the methods context will NOT die in this case.
(i.e. Blocks are closures in Smalltalk/X)
A return (via ^-statement) out of a block will force a return from the
blocks method context (if it is still living) - this make the implementation
of long-jumps and control structures possible.
(If the method is not alive (i.e. has already returned), a return out of the
block will trigger an error)
Long-jump is done by defining a catchBlock as ''[^ self]''
somewhere up in the calling-tree. Then, to do the long-jump from out of some
deeply nested method, simply do: ''catchBlock value''.
[Instance variables:]
home <Context> the context where this block was created (i.e. defined)
this may be a blockContext or a methodContext
nargs <SmallInteger> the number of arguments the block expects
sourcePos <SmallInteger> the character position of its source, in chars
relative to methods source beginning
initialPC <SmallInteger> the start position within the byteCode
for compiled blocks, this is nil.
[Class variables:]
InvalidNewSignal raised if a Block is tried to be created
with new (which is not allowed).
Only the VM is allowed to create Blocks.
NOTICE: layout known by runtime system and compiler - do not change
[author:]
Claus Gittinger
[see also:]
Process Context
Collection
( contexts. blocks & unwinding : programming/contexts.html)
"
!
examples
"
define a block and evaluate it:
[exBegin]
|b|
b := [ Transcript showCR:'hello' ].
Transcript showCR:'now evaluating the block ...'.
b value.
[exEnd]
even here, blocks are involved:
(although, the compiler optimizes things if possible)
[exBegin]
Transcript showCR:'now evaluating one of two blocks ...'.
1 > 4 ifTrue:[
Transcript showCR:'foo'
] ifFalse:[
Transcript showCR:'bar'
]
[exEnd]
here things become obvious:
[exBegin]
|yesBlock noBlock|
yesBlock := [ Transcript showCR:'foo' ].
noBlock := [ Transcript showCR:'bar' ].
Transcript showCR:'now evaluating one of two blocks ...'.
1 > 4 ifTrue:yesBlock
ifFalse:noBlock
[exEnd]
simple loops:
not very objectOriented:
[exBegin]
|i|
i := 1.
[i < 10] whileTrue:[
Transcript showCR:i.
i := i + 1
]
[exEnd]
using integer protocol:
[exBegin]
1 to:10 do:[:i |
Transcript showCR:i.
]
[exEnd]
interval protocol:
[exBegin]
(1 to:10) do:[:i |
Transcript showCR:i.
]
[exEnd]
looping over collections:
bad code:
(only works with numeric-indexable collections)
[exBegin]
|i coll|
coll := #(9 8 7 6 5).
i := 1.
[i <= coll size] whileTrue:[
Transcript showCR:(coll at:i).
i := i + 1.
]
[exEnd]
just as bad (well, marginally better ;-):
(only works with numeric-indexable collections)
[exBegin]
|coll|
coll := #(9 8 7 6 5).
1 to:coll size do:[:i |
Transcript showCR:(coll at:i).
]
[exEnd]
the smalltalk way:
(works with any collection)
[exBegin]
|coll|
coll := #(9 8 7 6 5).
coll do:[:element |
Transcript showCR:element.
]
[exEnd]
Rule: use enumeration protocol of the collection instead of
manually indexing it. [with few exceptions]
processes:
forking a lightweight process (thread):
[exBegin]
[
Transcript showCR:'waiting ...'.
Delay waitForSeconds:2.
Transcript showCR:'here I am'.
] fork
[exEnd]
some with low prio:
[exBegin]
[
Transcript showCR:'computing ...'.
10000 factorial.
Transcript showCR:'here I am'.
] forkAt:(Processor userBackgroundPriority)
[exEnd]
handling exceptions:
[exBegin]
Object errorSignal handle:[:ex |
Transcript showCR:'exception handler forces return'.
ex return
] do:[
Transcript showCR:'now, doing something bad ...'.
1 / 0.
Transcript showCR:'not reached'
]
[exEnd]
performing cleanup actions:
[exBegin]
Object errorSignal handle:[:ex |
Transcript showCR:'exception handler forces return'.
ex return
] do:[
[
Transcript showCR:'doing something bad ...'.
1 / 0.
Transcript showCR:'not reached'
] valueOnUnwindDo:[
Transcript showCR:'cleanup'
]
]
[exEnd]
delayed execution (visitor pattern):
(looking carefully into the example,
C/C++ programmers may raise their eyes ;-)
[exBegin]
|showBlock countBlock
howMany
top panel b1 b2|
howMany := 0.
showBlock := [ Transcript showCR:howMany ].
countBlock := [ howMany := howMany + 1 ].
top := StandardSystemView extent:200@200.
panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
b1 := Button label:'count up' in:panel.
b1 action:countBlock.
b2 := Button label:'show value' in:panel.
b2 action:showBlock.
top open.
Transcript showCR:'new process started;'.
Transcript showCR:'notice: the blocks can still access the'.
Transcript showCR:' howMany local variable.'.
[exEnd]
"
! !
!Block class methodsFor:'initialization'!
initialize
"create signals raised by various errors"
InvalidNewSignal isNil ifTrue:[
InvalidNewSignal := Error newSignalMayProceed:false.
InvalidNewSignal nameClass:self message:#invalidNewSignal.
InvalidNewSignal notifierString:'blocks are only created by the system'.
]
"Modified: 22.4.1996 / 16:34:20 / cg"
! !
!Block class methodsFor:'instance creation'!
byteCode:bCode numArgs:numArgs numStack:nStack sourcePosition:sourcePos initialPC:initialPC literals:literals
"create a new cheap (homeless) block.
Not for public use - this is a special hook for the compiler."
^ self
byteCode:bCode numArgs:numArgs numVars:0 numStack:nStack sourcePosition:sourcePos initialPC:initialPC literals:literals
!
byteCode:bCode numArgs:numArgs numVars:numVars numStack:nStack sourcePosition:sourcePos initialPC:initialPC literals:literals
"create a new cheap (homeless) block.
Not for public use - this is a special hook for the compiler."
|newBlock|
newBlock := (super basicNew:(literals size))
byteCode:bCode
numArgs:numArgs
numVars:numVars
numStack:nStack
sourcePosition:sourcePos
initialPC:initialPC
literals:literals.
^ newBlock
"Modified: 24.6.1996 / 12:36:48 / stefan"
"Created: 13.4.1997 / 00:04:09 / cg"
!
new
"catch creation of blocks - only the system creates blocks.
If you really need a block (assuming, you are some compiler),
use basicNew and setup the instance carefully"
^ InvalidNewSignal raise.
!
new:size
"catch creation of blocks - only the system creates blocks"
^ InvalidNewSignal raise.
! !
!Block class methodsFor:'queries'!
isBuiltInClass
"return true if this class is known by the run-time-system.
Here, true is returned for myself, false for subclasses."
^ self == Block
"Modified: 23.4.1996 / 15:55:58 / cg"
! !
!Block methodsFor:'Compatibility-ANSI'!
argumentCount
"VisualAge/ANSI compatibility: alias for #numArgs.
return the number of arguments I expect for evaluation"
^ nargs
"Created: 15.11.1996 / 11:22:02 / cg"
!
ensure:aBlock
"evaluate the receiver and return its result.
After evaluation, also evaluate aBlock but ignore its result.
aBlock is also evaluated in case of abnormal termination.
(the same as #valueNowOrOnUnwindDo:)"
<exception: #unwind>
|v|
v := self value. "the real logic is in Context>>unwind"
thisContext unmarkForUnwind.
aBlock value.
^ v
"/ the above is the same as in #valueNowOrOnUnwindDo:
"/ (actually, the previous implementation was:
"/ ^ self valueNowOrOnUnwindDo:aBlock
"
[
[
Transcript showCR:'one'.
Processor activeProcess terminate.
Transcript showCR:'two'.
] ensure:[
Transcript showCR:'three'.
].
] fork.
"
"
[
[
Transcript showCR:'one'.
Transcript showCR:'two'.
] ensure:[
Transcript showCR:'three'.
].
] fork.
"
!
ifCurtailed:aBlock
"evaluate the receiver - when some method sent within unwinds (i.e. does
a long return), evaluate the argument, aBlock.
This is used to make certain that cleanup actions (for example closing files etc.) are
executed regardless of error actions.
This is the same as #valueOnUnwindDo:"
<exception: #unwind>
|v|
"/ thisContext markForUnwind. -- same as above pragma
v := self value. "the real logic is in Context>>unwind"
thisContext unmarkForUnwind.
^ v
"
|s|
s := 'Makefile' asFilename readStream.
[
^ self
] ifCurtailed:[
Transcript showCR:'closing the stream - even though a return occurred'.
s close
]
"
"
[
|s|
s := 'Makefile' asFilename readStream.
[
Processor activeProcess terminate
] ifCurtailed:[
Transcript showCR:'closing the stream - even though process was terminated'.
s close
]
] fork
"
! !
!Block methodsFor:'Compatibility-Squeak'!
ifError:handlerBlock
"same as onError: - for squeak compatibility.
Notice, that the handlerBlock may take 0,1 or 2 args.
(1 arg -> the exception;
2 args -> the errorString and the erronous receiver)"
handlerBlock numArgs == 1 ifTrue:[
^ self on:Error do:handlerBlock
].
^ self
on:Error
do:[:ex |
|errString errReceiver|
handlerBlock numArgs == 0 ifTrue:[
ex return:handlerBlock value
].
errString := ex description.
errReceiver := ex suspendedContext receiver.
ex return:(handlerBlock value:errString value:errReceiver)
]
"
|a|
a := 0.
[ 123 / a ] ifError:[:msg :rec | self halt]
"
"
|a|
a := 0.
[ 123 / a ] ifError:[:ex | self halt]
"
"
|a|
a := 0.
[ 123 / a ] ifError:[self halt]
"
! !
!Block methodsFor:'Compatibility-V''Age'!
valueOnReturnDo:aBlock
"VisualAge compatibility: alias for #ifCurtailed:
evaluate the receiver - when some method sent within unwinds
(i.e. does a long return), evaluate the argument, aBlock.
This is used to make certain that cleanup actions
(for example closing files etc.) are executed regardless of error actions.
Q: is this the exact semantics of V'Ages method ?
the documentation is unclean; it could be a valueNowOrOnUnwindDo: ..."
^ self ifCurtailed:aBlock
"Created: 15.11.1996 / 11:38:37 / cg"
! !
!Block methodsFor:'binary storage'!
storeBinaryDefinitionOn:stream manager:manager
byteCode isNil ifTrue:[
self error:'cannot preserve semantics of block'.
].
^ super storeBinaryDefinitionOn:stream manager:manager
! !
!Block methodsFor:'conversion'!
asVarArgBlock
"convert myself into a varArg block;
this one has 1 formal argument, which gets the list
of actual arguments when evaluated."
nargs ~~ 1 ifTrue:[
self error:'vararg blocks must take exactly 1 argument - the arg list'.
^ nil
].
self changeClassTo:VarArgBlock.
^ self
"
|b|
b := [:argList | Transcript
show:'invoked with args:';
showCR:argList
] asVarArgBlock.
b value.
b value:'arg1'.
b value:'arg1' value:'arg2' value:'arg3' value:'arg4'
"
"Created: 23.1.1997 / 13:35:28 / cg"
"Modified: 23.1.1997 / 13:35:48 / cg"
!
beCurryingBlock
"make myself a currying block;
thats a block which, if invoked with less-than-expected arguments,
returns another block which provides the provided argument(s) and expects the remaining args.
Read any book on functional programming, if you dont understand this."
self changeClassTo:CurryingBlock.
^ self
!
beVarArg
"convert myself into a varArg block;
this one has 1 formal argument, which gets the list
of actual arguments when evaluated."
^ self asVarArgBlock.
"
|b|
b := [:argList | argList printCR] beVarArg.
b value.
b value:'arg1' value:'arg2' value:'arg3' value:'arg4'
"
"Created: 23.1.1997 / 13:35:28 / cg"
"Modified: 23.1.1997 / 13:35:48 / cg"
! !
!Block methodsFor:'copying'!
deepCopyUsing:aDictionary
"raise an error - deepCopy is not allowed for blocks"
^ self deepCopyError
"Created: / 31.3.1998 / 15:46:17 / cg"
! !
!Block methodsFor:'encoding'!
encodeOn:anEncoder with:aParameter
^ anEncoder encodeBlock:self with:aParameter
! !
!Block methodsFor:'error handling'!
invalidCodeObject
"{ Pragma: +optSpace }"
"this error is triggered by the interpreter when a non-Block object
is about to be executed.
In this case, the VM sends this to the bad method (the receiver).
Can only happen when the Compiler/runtime system is broken or
someone played around."
^ InvalidCodeError
raiseRequestWith:self
errorString:'invalid block - not executable'
"Modified: 4.11.1996 / 22:46:39 / cg"
! !
!Block methodsFor:'evaluation'!
value
"evaluate the receiver with no block args.
The receiver must be a block without arguments."
%{ /* NOCONTEXT */
REGISTER OBJFUNC thecode;
OBJ home;
if (__INST(nargs) == __MKSMALLINT(0)) {
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
/* compiled machine code */
RETURN ( (*thecode)(self) );
}
/* interpreted code */
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 0, nil, nil, nil, nil) );
# else
RETURN ( __interpret(self, 0, nil, nil, nil, nil) );
# endif
#else
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
/* compiled machine code */
RETURN ( (*thecode)(home) );
}
/* interpreted code */
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 0, nil, home, nil, nil) );
# else
RETURN ( __interpret(self, 0, nil, home, nil, nil) );
# endif
#endif
}
%}.
^ self wrongNumberOfArguments:0
!
value:arg
"evaluate the receiver with one argument.
The receiver must be a 1-arg block."
%{ /* NOCONTEXT */
REGISTER OBJFUNC thecode;
OBJ home;
if (__INST(nargs) == __MKSMALLINT(1)) {
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg) );
}
/* interpreted code */
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 1, nil, nil, nil, nil, &arg) );
# else
RETURN ( __interpret(self, 1, nil, nil, nil, nil, arg) );
# endif
#else
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home, arg) );
}
/* interpreted code */
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 1, nil, home, nil, nil, &arg) );
# else
RETURN ( __interpret(self, 1, nil, home, nil, nil, arg) );
# endif
#endif
}
%}.
^ self wrongNumberOfArguments:1
!
value:arg1 value:arg2
"evaluate the receiver with two arguments.
The receiver must be a 2-arg block."
%{ /* NOCONTEXT */
REGISTER OBJFUNC thecode;
OBJ home;
if (__INST(nargs) == __MKSMALLINT(2)) {
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 2, nil, nil, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 2, nil, nil, nil, nil, arg1, arg2) );
# endif
#else
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home, arg1, arg2) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 2, nil, home, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 2, nil, home, nil, nil, arg1, arg2) );
# endif
#endif
}
%}.
^ self wrongNumberOfArguments:2
!
value:arg1 value:arg2 value:arg3
"evaluate the receiver with three arguments.
The receiver must be a 3-arg block."
%{ /* NOCONTEXT */
REGISTER OBJFUNC thecode;
OBJ home;
if (__INST(nargs) == __MKSMALLINT(3)) {
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 3, nil, nil, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 3, nil, nil, nil, nil, arg1, arg2, arg3) );
# endif
#else
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home, arg1, arg2, arg3) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 3, nil, home, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 3, nil, home, nil, nil, arg1, arg2, arg3) );
# endif
#endif
}
%}.
^ self wrongNumberOfArguments:3
!
value:arg1 value:arg2 value:arg3 value:arg4
"evaluate the receiver with four arguments.
The receiver must be a 4-arg block."
%{ /* NOCONTEXT */
REGISTER OBJFUNC thecode;
OBJ home;
if (__INST(nargs) == __MKSMALLINT(4)) {
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 4, nil, nil, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 4, nil, nil, nil, nil, arg1, arg2, arg3, arg4) );
# endif
#else
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 4, nil, home, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 4, nil, home, nil, nil, arg1, arg2, arg3, arg4) );
# endif
#endif
}
%}.
^ self wrongNumberOfArguments:4
!
value:arg1 value:arg2 value:arg3 value:arg4 value:arg5
"evaluate the receiver with five arguments.
The receiver must be a 5-arg block."
%{ /* NOCONTEXT */
REGISTER OBJFUNC thecode;
OBJ home;
if (__INST(nargs) == __MKSMALLINT(5)) {
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 5, nil, nil, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 5, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5) );
# endif
#else
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 5, nil, home, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 5, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5) );
# endif
#endif
}
%}.
^ self wrongNumberOfArguments:5
!
value:arg1 value:arg2 value:arg3 value:arg4 value:arg5 value:arg6
"evaluate the receiver with six arguments.
The receiver must be a 6-arg block."
%{ /* NOCONTEXT */
REGISTER OBJFUNC thecode;
OBJ home;
if (__INST(nargs) == __MKSMALLINT(6)) {
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 6, nil, nil, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 6, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6) );
# endif
#else
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 6, nil, home, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 6, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6) );
# endif
#endif
}
%}.
^ self wrongNumberOfArguments:6
!
value:arg1 value:arg2 value:arg3 value:arg4 value:arg5 value:arg6 value:arg7
"evaluate the receiver with seven arguments.
The receiver must be a 7-arg block."
%{ /* NOCONTEXT */
REGISTER OBJFUNC thecode;
OBJ home;
if (__INST(nargs) == __MKSMALLINT(7)) {
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 7, nil, nil, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 7, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7) );
# endif
#else
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 7, nil, home, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 7, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7) );
# endif
#endif
}
%}.
^ self wrongNumberOfArguments:7
!
value:arg1 value:arg2 value:arg3 value:arg4 value:arg5 value:arg6 value:arg7 value:arg8
"evaluate the receiver with eight arguments.
The receiver must be a 8-arg block."
%{ /* NOCONTEXT */
REGISTER OBJFUNC thecode;
OBJ home;
if (__INST(nargs) == __MKSMALLINT(8)) {
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 8, nil, nil, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 8, nil, nil, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) );
# endif
#else
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(home, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, 8, nil, home, nil, nil, &arg1) );
# else
RETURN ( __interpret(self, 8, nil, home, nil, nil, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) );
# endif
#endif
}
%}.
^ self wrongNumberOfArguments:8
!
valueAt:priority
"evaluate the receiver, at the given prioriy;
i.e. change the priority for the execution of the receiver."
|oldPrio retVal|
oldPrio := Processor activePriority.
[
Processor activeProcess priority:priority.
retVal := self value.
] ensure:[
Processor activeProcess priority:oldPrio
].
^ retVal
"
[
1000 timesRepeat:[
1000 factorial
]
] valueAt:3
"
"Created: / 29.7.1998 / 19:19:48 / cg"
!
valueWithArguments:argArray
"evaluate the receiver with arguments taken from argArray.
ArgArray must be either an Array or nil.
The size of the argArray must match the number of arguments the receiver expects."
|a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12|
(argArray notNil and:[(argArray class ~~ Array) and:[argArray isArray not]]) ifTrue:[
^ self badArgumentArray:argArray
].
(argArray size == nargs) ifFalse:[
^ self wrongNumberOfArguments:argArray size
].
%{
REGISTER OBJFUNC thecode;
OBJ home;
REGISTER OBJ *ap;
OBJ nA;
#if defined(THIS_CONTEXT)
if (__ISVALID_ILC_LNO(__pilc))
__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
#endif
thecode = __BlockInstPtr(self)->b_code;
nA = __INST(nargs);
#ifndef NEW_BLOCK_CALL
home = __BlockInstPtr(self)->b_home;
if (thecode != (OBJFUNC)nil) {
/* the most common case (0 args) here (without a switch) */
if (nA == __MKSMALLINT(0)) {
RETURN ( (*thecode)(home) );
}
ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */
switch ((INT)(nA)) {
default:
goto error;
case (INT)__MKSMALLINT(12):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11]) );
case (INT)__MKSMALLINT(11):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10]) );
case (INT)__MKSMALLINT(10):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9]) );
case (INT)__MKSMALLINT(9):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) );
case (INT)__MKSMALLINT(8):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) );
case (INT)__MKSMALLINT(7):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
case (INT)__MKSMALLINT(6):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
case (INT)__MKSMALLINT(5):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4]) );
case (INT)__MKSMALLINT(4):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3]) );
case (INT)__MKSMALLINT(3):
RETURN ( (*thecode)(home, ap[0], ap[1], ap[2]) );
case (INT)__MKSMALLINT(2):
RETURN ( (*thecode)(home, ap[0], ap[1]) );
case (INT)__MKSMALLINT(1):
RETURN ( (*thecode)(home, ap[0]) );
case (INT)__MKSMALLINT(0):
RETURN ( (*thecode)(home) );
break;
}
}
#endif
if (nA != __MKSMALLINT(0)) {
ap = __arrayVal(argArray); /* nonNil after above test (size is known to be ok) */
switch ((INT)nA) {
default:
goto error;
case (INT)__MKSMALLINT(12):
a12 = ap[11];
case (INT)__MKSMALLINT(11):
a11 = ap[10];
case (INT)__MKSMALLINT(10):
a10 = ap[9];
case (INT)__MKSMALLINT(9):
a9 = ap[8];
case (INT)__MKSMALLINT(8):
a8 = ap[7];
case (INT)__MKSMALLINT(7):
a7 = ap[6];
case (INT)__MKSMALLINT(6):
a6 = ap[5];
case (INT)__MKSMALLINT(5):
a5 = ap[4];
case (INT)__MKSMALLINT(4):
a4 = ap[3];
case (INT)__MKSMALLINT(3):
a3 = ap[2];
case (INT)__MKSMALLINT(2):
a2 = ap[1];
case (INT)__MKSMALLINT(1):
a1 = ap[0];
case (INT)__MKSMALLINT(0):
break;
}
}
#ifdef NEW_BLOCK_CALL
if (thecode != (OBJFUNC)nil) {
RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) );
}
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, __intVal(nA), nil, nil, nil, nil, &a1) );
# else
RETURN ( __interpret(self, __intVal(nA), nil, nil, nil, nil, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) );
# endif
#else
# ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, __intVal(nA), nil, home, nil, nil, &a1) );
# else
RETURN ( __interpret(self, __intVal(nA), nil, home, nil, nil, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) );
# endif
#endif
error: ;
%}.
"
the above code only supports up-to 12 arguments
"
^ ArgumentError
raiseRequestWith:self
errorString:'only blocks with up-to 12 arguments supported'
!
valueWithOptionalArgument:arg
"evaluate the receiver.
Optionally pass an argument (if the receiver is a one arg block)."
nargs == 1 ifTrue:[
^ self value:arg
].
^ self value
"
|block|
block := [ Transcript showCR:'hello' ].
block valueWithOptionalArgument:2.
block := [:arg | Transcript showCR:arg ].
block valueWithOptionalArgument:2.
"
!
valueWithOptionalArgument:arg1 and:arg2
"evaluate the receiver.
Optionally pass up to two arguments (if the receiver is a one/two arg block)."
nargs == 2 ifTrue:[
^ self value:arg1 value:arg2
].
nargs == 1 ifTrue:[
^ self value:arg1
].
^ self value
"
|block|
block := [ Transcript showCR:'hello' ].
block valueWithOptionalArgument:2.
block := [:arg | Transcript showCR:arg ].
block valueWithOptionalArgument:2.
block := [:arg1 :arg2 | Transcript showCR:arg1. Transcript showCR:arg2 ].
block valueWithOptionalArgument:10 and:20.
"
! !
!Block methodsFor:'exception handling'!
handlerForSignal:exceptionHandler context:theContext originator:originator
"answer the handler block for the exceptionHandler from originator.
The handler block is retrieved from aContext.
Answer nil if the exceptionHandler is not handled."
|exceptionHandlerInContext|
theContext selector == #on:do: ifTrue:[
exceptionHandlerInContext := theContext argAt:1.
exceptionHandlerInContext isExceptionHandler ifFalse:[
exceptionHandlerInContext isNil ifTrue:[
'Block [warning]: nil ExceptionHandler in on:do:-context' errorPrintCR.
] ifFalse:[
'Block [warning]: non-ExceptionHandler in on:do:-context' errorPrintCR.
].
theContext fullPrint.
^ nil.
].
(exceptionHandlerInContext == exceptionHandler
or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[
^ theContext argAt:2.
].
] ifFalse:[
"must be #valueWithExceptionHandler:"
^ (theContext argAt:1) handlerForSignal:exceptionHandler.
].
^ nil
"Created: / 25.7.1999 / 19:52:58 / stefan"
"Modified: / 26.7.1999 / 14:30:42 / stefan"
!
handlerProtectedBlock:doBlock inContext:context
"set the handlerProtectedBlock in context.
Needed for #restartDo:"
"theContext selector must be #on:do: or #valueWithExceptionHandler:"
context receiver:doBlock
"
[1/0] on:Error do:[:ex| ex restartDo:[55]]
"
!
handlingExceptionInContext:theContext
"answer the handling signal from aContext."
"theContext selector must be #on:do: or #valueWithExceptionHandler:"
^ theContext argAt:1.
!
on:aSignalOrSignalSetOrException do:exceptionBlock
"added for ANSI compatibility; evaluate the receiver,
handling aSignalOrSignalSetOrException.
The 2nd argument, exceptionBlock is evaluated
if the signal is raised during evaluation."
<context: #return>
<exception: #handle>
"/ thisContext markForHandle. -- same as above pragma
^ self value. "the real logic is in Exception>>doRaise"
"
[
1 foo
] on:MessageNotUnderstoodSignal do:[:ex | self halt]
[
1 foo
] on:(MessageNotUnderstood , AbortOperationRequest) do:[:ex | self halt]
[
1 foo
] on:SignalSet anySignal do:[:ex| 2 bar. self halt]
"
"Modified: / 26.7.1999 / 15:30:48 / stefan"
!
valueWithExceptionHandler:handler
"evaluate myself. If any of the signals in handler is raised,
evaluate the corresponding handler block."
<context: #return>
<exception: #handle>
"/ thisContext markForHandle. -- same as above pragma
^ self value. "the real logic is in Exception>>doRaise"
"Created: / 26.7.1999 / 11:23:45 / stefan"
"Modified: / 26.7.1999 / 11:24:06 / stefan"
! !
!Block methodsFor:'looping'!
doUntil:aBlock
"repeat the receiver block until aBlock evaluates to true.
The receiver is evaluated at least once.
This is the same as '... doWhile:[... not]' "
"this implementation is for purists ... :-)"
self value.
aBlock value ifTrue:[^ nil].
thisContext restart
"
|n|
n := 1.
[n printNewline] doUntil:[ (n := n + 1) > 5 ]
"
!
doWhile:aBlock
"repeat the receiver block until aBlock evaluates to false.
The receiver is evaluated at least once."
"this implementation is for purists ... :-)"
self value.
aBlock value ifFalse:[^ nil].
thisContext restart
"
|n|
n := 1.
[n printNewline] doWhile:[ (n := n + 1) <= 5 ]
"
!
loop
"repeat the receiver forever
(the receiver block should contain a return somewhere).
The implementation below was inspired by a corresponding Self method."
self value.
thisContext restart
"
|n|
n := 1.
[
n printNewline.
n >= 10 ifTrue:[^ nil].
n := n + 1
] loop
"
"Modified: 18.4.1996 / 13:50:40 / cg"
!
loopWithExit
"the receiver must be a block of one argument. It is evaluated in a loop forever,
and is passed a block, which, if sent a value:-message, will exit the receiver block,
returning the parameter of the value:-message. Used for loops with exit in the middle.
Inspired by a corresponding Self method."
|exitBlock|
exitBlock := [:exitValue | ^ exitValue].
[true] whileTrue:[self value:exitBlock]
"
|i|
i := 1.
[:exit |
Transcript showCR:i.
i == 5 ifTrue:[exit value:'thats it'].
i := i + 1
] loopWithExit
"
!
repeat
"repeat the receiver forever - same as loop, for ST-80 compatibility.
(the receiver block should contain a return somewhere)."
self value.
thisContext restart
"Modified: 18.4.1996 / 13:50:55 / cg"
!
valueWithExit
"the receiver must be a block of one argument. It is evaluated, and is passed a block,
which, if sent a value:-message, will exit the receiver block, returning the parameter of the
value:-message. Used for premature returns to the caller.
Taken from a manchester goody (a similar construct also appears in Self)."
^ self value:[:exitValue | ^exitValue]
"
[:exit |
1 to:10 do:[:i |
Transcript showCR:i.
i == 5 ifTrue:[exit value:'thats it']
].
'regular block-value; never returned'
] valueWithExit
"
"Modified: 18.4.1996 / 13:51:38 / cg"
!
valueWithRestart
|myContext restartAction|
myContext := thisContext.
restartAction := [ myContext restart ].
^ self value:restartAction.
"
[:restart |
(self confirm:'try again ?') ifTrue:[
restart value.
]
] valueWithRestart
"
"Modified: / 25.1.2000 / 21:47:50 / cg"
!
whileFalse
"evaluate the receiver while it evaluates to false (ST80 compatibility)"
"this implementation is for purists ... :-)"
self value ifTrue:[^ nil].
thisContext restart
"
|n|
n := 1.
[n printNewline. (n := n + 1) > 10] whileFalse
"
!
whileFalse:aBlock
"evaluate the argument, aBlock while the receiver evaluates to false.
- usually open coded by compilers, but needed here for #perform
and expression evaluation."
"this implementation is for purists ... :-)"
self value ifTrue:[^ nil].
aBlock value.
thisContext restart
"
|n|
n := 1.
[n > 10] whileFalse:[
n printNewline.
n := n + 1
]
"
!
whileTrue
"evaluate the receiver while it evaluates to true (ST80 compatibility)"
"this implementation is for purists ... :-)"
self value ifFalse:[^ nil].
thisContext restart
"
|n|
n := 1.
[n printNewline. (n := n + 1) <= 10] whileTrue
"
!
whileTrue:aBlock
"evaluate the argument, aBlock while the receiver evaluates to true.
- usually open coded by compilers, but needed here for #perform
and expression evaluation."
"this implementation is for purists ... :-)"
self value ifFalse:[^ nil].
aBlock value.
thisContext restart
"
|n|
n := 1.
[n <= 10] whileTrue:[
n printNewline.
n := n + 1
]
"
! !
!Block methodsFor:'printing & storing'!
printBlockBracketsOn:aStream
aStream nextPutAll:'[]'.
!
printOn:aStream
"append a a printed representation of the block to aStream"
|h sel methodClass|
"cheap blocks have no home context, but a method instead"
(home isNil or:[home isContext not]) ifTrue:[
aStream nextPutAll:'[] in '.
"
currently, some cheap blocks don't know where they have been created
"
aStream nextPutAll:' ??? (optimized)'.
^ self
].
"a full blown block (with home, but without method)"
self printBlockBracketsOn:aStream.
aStream nextPutAll:' in '.
h := self methodHome.
sel := h selector.
"/ old:
"/ home receiver class name printOn:aStream.
"/ new:
"/ (h searchClass whichClassImplements:sel) name printOn:aStream.
methodClass := h methodClass.
methodClass isNil ifTrue:[
'UnboundMethod' printOn:aStream.
] ifFalse:[
methodClass name printOn:aStream.
].
aStream nextPutAll:'>>'.
sel printOn:aStream.
"/
"/ aStream nextPutAll:'[] in '.
"/ homeClass := home containingClass.
"/ homeClass notNil ifTrue:[
"/ homeClass name printOn:aStream.
"/ aStream space.
"/ (homeClass selectorForMethod:home) printOn:aStream
"/ ] ifFalse:[
"/ aStream nextPutAll:' ???'
"/ ]
"/
! !
!Block methodsFor:'private-accessing'!
byteCode:bCode numArgs:numArgs numVars:numVars numStack:numStack sourcePosition:srcPos initialPC:iPC literals:lits
"set all relevant internals.
DANGER ALERT: this interface is strictly private."
byteCode := bCode.
nargs := numArgs.
sourcePos := srcPos.
initialPC := iPC.
flags := 0.
self stackSize:numStack.
self literals:lits.
self numberOfArgs:numArgs. "/ must set the compiledCode flags as well
self numberOfVars:numVars. "/ must set the compiledCode flags as well
"Modified: 23.4.1996 / 16:05:30 / cg"
"Modified: 24.6.1996 / 12:37:37 / stefan"
"Created: 13.4.1997 / 00:00:57 / cg"
!
initialPC
"return the initial pc for evaluation."
^ initialPC
!
initialPC:initial
"set the initial pc for evaluation.
DANGER ALERT: this interface is for the compiler only."
initialPC := initial
"Modified: 23.4.1996 / 16:05:39 / cg"
!
numArgs:numArgs
"set the number of arguments the receiver expects for evaluation.
DANGER ALERT: this interface is for the compiler only."
nargs := numArgs
"Modified: 23.4.1996 / 16:05:52 / cg"
!
setHome:aContext
home := aContext
!
source
|m|
sourcePos isString ifTrue:[ "/ misuses the sourcePosition slot
^ sourcePos
].
m := self method.
m notNil ifTrue:[
^ m source
].
^ nil
!
source:aString
"set the source - only to be used, if the block is not contained in a method.
This interface is for knowledgable users only."
sourcePos := aString "/ misuse the sourcePosition slot
!
sourcePosition:position
"set the position of the source within my method.
This interface is for the compiler only."
sourcePos := position
"Modified: 23.4.1996 / 16:06:19 / cg"
! !
!Block methodsFor:'privileged evaluation'!
valueUninterruptably
"evaluate the receiver with interrupts blocked.
This does not prevent preemption by a higher priority processes
if any becomes runnable due to the evaluation of the receiver
(i.e. if a semaphore is signalled)."
"we must keep track of blocking-state if this is called nested"
(OperatingSystem blockInterrupts) ifTrue:[
"/ already blocked.
^ self value
].
^ self ensure:[OperatingSystem unblockInterrupts].
!
valueUnpreemptively
"evaluate the receiver without the possiblity of preemption
(i.e. at a very high priority)"
|oldPrio activeProcess|
activeProcess := Processor activeProcess.
oldPrio := activeProcess changePriority:(Processor highestPriority).
^ self ensure:[
activeProcess priority:oldPrio
]
! !
!Block methodsFor:'process creation'!
fork
"create a new process executing the receiver at the current priority."
^ self newProcess resume
!
forkAt:priority
"create a new process executing the receiver at a different priority."
^ (self newProcess priority:priority) resume
!
forkNamed:aString
"create a new process, give it a name and let it start
executing the receiver at the current priority."
|newProcess|
newProcess := self newProcess.
newProcess name:aString.
newProcess resume.
^ newProcess.
!
forkWith:argArray
"create a new process executing the receiver,
passing elements in argArray as arguments to the receiver block."
^ [self valueWithArguments:argArray] fork.
!
newProcess
"create a new (unscheduled) process executing the receiver"
^ Process for:self priority:(Processor activePriority)
!
newProcessWithArguments:argArray
"create a new (unscheduled) process executing the receiver,
passing the elements in argArray as arguments to the receiver block."
^ [self valueWithArguments:argArray] newProcess
!
promise
"create a promise on the receiver. The promise will evaluate the
receiver and promise to return the value with the #value message.
The evaluation will be performed as a separate process.
Asking the promise for its value will either block the asking process
(if the evaluation has not yet been finished) or return the value
immediately."
^ Promise value:self
"
|p|
p := [1000 factorial] promise.
'do something else ...'.
p value
"
!
promiseAt:prio
"create a promise on the receiver. The promise will evaluate the
receiver and promise to return the value with the #value message.
The evaluation will be performed as a separate process running at prio.
Asking the promise for its value will either block the asking process
(if the evaluation has not yet been finished) or return the value
immediately."
^ Promise value:self priority:prio
! !
!Block methodsFor:'sunit-support'!
home
"return the receivers home context (the context where it was
created). For cheap blocks, nil is returned"
^ home
!
homeMethod
"return the receivers home method.
Thats the method where the block was created."
home notNil ifTrue:[
^ home method
].
^ nil
"Created: 19.6.1997 / 16:14:57 / cg"
!
method
"return the receivers method
(the method where the block was created).
Obsolete: use #homeMethod for ST80 compatibility."
^ self homeMethod
"Modified: 19.6.1997 / 16:15:24 / cg"
!
methodHome
"return the receivers method home context (the context where it was
defined). For cheap blocks, nil is returned"
home notNil ifTrue:[
^ home methodHome
].
^ home
!
numArgs
"return the number of arguments I expect for evaluation.
Please use argumentCount, which is ANSI"
^ nargs
!
sunitEnsure: aBlock
^self ensure: aBlock
! !
!Block methodsFor:'testing'!
isBlock
"return true, if this is a block - yes I am"
^ true
!
isVarArgBlock
"return true, if this block accepts a variable number of arguments"
^ false
"Created: 23.1.1997 / 04:59:51 / cg"
! !
!Block methodsFor:'unwinding'!
unwindHandlerInContext:aContext
"given a context which has been marked for unwind,
retrieve the handler block.
This avoids hardwiring access to the first argument in
#unwind methods (and theoretically allows for other unwinding
methods to be added)"
aContext selector == #'value:onUnwindDo:' ifTrue:[
^ aContext argAt:2
].
"/ for now, only #valueNowOrOnUnwindDo:
"/ or #valueOnUnwindDo:
"/ or #ensure:
"/ or #ifCurtailed:
^ aContext argAt:1
! !
!Block methodsFor:'unwinding-old'!
value:arg onUnwindDo:aBlock
"evaluate the receiver, passing it one argument
- when some method sent within unwinds (i.e. does
a long return), evaluate the argument, aBlock.
This is used to make certain that cleanup actions (for example closing files etc.) are
executed regardless of error actions"
<exception: #unwind>
|v|
"/ thisContext markForUnwind. -- same as above pragma
v := self value:arg. "the real logic is in Context>>unwind"
thisContext unmarkForUnwind.
^ v
"
|s|
s := 'Makefile' asFilename readStream.
[:arg |
^ self
] value:12345 onUnwindDo:[
Transcript showCR:'closing the stream - even though a return occurred'.
s close
]
"
"
[
|s|
s := 'Makefile' asFilename readStream.
[:arg |
Processor activeProcess terminate
] value:12345 onUnwindDo:[
Transcript showCR:'closing the stream - even though process was terminated'.
s close
]
] fork
"
!
valueNowOrOnUnwindDo:aBlock
"evaluate the receiver - after that, or when some method sent within unwinds (i.e. does
a long return), evaluate the argument, aBlock.
This is used to make certain that cleanup actions (for example closing files etc.) are
executed regardless of error actions.
Same as the more modern #ensure:"
<exception: #unwind>
|v|
"/ thisContext markForUnwind. -- same as above pragma
v := self value. "the real logic is in Context>>unwind"
thisContext unmarkForUnwind.
aBlock value.
^ v
"
in the following example, f will be closed even if the block
returns with 'oops'. There are many more applications of this kind
found in the system.
"
"
|f|
f := 'Makefile' asFilename readStream.
[
l := f nextLine.
l isNil ifTrue:[^ 'oops']
] valueNowOrOnUnwindDo:[
f close
]
"
"Modified: 16.4.1996 / 11:05:26 / stefan"
!
valueOnUnwindDo:aBlock
"evaluate the receiver - when some method sent within unwinds (i.e. does
a long return), evaluate the argument, aBlock.
This is used to make certain that cleanup actions (for example closing files etc.) are
executed regardless of error actions
Same as the more modern #ifCurtailed:"
<exception: #unwind>
|v|
"/ thisContext markForUnwind. -- same as above pragma
v := self value. "the real logic is in Context>>unwind"
thisContext unmarkForUnwind.
^ v
"
|s|
s := 'Makefile' asFilename readStream.
[
^ self
] valueOnUnwindDo:[
Transcript showCR:'closing the stream - even though a return occurred'.
s close
]
"
"
[
|s|
s := 'Makefile' asFilename readStream.
[
Processor activeProcess terminate
] valueOnUnwindDo:[
Transcript showCR:'closing the stream - even though process was terminated'.
s close
]
] fork
"
! !
!Block class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.135 2003-09-05 10:29:15 stefan Exp $'
! !
Block initialize!