This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make a new section for vars related to interpreter state
[perl5.git] / djgpp / djgpp.c
index 73573c3..9370a29 100644 (file)
@@ -1,20 +1,5 @@
 #define PERLIO_NOT_STDIO 0
-#include <libc/stubs.h>
-#include <io.h>
-#include <errno.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <unistd.h>
-#include <libc/file.h>
-#include <process.h>
-#include <fcntl.h>
-#include <glob.h>
-#include <sys/fsext.h>
-#include <crt0.h>
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
+#include "djgpp.h"
 
 /* hold file pointer, command, mode, and the status of the command */
 struct pipe_list {
@@ -121,7 +106,7 @@ static int
 convretcode (pTHX_ int rc,char *prog,int fl)
 {
     if (rc < 0 && ckWARN(WARN_EXEC))
-        Perl_warner(aTHX_ WARN_EXEC,"Can't %s \"%s\": %s",
+        Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't %s \"%s\": %s",
                    fl ? "exec" : "spawn",prog,Strerror (errno));
     if (rc >= 0)
         return rc << 8;
@@ -144,7 +129,7 @@ do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
             *a++ = SvPVx(*mark, n_a);
         else
             *a++ = "";
-    *a = Nullch;
+    *a = NULL;
 
     if (argv[0][0] != '/' && argv[0][0] != '\\'
         && !(argv[0][0] && argv[0][1] == ':'
@@ -208,7 +193,7 @@ doshell:
             return convretcode (system (cmd),cmd,execf);
        }
 
-    New (1303,PL_Argv,(s-cmd)/2+2,char*);
+    Newx (PL_Argv,(s-cmd)/2+2,char*);
     PL_Cmd=savepvn (cmd,s-cmd);
     a=PL_Argv;
     for (s=PL_Cmd; *s;) {
@@ -219,7 +204,7 @@ doshell:
        if (*s)
            *s++='\0';
     }
-    *a=Nullch;
+    *a=NULL;
     if (!PL_Argv[0])
         return -1;
 
@@ -237,7 +222,7 @@ do_spawn (pTHX_ char *cmd)
 }
 
 bool
-Perl_do_exec (pTHX_ char *cmd)
+Perl_do_exec (pTHX_ const char *cmd)
 {
     do_spawn2 (aTHX_ cmd,EXECF_EXEC);
     return FALSE;
@@ -381,6 +366,24 @@ XS(dos_UseLFN)
     XSRETURN_IV (_USE_LFN);
 }
 
+XS(XS_Cwd_sys_cwd)
+{
+    dXSARGS;
+    if (items != 0)
+       Perl_croak_nocontext("Usage: Cwd::sys_cwd()");
+    {
+       char p[MAXPATHLEN];
+       char *  RETVAL;
+       RETVAL = getcwd(p, MAXPATHLEN);
+       ST(0) = sv_newmortal();
+       sv_setpv((SV*)ST(0), RETVAL);
+#ifndef INCOMPLETE_TAINTS
+       SvTAINTED_on(ST(0));
+#endif
+    }
+    XSRETURN(1);
+}
+
 void
 Perl_init_os_extras(pTHX)
 {
@@ -390,6 +393,7 @@ Perl_init_os_extras(pTHX)
     
     newXS ("Dos::GetCwd",dos_GetCwd,file);
     newXS ("Dos::UseLFN",dos_UseLFN,file);
+    newXS ("Cwd::sys_cwd",XS_Cwd_sys_cwd,file);
 
     /* install my File System Extension for globbing */
     __FSEXT_add_open_handler (glob_handler);
@@ -400,7 +404,8 @@ static char *perlprefix;
 
 #define PERL5 "/perl5"
 
-char *djgpp_pathexp (const char *p)
+char *
+djgpp_pathexp (const char *p)
 {
     static char expp[PATH_MAX];
     strcpy (expp,perlprefix);
@@ -455,3 +460,16 @@ djgpp_fflush (FILE *fp)
 
     return res;
 }
+
+int djgpp_get_stream_mode(FILE *f)
+{
+    extern char *__file_handle_modes;
+
+    int mode = __file_handle_modes[fileno(f)];
+    if (f->_flag & _IORW)
+        return mode | O_RDWR;
+    if (f->_flag & _IOWRT)
+        return mode | O_WRONLY;
+    return mode | O_RDONLY;
+}
+