| … | |
… | |
| 1475 | return S_F; |
1475 | return S_F; |
| 1476 | else if (*name == '\\') /* #\w (character) */ |
1476 | else if (*name == '\\') /* #\w (character) */ |
| 1477 | { |
1477 | { |
| 1478 | int c; |
1478 | int c; |
| 1479 | |
1479 | |
|
|
1480 | // TODO: optimise |
| 1480 | if (stricmp (name + 1, "space") == 0) |
1481 | if (stricmp (name + 1, "space") == 0) |
| 1481 | c = ' '; |
1482 | c = ' '; |
| 1482 | else if (stricmp (name + 1, "newline") == 0) |
1483 | else if (stricmp (name + 1, "newline") == 0) |
| 1483 | c = '\n'; |
1484 | c = '\n'; |
| 1484 | else if (stricmp (name + 1, "return") == 0) |
1485 | else if (stricmp (name + 1, "return") == 0) |
| 1485 | c = '\r'; |
1486 | c = '\r'; |
| 1486 | else if (stricmp (name + 1, "tab") == 0) |
1487 | else if (stricmp (name + 1, "tab") == 0) |
| 1487 | c = '\t'; |
1488 | c = '\t'; |
|
|
1489 | else if (stricmp (name + 1, "alarm") == 0) |
|
|
1490 | c = 0x07; |
|
|
1491 | else if (stricmp (name + 1, "backspace") == 0) |
|
|
1492 | c = 0x08; |
|
|
1493 | else if (stricmp (name + 1, "escape") == 0) |
|
|
1494 | c = 0x1b; |
|
|
1495 | else if (stricmp (name + 1, "delete") == 0) |
|
|
1496 | c = 0x7f; |
|
|
1497 | else if (stricmp (name + 1, "null") == 0) |
|
|
1498 | c = 0; |
| 1488 | else if (name[1] == 'x' && name[2] != 0) |
1499 | else if (name[1] == 'x' && name[2] != 0) |
| 1489 | { |
1500 | { |
| 1490 | long c1 = strtol (name + 2, 0, 16); |
1501 | long c1 = strtol (name + 2, 0, 16); |
| 1491 | |
1502 | |
| 1492 | if (0 <= c1 && c1 <= UCHAR_MAX) |
1503 | if (0 <= c1 && c1 <= UCHAR_MAX) |
| … | |
… | |
| 2175 | case '7': |
2186 | case '7': |
| 2176 | state = st_oct1; |
2187 | state = st_oct1; |
| 2177 | c1 = c - '0'; |
2188 | c1 = c - '0'; |
| 2178 | break; |
2189 | break; |
| 2179 | |
2190 | |
|
|
2191 | case 'a': *p++ = '\a'; state = st_ok; break; |
|
|
2192 | case 'n': *p++ = '\n'; state = st_ok; break; |
|
|
2193 | case 'r': *p++ = '\r'; state = st_ok; break; |
|
|
2194 | case 't': *p++ = '\t'; state = st_ok; break; |
|
|
2195 | |
|
|
2196 | //TODO: \whitespace eol whitespace |
|
|
2197 | |
|
|
2198 | //TODO: x should end in ;, not two-digit hex |
| 2180 | case 'x': |
2199 | case 'x': |
| 2181 | case 'X': |
2200 | case 'X': |
| 2182 | state = st_x1; |
2201 | state = st_x1; |
| 2183 | c1 = 0; |
2202 | c1 = 0; |
| 2184 | break; |
|
|
| 2185 | |
|
|
| 2186 | case 'n': |
|
|
| 2187 | *p++ = '\n'; |
|
|
| 2188 | state = st_ok; |
|
|
| 2189 | break; |
|
|
| 2190 | |
|
|
| 2191 | case 't': |
|
|
| 2192 | *p++ = '\t'; |
|
|
| 2193 | state = st_ok; |
|
|
| 2194 | break; |
|
|
| 2195 | |
|
|
| 2196 | case 'r': |
|
|
| 2197 | *p++ = '\r'; |
|
|
| 2198 | state = st_ok; |
|
|
| 2199 | break; |
2203 | break; |
| 2200 | |
2204 | |
| 2201 | default: |
2205 | default: |
| 2202 | *p++ = c; |
2206 | *p++ = c; |
| 2203 | state = st_ok; |
2207 | state = st_ok; |
| … | |
… | |
| 4374 | memcpy (pos, strvalue (car (x)), strlength (car (x))); |
4378 | memcpy (pos, strvalue (car (x)), strlength (car (x))); |
| 4375 | |
4379 | |
| 4376 | s_return (newstr); |
4380 | s_return (newstr); |
| 4377 | } |
4381 | } |
| 4378 | |
4382 | |
| 4379 | case OP_SUBSTR: /* substring */ |
4383 | case OP_STRING_COPY: /* substring/string-copy */ |
| 4380 | { |
4384 | { |
| 4381 | char *str = strvalue (x); |
4385 | char *str = strvalue (x); |
| 4382 | int index0 = ivalue_unchecked (cadr (args)); |
4386 | int index0 = cadr (args) == NIL ? 0 : ivalue_unchecked (cadr (args)); |
| 4383 | int index1; |
4387 | int index1; |
| 4384 | int len; |
4388 | int len; |
| 4385 | |
4389 | |
| 4386 | if (index0 > strlength (x)) |
4390 | if (index0 > strlength (x)) |
| 4387 | Error_1 ("substring: start out of bounds:", cadr (args)); |
4391 | Error_1 ("string->copy: start out of bounds:", cadr (args)); |
| 4388 | |
4392 | |
| 4389 | if (cddr (args) != NIL) |
4393 | if (cddr (args) != NIL) |
| 4390 | { |
4394 | { |
| 4391 | index1 = ivalue_unchecked (caddr (args)); |
4395 | index1 = ivalue_unchecked (caddr (args)); |
| 4392 | |
4396 | |
| 4393 | if (index1 > strlength (x) || index1 < index0) |
4397 | if (index1 > strlength (x) || index1 < index0) |
| 4394 | Error_1 ("substring: end out of bounds:", caddr (args)); |
4398 | Error_1 ("string->copy: end out of bounds:", caddr (args)); |
| 4395 | } |
4399 | } |
| 4396 | else |
4400 | else |
| 4397 | index1 = strlength (x); |
4401 | index1 = strlength (x); |
| 4398 | |
4402 | |
| 4399 | len = index1 - index0; |
4403 | len = index1 - index0; |
| 4400 | x = mk_empty_string (SCHEME_A_ len, ' '); |
4404 | x = mk_counted_string (SCHEME_A_ str + index0, len); |
| 4401 | memcpy (strvalue (x), str + index0, len); |
|
|
| 4402 | strvalue (x)[len] = 0; |
|
|
| 4403 | |
4405 | |
| 4404 | s_return (x); |
4406 | s_return (x); |
| 4405 | } |
4407 | } |
| 4406 | |
4408 | |
| 4407 | case OP_VECTOR: /* vector */ |
4409 | case OP_VECTOR: /* vector */ |
