[patch] Cwd.xs optimizations/abstraction

Message-ID: <Pine.LNX.4.21.0105311733270.732-100000@mako.covalent.net>

p4raw-id: //depot/perl@10369

10 files changed, 357 insertions, 272 deletions

diff --git a/embed.h b/embed.h
index 4acb7f3f0c..1a2f0e0d71 100644
--- a/embed.h
+++ b/embed.h
@@ -668,6 +668,7 @@
 #define sv_collxfrm		Perl_sv_collxfrm
 #endif
 #define sv_compile_2op		Perl_sv_compile_2op
+#define sv_getcwd		Perl_sv_getcwd
 #define sv_dec			Perl_sv_dec
 #define sv_dump			Perl_sv_dump
 #define sv_derived_from		Perl_sv_derived_from
@@ -691,6 +692,7 @@
 #define sv_pos_b2u		Perl_sv_pos_b2u
 #define sv_pvutf8n_force	Perl_sv_pvutf8n_force
 #define sv_pvbyten_force	Perl_sv_pvbyten_force
+#define sv_realpath		Perl_sv_realpath
 #define sv_reftype		Perl_sv_reftype
 #define sv_replace		Perl_sv_replace
 #define sv_report_used		Perl_sv_report_used
@@ -2163,6 +2165,7 @@
 #define sv_collxfrm(a,b)	Perl_sv_collxfrm(aTHX_ a,b)
 #endif
 #define sv_compile_2op(a,b,c,d)	Perl_sv_compile_2op(aTHX_ a,b,c,d)
+#define sv_getcwd(a)		Perl_sv_getcwd(aTHX_ a)
 #define sv_dec(a)		Perl_sv_dec(aTHX_ a)
 #define sv_dump(a)		Perl_sv_dump(aTHX_ a)
 #define sv_derived_from(a,b)	Perl_sv_derived_from(aTHX_ a,b)
@@ -2186,6 +2189,7 @@
 #define sv_pos_b2u(a,b)		Perl_sv_pos_b2u(aTHX_ a,b)
 #define sv_pvutf8n_force(a,b)	Perl_sv_pvutf8n_force(aTHX_ a,b)
 #define sv_pvbyten_force(a,b)	Perl_sv_pvbyten_force(aTHX_ a,b)
+#define sv_realpath(a,b,c)	Perl_sv_realpath(aTHX_ a,b,c)
 #define sv_reftype(a,b)		Perl_sv_reftype(aTHX_ a,b)
 #define sv_replace(a,b)		Perl_sv_replace(aTHX_ a,b)
 #define sv_report_used()	Perl_sv_report_used(aTHX)
@@ -4249,6 +4253,8 @@
 #endif
 #define Perl_sv_compile_2op	CPerlObj::Perl_sv_compile_2op
 #define sv_compile_2op		Perl_sv_compile_2op
+#define Perl_sv_getcwd		CPerlObj::Perl_sv_getcwd
+#define sv_getcwd		Perl_sv_getcwd
 #define Perl_sv_dec		CPerlObj::Perl_sv_dec
 #define sv_dec			Perl_sv_dec
 #define Perl_sv_dump		CPerlObj::Perl_sv_dump
@@ -4297,6 +4303,8 @@
 #define sv_pvutf8n_force	Perl_sv_pvutf8n_force
 #define Perl_sv_pvbyten_force	CPerlObj::Perl_sv_pvbyten_force
 #define sv_pvbyten_force	Perl_sv_pvbyten_force
+#define Perl_sv_realpath	CPerlObj::Perl_sv_realpath
+#define sv_realpath		Perl_sv_realpath
 #define Perl_sv_reftype		CPerlObj::Perl_sv_reftype
 #define sv_reftype		Perl_sv_reftype
 #define Perl_sv_replace		CPerlObj::Perl_sv_replace
diff --git a/embed.pl b/embed.pl
index 91165b3e0f..139270b47b 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1136,7 +1136,7 @@ DOC:
 		    redo FUNC;
 		}
 	    } else {
-		warn "$file:$line:$in";
+		warn "$file:$line:$in (=cut missing?)";
 	    }
 	}
     }
@@ -2029,6 +2029,7 @@ Apd	|I32	|sv_cmp_locale	|SV* sv1|SV* sv2
 Ap	|char*	|sv_collxfrm	|SV* sv|STRLEN* nxp
 #endif
 Ap	|OP*	|sv_compile_2op	|SV* sv|OP** startp|char* code|AV** avp
+Apd	|int	|sv_getcwd	|SV* sv
 Apd	|void	|sv_dec		|SV* sv
 Ap	|void	|sv_dump	|SV* sv
 Apd	|bool	|sv_derived_from|SV* sv|const char* name
@@ -2055,6 +2056,7 @@ Ap	|void	|sv_pos_b2u	|SV* sv|I32* offsetp
 Aopd	|char*	|sv_pvn_force	|SV* sv|STRLEN* lp
 Apd	|char*	|sv_pvutf8n_force|SV* sv|STRLEN* lp
 Ap	|char*	|sv_pvbyten_force|SV* sv|STRLEN* lp
+Apd	|int	|sv_realpath	|SV* sv|char *path|STRLEN len
 Apd	|char*	|sv_reftype	|SV* sv|int ob
 Apd	|void	|sv_replace	|SV* sv|SV* nsv
 Ap	|void	|sv_report_used
diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs
index 872591d3ad..7b367168f8 100644
--- a/ext/Cwd/Cwd.xs
+++ b/ext/Cwd/Cwd.xs
@@ -2,250 +2,36 @@
 #include "perl.h"
 #include "XSUB.h"
 
-/* Originally written in Perl by John Bazik; rewritten in C by Ben Sugars.
- * Comments from the orignal:
- *     This is a faster version of getcwd.  It's also more dangerous
- *     because you might chdir out of a directory that you can't chdir
- *     back into. */
-char *
-_cwdxs_fastcwd(void)
-{
-/* XXX Should we just use getcwd(3) if available? */
-  struct stat statbuf;
-  int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
-  int i = 0, j = 0, k = 0, ndirs = 16, pathlen = 0, namelen;
-  DIR *dir;
-  Direntry_t *dp;
-  char **names, *path;
-
-  Newz(0, names, ndirs, char*);
-
-  if (PerlLIO_lstat(".", &statbuf) < 0) {
-    Safefree(names);
-    return FALSE;
-  }
-  orig_cdev = statbuf.st_dev;
-  orig_cino = statbuf.st_ino;
-  cdev = orig_cdev;
-  cino = orig_cino;
-  for (;;) {
-    odev = cdev;
-    oino = cino;
-
-    if (PerlDir_chdir("..") < 0) {
-      Safefree(names);
-      return FALSE;
-    }
-    if (PerlLIO_stat(".", &statbuf) < 0) {
-      Safefree(names);
-      return FALSE;
-    }
-    cdev = statbuf.st_dev;
-    cino = statbuf.st_ino;
-    if (odev == cdev && oino == cino)
-      break;
-
-    if (!(dir = PerlDir_open("."))) {
-      Safefree(names);
-      return FALSE;
-    }
-
-    while ((dp = PerlDir_read(dir)) != NULL) {
-      if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
-	Safefree(names);
-	return FALSE;
-      }
-      if (strEQ(dp->d_name, "."))
-	continue;
-      if (strEQ(dp->d_name, ".."))
-	continue;
-      tdev = statbuf.st_dev;
-      tino = statbuf.st_ino;
-      if (tino == oino && tdev == odev)
-	break;
-    }
-
-    if (!dp) {
-      Safefree(names);
-      return FALSE;
-    }
-
-    if (i >= ndirs) {
-      ndirs += 16;
-      Renew(names, ndirs, char*);
-    }
-#ifdef DIRNAMLEN
-    namelen = dp->d_namlen;
-#else
-    namelen = strlen(dp->d_name);
-#endif
-    Newz(0, *(names + i), namelen + 1, char);
-    Copy(dp->d_name, *(names + i), namelen, char);
-    *(names[i] + namelen) = '\0';
-    pathlen += (namelen + 1);
-    ++i;
-
-#ifdef VOID_CLOSEDIR
-    PerlDir_close(dir);
-#else
-    if (PerlDir_close(dir) < 0) {
-      Safefree(names);
-      return FALSE;
-    }
-#endif
-  }
-
-  Newz(0, path, pathlen + 1, char);
-  for (j = i - 1; j >= 0; j--) {
-    *(path + k) = '/';
-    Copy(names[j], path + k + 1, strlen(names[j]) + 1, char);
-    k = k + strlen(names[j]) + 1;
-    Safefree(names[j]);
-  }
+MODULE = Cwd		PACKAGE = Cwd
 
-  if (PerlDir_chdir(path) < 0) {
-    Safefree(names);
-    Safefree(path);
-    return FALSE;
-  }
-  if (PerlLIO_stat(".", &statbuf) < 0) {
-    Safefree(names);
-    Safefree(path);
-    return FALSE;
-  }
-  cdev = statbuf.st_dev;
-  cino = statbuf.st_ino;
-  if (cdev != orig_cdev || cino != orig_cino)
-    Perl_croak(aTHX_ "Unstable directory path, current directory changed unexpectedly");
+PROTOTYPES: ENABLE
 
-  Safefree(names);
-  return(path);
+void
+fastcwd()
+PPCODE:
+{
+    dXSTARG;
+    sv_getcwd(TARG);
+    XSprePUSH; PUSHTARG;
 }
 
-char *
-_cwdxs_abs_path(char *start)
+void
+abs_path(svpath=Nullsv)
+    SV *svpath
+PPCODE:
 {
-  DIR *parent;
-  Direntry_t *dp;
-  char dotdots[MAXPATHLEN] = { 0 };
-  char name[MAXPATHLEN]    = { 0 };
-  char *cwd;
-  int namelen = 0;
-  struct stat cst, pst, tst;
-
-  if (PerlLIO_stat(start, &cst) < 0) {
-    warn("abs_path: stat(\"%s\"): %s", start, Strerror(errno));
-    return FALSE;
-  }
-
-  Newz(0, cwd, MAXPATHLEN, char);
-  Copy(start, dotdots, strlen(start), char);
-
-  for (;;) {
-    strcat(dotdots, "/..");
-    StructCopy(&cst, &pst, struct stat);
+    dXSTARG;
+    char *path;
+    STRLEN len;
 
-    if (PerlLIO_stat(dotdots, &cst) < 0) {
-      Safefree(cwd);
-      warn("abs_path: stat(\"%s\"): %s", dotdots, Strerror(errno));
-      return FALSE;
+    if (svpath) {
+        path = SvPV(svpath, len);
     }
-    
-    if (pst.st_dev == cst.st_dev && pst.st_ino == cst.st_ino) {
-      /* We've reached the root: previous is same as current */
-      break;
-    } else {
-      STRLEN dotdotslen = strlen(dotdots);
-
-      /* Scan through the dir looking for name of previous */
-      if (!(parent = PerlDir_open(dotdots))) {
-        Safefree(cwd);
-        warn("abs_path: opendir(\"%s\"): %s", dotdots, Strerror(errno));
-        return FALSE;
-      }
-    
-      SETERRNO(0,SS$_NORMAL); /* for readdir() */
-      while ((dp = PerlDir_read(parent)) != NULL) {
-        if (strEQ(dp->d_name, "."))
-          continue;
-        if (strEQ(dp->d_name, ".."))
-          continue;
-        
-        Copy(dotdots, name, dotdotslen, char);
-        name[dotdotslen] = '/';
-#ifdef DIRNAMLEN
-	namelen = dp->d_namlen;
-#else
-	namelen = strlen(dp->d_name);
-#endif
-        Copy(dp->d_name, name + dotdotslen + 1, namelen, char);
-	name[dotdotslen + 1 + namelen] = 0;
-        
-        if (PerlLIO_lstat(name, &tst) < 0) {
-          Safefree(cwd);
-          PerlDir_close(parent);
-          warn("abs_path: lstat(\"%s\"): %s", name, Strerror(errno));
-          return FALSE;
-        }
-        
-        if (tst.st_dev == pst.st_dev && tst.st_ino == pst.st_ino)
-          break;
-
-	SETERRNO(0,SS$_NORMAL); /* for readdir() */
-      }
-      
-
-      if (!dp && errno) {
-        warn("abs_path: readdir(\"%s\"): %s", dotdots, Strerror(errno));
-        Safefree(cwd);
-        return FALSE;
-      }
-
-      Move(cwd, cwd + namelen + 1, strlen(cwd), char);
-      Copy(dp->d_name, cwd + 1, namelen, char);
-#ifdef VOID_CLOSEDIR
-      PerlDir_close(parent);
-#else
-      if (PerlDir_close(parent) < 0) {
-        warn("abs_path: closedir(\"%s\"): %s", dotdots, Strerror(errno));
-        Safefree(cwd);
-        return FALSE;
-      }
-#endif
-      *cwd = '/';
+    else {
+        path = ".";
+        len = 1;
     }
-  }
 
-  return cwd;
+    sv_realpath(TARG, path, len);
+    XSprePUSH; PUSHTARG;
 }
-  
-
-MODULE = Cwd		PACKAGE = Cwd
-
-PROTOTYPES: ENABLE
-
-char *
-_fastcwd()
-PPCODE:
-    char * buf;
-    buf = _cwdxs_fastcwd();
-    if (buf) {
-        PUSHs(sv_2mortal(newSVpv(buf, 0)));
-        Safefree(buf);
-    }
-    else
-	XSRETURN_UNDEF;
-
-char *
-_abs_path(start = ".")
-    char * start
-PREINIT:
-    char * buf;
-PPCODE:
-    buf = _cwdxs_abs_path(start);
-    if (buf) {
-        PUSHs(sv_2mortal(newSVpv(buf, 0)));
-        Safefree(buf);
-    }
-    else
-	XSRETURN_UNDEF;
diff --git a/global.sym b/global.sym
index 17e3df3104..544e1cfc25 100644
--- a/global.sym
+++ b/global.sym
@@ -410,6 +410,7 @@ Perl_sv_cmp
 Perl_sv_cmp_locale
 Perl_sv_collxfrm
 Perl_sv_compile_2op
+Perl_sv_getcwd
 Perl_sv_dec
 Perl_sv_dump
 Perl_sv_derived_from
@@ -433,6 +434,7 @@ Perl_sv_pos_b2u
 Perl_sv_pvn_force
 Perl_sv_pvutf8n_force
 Perl_sv_pvbyten_force
+Perl_sv_realpath
 Perl_sv_reftype
 Perl_sv_replace
 Perl_sv_report_used
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index 4e4d39c8f7..27a3105f3b 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -85,8 +85,10 @@ use base qw/ Exporter /;
 our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
 our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 
-# Indicates if the XS portion has been loaded or not
-my $Booted = 0;
+eval {
+    require XSLoader;
+    XSLoader::load('Cwd');
+};
 
 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 
@@ -123,19 +125,6 @@ sub getcwd
     abs_path('.');
 }
 
-# Now a callout to an XSUB.  We have to delay booting of the XSUB
-# until the first time fastcwd is called since Cwd::cwd is needed in the
-# building of perl when dynamic loading may be unavailable
-sub fastcwd {
-    unless ($Booted) {
-	require XSLoader;
-        XSLoader::load("Cwd");
-	++$Booted;
-    }
-    return &Cwd::_fastcwd;
-}
-
-
 # Keeps track of current working directory in PWD environment var
 # Usage:
 #	use Cwd 'chdir';
@@ -206,17 +195,6 @@ sub chdir {
     1;
 }
 
-# Now a callout to an XSUB
-sub abs_path
-{
-    unless ($Booted) {
-        require XSLoader;
-        XSLoader::load("Cwd");
-        ++$Booted;
-    }
-    return &Cwd::_abs_path(@_);
-}
-
 # added function alias for those of us more
 # used to the libc function.  --tchrist 27-Jan-00
 *realpath = \&abs_path;
diff --git a/objXSUB.h b/objXSUB.h
index c830fe1542..a3cb92cae2 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1645,6 +1645,10 @@
 #define Perl_sv_compile_2op	pPerl->Perl_sv_compile_2op
 #undef  sv_compile_2op
 #define sv_compile_2op		Perl_sv_compile_2op
+#undef  Perl_sv_getcwd
+#define Perl_sv_getcwd		pPerl->Perl_sv_getcwd
+#undef  sv_getcwd
+#define sv_getcwd		Perl_sv_getcwd
 #undef  Perl_sv_dec
 #define Perl_sv_dec		pPerl->Perl_sv_dec
 #undef  sv_dec
@@ -1737,6 +1741,10 @@
 #define Perl_sv_pvbyten_force	pPerl->Perl_sv_pvbyten_force
 #undef  sv_pvbyten_force
 #define sv_pvbyten_force	Perl_sv_pvbyten_force
+#undef  Perl_sv_realpath
+#define Perl_sv_realpath	pPerl->Perl_sv_realpath
+#undef  sv_realpath
+#define sv_realpath		Perl_sv_realpath
 #undef  Perl_sv_reftype
 #define Perl_sv_reftype		pPerl->Perl_sv_reftype
 #undef  sv_reftype
diff --git a/perlapi.c b/perlapi.c
index b839a354b0..b8ec2c5c68 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -2981,6 +2981,13 @@ Perl_sv_compile_2op(pTHXo_ SV* sv, OP** startp, char* code, AV** avp)
     return ((CPerlObj*)pPerl)->Perl_sv_compile_2op(sv, startp, code, avp);
 }
 
+#undef  Perl_sv_getcwd
+int
+Perl_sv_getcwd(pTHXo_ SV* sv)
+{
+    return ((CPerlObj*)pPerl)->Perl_sv_getcwd(sv);
+}
+
 #undef  Perl_sv_dec
 void
 Perl_sv_dec(pTHXo_ SV* sv)
@@ -3142,6 +3149,13 @@ Perl_sv_pvbyten_force(pTHXo_ SV* sv, STRLEN* lp)
     return ((CPerlObj*)pPerl)->Perl_sv_pvbyten_force(sv, lp);
 }
 
+#undef  Perl_sv_realpath
+int
+Perl_sv_realpath(pTHXo_ SV* sv, char *path, STRLEN len)
+{
+    return ((CPerlObj*)pPerl)->Perl_sv_realpath(sv, path, len);
+}
+
 #undef  Perl_sv_reftype
 char*
 Perl_sv_reftype(pTHXo_ SV* sv, int ob)
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index b8dfd82dc0..aa72c9c9f9 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -952,7 +952,7 @@ parameter is the precomputed hash value; if it is zero then Perl will
 compute it.  The return value is the new hash entry so created.  It will be
 NULL if the operation failed or if the value did not need to be actually
 stored within the hash (as in the case of tied hashes).  Otherwise the
-contents of the return value can be accessed using the C<He???> macros
+contents of the return value can be accessed using the C<He?> macros
 described here.  Note that the caller is responsible for suitably
 incrementing the reference count of C<val> before the call, and
 decrementing it if the function returned NULL.
@@ -2408,19 +2408,19 @@ false, defined or undefined.  Does not handle 'get' magic.
 =for hackers
 Found in file sv.h
 
-=item SvTYPE
-
-Returns the type of the SV.  See C<svtype>.
+=item svtype
 
-	svtype	SvTYPE(SV* sv)
+An enum of flags for Perl types.  These are found in the file B<sv.h> 
+in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
 
 =for hackers
 Found in file sv.h
 
-=item svtype
+=item SvTYPE
 
-An enum of flags for Perl types.  These are found in the file B<sv.h> 
-in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
+Returns the type of the SV.  See C<svtype>.
+
+	svtype	SvTYPE(SV* sv)
 
 =for hackers
 Found in file sv.h
@@ -2754,6 +2754,15 @@ Free the memory used by an SV.
 =for hackers
 Found in file sv.c
 
+=item sv_getcwd
+
+Fill the sv with current working directory
+
+	int	sv_getcwd(SV* sv)
+
+=for hackers
+Found in file util.c
+
 =item sv_gets
 
 Get a line from the filehandle and store it into the SV, optionally
@@ -2894,6 +2903,16 @@ L</sv_pvn_force>.
 =for hackers
 Found in file sv.c
 
+=item sv_realpath
+
+Emulate realpath(3)
+
+XXX: add configure test for realpath(3) and prefer if available
+	int	sv_realpath(SV* sv, char *path, STRLEN len)
+
+=for hackers
+Found in file util.c
+
 =item sv_reftype
 
 Returns a string describing what the SV is a reference to.
diff --git a/proto.h b/proto.h
index c824a79c06..5104261810 100644
--- a/proto.h
+++ b/proto.h
@@ -752,6 +752,7 @@ PERL_CALLCONV I32	Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2);
 PERL_CALLCONV char*	Perl_sv_collxfrm(pTHX_ SV* sv, STRLEN* nxp);
 #endif
 PERL_CALLCONV OP*	Perl_sv_compile_2op(pTHX_ SV* sv, OP** startp, char* code, AV** avp);
+PERL_CALLCONV int	Perl_sv_getcwd(pTHX_ SV* sv);
 PERL_CALLCONV void	Perl_sv_dec(pTHX_ SV* sv);
 PERL_CALLCONV void	Perl_sv_dump(pTHX_ SV* sv);
 PERL_CALLCONV bool	Perl_sv_derived_from(pTHX_ SV* sv, const char* name);
@@ -776,6 +777,7 @@ PERL_CALLCONV void	Perl_sv_pos_b2u(pTHX_ SV* sv, I32* offsetp);
 PERL_CALLCONV char*	Perl_sv_pvn_force(pTHX_ SV* sv, STRLEN* lp);
 PERL_CALLCONV char*	Perl_sv_pvutf8n_force(pTHX_ SV* sv, STRLEN* lp);
 PERL_CALLCONV char*	Perl_sv_pvbyten_force(pTHX_ SV* sv, STRLEN* lp);
+PERL_CALLCONV int	Perl_sv_realpath(pTHX_ SV* sv, char *path, STRLEN len);
 PERL_CALLCONV char*	Perl_sv_reftype(pTHX_ SV* sv, int ob);
 PERL_CALLCONV void	Perl_sv_replace(pTHX_ SV* sv, SV* nsv);
 PERL_CALLCONV void	Perl_sv_report_used(pTHX);
diff --git a/util.c b/util.c
index 9a3ff31a06..06c355181b 100644
--- a/util.c
+++ b/util.c
@@ -4421,3 +4421,269 @@ Perl_my_strftime(pTHX_ char *fmt, int sec, int min, int hour, int mday, int mon,
 #endif
 }
 
+
+#define SV_CWD_RETURN_UNDEF \
+sv_setsv(sv, &PL_sv_undef); \
+return FALSE
+
+#define SV_CWD_ISDOT(dp) \
+    (dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || \
+        (dp->d_name[1] == '.' && dp->d_name[2] == '\0')))
+
+/*
+=for apidoc sv_getcwd
+
+Fill the sv with current working directory
+
+=cut
+*/
+
+/* Originally written in Perl by John Bazik; rewritten in C by Ben Sugars.
+ * rewritten again by dougm, optimized for use with xs TARG, and to prefer
+ * getcwd(3) if available
+ * Comments from the orignal:
+ *     This is a faster version of getcwd.  It's also more dangerous
+ *     because you might chdir out of a directory that you can't chdir
+ *     back into. */
+
+/* XXX: this needs more porting #ifndef HAS_GETCWD */
+int
+Perl_sv_getcwd(pTHX_ register SV *sv)
+{
+#ifndef HAS_GETCWD
+    struct stat statbuf;
+    int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
+    int namelen, pathlen=0;
+    DIR *dir;
+    Direntry_t *dp;
+#endif
+
+    (void)SvUPGRADE(sv, SVt_PV);
+
+#ifdef HAS_GETCWD
+
+    SvGROW(sv, 128);
+    while ((getcwd(SvPVX(sv), SvLEN(sv)-1) == NULL) && errno == ERANGE) {
+        SvGROW(sv, SvLEN(sv) + 128);
+    }
+    SvCUR_set(sv, strlen(SvPVX(sv)));
+    SvPOK_only(sv);
+
+#else
+
+    if (PerlLIO_lstat(".", &statbuf) < 0) {
+        CWDXS_RETURN_SVUNDEF(sv);
+    }
+
+    orig_cdev = statbuf.st_dev;
+    orig_cino = statbuf.st_ino;
+    cdev = orig_cdev;
+    cino = orig_cino;
+
+    for (;;) {
+        odev = cdev;
+        oino = cino;
+
+        if (PerlDir_chdir("..") < 0) {
+            SV_CWD_RETURN_UNDEF;
+        }
+        if (PerlLIO_stat(".", &statbuf) < 0) {
+            SV_CWD_RETURN_UNDEF;
+        }
+
+        cdev = statbuf.st_dev;
+        cino = statbuf.st_ino;
+
+        if (odev == cdev && oino == cino) {
+            break;
+        }
+        if (!(dir = PerlDir_open("."))) {
+            SV_CWD_RETURN_UNDEF;
+        }
+
+        while ((dp = PerlDir_read(dir)) != NULL) {
+#ifdef DIRNAMLEN
+            namelen = dp->d_namlen;
+#else
+            namelen = strlen(dp->d_name);
+#endif
+            /* skip . and .. */
+            if (SV_CWD_ISDOT(dp)) {dp->d_name[0] == '.'
+                continue;
+            }
+
+            if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
+                SV_CWD_RETURN_UNDEF;
+            }
+
+            tdev = statbuf.st_dev;
+            tino = statbuf.st_ino;
+            if (tino == oino && tdev == odev) {
+                break;
+            }
+        }
+
+        if (!dp) {
+            SV_CWD_RETURN_UNDEF;
+        }
+
+        SvGROW(sv, pathlen + namelen + 1);
+
+        if (pathlen) {
+            /* shift down */
+            Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
+        }
+
+        /* prepend current directory to the front */
+        *SvPVX(sv) = '/';
+        Move(dp->d_name, SvPVX(sv)+1, namelen, char);
+        pathlen += (namelen + 1);
+
+#ifdef VOID_CLOSEDIR
+        PerlDir_close(dir);
+#else
+        if (PerlDir_close(dir) < 0) {
+            SV_CWD_RETURN_UNDEF;
+        }
+#endif
+    }
+
+    SvCUR_set(sv, pathlen);
+    *SvEND(sv) = '\0';
+    SvPOK_only(sv);
+
+    if (PerlDir_chdir(SvPVX(sv)) < 0) {
+        SV_CWD_RETURN_UNDEF;
+    }
+    if (PerlLIO_stat(".", &statbuf) < 0) {
+        SV_CWD_RETURN_UNDEF;
+    }
+
+    cdev = statbuf.st_dev;
+    cino = statbuf.st_ino;
+
+    if (cdev != orig_cdev || cino != orig_cino) {
+        Perl_croak(aTHX_ "Unstable directory path, "
+                   "current directory changed unexpectedly");
+    }
+#endif
+
+    return TRUE;
+}
+
+/*
+=for apidoc sv_realpath
+
+Emulate realpath(3)
+
+XXX: add configure test for realpath(3) and prefer if available
+=cut
+ */
+int
+Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN len)
+{
+    DIR *parent;
+    Direntry_t *dp;
+    char dotdots[MAXPATHLEN] = { 0 };
+    char name[MAXPATHLEN]    = { 0 };
+    int namelen = 0, pathlen = 0;
+    struct stat cst, pst, tst;
+
+    if (PerlLIO_stat(path, &cst) < 0) {
+        Perl_warn(aTHX_ "sv_realpath: stat(\"%s\"): %s",
+                  path, Strerror(errno));
+        SV_CWD_RETURN_UNDEF;
+    }
+
+    (void)SvUPGRADE(sv, SVt_PV);
+
+    if (!len) {
+        len = strlen(path);
+    }
+    Copy(path, dotdots, len, char);
+
+    for (;;) {
+        strcat(dotdots, "/..");
+        StructCopy(&cst, &pst, struct stat);
+
+        if (PerlLIO_stat(dotdots, &cst) < 0) {
+            Perl_warn(aTHX_ "sv_realpath: stat(\"%s\"): %s",
+                      dotdots, Strerror(errno));
+            SV_CWD_RETURN_UNDEF;
+        }
+    
+        if (pst.st_dev == cst.st_dev && pst.st_ino == cst.st_ino) {
+            /* We've reached the root: previous is same as current */
+            break;
+        } else {
+            STRLEN dotdotslen = strlen(dotdots);
+
+            /* Scan through the dir looking for name of previous */
+            if (!(parent = PerlDir_open(dotdots))) {
+                Perl_warn(aTHX_ "sv_realpath: opendir(\"%s\"): %s",
+                          dotdots, Strerror(errno));
+                SV_CWD_RETURN_UNDEF;
+            }
+    
+            SETERRNO(0,SS$_NORMAL); /* for readdir() */
+            while ((dp = PerlDir_read(parent)) != NULL) {
+                if (SV_CWD_ISDOT(dp)) {
+                    continue;
+                }
+        
+                Copy(dotdots, name, dotdotslen, char);
+                name[dotdotslen] = '/';
+#ifdef DIRNAMLEN
+                namelen = dp->d_namlen;
+#else
+                namelen = strlen(dp->d_name);
+#endif
+                Copy(dp->d_name, name + dotdotslen + 1, namelen, char);
+                name[dotdotslen + 1 + namelen] = 0;
+        
+                if (PerlLIO_lstat(name, &tst) < 0) {
+                    PerlDir_close(parent);
+                    Perl_warn(aTHX_ "sv_realpath: lstat(\"%s\"): %s",
+                              name, Strerror(errno));
+                    SV_CWD_RETURN_UNDEF;
+                }
+        
+                if (tst.st_dev == pst.st_dev && tst.st_ino == pst.st_ino)
+                    break;
+
+                SETERRNO(0,SS$_NORMAL); /* for readdir() */
+            }
+
+            if (!dp && errno) {
+                Perl_warn(aTHX_ "sv_realpath: readdir(\"%s\"): %s",
+                          dotdots, Strerror(errno));
+                SV_CWD_RETURN_UNDEF;
+            }
+
+            SvGROW(sv, pathlen + namelen + 1);
+            if (pathlen) {
+                /* shift down */
+                Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
+            }
+
+            *SvPVX(sv) = '/';
+            Move(dp->d_name, SvPVX(sv)+1, namelen, char);
+            pathlen += (namelen + 1);
+
+#ifdef VOID_CLOSEDIR
+            PerlDir_close(parent);
+#else
+            if (PerlDir_close(parent) < 0) {
+                Perl_warn(aTHX_ "sv_realpath: closedir(\"%s\"): %s",
+                          dotdots, Strerror(errno));
+                SV_CWD_RETURN_UNDEF;
+            }
+#endif
+        }
+    }
+
+    SvCUR_set(sv, pathlen);
+    SvPOK_only(sv);
+
+    return TRUE;
+}