"
COPYRIGHT (c) 1992 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.
"
Link subclass:#Process
instanceVariableNames:'id prio state startBlock name restartable interruptActions
exitActions suspendSemaphore singleStepping
emergencySignalHandler suspendActions creatorId processGroupId'
classVariableNames:'TerminateSignal RestartSignal CoughtSignals'
poolDictionaries:''
category:'Kernel-Processes'
!
!Process class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1992 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
"
Instances of Process represent lightweight smalltalk processes
(i.e. threads). These all run in a shared smalltalk/X address space,
and can thus access and communicate via any objects.
Do not confuse these with (heavy-weight) unix processes, which are
created differently, and do NOT run in the same address space.
Also notice, that heavy-weight process creation takes much longer.
(see OperatingSystemclass>>fork).
Processes are typically created by sending #fork or #forkAt: to a block;
the block creates a new process, defines itself as its startBlock,
and (optionally) tells the Processor about the new process.
Scheduling is done by Processor, which is the sole instance of
ProcessorScheduler.
Processes can be terminated either soft or via a hardTerminate.
A soft terminate (see Process>>terminate) will raise a TerminationSignal
in the process, which can be handled by the process.
If no other handler was specified, the processes own handler
(see Process>>start) will catch the signal and terminate the process.
During this signal processing, normal unwind processing takes place,
this means that with a soft terminate, all valueOnUnwind:/valueNowOrOnUnwind:
cleanup blocks are evaluated.
(so a process which has set up those blocks correctly does not have to
care especially about cleanup in case of termination).
Other than that, the TerminateSignal can be caught for special cleanup or
even to make the process continue execution.
A hard terminate (Process>>terminateNoSignal) will NOT do all of the above,
but quickly (and without any cleanup) terminate the process.
The debugger offers a quickTerminate option on its popupMenu for
situations, when soft termination fails. (for example, if some error was
coded into a handler or unwind block).
Notice:
in Smalltalk/X, processes are gone, when an image is restarted;
this means, that you have to take care of process re-creation yourself.
Usually, this is done by depending on ObjectMemory, recreating the
process(es) when the #returnFromSnapshot-change notifiction arrives.
All views (actually windowGroups) recreate their window process
on image-restart. You have to do so manually for your own processes.
A later version will allow specification of automatic restart, but
thats not yet implemented. However, even when implemented, restartable processes
will be recreated to restart from the beginning. It will not be possible to
automatically continue a processes execution where it left off.
This is a consequence of the portable implementation of ST/X, since in order to
implement process continuation, the machines stack had to be preserved and
recreated. Although this is possible to do (and actually not too complicated),
this has not been implemented, since the machines stack layout is highly machine/compiler
dependent, thus leading to much bigger porting effort of ST/X (which conflicts
with ST/X's design goal of being highly portable).
Process synchronization:
Synchronization with cooperating processes is supported as usual,
via Semaphores (see Semaphore, Delay, SharedQueue etc.)
With uncooperative processes, only synchronization on suspend
and termination is possible:
any other process can wait for a process to suspend or terminate.
This waiting is implemented by using suspendSemaphore and exitBlocks
(where an exitSemaphore is signalled).
See waitUntilSuspended / waitUntilTerminated.
[Instance variables:]
id <SmallInteger> a unique process-id
creatorId <SmallInteger> the id of the process that
created me (useful for debugging
or monitoring).
processGroupId usually the id of the creator,
unless the process detached from
the group and became a groupLeader.
Groups can be easily terminated
as a whole.
Group leaders have a groupId of nil.
A groupId of 0 (zero) marks a system
process; these do not prevent a standAlone
app from exiting.
prio <SmallInteger> the processes priority
state <Symbol> the processes state
(for process-monitor)
startBlock <Block> the startup-block (the one that forked)
name <String-or-nil> the processes name (if any)
(for process-monitor)
suspendSemaphore <Semaphore> triggered when suspend (if nonNil)
restartable <Boolean> is restartable; if true, the process
will be restarted when an image is
restarted. Otherwise, it remains dead.
Running processes cannot be continued
at the point where leftOff after an
image-restart.
interruptActions <Collection> interrupt actions as defined by interruptWith:,
performed at interrupt time
exitActions <Collection of Block>
additional cleanup actions to perform
on termination (if nonEmpty)
emergencySignalHandler <Block> can be used for per-process
emergency signal handling
[Class variables:]
TerminateSignal <Signal> signal used to terminate processes
(should not be caught - or at least
rejected in handlers).
If caught and proceeded, a process
cannot be terminated via #terminate.
For hardTermination (in case of emergency),
send it a #erminateNoSignal message.
RestartSignal <Signal> signal used to restart a process.
Can be caught in additional handler(s),
to perform all kind of re-initialization.
However, these handlers should reject,
for the restart to be really performed.
[see also:]
ProcessorScheduler
Block
Sempahore SemaphoreSet Delay SharedQueue
WindowGroup
(``Working with processes'': programming/processes.html)
[author:]
Claus Gittinger
"
!
examples
"
start a background process, computing 1000 factorial 100 times;
the processes priority is set to not disturb any interactive process.
Since its prio is higher than the 3D animation demos prio, you will notice,
that those are suspended while the computation runs. But Interactive views
(like browsers) will continue to react normal.
[exBegin]
[
'starting' printNL.
100 timesRepeat:[1000 factorial].
'done with factorial' printNL.
] forkAt:(Processor userBackgroundPriority).
[exEnd]
start a background process, computing 1000 factorial 100 times;
the processes priority is set to not disturb any process.
The prio is set to 1 (which is the lowest possible) notice that now,
the 3D animation demos also continue to run.
[exBegin]
[
'starting' printNL.
100 timesRepeat:[1000 factorial].
'done with factorial' printNL.
] forkAt:1.
[exEnd]
start a background process, reading a pipe without blocking other
processes;
[exBegin]
[
|p|
'starting' printNL.
p := PipeStream readingFrom:'ls -lR .'.
[p atEnd] whileFalse:[
p readWait.
p nextLine printNL.
].
p close.
'done with pipe' printNL.
] forkAt:1.
[exEnd]
see more examples in doc/coding
(or search in the browser for senders of fork*)
"
! !
!Process class methodsFor:'initialization'!
initialize
TerminateSignal isNil ifTrue:[
TerminateSignal := Signal new mayProceed:true.
TerminateSignal nameClass:self message:#terminateSignal.
TerminateSignal notifierString:'unhandled process termination'.
RestartSignal := Signal new mayProceed:true.
RestartSignal nameClass:self message:#restartSignal.
RestartSignal notifierString:'unhandled process restart'.
CoughtSignals := SignalSet
with:AbortSignal
with:TerminateSignal
with:RestartSignal.
]
"Modified: 28.10.1996 / 20:39:05 / cg"
! !
!Process class methodsFor:'instance creation'!
for:aBlock priority:aPrio
"create a new (unscheduled) process which will execute aBlock at
a given priority, once scheduled. The process will start execution once
it gets a #resume-message."
^ self basicNew for:aBlock priority:aPrio
"Modified: 25.1.1997 / 01:23:12 / cg"
!
new
"create a new (unscheduled) process which will execute the start
method, when scheduled. The process will start execution once
it gets a #resume-message."
^ self basicNew for:nil priority:(Processor activePriority).
"Created: 25.1.1997 / 01:31:05 / cg"
! !
!Process class methodsFor:'Signal constants'!
restartSignal
"return the signal used for process restart"
^ RestartSignal
"Created: 28.10.1996 / 20:26:50 / cg"
!
terminateSignal
"return the signal used for process termination"
^ TerminateSignal
! !
!Process class methodsFor:'defaults'!
defaultMaximumStackSize
"return the default max stack size. All new processes get
this limit initially.
It may be changed for individual processes with:
aProcess setMaximumStackSize:limit"
%{ /* NOCONTEXT */
RETURN ( __MKSMALLINT( __defaultThreadMaxStackSize() ));
%}
"
Process defaultMaximumStackSize
"
"Modified: 8.5.1996 / 10:22:24 / cg"
!
defaultMaximumStackSize:numberOfBytes
"set the default max stack size, return the previous value.
All new processes get this stack limit initially.
It may be changed for individual processes with:
aProcess setMaximumStackSize:limit
Notice:
There is seldom any need to change the default setting,
except for highly recursive programs."
%{ /* NOCONTEXT */
if (__isSmallInteger(numberOfBytes)) {
RETURN ( __MKSMALLINT( __setDefaultThreadSetMaxStackSize(__intVal(numberOfBytes)) ));
}
%}
"
Process defaultMaximumStackSize:500*1024
"
"Modified: 8.5.1996 / 10:23:26 / cg"
! !
!Process methodsFor:'Compatibility - V''Age'!
queueInterrupt:aBlock
"VisualAge compatibility: alias for #interruptWith:
arrange for the receiver process to be interrupted and
evaluate aBlock in its interrupt handler."
^ self interruptWith:aBlock
"Created: 15.11.1996 / 11:41:06 / cg"
! !
!Process methodsFor:'accessing'!
beGroupLeader
"make the receiver a processGroupLeader.
This detaches the process from its creator, so that it will not
be terminated when it teminates via #terminateGroup.
(windowgroup processes do this)."
processGroupId := id
"Modified: 8.7.1996 / 14:00:35 / cg"
"Created: 8.7.1996 / 14:08:44 / cg"
!
beSystemProcess
"make the receiver a system process.
These processes have a groupId of 0.
When executed as standAlone application, smalltalk exits when
no more user processes are running.
To prevent any daemon processes from preventing this exit,
you should make the systemProcess"
processGroupId := 0
"Created: 17.1.1997 / 21:42:46 / cg"
!
changePriority:aNumber
"same as priority:, but returns the old priority.
(cannot do this in #priority: for ST-80 compatibility)"
|oldPrio|
oldPrio := prio.
Processor changePriority:aNumber for:self.
^ oldPrio
"Modified: 23.12.1995 / 18:38:53 / cg"
!
creatorId
"return the processcreators id.
This has no semantic meaning, but is useful to identify processes
when debugging."
^ creatorId
!
id
"return the processes id"
^ id
!
name
"return the processes name"
^ name
!
name:aString
"set the processes name"
name := aString
!
priority
"return the receivers priority"
^ prio
!
priority:aNumber
"set my priority"
Processor changePriority:aNumber for:self.
!
processGroupId
"return the processes processGroup id.
Normally, when created, a processes creator id is taken and used
as the processGroup id.
When #terminateGroup is sent to a process, the process and all of its
group members are terminated together.
Processes can detach themself from the process group to prevent being
killed when the parent terminates (windowgroup processes do this)."
^ processGroupId
"Created: 8.7.1996 / 13:47:47 / cg"
!
processGroupId:aGroupLeadersProcessID
"set the processes processGroup id.
Normally, when created, a processes creator id is taken and used
as the processGroup id.
When #terminateGroup is sent to a process, the process and all of its
group members are terminated together.
Processes can detach themself from the process group to prevent being
killed when the parent terminates (windowgroup processes do this)."
processGroupId := aGroupLeadersProcessID
"Created: 8.7.1996 / 13:47:53 / cg"
!
restartable:aBoolean
"set/clear, the restartable flag.
Restartable processes will automatically be restarted by the
ProcessorScheduler upon image restart.
Others have to be restarted manually."
startBlock isNil ifTrue:[
self error:'cannot be made restartable when already started'.
^ self
].
restartable := aBoolean
"Modified: 23.12.1995 / 18:38:32 / cg"
!
singleStep:aBoolean
singleStepping := aBoolean
!
startBlock
"return the processes startup-block"
^ startBlock
!
state
"return a symbol describing the processes state"
^ state
!
state:aSymbol
"set the state - only to be used from scheduler"
state := aSymbol
!
suspendedContext
"return the processes suspended context
- this is the context from which a process switch into the scheduler
or another process occured.
Typically, only the debugger is interested in this one."
%{ /* NOCONTEXT */
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
RETURN (__threadContext(__intVal(i)));
}
%}.
^ nil
! !
!Process methodsFor:'accessing-change notifications'!
addExitAction:aBlock
"add aBlock to the processes exit actions.
This block will be evaluated right before the process dies."
exitActions isNil ifTrue:[
exitActions := OrderedCollection new
].
exitActions add:aBlock
"Created: 12.1.1997 / 00:34:51 / cg"
!
addSuspendAction:aBlock
"add aBlock to the processes suspend actions.
This block will be evaluated when a process gets suspended."
suspendActions isNil ifTrue:[
suspendActions := OrderedCollection new
].
suspendActions add:aBlock
"Modified: 13.12.1995 / 13:44:31 / stefan"
"Created: 12.1.1997 / 00:35:11 / cg"
!
emergencySignalHandler
"return the emergencySignalHandler block.
See Signal>>documentation for more info."
^ emergencySignalHandler
!
emergencySignalHandler:aOneArgBlock
"set the emergencySignalHandler block.
See Signal>>documentation for more info."
emergencySignalHandler := aOneArgBlock
!
removeAllExitActions
"remove all exit actions."
exitActions := nil.
"Created: 12.1.1997 / 00:36:02 / cg"
!
removeAllSuspendActions
"remove all suspend actions."
suspendActions := nil.
"Created: 12.1.1997 / 00:36:16 / cg"
! !
!Process methodsFor:'accessing-stack'!
maximumStackSize
"returns the processes stack limit - i.e. the process will be
interrupted with a recursionSignal-raise, if it ever
needs more stack (in bytes) than this number"
%{ /* NOCONTEXT */
extern int __threadMaxStackSize();
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
RETURN( __MKSMALLINT(__threadMaxStackSize(__intVal(i))) );
}
%}.
^ nil
!
setMaximumStackSize:limit
"sets the processes stack limit - i.e. the process will be
interrupted with a recursionSignal-raise, if it ever
needs more stack (in bytes) than this number.
Returns the old value."
%{ /* NOCONTEXT */
extern int __threadSetMaxStackSize();
OBJ i;
if (__isSmallInteger(i = __INST(id))
&& __isSmallInteger(limit) ) {
RETURN ( __MKSMALLINT(__threadSetMaxStackSize(__intVal(i), __intVal(limit))) );
}
%}.
^ nil
!
setStackInitialSize:initial increment:increment safe:safe
"hook for fine-tuning. Sets the processes initialStackSize- and
and stackIncrement-parameters. Not for normal use."
%{ /* NOCONTEXT */
extern int __threadSetJunkSizes();
OBJ i;
if (__isSmallInteger(i = __INST(id))
&& __isSmallInteger(initial)
&& __isSmallInteger(increment)
&& __isSmallInteger(safe)) {
RETURN ( __threadSetJunkSizes(__intVal(i), __intVal(initial), __intVal(increment), __intVal(safe)) ? true : false );
}
%}.
^ false
! !
!Process methodsFor:'interrupts'!
addInterruptAction:aBlock
"make the receiver evaluate aBlock when resumed/interrupted.
The name is somewhat misleading (actually, its historic):
the block is also evaluated on resume."
self uninterruptablyDo:[
interruptActions isNil ifTrue:[
interruptActions := OrderedCollection with:aBlock.
] ifFalse:[
interruptActions addLast:aBlock.
].
].
"Created: 5.3.1996 / 17:10:10 / cg"
"Modified: 8.3.1996 / 13:03:10 / cg"
!
forceInterruptOnReturnOf:aContext
"helper entry for debugger. Force a stepInterrupt whenever aContext
returns either directly or via an unwind."
aContext markForInterruptOnUnwind.
%{
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
__threadContextStepInterrupt(__intVal(i), 1);
}
%}
!
interrupt
"evaluate my interrupt-actions.
The process will go back to where it got interrupted
after doing this."
|action|
[interruptActions size > 0] whileTrue:[
self uninterruptablyDo:[
action := interruptActions removeFirst
].
action value
].
interruptActions := nil
"Modified: 12.4.1996 / 12:43:31 / cg"
!
interruptWith:aBlock
"interrupt the receiver and make it evaluate aBlock.
If the receiver is currently suspended it is resumed.
Notice, that the process will only perform the block immediately,
IFF its priority is higher than the current processes priority.
Otherwise, it will remain suspended, until its time comes."
Processor activeProcess == self ifTrue:[
aBlock value
] ifFalse:[
self addInterruptAction:aBlock.
Processor scheduleForInterrupt:self.
]
"Modified: 12.1.1997 / 00:52:05 / cg"
!
interruptedIn:aContext
"evaluate my interrupt-actions.
The process will go back to where it got interrupted
after doing this."
|action|
[interruptActions size > 0] whileTrue:[
self uninterruptablyDo:[
action := interruptActions removeFirst
].
action numArgs == 1 ifTrue:[
action value:aContext
] ifFalse:[
action value
]
].
interruptActions := nil
"Created: 18.10.1996 / 20:43:39 / cg"
"Modified: 18.10.1996 / 20:47:20 / cg"
!
onResumeDo:aBlock
"prepare for the receiver to evaluate aBlock when resumed.
This is like #interruptWith:, but does not resume the receiver
(i.e. it continues its sleep).
This is useful to place a breakpoint on a sleeping process, to be fired
when it awakes."
self addInterruptAction:aBlock.
Processor scheduleInterruptActionsOf:self.
"Created: 5.3.1996 / 17:28:04 / cg"
"Modified: 8.3.1996 / 13:01:21 / cg"
! !
!Process methodsFor:'monitoring'!
numberOfStackBoundaryHits
"internal monitoring only - will vanish"
%{ /* NOCONTEXT */
extern int __threadNumberOfStackBoundaryHits();
int n;
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
n = __threadNumberOfStackBoundaryHits(__intVal(i));
n &= 0x3FFFFFFF;
RETURN( __MKSMALLINT(n) );
}
%}.
^ nil
!
numberOfStackSegments
"return the processes number of stack segments currently used.
This method is for monitoring purposes only - it may vanish."
%{ /* NOCONTEXT */
extern int __threadTotalStackSize();
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
RETURN( __MKSMALLINT(__threadStackSegments(__intVal(i))) );
}
%}.
^ nil
!
totalStackSize
"return the processes maximum used stack size.
This method is for monitoring purposes only - it may vanish."
%{ /* NOCONTEXT */
extern int __threadTotalStackSize();
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
RETURN( __MKSMALLINT(__threadTotalStackSize(__intVal(i))) );
}
%}.
^ nil
!
usedStackSize
"Return the processes current stack size.
This method is for monitoring purposes only - it may vanish."
%{ /* NOCONTEXT */
extern int __threadUsedStackSize();
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
RETURN( __MKSMALLINT(__threadUsedStackSize(__intVal(i))) );
}
%}.
^ nil
!
vmTrace:aBoolean
"turn on/off VM message tracing for the receiver.
This is meant for ST/X debugging, and may vanish.
Expect lots of output, once this is turned on."
%{ /* NOCONTEXT */
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
__threadTracing(__intVal(i), aBoolean);
}
%}.
! !
!Process methodsFor:'obsolete'!
exitAction:aBlock
"Obsoleted by addExitAction: / removeAllExitActions.
Add aBlock to the processes exit actions.
This block will be evaluated right before the process dies.
An argument of nil removes all exitActions."
self obsoleteMethodWarning:'use addExitAction: / removeAllExitActions'.
aBlock isNil ifTrue:[
^ self removeAllExitActions.
].
^ self addExitAction:aBlock
"Modified: 13.12.1995 / 13:44:03 / stefan"
"Modified: 12.1.1997 / 00:39:59 / cg"
!
suspendAction:aBlock
"Obsoleted by addSuspendAction: / removeAllSuspendActions.
Add aBlock to the processes suspend actions.
This block will be evaluated when a process gets suspended.
A nil argument removes all suspendActions."
self obsoleteMethodWarning:'use addSuspendAction: / removeAllSuspendActions'.
aBlock isNil ifTrue:[
^ self removeAllSuspendActions.
].
^ self addSuspendAction:aBlock
"Modified: 12.1.1997 / 00:38:22 / cg"
! !
!Process methodsFor:'printing & storing'!
printOn:aStream
"a little more info in my printed representation"
aStream nextPutAll:state article;
space;
nextPutAll:state;
nextPutAll:' Process (';
nextPutAll:self nameOrId;
nextPutAll:')'
! !
!Process methodsFor:'private'!
for:aBlock priority:aPrio
"setup the new process - the receiver is not scheduled for
execution, to get it running, send it #resume"
|nm active|
prio := aPrio.
startBlock := aBlock.
restartable := false.
(Processor newProcessFor:self) ifFalse:[
"for some reason, the Processor was unable to create
a VM process for me ...."
^ nil
].
"
give me a user-friendly name
"
active := Processor activeProcess.
(nm := active name) notNil ifTrue:[
"
avoid name inflation
"
(nm endsWith:' sub') ifFalse:[
nm := nm , ' [' , active id printString , '] sub'
].
name := nm
].
processGroupId := creatorId := active id
"Modified: 25.1.1997 / 01:28:54 / cg"
! !
!Process methodsFor:'private scheduler access'!
setId:idNumber state:stateSymbol
"set id and state - not for public use"
id := idNumber.
creatorId := processGroupId := 0.
state := stateSymbol.
"Modified: 30.10.1996 / 00:35:29 / cg"
!
setPriority:aNumber
"set priority without telling processor - not for public use"
prio := aNumber
!
setStartBlock:aBlock
"set the receivers startup block"
startBlock := aBlock
!
setStateTo:newState if:oldState
state == oldState ifTrue:[state := newState]
!
setStateTo:newState if:oldState1 or:oldState2
(state == oldState1 or:[state == oldState2]) ifTrue:[state := newState]
! !
!Process methodsFor:'queries'!
isDead
"return true, iff the receiver is a dead process"
^ (state isNil or:[state == #dead])
"Modified: 23.12.1995 / 18:35:29 / cg"
!
isRestartable
"return true, iff the receiver is restartable"
^ restartable
!
isSingleStepping
^ singleStepping
!
isSystemProcess
"return true if aProcess is a system process,
which should not be suspended/terminated etc.."
^ (Processor isPureEventDriven
or:[id == 0
or:[processGroupId == 0
or:[(Display notNil and:[Display dispatchProcess == self])
]]])
"
Processor activeProcessIsSystemProcess
"
"Created: 17.4.1997 / 12:57:37 / stefan"
!
nameOrId
"return a string to identify the process - either name or id"
name notNil ifTrue:[^ name].
^ id printString
! !
!Process methodsFor:'special'!
millisecondDelay:millis
"suspend the current process for some time.
If the receiver is a system process (i.e. scheduler or event dispatcher)
this blocks the whole smalltalk for the time delta;
if its a normal thread, only that thread is suspended."
(self isSystemProcess) ifTrue:[
OperatingSystem millisecondDelay:millis
] ifFalse:[
Delay waitForMilliseconds:millis
]
"Created: 16.12.1995 / 13:10:53 / cg"
"Modified: 17.4.1997 / 13:02:25 / stefan"
!
trapRestrictedMethods:trap
"Allow/deny the execution of restricted methods.
Process specific method restriction is not implemented yet, so this call is
redirected to ObjectMemory and causes a system wide restriction.
Notice: method restriction is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
^ObjectMemory trapRestrictedMethods:trap
"
Processor activeProcess trapRestrictedMethods:true
Processor activeProcess trapRestrictedMethods:false
"
"Created: 8.11.1995 / 19:45:04 / stefan"
!
uninterruptablyDo:aBlock
"execute aBlock with interrupts blocked.
This does not prevent preemption by a higher priority processes
if any becomes runnable due to the evaluation of aBlock
(i.e. if a semaphore is signalled there)."
"we must keep track of blocking-state if this is called nested"
(OperatingSystem blockInterrupts) ifTrue:[
"/ already blocked
^ aBlock value
].
^ aBlock valueNowOrOnUnwindDo:[OperatingSystem unblockInterrupts]
!
waitUntilSuspended
"wait until the receiver is suspended."
[
self isDead ifTrue:[^ self].
suspendSemaphore isNil ifTrue:[
suspendSemaphore := Semaphore new name:'process suspend'
].
suspendSemaphore wait
] valueUninterruptably
"Modified: 8.11.1996 / 23:05:24 / cg"
!
waitUntilTerminated
"wait until the receiver is terminated.
This method allows another process to wait till the receiver finishes."
|sema|
[
self isDead ifTrue:[^ self].
sema := Semaphore new name:'process termination'.
self addExitAction:[sema signal].
sema wait.
] valueUninterruptably
"
|p|
p := [10 timesRepeat:[100 factorial]] forkAt:4.
Transcript showCR:'now waiting ...'.
p waitUntilTerminated.
Transcript showCR:'done.'
"
"Modified: 12.1.1997 / 00:40:59 / cg"
!
withLowerPriorityDo:aBlock
"execute aBlock at a lower priority. This can be used to perform
time-consuming operations at a more user-friendly priority."
^ self withPriority:(prio - 1) do:aBlock
"
Processor activeProcess withLowerPriorityDo:[3000 factorial]
"
!
withPriority:aPrio do:aBlock
"execute aBlock at another priority. This can be used to perform
time-consuming operations at a more user-friendly priority,
or some critical action at a higher priority. Do not use too high
of a priority to avoid locking up the system (event processing takes place
at 24)"
|oldprio|
oldprio := prio.
self priority:aPrio.
^ aBlock valueNowOrOnUnwindDo:[
self priority:oldprio
]
"
Processor activeProcess withPriority:7 do:[3000 factorial]
"
"be careful - even ^C wont work until done:
Processor activeProcess withPriority:25 do:[3000 factorial]
"
! !
!Process methodsFor:'startup '!
imageRestart
"restart the process from the beginning.
This is sent by the ProcessorScheduler at image restart time,
to all restartable processes."
|savedGroupId|
"/ ('restart process ' , id printString) errorPrintNL.
savedGroupId := processGroupId.
(Processor newProcessFor:self withId:id) ifFalse:[
"for some reason, the Processor was unable to create
a VM process for me ...."
('Process [warning]: process ' , id printString , ' failed to restart.') errorPrintCR.
^ nil
].
processGroupId := savedGroupId.
self resume
"Created: 28.10.1996 / 20:32:34 / cg"
"Modified: 10.1.1997 / 18:01:13 / cg"
!
restart
"restart the process from the beginning.
This is only possible, if its restartable."
restartable ifFalse:[
^ self error:'process is not restartable'
].
self interruptWith:[RestartSignal raise]
"Modified: 12.1.1997 / 00:54:32 / cg"
!
start
"start the process - this is sent by the VM to the process to get
the process up and running.
Sending #start to the process (instead of directly executing the startBlock)
allows more flexible handling of processes, since anything that responds
to #start can be handled transparently by the VM then ..."
|block|
(block := startBlock) notNil ifTrue:[
"
just for your convenience ...
"
name isNil ifTrue:[
name := '(' , block displayString , ')'
].
restartable ~~ true ifTrue:[startBlock := nil].
[
CoughtSignals handle:[:ex |
ex signal == RestartSignal ifTrue:[
ex restart
].
ex return
] do:[
block value
]
] valueOnUnwindDo:[self terminateNoSignal].
self terminateNoSignal.
] ifFalse:[
"is this artificial restriction useful ?"
self error:'a process cannot be started twice'
]
"Modified: 28.10.1996 / 21:06:45 / cg"
! !
!Process methodsFor:'suspend / resume'!
resume
"resume the receiver process"
Processor resume:self
!
resumeForSingleSend
"resume the receiver process, but only let it execute a single send."
Processor resumeForSingleSend:self
!
stop
"suspend the receiver process - will continue to run when a resume is sent.
A stopped process will not be resumed for interrupt processing."
state := #stopped.
self suspend
"Modified: 13.12.1995 / 13:22:58 / stefan"
!
suspend
"suspend the receiver process - it will continue to run when a resume is sent.
Notice, that an interrupt will also resume the receiver,
so any waiting code should be prepared for premature return from
a suspend (see wait code in Semaphore).
Use #stop for a hard-suspend, which is not affected by interrupts."
self suspendWithState:#suspended
"Modified: 17.6.1996 / 14:41:34 / cg"
!
suspendWithState:aStateSymbol
"like suspend, this suspends the receiver process until a resume is sent.
This sets the state to the argument, aStateSymbol, which is shown
in the ProcessMonitor (instead of #suspended).
(i.e. no new functionality, but a bit more debuggability)
Notice, that an interrupt will also resume the receiver,
so any waiting code should be prepared for premature return from
a suspend (see wait code in Semaphore).
Use #stop for a hard-suspend, which is not affected by interrupts."
suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
suspendActions notNil ifTrue:[
suspendActions do:[:action | action value]
].
"
this is a bit of a kludge: allow someone else to
set the state to something like #ioWait etc.
In this case, do not set the receivers state to #suspend.
(All of this to enhance the output of the process monitor ...)
"
(state == #active or:[state == #run]) ifTrue:[
state := aStateSymbol.
].
Processor suspend:self
!
terminate
"terminate the receiver process.
Termination is done by raising the terminateSignal in the receiver process,
which can be caught.
All unwind actions and the exit-actions (if any)
will be performed before the process is really terminated."
self interruptWith:[
Signal noHandlerSignal handle:[:ex |
ex return.
] do:[
TerminateSignal raise.
].
self terminateNoSignal.
]
"Modified: 12.1.1997 / 00:55:14 / cg"
!
terminateAllSubprocesses
"terminate all the receivers subprocesses and their children as well
(i.e. all processes in the receivers process group, except for
the receiver itself)."
ProcessorScheduler knownProcesses do:[:aProcess |
aProcess ~~ self ifTrue:[
aProcess processGroupId == processGroupId ifTrue:[
aProcess terminateWithAllSubprocesses
]
]
].
"Modified: 28.10.1996 / 20:40:50 / cg"
"Created: 28.10.1996 / 20:43:32 / cg"
!
terminateGroup
"terminate the receiver with all of its created subprocesses
(i.e. all processes in the receivers process group)."
self terminateSubprocesses.
self terminate
"Created: 8.7.1996 / 14:04:15 / cg"
"Modified: 28.10.1996 / 20:42:00 / cg"
!
terminateNoSignal
"hard-terminate the receiver process without sending a terminateSignal
or performing any unwind-handling.
However, exit-actions are performed.
This is useful in case of emergency, when a buggy terminationHandler
prevents you from getting a process to terminate."
|block|
"/ this is treated like the final suspend
suspendActions notNil ifTrue:[
[suspendActions isEmpty] whileFalse:[
block := suspendActions removeFirst.
block value.
]
].
exitActions notNil ifTrue:[
[exitActions isEmpty] whileFalse:[
block := exitActions removeFirst.
block value.
]
].
suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
Processor terminateNoSignal:self
"Modified: 13.12.1995 / 13:40:14 / stefan"
"Modified: 12.2.1997 / 12:41:38 / cg"
!
terminateSubprocesses
"terminate all the receivers subprocesses
(i.e. all processes in the receivers process group, except for
the receiver itself)."
ProcessorScheduler knownProcesses do:[:aProcess |
aProcess ~~ self ifTrue:[
aProcess processGroupId == processGroupId ifTrue:[
aProcess terminate
]
]
].
"Modified: 28.10.1996 / 20:40:50 / cg"
"Created: 28.10.1996 / 20:41:49 / cg"
!
terminateWithAllSubprocesses
"terminate the receiver with all of its created subprocesses and their children
(i.e. all processes in the receivers process group)."
self terminateAllSubprocesses.
self terminate
"Modified: 28.10.1996 / 20:42:00 / cg"
"Created: 28.10.1996 / 20:44:07 / cg"
! !
!Process class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.78 1997-06-16 18:21:30 cg Exp $'
! !
Process initialize!