From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 13 Feb 2001 02:22:36 +0000 (+0000)
Subject: Merge ebcdic.c (only one function, ebcdic_control()) into util.c.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a926ef6bf408292b4a3963e296e2683a36825a5e;p=p5sagit%2Fp5-mst-13.2.git
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
--- 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
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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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