summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Williamson <public@khwilliamson.com>2013-04-13 09:18:41 -0600
committerKarl Williamson <public@khwilliamson.com>2013-08-29 09:56:06 -0600
commit76e6dc3a786387b6174655bd76877e406a342e5b (patch)
treec2d36696d47cc290f013e2298ff4b3e9d26c3e8a
parentc5eda08a3ed28f8c2b583618101553353dae3b51 (diff)
downloadperl-76e6dc3a786387b6174655bd76877e406a342e5b.tar.gz
perlio.c: Generalize for EBCDIC
This code had the hex constants for CARRIAGE RETURN and LINE FEED hard-coded in. It appears to me from the comments that '\r' and '\n' are not suitable to use instead. This commit changes the constants to use the native values instead.
-rw-r--r--perlio.c34
1 files changed, 19 insertions, 15 deletions
diff --git a/perlio.c b/perlio.c
index 963c3e80c4..f7c0698c8c 100644
--- a/perlio.c
+++ b/perlio.c
@@ -130,6 +130,9 @@ extern int fseeko(FILE *, off_t, int);
extern off_t ftello(FILE *);
#endif
+#define NATIVE_0xd CR_NATIVE
+#define NATIVE_0xa LF_NATIVE
+
#ifndef USE_SFIO
EXTERN_C int perlsio_binmode(FILE *fp, int iotype, int mode);
@@ -4544,7 +4547,7 @@ PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf);
if (c->nl) { /* XXXX Shouldn't it be done only if b->ptr > c->nl? */
- *(c->nl) = 0xd;
+ *(c->nl) = NATIVE_0xd;
c->nl = NULL;
}
if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF))
@@ -4567,14 +4570,15 @@ PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
const int ch = *--buf;
if (ch == '\n') {
if (b->ptr - 2 >= b->buf) {
- *--(b->ptr) = 0xa;
- *--(b->ptr) = 0xd;
+ *--(b->ptr) = NATIVE_0xa;
+ *--(b->ptr) = NATIVE_0xd;
unread++;
count--;
}
else {
/* If b->ptr - 1 == b->buf, we are undoing reading 0xa */
- *--(b->ptr) = 0xa; /* Works even if 0xa == '\r' */
+ *--(b->ptr) = NATIVE_0xa; /* Works even if 0xa ==
+ '\r' */
unread++;
count--;
}
@@ -4601,15 +4605,15 @@ PerlIOCrlf_get_cnt(pTHX_ PerlIO *f)
PerlIO_get_base(f);
if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf);
- if ((PerlIOBase(f)->flags & PERLIO_F_CRLF) && (!c->nl || *c->nl == 0xd)) {
+ if ((PerlIOBase(f)->flags & PERLIO_F_CRLF) && (!c->nl || *c->nl == NATIVE_0xd)) {
STDCHAR *nl = (c->nl) ? c->nl : b->ptr;
scan:
- while (nl < b->end && *nl != 0xd)
+ while (nl < b->end && *nl != NATIVE_0xd)
nl++;
- if (nl < b->end && *nl == 0xd) {
+ if (nl < b->end && *nl == NATIVE_0xd) {
test:
if (nl + 1 < b->end) {
- if (nl[1] == 0xa) {
+ if (nl[1] == NATIVE_0xa) {
*nl = '\n';
c->nl = nl;
}
@@ -4649,7 +4653,7 @@ PerlIOCrlf_get_cnt(pTHX_ PerlIO *f)
b->buf--; /* Point at space */
b->ptr = nl = b->buf; /* Which is what we hand
* off */
- *nl = 0xd; /* Fill in the CR */
+ *nl = NATIVE_0xd; /* Fill in the CR */
if (code == 0)
goto test; /* fill() call worked */
/*
@@ -4675,7 +4679,7 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
if (!ptr) {
if (c->nl) {
ptr = c->nl + 1;
- if (ptr == b->end && *c->nl == 0xd) {
+ if (ptr == b->end && *c->nl == NATIVE_0xd) {
/* Deferred CR at end of buffer case - we lied about count */
ptr--;
}
@@ -4693,7 +4697,7 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
*/
IV flags = PerlIOBase(f)->flags;
STDCHAR *chk = (c->nl) ? (c->nl+1) : b->end;
- if (ptr+cnt == c->nl && c->nl+1 == b->end && *c->nl == 0xd) {
+ if (ptr+cnt == c->nl && c->nl+1 == b->end && *c->nl == NATIVE_0xd) {
/* Deferred CR at end of buffer case - we lied about count */
chk--;
}
@@ -4711,7 +4715,7 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
/*
* They have taken what we lied about
*/
- *(c->nl) = 0xd;
+ *(c->nl) = NATIVE_0xd;
c->nl = NULL;
ptr++;
}
@@ -4746,8 +4750,8 @@ PerlIOCrlf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
break;
}
else {
- *(b->ptr)++ = 0xd; /* CR */
- *(b->ptr)++ = 0xa; /* LF */
+ *(b->ptr)++ = NATIVE_0xd; /* CR */
+ *(b->ptr)++ = NATIVE_0xa; /* LF */
buf++;
if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) {
PerlIO_flush(f);
@@ -4775,7 +4779,7 @@ PerlIOCrlf_flush(pTHX_ PerlIO *f)
{
PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf);
if (c->nl) {
- *(c->nl) = 0xd;
+ *(c->nl) = NATIVE_0xd;
c->nl = NULL;
}
return PerlIOBuf_flush(aTHX_ f);