more complete support for implicit thread/interpreter pointer,

enabled via -DPERL_IMPLICIT_CONTEXT (all changes are noops
without that enabled):
  - USE_THREADS now enables PERL_IMPLICIT_CONTEXT, so dTHR
    is a noop; tests pass on Solaris; should be faster now!
  - MULTIPLICITY has been tested with and without
    PERL_IMPLICIT_CONTEXT on Solaris
  - improved function database now merged with embed.pl
  - everything except the varargs functions have foo(a,b,c) macros
    to provide compatibility
  - varargs functions default to compatibility variants that
    get the context pointer using dTHX
  - there should be almost no source compatibility issues as a
    result of all this
  - dl_foo.xs changes other than dl_dlopen.xs untested
  - still needs documentation, fixups for win32 etc
Next step: migrate most non-mutex variables from perlvars.h
to intrpvar.h

p4raw-id: //depot/perl@3524

1 files changed, 15 insertions, 12 deletions

diff --git a/perlio.c b/perlio.c
index a71acba783..3094ea767c 100644
--- a/perlio.c
+++ b/perlio.c
@@ -142,11 +142,11 @@ void
 PerlIO_set_cnt(PerlIO *f, int cnt)
 {
  if (cnt < -1)
-  warn("Setting cnt to %d\n",cnt);
+  Perl_warn(aTHX_ "Setting cnt to %d\n",cnt);
 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
  FILE_cnt(f) = cnt;
 #else
- croak("Cannot set 'cnt' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
 #endif
 }
 
@@ -158,19 +158,19 @@ PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
  STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
  int ec = e - ptr;
  if (ptr > e + 1)
-  warn("Setting ptr %p > end+1 %p\n", ptr, e + 1);
+  Perl_warn(aTHX_ "Setting ptr %p > end+1 %p\n", ptr, e + 1);
  if (cnt != ec)
-  warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
+  Perl_warn(aTHX_ "Setting cnt to %d, ptr implies %d\n",cnt,ec);
 #endif
 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
  FILE_ptr(f) = ptr;
 #else
- croak("Cannot set 'ptr' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot set 'ptr' of FILE * on this system");
 #endif
 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
  FILE_cnt(f) = cnt;
 #else
- croak("Cannot set 'cnt' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
 #endif
 }
 
@@ -181,7 +181,7 @@ PerlIO_get_cnt(PerlIO *f)
 #ifdef FILE_cnt
  return FILE_cnt(f);
 #else
- croak("Cannot get 'cnt' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot get 'cnt' of FILE * on this system");
  return -1;
 #endif
 }
@@ -193,7 +193,7 @@ PerlIO_get_bufsiz(PerlIO *f)
 #ifdef FILE_bufsiz
  return FILE_bufsiz(f);
 #else
- croak("Cannot get 'bufsiz' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot get 'bufsiz' of FILE * on this system");
  return -1;
 #endif
 }
@@ -205,7 +205,7 @@ PerlIO_get_ptr(PerlIO *f)
 #ifdef FILE_ptr
  return FILE_ptr(f);
 #else
- croak("Cannot get 'ptr' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot get 'ptr' of FILE * on this system");
  return NULL;
 #endif
 }
@@ -217,7 +217,7 @@ PerlIO_get_base(PerlIO *f)
 #ifdef FILE_base
  return FILE_base(f);
 #else
- croak("Cannot get 'base' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot get 'base' of FILE * on this system");
  return NULL;
 #endif
 }
@@ -282,7 +282,7 @@ PerlIO_getname(PerlIO *f, char *buf)
 #ifdef VMS
  return fgetname(f,buf);
 #else
- croak("Don't know how to get file name");
+ Perl_croak(aTHX_ "Don't know how to get file name");
  return NULL;
 #endif
 }
@@ -537,7 +537,10 @@ PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
    if (strlen(s) >= (STRLEN)n)
     {
      PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
-     my_exit(1);
+     {
+      dTHX;
+      my_exit(1);
+     }
     }
   }
  return val;