#define SPACE_OR_TAB(c) isBLANK_A(c)
+#define HEXFP_PEEK(s) \
+ (((s[0] == '.') && \
+ (isXDIGIT(s[1]) || isALPHA_FOLD_EQ(s[1], 'p'))) || \
+ isALPHA_FOLD_EQ(s[0], 'p'))
+
/* LEX_* are values for PL_lex_state, the state of the lexer.
* They are arranged oddly so that the guard on the switch statement
* can get by with a single comparison (if the compiler is smart enough).
#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s, REPORT(retval))
#define TERM(retval) return (CLINE, PL_expect = XOPERATOR, PL_bufptr = s, REPORT(retval))
#define POSTDEREF(f) return (PL_bufptr = s, S_postderef(aTHX_ REPORT(f),s[1]))
-#define LOOPX(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
+#define LOOPX(f) return (PL_expect = XOPERATOR, \
+ PL_bufptr = force_word(s,WORD,TRUE,FALSE), \
+ pl_yylval.ival=f, \
+ (void)(PL_nexttoke || (PL_expect = XTERM)), \
+ REPORT((int)LOOPEX))
#define FTST(f) return (pl_yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
#define FUN0(f) return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
#define FUN0OP(f) return (pl_yylval.opval=f, CLINE, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0OP))
/*
* S_lop
* Build a list operator (or something that might be one). The rules:
- * - if we have a next token, then it's a list operator [why?]
+ * - if we have a next token, then it's a list operator (no parens) for
+ * which the next token has already been parsed; e.g.,
+ * sort foo @args
+ * sort foo (@args)
* - if the next thing is an opening paren, then it's a function
* - else it's a list operator
*/
pl_yylval.ival = f;
CLINE;
- PL_expect = x;
PL_bufptr = s;
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = (OPCODE)f;
if (PL_nexttoke)
goto lstop;
+ PL_expect = x;
if (*s == '(')
return REPORT(FUNC);
s = PEEKSPACE(s);
*d++ = '\t';
break;
case 'e':
- *d++ = ASCII_TO_NATIVE('\033');
+ *d++ = ESC_NATIVE;
break;
case 'a':
*d++ = '\a';
#ifdef DEBUGGING
static const char* const exp_name[] =
{ "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
- "ATTRTERM", "TERMBLOCK", "POSTDEREF", "TERMORDORDOR"
+ "ATTRTERM", "TERMBLOCK", "XBLOCKTERM", "POSTDEREF",
+ "TERMORDORDOR"
};
#endif
* line contains "Perl" rather than "perl" */
if (!d) {
for (d = ipathend-4; d >= ipath; --d) {
- if ((*d == 'p' || *d == 'P')
+ if (isALPHA_FOLD_EQ(*d, 'p')
&& !ibcmp(d, "perl", 4))
{
break;
!= PL_unicode)
baduni = TRUE;
}
- if (baduni || *d1 == 'M' || *d1 == 'm') {
+ if (baduni || isALPHA_FOLD_EQ(*d1, 'M')) {
const char * const m = d1;
while (*d1 && !isSPACE(*d1))
d1++;
TOKEN(0);
CLINE;
s++;
- OPERATOR(';');
+ PL_expect = XSTATE;
+ TOKEN(';');
case ')':
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_CLOSING)
TOKEN(0);
UNI(OP_DBMCLOSE);
case KEY_dump:
- PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_DUMP);
case KEY_else:
LOP(OP_GREPSTART, XREF);
case KEY_goto:
- PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_GOTO);
case KEY_gmtime:
LOP(OP_KILL,XTERM);
case KEY_last:
- PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_LAST);
case KEY_lc:
OPERATOR(MY);
case KEY_next:
- PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_NEXT);
case KEY_ne:
case KEY_no:
s = tokenize_use(0, s);
- TERM(USE);
+ TOKEN(USE);
case KEY_not:
if (*s == '(' || (s = SKIPSPACE1(s), *s == '('))
}
else
pl_yylval.ival = 0;
- PL_expect = XTERM;
+ if (!PL_nexttoke) PL_expect = XTERM;
PL_bufptr = s;
PL_last_uni = PL_oldbufptr;
PL_last_lop_op = OP_REQUIRE;
UNI(OP_RESET);
case KEY_redo:
- PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_REDO);
case KEY_rename:
case KEY_use:
s = tokenize_use(1, s);
- OPERATOR(USE);
+ TOKEN(USE);
case KEY_values:
UNI(OP_VALUES);
\d(_?\d)*(\.(\d(_?\d)*)?)?[Ee][\+\-]?(\d(_?\d)*) 12 12.34 12.
\.\d(_?\d)*[Ee][\+\-]?(\d(_?\d)*) .34
- 0b[01](_?[01])*
- 0[0-7](_?[0-7])*
- 0x[0-9A-Fa-f](_?[0-9A-Fa-f])*
+ 0b[01](_?[01])* binary integers
+ 0[0-7](_?[0-7])* octal integers
+ 0x[0-9A-Fa-f](_?[0-9A-Fa-f])* hexadecimal integers
+ 0x[0-9A-Fa-f](_?[0-9A-Fa-f])*(?:\.\d*)?p[+-]?[0-9]+ hexadecimal floats
Like most scan_ routines, it uses the PL_tokenbuf buffer to hold the
thing it reads.
static const char* const number_too_long = "Number too long";
/* Hexadecimal floating point.
*
- * In many places (where UV is quad and NV is IEEE 754 double)
- * we can fit the mantissa bits of a NV into a UV. This will not
- * work everywhere, though (either no quads, or using long doubles),
- * in which case we have to resort to NV, which will probably mean
- * horrible loss of precision due to multiple fp operations. */
+ * In many places (where we have quads and NV is IEEE 754 double)
+ * we can fit the mantissa bits of a NV into an unsigned quad.
+ * (Note that UVs might not be quads even when we have quads.)
+ * This will not work everywhere, though (either no quads, or
+ * using long doubles), in which case we have to resort to NV,
+ * which will probably mean horrible loss of precision due to
+ * multiple fp operations. */
bool hexfp = FALSE;
int total_bits = 0;
-#if UVSIZE == 8 && NVSIZE == 8
-# define HEXFP_UV
- UV hexfp_uv = 0;
+#if NVSIZE == 8 && defined(HAS_QUAD) && defined(Uquad_t)
+# define HEXFP_UQUAD
+ Uquad_t hexfp_uquad = 0;
int hexfp_frac_bits = 0;
#else
# define HEXFP_NV
const char *base, *Base, *max;
/* check for hex */
- if (s[1] == 'x' || s[1] == 'X') {
+ if (isALPHA_FOLD_EQ(s[1], 'x')) {
shift = 4;
s += 2;
just_zero = FALSE;
- } else if (s[1] == 'b' || s[1] == 'B') {
+ } else if (isALPHA_FOLD_EQ(s[1], 'b')) {
shift = 1;
s += 2;
just_zero = FALSE;
}
/* check for a decimal in disguise */
- else if (s[1] == '.' || s[1] == 'e' || s[1] == 'E')
+ else if (s[1] == '.' || isALPHA_FOLD_EQ(s[1], 'e'))
goto decimal;
/* so it must be octal */
else {
/* this could be hexfp, but peek ahead
* to avoid matching ".." */
-#define HEXFP_PEEK(s) \
- (((s[0] == '.') && \
- (isXDIGIT(s[1]) || s[1] == 'p' || s[1] == 'P')) \
- || s[0] == 'p' || s[0] == 'P')
if (UNLIKELY(HEXFP_PEEK(s))) {
goto out;
}
* detection will shortly be more thorough with the
* underbar checks. */
const char* h = s;
-#ifdef HEXFP_UV
- hexfp_uv = u;
+#ifdef HEXFP_UQUAD
+ hexfp_uquad = u;
#else /* HEXFP_NV */
hexfp_nv = u;
#endif
if (*h == '.') {
#ifdef HEXFP_NV
- NV hfm = 1 / 16.0;
+ NV mult = 1 / 16.0;
#endif
h++;
while (isXDIGIT(*h) || *h == '_') {
if (isXDIGIT(*h)) {
- const char* p = strchr(PL_hexdigit, *h);
- U8 b;
- assert(p);
- b = ((p - PL_hexdigit) & 0x0F);
+ U8 b = XDIGIT_VALUE(*h);
total_bits += shift;
-#ifdef HEXFP_UV
- hexfp_uv <<= shift;
- hexfp_uv |= b;
+#ifdef HEXFP_UQUAD
+ hexfp_uquad <<= shift;
+ hexfp_uquad |= b;
hexfp_frac_bits += shift;
#else /* HEXFP_NV */
- hexfp_nv += b * hfm;
- hfm /= 16.0;
+ hexfp_nv += b * mult;
+ mult /= 16.0;
#endif
}
h++;
total_bits--;
}
- if (total_bits > 0 && (*h == 'p' || *h == 'P')) {
+ if (total_bits > 0 && (isALPHA_FOLD_EQ(*h, 'p'))) {
bool negexp = FALSE;
h++;
if (*h == '+')
"Hexadecimal float: exponent underflow");
#endif
break;
- } else {
+ }
+ else {
#ifdef NV_MAX_EXP
if (!negexp &&
hexfp_exp > NV_MAX_EXP - 1) {
}
if (negexp)
hexfp_exp = -hexfp_exp;
-#ifdef HEXFP_UV
+#ifdef HEXFP_UQUAD
hexfp_exp -= hexfp_frac_bits;
#endif
hexfp_mult = pow(2.0, hexfp_exp);
}
/* read exponent part, if present */
- if (((*s == 'e' || *s == 'E') ||
- UNLIKELY(hexfp && (*s == 'p' || *s == 'P'))) &&
- strchr("+-0123456789_", s[1])) {
+ if ((isALPHA_FOLD_EQ(*s, 'e')
+ || UNLIKELY(hexfp && isALPHA_FOLD_EQ(*s, 'p')))
+ && strchr("+-0123456789_", s[1]))
+ {
floatit = TRUE;
/* regardless of whether user said 3E5 or 3e5, use lower 'e',
ditto for p (hexfloats) */
- if ((*s == 'e' || *s == 'E')) {
+ if ((isALPHA_FOLD_EQ(*s, 'e'))) {
/* At least some Mach atof()s don't grok 'E' */
*d++ = 'e';
- } else if (UNLIKELY(hexfp && (*s == 'p' || *s == 'P'))) {
+ }
+ else if (UNLIKELY(hexfp && (isALPHA_FOLD_EQ(*s, 'p')))) {
*d++ = 'p';
}
Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Hexadecimal float: mantissa overflow");
# endif
-#ifdef HEXFP_UV
- nv = hexfp_uv * hexfp_mult;
+#ifdef HEXFP_UQUAD
+ nv = hexfp_uquad * hexfp_mult;
#else /* HEXFP_NV */
nv = hexfp_nv * hexfp_mult;
#endif