author | Stefan Vogel <sv@exept.de> |
Fri, 03 Apr 2020 18:50:48 +0200 | |
changeset 5471 | 0bee7a5e40e8 |
parent 4312 | 0c8f81adbee0 |
permissions | -rw-r--r-- |
3495 | 1 |
" |
2 |
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague |
|
3 |
All Rights Reserved |
|
4 |
||
5 |
Permission is hereby granted, free of charge, to any person |
|
6 |
obtaining a copy of this software and associated documentation |
|
7 |
files (the 'Software'), to deal in the Software without |
|
8 |
restriction, including without limitation the rights to use, |
|
9 |
copy, modify, merge, publish, distribute, sublicense, and/or sell |
|
10 |
copies of the Software, and to permit persons to whom the |
|
11 |
Software is furnished to do so, subject to the following |
|
12 |
conditions: |
|
13 |
||
14 |
The above copyright notice and this permission notice shall be |
|
15 |
included in all copies or substantial portions of the Software. |
|
16 |
||
17 |
THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, |
|
18 |
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES |
|
19 |
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND |
|
20 |
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT |
|
21 |
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, |
|
22 |
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING |
|
23 |
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR |
|
24 |
OTHER DEALINGS IN THE SOFTWARE. |
|
25 |
" |
|
26 |
"{ Package: 'stx:libbasic2' }" |
|
27 |
||
28 |
"{ NameSpace: Smalltalk }" |
|
29 |
||
30 |
Object subclass:#AbstractBackgroundJob |
|
3612 | 31 |
instanceVariableNames:'name job priority thread running isDebuggerJob initiatingThread' |
3495 | 32 |
classVariableNames:'' |
33 |
poolDictionaries:'' |
|
34 |
category:'System-Support' |
|
35 |
! |
|
36 |
||
37 |
!AbstractBackgroundJob class methodsFor:'documentation'! |
|
38 |
||
39 |
copyright |
|
40 |
" |
|
41 |
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague |
|
42 |
All Rights Reserved |
|
43 |
||
44 |
Permission is hereby granted, free of charge, to any person |
|
45 |
obtaining a copy of this software and associated documentation |
|
46 |
files (the 'Software'), to deal in the Software without |
|
47 |
restriction, including without limitation the rights to use, |
|
48 |
copy, modify, merge, publish, distribute, sublicense, and/or sell |
|
49 |
copies of the Software, and to permit persons to whom the |
|
50 |
Software is furnished to do so, subject to the following |
|
51 |
conditions: |
|
52 |
||
53 |
The above copyright notice and this permission notice shall be |
|
54 |
included in all copies or substantial portions of the Software. |
|
55 |
||
56 |
THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, |
|
57 |
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES |
|
58 |
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND |
|
59 |
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT |
|
60 |
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, |
|
61 |
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING |
|
62 |
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR |
|
63 |
OTHER DEALINGS IN THE SOFTWARE. |
|
64 |
" |
|
65 |
! |
|
66 |
||
67 |
documentation |
|
68 |
" |
|
69 |
Ab AbstractBackgroundJob is a base superclass for any kind of background |
|
70 |
processing job. Possible uses include (but not limited to): |
|
71 |
copying files, syntax higlighting, live searching, autosave, etc. |
|
72 |
||
73 |
See subclasses for various form of background processing. |
|
74 |
||
75 |
A task to be processed in a background is given to instances |
|
76 |
in a form of a block or a message send. The background task must |
|
77 |
be then started by sending a #start message to the instance of |
|
78 |
the job. A job may be restarted any time by sending #restart or |
|
79 |
terminated by sending #stop. Sending #start to already started |
|
80 |
job does nothing. |
|
81 |
||
82 |
Implementation note: |
|
83 |
The the task is actually processed in a separate, exclusive |
|
84 |
worker thread, so an explicit synchronization have to |
|
85 |
be done iff the task accesses possibly shared data. |
|
86 |
The worker exists only iff the job is actually running. When |
|
87 |
the task is finished, worker thread terminates. |
|
88 |
||
89 |
[author:] |
|
90 |
Jan Vrany <jan.vrany@fit.cvut.cz> |
|
91 |
||
92 |
[instance variables:] |
|
93 |
name <String|nil> A user friendly name of a job, |
|
94 |
useful for identifing job's thread in |
|
95 |
process list. |
|
96 |
job <Block|MessageSend> A task to perform in background. |
|
97 |
priority<Integer> A priority of worker thread. Defaults to |
|
98 |
Processor userBackgroundPriority. |
|
99 |
thread <Process|nil> The worker thread |
|
100 |
running <Boolean> Boolean value indicating whether |
|
101 |
tasks already started or not. |
|
102 |
||
103 |
[see also:] |
|
104 |
BackgroundJob |
|
105 |
BackgroundQueueProcessingJob |
|
106 |
BackgroundPeriodicalJob |
|
107 |
Tools::CodeHighlightingService (uses this class) |
|
108 |
||
109 |
||
110 |
||
111 |
" |
|
112 |
! ! |
|
113 |
||
114 |
!AbstractBackgroundJob class methodsFor:'instance creation'! |
|
115 |
||
116 |
named: name |
|
117 |
||
118 |
^self new name: name |
|
119 |
||
120 |
"Created: / 28-04-2011 / 20:26:48 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
121 |
! |
|
122 |
||
123 |
named: name on: block |
|
124 |
||
125 |
^self new name: name; job: block |
|
126 |
||
127 |
"Created: / 28-04-2011 / 20:27:52 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
128 |
! |
|
129 |
||
130 |
new |
|
131 |
"return an initialized instance" |
|
132 |
||
133 |
^ self basicNew initialize. |
|
134 |
! |
|
135 |
||
136 |
on: block |
|
137 |
||
138 |
^self new job: block |
|
139 |
||
140 |
"Created: / 28-04-2011 / 20:30:03 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
141 |
! ! |
|
142 |
||
4312 | 143 |
!AbstractBackgroundJob class methodsFor:'queries'! |
144 |
||
145 |
isAbstract |
|
146 |
"Return if this class is an abstract class. |
|
147 |
True is returned here for myself only; false for subclasses. |
|
148 |
Abstract subclasses must redefine this again." |
|
149 |
||
150 |
^ self == AbstractBackgroundJob. |
|
151 |
! ! |
|
152 |
||
3495 | 153 |
!AbstractBackgroundJob methodsFor:'accessing'! |
154 |
||
3612 | 155 |
initiatingThread |
156 |
^ initiatingThread |
|
157 |
! |
|
158 |
||
159 |
initiatingThread:something |
|
160 |
initiatingThread := something. |
|
161 |
! |
|
162 |
||
3592
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
163 |
isDebuggerJob |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
164 |
^ isDebuggerJob ? false |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
165 |
! |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
166 |
|
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
167 |
isDebuggerJob:aBoolean |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
168 |
"added to allow suppression of breakpoints/halts of a |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
169 |
job started by the debugger |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
170 |
(if you ask what this is for, |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
171 |
try to put a breakpoint into the syntaxhighlighter in the old schema)" |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
172 |
|
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
173 |
isDebuggerJob := aBoolean |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
174 |
! |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
175 |
|
3495 | 176 |
job |
177 |
^ job |
|
178 |
! |
|
179 |
||
180 |
job:aBlockOrMessageSend |
|
181 |
||
182 |
"Sets the job to be done. The job is sent |
|
183 |
#value from the worker thread once started" |
|
184 |
||
185 |
job := aBlockOrMessageSend. |
|
186 |
||
187 |
"Modified (comment): / 03-08-2011 / 21:02:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
188 |
! |
|
189 |
||
190 |
name |
|
191 |
^ name ? '<unnamed background job>' |
|
192 |
||
193 |
"Modified: / 28-04-2011 / 20:29:52 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
194 |
! |
|
195 |
||
196 |
name:aString |
|
197 |
name := aString. |
|
198 |
! |
|
199 |
||
200 |
priority |
|
201 |
^ priority |
|
202 |
! |
|
203 |
||
204 |
priority:anInteger |
|
205 |
"Set the priority of a worker thread" |
|
206 |
||
207 |
priority := anInteger. |
|
208 |
||
209 |
"Modified (format): / 03-08-2011 / 16:42:45 / cg" |
|
210 |
"Modified (comment): / 03-08-2011 / 21:01:40 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
211 |
! |
|
212 |
||
213 |
thread |
|
214 |
"Return the thread (an instance of Process) that currently |
|
215 |
processes the job or nil. if no processing is currently performed." |
|
216 |
||
217 |
^thread |
|
218 |
||
219 |
"Created: / 18-04-2012 / 10:16:16 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
220 |
! ! |
|
221 |
||
222 |
!AbstractBackgroundJob methodsFor:'initialization'! |
|
223 |
||
224 |
initialize |
|
225 |
priority := Processor userBackgroundPriority. |
|
226 |
running := false. |
|
227 |
||
228 |
"/ super initialize. -- commented since inherited method does nothing |
|
229 |
||
230 |
"Modified: / 29-07-2011 / 10:52:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
231 |
"Modified (format): / 03-08-2011 / 16:42:51 / cg" |
|
232 |
! ! |
|
233 |
||
234 |
!AbstractBackgroundJob methodsFor:'private'! |
|
235 |
||
236 |
setupThread: t priority: p |
|
237 |
"Sets up worker thread" |
|
238 |
||
239 |
t priority: p. |
|
240 |
t name: name. |
|
241 |
||
242 |
"Created: / 20-01-2012 / 16:38:42 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
243 |
! ! |
|
244 |
||
245 |
!AbstractBackgroundJob methodsFor:'processing'! |
|
246 |
||
247 |
process |
|
3507
58dd3995e45b
Added new API to BackgroundJob: allow to pass down a block to evaluate as background job
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3495
diff
changeset
|
248 |
"Actually perform the job. This method is called from the background worker thread" |
3495 | 249 |
|
3507
58dd3995e45b
Added new API to BackgroundJob: allow to pass down a block to evaluate as background job
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3495
diff
changeset
|
250 |
self subclassResponsibility |
3495 | 251 |
|
252 |
"Created: / 28-04-2011 / 20:23:20 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
253 |
"Modified (format): / 03-08-2011 / 16:42:42 / cg" |
|
3507
58dd3995e45b
Added new API to BackgroundJob: allow to pass down a block to evaluate as background job
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3495
diff
changeset
|
254 |
"Modified: / 21-02-2015 / 10:12:24 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
3495 | 255 |
! ! |
256 |
||
257 |
!AbstractBackgroundJob methodsFor:'queries'! |
|
258 |
||
259 |
running |
|
260 |
"Return true if the job is actually running, i.e., if it |
|
261 |
is actually computing a value, contrary to #scheduled, that |
|
262 |
returns true even if computation actually did not start |
|
263 |
(i.e., thread is created but was not scheduled so far)" |
|
264 |
||
265 |
^running |
|
266 |
||
267 |
"Created: / 29-07-2011 / 10:23:04 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
268 |
"Modified (format): / 03-08-2011 / 16:42:35 / cg" |
|
269 |
! |
|
270 |
||
271 |
scheduled |
|
272 |
"Return true, if the job has been already started" |
|
273 |
||
274 |
^thread notNil |
|
275 |
||
276 |
"Created: / 29-07-2011 / 10:47:43 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
277 |
"Modified (format): / 03-08-2011 / 16:42:32 / cg" |
|
278 |
! ! |
|
279 |
||
280 |
!AbstractBackgroundJob methodsFor:'start & stop'! |
|
281 |
||
282 |
abort |
|
283 |
"Abort the job, if it is running. Similar to #stop, but raises |
|
284 |
abort operation request so the job has a chance to terminate |
|
285 |
gracefully" |
|
286 |
||
287 |
| t | |
|
288 |
||
289 |
(t := thread) isNil ifTrue:[^self]. |
|
290 |
t interruptWith:[ |
|
291 |
NoHandlerError handle:[:ex | |
|
292 |
ex exception creator == AbortOperationRequest ifTrue:[ |
|
293 |
ex return. |
|
294 |
]. |
|
295 |
ex reject. |
|
296 |
] do:[ |
|
297 |
AbortOperationRequest raise. |
|
298 |
]. |
|
299 |
]. |
|
300 |
self stop |
|
301 |
||
302 |
"Created: / 09-02-2012 / 19:34:01 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
303 |
! |
|
304 |
||
305 |
restart |
|
306 |
||
307 |
running ifTrue:[ |
|
308 |
self stop. |
|
309 |
]. |
|
310 |
self start |
|
311 |
||
312 |
"Created: / 28-04-2011 / 20:31:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
313 |
"Modified (format): / 03-08-2011 / 16:42:39 / cg" |
|
314 |
"Modified (comment): / 03-08-2011 / 21:03:21 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
315 |
! |
|
316 |
||
317 |
start |
|
318 |
self startWithPriority: priority |
|
319 |
||
320 |
"Created: / 28-04-2011 / 20:23:25 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
321 |
"Modified (format): / 03-08-2011 / 16:44:36 / cg" |
|
322 |
! |
|
323 |
||
324 |
startWithPriority: prio |
|
325 |
| t | |
|
326 |
||
327 |
((t := thread) isNil or:[t isDead]) ifTrue:[ |
|
3592
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
328 |
thread := |
3495 | 329 |
[ |
3592
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
330 |
[ |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
331 |
ControlInterrupt handle:[:ex | |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
332 |
self isDebuggerJob ifTrue:[ |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
333 |
Transcript showCR:'halt/breakpoint ignored in debugger job'. |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
334 |
ex proceed. |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
335 |
]. |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
336 |
ex reject |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
337 |
] do:[ |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
338 |
running := true. |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
339 |
self process |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
340 |
]. |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
341 |
] ensure: [ |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
342 |
running := false. |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
343 |
thread := nil |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
344 |
]. |
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
345 |
] newProcess. |
3495 | 346 |
self setupThread: thread priority: prio. |
347 |
thread resume. |
|
348 |
] |
|
349 |
||
350 |
"Created: / 29-07-2011 / 11:04:22 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
351 |
"Modified (format): / 03-08-2011 / 16:42:19 / cg" |
|
3507
58dd3995e45b
Added new API to BackgroundJob: allow to pass down a block to evaluate as background job
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3495
diff
changeset
|
352 |
"Modified: / 21-02-2015 / 10:10:39 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
3495 | 353 |
! |
354 |
||
355 |
stop |
|
356 |
| t | |
|
357 |
||
358 |
(t := thread) isNil ifTrue:[^self]. |
|
359 |
thread := nil. |
|
360 |
t terminate. |
|
361 |
"/ raise its prio to make it terminate quickly |
|
362 |
t priority:(Processor userSchedulingPriority + 1) |
|
363 |
||
364 |
"Created: / 28-04-2011 / 20:31:18 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
365 |
"Modified: / 18-11-2011 / 14:07:28 / cg" |
|
366 |
! ! |
|
367 |
||
368 |
!AbstractBackgroundJob class methodsFor:'documentation'! |
|
369 |
||
370 |
version |
|
3592
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
371 |
^ '$Header$' |
3495 | 372 |
! |
373 |
||
374 |
version_CVS |
|
3592
ff7df9bc1032
class: AbstractBackgroundJob
Claus Gittinger <cg@exept.de>
parents:
3507
diff
changeset
|
375 |
^ '$Header$' |
3495 | 376 |
! ! |
377 |