MacOS support, part 1 (from Matthias Neeracher

<neeri@iis.ee.ethz.ch>)

p4raw-id: //depot/perl@6143

diff --git a/MANIFEST b/MANIFEST
index 3dec812..380fa4f 100644 (file)
--- 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 (file)
--- 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 (file)
index 0000000..136e6d5
--- /dev/null
+++ b/ext/DynaLoader/dl_mac.xs
@@ -0,0 +1,137 @@
+/* dl_mac.xs
+ * 
+ * Platform:   Macintosh CFM
+ * Author:     Matthias Neeracher <neeri@iis.ee.ethz.ch>
+ *             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 <CodeFragments.h>
+
+
+#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 (file)
--- 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 (file)
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -55,6 +55,9 @@
 #ifdef I_UNISTD
 #include <unistd.h>
 #endif
+#ifdef MACOS_TRADITIONAL
+#undef fdopen
+#endif
 #include <fcntl.h>
 
 #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 <grp.h>
-#  include <sys/times.h>
-#  ifdef HAS_UNAME
-#    include <sys/utsname.h>
+#  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 <grp.h>
+#    include <sys/times.h>
+#    ifdef HAS_UNAME
+#      include <sys/utsname.h>
+#    endif
+#    include <sys/wait.h>
 #  endif
-#  include <sys/wait.h>
 #  ifdef I_UTIME
 #    include <utime.h>
 #  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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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<strtol> and C<strtod> for converting strings to double and longs,
+C<strtod> and C<strtol> 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 */