Basic integrate of lastest perl into ansiperl
Nick Ing-Simmons [Fri, 21 Nov 1997 00:54:43 +0000 (00:54 +0000)]
p4raw-id: //depot/ansiperl@272

14 files changed:
1  2 
global.sym
perl.c
perl.h
pp_ctl.c
sv.c
toke.c
win32/config.bc
win32/config.vc
win32/config_H.bc
win32/config_H.vc
win32/makedef.pl
win32/win32.c
win32/win32.h
win32/win32thread.h

diff --cc global.sym
Simple merge
diff --cc perl.c
--- 1/perl.c
--- 2/perl.c
+++ b/perl.c
@@@ -1716,6 -1686,6 +1686,9 @@@ GNU General Public License, which may b
        break;
      case '-':
      case 0:
++#ifdef WIN32
++    case '\r':
++#endif
      case '\n':
      case '\t':
        break;
@@@ -2017,7 -1987,7 +1990,7 @@@ SV *sv
      if (strEQ(origfilename,"-"))
        scriptname = "";
      if (fdscript >= 0) {
--      rsfp = PerlIO_fdopen(fdscript,"r");
++      rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
  #if defined(HAS_FCNTL) && defined(F_SETFD)
        if (rsfp)
            fcntl(PerlIO_fileno(rsfp),F_SETFD,1);  /* ensure close-on-exec */
@@@ -2101,7 -2071,7 +2074,7 @@@ sed %s -e \"/^[^#]/b\" 
        rsfp = PerlIO_stdin();
      }
      else {
--      rsfp = PerlIO_open(scriptname,"r");
++      rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
  #if defined(HAS_FCNTL) && defined(F_SETFD)
        if (rsfp)
            fcntl(PerlIO_fileno(rsfp),F_SETFD,1);  /* ensure close-on-exec */
diff --cc perl.h
--- 1/perl.h
--- 2/perl.h
+++ b/perl.h
@@@ -2319,6 -2293,6 +2293,10 @@@ EXT bool       numeric_local INIT(TRUE);    /
  #define printf PerlIO_stdoutf
  #endif
  
++#ifndef PERL_SCRIPT_MODE
++#define PERL_SCRIPT_MODE "r"
++#endif
++
  /*
   * nice_chunk and nice_chunk size need to be set
   * and queried under the protection of sv_mutex
diff --cc pp_ctl.c
+++ b/pp_ctl.c
@@@ -2288,7 -2368,7 +2368,7 @@@ PP(pp_require
      )
      {
        tryname = name;
--      tryrsfp = PerlIO_open(name,"r");
++      tryrsfp = PerlIO_open(name,PERL_SCRIPT_MODE);
      }
      else {
        AV *ar = GvAVn(incgv);
                sv_setpvf(namesv, "%s/%s", dir, name);
  #endif
                tryname = SvPVX(namesv);
--              tryrsfp = PerlIO_open(tryname, "r");
++              tryrsfp = PerlIO_open(tryname, PERL_SCRIPT_MODE);
                if (tryrsfp) {
                    if (tryname[0] == '.' && tryname[1] == '/')
                        tryname += 2;
diff --cc sv.c
--- 1/sv.c
--- 2/sv.c
+++ b/sv.c
@@@ -3216,6 -3219,6 +3219,10 @@@ screamer2
        }
      }
  
++#ifdef WIN32
++    win32_strip_return(sv);
++#endif
++
      return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
  }
  
diff --cc toke.c
--- 1/toke.c
--- 2/toke.c
+++ b/toke.c
@@@ -187,7 -187,7 +187,7 @@@ missingterm(char *s
      char q;
      if (s) {
        char *nl = strrchr(s,'\n');
--      if (nl)
++      if (nl) 
            *nl = '\0';
      }
      else if (multi_close < 32 || multi_close == 127) {
@@@ -219,6 -219,6 +219,19 @@@ depcom(void
      deprecate("comma-less variable list");
  }
  
++#ifdef WIN32
++
++static I32
++win32_textfilter(int idx, SV *sv, int maxlen)
++{
++ I32 count = FILTER_READ(idx+1, sv, maxlen);
++ if (count > 0 && !maxlen)
++  win32_strip_return(sv);
++ return count;
++}
++#endif
++
++
  void
  lex_start(SV *line)
  {
@@@ -1159,6 -1159,6 +1172,7 @@@ filter_read(int idx, SV *buf_sv, int ma
                else
                    return 0 ;          /* end of file */
            }
++
        }
        return SvCUR(buf_sv);
      }
      return (*funcp)(idx, buf_sv, maxlen);
  }
  
++
  static char *
  filter_gets(register SV *sv, register FILE *fp, STRLEN append)
  {
++#ifdef WIN32FILTER
++    if (!rsfp_filters) {
++      filter_add(win32_textfilter,NULL);
++    }
++#endif
      if (rsfp_filters) {
  
        if (!append)
      }
      else 
          return (sv_gets(sv, fp, append));
--    
  }
  
  
@@@ -1724,9 -1724,9 +1743,11 @@@ yylex(void
        }
        goto retry;
      case '\r':
++#ifndef WIN32CHEAT
        warn("Illegal character \\%03o (carriage return)", '\r');
        croak(
        "(Maybe you didn't strip carriage returns after a network transfer?)\n");
++#endif
      case ' ': case '\t': case '\f': case 013:
        s++;
        goto retry;
diff --cc win32/config.bc
Simple merge
diff --cc win32/config.vc
Simple merge
Simple merge
Simple merge
@@@ -253,6 -232,6 +253,7 @@@ while (<DATA>) 
        my $symbol;
        next if (!/^[A-Za-z]/);
        next if (/^#/);
++        s/\r//g;
        $symbol = $_;
        next if ($skip_sym =~ m/^$symbol/m);
          $symbol = "Perl_".$symbol if ($define{'USE_THISPTR'} 
diff --cc win32/win32.c
@@@ -1725,6 -1645,6 +1725,32 @@@ Perl_win32_init(int *argcp, char ***arg
  #endif
  }
  
++#ifdef USE_BINMODE_SCRIPTS
++
++void
++win32_strip_return(SV *sv)
++{
++ char *s = SvPVX(sv);
++ char *e = s+SvCUR(sv);
++ char *d = s;
++ while (s < e)
++  {
++   if (*s == '\r' && s[1] == '\n')
++    {
++     *d++ = '\n';
++     s += 2;
++    }
++   else 
++    {
++     *d++ = *s++;
++    }   
++  }
++ SvCUR_set(sv,d-SvPVX(sv)); 
++}
++
++#endif
++
++
  
  
  
diff --cc win32/win32.h
@@@ -145,14 -145,4 +145,22 @@@ typedef  char *          caddr_t;        /* In malloc.
  #include <sys/socket.h>
  #include <netdb.h>
  
 +#ifdef MYMALLOC
 +#define EMBEDMYMALLOC /**/
 +/* #define USE_PERL_SBRK      /**/
 +/* #define PERL_SBRK_VIA_MALLOC       /**/
 +#endif
 +
 +#ifdef PERLDLL
 +#define PERL_CORE
 +#endif
 +
++#ifdef USE_BINMODE_SCRIPTS
++#define PERL_SCRIPT_MODE "rb"
++EXT void win32_strip_return(struct sv *sv);
++#else
++#define PERL_SCRIPT_MODE "r"
++#define win32_strip_return(sv) NOOP
++#endif
++
  #endif /* _INC_WIN32_PERL5 */
@@@ -105,18 -105,7 +105,18 @@@ typedef HANDLE perl_mutex
  
  typedef THREAD_RET_TYPE thread_func_t(void *);
  
 +
  START_EXTERN_C
 +
- #if defined(PERLDLL) && defined(_DLL)
++#if defined(PERLDLL) && (!defined(__BORLANDC__) || defined(_DLL))
 +extern __declspec(thread) struct thread *Perl_current_thread;
 +#define SET_THR(t)            (Perl_current_thread = t)
 +#define THR                   Perl_current_thread
 +#else
 +#define THR                   Perl_getTHR()
 +#define SET_THR(t)            Perl_setTHR(t)
 +#endif
 +
  void Perl_alloc_thread_key _((void));
  int Perl_thread_create _((struct thread *thr, thread_func_t *fn));
  void Perl_set_thread_self _((struct thread *thr));