Add to MANIFEST: README.threads, lib/ISA.pm, lib/Class/Fields.pm

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index 5759e5a..8fa30a0 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1131,6 +1131,7 @@ mess(pat, args)
     sv = mess_sv;
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
+       dTHR;
        if (dirty)
            sv_catpv(sv, dgd);
        else {
@@ -1171,6 +1172,8 @@ die(pat, va_alist)
     GV *gv;
     CV *cv;
 
+    DEBUG_L(fprintf(stderr, "die: curstack = %p, mainstack= %p\n",
+                   curstack, mainstack));/*debug*/
     /* We have to switch back to mainstack or die_where may try to pop
      * the eval block from the wrong stack if die is being called from a
      * signal handler.  - dkindred@cs.cmu.edu */
@@ -1187,6 +1190,8 @@ die(pat, va_alist)
     message = mess(pat, &args);
     va_end(args);
 
+    DEBUG_L(fprintf(stderr, "die: message = %s\ndiehook = %p\n",
+                  message, diehook));/*debug*/
     if (diehook) {
        /* sv_2cv might call croak() */
        SV *olddiehook = diehook;
@@ -1214,6 +1219,9 @@ die(pat, va_alist)
     }
 
     restartop = die_where(message);
+    DEBUG_L(fprintf(stderr,
+                   "die: restartop = %p, was_in_eval = %d, oldrunlevel = %d\n",
+                   restartop, was_in_eval, oldrunlevel));/*debug*/
     if ((!restartop && was_in_eval) || oldrunlevel > 1)
        JMPENV_JUMP(3);
     return restartop;
@@ -2292,6 +2300,84 @@ I32 *retlen;
 }
 
 #ifdef USE_THREADS
+#ifdef FAKE_THREADS
+/* Very simplistic scheduler for now */
+void
+schedule(void)
+{
+    thr = thr->next_run;
+}
+
+void
+perl_cond_init(cp)
+perl_cond *cp;
+{
+    *cp = 0;
+}
+
+void
+perl_cond_signal(cp)
+perl_cond *cp;
+{
+    perl_thread t;
+    perl_cond cond = *cp;
+    
+    if (!cond)
+       return;
+    t = cond->thread;
+    /* Insert t in the runnable queue just ahead of us */
+    t->next_run = thr->next_run;
+    thr->next_run->prev_run = t;
+    t->prev_run = thr;
+    thr->next_run = t;
+    thr->wait_queue = 0;
+    /* Remove from the wait queue */
+    *cp = cond->next;
+    Safefree(cond);
+}
+
+void
+perl_cond_broadcast(cp)
+perl_cond *cp;
+{
+    perl_thread t;
+    perl_cond cond, cond_next;
+    
+    for (cond = *cp; cond; cond = cond_next) {
+       t = cond->thread;
+       /* Insert t in the runnable queue just ahead of us */
+       t->next_run = thr->next_run;
+       thr->next_run->prev_run = t;
+       t->prev_run = thr;
+       thr->next_run = t;
+       thr->wait_queue = 0;
+       /* Remove from the wait queue */
+       cond_next = cond->next;
+       Safefree(cond);
+    }
+    *cp = 0;
+}
+
+void
+perl_cond_wait(cp)
+perl_cond *cp;
+{
+    perl_cond cond;
+
+    if (thr->next_run == thr)
+       croak("panic: perl_cond_wait called by last runnable thread");
+    
+    New(666, cond, 1, struct perl_wait_queue);
+    cond->thread = thr;
+    cond->next = *cp;
+    *cp = cond;
+    thr->wait_queue = cond;
+    /* Remove ourselves from runnable queue */
+    thr->next_run->prev_run = thr->prev_run;
+    thr->prev_run->next_run = thr->next_run;
+}
+#endif /* FAKE_THREADS */
+
 #ifdef OLD_PTHREADS_API
 struct thread *
 getTHR _((void))