From: Gurusamy Sarathy Date: Sun, 28 May 2000 18:41:12 +0000 (+0000) Subject: MacOS support, part 1 (from Matthias Neeracher X-Git-Tag: accepted/trunk/20130322.191538~34874 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=bf4acbe410c9fcc2bff9bfa63411be8c6c46902a;p=platform%2Fupstream%2Fperl.git MacOS support, part 1 (from Matthias Neeracher ) p4raw-id: //depot/perl@6143 --- diff --git a/MANIFEST b/MANIFEST index 3dec812..380fa4f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -239,6 +239,7 @@ ext/DynaLoader/dl_dld.xs GNU dld style implementation ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation ext/DynaLoader/dl_dyld.xs NeXT/Apple dyld implementation ext/DynaLoader/dl_hpux.xs HP-UX implementation +ext/DynaLoader/dl_mac.xs MacOS implementation ext/DynaLoader/dl_mpeix.xs MPE/iX implementation ext/DynaLoader/dl_next.xs NeXT implementation ext/DynaLoader/dl_none.xs Stub implementation diff --git a/ext/DB_File/Makefile.PL b/ext/DB_File/Makefile.PL index cac6578..0414160 100644 --- a/ext/DB_File/Makefile.PL +++ b/ext/DB_File/Makefile.PL @@ -17,6 +17,7 @@ WriteMakefile( OBJECT => 'version$(OBJ_EXT) DB_File$(OBJ_EXT)', XSPROTOARG => '-noprototypes', DEFINE => $OS2 || "", + INC => ($^O eq "MacOS" ? "-i ::::db:include" : "") ); sub MY::postamble { diff --git a/ext/DynaLoader/dl_mac.xs b/ext/DynaLoader/dl_mac.xs new file mode 100644 index 0000000..136e6d5 --- /dev/null +++ b/ext/DynaLoader/dl_mac.xs @@ -0,0 +1,137 @@ +/* dl_mac.xs + * + * Platform: Macintosh CFM + * Author: Matthias Neeracher + * Adapted from dl_dlopen.xs reference implementation by + * Paul Marquess (pmarquess@bfsec.bt.co.uk) + * $Log: dl_mac.xs,v $ + * Revision 1.3 1998/04/07 01:47:24 neeri + * MacPerl 5.2.0r4b1 + * + * Revision 1.2 1997/08/08 16:39:18 neeri + * MacPerl 5.1.4b1 + time() fix + * + * Revision 1.1 1997/04/07 20:48:23 neeri + * Synchronized with MacPerl 5.1.4a1 + * + */ + +#define MAC_CONTEXT +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include + + +#include "dlutils.c" /* SaveError() etc */ + +typedef CFragConnectionID ConnectionID; + +static ConnectionID ** connections; + +static void terminate(void) +{ + int size = GetHandleSize((Handle) connections) / sizeof(ConnectionID); + HLock((Handle) connections); + while (size) + CloseConnection(*connections + --size); + DisposeHandle((Handle) connections); + connections = nil; +} + +static void +dl_private_init(pTHX) +{ + (void)dl_generic_private_init(aTHX); +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(aTHX); + + +ConnectionID +dl_load_file(filename, flags=0) + char * filename + int flags + PREINIT: + OSErr err; + FSSpec spec; + ConnectionID connID; + Ptr mainAddr; + Str255 errName; + CODE: + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + err = GUSIPath2FSp(filename, &spec); + if (!err) + err = + GetDiskFragment( + &spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName); + if (!err) { + if (!connections) { + connections = (ConnectionID **)NewHandle(0); + atexit(terminate); + } + PtrAndHand((Ptr) &connID, (Handle) connections, sizeof(ConnectionID)); + RETVAL = connID; + } else + RETVAL = (ConnectionID) 0; + DLDEBUG(2,fprintf(stderr," libref=%d\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (err) + SaveError(aTHX_ "DynaLoader error [%d, %#s]", err, errName) ; + else + sv_setiv( ST(0), (IV)RETVAL); + +void * +dl_find_symbol(connID, symbol) + ConnectionID connID + Str255 symbol + CODE: + { + OSErr err; + Ptr symAddr; + CFragSymbolClass symClass; + DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%#s)\n", + connID, symbol)); + err = FindSymbol(connID, symbol, &symAddr, &symClass); + if (err) + symAddr = (Ptr) 0; + RETVAL = (void *) symAddr; + DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (err) + SaveError(aTHX_ "DynaLoader error [%d]!", err) ; + else + sv_setiv( ST(0), (IV)RETVAL); + } + +void +dl_undef_symbols() + PPCODE: + + + +# These functions should not need changing on any platform: + +void +dl_install_xsub(perl_name, symref, filename="$Package") + char * perl_name + void * symref + char * filename + CODE: + DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/ext/NDBM_File/Makefile.PL b/ext/NDBM_File/Makefile.PL index 6ceab55..7b58601 100644 --- a/ext/NDBM_File/Makefile.PL +++ b/ext/NDBM_File/Makefile.PL @@ -5,4 +5,5 @@ WriteMakefile( MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'NDBM_File.pm', + INC => ($^O eq "MacOS" ? "-i ::::db:include" : "") ); diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index b33e961..d309ecb 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -55,6 +55,9 @@ #ifdef I_UNISTD #include #endif +#ifdef MACOS_TRADITIONAL +#undef fdopen +#endif #include #if defined(__VMS) && !defined(__POSIX_SOURCE) @@ -142,7 +145,7 @@ #else # ifndef HAS_MKFIFO -# ifdef OS2 +# if defined(OS2) || defined(MACOS_TRADITIONAL) # define mkfifo(a,b) not_here("mkfifo") # else /* !( defined OS2 ) */ # ifndef mkfifo @@ -151,12 +154,19 @@ # endif # endif /* !HAS_MKFIFO */ -# include -# include -# ifdef HAS_UNAME -# include +# ifdef MACOS_TRADITIONAL + struct tms { time_t tms_utime, tms_stime, tms_cutime, tms_cstime; }; +# define times(a) not_here("times") +# define ttyname(a) (char*)not_here("ttyname") +# define tzset() not_here("tzset") +# else +# include +# include +# ifdef HAS_UNAME +# include +# endif +# include # endif -# include # ifdef I_UTIME # include # endif @@ -3352,7 +3362,7 @@ modf(x) PPCODE: double intvar; /* (We already know stack is long enough.) */ - PUSHs(sv_2mortal(newSVnv(modf(x,&intvar)))); + PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar)))); PUSHs(sv_2mortal(newSVnv(intvar))); double diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index 9906fd5..bef12b5 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -82,7 +82,7 @@ if ($Is_OS2) { require ExtUtils::MM_OS2; } if ($Is_Mac) { - require ExtUtils::MM_Mac; + require ExtUtils::MM_MacOS; } if ($Is_Win32) { require ExtUtils::MM_Win32; diff --git a/mg.c b/mg.c index f0b5734..f8dd89e 100644 --- a/mg.c +++ b/mg.c @@ -489,8 +489,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) { char msg[256]; - sv_setnv(sv,(double)gLastMacOSErr); - sv_setpv(sv, gLastMacOSErr ? GetSysErrText(gLastMacOSErr, msg) : ""); + sv_setnv(sv,(double)gMacPerl_OSErr); + sv_setpv(sv, gMacPerl_OSErr ? GetSysErrText(gMacPerl_OSErr, msg) : ""); } #else #ifdef VMS @@ -1670,7 +1670,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; case '\005': /* ^E */ #ifdef MACOS_TRADITIONAL - gLastMacOSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); #else # ifdef VMS set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); diff --git a/perl.c b/perl.c index 7564282..8128733 100644 --- a/perl.c +++ b/perl.c @@ -969,6 +969,11 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) goto reswitch; case 'e': +#ifdef MACOS_TRADITIONAL + /* ignore -e for Dev:Pseudo argument */ + if (argv[1] && !strcmp(argv[1], "Dev:Pseudo")) + break; +#endif if (PL_euid != PL_uid || PL_egid != PL_gid) Perl_croak(aTHX_ "No -e allowed in setuid scripts"); if (!PL_e_script) { @@ -1190,7 +1195,11 @@ print \" \\@INC:\\n @INC\\n\";"); } #endif +#ifdef MACOS_TRADITIONAL + if (PL_doextract || gMacPerl_AlwaysExtract) { +#else if (PL_doextract) { +#endif find_beginning(); if (cddir && PerlDir_chdir(cddir) < 0) Perl_croak(aTHX_ "Can't chdir to %s",cddir); @@ -1251,6 +1260,16 @@ print \" \\@INC:\\n @INC\\n\";"); SETERRNO(0,SS$_NORMAL); PL_error_count = 0; +#ifdef MACOS_TRADITIONAL + if (gMacPerl_SyntaxError = (yyparse() || PL_error_count)) { + if (PL_minus_c) + Perl_croak(aTHX_ "%s had compilation errors.\n", MacPerl_MPWFileName(PL_origfilename)); + else { + Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n", + MacPerl_MPWFileName(PL_origfilename)); + } + } +#else if (yyparse() || PL_error_count) { if (PL_minus_c) Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename); @@ -1259,6 +1278,7 @@ print \" \\@INC:\\n @INC\\n\";"); PL_origfilename); } } +#endif CopLINE_set(PL_curcop, 0); PL_curstash = PL_defstash; PL_preprocess = FALSE; @@ -1384,7 +1404,11 @@ S_run_body(pTHX_ I32 oldscope) PTR2UV(thr))); if (PL_minus_c) { +#ifdef MACOS_TRADITIONAL + PerlIO_printf(Perl_error_log, "%s syntax OK\n", MacPerl_MPWFileName(PL_origfilename)); +#else PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename); +#endif my_exit(0); } if (PERLDB_SINGLE && PL_DBsingle) @@ -2177,6 +2201,9 @@ Perl_moreswitches(pTHX_ char *s) s++; return s; case 'u': +#ifdef MACOS_TRADITIONAL + Perl_croak(aTHX_ "Believe me, you don't want to use \"-u\" on a Macintosh"); +#endif PL_do_undump = TRUE; s++; return s; @@ -2982,9 +3009,30 @@ S_find_beginning(pTHX) /* skip forward in input to the real script? */ forbid_setid("-x"); +#ifdef MACOS_TRADITIONAL + /* Since the Mac OS does not honor !# arguments for us, we do it ourselves */ + + while (PL_doextract || gMacPerl_AlwaysExtract) { + if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) { + if (!gMacPerl_AlwaysExtract) + Perl_croak(aTHX_ "No Perl script found in input\n"); + + if (PL_doextract) /* require explicit override ? */ + if (!OverrideExtract(PL_origfilename)) + Perl_croak(aTHX_ "User aborted script\n"); + else + PL_doextract = FALSE; + + /* Pater peccavi, file does not have #! */ + PerlIO_rewind(PL_rsfp); + + break; + } +#else while (PL_doextract) { if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) Perl_croak(aTHX_ "No Perl script found in input\n"); +#endif if (*s == '#' && s[1] == '!' && (s = instr(s,"perl"))) { PerlIO_ungetc(PL_rsfp, '\n'); /* to keep line count right */ PL_doextract = FALSE; @@ -3166,8 +3214,9 @@ S_init_predump_symbols(pTHX) PL_statname = NEWSV(66,0); /* last filename we did stat on */ - if (!PL_osname) - PL_osname = savepv(OSNAME); + if (PL_osname) + Safefree(PL_osname); + PL_osname = savepv(OSNAME); } STATIC void @@ -3205,8 +3254,13 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register TAINT; if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) { +#ifdef MACOS_TRADITIONAL + /* $0 is not majick on a Mac */ + sv_setpv(GvSV(tmpgv),MacPerl_MPWFileName(PL_origfilename)); +#else sv_setpv(GvSV(tmpgv),PL_origfilename); magicname("0", "0", 1); +#endif } if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) #ifdef OS2 @@ -3230,7 +3284,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register GvMULTI_on(PL_envgv); hv = GvHVn(PL_envgv); hv_magic(hv, PL_envgv, 'E'); -#if !defined( VMS) && !defined(EPOC) /* VMS doesn't have environ array */ +#if !defined( VMS) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) /* VMS doesn't have environ array */ /* Note that if the supplied env parameter is actually a copy of the global environ then it may now point to free'd memory if the environment has been modified since. To avoid this @@ -3300,6 +3354,27 @@ S_init_perllib(pTHX) #ifdef ARCHLIB_EXP incpush(ARCHLIB_EXP, FALSE, FALSE); #endif +#ifdef MACOS_TRADITIONAL + { + struct stat tmpstatbuf; + SV * privdir = NEWSV(55, 0); + char * macperl = PerlEnv_getenv("MACPERL"); + + if (!macperl) + macperl = ""; + + Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl); + if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) + incpush(SvPVX(privdir), TRUE, FALSE); + Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl); + if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) + incpush(SvPVX(privdir), TRUE, FALSE); + + SvREFCNT_dec(privdir); + } + if (!PL_tainting) + incpush(":", FALSE, FALSE); +#else #ifndef PRIVLIB_EXP # define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl" #endif @@ -3355,6 +3430,7 @@ S_init_perllib(pTHX) if (!PL_tainting) incpush(".", FALSE, FALSE); +#endif /* MACOS_TRADITIONAL */ } #if defined(DOSISH) @@ -3363,7 +3439,11 @@ S_init_perllib(pTHX) # if defined(VMS) # define PERLLIB_SEP '|' # else -# define PERLLIB_SEP ':' +# if defined(MACOS_TRADITIONAL) +# define PERLLIB_SEP ',' +# else +# define PERLLIB_SEP ':' +# endif # endif #endif #ifndef PERLLIB_MANGLE @@ -3403,6 +3483,12 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) sv_setpv(libdir, PERLLIB_MANGLE(p, 0)); p = Nullch; /* break out */ } +#ifdef MACOS_TRADITIONAL + if (!strchr(SvPVX(libdir), ':')) + sv_insert(libdir, 0, 0, ":", 1); + if (SvPVX(libdir)[SvCUR(libdir)-1] != ':') + sv_catpv(libdir, ":"); +#endif /* * BEFORE pushing libdir onto @INC we may first push version- and @@ -3430,8 +3516,15 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) SvPV(libdir,len)); #endif if (addsubdirs) { +#ifdef MACOS_TRADITIONAL +#define PERL_AV_SUFFIX_FMT "" +#define PERL_ARCH_FMT ":%s" +#else +#define PERL_AV_SUFFIX_FMT "/" +#define PERL_ARCH_FMT "/%s" +#endif /* .../version/archname if -d .../version/archname */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", + Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT PERL_ARCH_FMT, libdir, (int)PERL_REVISION, (int)PERL_VERSION, (int)PERL_SUBVERSION, ARCHNAME); @@ -3440,7 +3533,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) av_push(GvAVn(PL_incgv), newSVsv(subdir)); /* .../version if -d .../version */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir, + Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT, libdir, (int)PERL_REVISION, (int)PERL_VERSION, (int)PERL_SUBVERSION); if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && @@ -3448,7 +3541,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) av_push(GvAVn(PL_incgv), newSVsv(subdir)); /* .../archname if -d .../archname */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME); + Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, ARCHNAME); if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(PL_incgv), newSVsv(subdir)); @@ -3458,7 +3551,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) if (addoldvers) { for (incver = incverlist; *incver; incver++) { /* .../xxx if -d .../xxx */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver); + Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, *incver); if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(PL_incgv), newSVsv(subdir)); diff --git a/perlsfio.h b/perlsfio.h index c4ed5c7..00568d1 100644 --- a/perlsfio.h +++ b/perlsfio.h @@ -49,7 +49,7 @@ extern int _stdprintf _ARG_((const char*, ...)); #define PerlIO_get_cnt(f) ((f)->endr - (f)->next) #define PerlIO_canset_cnt(f) 1 #define PerlIO_fast_gets(f) 1 -#define PerlIO_set_ptrcnt(f,p,c) ((f)->next = (p)) +#define PerlIO_set_ptrcnt(f,p,c) ((f)->next = (unsigned char *)(p)) #define PerlIO_set_cnt(f,c) 1 #define PerlIO_has_base(f) 1 diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index e997a8f..ecbd652 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -1746,7 +1746,7 @@ if you just want to say, ``Is this a float?'' Or you could check out the String::Scanf module on CPAN instead. The POSIX module (part of the standard Perl distribution) provides the -C and C for converting strings to double and longs, +C and C for converting strings to double and longs, respectively. =head2 How do I keep persistent data across program calls? diff --git a/pp_ctl.c b/pp_ctl.c index cad91bd..2060632 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2996,8 +2996,19 @@ PP(pp_require) { tryname = name; tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE); +#ifdef MACOS_TRADITIONAL + /* We consider paths of the form :a:b ambiguous and interpret them first + as global then as local + */ + if (!tryrsfp && name[0] == ':' && name[1] != ':' && strchr(name+2, ':')) + goto trylocal; + } + else +trylocal: { +#else } else { +#endif AV *ar = GvAVn(PL_incgv); I32 i; #ifdef VMS @@ -3115,6 +3126,10 @@ PP(pp_require) } else { char *dir = SvPVx(dirsv, n_a); +#ifdef MACOS_TRADITIONAL + /* We have ensured in incpush that library ends with ':' */ + Perl_sv_setpvf(aTHX_ namesv, "%s%s", dir, name+(name[0] == ':')); +#else #ifdef VMS char *unixdir; if ((unixdir = tounixpath(dir, Nullch)) == Nullch) @@ -3124,8 +3139,17 @@ PP(pp_require) #else Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name); #endif +#endif TAINT_PROPER("require"); tryname = SvPVX(namesv); +#ifdef MACOS_TRADITIONAL + { + /* Convert slashes in the name part, but not the directory part, to colons */ + char * colon; + for (colon = tryname+strlen(dir); colon = strchr(colon, '/'); ) + *colon++ = ':'; + } +#endif tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE); if (tryrsfp) { if (tryname[0] == '.' && tryname[1] == '/') diff --git a/proto.h b/proto.h index 9fbefb0..eb861e1 100644 --- a/proto.h +++ b/proto.h @@ -280,7 +280,7 @@ PERL_CALLCONV char* Perl_vform(pTHX_ const char* pat, va_list* args); PERL_CALLCONV void Perl_free_tmps(pTHX); PERL_CALLCONV OP* Perl_gen_constant_list(pTHX_ OP* o); #if !defined(HAS_GETENV_LEN) -PERL_CALLCONV char* Perl_getenv_len(pTHX_ char* key, unsigned long *len); +PERL_CALLCONV char* Perl_getenv_len(pTHX_ const char* key, unsigned long *len); #endif PERL_CALLCONV void Perl_gp_free(pTHX_ GV* gv); PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp); diff --git a/toke.c b/toke.c index c9b7bc5..75cab91 100644 --- a/toke.c +++ b/toke.c @@ -39,6 +39,13 @@ static void restore_rsfp(pTHXo_ void *f); * 1999-02-27 mjd-perl-patch@plover.com */ #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x))) +/* On MacOS, respect nonbreaking spaces */ +#ifdef MACOS_TRADITIONAL +#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\312'||(c)=='\t') +#else +#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t') +#endif + /* LEX_* are values for PL_lex_state, the state of the lexer. * They are arranged oddly so that the guard on the switch statement * can get by with a single comparison (if the compiler is smart enough). @@ -463,7 +470,7 @@ S_incline(pTHX_ char *s) CopLINE_inc(PL_curcop); if (*s++ != '#') return; - while (*s == ' ' || *s == '\t') s++; + while (SPACE_OR_TAB(*s)) s++; if (strnEQ(s, "line", 4)) s += 4; else @@ -472,13 +479,13 @@ S_incline(pTHX_ char *s) s++; else return; - while (*s == ' ' || *s == '\t') s++; + while (SPACE_OR_TAB(*s)) s++; if (!isDIGIT(*s)) return; n = s; while (isDIGIT(*s)) s++; - while (*s == ' ' || *s == '\t') + while (SPACE_OR_TAB(*s)) s++; if (*s == '"' && (t = strchr(s+1, '"'))) { s++; @@ -488,7 +495,7 @@ S_incline(pTHX_ char *s) for (t = s; !isSPACE(*t); t++) ; e = t; } - while (*e == ' ' || *e == '\t' || *e == '\r' || *e == '\f') + while (SPACE_OR_TAB(*e) || *e == '\r' || *e == '\f') e++; if (*e != '\n' && *e != '\0') return; /* false alarm */ @@ -512,7 +519,7 @@ S_skipspace(pTHX_ register char *s) { dTHR; if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) { - while (s < PL_bufend && (*s == ' ' || *s == '\t')) + while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; return s; } @@ -2024,6 +2031,9 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) if we already built the token before, use it. */ +#ifdef __SC__ +#pragma segment Perl_yylex +#endif int #ifdef USE_PURE_BISON Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp) @@ -2584,6 +2594,7 @@ Perl_yylex(pTHX) *s = '#'; /* Don't try to parse shebang line */ } #endif /* ALTERNATE_SHEBANG */ +#ifndef MACOS_TRADITIONAL if (!d && *s == '#' && ipathend > ipath && @@ -2611,13 +2622,14 @@ Perl_yylex(pTHX) PerlProc_execv(ipath, newargv); Perl_croak(aTHX_ "Can't exec %s", ipath); } +#endif if (d) { U32 oldpdb = PL_perldb; bool oldn = PL_minus_n; bool oldp = PL_minus_p; while (*d && !isSPACE(*d)) d++; - while (*d == ' ' || *d == '\t') d++; + while (SPACE_OR_TAB(*d)) d++; if (*d++ == '-') { do { @@ -2659,6 +2671,9 @@ Perl_yylex(pTHX) "\t(Maybe you didn't strip carriage returns after a network transfer?)\n"); #endif case ' ': case '\t': case '\f': case 013: +#ifdef MACOS_TRADITIONAL + case '\312': +#endif s++; goto retry; case '#': @@ -2692,7 +2707,7 @@ Perl_yylex(pTHX) PL_bufptr = s; tmp = *s++; - while (s < PL_bufend && (*s == ' ' || *s == '\t')) + while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; if (strnEQ(s,"=>",2)) { @@ -2976,20 +2991,20 @@ Perl_yylex(pTHX) PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR; OPERATOR(HASHBRACK); case XOPERATOR: - while (s < PL_bufend && (*s == ' ' || *s == '\t')) + while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; d = s; PL_tokenbuf[0] = '\0'; if (d < PL_bufend && *d == '-') { PL_tokenbuf[0] = '-'; d++; - while (d < PL_bufend && (*d == ' ' || *d == '\t')) + while (d < PL_bufend && SPACE_OR_TAB(*d)) d++; } if (d < PL_bufend && isIDFIRST_lazy_if(d,UTF)) { d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE, &len); - while (d < PL_bufend && (*d == ' ' || *d == '\t')) + while (d < PL_bufend && SPACE_OR_TAB(*d)) d++; if (*d == '}') { char minus = (PL_tokenbuf[0] == '-'); @@ -3206,9 +3221,9 @@ Perl_yylex(pTHX) if (PL_lex_brackets < PL_lex_formbrack) { char *t; #ifdef PERL_STRICT_CR - for (t = s; *t == ' ' || *t == '\t'; t++) ; + for (t = s; SPACE_OR_TAB(*t); t++) ; #else - for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ; + for (t = s; SPACE_OR_TAB(*t) || *t == '\r'; t++) ; #endif if (*t == '\n' || *t == '#') { s--; @@ -3802,7 +3817,7 @@ Perl_yylex(pTHX) if (*s == '(') { CLINE; if (gv && GvCVu(gv)) { - for (d = s + 1; *d == ' ' || *d == '\t'; d++) ; + for (d = s + 1; SPACE_OR_TAB(*d); d++) ; if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) { s = d + 1; goto its_constant; @@ -4996,6 +5011,9 @@ Perl_yylex(pTHX) } }} } +#ifdef __SC__ +#pragma segment Main +#endif I32 Perl_keyword(pTHX_ register char *d, I32 len) @@ -5869,7 +5887,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des if (isSPACE(s[-1])) { while (s < send) { char ch = *s++; - if (ch != ' ' && ch != '\t') { + if (!SPACE_OR_TAB(ch)) { *d = ch; break; } @@ -5895,7 +5913,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des Perl_croak(aTHX_ ident_too_long); } *d = '\0'; - while (s < send && (*s == ' ' || *s == '\t')) s++; + while (s < send && SPACE_OR_TAB(*s)) s++; if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) { dTHR; /* only for ckWARN */ if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) { @@ -6169,7 +6187,7 @@ S_scan_heredoc(pTHX_ register char *s) e = PL_tokenbuf + sizeof PL_tokenbuf - 1; if (!outer) *d++ = '\n'; - for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ; + for (peek = s; SPACE_OR_TAB(*peek); peek++) ; if (*peek && strchr("`'\"",*peek)) { s = peek; term = *s++; @@ -7134,9 +7152,9 @@ S_scan_formline(pTHX_ register char *s) if (*s == '.' || *s == '}') { /*SUPPRESS 530*/ #ifdef PERL_STRICT_CR - for (t = s+1;*t == ' ' || *t == '\t'; t++) ; + for (t = s+1;SPACE_OR_TAB(*t); t++) ; #else - for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ; + for (t = s+1;SPACE_OR_TAB(*t) || *t == '\r'; t++) ; #endif if (*t == '\n' || t == PL_bufend) break; diff --git a/util.c b/util.c index 74b374c..ef9387d 100644 --- a/util.c +++ b/util.c @@ -3666,7 +3666,7 @@ Perl_get_ppaddr(pTHX) #ifndef HAS_GETENV_LEN char * -Perl_getenv_len(pTHX_ char *env_elem, unsigned long *len) +Perl_getenv_len(pTHX_ const char *env_elem, unsigned long *len) { char *env_trans = PerlEnv_getenv(env_elem); if (env_trans) diff --git a/util.h b/util.h index beb5215..cb9f4c9 100644 --- a/util.h +++ b/util.h @@ -26,7 +26,11 @@ (*(f) == '/' \ || ((f)[0] && (f)[1] == ':')) /* drive name */ # else /* !DOSISH */ -# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') +# ifdef MACOS_TRADITIONAL +# define PERL_FILE_IS_ABSOLUTE(f) (strchr(f, ':')) +# else /* !MACOS_TRADITIONAL */ +# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') +# endif /* MACOS_TRADITIONAL */ # endif /* DOSISH */ # endif /* WIN32 */ #endif /* VMS */