Applied patches from Stephen Deasey for better compile time error checking.
1 | /* |
2 | * The contents of this file are subject to the AOLserver Public License |
3 | * Version 1.1 (the "License"); you may not use this file except in |
4 | * compliance with the License. You may obtain a copy of the License at |
5 | * http://aolserver.com/. |
6 | * |
7 | * Software distributed under the License is distributed on an "AS IS" |
8 | * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See |
9 | * the License for the specific language governing rights and limitations |
10 | * under the License. |
11 | * |
12 | * The Original Code is AOLserver Code and related documentation |
13 | * distributed by AOL. |
14 | * |
15 | * The Initial Developer of the Original Code is America Online, |
16 | * Inc. Portions created by AOL are Copyright (C) 1999 America Online, |
17 | * Inc. All Rights Reserved. |
18 | * |
19 | * Alternatively, the contents of this file may be used under the terms |
20 | * of the GNU General Public License (the "GPL"), in which case the |
21 | * provisions of GPL are applicable instead of those above. If you wish |
22 | * to allow use of your version of this file only under the terms of the |
23 | * GPL and not to allow others to use your version of this file under the |
24 | * License, indicate your decision by deleting the provisions above and |
25 | * replace them with the notice and other provisions required by the GPL. |
26 | * If you do not delete the provisions above, a recipient may use your |
27 | * version of this file under either the License or the GPL. |
28 | */ |
29 | |
30 | |
31 | /* |
32 | * tclthread.c -- |
33 | * |
34 | * Tcl wrappers around all thread objects |
35 | */ |
36 | |
37 | static const char *RCSID = "@(#) $Header: /cvsroot-fuse/aolserver/aolserver/nsd/tclthread.c,v 1.26 2005/08/23 21:41:31 jgdavidson Exp $, compiled: " __DATE__ " " __TIME__; |
38 | |
39 | #ifdef NS_NOCOMPAT |
40 | #undef NS_NOCOMPAT |
41 | #endif |
42 | #include "nsd.h" |
43 | |
44 | typedef struct ThreadArg { |
45 | int detached; |
46 | char *server; |
47 | char script[1]; |
48 | } ThreadArg; |
49 | |
50 | /* |
51 | * Local functions defined in this file |
52 | */ |
53 | |
54 | static int <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetArgs">GetArgs</a>(Tcl_Interp *interp, int objc, Tcl_Obj **objv, |
55 | CONST char *opts[], int type, int create, int *optPtr, void **addrPtr); |
56 | static void <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_CreateTclThread">CreateTclThread</a>(NsInterp *itPtr, char *script, int detached, |
57 | Ns_Thread *thrPtr); |
58 | |
59 | /* |
60 | * The following define the address Tcl_Obj type. |
61 | */ |
62 | |
63 | static int <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrFromAny">SetAddrFromAny</a>(Tcl_Interp *interp, Tcl_Obj *objPtr); |
64 | static void <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrResult">SetAddrResult</a>(Tcl_Interp *interp, int type, void *addr); |
65 | static void <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_UpdateStringOfAddr">UpdateStringOfAddr</a>(Tcl_Obj *objPtr); |
66 | static void <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrInternalRep">SetAddrInternalRep</a>(Tcl_Obj *objPtr, int type, void *addr); |
67 | static int <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetAddrFromObj">GetAddrFromObj</a>(Tcl_Interp *interp, Tcl_Obj *objPtr, int type, |
68 | void **addrPtr); |
69 | |
70 | static Tcl_ObjType addrType = { |
71 | "ns:addr", |
72 | (Tcl_FreeInternalRepProc *) NULL, |
73 | (Tcl_DupInternalRepProc *) NULL, |
74 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_UpdateStringOfAddr">UpdateStringOfAddr</a>, |
75 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrFromAny">SetAddrFromAny</a> |
76 | }; |
77 | |
78 | |
79 | /* |
80 | *---------------------------------------------------------------------- |
81 | * |
82 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclInitAddrType">NsTclInitAddrType</a> -- |
83 | * |
84 | * Initialize the Tcl address object type. |
85 | * |
86 | * Results: |
87 | * None. |
88 | * |
89 | * Side effects: |
90 | * None. |
91 | * |
92 | *---------------------------------------------------------------------- |
93 | */ |
94 | |
95 | void |
96 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclInitAddrType">NsTclInitAddrType</a>(void) |
97 | { |
98 | Tcl_RegisterObjType(&addrType); |
99 | } |
100 | |
101 | |
102 | /* |
103 | *---------------------------------------------------------------------- |
104 | * |
105 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclMutexObjCmd">NsTclMutexObjCmd</a> -- |
106 | * |
107 | * Implements ns_mutex as obj command. |
108 | * |
109 | * Results: |
110 | * Tcl result. |
111 | * |
112 | * Side effects: |
113 | * See docs. |
114 | * |
115 | *---------------------------------------------------------------------- |
116 | */ |
117 | |
118 | int |
119 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclMutexObjCmd">NsTclMutexObjCmd</a>(ClientData data, Tcl_Interp *interp, int objc, Tcl_Obj **objv) |
120 | { |
121 | Ns_Mutex *lockPtr _nsmayalias; |
122 | static CONST char *opts[] = { |
123 | "create", "destroy", "lock", "unlock", NULL |
124 | }; |
125 | enum { |
126 | MCreateIdx, MDestroyIdx, MLockIdx, MUnlockIdx |
127 | } _nsmayalias opt; |
128 | |
129 | if (!<a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetArgs">GetArgs</a>(interp, objc, objv, opts, 'm', MCreateIdx, |
130 | (int *) &opt, (void **) &lockPtr)) { |
131 | return TCL_ERROR; |
132 | } |
133 | switch (opt) { |
134 | case MCreateIdx: |
135 | Ns_MutexInit(lockPtr); |
136 | if (objc > 2) { |
137 | Ns_MutexSetName(lockPtr, Tcl_GetString(objv[2])); |
138 | } |
139 | break; |
140 | case MLockIdx: |
141 | Ns_MutexLock(lockPtr); |
142 | break; |
143 | case MUnlockIdx: |
144 | Ns_MutexUnlock(lockPtr); |
145 | break; |
146 | case MDestroyIdx: |
147 | Ns_MutexDestroy(lockPtr); |
148 | ns_free(lockPtr); |
149 | break; |
150 | } |
151 | return TCL_OK; |
152 | } |
153 | |
154 | |
155 | /* |
156 | *---------------------------------------------------------------------- |
157 | * |
158 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclCritSecObjCmd">NsTclCritSecObjCmd</a> -- |
159 | * |
160 | * Implements ns_critsec. |
161 | * |
162 | * Results: |
163 | * Tcl result. |
164 | * |
165 | * Side effects: |
166 | * See doc. |
167 | * |
168 | *---------------------------------------------------------------------- |
169 | */ |
170 | |
171 | int |
172 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclCritSecObjCmd">NsTclCritSecObjCmd</a>(ClientData data, Tcl_Interp *interp, int objc, |
173 | Tcl_Obj **objv) |
174 | { |
175 | Ns_Cs *csPtr _nsmayalias; |
176 | static CONST char *opts[] = { |
177 | "create", "destroy", "enter", "leave", NULL |
178 | }; |
179 | enum { |
180 | CCreateIdx, CDestroyIdx, CEnterIdx, CLeaveIdx |
181 | } _nsmayalias opt; |
182 | |
183 | if (!<a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetArgs">GetArgs</a>(interp, objc, objv, opts, 'c', CCreateIdx, |
184 | (int *) &opt, (void **) &csPtr)) { |
185 | return TCL_ERROR; |
186 | } |
187 | switch (opt) { |
188 | case CCreateIdx: |
189 | Ns_CsInit(csPtr); |
190 | break; |
191 | case CEnterIdx: |
192 | Ns_CsEnter(csPtr); |
193 | break; |
194 | case CLeaveIdx: |
195 | Ns_CsLeave(csPtr); |
196 | break; |
197 | case CDestroyIdx: |
198 | Ns_CsDestroy(csPtr); |
199 | ns_free(csPtr); |
200 | break; |
201 | } |
202 | return TCL_OK; |
203 | } |
204 | |
205 | |
206 | /* |
207 | *---------------------------------------------------------------------- |
208 | * |
209 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclSemaObjCmd">NsTclSemaObjCmd</a> -- |
210 | * |
211 | * Implements ns_sema. |
212 | * |
213 | * Results: |
214 | * Tcl result. |
215 | * |
216 | * Side effects: |
217 | * See docs. |
218 | * |
219 | *---------------------------------------------------------------------- |
220 | */ |
221 | |
222 | int |
223 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclSemaObjCmd">NsTclSemaObjCmd</a>(ClientData data, Tcl_Interp *interp, int objc, |
224 | Tcl_Obj **objv) |
225 | { |
226 | Ns_Sema *semaPtr _nsmayalias; |
227 | int cnt; |
228 | static CONST char *opts[] = { |
229 | "create", "destroy", "release", "wait", NULL |
230 | }; |
231 | enum { |
232 | SCreateIdx, SDestroyIdx, SReleaseIdx, SWaitIdx |
233 | } _nsmayalias opt; |
234 | |
235 | if (!<a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetArgs">GetArgs</a>(interp, objc, objv, opts, 's', SCreateIdx, |
236 | (int *) &opt, (void **) &semaPtr)) { |
237 | return TCL_ERROR; |
238 | } |
239 | switch (opt) { |
240 | case SCreateIdx: |
241 | if (objc < 3) { |
242 | cnt = 0; |
243 | } else if (Tcl_GetIntFromObj(interp, objv[2], &cnt) != TCL_OK) { |
244 | return TCL_ERROR; |
245 | } |
246 | Ns_SemaInit(semaPtr, cnt); |
247 | break; |
248 | case SReleaseIdx: |
249 | if (objc < 4) { |
250 | cnt = 1; |
251 | } else if (Tcl_GetIntFromObj(interp, objv[3], &cnt) != TCL_OK) { |
252 | return TCL_ERROR; |
253 | } |
254 | Ns_SemaPost(semaPtr, cnt); |
255 | break; |
256 | case SWaitIdx: |
257 | Ns_SemaWait(semaPtr); |
258 | break; |
259 | case SDestroyIdx: |
260 | Ns_SemaDestroy(semaPtr); |
261 | ns_free(semaPtr); |
262 | break; |
263 | } |
264 | return TCL_OK; |
265 | } |
266 | |
267 | |
268 | /* |
269 | *---------------------------------------------------------------------- |
270 | * |
271 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclCondObjCmd">NsTclCondObjCmd</a> -- |
272 | * |
273 | * Implements ns_cond and ns_event. |
274 | * |
275 | * Results: |
276 | * See docs. |
277 | * |
278 | * Side effects: |
279 | * See docs. |
280 | * |
281 | *---------------------------------------------------------------------- |
282 | */ |
283 | |
284 | int |
285 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclCondObjCmd">NsTclCondObjCmd</a>(ClientData data, Tcl_Interp *interp, int objc, |
286 | Tcl_Obj **objv) |
287 | { |
288 | Tcl_Obj *objPtr; |
289 | Ns_Cond *condPtr _nsmayalias; |
290 | Ns_Mutex *lock _nsmayalias; |
291 | Ns_Time timeout; |
292 | int result; |
293 | static CONST char *opts[] = { |
294 | "abswait", "broadcast", "create", "destroy", "set", |
295 | "signal", "timedwait", "wait", NULL |
296 | }; |
297 | enum { |
298 | EAbsWaitIdx, EBroadcastIdx, ECreateIdx, EDestroyIdx, ESetIdx, |
299 | ESignalIdx, ETimedWaitIdx, EWaitIdx |
300 | } _nsmayalias opt; |
301 | |
302 | if (!<a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetArgs">GetArgs</a>(interp, objc, objv, opts, 'e', ECreateIdx, |
303 | (int *) &opt, (void **) &condPtr)) { |
304 | return TCL_ERROR; |
305 | } |
306 | switch (opt) { |
307 | case ECreateIdx: |
308 | Ns_CondInit(condPtr); |
309 | break; |
310 | case EAbsWaitIdx: |
311 | case ETimedWaitIdx: |
312 | case EWaitIdx: |
313 | if (objc < 4) { |
314 | Tcl_WrongNumArgs(interp, 2, objv, "condId mutexId ?timeout?"); |
315 | return TCL_ERROR; |
316 | } |
317 | if (<a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetAddrFromObj">GetAddrFromObj</a>(interp, objv[3], 'm', (void **) &lock) != TCL_OK) { |
318 | return TCL_ERROR; |
319 | } |
320 | if (objc < 5) { |
321 | timeout.sec = timeout.usec = 0; |
322 | } else if (<a href="/cvs/aolserver/aolserver/nsd/tclobj.c#A_Ns_TclGetTimeFromObj">Ns_TclGetTimeFromObj</a>(interp, objv[4], &timeout) != TCL_OK) { |
323 | return TCL_ERROR; |
324 | } |
325 | if (opt == EAbsWaitIdx) { |
326 | result = Ns_CondTimedWait(condPtr, lock, &timeout); |
327 | } else if (opt == ETimedWaitIdx) { |
328 | Ns_Event *eventPtr = (Ns_Event *) condPtr; |
329 | result = Ns_TimedWaitForEvent(eventPtr, lock, timeout.sec); |
330 | } else { |
331 | if (objc < 5 || (timeout.sec == 0 && timeout.usec == 0)) { |
332 | Ns_CondWait(condPtr, lock); |
333 | result = NS_OK; |
334 | } else { |
335 | Ns_Time abstime; |
336 | Ns_GetTime(&abstime); |
337 | Ns_IncrTime(&abstime, timeout.sec, timeout.usec); |
338 | result = Ns_CondTimedWait(condPtr, lock, &abstime); |
339 | } |
340 | } |
341 | if (result == NS_OK) { |
342 | objPtr = Tcl_NewBooleanObj(1); |
343 | } else if (result == NS_TIMEOUT) { |
344 | objPtr = Tcl_NewBooleanObj(0); |
345 | } else { |
346 | return TCL_ERROR; |
347 | } |
348 | Tcl_SetObjResult(interp, objPtr); |
349 | break; |
350 | |
351 | case EBroadcastIdx: |
352 | Ns_CondBroadcast(condPtr); |
353 | break; |
354 | |
355 | case ESetIdx: |
356 | case ESignalIdx: |
357 | Ns_CondSignal(condPtr); |
358 | break; |
359 | |
360 | case EDestroyIdx: |
361 | Ns_CondDestroy(condPtr); |
362 | ns_free(condPtr); |
363 | break; |
364 | } |
365 | return TCL_OK; |
366 | } |
367 | |
368 | |
369 | /* |
370 | *---------------------------------------------------------------------- |
371 | * |
372 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclRWLockObjCmd">NsTclRWLockObjCmd</a> -- |
373 | * |
374 | * Implements ns_rwlock. |
375 | * |
376 | * Results: |
377 | * Tcl result. |
378 | * |
379 | * Side effects: |
380 | * See docs. |
381 | * |
382 | *---------------------------------------------------------------------- |
383 | */ |
384 | |
385 | int |
386 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclRWLockObjCmd">NsTclRWLockObjCmd</a>(ClientData data, Tcl_Interp *interp, int objc, |
387 | Tcl_Obj **objv) |
388 | { |
389 | Ns_RWLock *rwlockPtr _nsmayalias; |
390 | |
391 | static CONST char *opts[] = { |
392 | "create", "destroy", "readlock", "readunlock", |
393 | "writelock", "writeunlock", "unlock", NULL |
394 | }; |
395 | enum { |
396 | RCreateIdx, RDestroyIdx, RReadLockIdx, RReadUnlockIdx, |
397 | RWriteLockIdx, RWriteUnlockIdx, RUnlockIdx |
398 | } _nsmayalias opt; |
399 | |
400 | if (!<a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetArgs">GetArgs</a>(interp, objc, objv, opts, 'r', RCreateIdx, |
401 | (int *) &opt, (void **) &rwlockPtr)) { |
402 | return TCL_ERROR; |
403 | } |
404 | switch (opt) { |
405 | case RCreateIdx: |
406 | Ns_RWLockInit(rwlockPtr); |
407 | break; |
408 | case RReadLockIdx: |
409 | Ns_RWLockRdLock(rwlockPtr); |
410 | break; |
411 | case RWriteLockIdx: |
412 | Ns_RWLockWrLock(rwlockPtr); |
413 | break; |
414 | case RReadUnlockIdx: |
415 | case RWriteUnlockIdx: |
416 | case RUnlockIdx: |
417 | Ns_RWLockUnlock(rwlockPtr); |
418 | break; |
419 | case RDestroyIdx: |
420 | Ns_RWLockDestroy(rwlockPtr); |
421 | ns_free(rwlockPtr); |
422 | break; |
423 | } |
424 | return TCL_OK; |
425 | |
426 | } |
427 | |
428 | |
429 | /* |
430 | *---------------------------------------------------------------------- |
431 | * |
432 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclThreadObjCmd">NsTclThreadObjCmd</a> -- |
433 | * |
434 | * Implements ns_thread to get data on the current thread and |
435 | * create and wait on new Tcl-script based threads. New threads will |
436 | * be created in the virtual-server context of the current interp, |
437 | * if any. |
438 | * |
439 | * Results: |
440 | * Standard Tcl result. |
441 | * |
442 | * Side effects: |
443 | * May create a new thread or wait for an existing thread to exit. |
444 | * |
445 | *---------------------------------------------------------------------- |
446 | */ |
447 | |
448 | int |
449 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclThreadObjCmd">NsTclThreadObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj **objv) |
450 | { |
451 | NsInterp *itPtr = arg; |
452 | void *result; |
453 | char *script; |
454 | Ns_Thread tid; |
455 | static CONST char *opts[] = { |
456 | "begin", "begindetached", "create", "wait", "join", |
457 | "name", "get", "getid", "id", "yield", NULL |
458 | }; |
459 | enum { |
460 | TBeginIdx, TBeginDetachedIdx, TCreateIdx, TWaitIdx, TJoinIdx, |
461 | TNameIdx, TGetIdx, TGetIdIdx, TIdIdx, TYieldIdx |
462 | } opt; |
463 | |
464 | if (objc < 2) { |
465 | Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); |
466 | return TCL_ERROR; |
467 | } |
468 | if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, |
469 | (int *) &opt) != TCL_OK) { |
470 | return TCL_ERROR; |
471 | } |
472 | |
473 | switch (opt) { |
474 | case TBeginIdx: |
475 | case TBeginDetachedIdx: |
476 | case TCreateIdx: |
477 | if (objc != 3) { |
478 | Tcl_WrongNumArgs(interp, 2, objv, "script"); |
479 | return TCL_ERROR; |
480 | } |
481 | script = Tcl_GetString(objv[2]); |
482 | if (opt == TBeginDetachedIdx) { |
483 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_CreateTclThread">CreateTclThread</a>(itPtr, script, 1, NULL); |
484 | } else { |
485 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_CreateTclThread">CreateTclThread</a>(itPtr, script, 0, &tid); |
486 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrResult">SetAddrResult</a>(interp, 't', tid); |
487 | } |
488 | break; |
489 | |
490 | case TWaitIdx: |
491 | case TJoinIdx: |
492 | if (objc != 3) { |
493 | Tcl_WrongNumArgs(interp, 2, objv, "tid"); |
494 | return TCL_ERROR; |
495 | } |
496 | if (<a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetAddrFromObj">GetAddrFromObj</a>(interp, objv[2], 't', (void **) &tid) != TCL_OK) { |
497 | return TCL_ERROR; |
498 | } |
499 | Ns_ThreadJoin(&tid, &result); |
500 | Tcl_SetResult(interp, (char *) result, (Tcl_FreeProc *) ns_free); |
501 | break; |
502 | |
503 | case TGetIdx: |
504 | Ns_ThreadSelf(&tid); |
505 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrResult">SetAddrResult</a>(interp, 't', tid); |
506 | break; |
507 | |
508 | case TIdIdx: |
509 | case TGetIdIdx: |
510 | Tcl_SetObjResult(interp, Tcl_NewIntObj(Ns_ThreadId())); |
511 | break; |
512 | |
513 | case TNameIdx: |
514 | if (objc > 2) { |
515 | Ns_ThreadSetName(Tcl_GetString(objv[2])); |
516 | } |
517 | Tcl_SetResult(interp, Ns_ThreadGetName(), TCL_VOLATILE); |
518 | break; |
519 | |
520 | case TYieldIdx: |
521 | Ns_ThreadYield(); |
522 | break; |
523 | } |
524 | return TCL_OK; |
525 | } |
526 | |
527 | |
528 | /* |
529 | *---------------------------------------------------------------------- |
530 | * |
531 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrResult">SetAddrResult</a> -- |
532 | * |
533 | * Set the interp result with an opaque thread-object. |
534 | * |
535 | * Results: |
536 | * None. |
537 | * |
538 | * Side effects: |
539 | * Interp result set. |
540 | * |
541 | *---------------------------------------------------------------------- |
542 | */ |
543 | |
544 | static void |
545 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrResult">SetAddrResult</a>(Tcl_Interp *interp, int type, void *addr) |
546 | { |
547 | Tcl_Obj *objPtr; |
548 | |
549 | objPtr = Tcl_GetObjResult(interp); |
550 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrInternalRep">SetAddrInternalRep</a>(objPtr, type, addr); |
551 | } |
552 | |
553 | |
554 | /* |
555 | *---------------------------------------------------------------------- |
556 | * |
557 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_Ns_TclThread">Ns_TclThread</a> -- |
558 | * |
559 | * Run a Tcl script in a new thread. |
560 | * |
561 | * Results: |
562 | * NS_OK. |
563 | * |
564 | * Side effects: |
565 | * None. |
566 | * |
567 | *---------------------------------------------------------------------- |
568 | */ |
569 | |
570 | int |
571 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_Ns_TclThread">Ns_TclThread</a>(Tcl_Interp *interp, char *script, Ns_Thread *thrPtr) |
572 | { |
573 | NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp); |
574 | |
575 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_CreateTclThread">CreateTclThread</a>(itPtr, script, (thrPtr == NULL), thrPtr); |
576 | return NS_OK; |
577 | } |
578 | |
579 | |
580 | /* |
581 | *---------------------------------------------------------------------- |
582 | * |
583 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_Ns_TclDetachedThread">Ns_TclDetachedThread</a> -- |
584 | * |
585 | * Run a Tcl script in a detached thread. |
586 | * |
587 | * Results: |
588 | * NS_OK. |
589 | * |
590 | * Side effects: |
591 | * None. |
592 | * |
593 | *---------------------------------------------------------------------- |
594 | */ |
595 | |
596 | int |
597 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_Ns_TclDetachedThread">Ns_TclDetachedThread</a>(Tcl_Interp *interp, char *script) |
598 | { |
599 | return <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_Ns_TclThread">Ns_TclThread</a>(interp, script, NULL); |
600 | } |
601 | |
602 | |
603 | /* |
604 | *---------------------------------------------------------------------- |
605 | * |
606 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_CreateTclThread">CreateTclThread</a> -- |
607 | * |
608 | * Create a new Tcl thread. |
609 | * |
610 | * Results: |
611 | * None. |
612 | * |
613 | * Side effects: |
614 | * Depends on new thread script. |
615 | * |
616 | *---------------------------------------------------------------------- |
617 | */ |
618 | |
619 | static void |
620 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_CreateTclThread">CreateTclThread</a>(NsInterp *itPtr, char *script, int detached, Ns_Thread *thrPtr) |
621 | { |
622 | ThreadArg *argPtr; |
623 | |
624 | argPtr = ns_malloc(sizeof(ThreadArg) + strlen(script)); |
625 | argPtr->detached = detached; |
626 | strcpy(argPtr->script, script); |
627 | argPtr->server = (itPtr ? itPtr->servPtr->server : NULL); |
628 | Ns_ThreadCreate(<a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclThread">NsTclThread</a>, argPtr, 0, thrPtr); |
629 | } |
630 | |
631 | |
632 | /* |
633 | *---------------------------------------------------------------------- |
634 | * |
635 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclThread">NsTclThread</a> -- |
636 | * |
637 | * Tcl thread <a href="/cvs/aolserver/aolserver/nsd/main.c#A_main">main</a>. |
638 | * |
639 | * Results: |
640 | * None. |
641 | * |
642 | * Side effects: |
643 | * Copy of string result is return as exit arg to be reaped |
644 | * by ns_thread wait. |
645 | * |
646 | *---------------------------------------------------------------------- |
647 | */ |
648 | |
649 | void |
650 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclThread">NsTclThread</a>(void *arg) |
651 | { |
652 | ThreadArg *argPtr = arg; |
653 | Ns_DString ds, *dsPtr; |
654 | int detached = argPtr->detached; |
655 | |
656 | if (detached) { |
657 | dsPtr = NULL; |
658 | } else { |
659 | <a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringInit">Ns_DStringInit</a>(&ds); |
660 | dsPtr = &ds; |
661 | } |
662 | |
663 | /* |
664 | * Need to ensure that the server has completed it's initializtion |
665 | * prior to initiating TclEval. |
666 | */ |
667 | <a href="/cvs/aolserver/aolserver/nsd/nsmain.c#A_Ns_WaitForStartup">Ns_WaitForStartup</a>(); |
668 | |
669 | (void) <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclEval">Ns_TclEval</a>(dsPtr, argPtr->server, argPtr->script); |
670 | ns_free(argPtr); |
671 | if (!detached) { |
672 | Ns_ThreadExit(<a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringExport">Ns_DStringExport</a>(&ds)); |
673 | } |
674 | } |
675 | |
676 | |
677 | /* |
678 | *---------------------------------------------------------------------- |
679 | * |
680 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclThreadArgProc">NsTclThreadArgProc</a> -- |
681 | * |
682 | * Proc info routine to copy Tcl thread script. |
683 | * |
684 | * Results: |
685 | * None. |
686 | * |
687 | * Side effects: |
688 | * Will copy script to given dstring. |
689 | * |
690 | *---------------------------------------------------------------------- |
691 | */ |
692 | |
693 | void |
694 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclThreadArgProc">NsTclThreadArgProc</a>(Tcl_DString *dsPtr, void *arg) |
695 | { |
696 | ThreadArg *argPtr = arg; |
697 | |
698 | Tcl_DStringAppendElement(dsPtr, argPtr->script); |
699 | } |
700 | |
701 | |
702 | static int |
703 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetArgs">GetArgs</a>(Tcl_Interp *interp, int objc, Tcl_Obj **objv, CONST char *opts[], |
704 | int type, int create, int *optPtr, void **addrPtr) |
705 | { |
706 | int opt; |
707 | void *addr; |
708 | |
709 | if (objc < 2) { |
710 | Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); |
711 | return 0; |
712 | } |
713 | if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, |
714 | &opt) != TCL_OK) { |
715 | return 0; |
716 | } |
717 | if (opt == create) { |
718 | addr = ns_malloc(sizeof(void *)); |
719 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrResult">SetAddrResult</a>(interp, type, addr); |
720 | } else { |
721 | if (objc < 3) { |
722 | Tcl_WrongNumArgs(interp, 2, objv, "object"); |
723 | return 0; |
724 | } |
725 | if (<a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetAddrFromObj">GetAddrFromObj</a>(interp, objv[2], type, &addr) != TCL_OK) { |
726 | return 0; |
727 | } |
728 | } |
729 | *addrPtr = addr; |
730 | *optPtr = opt; |
731 | return 1; |
732 | } |
733 | |
734 | |
735 | /* |
736 | *---------------------------------------------------------------------- |
737 | * |
738 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetAddrFromObj">GetAddrFromObj</a> -- |
739 | * |
740 | * Return the internal pointer of an address Tcl_Obj. |
741 | * |
742 | * Results: |
743 | * TCL_OK or TCL_ERROR if not a valid Ns_Time. |
744 | * |
745 | * Side effects: |
746 | * Object is set to id type if necessary. |
747 | * |
748 | *---------------------------------------------------------------------- |
749 | */ |
750 | |
751 | static int |
752 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_GetAddrFromObj">GetAddrFromObj</a>(Tcl_Interp *interp, Tcl_Obj *objPtr, int type, void **addrPtr) |
753 | { |
754 | if (Tcl_ConvertToType(interp, objPtr, &addrType) != TCL_OK) { |
755 | return TCL_ERROR; |
756 | } |
757 | if ((int) objPtr->internalRep.twoPtrValue.ptr1 != type) { |
758 | Tcl_AppendResult(interp, "incorrect type: ", Tcl_GetString(objPtr), NULL); |
759 | return TCL_ERROR; |
760 | } |
761 | *addrPtr = objPtr->internalRep.twoPtrValue.ptr2; |
762 | return TCL_OK; |
763 | } |
764 | |
765 | |
766 | /* |
767 | *---------------------------------------------------------------------- |
768 | * |
769 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_UpdateStringOfAddr">UpdateStringOfAddr</a> -- |
770 | * |
771 | * Update the string representation for an address object. |
772 | * Note: This procedure does not free an existing old string rep |
773 | * so storage will be lost if this has not already been done. |
774 | * |
775 | * Results: |
776 | * None. |
777 | * |
778 | * Side effects: |
779 | * The object's string is set to a valid string that results from |
780 | * the Ns_Time-to-string conversion. |
781 | * |
782 | *---------------------------------------------------------------------- |
783 | */ |
784 | |
785 | static void |
786 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_UpdateStringOfAddr">UpdateStringOfAddr</a>(objPtr) |
787 | register Tcl_Obj *objPtr; /* Int object whose string rep to update. */ |
788 | { |
789 | int type = (int) objPtr->internalRep.twoPtrValue.ptr1; |
790 | void *addr = objPtr->internalRep.twoPtrValue.ptr2; |
791 | char buf[40]; |
792 | size_t len; |
793 | |
794 | len = sprintf(buf, "%cid%p", type, addr); |
795 | objPtr->bytes = ckalloc(len + 1); |
796 | strcpy(objPtr->bytes, buf); |
797 | objPtr->length = len; |
798 | } |
799 | |
800 | |
801 | /* |
802 | *---------------------------------------------------------------------- |
803 | * |
804 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrFromAny">SetAddrFromAny</a> -- |
805 | * |
806 | * Attempt to generate an address internal form for the Tcl object. |
807 | * |
808 | * Results: |
809 | * The return value is a standard object Tcl result. If an error occurs |
810 | * during conversion, an error message is left in the interpreter's |
811 | * result unless "interp" is NULL. |
812 | * |
813 | * Side effects: |
814 | * If no error occurs, an int is stored as "objPtr"s internal |
815 | * representation. |
816 | * |
817 | *---------------------------------------------------------------------- |
818 | */ |
819 | |
820 | static int |
821 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrFromAny">SetAddrFromAny</a>(Tcl_Interp *interp, Tcl_Obj *objPtr) |
822 | { |
823 | void *addr; |
824 | int type; |
825 | register char *id, *p; |
826 | |
827 | p = id = Tcl_GetString(objPtr); |
828 | type = *p++; |
829 | if (type == '\0' || *p++ != 'i' || *p++ != 'd' |
830 | || sscanf(p, "%p", &addr) != 1 || addr == NULL) { |
831 | Tcl_AppendResult(interp, "invalid thread object id \"", |
832 | id, "\"", NULL); |
833 | return TCL_ERROR; |
834 | } |
835 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrInternalRep">SetAddrInternalRep</a>(objPtr, type, addr); |
836 | return TCL_OK; |
837 | } |
838 | |
839 | |
840 | /* |
841 | *---------------------------------------------------------------------- |
842 | * |
843 | * <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrInternalRep">SetAddrInternalRep</a> -- |
844 | * |
845 | * Set the internal address, freeing a previous internal rep if |
846 | * necessary. |
847 | * |
848 | * Results: |
849 | * None. |
850 | * |
851 | * Side effects: |
852 | * Object will be an addr type. |
853 | * |
854 | *---------------------------------------------------------------------- |
855 | */ |
856 | |
857 | static void |
858 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_SetAddrInternalRep">SetAddrInternalRep</a>(Tcl_Obj *objPtr, int type, void *addr) |
859 | { |
860 | Tcl_ObjType *typePtr = objPtr->typePtr; |
861 | |
862 | if (typePtr != NULL && typePtr->freeIntRepProc != NULL) { |
863 | (*typePtr->freeIntRepProc)(objPtr); |
864 | } |
865 | objPtr->typePtr = &addrType; |
866 | objPtr->internalRep.twoPtrValue.ptr1 = (void *) type; |
867 | objPtr->internalRep.twoPtrValue.ptr2 = addr; |
868 | Tcl_InvalidateStringRep(objPtr); |
869 | } |
Copyright © 2010 Geeknet, Inc. All rights reserved. Terms of Use