This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix up ansiperl integration. Back to passing all expected tests
authorMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Tue, 11 Nov 1997 17:46:59 +0000 (17:46 +0000)
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Tue, 11 Nov 1997 17:46:59 +0000 (17:46 +0000)
with usethreads. Untested with non-threaded perl.

p4raw-id: //depot/perl@231

embed.h
ext/DB_File/DB_File.xs
ext/GDBM_File/GDBM_File.xs
perl.c
perl.h
pp.c
t/lib/thread.t [changed mode: 0644->0755]
t/op/nothread.t [changed mode: 0644->0755]
util.c

diff --git a/embed.h b/embed.h
index 46709be..32c2fcc 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define e_tmpname              (curinterp->Ie_tmpname)
 #define endav                  (curinterp->Iendav)
 #define envgv                  (curinterp->Ienvgv)
-#define errhv                  (curinterp->Ierrhv)
-#define errsv                  (curinterp->Ierrsv)
+#define errgv                  (curinterp->Ierrgv)
 #define eval_root              (curinterp->Ieval_root)
 #define eval_start             (curinterp->Ieval_start)
 #define fdpid                  (curinterp->Ifdpid)
 #define Ie_tmpname             e_tmpname
 #define Iendav                 endav
 #define Ienvgv                 envgv
-#define Ierrhv                 errhv
-#define Ierrsv                 errsv
+#define Ierrgv                 errgv
 #define Ieval_root             eval_root
 #define Ieval_start            eval_start
 #define Ifdpid                 fdpid
 #define e_fp                   Perl_e_fp
 #define e_tmpname              Perl_e_tmpname
 #define endav                  Perl_endav
-#define errhv                  Perl_errhv
-#define errsv                  Perl_errsv
+#define errgv                  Perl_errgv
 #define eval_root              Perl_eval_root
 #define eval_start             Perl_eval_start
 #define fdpid                  Perl_fdpid
index bd0c933..959f342 100644 (file)
@@ -140,7 +140,6 @@ btree_compare(key1, key2)
 const DBT * key1 ;
 const DBT * key2 ;
 {
-    dTHR ;
     dSP ;
     void * data1, * data2 ;
     int retval ;
@@ -188,7 +187,6 @@ btree_prefix(key1, key2)
 const DBT * key1 ;
 const DBT * key2 ;
 {
-    dTHR ;
     dSP ;
     void * data1, * data2 ;
     int retval ;
@@ -236,7 +234,6 @@ hash_cb(data, size)
 const void * data ;
 size_t size ;
 {
-    dTHR ;
     dSP ;
     int retval ;
     int count ;
index d3305ec..ac1ca8c 100644 (file)
@@ -20,7 +20,7 @@ typedef GDBM_FILE GDBM_File;
 
 typedef datum gdatum;
 
-typedef void (*FATALFUNC)(...);
+typedef void (*FATALFUNC)();
 
 static int
 not_here(char *s)
diff --git a/perl.c b/perl.c
index 3fe2c50..7264648 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -472,8 +472,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
     envgv = Nullgv;
     siggv = Nullgv;
     incgv = Nullgv;
-    errhv = Nullhv;
-    errsv = Nullsv;
+    errgv = Nullgv;
     argvgv = Nullgv;
     argvoutgv = Nullgv;
     stdingv = Nullgv;
@@ -1791,8 +1790,8 @@ init_main_stash(void)
     incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(incgv);
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
-    errsv = newSVpv("", 0);
-    errhv = newHV();
+    errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+    GvMULTI_on(errgv);
     (void)form("%240s","");    /* Preallocate temp - for immediate signals. */
     sv_grow(ERRSV, 240);       /* Preallocate - for immediate signals. */
     sv_setpvn(ERRSV, "", 0);
@@ -2885,18 +2884,18 @@ call_list(I32 oldscope, AV *list)
                SV* atsv = ERRSV;
                PUSHMARK(stack_sp);
                perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
-               (void)SvPV(errsv, len);
+               (void)SvPV(atsv, len);
                if (len) {
                    JMPENV_POP;
                    curcop = &compiling;
                    curcop->cop_line = oldline;
                    if (list == beginav)
-                       sv_catpv(errsv, "BEGIN failed--compilation aborted");
+                       sv_catpv(atsv, "BEGIN failed--compilation aborted");
                    else
-                       sv_catpv(errsv, "END failed--cleanup aborted");
+                       sv_catpv(atsv, "END failed--cleanup aborted");
                    while (scopestack_ix > oldscope)
                        LEAVE;
-                   croak("%s", SvPVX(errsv));
+                   croak("%s", SvPVX(atsv));
                }
            }
            break;
diff --git a/perl.h b/perl.h
index 0a9a512..d562a31 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1878,8 +1878,7 @@ IEXT I32  Imaxscream IINIT(-1);
 IEXT SV *      Ilastscream;
 
 /* shortcuts to misc objects */
-IEXT HV *      Ierrhv;
-IEXT SV *      Ierrsv;
+IEXT GV *      Ierrgv;
 
 /* shortcuts to debugging objects */
 IEXT GV *      IDBgv;
diff --git a/pp.c b/pp.c
index e518d73..819aea7 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4297,7 +4297,7 @@ PP(pp_lock)
 
 PP(pp_threadsv)
 {
-    dSP;
+    djSP;
 #ifdef USE_THREADS
     SV **svp = av_fetch(thr->magicals, op->op_targ, FALSE);
     if (!svp)
old mode 100644 (file)
new mode 100755 (executable)
old mode 100644 (file)
new mode 100755 (executable)
diff --git a/util.c b/util.c
index 665fa88..721f945 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2407,8 +2407,7 @@ condpair_magic(SV *sv)
  * thread calling new_struct_thread) clearly satisfies this constraint.
  */
 struct thread *
-new_struct_thread(t)
-struct thread *t;
+new_struct_thread(struct thread *t)
 {
     struct thread *thr;
     SV *sv;
@@ -2488,122 +2487,6 @@ struct thread *t;
 
 #ifdef HAVE_THREAD_INTERN
     init_thread_intern(thr);
-#else
-    thr->self = pthread_self();
-#endif /* HAVE_THREAD_INTERN */
-    return thr;
-}
-
-/*
- * Make a new perl thread structure using t as a prototype. Some of the
- * fields for the new thread are copied from the prototype thread, t,
- * so t should not be running in perl at the time this function is
- * called. The use by ext/Thread/Thread.xs in core perl (where t is the
- * thread calling new_struct_thread) clearly satisfies this constraint.
- */
-struct thread *
-new_struct_thread(struct thread *t)
-{
-    struct thread *thr;
-    SV *sv;
-    SV **svp;
-    I32 i;
-
-    sv = newSVpv("", 0);
-    SvGROW(sv, sizeof(struct thread) + 1);
-    SvCUR_set(sv, sizeof(struct thread));
-    thr = (Thread) SvPVX(sv);
-    /* debug */
-    memset(thr, 0xab, sizeof(struct thread));
-    markstack = 0;
-    scopestack = 0;
-    savestack = 0;
-    retstack = 0;
-    dirty = 0;
-    localizing = 0;
-    /* end debug */
-
-    thr->oursv = sv;
-    init_stacks(ARGS);
-
-    curcop = &compiling;
-    thr->cvcache = newHV();
-    thr->magicals = newAV();
-    thr->specific = newAV();
-    thr->flags = THRf_R_JOINABLE;
-    MUTEX_INIT(&thr->mutex);
-
-    curcop = t->Tcurcop;       /* XXX As good a guess as any? */
-    defstash = t->Tdefstash;   /* XXX maybe these should */
-    curstash = t->Tcurstash;   /* always be set to main? */
-
-
-    /* top_env needs to be non-zero. It points to an area
-       in which longjmp() stuff is stored, as C callstack
-       info there at least is thread specific this has to
-       be per-thread. Otherwise a 'die' in a thread gives
-       that thread the C stack of last thread to do an eval {}!
-       See comments in scope.h    
-       Initialize top entry (as in perl.c for main thread)
-     */
-    start_env.je_prev = NULL;
-    start_env.je_ret = -1;
-    start_env.je_mustcatch = TRUE;
-    top_env  = &start_env;
-
-    runlevel = 0;              /* Let entering sub do increment */
-
-    in_eval = FALSE;
-    restartop = 0;
-
-    tainted = t->Ttainted;
-    curpm = t->Tcurpm;         /* XXX No PMOP ref count */
-    nrs = newSVsv(t->Tnrs);
-    rs = newSVsv(t->Trs);
-    last_in_gv = (GV*)SvREFCNT_inc(t->Tlast_in_gv);
-    ofslen = t->Tofslen;
-    ofs = savepvn(t->Tofs, ofslen);
-    defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
-    chopset = t->Tchopset;
-    formtarget = newSVsv(t->Tformtarget);
-    bodytarget = newSVsv(t->Tbodytarget);
-    toptarget = newSVsv(t->Ttoptarget);
-    
-    /* Initialise all per-thread magicals that the template thread used */
-    svp = AvARRAY(t->magicals);
-    for (i = 0; i <= AvFILL(t->magicals); i++, svp++) {
-       if (*svp && *svp != &sv_undef) {
-           SV *sv = newSVsv(*svp);
-           av_store(thr->magicals, i, sv);
-           sv_magic(sv, 0, 0, &per_thread_magicals[i], 1);
-           DEBUG_L(PerlIO_printf(PerlIO_stderr(),
-                                 "new_struct_thread: copied magical %d %p->%p\n",i,
-                                  t, thr));
-       }
-    } 
-
-    MUTEX_LOCK(&threads_mutex);
-    nthreads++;
-    thr->tid = ++threadnum;
-    thr->next = t->next;
-    thr->prev = t;
-    t->next = thr;
-    thr->next->prev = thr;
-    MUTEX_UNLOCK(&threads_mutex);
-
-/*
- * This is highly suspect - new_struct_thread is executed
- * by creating thread so pthread_self() or equivalent
- * is parent thread not the child.
- * In particular this should _NOT_ change dTHR value of calling thread.
- * 
- * But a good place to have a 'hook' for filling in port-private
- * fields of thr. 
- */
-#ifdef INIT_THREAD_INTERN
-    INIT_THREAD_INTERN(thr);
-#else
-    thr->self = pthread_self();
 #endif /* HAVE_THREAD_INTERN */
     return thr;
 }