summaryrefslogtreecommitdiff
path: root/perlio.c
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 /perlio.c
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.
Diffstat (limited to 'perlio.c')
-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);