DJGPP patches from Laszlo Molnar.

[p5sagit/p5-mst-13.2.git] / djgpp / djgpp.c

diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c
index 466b4ab..f235421 100644 (file)
--- a/djgpp/djgpp.c
+++ b/djgpp/djgpp.c
@@ -1,3 +1,4 @@
+#define PERLIO_NOT_STDIO 0
 #include <libc/stubs.h>
 #include <io.h>
 #include <errno.h>
@@ -27,7 +28,7 @@ struct pipe_list {
 static struct pipe_list *pl = NULL;
 
 FILE *
-popen (const char *cm, const char *md) /* program name, pipe mode */
+djgpp_popen (const char *cm, const char *md) /* program name, pipe mode */
 {
   struct pipe_list *l1;
   int fd;
@@ -75,7 +76,7 @@ popen (const char *cm, const char *md) /* program name, pipe mode */
 }
 
 int
-pclose (FILE *pp)
+djgpp_pclose (FILE *pp)
 {
   struct pipe_list *l1, **l2;   /* list pointers */
   int retval=-1;               /* function return value */
@@ -117,23 +118,22 @@ pclose (FILE *pp)
 #define EXECF_EXEC 1
 
 static int
-convretcode (int rc,char *prog,int fl)
+convretcode (pTHX_ int rc,char *prog,int fl)
 {
-    if (rc < 0 && dowarn)
-        warn ("Can't %s \"%s\": %s",fl ? "exec" : "spawn",prog,Strerror (errno));
-    if (rc > 0)
-        return rc <<= 8;
-    if (rc < 0)
-        return 255 << 8;
-    return 0;
+    if (rc < 0 && ckWARN(WARN_EXEC))
+        Perl_warner(aTHX_ WARN_EXEC,"Can't %s \"%s\": %s",
+                   fl ? "exec" : "spawn",prog,Strerror (errno));
+    if (rc >= 0)
+        return rc << 8;
+    return -1;
 }
 
 int
-do_aspawn (SV *really,SV **mark,SV **sp)
+do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
 {
-    dTHR;
     int  rc;
     char **a,*tmps,**argv; 
+    STRLEN n_a;
 
     if (sp<=mark)
         return -1;
@@ -141,7 +141,7 @@ do_aspawn (SV *really,SV **mark,SV **sp)
 
     while (++mark <= sp)
         if (*mark)
-            *a++ = SvPVx(*mark, na);
+            *a++ = SvPVx(*mark, n_a);
         else
             *a++ = "";
     *a = Nullch;
@@ -152,7 +152,7 @@ do_aspawn (SV *really,SV **mark,SV **sp)
      ) /* will swawnvp use PATH? */
          TAINT_ENV();  /* testing IFS here is overkill, probably */
 
-    if (really && *(tmps = SvPV(really, na)))
+    if (really && *(tmps = SvPV(really, n_a)))
         rc=spawnvp (P_WAIT,tmps,argv);
     else
         rc=spawnvp (P_WAIT,argv[0],argv);
@@ -163,7 +163,7 @@ do_aspawn (SV *really,SV **mark,SV **sp)
 #define EXTRA "\x00\x00\x00\x00\x00\x00"
 
 int
-do_spawn2 (char *cmd,int execf)
+do_spawn2 (pTHX_ char *cmd,int execf)
 {
     char **a,*s,*shell,*metachars;
     int  rc,unixysh;
@@ -208,10 +208,10 @@ doshell:
             return convretcode (system (cmd),cmd,execf);
        }
 
-    New (1303,Argv,(s-cmd)/2+2,char*);
-    Cmd=savepvn (cmd,s-cmd);
-    a=Argv;
-    for (s=Cmd; *s;) {
+    New (1303,PL_Argv,(s-cmd)/2+2,char*);
+    PL_Cmd=savepvn (cmd,s-cmd);
+    a=PL_Argv;
+    for (s=PL_Cmd; *s;) {
        while (*s && isSPACE (*s)) s++;
        if (*s)
            *(a++)=s;
@@ -220,26 +220,26 @@ doshell:
            *s++='\0';
     }
     *a=Nullch;
-    if (!Argv[0])
+    if (!PL_Argv[0])
         return -1;
 
     if (execf==EXECF_EXEC)
-        rc=execvp (Argv[0],Argv);
+        rc=execvp (PL_Argv[0],PL_Argv);
     else
-        rc=spawnvp (P_WAIT,Argv[0],Argv);
-    return convretcode (rc,Argv[0],execf);
+        rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv);
+    return convretcode (rc,PL_Argv[0],execf);
 }
 
 int
-do_spawn (char *cmd)
+do_spawn (pTHX_ char *cmd)
 {
-    return do_spawn2 (cmd,EXECF_SPAWN);
+    return do_spawn2 (aTHX_ cmd,EXECF_SPAWN);
 }
 
 bool
-do_exec (char *cmd)
+Perl_do_exec (pTHX_ char *cmd)
 {
-    do_spawn2 (cmd,EXECF_EXEC);
+    do_spawn2 (aTHX_ cmd,EXECF_EXEC);
     return FALSE;
 }
 
@@ -250,6 +250,7 @@ struct globinfo
     int    fd;
     char   *matches;
     size_t size;
+    fpos_t pos;
 };
 
 #define MAXOPENGLOBS 10
@@ -284,6 +285,7 @@ glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
             if ((gi=searchfd (-1)) == NULL)
                 break;
 
+            gi->pos=0;
             pattern=alloca (strlen (name+=13)+1);
             strcpy (pattern,name);
             if (!_USE_LFN)
@@ -330,11 +332,10 @@ glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
             if ((gi=searchfd (fd))==NULL)
                 break;
 
-            ic=tell (fd);
-            if (siz+ic>=gi->size)
-                siz=gi->size-ic;
-            memcpy (buf,ic+gi->matches,siz);
-            lseek (fd,siz,1);
+            if (siz+gi->pos > gi->size)
+                siz = gi->size - gi->pos;
+            memcpy (buf,gi->pos+gi->matches,siz);
+            gi->pos += siz;
             *rv=siz;
             return 1;
         }
@@ -360,7 +361,7 @@ XS(dos_GetCwd)
     dXSARGS;
 
     if (items)
-        croak ("Usage: Dos::GetCwd()");
+        Perl_croak (aTHX_ "Usage: Dos::GetCwd()");
     {
         char tmp[PATH_MAX+2];
         ST(0)=sv_newmortal ();
@@ -378,7 +379,7 @@ XS(dos_UseLFN)
 }
 
 void
-init_os_extras()
+Perl_init_os_extras(pTHX)
 {
     char *file = __FILE__;
 
@@ -432,3 +433,22 @@ Perl_DJGPP_init (int *argcp,char ***argvp)
         strcpy (perlprefix,"..");
 }
 
+int
+djgpp_fflush (FILE *fp)
+{
+    int res;
+
+    if ((res = fflush(fp)) == 0 && fp) {
+       Stat_t s;
+       if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
+           res = fsync(fileno(fp));
+    }
+/*
+ * If the flush succeeded but set end-of-file, we need to clear
+ * the error because our caller may check ferror().  BTW, this
+ * probably means we just flushed an empty file.
+ */
+    if (res == 0 && fp && ferror(fp) == EOF) clearerr(fp);
+
+    return res;
+}