diff options
| -rw-r--r-- | cop.h | 6 | ||||
| -rw-r--r-- | doio.c | 13 | ||||
| -rw-r--r-- | doop.c | 4 | ||||
| -rw-r--r-- | ext/File-Glob/bsd_glob.c | 390 | ||||
| -rw-r--r-- | ext/POSIX/POSIX.xs | 24 | ||||
| -rw-r--r-- | mg.c | 29 | ||||
| -rw-r--r-- | perl.c | 131 | ||||
| -rw-r--r-- | perl.h | 13 | ||||
| -rw-r--r-- | pp_ctl.c | 37 | ||||
| -rw-r--r-- | pp_sys.c | 4 | ||||
| -rw-r--r-- | sv.c | 6 | ||||
| -rw-r--r-- | toke.c | 10 | ||||
| -rw-r--r-- | util.c | 31 | ||||
| -rw-r--r-- | util.h | 6 |
14 files changed, 43 insertions, 661 deletions
@@ -232,11 +232,7 @@ struct cop { #define CopLINE_set(c,l) (CopLINE(c) = (l)) /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */ -#ifdef MACOS_TRADITIONAL -# define OutCopFILE(c) MacPerl_MPWFileName(CopFILE(c)) -#else -# define OutCopFILE(c) CopFILE(c) -#endif +#define OutCopFILE(c) CopFILE(c) /* If $[ is non-zero, it's stored in cop_hints under the key "$[", and HINT_ARYBASE is set to indicate this. @@ -1395,7 +1395,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, { dVAR; PERL_ARGS_ASSERT_DO_AEXEC5; -#if defined(MACOS_TRADITIONAL) || defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__) +#if defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__) Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system"); #else if (sp > mark) { @@ -1943,10 +1943,6 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp) static bool S_ingroup(pTHX_ Gid_t testgid, bool effective) { -#ifdef MACOS_TRADITIONAL - /* This is simply not correct for AppleShare, but fix it yerself. */ - return TRUE; -#else dVAR; if (testgid == (effective ? PL_egid : PL_gid)) return TRUE; @@ -1971,7 +1967,6 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) #else return FALSE; #endif -#endif } #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) @@ -2352,11 +2347,6 @@ Perl_vms_start_glob fp = Perl_vms_start_glob(aTHX_ tmpglob, io); #else /* !VMS */ -#ifdef MACOS_TRADITIONAL - sv_setpv(tmpcmd, "glob "); - sv_catsv(tmpcmd, tmpglob); - sv_catpv(tmpcmd, " |"); -#else #ifdef DOSISH #ifdef OS2 sv_setpv(tmpcmd, "for a in "); @@ -2388,7 +2378,6 @@ Perl_vms_start_glob #endif #endif /* !CSH */ #endif /* !DOSISH */ -#endif /* MACOS_TRADITIONAL */ (void)do_open(PL_last_in_gv, (char*)SvPVX_const(tmpcmd), SvCUR(tmpcmd), FALSE, O_RDONLY, 0, NULL); fp = IoIFP(io); @@ -203,10 +203,6 @@ S_do_trans_complex(pTHX_ SV * const sv) if (complement && !del) rlen = tbl[0x100]; -#ifdef MACOS_TRADITIONAL -#define comp CoMP /* "comp" is a keyword in some compilers ... */ -#endif - if (PL_op->op_private & OPpTRANS_SQUASH) { UV pch = 0xfeedface; while (s < send) { diff --git a/ext/File-Glob/bsd_glob.c b/ext/File-Glob/bsd_glob.c index b3b4600d82..db36007b0f 100644 --- a/ext/File-Glob/bsd_glob.c +++ b/ext/File-Glob/bsd_glob.c @@ -83,11 +83,7 @@ static char sscsid[]= "$OpenBSD: glob.c,v 1.8.10.1 2001/04/10 jason Exp $"; # ifdef PATH_MAX # define MAXPATHLEN PATH_MAX # else -# ifdef MACOS_TRADITIONAL -# define MAXPATHLEN 255 -# else -# define MAXPATHLEN 1024 -# endif +# define MAXPATHLEN 1024 # endif #endif @@ -96,20 +92,16 @@ static char sscsid[]= "$OpenBSD: glob.c,v 1.8.10.1 2001/04/10 jason Exp $"; #endif #ifndef ARG_MAX -# ifdef MACOS_TRADITIONAL -# define ARG_MAX 65536 /* Mac OS is actually unlimited */ +# ifdef _SC_ARG_MAX +# define ARG_MAX (sysconf(_SC_ARG_MAX)) # else -# ifdef _SC_ARG_MAX -# define ARG_MAX (sysconf(_SC_ARG_MAX)) +# ifdef _POSIX_ARG_MAX +# define ARG_MAX _POSIX_ARG_MAX # else -# ifdef _POSIX_ARG_MAX -# define ARG_MAX _POSIX_ARG_MAX +# ifdef WIN32 +# define ARG_MAX 14500 /* from VC's limits.h */ # else -# ifdef WIN32 -# define ARG_MAX 14500 /* from VC's limits.h */ -# else -# define ARG_MAX 4096 /* from POSIX, be conservative */ -# endif +# define ARG_MAX 4096 /* from POSIX, be conservative */ # endif # endif # endif @@ -124,11 +116,7 @@ static char sscsid[]= "$OpenBSD: glob.c,v 1.8.10.1 2001/04/10 jason Exp $"; #define BG_QUOTE '\\' #define BG_RANGE '-' #define BG_RBRACKET ']' -#ifdef MACOS_TRADITIONAL -# define BG_SEP ':' -#else -# define BG_SEP '/' -#endif +#define BG_SEP '/' #ifdef DOSISH #define BG_SEP2 '\\' #endif @@ -228,23 +216,6 @@ my_readdir(DIR *d) #endif -#ifdef MACOS_TRADITIONAL -#include <Files.h> -#include <Types.h> -#include <string.h> - -#define NO_UPDIR_ERR 1 /* updir resolving failed */ - -static Boolean g_matchVol; /* global variable */ -static short updir(char *path); -static short resolve_updirs(char *new_pattern); -static void remove_trColon(char *path); -static short glob_mark_Mac(Char *pathbuf, Char *pathend, Char *pathend_last); -static OSErr GetVolInfo(short volume, Boolean indexed, FSSpec *spec); -static void name_f_FSSpec(StrFileName volname, FSSpec *spec); - -#endif - int bsd_glob(const char *pattern, int flags, int (*errfunc)(const char *, int), glob_t *pglob) @@ -252,16 +223,7 @@ bsd_glob(const char *pattern, int flags, const U8 *patnext; int c; Char *bufnext, *bufend, patbuf[MAXPATHLEN]; - -#ifdef MACOS_TRADITIONAL - char *new_pat, *p, *np; - int err; - size_t len; -#endif - -#ifndef MACOS_TRADITIONAL patnext = (U8 *) pattern; -#endif /* TODO: GLOB_APPEND / GLOB_DOOFFS aren't supported yet */ #if 0 if (!(flags & GLOB_APPEND)) { @@ -301,61 +263,6 @@ bsd_glob(const char *pattern, int flags, } #endif -#ifdef MACOS_TRADITIONAL - /* Check if we need to match a volume name (e.g. '*HD:*') */ - g_matchVol = false; - p = (char *) pattern; - if (*p != BG_SEP) { - p++; - while (*p != BG_EOS) { - if (*p == BG_SEP) { - g_matchVol = true; - break; - } - p++; - } - } - - /* Transform the pattern: - * (a) Resolve updirs, e.g. - * '*:t*p::' -> '*:' - * ':a*:tmp::::' -> '::' - * ':base::t*p:::' -> '::' - * '*HD::' -> return 0 (error, quit silently) - * - * (b) Remove a single trailing ':', unless it's a "match volume only" - * pattern like '*HD:'; e.g. - * '*:tmp:' -> '*:tmp' but - * '*HD:' -> '*HD:' - * (If we don't do that, even filenames will have a trailing ':' in - * the result.) - */ - - /* We operate on a copy of the pattern */ - len = strlen(pattern); - Newx(new_pat, len + 1, char); - if (new_pat == NULL) - return (GLOB_NOSPACE); - - p = (char *) pattern; - np = new_pat; - while (*np++ = *p++) ; - - /* Resolve updirs ... */ - err = resolve_updirs(new_pat); - if (err) { - Safefree(new_pat); - /* The pattern is incorrect: tried to move - up above the volume root, see above. - We quit silently. */ - return 0; - } - /* remove trailing colon ... */ - remove_trColon(new_pat); - patnext = (U8 *) new_pat; - -#endif /* MACOS_TRADITIONAL */ - if (flags & GLOB_QUOTE) { /* Protect the quoted characters. */ while (bufnext < bufend && (c = *patnext++) != BG_EOS) @@ -383,19 +290,10 @@ bsd_glob(const char *pattern, int flags, *bufnext++ = c; *bufnext = BG_EOS; -#ifdef MACOS_TRADITIONAL - if (flags & GLOB_BRACE) - err = globexp1(patbuf, pglob); - else - err = glob0(patbuf, pglob); - Safefree(new_pat); - return err; -#else if (flags & GLOB_BRACE) return globexp1(patbuf, pglob); else return glob0(patbuf, pglob); -#endif } /* @@ -614,12 +512,6 @@ glob0(const Char *pattern, glob_t *pglob) Char *bufnext, patbuf[MAXPATHLEN]; size_t limit = 0; -#ifdef MACOS_TRADITIONAL - if ( (*pattern == BG_TILDE) && (pglob->gl_flags & GLOB_TILDE) ) { - return(globextend(pattern, pglob, &limit)); - } -#endif - qpat = globtilde(pattern, patbuf, MAXPATHLEN, pglob); qpatnext = qpat; oldflags = pglob->gl_flags; @@ -778,17 +670,10 @@ glob2(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, (S_ISLNK(sb.st_mode) && (g_stat(pathbuf, &sb, pglob) == 0) && S_ISDIR(sb.st_mode)))) { -#ifdef MACOS_TRADITIONAL - short err; - err = glob_mark_Mac(pathbuf, pathend, pathend_last); - if (err) - return (err); -#else if (pathend+1 > pathend_last) return (1); *pathend++ = BG_SEP; *pathend = BG_EOS; -#endif } ++pglob->gl_matchc; #ifdef GLOB_DEBUG @@ -874,49 +759,6 @@ glob3(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, } #endif -#ifdef MACOS_TRADITIONAL - if ((!*pathbuf) && (g_matchVol)) { - FSSpec spec; - short index; - StrFileName vol_name; /* unsigned char[64] on MacOS */ - - err = 0; - nocase = ((pglob->gl_flags & GLOB_NOCASE) != 0); - - /* Get and match a list of volume names */ - for (index = 0; !GetVolInfo(index+1, true, &spec); ++index) { - register U8 *sc; - register Char *dc; - - name_f_FSSpec(vol_name, &spec); - - /* Initial BG_DOT must be matched literally. */ - if (*vol_name == BG_DOT && *pattern != BG_DOT) - continue; - dc = pathend; - sc = (U8 *) vol_name; - while (dc < pathend_last && (*dc++ = *sc++) != BG_EOS) - ; - if (dc >= pathend_last) { - *dc = BG_EOS; - err = 1; - break; - } - - if (!match(pathend, pattern, restpattern, nocase)) { - *pathend = BG_EOS; - continue; - } - err = glob2(pathbuf, pathbuf_last, --dc, pathend_last, - restpattern, restpattern_last, pglob, limitp); - if (err) - break; - } - return(err); - - } else { /* open dir */ -#endif /* MACOS_TRADITIONAL */ - if ((dirp = g_opendir(pathbuf, pglob)) == NULL) { /* TODO: don't call for ENOENT or ENOTDIR? */ if (pglob->gl_errfunc) { @@ -969,10 +811,6 @@ glob3(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, else PerlDir_close(dirp); return(err); - -#ifdef MACOS_TRADITIONAL - } -#endif } @@ -1131,11 +969,7 @@ g_opendir(register Char *str, glob_t *pglob) char buf[MAXPATHLEN]; if (!*str) { -#ifdef MACOS_TRADITIONAL - my_strlcpy(buf, ":", sizeof(buf)); -#else my_strlcpy(buf, ".", sizeof(buf)); -#endif } else { if (g_Ctoc(str, buf, sizeof(buf))) return(NULL); @@ -1213,209 +1047,3 @@ qprintf(const char *str, register Char *s) (void)printf("\n"); } #endif /* GLOB_DEBUG */ - - -#ifdef MACOS_TRADITIONAL - -/* Replace the last occurrence of the pattern ":[^:]+::", e.g. ":lib::", - with a single ':', if possible. It is not an error, if the pattern - doesn't match (we return -1), but if there are two consecutive colons - '::', there must be a preceding ':[^:]+'. Hence, a volume path like - "HD::" is considered to be an error (we return 1), that is, it can't - be resolved. We return 0 on success. -*/ - -static short -updir(char *path) -{ - char *pb, *pe, *lastchar; - char *bgn_mark, *end_mark; - char *f, *m, *b; /* front, middle, back */ - size_t len; - - len = strlen(path); - lastchar = path + (len-1); - b = lastchar; - m = lastchar-1; - f = lastchar-2; - - /* find a '[^:]::' (e.g. b::) pattern ... */ - while ( !( (*f != BG_SEP) && (*m == BG_SEP) && (*b == BG_SEP) ) - && (f >= path)) { - f--; - m--; - b--; - } - - if (f < path) { /* no (more) match */ - return -1; - } - - end_mark = b; - - /* ... and now find its preceding colon ':' */ - while ((*f != BG_SEP) && (f >= path)) { - f--; - } - if (f < path) { - /* No preceding colon found, must be a - volume path. We can't move up the - tree and that's an error */ - return 1; - } - bgn_mark = f; - - /* Shrink path, i.e. exclude all characters between - bgn_mark and end_mark */ - - pb = bgn_mark; - pe = end_mark; - while (*pb++ = *pe++) ; - return 0; -} - - -/* Resolve all updirs in pattern. */ - -static short -resolve_updirs(char *new_pattern) -{ - short err; - - do { - err = updir(new_pattern); - } while (!err); - if (err == 1) { - return NO_UPDIR_ERR; - } - return 0; -} - - -/* Remove a trailing colon from the path, but only if it's - not a volume path (e.g. HD:) and not a path consisting - solely of colons. */ - -static void -remove_trColon(char *path) -{ - char *lastchar, *lc; - - /* if path matches the pattern /:[^:]+:$/, we can - remove the trailing ':' */ - - lc = lastchar = path + (strlen(path) - 1); - if (*lastchar == BG_SEP) { - /* there's a trailing ':', there must be at least - one preceding char != ':' and a preceding ':' */ - lc--; - if ((*lc != BG_SEP) && (lc >= path)) { - lc--; - } else { - return; - } - while ((*lc != BG_SEP) && (lc >= path)) { - lc--; - } - if (lc >= path) { - /* ... there's a preceding ':', we remove - the trailing colon */ - *lastchar = BG_EOS; - } - } -} - - -/* With the GLOB_MARK flag on, we append a colon, if pathbuf - is a directory. If the directory name contains no colons, - e.g. 'lib', we can't simply append a ':', since this (e.g. - 'lib:') is not a valid (relative) path on Mac OS. Instead, - we add a leading _and_ trailing ':'. */ - -static short -glob_mark_Mac(Char *pathbuf, Char *pathend, Char *pathend_last) -{ - Char *p, *pe; - Boolean is_file = true; - - /* check if pathbuf contains a ':', - i.e. is not a file name */ - p = pathbuf; - while (*p != BG_EOS) { - if (*p == BG_SEP) { - is_file = false; - break; - } - p++; - } - - if (is_file) { - if (pathend+2 > pathend_last) { - return (1); - } - /* right shift one char */ - pe = p = pathend; - p--; - pathend++; - while (p >= pathbuf) { - *pe-- = *p--; - } - /* first char becomes a colon */ - *pathbuf = BG_SEP; - /* append a colon */ - *pathend++ = BG_SEP; - *pathend = BG_EOS; - - } else { - if (pathend+1 > pathend_last) { - return (1); - } - *pathend++ = BG_SEP; - *pathend = BG_EOS; - } - return 0; -} - - -/* Return a FSSpec record for the specified volume - (borrowed from MacPerl.xs). */ - -static OSErr -GetVolInfo(short volume, Boolean indexed, FSSpec* spec) -{ - OSErr err; /* OSErr: 16-bit integer */ - HParamBlockRec pb; - - pb.volumeParam.ioNamePtr = spec->name; - pb.volumeParam.ioVRefNum = indexed ? 0 : volume; - pb.volumeParam.ioVolIndex = indexed ? volume : 0; - - if (err = PBHGetVInfoSync(&pb)) - return err; - - spec->vRefNum = pb.volumeParam.ioVRefNum; - spec->parID = 1; - - return noErr; /* 0 */ -} - -/* Extract a C name from a FSSpec. Note that there are - no leading or trailing colons. */ - -static void -name_f_FSSpec(StrFileName name, FSSpec *spec) -{ - unsigned char *nc; - const short len = spec->name[0]; - short i; - - /* FSSpec.name is a Pascal string, - convert it to C ... */ - nc = name; - for (i=1; i<=len; i++) { - *nc++ = spec->name[i]; - } - *nc = BG_EOS; -} - -#endif /* MACOS_TRADITIONAL */ diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index c62cc01798..25357c2788 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -70,9 +70,6 @@ #ifdef I_UNISTD #include <unistd.h> #endif -#ifdef MACOS_TRADITIONAL -#undef fdopen -#endif #include <fcntl.h> #ifdef HAS_TZNAME @@ -196,7 +193,7 @@ char *tzname[] = { "" , "" }; #else # ifndef HAS_MKFIFO -# if defined(OS2) || defined(MACOS_TRADITIONAL) +# if defined(OS2) # define mkfifo(a,b) not_here("mkfifo") # else /* !( defined OS2 ) */ # ifndef mkfifo @@ -205,19 +202,14 @@ char *tzname[] = { "" , "" }; # endif # endif /* !HAS_MKFIFO */ -# ifdef MACOS_TRADITIONAL -# define ttyname(a) (char*)not_here("ttyname") -# define tzset() not_here("tzset") -# else -# ifdef I_GRP -# include <grp.h> -# endif -# include <sys/times.h> -# ifdef HAS_UNAME -# include <sys/utsname.h> -# endif -# include <sys/wait.h> +# ifdef I_GRP +# include <grp.h> +# endif +# include <sys/times.h> +# ifdef HAS_UNAME +# include <sys/utsname.h> # endif +# include <sys/wait.h> # ifdef I_UTIME # include <utime.h> # endif @@ -772,14 +772,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) break; case '\005': /* ^E */ if (nextchar == '\0') { -#if defined(MACOS_TRADITIONAL) - { - char msg[256]; - - sv_setnv(sv,(double)gMacPerl_OSErr); - sv_setpv(sv, gMacPerl_OSErr ? GetSysErrText(gMacPerl_OSErr, msg) : ""); - } -#elif defined(VMS) +#if defined(VMS) { # include <descrip.h> # include <starlet.h> @@ -1075,10 +1068,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif break; -#ifndef MACOS_TRADITIONAL case '0': break; -#endif } return 0; } @@ -2385,21 +2376,17 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; case '\005': /* ^E */ if (*(mg->mg_ptr+1) == '\0') { -#ifdef MACOS_TRADITIONAL - gMacPerl_OSErr = SvIV(sv); -#else -# ifdef VMS +#ifdef VMS set_vaxc_errno(SvIV(sv)); -# else -# ifdef WIN32 +#else +# ifdef WIN32 SetLastError( SvIV(sv) ); -# else -# ifdef OS2 +# else +# ifdef OS2 os2_setsyserrno(SvIV(sv)); -# else +# else /* will anyone ever use this? */ SETERRNO(SvIV(sv), 4); -# endif # endif # endif #endif @@ -2774,7 +2761,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case ':': PL_chopset = SvPV_force(sv,len); break; -#ifndef MACOS_TRADITIONAL case '0': LOCK_DOLLARZERO_MUTEX; #ifdef HAS_SETPROCTITLE @@ -2840,7 +2826,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #endif UNLOCK_DOLLARZERO_MUTEX; break; -#endif } return 0; } @@ -1711,11 +1711,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) PL_minus_E = TRUE; /* FALL THROUGH */ case 'e': -#ifdef MACOS_TRADITIONAL - /* ignore -e for Dev:Pseudo argument */ - if (argv[1] && !strcmp(argv[1], "Dev:Pseudo")) - break; -#endif forbid_setid('e', FALSE); if (!PL_e_script) { PL_e_script = newSVpvs(""); @@ -2002,11 +1997,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) # endif #endif - if (PL_doextract -#ifdef MACOS_TRADITIONAL - || gMacPerl_AlwaysExtract -#endif - ) { + if (PL_doextract) { /* This will croak if suidscript is true, as -x cannot be used with setuid scripts. */ @@ -2146,16 +2137,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) /* now parse the script */ SETERRNO(0,SS_NORMAL); -#ifdef MACOS_TRADITIONAL - if (gMacPerl_SyntaxError = (yyparse() || PL_parser->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_parser->error_count) { if (PL_minus_c) Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename); @@ -2164,7 +2145,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) PL_origfilename); } } -#endif CopLINE_set(PL_curcop, 0); PL_curstash = PL_defstash; if (PL_e_script) { @@ -2282,13 +2262,7 @@ S_run_body(pTHX_ I32 oldscope) #endif if (PL_minus_c) { -#ifdef MACOS_TRADITIONAL - PerlIO_printf(Perl_error_log, "%s%s syntax OK\n", - (gMacPerl_ErrorFormat ? "# " : ""), - 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) @@ -3202,9 +3176,6 @@ Perl_moreswitches(pTHX_ const 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; @@ -3263,11 +3234,6 @@ Perl_moreswitches(pTHX_ const char *s) PerlIO_printf(PerlIO_stdout(), "\n\nCopyright 1987-2009, Larry Wall\n"); -#ifdef MACOS_TRADITIONAL - PerlIO_printf(PerlIO_stdout(), - "\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n" - "maintained by Chris Nandor\n"); -#endif #ifdef MSDOS PerlIO_printf(PerlIO_stdout(), "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n"); @@ -3664,38 +3630,14 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp) dVAR; const char *s; register const char *s2; -#ifdef MACOS_TRADITIONAL - int maclines = 0; -#endif PERL_ARGS_ASSERT_FIND_BEGINNING; /* skip forward in input to the real script? */ -#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(linestr_sv, rsfp, 0)) == NULL) { - 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(rsfp); - - break; - } -#else while (PL_doextract) { if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL) Perl_croak(aTHX_ "No Perl script found in input\n"); -#endif s2 = s; if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) { PerlIO_ungetc(rsfp, '\n'); /* to keep line count right */ @@ -3710,20 +3652,6 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp) while ((s = moreswitches(s))) ; } -#ifdef MACOS_TRADITIONAL - /* We are always searching for the #!perl line in MacPerl, - * so if we find it, still keep the line count correct - * by counting lines we already skipped over - */ - for (; maclines > 0 ; maclines--) - PerlIO_ungetc(rsfp, '\n'); - - break; - - /* gMacPerl_AlwaysExtract is false in MPW tool */ - } else if (gMacPerl_AlwaysExtract) { - ++maclines; -#endif } } } @@ -4009,17 +3937,12 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register init_argv_symbols(argc,argv); if ((tmpgv = gv_fetchpvs("0", GV_ADD|GV_NOTQUAL, 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); { GV * const gv = gv_fetchpv("0", GV_ADD, SVt_PV); if (gv) sv_magic(GvSV(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, "0", 1); } -#endif } if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) { HV *hv; @@ -4141,33 +4064,6 @@ S_init_perllib(pTHX) INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); #endif -#ifdef MACOS_TRADITIONAL - { - Stat_t tmpstatbuf; - SV * privdir = newSV(0); - char * macperl = PerlEnv_getenv("MACPERL"); - - if (!macperl) - macperl = ""; - -# ifdef ARCHLIB_EXP - S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE); -# endif - - Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl); - if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) - incpush_use_sep(SvPVX(privdir), SvCUR(privdir), - INCPUSH_ADD_SUB_DIRS); - Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl); - if (PerlLIO_stat(SvPVX(privdir), SvCUR(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) - incpush_use_sep(SvPVX(privdir), SvCUR(privdir), - INCPUSH_ADD_SUB_DIRS); - - SvREFCNT_dec(privdir); - if (!PL_tainting) - S_incpush(aTHX_ STR_WITH_LEN(":"), 0); - } -#else #ifdef SITEARCH_EXP /* sitearch is always relative to sitelib on Windows for * DLL-based path intuition to work correctly */ @@ -4234,7 +4130,6 @@ S_init_perllib(pTHX) INCPUSH_ADD_VERSIONED_SUB_DIRS|INCPUSH_NOT_BASEDIR |INCPUSH_CAN_RELOCATE); #endif -#endif /* MACOS_TRADITIONAL */ if (!PL_tainting) { #ifndef VMS @@ -4273,7 +4168,6 @@ S_init_perllib(pTHX) |INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); #endif -#ifndef MACOS_TRADITIONAL #if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST) /* Search for version-specific dirs below here */ S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_STEM), @@ -4295,7 +4189,6 @@ S_init_perllib(pTHX) if (!PL_tainting) S_incpush(aTHX_ STR_WITH_LEN("."), 0); -#endif /* MACOS_TRADITIONAL */ } #if defined(DOSISH) || defined(EPOC) || defined(__SYMBIAN32__) @@ -4304,11 +4197,7 @@ S_init_perllib(pTHX) # if defined(VMS) # define PERLLIB_SEP '|' # else -# if defined(MACOS_TRADITIONAL) -# define PERLLIB_SEP ',' -# else -# define PERLLIB_SEP ':' -# endif +# define PERLLIB_SEP ':' # endif #endif #ifndef PERLLIB_MANGLE @@ -4383,16 +4272,6 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags) libdir = newSVpv(PERLLIB_MANGLE(dir, 0), 0); } -#ifdef MACOS_TRADITIONAL - if (!strchr(SvPVX(libdir), ':')) { - char buf[256]; - - sv_setpv(libdir, MacPerl_CanonDir(SvPVX(libdir), buf, 0)); - } - if (SvPVX(libdir)[SvCUR(libdir)-1] != ':') - sv_catpvs(libdir, ":"); -#endif - /* Do the if() outside the #ifdef to avoid warnings about an unused parameter. */ if (canrelocate) { @@ -4522,15 +4401,9 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags) subdir = newSVsv(libdir); if (add_versioned_sub_dirs) { -#ifdef MACOS_TRADITIONAL -#define PERL_ARCH_FMT_PREFIX "" -#define PERL_ARCH_FMT_SUFFIX ":" -#define PERL_ARCH_FMT_PATH PERL_FS_VERSION "" -#else #define PERL_ARCH_FMT_PREFIX "/" #define PERL_ARCH_FMT_SUFFIX "" #define PERL_ARCH_FMT_PATH "/" PERL_FS_VERSION -#endif /* .../version/archname if -d .../version/archname */ sv_catpvs(subdir, PERL_ARCH_FMT_PATH \ PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX); @@ -943,7 +943,7 @@ EXTERN_C int usleep(unsigned int); #define PERL_USES_PL_PIDSTATUS #endif -#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL) +#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) #define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION #endif @@ -2502,7 +2502,7 @@ typedef struct clone_params CLONE_PARAMS; # endif #endif -#if defined(OS2) || defined(MACOS_TRADITIONAL) +#if defined(OS2) # include "iperlsys.h" #endif @@ -2564,13 +2564,6 @@ typedef struct clone_params CLONE_PARAMS; # define ISHISH "symbian" #endif -#if defined(MACOS_TRADITIONAL) -# include "macos/macish.h" -# ifndef NO_ENVIRON_ARRAY -# define NO_ENVIRON_ARRAY -# endif -# define ISHISH "macos classic" -#endif #if defined(__HAIKU__) # include "haiku/haikuish.h" @@ -3340,7 +3333,7 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ #endif /* threading */ #endif /* AIX */ -#if !defined(OS2) && !defined(MACOS_TRADITIONAL) +#if !defined(OS2) # include "iperlsys.h" #endif @@ -3304,17 +3304,6 @@ PP(pp_require) tryname = name; tryrsfp = doopen_pm(name, len); } -#ifdef MACOS_TRADITIONAL - if (!tryrsfp) { - char newname[256]; - - MacPerl_CanonDir(name, newname, 1); - if (path_is_absolute(newname)) { - tryname = newname; - tryrsfp = doopen_pm(newname, strlen(newname)); - } - } -#endif if (!tryrsfp) { AV * const ar = GvAVn(PL_incgv); I32 i; @@ -3445,12 +3434,6 @@ PP(pp_require) } else { if (!path_is_absolute(name) -#ifdef MACOS_TRADITIONAL - /* We consider paths of the form :a:b ambiguous and interpret them first - as global then as local - */ - || (*name == ':' && name[1] != ':' && strchr(name+2, ':')) -#endif ) { const char *dir; STRLEN dirlen; @@ -3462,21 +3445,14 @@ PP(pp_require) dirlen = 0; } -#ifdef MACOS_TRADITIONAL - char buf1[256]; - char buf2[256]; - - MacPerl_CanonDir(name, buf2, 1); - Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf1, 0), buf2+(buf2[0] == ':')); -#else -# ifdef VMS +#ifdef VMS char *unixdir; if ((unixdir = tounixpath(dir, NULL)) == NULL) continue; sv_setpv(namesv, unixdir); sv_catpv(namesv, unixname); -# else -# ifdef __SYMBIAN32__ +#else +# ifdef __SYMBIAN32__ if (PL_origfilename[0] && PL_origfilename[1] == ':' && !(dir[0] && dir[1] == ':')) @@ -3488,7 +3464,7 @@ PP(pp_require) Perl_sv_setpvf(aTHX_ namesv, "%s\\%s", dir, name); -# else +# else /* The equivalent of Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name); but without the need to parse the format string, or @@ -3509,7 +3485,6 @@ PP(pp_require) /* Don't even actually have to turn SvPOK_on() as we access it directly with SvPVX() below. */ } -# endif # endif #endif TAINT_PROPER("require"); @@ -4935,12 +4910,8 @@ S_path_is_absolute(const char *name) PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE; if (PERL_FILE_IS_ABSOLUTE(name) -#ifdef MACOS_TRADITIONAL - || (*name == ':') -#else || (*name == '.' && (name[1] == '/' || (name[1] == '.' && name[2] == '/'))) -#endif ) { return TRUE; @@ -4069,7 +4069,7 @@ PP(pp_fork) PP(pp_wait) { -#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__) dVAR; dSP; dTARGET; Pid_t childpid; int argflags; @@ -4097,7 +4097,7 @@ PP(pp_wait) PP(pp_waitpid) { -#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__) dVAR; dSP; dTARGET; const int optype = POPi; const Pid_t pid = TOPi; @@ -9670,12 +9670,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen, if (args) { eptr = va_arg(*args, char*); if (eptr) -#ifdef MACOS_TRADITIONAL - /* On MacOS, %#s format is used for Pascal strings */ - if (alt) - elen = *eptr++; - else -#endif elen = strlen(eptr); else { eptr = (char *)nullstr; @@ -128,12 +128,7 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen); * 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 @@ -3948,7 +3943,6 @@ Perl_yylex(pTHX) *s = '#'; /* Don't try to parse shebang line */ } #endif /* ALTERNATE_SHEBANG */ -#ifndef MACOS_TRADITIONAL if (!d && *s == '#' && ipathend > ipath && @@ -3979,7 +3973,6 @@ Perl_yylex(pTHX) PERL_FPU_POST_EXEC Perl_croak(aTHX_ "Can't exec %s", ipath); } -#endif if (d) { while (*d && !isSPACE(*d)) d++; @@ -4042,9 +4035,6 @@ 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 #ifdef PERL_MAD PL_realtokenstart = -1; if (!PL_thiswhite) @@ -2255,7 +2255,7 @@ Perl_my_swabn(void *ptr, int n) PerlIO * Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) { -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__) dVAR; int p[2]; register I32 This, that; @@ -2395,7 +2395,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) } /* VMS' my_popen() is in VMS.c, same with OS/2. */ -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(__LIBCATAMOUNT__) PerlIO * Perl_my_popen(pTHX_ const char *cmd, const char *mode) { @@ -2700,11 +2700,6 @@ dup2(int oldfd, int newfd) #ifndef PERL_MICRO #ifdef HAS_SIGACTION -#ifdef MACOS_TRADITIONAL -/* We don't want restart behavior on MacOS */ -#undef SA_RESTART -#endif - Sighandler_t Perl_rsignal(pTHX_ int signo, Sighandler_t handler) { @@ -2855,7 +2850,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save) #endif /* !PERL_MICRO */ /* VMS' my_pclose() is in VMS.c; same with OS/2 */ -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(__LIBCATAMOUNT__) I32 Perl_my_pclose(pTHX_ PerlIO *ptr) { @@ -2913,7 +2908,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) #endif #endif /* !DOSISH */ -#if (!defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(NETWARE)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(NETWARE)) && !defined(__LIBCATAMOUNT__) I32 Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) { @@ -3231,26 +3226,16 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, } #endif -#ifdef MACOS_TRADITIONAL - if (dosearch && !strchr(scriptname, ':') && - (s = PerlEnv_getenv("Commands"))) -#else if (dosearch && !strchr(scriptname, '/') #ifdef DOSISH && !strchr(scriptname, '\\') #endif && (s = PerlEnv_getenv("PATH"))) -#endif { bool seen_dot = 0; bufend = s + strlen(s); while (s < bufend) { -#ifdef MACOS_TRADITIONAL - s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend, - ',', - &len); -#else #if defined(atarist) || defined(DOSISH) for (len = 0; *s # ifdef atarist @@ -3267,15 +3252,10 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, ':', &len); #endif /* ! (atarist || DOSISH) */ -#endif /* MACOS_TRADITIONAL */ if (s < bufend) s++; if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf) continue; /* don't search dir with too-long name */ -#ifdef MACOS_TRADITIONAL - if (len && tmpbuf[len - 1] != ':') - tmpbuf[len++] = ':'; -#else if (len # if defined(atarist) || defined(__MINT__) || defined(DOSISH) && tmpbuf[len - 1] != '/' @@ -3285,7 +3265,6 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, tmpbuf[len++] = '/'; if (len == 2 && tmpbuf[0] == '.') seen_dot = 1; -#endif (void)my_strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len); #endif /* !VMS */ @@ -3310,7 +3289,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, continue; if (S_ISREG(PL_statbuf.st_mode) && cando(S_IRUSR,TRUE,&PL_statbuf) -#if !defined(DOSISH) && !defined(MACOS_TRADITIONAL) +#if !defined(DOSISH) && cando(S_IXUSR,TRUE,&PL_statbuf) #endif ) @@ -32,11 +32,7 @@ (*(f) == '/' \ || ((f)[0] && (f)[1] == ':')) /* drive name */ # else /* NEITHER DOSISH NOR EPOCISH NOR SYMBIANISH */ -# ifdef MACOS_TRADITIONAL -# define PERL_FILE_IS_ABSOLUTE(f) (strchr(f, ':') && *(f) != ':') -# else /* !MACOS_TRADITIONAL */ -# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') -# endif /* MACOS_TRADITIONAL */ +# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') # endif /* DOSISH */ # endif /* NETWARE */ # endif /* WIN32 */ |