The R Project SVN R-packages

#include <stdlib.h>

#include <Rdefines.h>
#define MAXELTSIZE 8192

typedef wchar_t xxx_ucs_t;


#if defined(Win32) || defined(__STDC_ISO_10646__)
typedef wchar_t ucs_t;
# define mbcs_get_next2 mbcs_get_next
#else
typedef unsigned int ucs_t;
# define WC_NOT_UNICODE 
#endif

#define CTEXT_PUSH(c) do { \
    if (ct - currtext >= 1000) {memmove(currtext, currtext+100, 901); memmove(currtext, "... ", 4); ct -= 100;} \
    *ct++ = (char)(c);                      \
} while(0)

#define CTEXT_POP() ct--

#define xxgetc() (int) ((char*)input)[pos++]
#define xxungetc(val) pos--
#define R_EOF '\0'

#define STEXT_PUSH(c) do {                  \
    unsigned long nc = bp - stext;      \
    if (nc >= nstext - 1) {             \
        char *old = stext;              \
        nstext *= 2;                    \
        stext = malloc(nstext);         \
        if(!stext)  \
                errorcall(R_NilValue, "unable to allocate buffer for long string"); \
        memmove(stext, old, nc);        \
        if(old != st0) free(old);       \
        bp = stext+nc; }            \
    *bp++ = (char)(c);          \
    } while(0)

#define WTEXT_PUSH(c) do { if(wcnt < 10000) wcs[wcnt++] = c; } while(0)



SEXP StringValue(void *input, int len)
{
    SEXP yylval = R_NilValue;
    int pos = 0;
    int c = xxgetc();
    int quote = c;
    char currtext[1010], *ct = currtext;
    char st0[MAXELTSIZE];
    unsigned int nstext = MAXELTSIZE;
    char *stext = st0, *bp = st0;
    int wcnt = 0;
    ucs_t wcs[10001];
//    Rboolean oct_or_hex = FALSE, use_wcs = FALSE;

    while (pos < len && (c = xxgetc()) != R_EOF && c != quote) {
    CTEXT_PUSH(c);
    if (c == '\n') {
        xxungetc(c);
        /* Fix suggested by Mark Bravington to allow multiline strings
         * by pretending we've seen a backslash. Was:
         * return ERROR;
         */
        c = '\\';
    }
    if (c == '\\') {
        c = xxgetc(); CTEXT_PUSH(c);
        if ('0' <= c && c <= '8') {
        int octal = c - '0';
        if ('0' <= (c = xxgetc()) && c <= '8') {
            CTEXT_PUSH(c);
            octal = 8 * octal + c - '0';
            if ('0' <= (c = xxgetc()) && c <= '8') {
            CTEXT_PUSH(c);
            octal = 8 * octal + c - '0';
            } else {
            xxungetc(c);
            CTEXT_POP();
            }
        } else {
            xxungetc(c);
            CTEXT_POP();
        }
        c = octal;
//      oct_or_hex = TRUE;
        }
        else if(c == 'x') {
        int val = 0; int i, ext;
        for(i = 0; i < 2; i++) {
            c = xxgetc(); CTEXT_PUSH(c);
            if(c >= '0' && c <= '9') ext = c - '0';
            else if (c >= 'A' && c <= 'F') ext = c - 'A' + 10;
            else if (c >= 'a' && c <= 'f') ext = c - 'a' + 10;
            else {
            xxungetc(c);
            CTEXT_POP();
            if (i == 0) { /* was just \x */
                *ct = '\0';
                Rf_error("'\\x' used without hex digits in character string starting \"%s\"", currtext);
            }
            break;
            }
            val = 16*val + ext;
        }
        c = val;
//      oct_or_hex = TRUE;
        }
        else if(c == 'u') {
        unsigned int val = 0; int i, ext; 
        Rboolean delim = FALSE;


        if((c = xxgetc()) == '{') {
            delim = TRUE;
            CTEXT_PUSH(c);
        } else xxungetc(c);
        for(i = 0; i < 4; i++) {
            c = xxgetc(); CTEXT_PUSH(c);
            if(c >= '0' && c <= '9') ext = c - '0';
            else if (c >= 'A' && c <= 'F') ext = c - 'A' + 10;
            else if (c >= 'a' && c <= 'f') ext = c - 'a' + 10;
            else {
            xxungetc(c);
            CTEXT_POP();
            if (i == 0) { /* was just \u */
                *ct = '\0';
                Rf_error("'\\u' used without hex digits in character string starting \"%s\"", currtext);
            }
            break;
            }
            val = 16*val + ext;
        }
        if(delim) {
            if((c = xxgetc()) != '}') {
            Rf_error("invalid \\u{xxxx} sequence");
            } else CTEXT_PUSH(c);
        }
        WTEXT_PUSH(val); /* this assumes wchar_t is Unicode */
//      use_wcs = TRUE;
        continue;
        }
        else if(c == 'U') {
        unsigned int val = 0; int i, ext;
        Rboolean delim = FALSE;

        if((c = xxgetc()) == '{') {
            delim = TRUE;
            CTEXT_PUSH(c);
        } else xxungetc(c);
        for(i = 0; i < 8; i++) {
            c = xxgetc(); CTEXT_PUSH(c);
            if(c >= '0' && c <= '9') ext = c - '0';
            else if (c >= 'A' && c <= 'F') ext = c - 'A' + 10;
            else if (c >= 'a' && c <= 'f') ext = c - 'a' + 10;
            else {
            xxungetc(c);
            CTEXT_POP();
            if (i == 0) { /* was just \U */
                *ct = '\0';
                Rf_error( "'\\U' used without hex digits in character string starting \"%s\"", currtext);
            }
            break;
            }
            val = 16*val + ext;
        }
        if(delim) {
            if((c = xxgetc()) != '}') {
            Rf_error("invalid \\U{xxxxxxxx} sequence");
            } else CTEXT_PUSH(c);
        }
        WTEXT_PUSH(val);
//      use_wcs = TRUE;
        continue;
        }
        else {
        switch (c) {
        case 'a':
            c = '\a';
            break;
        case 'b':
            c = '\b';
            break;
        case 'f':
            c = '\f';
            break;
        case 'n':
            c = '\n';
            break;
        case 'r':
            c = '\r';
            break;
        case 't':
            c = '\t';
            break;
        case 'v':
            c = '\v';
            break;
        case '\\':
            c = '\\';
            break;
        case '"':
        case '\'':
        case ' ':
        case '\n':
            break;
        default:
            *ct = '\0';
            Rf_error("'\\%c' is an unrecognized escape in character string starting \"%s\"", c, currtext);
        }
        }
    }
    }

    STEXT_PUSH(c);
    if ((unsigned int) c < 0x80) WTEXT_PUSH(c);

    STEXT_PUSH('\0');
    WTEXT_PUSH(0);

    yylval = mkCharLenCE((char *) wcs, wcnt, CE_UTF8); /* include terminator */
    if(stext != st0) free(stext);
    return(yylval);
}

SEXP
R_checkStringValue(void)
{
    char str[6];
    str[0] = '\\';
    str[1] = 'u';
    str[2] = '1';
    str[3] = '4';
    str[4] = '0';
    str[5] = '5';
    return(StringValue(str, 6));
}