eliminate PL_regprecomp, PL_regprogram, PL_regnpar and PL_regdata

[perl5.git] / epoc / epoc.c

diff --git a/epoc/epoc.c b/epoc/epoc.c
index 498036d..d580552 100644 (file)
--- a/epoc/epoc.c
+++ b/epoc/epoc.c
@@ -10,138 +10,116 @@
 #include <string.h>
 #include <stdio.h>
 #include <sys/unistd.h>
+#include <process.h>
 
-void
-Perl_epoc_init(int *argcp, char ***argvp) {
-  int i;
-  int truecount=0;
-  char **lastcp = (*argvp);
-  char *ptr;
-  for (i=0; i< *argcp; i++) {
-    if ((*argvp)[i]) {
-      if (*((*argvp)[i]) == '<') {
-       if (strlen((*argvp)[i]) > 1) {
-         ptr =((*argvp)[i])+1;
-       } else {
-         i++;
-         ptr = ((*argvp)[i]);
-       }
-       freopen(  ptr, "r", stdin);
-      } else if (*((*argvp)[i]) == '>') {
-       if (strlen((*argvp)[i]) > 1) {
-         ptr =((*argvp)[i])+1;
-       } else {
-         i++;
-         ptr = ((*argvp)[i]);
-       }
-       freopen(  ptr, "w", stdout);
-      } else if ((*((*argvp)[i]) == '2') && (*(((*argvp)[i])+1) == '>')) {
-       if (strcmp( (*argvp)[i], "2>&1") == 0) {
-         dup2( fileno( stdout), fileno( stderr));
-       } else {
-          if (strlen((*argvp)[i]) > 2) {
-            ptr =((*argvp)[i])+2;
-         } else {
-           i++;
-           ptr = ((*argvp)[i]);
-         }
-         freopen(  ptr, "w", stderr);
-       }
-      } else {
-       *lastcp++ = (*argvp)[i];
-       truecount++;
-      }
-    } 
-  }
-  *argcp=truecount;
-      
-
-}
-
-#ifdef __MARM__
-/* Symbian forgot to include __fixunsdfi into the MARM euser.lib */
-/* This is from libgcc2.c , gcc-2.7.2.3                          */
-
-typedef unsigned int UQItype   __attribute__ ((mode (QI)));
-typedef         int SItype     __attribute__ ((mode (SI)));
-typedef unsigned int USItype   __attribute__ ((mode (SI)));
-typedef                 int DItype     __attribute__ ((mode (DI)));
-typedef unsigned int UDItype   __attribute__ ((mode (DI)));
-
-typedef        float SFtype    __attribute__ ((mode (SF)));
-typedef                float DFtype    __attribute__ ((mode (DF)));
-
-
-
-extern DItype __fixunssfdi (SFtype a);
-extern DItype __fixunsdfdi (DFtype a);
-
-
-USItype
-__fixunsdfsi (a)
-     DFtype a;
-{
-  if (a >= - (DFtype) (- 2147483647L  -1) )
-    return (SItype) (a + (- 2147483647L  -1) ) - (- 2147483647L  -1) ;
-  return (SItype) a;
-}
 
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 
 int 
-do_aspawn( pTHX_ SV *really,SV **mark,SV **sp) {
-  return do_spawn( really, mark, sp);
+do_spawn( char *cmd) {
+    dTHX;
+    return system( cmd);
 }
 
 int
-do_spawn (pTHX_ SV *really,SV **mark,SV **sp)
-{
-    dTHR;
+do_aspawn ( void *vreally, void **vmark, void **vsp) {
+
+    dTHX;
+
+    SV *really = (SV*)vreally;
+    SV **mark = (SV**)vmark;
+    SV **sp = (SV**)vsp;
+
+    char **argv;
+    char *str;
+    char *p2, **ptr;
+    char *cmd;
+
+
     int  rc;
-    char **a,*cmd,**ptr, *cmdline, **argv, *p2; 
-    STRLEN n_a;
-    size_t len = 0;
+    int index = 0;
 
     if (sp<=mark)
       return -1;
     
-    a=argv=ptr=(char**) malloc ((sp-mark+3)*sizeof (char*));
+    ptr = argv =(char**) malloc ((sp-mark+3)*sizeof (char*));
     
     while (++mark <= sp) {
-      if (*mark)
-       *a = SvPVx(*mark, n_a);
+      if (*mark && (str = SvPV_nolen(*mark)))
+       argv[index] = str;
       else
-       *a = "";
-      len += strlen( *a) + 1;
-      a++;
+       argv[index] = "";
     }
-    *a = Nullch;
+    argv[index++] = 0;
 
-    if (!(really && *(cmd = SvPV(really, n_a)))) {
-      cmd = argv[0];
-      argv++;
+    cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0]));
+
+    rc = spawnvp( P_WAIT, cmd, argv);
+    free( argv);
+    free( cmd);
+
+    return rc;
+}
+
+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;
+      }
       
-    cmdline = (char * ) malloc( len + 1);
-    cmdline[ 0] = '\0';
-    while (*argv != NULL) {
-      strcat( cmdline, *argv++);
-      strcat( cmdline, " ");
     }
 
-    for (p2=cmd; *p2 != '\0'; p2++) {
-      /* Change / to \ */
-      if ( *p2 == '/') 
-       *p2 = '\\';
+    /* 
+     * 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;
+#ifndef INCOMPLETE_TAINTS
+       SvTAINTED_on(ST(0));
+#endif
+       XSRETURN(1);
     }
-    rc = epoc_spawn( cmd, cmdline);
-    free( ptr);
-    free( cmdline);
-    
-    return rc;
+    free( buffer);
+    XSRETURN_UNDEF;
+}
+  
+
+void
+Perl_init_os_extras(void)
+{ 
+  dTHX;
+  char *file = __FILE__;
+  newXS("EPOC::getcwd", epoc_getcwd, file);
 }
 
- 
-#endif