Process.st
changeset 699 12f456343eea
parent 532 2511c99de912
child 712 40906c842cd2
equal deleted inserted replaced
698:04533375e12c 699:12f456343eea
     9  other person.  No title to or ownership of the software is
     9  other person.  No title to or ownership of the software is
    10  hereby transferred.
    10  hereby transferred.
    11 "
    11 "
    12 
    12 
    13 Link subclass:#Process
    13 Link subclass:#Process
    14 	 instanceVariableNames:'id prio state startBlock name 
    14 	 instanceVariableNames:'id prio state startBlock name restartable interruptActions
    15 				restartable interruptActions 
    15                 exitActions suspendSemaphore singleStepping
    16 				exitActions suspendSemaphore 
    16                 emergencySignalHandler'
    17 				singleStepping emergencySignalHandler'
       
    18 	 classVariableNames:'TerminateSignal CoughtSignals'
    17 	 classVariableNames:'TerminateSignal CoughtSignals'
    19 	 poolDictionaries:''
    18 	 poolDictionaries:''
    20 	 category:'Kernel-Processes'
    19 	 category:'Kernel-Processes'
    21 !
    20 !
    22 
    21 
    32  inclusion of the above copyright notice.   This software may not
    31  inclusion of the above copyright notice.   This software may not
    33  be provided or otherwise made available to, or used by, any
    32  be provided or otherwise made available to, or used by, any
    34  other person.  No title to or ownership of the software is
    33  other person.  No title to or ownership of the software is
    35  hereby transferred.
    34  hereby transferred.
    36 "
    35 "
    37 !
       
    38 
       
    39 version
       
    40     ^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.35 1995-11-13 09:08:17 stefan Exp $'
       
    41 !
    36 !
    42 
    37 
    43 documentation
    38 documentation
    44 "
    39 "
    45     Instances of Process represent lightweight smalltalk processes 
    40     Instances of Process represent lightweight smalltalk processes 
   201 
   196 
   202 	CoughtSignals := SignalSet with:AbortSignal with:TerminateSignal.
   197 	CoughtSignals := SignalSet with:AbortSignal with:TerminateSignal.
   203     ]
   198     ]
   204 ! !
   199 ! !
   205 
   200 
   206 !Process class methodsFor:'Signal constants'!
       
   207 
       
   208 terminateSignal
       
   209     "return the signal used for process termination"
       
   210 
       
   211     ^ TerminateSignal
       
   212 ! !
       
   213 
       
   214 !Process class methodsFor:'instance creation'!
   201 !Process class methodsFor:'instance creation'!
   215 
   202 
   216 for:aBlock priority:aPrio
   203 for:aBlock priority:aPrio
   217     "create a new (unscheduled) process which will execute aBlock at
   204     "create a new (unscheduled) process which will execute aBlock at
   218      a given priority, once scheduled. The process will start execution once
   205      a given priority, once scheduled. The process will start execution once
   219      it gets a #resume-message."
   206      it gets a #resume-message."
   220 
   207 
   221     ^ self new for:aBlock priority:aPrio
   208     ^ self new for:aBlock priority:aPrio
       
   209 ! !
       
   210 
       
   211 !Process class methodsFor:'Signal constants'!
       
   212 
       
   213 terminateSignal
       
   214     "return the signal used for process termination"
       
   215 
       
   216     ^ TerminateSignal
       
   217 ! !
       
   218 
       
   219 !Process methodsFor:'accessing'!
       
   220 
       
   221 changePriority:aNumber
       
   222     "same as priority:, but returns the old priority.
       
   223      (cannot do this in priority: for ST-80 compatibility)"
       
   224 
       
   225     |oldPrio|
       
   226 
       
   227     oldPrio := prio.
       
   228     Processor changePriority:aNumber for:self.
       
   229     ^ oldPrio
       
   230 !
       
   231 
       
   232 emergencySignalHandler
       
   233     "return the emergencySignalHandler block.
       
   234      See Signal>>documentation for more info."
       
   235 
       
   236     ^ emergencySignalHandler
       
   237 !
       
   238 
       
   239 emergencySignalHandler:aOneArgBlock
       
   240     "set the emergencySignalHandler block.
       
   241      See Signal>>documentation for more info."
       
   242 
       
   243     emergencySignalHandler := aOneArgBlock
       
   244 !
       
   245 
       
   246 exitAction:aBlock
       
   247     "add aBlock to the processes exit actions.
       
   248      This will be evaluated right before the process dies."
       
   249 
       
   250     exitActions isNil ifTrue:[
       
   251 	exitActions := OrderedCollection new
       
   252     ].
       
   253     exitActions add:aBlock
       
   254 !
       
   255 
       
   256 id
       
   257     "return the processes id"
       
   258 
       
   259     ^ id
       
   260 !
       
   261 
       
   262 isDead
       
   263     "return true, if the receiver has already terminated"
       
   264 
       
   265     ^ state == #dead
       
   266 !
       
   267 
       
   268 isRestartable
       
   269     "return true, iff the receiver is restartable"
       
   270 
       
   271     ^ restartable
       
   272 !
       
   273 
       
   274 isSingleStepping
       
   275     ^ singleStepping
       
   276 !
       
   277 
       
   278 maximumStackSize
       
   279     "returns the processes stack limit - i.e. the process will be 
       
   280      interrupted with a recursionSignal-raise, if it ever
       
   281      needs more stack (in bytes) than this number"
       
   282 
       
   283 %{  /* NOCONTEXT */
       
   284     extern int __threadMaxStackSize();
       
   285     OBJ i;
       
   286 
       
   287     if (__isSmallInteger(i = _INST(id))) {
       
   288 	RETURN( _MKSMALLINT(__threadMaxStackSize(_intVal(i))) );
       
   289     }
       
   290 %}.
       
   291     ^ nil
       
   292 !
       
   293 
       
   294 name
       
   295     "return the processes name"
       
   296 
       
   297     ^ name
       
   298 !
       
   299 
       
   300 name:aString
       
   301     "set the processes name"
       
   302 
       
   303     name := aString
       
   304 !
       
   305 
       
   306 nameOrId
       
   307     "return a string to identify the process - either name or id"
       
   308 
       
   309     name notNil ifTrue:[^ name].
       
   310     ^ id printString
       
   311 !
       
   312 
       
   313 priority
       
   314     "return the receivers priority"
       
   315 
       
   316     ^ prio
       
   317 !
       
   318 
       
   319 priority:aNumber
       
   320     "set my priority"
       
   321 
       
   322     Processor changePriority:aNumber for:self.
       
   323 !
       
   324 
       
   325 restartable:aBoolean
       
   326     "set/clear, the restartable flag.
       
   327      Restartable processes will automatically be restarted by the
       
   328      ProcessorScheduler upon image restart. Others have to be restarted
       
   329      manually."
       
   330 
       
   331     startBlock isNil ifTrue:[
       
   332 	self error:'cannot be made restartable when already started'.
       
   333 	^ self
       
   334     ].
       
   335     restartable := aBoolean
       
   336 !
       
   337 
       
   338 setMaximumStackSize:limit
       
   339     "sets the processes stack limit - i.e. the process will be
       
   340      interrupted with a recursionSignal-raise, if it ever
       
   341      needs more stack (in bytes) than this number.
       
   342      Returns the old value."
       
   343 
       
   344 %{  /* NOCONTEXT */
       
   345     extern int __threadSetMaxStackSize();
       
   346     OBJ i;
       
   347 
       
   348     if (__isSmallInteger(i = _INST(id)) 
       
   349      && __isSmallInteger(limit) ) {
       
   350 	RETURN ( _MKSMALLINT(__threadSetMaxStackSize(_intVal(i), _intVal(limit))) );
       
   351     }
       
   352 %}.
       
   353     ^ nil
       
   354 !
       
   355 
       
   356 singleStep:aBoolean
       
   357     singleStepping := aBoolean
       
   358 !
       
   359 
       
   360 startBlock
       
   361     "return the processes startup-block"
       
   362 
       
   363     ^ startBlock
       
   364 !
       
   365 
       
   366 state
       
   367     "return a symbol describing the processes state"
       
   368 
       
   369     ^ state
       
   370 !
       
   371 
       
   372 state:aSymbol
       
   373     "set the state - only to be used from scheduler"
       
   374 
       
   375     state := aSymbol
       
   376 !
       
   377 
       
   378 suspendedContext
       
   379     "return the processes suspended context 
       
   380      - this is the context from which a process switch into the scheduler
       
   381      or another process occured.
       
   382      Typically, only the debugger is interrested in this one."
       
   383 
       
   384 %{  /* NOCONTEXT */
       
   385     extern OBJ __threadContext();
       
   386     OBJ i;
       
   387 
       
   388     if (__isSmallInteger(i = _INST(id))) {
       
   389 	RETURN (__threadContext(_intVal(i)));
       
   390     }
       
   391 %}.
       
   392     ^ nil
       
   393 ! !
       
   394 
       
   395 !Process methodsFor:'interrupts'!
       
   396 
       
   397 interrupt
       
   398     "evaluate my interrupt-actions
       
   399      the process will go back to where it got interrupted
       
   400      after doing this.
       
   401     "
       
   402     |action|
       
   403 
       
   404     [interruptActions notNil and:[interruptActions notEmpty]] whileTrue:[
       
   405 	action := interruptActions removeFirst.
       
   406 	action value
       
   407     ].
       
   408     interruptActions := nil
       
   409 !
       
   410 
       
   411 interruptWith:aBlock
       
   412     "interrupt the receiver and make it evaluate aBlock.
       
   413      If the receiver is currently suspended, the block will be remembered
       
   414      to be evaluated once the receiver wakes up."
       
   415 
       
   416     self uninterruptablyDo:[
       
   417 	interruptActions isNil ifTrue:[
       
   418 	    interruptActions := OrderedCollection with:aBlock.
       
   419 	] ifFalse:[
       
   420 	    interruptActions addLast:aBlock.
       
   421 	].
       
   422     ].
       
   423     Processor scheduleForInterrupt:self.
       
   424 ! !
       
   425 
       
   426 !Process methodsFor:'monitoring'!
       
   427 
       
   428 numberOfStackBoundaryHits
       
   429     "internal monitoring only - will vanish"
       
   430 
       
   431 %{  /* NOCONTEXT */
       
   432     extern int __threadNumberOfStackBoundaryHits();
       
   433     int n;
       
   434     OBJ i;
       
   435 
       
   436     if (__isSmallInteger(i = _INST(id))) {
       
   437 	n = __threadNumberOfStackBoundaryHits(_intVal(i));
       
   438 	n &= 0x3FFFFFFF;
       
   439 	RETURN( _MKSMALLINT(n) );
       
   440     }
       
   441 %}.
       
   442     ^ nil
       
   443 !
       
   444 
       
   445 numberOfStackSegments
       
   446     "return the processes number of stack segments currently used.
       
   447      This method is for monitoring purposes only - it may vanish."
       
   448 
       
   449 %{  /* NOCONTEXT */
       
   450     extern int __threadTotalStackSize();
       
   451     OBJ i;
       
   452 
       
   453     if (__isSmallInteger(i = _INST(id))) {
       
   454 	RETURN( _MKSMALLINT(__threadStackSegments(_intVal(i))) );
       
   455     }
       
   456 %}.
       
   457     ^ nil
       
   458 !
       
   459 
       
   460 totalStackSize
       
   461     "return the processes maximum used stack size.
       
   462      This method is for monitoring purposes only - it may vanish."
       
   463 
       
   464 %{  /* NOCONTEXT */
       
   465     extern int __threadTotalStackSize();
       
   466     OBJ i;
       
   467 
       
   468     if (__isSmallInteger(i = _INST(id))) {
       
   469 	RETURN( _MKSMALLINT(__threadTotalStackSize(_intVal(i))) );
       
   470     }
       
   471 %}.
       
   472     ^ nil
       
   473 !
       
   474 
       
   475 usedStackSize
       
   476     "Return the processes current stack size.
       
   477      This method is for monitoring purposes only - it may vanish."
       
   478 
       
   479 %{  /* NOCONTEXT */
       
   480     extern int __threadUsedStackSize();
       
   481     OBJ i;
       
   482 
       
   483     if (__isSmallInteger(i = _INST(id))) {
       
   484 	RETURN( _MKSMALLINT(__threadUsedStackSize(_intVal(i))) );
       
   485     }
       
   486 %}.
       
   487     ^ nil
       
   488 !
       
   489 
       
   490 vmTrace:aBoolean
       
   491     "turn on/off VM message tracing for the receiver.
       
   492      This is meant for ST/X debugging, and may vanish.
       
   493      Expect lots of output, once this is turned on."
       
   494 
       
   495 %{  /* NOCONTEXT */
       
   496     OBJ i;
       
   497 
       
   498     if (__isSmallInteger(i = _INST(id))) {
       
   499 	__threadTracing(_intVal(i), aBoolean);
       
   500     }
       
   501 %}.
       
   502 ! !
       
   503 
       
   504 !Process methodsFor:'printing & storing'!
       
   505 
       
   506 printOn:aStream
       
   507     "a little more info in my printed representation"
       
   508 
       
   509     aStream nextPutAll:state article;
       
   510 	    space;
       
   511 	    nextPutAll:state;
       
   512 	    nextPutAll:' Process (';
       
   513 	    nextPutAll:self nameOrId;
       
   514 	    nextPutAll:')'
   222 ! !
   515 ! !
   223 
   516 
   224 !Process methodsFor:'private'!
   517 !Process methodsFor:'private'!
   225 
   518 
   226 for:aBlock priority:aPrio
   519 for:aBlock priority:aPrio
   252 	].
   545 	].
   253 	name := nm
   546 	name := nm
   254     ]
   547     ]
   255 ! !
   548 ! !
   256 
   549 
   257 !Process methodsFor:'accessing'!
       
   258 
       
   259 state
       
   260     "return a symbol describing the processes state"
       
   261 
       
   262     ^ state
       
   263 !
       
   264 
       
   265 state:aSymbol
       
   266     "set the state - only to be used from scheduler"
       
   267 
       
   268     state := aSymbol
       
   269 !
       
   270 
       
   271 isDead
       
   272     "return true, if the receiver has already terminated"
       
   273 
       
   274     ^ state == #dead
       
   275 !
       
   276 
       
   277 startBlock
       
   278     "return the processes startup-block"
       
   279 
       
   280     ^ startBlock
       
   281 !
       
   282 
       
   283 emergencySignalHandler:aOneArgBlock
       
   284     "set the emergencySignalHandler block.
       
   285      See Signal>>documentation for more info."
       
   286 
       
   287     emergencySignalHandler := aOneArgBlock
       
   288 !
       
   289 
       
   290 emergencySignalHandler
       
   291     "return the emergencySignalHandler block.
       
   292      See Signal>>documentation for more info."
       
   293 
       
   294     ^ emergencySignalHandler
       
   295 !
       
   296 
       
   297 priority
       
   298     "return the receivers priority"
       
   299 
       
   300     ^ prio
       
   301 !
       
   302 
       
   303 priority:aNumber
       
   304     "set my priority"
       
   305 
       
   306     Processor changePriority:aNumber for:self.
       
   307 !
       
   308 
       
   309 isRestartable
       
   310     "return true, iff the receiver is restartable"
       
   311 
       
   312     ^ restartable
       
   313 !
       
   314 
       
   315 restartable:aBoolean
       
   316     "set/clear, the restartable flag.
       
   317      Restartable processes will automatically be restarted by the
       
   318      ProcessorScheduler upon image restart. Others have to be restarted
       
   319      manually."
       
   320 
       
   321     startBlock isNil ifTrue:[
       
   322 	self error:'cannot be made restartable when already started'.
       
   323 	^ self
       
   324     ].
       
   325     restartable := aBoolean
       
   326 !
       
   327 
       
   328 changePriority:aNumber
       
   329     "same as priority:, but returns the old priority.
       
   330      (cannot do this in priority: for ST-80 compatibility)"
       
   331 
       
   332     |oldPrio|
       
   333 
       
   334     oldPrio := prio.
       
   335     Processor changePriority:aNumber for:self.
       
   336     ^ oldPrio
       
   337 !
       
   338 
       
   339 isSingleStepping
       
   340     ^ singleStepping
       
   341 !
       
   342 
       
   343 singleStep:aBoolean
       
   344     singleStepping := aBoolean
       
   345 !
       
   346 
       
   347 id
       
   348     "return the processes id"
       
   349 
       
   350     ^ id
       
   351 !
       
   352 
       
   353 name
       
   354     "return the processes name"
       
   355 
       
   356     ^ name
       
   357 !
       
   358 
       
   359 name:aString
       
   360     "set the processes name"
       
   361 
       
   362     name := aString
       
   363 !
       
   364 
       
   365 nameOrId
       
   366     "return a string to identify the process - either name or id"
       
   367 
       
   368     name notNil ifTrue:[^ name].
       
   369     ^ id printString
       
   370 !
       
   371 
       
   372 exitAction:aBlock
       
   373     "add aBlock to the processes exit actions.
       
   374      This will be evaluated right before the process dies."
       
   375 
       
   376     exitActions isNil ifTrue:[
       
   377 	exitActions := OrderedCollection new
       
   378     ].
       
   379     exitActions add:aBlock
       
   380 !
       
   381 
       
   382 suspendedContext
       
   383     "return the processes suspended context 
       
   384      - this is the context from which a process switch into the scheduler
       
   385      or another process occured.
       
   386      Typically, only the debugger is interrested in this one."
       
   387 
       
   388 %{  /* NOCONTEXT */
       
   389     extern OBJ __threadContext();
       
   390     OBJ i;
       
   391 
       
   392     if (__isSmallInteger(i = _INST(id))) {
       
   393 	RETURN (__threadContext(_intVal(i)));
       
   394     }
       
   395 %}.
       
   396     ^ nil
       
   397 !
       
   398 
       
   399 maximumStackSize
       
   400     "returns the processes stack limit - i.e. the process will be 
       
   401      interrupted with a recursionSignal-raise, if it ever
       
   402      needs more stack (in bytes) than this number"
       
   403 
       
   404 %{  /* NOCONTEXT */
       
   405     extern int __threadMaxStackSize();
       
   406     OBJ i;
       
   407 
       
   408     if (__isSmallInteger(i = _INST(id))) {
       
   409 	RETURN( _MKSMALLINT(__threadMaxStackSize(_intVal(i))) );
       
   410     }
       
   411 %}.
       
   412     ^ nil
       
   413 !
       
   414 
       
   415 setMaximumStackSize:limit
       
   416     "sets the processes stack limit - i.e. the process will be
       
   417      interrupted with a recursionSignal-raise, if it ever
       
   418      needs more stack (in bytes) than this number.
       
   419      Returns the old value."
       
   420 
       
   421 %{  /* NOCONTEXT */
       
   422     extern int __threadSetMaxStackSize();
       
   423     OBJ i;
       
   424 
       
   425     if (__isSmallInteger(i = _INST(id)) 
       
   426      && __isSmallInteger(limit) ) {
       
   427 	RETURN ( _MKSMALLINT(__threadSetMaxStackSize(_intVal(i), _intVal(limit))) );
       
   428     }
       
   429 %}.
       
   430     ^ nil
       
   431 ! !
       
   432 
       
   433 !Process methodsFor:'monitoring'!
       
   434 
       
   435 vmTrace:aBoolean
       
   436     "turn on/off VM message tracing for the receiver.
       
   437      This is meant for ST/X debugging, and may vanish.
       
   438      Expect lots of output, once this is turned on."
       
   439 
       
   440 %{  /* NOCONTEXT */
       
   441     OBJ i;
       
   442 
       
   443     if (__isSmallInteger(i = _INST(id))) {
       
   444 	__threadTracing(_intVal(i), aBoolean);
       
   445     }
       
   446 %}.
       
   447 !
       
   448 
       
   449 usedStackSize
       
   450     "Return the processes current stack size.
       
   451      This method is for monitoring purposes only - it may vanish."
       
   452 
       
   453 %{  /* NOCONTEXT */
       
   454     extern int __threadUsedStackSize();
       
   455     OBJ i;
       
   456 
       
   457     if (__isSmallInteger(i = _INST(id))) {
       
   458 	RETURN( _MKSMALLINT(__threadUsedStackSize(_intVal(i))) );
       
   459     }
       
   460 %}.
       
   461     ^ nil
       
   462 !
       
   463 
       
   464 totalStackSize
       
   465     "return the processes maximum used stack size.
       
   466      This method is for monitoring purposes only - it may vanish."
       
   467 
       
   468 %{  /* NOCONTEXT */
       
   469     extern int __threadTotalStackSize();
       
   470     OBJ i;
       
   471 
       
   472     if (__isSmallInteger(i = _INST(id))) {
       
   473 	RETURN( _MKSMALLINT(__threadTotalStackSize(_intVal(i))) );
       
   474     }
       
   475 %}.
       
   476     ^ nil
       
   477 !
       
   478 
       
   479 numberOfStackSegments
       
   480     "return the processes number of stack segments currently used.
       
   481      This method is for monitoring purposes only - it may vanish."
       
   482 
       
   483 %{  /* NOCONTEXT */
       
   484     extern int __threadTotalStackSize();
       
   485     OBJ i;
       
   486 
       
   487     if (__isSmallInteger(i = _INST(id))) {
       
   488 	RETURN( _MKSMALLINT(__threadStackSegments(_intVal(i))) );
       
   489     }
       
   490 %}.
       
   491     ^ nil
       
   492 !
       
   493 
       
   494 numberOfStackBoundaryHits
       
   495     "internal monitoring only - will vanish"
       
   496 
       
   497 %{  /* NOCONTEXT */
       
   498     extern int __threadNumberOfStackBoundaryHits();
       
   499     int n;
       
   500     OBJ i;
       
   501 
       
   502     if (__isSmallInteger(i = _INST(id))) {
       
   503 	n = __threadNumberOfStackBoundaryHits(_intVal(i));
       
   504 	n &= 0x3FFFFFFF;
       
   505 	RETURN( _MKSMALLINT(n) );
       
   506     }
       
   507 %}.
       
   508     ^ nil
       
   509 ! !
       
   510 
       
   511 !Process methodsFor:'private scheduler access'!
   550 !Process methodsFor:'private scheduler access'!
       
   551 
       
   552 setId:idNumber state:stateSymbol
       
   553     "set id and state - not for public use"
       
   554 
       
   555     id := idNumber.
       
   556     state := stateSymbol.
       
   557 !
   512 
   558 
   513 setPriority:aNumber
   559 setPriority:aNumber
   514     "set priority without telling processor - not for public use"
   560     "set priority without telling processor - not for public use"
   515 
   561 
   516     prio := aNumber
   562     prio := aNumber
   526     state == oldState ifTrue:[state := newState]
   572     state == oldState ifTrue:[state := newState]
   527 !
   573 !
   528 
   574 
   529 setStateTo:newState if:oldState1 or:oldState2
   575 setStateTo:newState if:oldState1 or:oldState2
   530     (state == oldState1 or:[state == oldState2]) ifTrue:[state := newState]
   576     (state == oldState1 or:[state == oldState2]) ifTrue:[state := newState]
   531 !
   577 ! !
   532 
   578 
   533 setId:idNumber state:stateSymbol
   579 !Process methodsFor:'special'!
   534     "set id and state - not for public use"
   580 
   535 
   581 trapRestrictedMethods:trap
   536     id := idNumber.
   582     "Allow/deny the execution of restricted methods.
   537     state := stateSymbol.
   583      Process specific method restriction is not implemented yet, so this call is
       
   584      redirected to ObjectMemory and causes a system wide restriction.
       
   585 
       
   586      Notice: method restriction is a nonstandard feature, not supported
       
   587      by other smalltalk implementations and not specified in the ANSI spec.
       
   588      This is EXPERIMENTAL - and being evaluated for usability.
       
   589      It may change or even vanish (if it shows to be not useful)."
       
   590 
       
   591     ^ObjectMemory trapRestrictedMethods:trap
       
   592 
       
   593     "
       
   594 	Processor activeProcess trapRestrictedMethods:true
       
   595 	Processor activeProcess trapRestrictedMethods:false
       
   596     "
       
   597 
       
   598     "Created: 8.11.1995 / 19:45:04 / stefan"
       
   599 !
       
   600 
       
   601 uninterruptablyDo:aBlock
       
   602     "execute aBlock with interrupts blocked. 
       
   603      This does not prevent preemption by a higher priority processes
       
   604      if any becomes runnable due to the evaluation of aBlock
       
   605      (i.e. if a semaphore is signalled there)."
       
   606 
       
   607     |wasBlocked|
       
   608 
       
   609     "we must keep track of blocking-state if this is called nested"
       
   610 
       
   611     wasBlocked := OperatingSystem blockInterrupts.
       
   612     ^ aBlock valueNowOrOnUnwindDo:[
       
   613 	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
       
   614 	0 "stc hint"
       
   615     ]
       
   616 !
       
   617 
       
   618 waitUntilSuspended
       
   619     "wait until the receiver is suspended."
       
   620 
       
   621     |wasBlocked|
       
   622 
       
   623     wasBlocked := OperatingSystem blockInterrupts.
       
   624     suspendSemaphore isNil ifTrue:[suspendSemaphore := Semaphore new].
       
   625     suspendSemaphore wait
       
   626     wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
       
   627 !
       
   628 
       
   629 waitUntilTerminated
       
   630     "wait until the receiver is terminated.
       
   631      This method allows another process to wait till the receiver finishes."
       
   632 
       
   633     |wasBlocked sema|
       
   634 
       
   635     wasBlocked := OperatingSystem blockInterrupts.
       
   636     sema := Semaphore new.
       
   637     self exitAction:[sema signal].
       
   638     sema wait.
       
   639     wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
       
   640 !
       
   641 
       
   642 withLowerPriorityDo:aBlock
       
   643     "execute aBlock at a lower priority. This can be used to perform
       
   644      time-consuming operations at a more user-friendly priority."
       
   645 
       
   646     ^ self withPriority:(prio - 1) do:aBlock
       
   647 
       
   648     "
       
   649      Processor activeProcess withLowerPriorityDo:[3000 factorial]
       
   650     "
       
   651 !
       
   652 
       
   653 withPriority:aPrio do:aBlock
       
   654     "execute aBlock at another priority. This can be used to perform
       
   655      time-consuming operations at a more user-friendly priority,
       
   656      or some critical action at a higher priority. Do not use too high
       
   657      of a priority to avoid locking up the system (event processing takes place
       
   658      at 24)"
       
   659 
       
   660     |oldprio|
       
   661 
       
   662     oldprio := prio.
       
   663     self priority:aPrio.
       
   664 
       
   665     ^ aBlock valueNowOrOnUnwindDo:[
       
   666 	self priority:oldprio
       
   667     ]
       
   668 
       
   669     "
       
   670      Processor activeProcess withPriority:7 do:[3000 factorial]
       
   671     "
       
   672     "be careful - even ^C wont work until done:
       
   673      Processor activeProcess withPriority:25 do:[3000 factorial]
       
   674     "
   538 ! !
   675 ! !
   539 
   676 
   540 !Process methodsFor:'startup '!
   677 !Process methodsFor:'startup '!
       
   678 
       
   679 restart
       
   680     "restart the process from the beginning.
       
   681      This is sent by the ProcessorScheduler to all restartable processes."
       
   682 
       
   683 "/  ('restart process ' , id printString) errorPrintNL.
       
   684 
       
   685     (Processor newProcessFor:self withId:id) ifFalse:[ 
       
   686 	"for some reason, the Processor was unable to create
       
   687 	 a VM process for me ...."
       
   688 
       
   689 	('process ' , id printString , ' failed to restart.') errorPrintNL.
       
   690 	^ nil
       
   691     ].
       
   692     self resume
       
   693 !
   541 
   694 
   542 start
   695 start
   543     "start the process - this is sent by the VM to the process to get
   696     "start the process - this is sent by the VM to the process to get
   544      the process up and running.
   697      the process up and running.
   545      Sending #start to the process (instead of directly executing the startBlock)
   698      Sending #start to the process (instead of directly executing the startBlock)
   563 	self terminateNoSignal.
   716 	self terminateNoSignal.
   564     ] ifFalse:[
   717     ] ifFalse:[
   565 	"is this artificial restriction useful ?"
   718 	"is this artificial restriction useful ?"
   566 	self error:'a process cannot be started twice'
   719 	self error:'a process cannot be started twice'
   567     ]
   720     ]
   568 !
       
   569 
       
   570 restart
       
   571     "restart the process from the beginning.
       
   572      This is sent by the ProcessorScheduler to all restartable processes."
       
   573 
       
   574 "/  ('restart process ' , id printString) errorPrintNL.
       
   575 
       
   576     (Processor newProcessFor:self withId:id) ifFalse:[ 
       
   577 	"for some reason, the Processor was unable to create
       
   578 	 a VM process for me ...."
       
   579 
       
   580 	('process ' , id printString , ' failed to restart.') errorPrintNL.
       
   581 	^ nil
       
   582     ].
       
   583     self resume
       
   584 ! !
   721 ! !
   585 
   722 
   586 !Process methodsFor:'suspend / resume'!
   723 !Process methodsFor:'suspend / resume'!
       
   724 
       
   725 resume
       
   726     "resume the receiver process"
       
   727 
       
   728     Processor resume:self
       
   729 !
       
   730 
       
   731 resumeForSingleSend
       
   732     "resume the receiver process, but only let it execute a single send."
       
   733 
       
   734     Processor resumeForSingleSend:self
       
   735 !
   587 
   736 
   588 stop
   737 stop
   589     "suspend the receiver process - will continue to run when a resume is sent.
   738     "suspend the receiver process - will continue to run when a resume is sent.
   590      A stopped process will not be resumed for interrupt processing."
   739      A stopped process will not be resumed for interrupt processing."
   591 
   740 
   598     "suspend the receiver process - will continue to run when a resume is sent.
   747     "suspend the receiver process - will continue to run when a resume is sent.
   599      An interrupt will resume the receiver."
   748      An interrupt will resume the receiver."
   600 
   749 
   601     suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
   750     suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
   602     Processor suspend:self
   751     Processor suspend:self
   603 !
       
   604 
       
   605 resume
       
   606     "resume the receiver process"
       
   607 
       
   608     Processor resume:self
       
   609 !
       
   610 
       
   611 resumeForSingleSend
       
   612     "resume the receiver process, but only let it execute a single send."
       
   613 
       
   614     Processor resumeForSingleSend:self
       
   615 !
   752 !
   616 
   753 
   617 terminate
   754 terminate
   618     "terminate the receiver process. Termination is done by raising
   755     "terminate the receiver process. Termination is done by raising
   619      the terminateSignal in the receiver process, which can be cought.
   756      the terminateSignal in the receiver process, which can be cought.
   647     ].
   784     ].
   648     suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
   785     suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
   649     Processor terminateNoSignal:self
   786     Processor terminateNoSignal:self
   650 ! !
   787 ! !
   651 
   788 
   652 !Process methodsFor:'interrupts'!
   789 !Process class methodsFor:'documentation'!
   653 
   790 
   654 interruptWith:aBlock
   791 version
   655     "interrupt the receiver and make it evaluate aBlock.
   792     ^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.36 1995-12-07 21:29:26 cg Exp $'
   656      If the receiver is currently suspended, the block will be remembered
   793 ! !
   657      to be evaluated once the receiver wakes up."
   794 Process initialize!
   658 
       
   659     self uninterruptablyDo:[
       
   660 	interruptActions isNil ifTrue:[
       
   661 	    interruptActions := OrderedCollection with:aBlock.
       
   662 	] ifFalse:[
       
   663 	    interruptActions addLast:aBlock.
       
   664 	].
       
   665     ].
       
   666     Processor scheduleForInterrupt:self.
       
   667 !
       
   668 
       
   669 interrupt
       
   670     "evaluate my interrupt-actions
       
   671      the process will go back to where it got interrupted
       
   672      after doing this.
       
   673     "
       
   674     |action|
       
   675 
       
   676     [interruptActions notNil and:[interruptActions notEmpty]] whileTrue:[
       
   677 	action := interruptActions removeFirst.
       
   678 	action value
       
   679     ].
       
   680     interruptActions := nil
       
   681 ! !
       
   682 
       
   683 !Process methodsFor:'special'!
       
   684 
       
   685 withPriority:aPrio do:aBlock
       
   686     "execute aBlock at another priority. This can be used to perform
       
   687      time-consuming operations at a more user-friendly priority,
       
   688      or some critical action at a higher priority. Do not use too high
       
   689      of a priority to avoid locking up the system (event processing takes place
       
   690      at 24)"
       
   691 
       
   692     |oldprio|
       
   693 
       
   694     oldprio := prio.
       
   695     self priority:aPrio.
       
   696 
       
   697     ^ aBlock valueNowOrOnUnwindDo:[
       
   698 	self priority:oldprio
       
   699     ]
       
   700 
       
   701     "
       
   702      Processor activeProcess withPriority:7 do:[3000 factorial]
       
   703     "
       
   704     "be careful - even ^C wont work until done:
       
   705      Processor activeProcess withPriority:25 do:[3000 factorial]
       
   706     "
       
   707 !
       
   708 
       
   709 withLowerPriorityDo:aBlock
       
   710     "execute aBlock at a lower priority. This can be used to perform
       
   711      time-consuming operations at a more user-friendly priority."
       
   712 
       
   713     ^ self withPriority:(prio - 1) do:aBlock
       
   714 
       
   715     "
       
   716      Processor activeProcess withLowerPriorityDo:[3000 factorial]
       
   717     "
       
   718 !
       
   719 
       
   720 uninterruptablyDo:aBlock
       
   721     "execute aBlock with interrupts blocked. 
       
   722      This does not prevent preemption by a higher priority processes
       
   723      if any becomes runnable due to the evaluation of aBlock
       
   724      (i.e. if a semaphore is signalled there)."
       
   725 
       
   726     |wasBlocked|
       
   727 
       
   728     "we must keep track of blocking-state if this is called nested"
       
   729 
       
   730     wasBlocked := OperatingSystem blockInterrupts.
       
   731     ^ aBlock valueNowOrOnUnwindDo:[
       
   732 	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
       
   733 	0 "stc hint"
       
   734     ]
       
   735 !
       
   736 
       
   737 waitUntilTerminated
       
   738     "wait until the receiver is terminated.
       
   739      This method allows another process to wait till the receiver finishes."
       
   740 
       
   741     |wasBlocked sema|
       
   742 
       
   743     wasBlocked := OperatingSystem blockInterrupts.
       
   744     sema := Semaphore new.
       
   745     self exitAction:[sema signal].
       
   746     sema wait.
       
   747     wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
       
   748 !
       
   749 
       
   750 waitUntilSuspended
       
   751     "wait until the receiver is suspended."
       
   752 
       
   753     |wasBlocked|
       
   754 
       
   755     wasBlocked := OperatingSystem blockInterrupts.
       
   756     suspendSemaphore isNil ifTrue:[suspendSemaphore := Semaphore new].
       
   757     suspendSemaphore wait
       
   758     wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
       
   759 !
       
   760 
       
   761 trapRestrictedMethods:trap
       
   762     "Allow/deny the execution of restricted methods.
       
   763      Process specific method restriction is not implemented yet, so this call is
       
   764      redirected to ObjectMemory and causes a system wide restriction.
       
   765 
       
   766      Notice: method restriction is a nonstandard feature, not supported
       
   767      by other smalltalk implementations and not specified in the ANSI spec.
       
   768      This is EXPERIMENTAL - and being evaluated for usability.
       
   769      It may change or even vanish (if it shows to be not useful)."
       
   770 
       
   771     ^ObjectMemory trapRestrictedMethods:trap
       
   772 
       
   773     "
       
   774 	Processor activeProcess trapRestrictedMethods:true
       
   775 	Processor activeProcess trapRestrictedMethods:false
       
   776     "
       
   777 
       
   778     "Created: 8.11.1995 / 19:45:04 / stefan"
       
   779 ! !
       
   780     
       
   781 !Process methodsFor:'printing & storing'!
       
   782 
       
   783 printOn:aStream
       
   784     "a little more info in my printed representation"
       
   785 
       
   786     aStream nextPutAll:state article;
       
   787 	    space;
       
   788 	    nextPutAll:state;
       
   789 	    nextPutAll:' Process (';
       
   790 	    nextPutAll:self nameOrId;
       
   791 	    nextPutAll:')'
       
   792 ! !