develooper Front page | perl.perl5.porters | Postings from April 2007

[PATCH] patching for sunos

Thread Next
From:
Heiko
Date:
April 12, 2007 00:54
Subject:
[PATCH] patching for sunos
Message ID:
461D2A86.1030809@hexco.de
Hi coders,

greetings from the stone age:

This is perl, v5.9.4 built for sun4-sunos-stdio

SunOS Release 4.1.3 (GENERIC) #3: Mon Jul 27 16:44:16 PDT 1992
$ uname -a
SunOS xxx 4.1.3 3 sun4m


If anyone is interested in patches for SunOS yet, I have some.
Some are harmless, some may not be optimal. Help/hints/tips are
always nice and appreciated.

1. SunOS realloc() does not like NULL pointers as parameters.
    (buf?realloc((buf), (size)):malloc((size)))

2. There is no strtoul(), alas. Some older code correctly uses the
Strtoul() macro (capital S). Newer additions don't always (probabaly
nobody noticed). I enclosed the expansion of the Strtoul macro definition
in round parentheses:
#   define Strtoul(s, e, b)    (strchr((s), '-') ? ULONG_MAX : (unsigned 
long)strtol((s), (e), (b)))
and changed all occurences of strtoul() to Strtoul().

3. There is no prototype for drand48() available, although one is needed.
This cures the previously failing sort and shuffle tests.
#ifndef HAS_DRAND48_PROTO
  extern double drand48 (void);
#endif

4. For the generation of miniperl I had to do something about div_t and 
div(),
which are lacking. It is used for version string formatting. Since I 
considered
this usage not the most time critical, I replaced the div() call with 
the good old
/ and % operators.
Perl_sv_catpvf(aTHX_ sv, "%0*d_%d", width, (int)PERL_ABS(digit) / denom, 
(int)PERL_ABS(digit) % denom);

5. snprintf() is missing, so vsprintf() is used to emulate it. But 
vsprintf() like sprintf()
has a non standard return type (the buffer instead of the length of 
characters output).
sprintf() was treated ok by the older code parts, vsprintf was not. I 
think my patch
is not optimal, it was a bit quick-and-dirty.

6. Finally Dynaloading. I saw it does not work in 5.9.4. (and also not 
since 5.8.1 according to
the hints file). So I peeked in version 5.6.3 and changed the return 
types for dl_load_file() and
dl_find_symbol() in dl_open.xs back to the previously working return 
types (void *). Since I
don't know why they were changed (to void), I suspect the best solution 
is to have a seperate dl_sunos.xs.
This is work in progress so no patch yet.

Hope this is useful,
Heiko

diff -r -c perl-5.9.4/iperlsys.h perl-5.9.4-patched/iperlsys.h
*** perl-5.9.4/iperlsys.h    Tue Aug 15 14:37:41 2006
--- perl-5.9.4-patched/iperlsys.h    Mon Apr  2 20:04:53 2007
***************
*** 875,881 ****
 
  /* Interpreter specific memory macros */
  #define PerlMem_malloc(size)        malloc((size))
! #define PerlMem_realloc(buf, size)    realloc((buf), (size))
  #define PerlMem_free(buf)        free((buf))
  #define PerlMem_calloc(num, size)    calloc((num), (size))
  #define PerlMem_get_lock()       
--- 875,881 ----
 
  /* Interpreter specific memory macros */
  #define PerlMem_malloc(size)        malloc((size))
! #define PerlMem_realloc(buf, size)    (buf?realloc((buf), 
(size)):malloc((size)))
  #define PerlMem_free(buf)        free((buf))
  #define PerlMem_calloc(num, size)    calloc((num), (size))
  #define PerlMem_get_lock()       
***************
*** 884,890 ****
 
  /* Shared memory macros */
  #define PerlMemShared_malloc(size)        malloc((size))
! #define PerlMemShared_realloc(buf, size)    realloc((buf), (size))
  #define PerlMemShared_free(buf)            free((buf))
  #define PerlMemShared_calloc(num, size)        calloc((num), (size))
  #define PerlMemShared_get_lock()       
--- 884,890 ----
 
  /* Shared memory macros */
  #define PerlMemShared_malloc(size)        malloc((size))
! #define PerlMemShared_realloc(buf, size)    (buf?realloc((buf), 
(size)):malloc((size)))
  #define PerlMemShared_free(buf)            free((buf))
  #define PerlMemShared_calloc(num, size)        calloc((num), (size))
  #define PerlMemShared_get_lock()       
***************
*** 893,899 ****
 
  /* Parse tree memory macros */
  #define PerlMemParse_malloc(size)    malloc((size))
! #define PerlMemParse_realloc(buf, size)    realloc((buf), (size))
  #define PerlMemParse_free(buf)        free((buf))
  #define PerlMemParse_calloc(num, size)    calloc((num), (size))
  #define PerlMemParse_get_lock()       
--- 893,899 ----
 
  /* Parse tree memory macros */
  #define PerlMemParse_malloc(size)    malloc((size))
! #define PerlMemParse_realloc(buf, size)    (buf?realloc((buf), 
(size)):malloc((size)))
  #define PerlMemParse_free(buf)        free((buf))
  #define PerlMemParse_calloc(num, size)    calloc((num), (size))
  #define PerlMemParse_get_lock()       
diff -r -c perl-5.9.4/perl.h perl-5.9.4-patched/perl.h
*** perl-5.9.4/perl.h    Tue Aug 15 14:37:41 2006
--- perl-5.9.4-patched/perl.h    Tue Apr  3 20:08:05 2007
***************
*** 5166,5172 ****
  #   define Strtoul    strtoul
  #endif
  #if !defined(Strtoul) && defined(HAS_STRTOL) /* Last resort. */
! #   define Strtoul(s, e, b)    strchr((s), '-') ? ULONG_MAX : 
(unsigned long)strtol((s), (e), (b))
  #endif
  #ifndef Atoul
  #   define Atoul(s)    Strtoul(s, NULL, 10)
--- 5166,5172 ----
  #   define Strtoul    strtoul
  #endif
  #if !defined(Strtoul) && defined(HAS_STRTOL) /* Last resort. */
! #   define Strtoul(s, e, b)    (strchr((s), '-') ? ULONG_MAX : 
(unsigned long)strtol((s), (e), (b)))
  #endif
  #ifndef Atoul
  #   define Atoul(s)    Strtoul(s, NULL, 10)
diff -r -c perl-5.9.4/pp_sort.c perl-5.9.4-patched/pp_sort.c
*** perl-5.9.4/pp_sort.c    Tue Aug 15 14:37:41 2006
--- perl-5.9.4-patched/pp_sort.c    Fri Apr  6 17:28:05 2007
***************
*** 28,33 ****
--- 28,37 ----
  #define PERL_IN_PP_SORT_C
  #include "perl.h"
 
+ #ifndef HAS_DRAND48_PROTO
+ extern double drand48 (void);
+ #endif
+
  #if defined(UNDER_CE)
  /* looks like 'small' is reserved word for WINCE (or somesuch)*/
  #define    small xsmall
diff -r -c perl-5.9.4/util.c perl-5.9.4-patched/util.c
*** perl-5.9.4/util.c    Tue Aug 15 14:37:42 2006
--- perl-5.9.4-patched/util.c    Wed Apr 11 00:18:38 2007
***************
*** 45,50 ****
--- 45,54 ----
  # endif
  #endif
 
+ #ifndef HAS_DRAND48_PROTO
+ extern double drand48 (void);
+ #endif
+
  #define FLUSH
 
  #if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC)
***************
*** 4425,4432 ****
      digit = SvIV(*av_fetch(av, i, 0));
      if ( width < 3 ) {
          const int denom = (width == 2 ? 10 : 100);
!         const div_t term = div((int)PERL_ABS(digit),denom);
          Perl_sv_catpvf(aTHX_ sv, "%0*d_%d", width, term.quot, term.rem);
      }
      else {
          Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
--- 4429,4439 ----
      digit = SvIV(*av_fetch(av, i, 0));
      if ( width < 3 ) {
          const int denom = (width == 2 ? 10 : 100);
! /*        const div_t term = div((int)PERL_ABS(digit),denom);
          Perl_sv_catpvf(aTHX_ sv, "%0*d_%d", width, term.quot, term.rem);
+ */
+         Perl_sv_catpvf(aTHX_ sv, "%0*d_%d", width, 
(int)PERL_ABS(digit) / denom, (int)PERL_ABS(digit) % denom);
+
      }
      else {
          Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
***************
*** 5391,5396 ****
--- 5398,5406 ----
      retval = vsnprintf(buffer, len, format, ap);
  #else
      retval = vsprintf(buffer, format, ap);
+     if ((char *) retval == buffer) {
+     retval = strlen(buffer);
+     }
  #endif
      va_end(ap);
      /* vsnprintf() shows failure with >= len, vsprintf() with < 0 */
diff -r -c perl-5.9.4/ext/Digest/SHA/src/sha.c 
perl-5.9.4-patched/ext/Digest/SHA/src/sha.c
*** perl-5.9.4/ext/Digest/SHA/src/sha.c    Tue Aug 15 14:37:40 2006
--- perl-5.9.4-patched/ext/Digest/SHA/src/sha.c    Tue Apr  3 20:07:02 2007
***************
*** 579,587 ****
          if ((p = getval(pr, &pr)) == NULL)
              return(1);
          switch (type) {
!         case T_C: *pc++ = (UCHR) strtoul(p, NULL, base); break;
!         case T_I: *pi++ = (UINT) strtoul(p, NULL, base); break;
!         case T_L: *pl++ = (W32 ) strtoul(p, NULL, base); break;
          case T_Q: *pq++ = (W64 ) strto64(p            ); break;
          }
      }
--- 579,587 ----
          if ((p = getval(pr, &pr)) == NULL)
              return(1);
          switch (type) {
!         case T_C: *pc++ = (UCHR) Strtoul(p, NULL, base); break;
!         case T_I: *pi++ = (UINT) Strtoul(p, NULL, base); break;
!         case T_L: *pl++ = (W32 ) Strtoul(p, NULL, base); break;
          case T_Q: *pq++ = (W64 ) strto64(p            ); break;
          }
      }
diff -r -c perl-5.9.4/ext/Digest/SHA/src/sha64bit.c 
perl-5.9.4-patched/ext/Digest/SHA/src/sha64bit.c
*** perl-5.9.4/ext/Digest/SHA/src/sha64bit.c    Tue Aug 15 14:37:40 2006
--- perl-5.9.4-patched/ext/Digest/SHA/src/sha64bit.c    Tue Apr  3 
20:07:19 2007
***************
*** 72,78 ****
      W64 u = C64(0);
 
      while (isxdigit(str[0] = *s++))
!         u = (u << 4) + strtoul(str, NULL, 16);
      return(u);
  }
 
--- 72,78 ----
      W64 u = C64(0);
 
      while (isxdigit(str[0] = *s++))
!         u = (u << 4) + Strtoul(str, NULL, 16);
      return(u);
  }
diff -r -c perl-5.9.4/ext/List/Util/Util.xs 
perl-5.9.4-patched/ext/List/Util/Util.xs
*** perl-5.9.4/ext/List/Util/Util.xs    Tue Aug 15 14:37:41 2006
--- perl-5.9.4-patched/ext/List/Util/Util.xs    Wed Apr 11 00:44:28 2007
***************
*** 59,64 ****
--- 59,68 ----
  #    define Drand01()        ((rand() & 0x7FFF) / (double) ((unsigned 
long)1 << 15))
  #endif
 
+ #ifndef HAS_DRAND48_PROTO
+ extern double drand48 (void);
+ #endif
+
  #if PERL_VERSION < 5
  #  ifndef gv_stashpvn
  #    define gv_stashpvn(n,l,c) gv_stashpv(n,c)


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About