X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=epoc%2Fepoc.c;h=b9bc652c22f71d023d37b3adce6216d870f24695;hb=77003bb1f5b79e478d4e39dbf22a7d33aacd2fd5;hp=498036dbc041713128b34ab99e4a4b413adada16;hpb=146174a91a192983720a158796dc066226ad0e55;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/epoc/epoc.c b/epoc/epoc.c
index 498036d..b9bc652 100644
--- a/epoc/epoc.c
+++ b/epoc/epoc.c
@@ -58,6 +58,7 @@ Perl_epoc_init(int *argcp, char ***argvp) {
 
 }
 
+
 #ifdef __MARM__
 /* Symbian forgot to include __fixunsdfi into the MARM euser.lib */
 /* This is from libgcc2.c , gcc-2.7.2.3                          */
@@ -86,6 +87,8 @@ __fixunsdfsi (a)
   return (SItype) a;
 }
 
+#endif
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -98,7 +101,6 @@ do_aspawn( pTHX_ SV *really,SV **mark,SV **sp) {
 int
 do_spawn (pTHX_ SV *really,SV **mark,SV **sp)
 {
-    dTHR;
     int  rc;
     char **a,*cmd,**ptr, *cmdline, **argv, *p2; 
     STRLEN n_a;
@@ -143,5 +145,64 @@ do_spawn (pTHX_ SV *really,SV **mark,SV **sp)
     return rc;
 }
 
- 
-#endif
+static
+XS(epoc_getcwd)   /* more or less stolen from win32.c */
+{
+    dXSARGS;
+    /* Make the host for current directory */
+    char *buffer; 
+    int buflen = 256;
+
+    char *ptr;
+    buffer = (char *) malloc( buflen);
+    if (buffer == NULL) {
+      XSRETURN_UNDEF;
+    }
+    while ((NULL == ( ptr = getcwd( buffer, buflen))) && (errno == ERANGE)) {
+      buflen *= 2;
+      if (NULL == realloc( buffer, buflen)) {
+	 XSRETURN_UNDEF;
+      }
+      
+    }
+
+    /* 
+     * If ptr != Nullch 
+     *   then it worked, set PV valid, 
+     *   else return 'undef' 
+     */
+
+    if (ptr) {
+	SV *sv = sv_newmortal();
+	char *tptr;
+
+	for (tptr = ptr; *tptr != '\0'; tptr++) {
+	  if (*tptr == '\\') {
+	    *tptr = '/';
+	  }
+	}
+	sv_setpv(sv, ptr);
+	free( buffer);
+
+	EXTEND(SP,1);
+	SvPOK_on(sv);
+	ST(0) = sv;
+	XSRETURN(1);
+    }
+    free( buffer);
+    XSRETURN_UNDEF;
+}
+  
+
+void
+Perl_init_os_extras(void)
+{ 
+  dTHXo;
+  char *file = __FILE__;
+  newXS("EPOC::getcwd", epoc_getcwd, file);
+}
+
+void
+Perl_my_setenv(pTHX_ char *nam,char *val) {
+  setenv( nam, val, 1);
+}