.
"
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'
classVariableNames:'TerminateSignal CoughtSignals'
poolDictionaries:''
category:'Kernel-Processes'
!
Process comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libbasic/Process.st,v 1.30 1995-08-08 00:48:25 claus Exp $
'!
!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.
"
!
version
"
$Header: /cvs/stx/stx/libbasic/Process.st,v 1.30 1995-08-08 00:48:25 claus Exp $
"
!
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 cought 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
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 (not yet implemented)
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 cought - or at least
rejected in handlers)
"
!
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.
[
'starting' printNL.
100 timesRepeat:[1000 factorial].
'done with factorial' printNL.
] forkAt:(Processor userBackgroundPriority).
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.
[
'starting' printNL.
100 timesRepeat:[1000 factorial].
'done with factorial' printNL.
] forkAt:1.
start a background process, reading a pipe without blocking other
processes;
[
|p|
'starting' printNL.
p := PipeStream readingFrom:'ls -lR .'.
[p atEnd] whileFalse:[
p readWait.
p nextLine printNL.
].
p close.
'done with pipe' printNL.
] forkAt:1.
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'.
CoughtSignals := SignalSet with:AbortSignal with:TerminateSignal.
]
! !
!Process class methodsFor:'Signal constants'!
terminateSignal
"return the signal used for process termination"
^ TerminateSignal
! !
!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 new for:aBlock priority:aPrio
! !
!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
]
! !
!Process methodsFor:'accessing'!
state
"return a symbol describing the processes state"
^ state
!
state:aSymbol
"set the state - only to be used from scheduler"
state := aSymbol
!
isDead
"return true, if the receiver has already terminated"
^ state == #dead
!
startBlock
"return the processes startup-block"
^ startBlock
!
emergencySignalHandler:aOneArgBlock
"set the emergencySignalHandler block.
See Signal>>documentation for more info."
emergencySignalHandler := aOneArgBlock
!
emergencySignalHandler
"return the emergencySignalHandler block.
See Signal>>documentation for more info."
^ emergencySignalHandler
!
priority
"return the receivers priority"
^ prio
!
priority:aNumber
"set my priority"
Processor changePriority:aNumber for:self.
!
isRestartable
"return true, iff the receiver is restartable"
^ restartable
!
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
!
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
!
isSingleStepping
^ singleStepping
!
singleStep:aBoolean
singleStepping := aBoolean
!
id
"return the processes id"
^ id
!
name
"return the processes name"
^ name
!
name:aString
"set the processes name"
name := aString
!
nameOrId
"return a string to identify the process - either name or id"
name notNil ifTrue:[^ name].
^ id printString
!
exitAction:aBlock
"add aBlock to the processes exit actions.
This will be evaluated right before the process dies."
exitActions isNil ifTrue:[
exitActions := OrderedCollection new
].
exitActions add:aBlock
!
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 interrested in this one."
%{ /* NOCONTEXT */
extern OBJ __threadContext();
OBJ i;
if (__isSmallInteger(i = _INST(id))) {
RETURN (__threadContext(_intVal(i)));
}
%}.
^ nil
!
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
! !
!Process methodsFor:'monitoring'!
vmTrace:aBoolean
"turn on/off VM message tracing for the receiver.
This is meant for ST/X debugging, and may valish.
Expect lots of output, once this is turned on."
%{ /* NOCONTEXT */
OBJ i;
if (__isSmallInteger(i = _INST(id))) {
__threadTracing(_intVal(i), aBoolean);
}
%}.
!
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
!
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
!
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
!
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
! !
!Process methodsFor:'private scheduler access'!
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]
!
setId:idNumber state:stateSymbol
"set id and state - not for public use"
id := idNumber.
state := stateSymbol.
! !
!Process methodsFor:'startup '!
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 return
] do:block.
self terminateNoSignal.
] ifFalse:[
"is this artificial restriction useful ?"
self error:'a process cannot be started twice'
]
!
restart
"restart the process from the beginning.
This is sent by the ProcessorScheduler to all restartable processes."
"/ ('restart process ' , id printString) errorPrintNL.
(Processor newProcessFor:self withId:id) ifFalse:[
"for some reason, the Processor was unable to create
a VM process for me ...."
('process ' , id printString , ' failed to restart.') errorPrintNL.
^ nil
].
self resume
! !
!Process methodsFor:'suspend / resume'!
stop
"suspend the receiver process - will continue to run when a resume is sent.
A stopped process will not be resumed for interrupt processing."
suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
state := #stopped.
Processor suspend:self
!
suspend
"suspend the receiver process - will continue to run when a resume is sent.
An interrupt will resume the receiver."
suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
Processor suspend:self
!
resume
"resume the receiver process"
Processor resume:self
!
resumeForSingleSend
"resume the receiver process, but only let it execute a single send."
Processor resumeForSingleSend:self
!
terminate
"terminate the receiver process. Termination is done by raising
the terminateSignal in the receiver process, which can be cought.
All unwind actions and the exit-actions (if any)
will be performed before the process is really terminated."
Processor activeProcess == self ifTrue:[
Signal noHandlerSignal handle:[:ex |
ex return.
] do:[
TerminateSignal raise.
].
self terminateNoSignal.
] ifFalse:[
self interruptWith:[self terminate]
]
!
terminateNoSignal
"terminate the receiver process without sending a terminateSignal
or performing any unwind-handling.
However, exit-actions are performed."
|block|
exitActions notNil ifTrue:[
[exitActions notEmpty] whileTrue:[
block := exitActions removeFirst.
block value.
]
].
suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
Processor terminateNoSignal:self
! !
!Process methodsFor:'interrupts'!
interruptWith:aBlock
"interrupt the receiver and make it evaluate aBlock.
If the receiver is currently suspended, the block will be remembered
to be evaluated once the receiver wakes up."
self uninterruptablyDo:[
interruptActions isNil ifTrue:[
interruptActions := OrderedCollection with:aBlock.
] ifFalse:[
interruptActions addLast:aBlock.
].
].
Processor scheduleForInterrupt:self.
!
interrupt
"evaluate my interrupt-actions
the process will go back to where it got interrupted
after doing this.
"
|action|
[interruptActions notNil and:[interruptActions notEmpty]] whileTrue:[
action := interruptActions removeFirst.
action value
].
interruptActions := nil
! !
!Process methodsFor:'special'!
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]
"
!
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]
"
!
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)."
|wasBlocked|
"we must keep track of blocking-state if this is called nested"
wasBlocked := OperatingSystem blockInterrupts.
^ aBlock valueNowOrOnUnwindDo:[
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
0 "stc hint"
]
!
waitUntilTerminated
"wait until the receiver is terminated.
This method allows another process to wait till the receiver finishes."
|wasBlocked sema|
wasBlocked := OperatingSystem blockInterrupts.
sema := Semaphore new.
self exitAction:[sema signal].
sema wait.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
waitUntilSuspended
"wait until the receiver is suspended."
|wasBlocked|
wasBlocked := OperatingSystem blockInterrupts.
suspendSemaphore isNil ifTrue:[suspendSemaphore := Semaphore new].
suspendSemaphore wait
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
! !
!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:')'
! !