Merge ebcdic.c (only one function, ebcdic_control()) into util.c.

p4raw-id: //depot/perl@8783

diff --git a/MANIFEST b/MANIFEST
index 61af6b5..f02ed7e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -89,7 +89,6 @@ doio.c                        I/O operations
 doop.c                 Support code for various operations
 dosish.h               Some defines for MS/DOSish machines
 dump.c                 Debugging output
-ebcdic.c               EBCDIC support routines
 emacs/cperl-mode.el    An alternate perl-mode
 emacs/e2ctags.pl       etags to ctags converter
 emacs/ptags            Creates smart TAGS file

diff --git a/ebcdic.c b/ebcdic.c
deleted file mode 100644 (file)
index d86d50b..0000000
--- a/ebcdic.c
+++ /dev/null
@@ -1,41 +0,0 @@
-#include "EXTERN.h"
-#define PERL_IN_EBCDIC_C
-#include "perl.h"
-
-/* in ASCII order, not that it matters */
-static const char controllablechars[] = "?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
- 
-int
-ebcdic_control(int ch)
-{
-       if (ch > 'a') {
-               char *ctlp;
- 
-              if (islower(ch))
-                     ch = toupper(ch);
- 
-              if ((ctlp = strchr(controllablechars, ch)) == 0) {
-                     Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
-              }
- 
-               if (ctlp == controllablechars)
-                      return('\177'); /* DEL */
-               else
-                      return((unsigned char)(ctlp - controllablechars - 1));
-       } else { /* Want uncontrol */
-               if (ch == '\177' || ch == -1)
-                       return('?');
-               else if (ch == '\157')
-                       return('\177');
-               else if (ch == '\174')
-                       return('\000');
-               else if (ch == '^')    /* '\137' in 1047, '\260' in 819 */
-                       return('\036');
-               else if (ch == '\155')
-                       return('\037');
-               else if (0 < ch && ch < (sizeof(controllablechars) - 1))
-                       return(controllablechars[ch+1]);
-               else
-                       Perl_die(aTHX_ "invalid control request: '\\%03o'\n", ch & 0xFF);
-       }
-}

diff --git a/embed.h b/embed.h
index 6d2eea6..1150e98 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1159,6 +1159,9 @@
 #  if defined(LEAKTEST)
 #define xstat                  S_xstat
 #  endif
+#  if defined(EBCDIC)
+#define ebcdic_control         Perl_ebcdic_control
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif
@@ -2633,6 +2636,9 @@
 #  if defined(LEAKTEST)
 #define xstat(a)               S_xstat(aTHX_ a)
 #  endif
+#  if defined(EBCDIC)
+#define ebcdic_control(a)      Perl_ebcdic_control(aTHX_ a)
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif
@@ -5112,6 +5118,10 @@
 #define S_xstat                        CPerlObj::S_xstat
 #define xstat                  S_xstat
 #  endif
+#  if defined(EBCDIC)
+#define Perl_ebcdic_control    CPerlObj::Perl_ebcdic_control
+#define ebcdic_control         Perl_ebcdic_control
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif

diff --git a/embed.pl b/embed.pl
index e350a45..2e93faa 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -2553,6 +2553,9 @@ s |SV*    |mess_alloc
 #  if defined(LEAKTEST)
 s      |void   |xstat          |int
 #  endif
+#  if defined(EBCDIC)
+p      |int    |ebcdic_control |int ch
+#  endif
 #endif
 
 #if defined(PERL_OBJECT)

diff --git a/handy.h b/handy.h
index 9d7e096..9ac2e29 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -483,7 +483,6 @@ Converts the specified character to lowercase.
 #define isBLANK_LC_utf8(c)     isBLANK(c) /* could be wrong */
 
 #ifdef EBCDIC
-EXT int ebcdic_control (int);
 #  define toCTRL(c)    ebcdic_control(c)
 #else
   /* This conversion works both ways, strangely enough. */

diff --git a/hints/os390.sh b/hints/os390.sh
index 54787e8..6f4f39b 100644 (file)
--- a/hints/os390.sh
+++ b/hints/os390.sh
@@ -139,14 +139,6 @@ case "$archname" in
 '') archname="$osname" ;;
 esac
 
-# Architecture related object files.
-# ebcdic.c contains special \cX mapping code for EBCDIC char sets.
-# Prepend your preference with Configure -Darchobs=your_preference.o.
-case "$archname" in
-'') archobjs="ebcdic.o" ;;
-*) archobjs="$archobjs ebcdic.o" ;;
-esac
-
 # We have our own cppstdin script.  This is not a variable since 
 # Configure sees the presence of the script file.
 # We put system header -D definitions in so that Configure

diff --git a/hints/posix-bc.sh b/hints/posix-bc.sh
index 5c45832..6275233 100644 (file)
--- a/hints/posix-bc.sh
+++ b/hints/posix-bc.sh
@@ -92,10 +92,3 @@ esac
 #'') ldlibpthname=LIBPATH ;;
 #esac
 
-# Architecture related object files.
-# ebcdic.c contains special \cX mapping code for EBCDIC char sets.
-# Prepend your preference with Configure -Darchobs=your_preference.o.
-case "$archname" in
-'') archobjs="ebcdic.o" ;;
-*) archobjs="$archobjs ebcdic.o" ;;
-esac

diff --git a/hints/vmesa.sh b/hints/vmesa.sh
index 81ab6a4..2c95fd3 100644 (file)
--- a/hints/vmesa.sh
+++ b/hints/vmesa.sh
@@ -24,7 +24,7 @@ d_access='define'
 d_alarm='define'
 d_archlib='define'
 # randbits='15'
-archobjs="ebcdic.o vmesa.o"
+archobjs="vmesa.o"
 d_attribut='undef'
 d_bcmp='define'
 d_bcopy='define'

diff --git a/objXSUB.h b/objXSUB.h
index d1c2eee..5925567 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -2331,6 +2331,8 @@
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 #  if defined(LEAKTEST)
 #  endif
+#  if defined(EBCDIC)
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif

diff --git a/perlapi.c b/perlapi.c
index 4cdb104..05e6c7a 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -4153,6 +4153,8 @@ Perl_sys_intern_init(pTHXo)
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 #  if defined(LEAKTEST)
 #  endif
+#  if defined(EBCDIC)
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif

diff --git a/proto.h b/proto.h
index 807fab1..f932454 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1282,6 +1282,9 @@ STATIC SV*        S_mess_alloc(pTHX);
 #  if defined(LEAKTEST)
 STATIC void    S_xstat(pTHX_ int);
 #  endif
+#  if defined(EBCDIC)
+PERL_CALLCONV int      Perl_ebcdic_control(pTHX_ int ch);
+#  endif
 #endif
 
 #if defined(PERL_OBJECT)

diff --git a/util.c b/util.c
index 1fb9ef2..d603e82 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3997,3 +3997,40 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
                        func, pars);
     }
 }
+
+#ifdef EBCDIC
+int
+Perl_ebcdic_control(pTHX_ int ch)
+{
+       if (ch > 'a') {
+               char *ctlp;
+ 
+              if (islower(ch))
+                     ch = toupper(ch);
+ 
+              if ((ctlp = strchr(controllablechars, ch)) == 0) {
+                     Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
+              }
+ 
+               if (ctlp == controllablechars)
+                      return('\177'); /* DEL */
+               else
+                      return((unsigned char)(ctlp - controllablechars - 1));
+       } else { /* Want uncontrol */
+               if (ch == '\177' || ch == -1)
+                       return('?');
+               else if (ch == '\157')
+                       return('\177');
+               else if (ch == '\174')
+                       return('\000');
+               else if (ch == '^')    /* '\137' in 1047, '\260' in 819 */
+                       return('\036');
+               else if (ch == '\155')
+                       return('\037');
+               else if (0 < ch && ch < (sizeof(controllablechars) - 1))
+                       return(controllablechars[ch+1]);
+               else
+                       Perl_die(aTHX_ "invalid control request: '\\%03o'\n", ch & 0xFF);
+       }
+}
+#endif