amigaos4: install scripts

[perl5.git] / util.c

diff --git a/util.c b/util.c
index 668cbe1..b5f04a5 100644 (file)
--- a/util.c
+++ b/util.c
@@ -45,6 +45,10 @@
 int putenv(char *);
 #endif
 
+#ifdef __amigaos__
+# include "amigaos4/amigaio.h"
+#endif
+
 #ifdef HAS_SELECT
 # ifdef I_SYS_SELECT
 #  include <sys/select.h>
@@ -1445,7 +1449,8 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume)
 =for apidoc Am|SV *|vmess|const char *pat|va_list *args
 
 C<pat> and C<args> are a sprintf-style format pattern and encapsulated
-argument list.  These are used to generate a string message.  If the
+argument list, respectively.  These are used to generate a string message.  If
+the
 message does not end with a newline, then it will be extended with
 some indication of the current location in the code, as described for
 L</mess_sv>.
@@ -2050,6 +2055,9 @@ void
 Perl_my_setenv(pTHX_ const char *nam, const char *val)
 {
   dVAR;
+#if defined(__amigaos4__)
+  amigaos4_obtain_environ(__FUNCTION__);
+#endif
 #ifdef USE_ITHREADS
   /* only parent thread can modify process environment */
   if (PL_curinterp == aTHX)
@@ -2091,7 +2099,11 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
                 environ[i] = environ[i+1];
                 i++;
             }
+#if defined(__amigaos4__)
+            goto my_setenv_out;
+#else
             return;
+#endif
         }
         if (!environ[i]) {                 /* does not exist yet */
             environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*));
@@ -2152,6 +2164,10 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
     }
 #endif
   }
+#if defined(__amigaos4__)
+my_setenv_out:
+  amigaos4_release_environ(__FUNCTION__);
+#endif
 }
 
 #else /* WIN32 || NETWARE */
@@ -2330,7 +2346,7 @@ vsprintf(char *dest, const char *pat, void *args)
 PerlIO *
 Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
 {
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__)
+#if (!defined(DOSISH) || defined(HAS_FORK)) && !defined(OS2) && !defined(VMS) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__) && !defined(__amigaos4__)
     int p[2];
     I32 This, that;
     Pid_t pid;
@@ -2468,8 +2484,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
 #endif
 }
 
-    /* VMS' my_popen() is in VMS.c, same with OS/2. */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__LIBCATAMOUNT__)
+    /* VMS' my_popen() is in VMS.c, same with OS/2 and AmigaOS 4. */
+#if (!defined(DOSISH) || defined(HAS_FORK)) && !defined(VMS) && !defined(__LIBCATAMOUNT__) && !defined(__amigaos4__)
 PerlIO *
 Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 {
@@ -2689,6 +2705,8 @@ Perl_my_fork(void)
     pid = fork();
 #endif
     return pid;
+#elif defined(__amigaos4__)
+    return amigaos_fork();
 #else
     /* this "canna happen" since nothing should be calling here if !HAS_FORK */
     Perl_croak_nocontext("fork() not available");
@@ -2888,7 +2906,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
 #endif /* !PERL_MICRO */
 
     /* VMS' my_pclose() is in VMS.c; same with OS/2 */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__LIBCATAMOUNT__)
+#if (!defined(DOSISH) || defined(HAS_FORK)) && !defined(VMS) && !defined(__LIBCATAMOUNT__) && !defined(__amigaos4__)
 I32
 Perl_my_pclose(pTHX_ PerlIO *ptr)
 {
@@ -3048,7 +3066,10 @@ S_pidgone(pTHX_ Pid_t pid, int status)
 }
 #endif
 
-#if defined(OS2)
+#if defined(OS2) || defined(__amigaos4__)
+#  if defined(__amigaos4__) && defined(pclose)
+#    undef pclose
+#  endif
 int pclose();
 #ifdef HAS_FORK
 int                                    /* Cannot prototype with I32
@@ -4529,7 +4550,11 @@ Perl_seed(pTHX)
     * if there isn't enough entropy available.  You can compile with
     * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
     * is enough real entropy to fill the seed. */
-#  define PERL_RANDOM_DEVICE "/dev/urandom"
+#  ifdef __amigaos4__
+#    define PERL_RANDOM_DEVICE "RANDOM:SIZE=4"
+#  else
+#    define PERL_RANDOM_DEVICE "/dev/urandom"
+#  endif
 #endif
     fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
     if (fd != -1) {
@@ -4948,7 +4973,7 @@ Perl_my_sprintf(char *buffer, const char* pat, ...)
 =for apidoc quadmath_format_single
 
 C<quadmath_snprintf()> is very strict about its C<format> string and will
-fail, returning -1, if the format is invalid.  It acccepts exactly
+fail, returning -1, if the format is invalid.  It accepts exactly
 one format spec.
 
 C<quadmath_format_single()> checks that the intended single spec looks