From: Nick Ing-Simmons Date: Fri, 21 Nov 1997 00:54:43 +0000 (+0000) Subject: Basic integrate of lastest perl into ansiperl X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a868473fb9213692497e27ae968094b32a41c501;p=p5sagit%2Fp5-mst-13.2.git Basic integrate of lastest perl into ansiperl p4raw-id: //depot/ansiperl@272 --- a868473fb9213692497e27ae968094b32a41c501 diff --cc perl.c index c2f7ffc,6f3e15c..db5821c --- a/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 index a2f5630,9facb91..4cbc677 --- a/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 index 1ba4c8f,8691cfa..dadc145 --- a/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); @@@ -2311,7 -2391,7 +2391,7 @@@ 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 index aeb2055,408cc77..9a7f075 --- a/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 index 77a2f16,00825b2..f643732 --- a/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); } @@@ -1179,9 -1179,9 +1193,15 @@@ 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) @@@ -1193,7 -1193,7 +1213,6 @@@ } 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/makedef.pl index c82ded0,abc89d8..55b3e29 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@@ -253,6 -232,6 +253,7 @@@ while () 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 index f31e5a8,4551679..28454e8 --- a/win32/win32.c +++ b/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 index 54e9855,18bf8a2..9086f31 --- a/win32/win32.h +++ b/win32/win32.h @@@ -145,14 -145,4 +145,22 @@@ typedef char * caddr_t; /* In malloc. #include #include +#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 */ diff --cc win32/win32thread.h index 66f2168,0c6bb55..38e66e9 --- a/win32/win32thread.h +++ b/win32/win32thread.h @@@ -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));