This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
new thread should set current interp in TLS
[perl5.git] / ext / Thread / Thread.xs
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5
6 /* Magic signature for Thread's mg_private is "Th" */ 
7 #define Thread_MAGIC_SIGNATURE 0x5468
8
9 #ifdef __cplusplus
10 #ifdef I_UNISTD
11 #include <unistd.h>
12 #endif
13 #endif
14 #include <fcntl.h>
15                         
16 static int sig_pipe[2];
17             
18 #ifndef THREAD_RET_TYPE
19 #define THREAD_RET_TYPE void *
20 #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x)
21 #endif
22
23 static void
24 remove_thread(pTHX_ struct perl_thread *t)
25 {
26 #ifdef USE_THREADS
27     DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(),
28                                    "%p: remove_thread %p\n", thr, t)));
29     MUTEX_LOCK(&PL_threads_mutex);
30     MUTEX_DESTROY(&t->mutex);
31     PL_nthreads--;
32     t->prev->next = t->next;
33     t->next->prev = t->prev;
34     COND_BROADCAST(&PL_nthreads_cond);
35     MUTEX_UNLOCK(&PL_threads_mutex);
36 #endif
37 }
38
39 static THREAD_RET_TYPE
40 threadstart(void *arg)
41 {
42 #ifdef USE_THREADS
43 #ifdef FAKE_THREADS
44     Thread savethread = thr;
45     LOGOP myop;
46     dSP;
47     I32 oldscope = PL_scopestack_ix;
48     I32 retval;
49     AV *av;
50     int i;
51
52     DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
53                           thr, SvPEEK(TOPs)));
54     thr = (Thread) arg;
55     savemark = TOPMARK;
56     thr->prev = thr->prev_run = savethread;
57     thr->next = savethread->next;
58     thr->next_run = savethread->next_run;
59     savethread->next = savethread->next_run = thr;
60     thr->wait_queue = 0;
61     thr->private = 0;
62
63     /* Now duplicate most of perl_call_sv but with a few twists */
64     PL_op = (OP*)&myop;
65     Zero(PL_op, 1, LOGOP);
66     myop.op_flags = OPf_STACKED;
67     myop.op_next = Nullop;
68     myop.op_flags |= OPf_KNOW;
69     myop.op_flags |= OPf_WANT_LIST;
70     PL_op = pp_entersub(ARGS);
71     DEBUG_S(if (!PL_op)
72             PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n"));
73     /*
74      * When this thread is next scheduled, we start in the right
75      * place. When the thread runs off the end of the sub, perl.c
76      * handles things, using savemark to figure out how much of the
77      * stack is the return value for any join.
78      */
79     thr = savethread;           /* back to the old thread */
80     return 0;
81 #else
82     Thread thr = (Thread) arg;
83     LOGOP myop;
84     djSP;
85     I32 oldmark = TOPMARK;
86     I32 oldscope = PL_scopestack_ix;
87     I32 retval;
88     SV *sv;
89     AV *av;
90     int i, ret;
91     dJMPENV;
92
93 #if defined(MULTIPLICITY)
94     PERL_SET_INTERP(thr->interp);
95 #endif
96
97     DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n",
98                           thr));
99
100     /* Don't call *anything* requiring dTHR until after SET_THR() */
101     /*
102      * Wait until our creator releases us. If we didn't do this, then
103      * it would be potentially possible for out thread to carry on and
104      * do stuff before our creator fills in our "self" field. For example,
105      * if we went and created another thread which tried to JOIN with us,
106      * then we'd be in a mess.
107      */
108     MUTEX_LOCK(&thr->mutex);
109     MUTEX_UNLOCK(&thr->mutex);
110
111     /*
112      * It's safe to wait until now to set the thread-specific pointer
113      * from our pthread_t structure to our struct perl_thread, since
114      * we're the only thread who can get at it anyway.
115      */
116     SET_THR(thr);
117
118     /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */
119     DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
120                           thr, SvPEEK(TOPs)));
121
122     av = newAV();
123     sv = POPs;
124     PUTBACK;
125     ENTER;
126     SAVETMPS;
127     perl_call_sv(sv, G_ARRAY|G_EVAL);
128     SPAGAIN;
129     retval = SP - (PL_stack_base + oldmark);
130     SP = PL_stack_base + oldmark + 1;
131     if (SvCUR(thr->errsv)) {
132         MUTEX_LOCK(&thr->mutex);
133         thr->flags |= THRf_DID_DIE;
134         MUTEX_UNLOCK(&thr->mutex);
135         av_store(av, 0, &PL_sv_no);
136         av_store(av, 1, newSVsv(thr->errsv));
137         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
138                               thr, SvPV(thr->errsv, PL_na)));
139     } else {
140         DEBUG_S(STMT_START {
141             for (i = 1; i <= retval; i++) {
142                 PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n",
143                                 thr, i, SvPEEK(SP[i - 1]));
144             }
145         } STMT_END);
146         av_store(av, 0, &PL_sv_yes);
147         for (i = 1; i <= retval; i++, SP++)
148             sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP));
149     }
150     FREETMPS;
151     LEAVE;
152
153   finishoff:
154 #if 0    
155     /* removed for debug */
156     SvREFCNT_dec(PL_curstack);
157 #endif
158     SvREFCNT_dec(thr->cvcache);
159     SvREFCNT_dec(thr->threadsv);
160     SvREFCNT_dec(thr->specific);
161     SvREFCNT_dec(thr->errsv);
162     SvREFCNT_dec(thr->errhv);
163
164     /*Safefree(cxstack);*/
165     while (PL_curstackinfo->si_next)
166         PL_curstackinfo = PL_curstackinfo->si_next;
167     while (PL_curstackinfo) {
168         PERL_SI *p = PL_curstackinfo->si_prev;
169         SvREFCNT_dec(PL_curstackinfo->si_stack);
170         Safefree(PL_curstackinfo->si_cxstack);
171         Safefree(PL_curstackinfo);
172         PL_curstackinfo = p;
173     }    
174     Safefree(PL_markstack);
175     Safefree(PL_scopestack);
176     Safefree(PL_savestack);
177     Safefree(PL_retstack);
178     Safefree(PL_tmps_stack);
179     Safefree(PL_ofs);
180
181     SvREFCNT_dec(PL_rs);
182     SvREFCNT_dec(PL_nrs);
183     SvREFCNT_dec(PL_statname);
184     Safefree(PL_screamfirst);
185     Safefree(PL_screamnext);
186     Safefree(PL_reg_start_tmp);
187     SvREFCNT_dec(PL_lastscream);
188     SvREFCNT_dec(PL_defoutgv);
189     Safefree(PL_reg_poscache);
190
191     MUTEX_LOCK(&thr->mutex);
192     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
193                           "%p: threadstart finishing: state is %u\n",
194                           thr, ThrSTATE(thr)));
195     switch (ThrSTATE(thr)) {
196     case THRf_R_JOINABLE:
197         ThrSETSTATE(thr, THRf_ZOMBIE);
198         MUTEX_UNLOCK(&thr->mutex);
199         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
200                               "%p: R_JOINABLE thread finished\n", thr));
201         break;
202     case THRf_R_JOINED:
203         ThrSETSTATE(thr, THRf_DEAD);
204         MUTEX_UNLOCK(&thr->mutex);
205         remove_thread(aTHX_ thr);
206         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
207                               "%p: R_JOINED thread finished\n", thr));
208         break;
209     case THRf_R_DETACHED:
210         ThrSETSTATE(thr, THRf_DEAD);
211         MUTEX_UNLOCK(&thr->mutex);
212         SvREFCNT_dec(av);
213         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
214                               "%p: DETACHED thread finished\n", thr));
215         remove_thread(aTHX_ thr);       /* This might trigger main thread to finish */
216         break;
217     default:
218         MUTEX_UNLOCK(&thr->mutex);
219         croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr));
220         /* NOTREACHED */
221     }
222     return THREAD_RET_CAST(av); /* Available for anyone to join with */
223                                         /* us unless we're detached, in which */
224                                         /* case noone sees the value anyway. */
225 #endif    
226 #else
227     return THREAD_RET_CAST(NULL);
228 #endif
229 }
230
231 static SV *
232 newthread (pTHX_ SV *startsv, AV *initargs, char *classname)
233 {
234 #ifdef USE_THREADS
235     dSP;
236     Thread savethread;
237     int i;
238     SV *sv;
239     int err;
240 #ifndef THREAD_CREATE
241     static pthread_attr_t attr;
242     static int attr_inited = 0;
243     sigset_t fullmask, oldmask;
244     static int attr_joinable = PTHREAD_CREATE_JOINABLE;
245 #endif
246
247     savethread = thr;
248     thr = new_struct_thread(thr);
249     /* temporarily pretend to be the child thread in case the
250      * XPUSHs() below want to grow the child's stack.  This is
251      * safe, since the other thread is not yet created, and we
252      * are the only ones who know about it */
253     SET_THR(thr);
254     SPAGAIN;
255     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
256                           "%p: newthread (%p), tid is %u, preparing stack\n",
257                           savethread, thr, thr->tid));
258     /* The following pushes the arg list and startsv onto the *new* stack */
259     PUSHMARK(SP);
260     /* Could easily speed up the following greatly */
261     for (i = 0; i <= AvFILL(initargs); i++)
262         XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
263     XPUSHs(SvREFCNT_inc(startsv));
264     PUTBACK;
265
266     /* On your marks... */
267     SET_THR(savethread);
268     MUTEX_LOCK(&thr->mutex);
269
270 #ifdef THREAD_CREATE
271     err = THREAD_CREATE(thr, threadstart);
272 #else    
273     /* Get set...  */
274     sigfillset(&fullmask);
275     if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
276         croak("panic: sigprocmask");
277     err = 0;
278     if (!attr_inited) {
279         attr_inited = 1;
280         err = pthread_attr_init(&attr);
281 #  ifdef PTHREAD_ATTR_SETDETACHSTATE
282         if (err == 0)
283             err = PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
284
285 #  else
286         croak("panic: can't pthread_attr_setdetachstate");
287 #  endif
288     }
289     if (err == 0)
290         err = PTHREAD_CREATE(&thr->self, attr, threadstart, (void*) thr);
291 #endif
292
293     if (err) {
294         MUTEX_UNLOCK(&thr->mutex);
295         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
296                               "%p: create of %p failed %d\n",
297                               savethread, thr, err));
298         /* Thread creation failed--clean up */
299         SvREFCNT_dec(thr->cvcache);
300         remove_thread(aTHX_ thr);
301         MUTEX_DESTROY(&thr->mutex);
302         for (i = 0; i <= AvFILL(initargs); i++)
303             SvREFCNT_dec(*av_fetch(initargs, i, FALSE));
304         SvREFCNT_dec(startsv);
305         return NULL;
306     }
307
308 #ifdef THREAD_POST_CREATE
309     THREAD_POST_CREATE(thr);
310 #else
311     if (sigprocmask(SIG_SETMASK, &oldmask, 0))
312         croak("panic: sigprocmask");
313 #endif
314
315     sv = newSViv(thr->tid);
316     sv_magic(sv, thr->oursv, '~', 0, 0);
317     SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
318     sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
319
320     /* Go */
321     MUTEX_UNLOCK(&thr->mutex);
322
323     return sv;
324 #else
325     croak("No threads in this perl");
326     return &PL_sv_undef;
327 #endif
328 }
329
330 static Signal_t handle_thread_signal (int sig);
331
332 static Signal_t
333 handle_thread_signal(int sig)
334 {
335     dTHXo;
336     unsigned char c = (unsigned char) sig;
337     /*
338      * We're not really allowed to call fprintf in a signal handler
339      * so don't be surprised if this isn't robust while debugging
340      * with -DL.
341      */
342     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
343             "handle_thread_signal: got signal %d\n", sig););
344     write(sig_pipe[1], &c, 1);
345 }
346
347 MODULE = Thread         PACKAGE = Thread
348 PROTOTYPES: DISABLE
349
350 void
351 new(classname, startsv, ...)
352         char *          classname
353         SV *            startsv
354         AV *            av = av_make(items - 2, &ST(2));
355     PPCODE:
356         XPUSHs(sv_2mortal(newthread(aTHX_ startsv, av, classname)));
357
358 void
359 join(t)
360         Thread  t
361         AV *    av = NO_INIT
362         int     i = NO_INIT
363     PPCODE:
364 #ifdef USE_THREADS
365         if (t == thr)
366             croak("Attempt to join self");
367         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n",
368                               thr, t, ThrSTATE(t)););
369         MUTEX_LOCK(&t->mutex);
370         switch (ThrSTATE(t)) {
371         case THRf_R_JOINABLE:
372         case THRf_R_JOINED:
373             ThrSETSTATE(t, THRf_R_JOINED);
374             MUTEX_UNLOCK(&t->mutex);
375             break;
376         case THRf_ZOMBIE:
377             ThrSETSTATE(t, THRf_DEAD);
378             MUTEX_UNLOCK(&t->mutex);
379             remove_thread(aTHX_ t);
380             break;
381         default:
382             MUTEX_UNLOCK(&t->mutex);
383             croak("can't join with thread");
384             /* NOTREACHED */
385         }
386         JOIN(t, &av);
387
388         if (SvTRUE(*av_fetch(av, 0, FALSE))) {
389             /* Could easily speed up the following if necessary */
390             for (i = 1; i <= AvFILL(av); i++)
391                 XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
392         } else {
393             STRLEN n_a;
394             char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a);
395             DEBUG_S(PerlIO_printf(PerlIO_stderr(),
396                                   "%p: join propagating die message: %s\n",
397                                   thr, mess));
398             croak(mess);
399         }
400 #endif
401
402 void
403 detach(t)
404         Thread  t
405     CODE:
406 #ifdef USE_THREADS
407         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n",
408                               thr, t, ThrSTATE(t)););
409         MUTEX_LOCK(&t->mutex);
410         switch (ThrSTATE(t)) {
411         case THRf_R_JOINABLE:
412             ThrSETSTATE(t, THRf_R_DETACHED);
413             /* fall through */
414         case THRf_R_DETACHED:
415             DETACH(t);
416             MUTEX_UNLOCK(&t->mutex);
417             break;
418         case THRf_ZOMBIE:
419             ThrSETSTATE(t, THRf_DEAD);
420             DETACH(t);
421             MUTEX_UNLOCK(&t->mutex);
422             remove_thread(aTHX_ t);
423             break;
424         default:
425             MUTEX_UNLOCK(&t->mutex);
426             croak("can't detach thread");
427             /* NOTREACHED */
428         }
429 #endif
430
431 void
432 equal(t1, t2)
433         Thread  t1
434         Thread  t2
435     PPCODE:
436         PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no);
437
438 void
439 flags(t)
440         Thread  t
441     PPCODE:
442 #ifdef USE_THREADS
443         PUSHs(sv_2mortal(newSViv(t->flags)));
444 #endif
445
446 void
447 self(classname)
448         char *  classname
449     PREINIT:
450         SV *sv;
451     PPCODE:        
452 #ifdef USE_THREADS
453         sv = newSViv(thr->tid);
454         sv_magic(sv, thr->oursv, '~', 0, 0);
455         SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
456         PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv),
457                                   gv_stashpv(classname, TRUE))));
458 #endif
459
460 U32
461 tid(t)
462         Thread  t
463     CODE:
464 #ifdef USE_THREADS
465         MUTEX_LOCK(&t->mutex);
466         RETVAL = t->tid;
467         MUTEX_UNLOCK(&t->mutex);
468 #else 
469         RETVAL = 0;
470 #endif
471     OUTPUT:
472         RETVAL
473
474 void
475 DESTROY(t)
476         SV *    t
477     PPCODE:
478         PUSHs(&PL_sv_yes);
479
480 void
481 yield()
482     CODE:
483 {
484 #ifdef USE_THREADS
485         YIELD;
486 #endif
487 }
488
489 void
490 cond_wait(sv)
491         SV *    sv
492         MAGIC * mg = NO_INIT
493 CODE:                       
494 #ifdef USE_THREADS
495         if (SvROK(sv))
496             sv = SvRV(sv);
497
498         mg = condpair_magic(sv);
499         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv));
500         MUTEX_LOCK(MgMUTEXP(mg));
501         if (MgOWNER(mg) != thr) {
502             MUTEX_UNLOCK(MgMUTEXP(mg));
503             croak("cond_wait for lock that we don't own\n");
504         }
505         MgOWNER(mg) = 0;
506         COND_SIGNAL(MgOWNERCONDP(mg));
507         COND_WAIT(MgCONDP(mg), MgMUTEXP(mg));
508         while (MgOWNER(mg))
509             COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
510         MgOWNER(mg) = thr;
511         MUTEX_UNLOCK(MgMUTEXP(mg));
512 #endif
513
514 void
515 cond_signal(sv)
516         SV *    sv
517         MAGIC * mg = NO_INIT
518 CODE:
519 #ifdef USE_THREADS
520         if (SvROK(sv))
521             sv = SvRV(sv);
522
523         mg = condpair_magic(sv);
524         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv));
525         MUTEX_LOCK(MgMUTEXP(mg));
526         if (MgOWNER(mg) != thr) {
527             MUTEX_UNLOCK(MgMUTEXP(mg));
528             croak("cond_signal for lock that we don't own\n");
529         }
530         COND_SIGNAL(MgCONDP(mg));
531         MUTEX_UNLOCK(MgMUTEXP(mg));
532 #endif
533
534 void
535 cond_broadcast(sv)
536         SV *    sv
537         MAGIC * mg = NO_INIT
538 CODE: 
539 #ifdef USE_THREADS
540         if (SvROK(sv))
541             sv = SvRV(sv);
542
543         mg = condpair_magic(sv);
544         DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n",
545                               thr, sv));
546         MUTEX_LOCK(MgMUTEXP(mg));
547         if (MgOWNER(mg) != thr) {
548             MUTEX_UNLOCK(MgMUTEXP(mg));
549             croak("cond_broadcast for lock that we don't own\n");
550         }
551         COND_BROADCAST(MgCONDP(mg));
552         MUTEX_UNLOCK(MgMUTEXP(mg));
553 #endif
554
555 void
556 list(classname)
557         char *  classname
558     PREINIT:
559         Thread  t;
560         AV *    av;
561         SV **   svp;
562         int     n = 0;
563     PPCODE:
564 #ifdef USE_THREADS
565         av = newAV();
566         /*
567          * Iterate until we have enough dynamic storage for all threads.
568          * We mustn't do any allocation while holding threads_mutex though.
569          */
570         MUTEX_LOCK(&PL_threads_mutex);
571         do {
572             n = PL_nthreads;
573             MUTEX_UNLOCK(&PL_threads_mutex);
574             if (AvFILL(av) < n - 1) {
575                 int i = AvFILL(av);
576                 for (i = AvFILL(av); i < n - 1; i++) {
577                     SV *sv = newSViv(0);        /* fill in tid later */
578                     sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */
579                     av_push(av, sv_bless(newRV_noinc(sv),
580                                          gv_stashpv(classname, TRUE)));
581         
582                 }
583             }
584             MUTEX_LOCK(&PL_threads_mutex);
585         } while (n < PL_nthreads);
586         n = PL_nthreads;        /* Get the final correct value */
587
588         /*
589          * At this point, there's enough room to fill in av.
590          * Note that we are holding threads_mutex so the list
591          * won't change out from under us but all the remaining
592          * processing is "fast" (no blocking, malloc etc.)
593          */
594         t = thr;
595         svp = AvARRAY(av);
596         do {
597             SV *sv = (SV*)SvRV(*svp);
598             sv_setiv(sv, t->tid);
599             SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv);
600             SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED;
601             SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
602             t = t->next;
603             svp++;
604         } while (t != thr);
605         /*  */
606         MUTEX_UNLOCK(&PL_threads_mutex);
607         /* Truncate any unneeded slots in av */
608         av_fill(av, n - 1);
609         /* Finally, push all the new objects onto the stack and drop av */
610         EXTEND(SP, n);
611         for (svp = AvARRAY(av); n > 0; n--, svp++)
612             PUSHs(*svp);
613         (void)sv_2mortal((SV*)av);
614 #endif
615
616
617 MODULE = Thread         PACKAGE = Thread::Signal
618
619 void
620 kill_sighandler_thread()
621     PPCODE:
622         write(sig_pipe[1], "\0", 1);
623         PUSHs(&PL_sv_yes);
624
625 void
626 init_thread_signals()
627     PPCODE:
628         PL_sighandlerp = handle_thread_signal;
629         if (pipe(sig_pipe) == -1)
630             XSRETURN_UNDEF;
631         PUSHs(&PL_sv_yes);
632
633 void
634 await_signal()
635     PREINIT:
636         unsigned char c;
637         SSize_t ret;
638     CODE:
639         do {
640             ret = read(sig_pipe[0], &c, 1);
641         } while (ret == -1 && errno == EINTR);
642         if (ret == -1)
643             croak("panic: await_signal");
644         ST(0) = sv_newmortal();
645         if (ret)
646             sv_setsv(ST(0), c ? PL_psig_ptr[c] : &PL_sv_no);
647         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
648                               "await_signal returning %s\n", SvPEEK(ST(0))););
649
650 MODULE = Thread         PACKAGE = Thread::Specific
651
652 void
653 data(classname = "Thread::Specific")
654         char *  classname
655     PPCODE:
656 #ifdef USE_THREADS
657         if (AvFILL(thr->specific) == -1) {
658             GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV);
659             av_store(thr->specific, 0, newRV((SV*)GvHV(gv)));
660         }
661         XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE)));
662 #endif