42 |
#define SHARP_EQ_CONTEXT_SIZE 250 |
#define SHARP_EQ_CONTEXT_SIZE 250 |
43 |
#endif |
#endif |
44 |
|
|
45 |
|
void |
46 |
setup_READtable() |
setup_READtable() |
47 |
{ |
{ |
48 |
READtable = current_readtable(); |
READtable = current_readtable(); |
62 |
*/ |
*/ |
63 |
|
|
64 |
|
|
65 |
|
void |
66 |
setup_READ() |
setup_READ() |
67 |
{ |
{ |
68 |
object x; |
object x; |
92 |
backq_level = 0; |
backq_level = 0; |
93 |
} |
} |
94 |
|
|
95 |
|
void |
96 |
setup_standard_READ() |
setup_standard_READ() |
97 |
{ |
{ |
98 |
READtable = standard_readtable; |
READtable = standard_readtable; |
112 |
|
|
113 |
#define read_char(in) code_char(readc_stream(in)) |
#define read_char(in) code_char(readc_stream(in)) |
114 |
|
|
115 |
|
void |
116 |
unread_char(c, in) |
unread_char(c, in) |
117 |
object c, in; |
object c, in; |
118 |
{ |
{ |
200 |
READsuppress = old_READsuppress; |
READsuppress = old_READsuppress; |
201 |
|
|
202 |
/* BUG FIX by Toshiba */ |
/* BUG FIX by Toshiba */ |
203 |
vs_pop; |
vs_popp; |
204 |
|
|
205 |
if (e) { |
if (e) { |
206 |
nlj_active = FALSE; |
nlj_active = FALSE; |
268 |
nlj_active = FALSE; |
nlj_active = FALSE; |
269 |
unwind(nlj_fr, nlj_tag); |
unwind(nlj_fr, nlj_tag); |
270 |
} |
} |
271 |
vs_pop; |
vs_popp; |
272 |
/* BUG FIX by Toshiba */ |
/* BUG FIX by Toshiba */ |
273 |
vs_pop; |
vs_popp; |
274 |
return(x); |
return(x); |
275 |
} |
} |
276 |
|
|
332 |
nlj_active = FALSE; |
nlj_active = FALSE; |
333 |
unwind(nlj_fr, nlj_tag); |
unwind(nlj_fr, nlj_tag); |
334 |
} |
} |
335 |
vs_pop; |
vs_popp; |
336 |
/* BUG FIX by Toshiba */ |
/* BUG FIX by Toshiba */ |
337 |
vs_pop; |
vs_popp; |
338 |
return(x); |
return(x); |
339 |
} |
} |
340 |
#ifdef UNIX /* faster code for inner loop from file stream */ |
#ifdef UNIX /* faster code for inner loop from file stream */ |
355 |
|
|
356 |
#define read_char_to(res,in,eof_code) \ |
#define read_char_to(res,in,eof_code) \ |
357 |
do{FILE *fp; \ |
do{FILE *fp; \ |
358 |
if(fp=in->sm.sm_fp) \ |
if((fp=in->sm.sm_fp)) \ |
359 |
{int ch = getc(fp); \ |
{int ch = getc(fp); \ |
360 |
if (ch==EOF && feof(fp)) \ |
if (ch==EOF && feof(fp)) \ |
361 |
{ eof_code;} \ |
{ eof_code;} \ |
377 |
} while(0) |
} while(0) |
378 |
#endif |
#endif |
379 |
|
|
380 |
|
void |
381 |
|
too_long_token(void); |
382 |
/* |
/* |
383 |
Read_object(in) reads an object from stream in. |
Read_object(in) reads an object from stream in. |
384 |
This routine corresponds to COMMON Lisp function READ. |
This routine corresponds to COMMON Lisp function READ. |
388 |
object in; |
object in; |
389 |
{ |
{ |
390 |
object x; |
object x; |
391 |
object c; |
object c=Cnil; |
392 |
enum chattrib a; |
enum chattrib a; |
393 |
object *old_vs_base; |
object *old_vs_base; |
394 |
object result; |
object result; |
395 |
object p; |
object p; |
396 |
int colon, colon_type; |
int colon=0, colon_type; |
397 |
int i, d; |
int i; |
398 |
bool df, ilf; |
bool df, ilf; |
399 |
VOL int length; |
VOL int length; |
400 |
vs_mark; |
vs_mark; |
592 |
return(x); |
return(x); |
593 |
} |
} |
594 |
|
|
595 |
|
void |
596 |
Lleft_parenthesis_reader() |
Lleft_parenthesis_reader() |
597 |
{ |
{ |
598 |
object in, c, x; |
object in, c, x; |
624 |
} |
} |
625 |
vs_push(x); |
vs_push(x); |
626 |
*p = make_cons(x, Cnil); |
*p = make_cons(x, Cnil); |
627 |
vs_pop; |
vs_popp; |
628 |
p = &((*p)->c.c_cdr); |
p = &((*p)->c.c_cdr); |
629 |
} |
} |
630 |
|
|
655 |
char *s; |
char *s; |
656 |
int end, *ep, radix; |
int end, *ep, radix; |
657 |
{ |
{ |
658 |
object x, r; |
object x=Cnil; |
659 |
fixnum sign; |
fixnum sign; |
660 |
object integer_part; |
object integer_part; |
661 |
double fraction, fraction_unit, f; |
double fraction, fraction_unit, f; |
916 |
char *s; |
char *s; |
917 |
int end, *ep, radix; |
int end, *ep, radix; |
918 |
{ |
{ |
919 |
object x, r; |
object x; |
920 |
fixnum sign; |
fixnum sign; |
921 |
object integer_part; |
object integer_part; |
922 |
int i, d; |
int i, d; |
965 |
/**/ |
/**/ |
966 |
return(OBJNULL); |
return(OBJNULL); |
967 |
} |
} |
968 |
/* |
|
969 |
|
|
970 |
|
void |
971 |
|
too_long_string(void); |
972 |
|
|
973 |
|
/* |
974 |
Read_string(delim, in) reads |
Read_string(delim, in) reads |
975 |
a simple string terminated by character code delim |
a simple string terminated by character code delim |
976 |
and places it in token. |
and places it in token. |
977 |
Delim is not included in the string but discarded. |
Delim is not included in the string but discarded. |
978 |
*/ |
*/ |
979 |
|
void |
980 |
read_string(delim, in) |
read_string(delim, in) |
981 |
int delim; |
int delim; |
982 |
object in; |
object in; |
1003 |
a sequence of constituent characters from stream in |
a sequence of constituent characters from stream in |
1004 |
and places it in token_buffer. |
and places it in token_buffer. |
1005 |
*/ |
*/ |
1006 |
|
void |
1007 |
read_constituent(in) |
read_constituent(in) |
1008 |
object in; |
object in; |
1009 |
{ |
{ |
1025 |
|
|
1026 |
} |
} |
1027 |
|
|
1028 |
|
void |
1029 |
Ldouble_quote_reader() |
Ldouble_quote_reader() |
1030 |
{ |
{ |
1031 |
check_arg(2); |
check_arg(2); |
1032 |
vs_pop; |
vs_popp; |
1033 |
read_string('"', vs_base[0]); |
read_string('"', vs_base[0]); |
1034 |
vs_base[0] = copy_simple_string(token); |
vs_base[0] = copy_simple_string(token); |
1035 |
} |
} |
1036 |
|
|
1037 |
|
void |
1038 |
Ldispatch_reader() |
Ldispatch_reader() |
1039 |
{ |
{ |
1040 |
object c, x; |
object c, x; |
1068 |
super_funcall(x); |
super_funcall(x); |
1069 |
} |
} |
1070 |
|
|
1071 |
|
void |
1072 |
Lsingle_quote_reader() |
Lsingle_quote_reader() |
1073 |
{ |
{ |
1074 |
check_arg(2); |
check_arg(2); |
1075 |
vs_pop; |
vs_popp; |
1076 |
vs_push(sLquote); |
vs_push(sLquote); |
1077 |
vs_push(read_object(vs_base[0])); |
vs_push(read_object(vs_base[0])); |
1078 |
vs_push(Cnil); |
vs_push(Cnil); |
1081 |
vs_base[0] = vs_pop; |
vs_base[0] = vs_pop; |
1082 |
} |
} |
1083 |
|
|
1084 |
|
void |
1085 |
Lright_parenthesis_reader() |
Lright_parenthesis_reader() |
1086 |
{ |
{ |
1087 |
check_arg(2); |
check_arg(2); |
1088 |
vs_pop; |
vs_popp; |
1089 |
vs_pop; |
vs_popp; |
1090 |
/* no result */ |
/* no result */ |
1091 |
} |
} |
1092 |
|
|
1094 |
Lcomma_reader(){} |
Lcomma_reader(){} |
1095 |
*/ |
*/ |
1096 |
|
|
1097 |
|
void |
1098 |
Lsemicolon_reader() |
Lsemicolon_reader() |
1099 |
{ |
{ |
1100 |
object c; |
object c; |
1101 |
object str= vs_base[0]; |
object str= vs_base[0]; |
1102 |
check_arg(2); |
check_arg(2); |
1103 |
vs_pop; |
vs_popp; |
1104 |
do |
do |
1105 |
{ read_char_to(c,str, goto L); } |
{ read_char_to(c,str, goto L); } |
1106 |
while (char_code(c) != '\n'); |
while (char_code(c) != '\n'); |
1107 |
L: |
L: |
1108 |
vs_pop; |
vs_popp; |
1109 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1110 |
/* no result */ |
/* no result */ |
1111 |
} |
} |
1117 |
/* |
/* |
1118 |
sharpmacro routines |
sharpmacro routines |
1119 |
*/ |
*/ |
1120 |
|
void |
1121 |
|
extra_argument(int); |
1122 |
|
|
1123 |
|
void |
1124 |
Lsharp_C_reader() |
Lsharp_C_reader() |
1125 |
{ |
{ |
1126 |
object x, c; |
object x, c; |
1128 |
check_arg(3); |
check_arg(3); |
1129 |
if (vs_base[2] != Cnil && !READsuppress) |
if (vs_base[2] != Cnil && !READsuppress) |
1130 |
extra_argument('C'); |
extra_argument('C'); |
1131 |
vs_pop; |
vs_popp; |
1132 |
vs_pop; |
vs_popp; |
1133 |
c = read_char(vs_base[0]); |
c = read_char(vs_base[0]); |
1134 |
if (char_code(c) != '(') |
if (char_code(c) != '(') |
1135 |
FEerror("A left parenthesis is expected.", 0); |
FEerror("A left parenthesis is expected.", 0); |
1162 |
vs_top = vs_base + 1; |
vs_top = vs_base + 1; |
1163 |
} |
} |
1164 |
|
|
1165 |
|
void |
1166 |
Lsharp_backslash_reader() |
Lsharp_backslash_reader() |
1167 |
{ |
{ |
1168 |
object c; |
object c; |
1173 |
fix(vs_base[2]) != 0) |
fix(vs_base[2]) != 0) |
1174 |
FEerror("~S is an illegal CHAR-FONT.", 1, vs_base[2]); |
FEerror("~S is an illegal CHAR-FONT.", 1, vs_base[2]); |
1175 |
/* assuming that CHAR-FONT-LIMIT is 1 */ |
/* assuming that CHAR-FONT-LIMIT is 1 */ |
1176 |
vs_pop; |
vs_popp; |
1177 |
vs_pop; |
vs_popp; |
1178 |
unread_char(code_char('\\'), vs_base[0]); |
unread_char(code_char('\\'), vs_base[0]); |
1179 |
if (READsuppress) { |
if (READsuppress) { |
1180 |
(void)read_object(vs_base[0]); |
(void)read_object(vs_base[0]); |
1217 |
FEerror("~S is an illegal character name.", 1, c); |
FEerror("~S is an illegal character name.", 1, c); |
1218 |
} |
} |
1219 |
|
|
1220 |
|
void |
1221 |
Lsharp_single_quote_reader() |
Lsharp_single_quote_reader() |
1222 |
{ |
{ |
1223 |
|
|
1224 |
check_arg(3); |
check_arg(3); |
1225 |
if(vs_base[2] != Cnil && !READsuppress) |
if(vs_base[2] != Cnil && !READsuppress) |
1226 |
extra_argument('#'); |
extra_argument('#'); |
1227 |
vs_pop; |
vs_popp; |
1228 |
vs_pop; |
vs_popp; |
1229 |
vs_push(sLfunction); |
vs_push(sLfunction); |
1230 |
vs_push(read_object(vs_base[0])); |
vs_push(read_object(vs_base[0])); |
1231 |
vs_push(Cnil); |
vs_push(Cnil); |
1243 |
|
|
1244 |
object siScomma; |
object siScomma; |
1245 |
|
|
1246 |
|
void |
1247 |
Lsharp_left_parenthesis_reader() |
Lsharp_left_parenthesis_reader() |
1248 |
{ |
{ |
1249 |
object endp_temp; |
object endp_temp; |
1250 |
|
|
1251 |
int dim; |
int dim=0; |
1252 |
int dimcount; |
int dimcount; |
1253 |
object in, x; |
object in, x; |
1254 |
int a; |
int a; |
1259 |
dim = -1; |
dim = -1; |
1260 |
else if (type_of(vs_base[2]) == t_fixnum) |
else if (type_of(vs_base[2]) == t_fixnum) |
1261 |
dim = fix(vs_base[2]); |
dim = fix(vs_base[2]); |
1262 |
vs_pop; |
vs_popp; |
1263 |
vs_pop; |
vs_popp; |
1264 |
in = vs_base[0]; |
in = vs_base[0]; |
1265 |
if (backq_level > 0) { |
if (backq_level > 0) { |
1266 |
unreadc_stream('(', in); |
unreadc_stream('(', in); |
1320 |
vs_push(x); |
vs_push(x); |
1321 |
x->v.v_self |
x->v.v_self |
1322 |
= (object *)alloc_relblock(dimcount * sizeof(object)); |
= (object *)alloc_relblock(dimcount * sizeof(object)); |
1323 |
vs_pop; |
vs_popp; |
1324 |
for (dim = 0; dim < dimcount; dim++) |
for (dim = 0; dim < dimcount; dim++) |
1325 |
x->v.v_self[dim] = vsp[dim]; |
x->v.v_self[dim] = vsp[dim]; |
1326 |
vs_top = vs_base; |
vs_top = vs_base; |
1328 |
vs_push(x); |
vs_push(x); |
1329 |
} |
} |
1330 |
|
|
1331 |
|
void |
1332 |
Lsharp_asterisk_reader() |
Lsharp_asterisk_reader() |
1333 |
{ |
{ |
1334 |
int dim; |
int dim=0; |
1335 |
int dimcount; |
int dimcount; |
1336 |
object in, x; |
object in, x; |
1337 |
object *vsp; |
object *vsp; |
1339 |
check_arg(3); |
check_arg(3); |
1340 |
if (READsuppress) { |
if (READsuppress) { |
1341 |
read_constituent(vs_base[0]); |
read_constituent(vs_base[0]); |
1342 |
vs_pop; |
vs_popp; |
1343 |
vs_pop; |
vs_popp; |
1344 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1345 |
return; |
return; |
1346 |
} |
} |
1348 |
dim = -1; |
dim = -1; |
1349 |
else if (type_of(vs_head) == t_fixnum) |
else if (type_of(vs_head) == t_fixnum) |
1350 |
dim = fix(vs_head); |
dim = fix(vs_head); |
1351 |
vs_pop; |
vs_popp; |
1352 |
vs_pop; |
vs_popp; |
1353 |
in = vs_head; |
in = vs_head; |
1354 |
vsp = vs_top; |
vsp = vs_top; |
1355 |
dimcount = 0; |
dimcount = 0; |
1379 |
x = alloc_simple_bitvector(dimcount); |
x = alloc_simple_bitvector(dimcount); |
1380 |
vs_push(x); |
vs_push(x); |
1381 |
x->bv.bv_self = alloc_relblock((dimcount + 7)/8); |
x->bv.bv_self = alloc_relblock((dimcount + 7)/8); |
1382 |
vs_pop; |
vs_popp; |
1383 |
for (dim = 0; dim < dimcount; dim++) |
for (dim = 0; dim < dimcount; dim++) |
1384 |
if (char_code(vsp[dim]) == '0') |
if (char_code(vsp[dim]) == '0') |
1385 |
x->bv.bv_self[dim/8] &= ~(0200 >> dim%8); |
x->bv.bv_self[dim/8] &= ~(0200 >> dim%8); |
1390 |
vs_push(x); |
vs_push(x); |
1391 |
} |
} |
1392 |
|
|
1393 |
|
void |
1394 |
Lsharp_colon_reader() |
Lsharp_colon_reader() |
1395 |
{ |
{ |
1396 |
object in; |
object in; |
1400 |
|
|
1401 |
if (vs_base[2] != Cnil && !READsuppress) |
if (vs_base[2] != Cnil && !READsuppress) |
1402 |
extra_argument(':'); |
extra_argument(':'); |
1403 |
vs_pop; |
vs_popp; |
1404 |
vs_pop; |
vs_popp; |
1405 |
in = vs_base[0]; |
in = vs_base[0]; |
1406 |
c = read_char(in); |
c = read_char(in); |
1407 |
a = cat(c); |
a = cat(c); |
1457 |
vs_base[0] = make_symbol(vs_base[0]); |
vs_base[0] = make_symbol(vs_base[0]); |
1458 |
} |
} |
1459 |
|
|
1460 |
|
void |
1461 |
Lsharp_dot_reader() |
Lsharp_dot_reader() |
1462 |
{ |
{ |
1463 |
check_arg(3); |
check_arg(3); |
1464 |
if(vs_base[2] != Cnil && !READsuppress) |
if(vs_base[2] != Cnil && !READsuppress) |
1465 |
extra_argument('.'); |
extra_argument('.'); |
1466 |
vs_pop; |
vs_popp; |
1467 |
vs_pop; |
vs_popp; |
1468 |
if (READsuppress) { |
if (READsuppress) { |
1469 |
read_object(vs_base[0]); |
read_object(vs_base[0]); |
1470 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1474 |
vs_base[0] = ieval(vs_base[0]); |
vs_base[0] = ieval(vs_base[0]); |
1475 |
} |
} |
1476 |
|
|
1477 |
|
void |
1478 |
Lsharp_comma_reader() |
Lsharp_comma_reader() |
1479 |
{ |
{ |
1480 |
check_arg(3); |
check_arg(3); |
1481 |
if(vs_base[2] != Cnil && !READsuppress) |
if(vs_base[2] != Cnil && !READsuppress) |
1482 |
extra_argument(','); |
extra_argument(','); |
1483 |
vs_pop; |
vs_popp; |
1484 |
vs_pop; |
vs_popp; |
1485 |
if (READsuppress) { |
if (READsuppress) { |
1486 |
read_object(vs_base[0]); |
read_object(vs_base[0]); |
1487 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1491 |
vs_base[0] = ieval(vs_base[0]); |
vs_base[0] = ieval(vs_base[0]); |
1492 |
} |
} |
1493 |
|
|
1494 |
|
void |
1495 |
siLsharp_comma_reader_for_compiler() |
siLsharp_comma_reader_for_compiler() |
1496 |
{ |
{ |
1497 |
check_arg(3); |
check_arg(3); |
1498 |
if(vs_base[2] != Cnil && !READsuppress) |
if(vs_base[2] != Cnil && !READsuppress) |
1499 |
extra_argument(','); |
extra_argument(','); |
1500 |
vs_pop; |
vs_popp; |
1501 |
vs_pop; |
vs_popp; |
1502 |
if (READsuppress) { |
if (READsuppress) { |
1503 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1504 |
return; |
return; |
1510 |
/* |
/* |
1511 |
For fasload. |
For fasload. |
1512 |
*/ |
*/ |
1513 |
|
void |
1514 |
Lsharp_exclamation_reader() |
Lsharp_exclamation_reader() |
1515 |
{ |
{ |
1516 |
check_arg(3); |
check_arg(3); |
1517 |
if(vs_base[2] != Cnil && !READsuppress) |
if(vs_base[2] != Cnil && !READsuppress) |
1518 |
extra_argument('!'); |
extra_argument('!'); |
1519 |
vs_pop; |
vs_popp; |
1520 |
vs_pop; |
vs_popp; |
1521 |
if (READsuppress) { |
if (READsuppress) { |
1522 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1523 |
return; |
return; |
1524 |
} |
} |
1525 |
vs_base[0] = read_object(vs_base[0]); |
vs_base[0] = read_object(vs_base[0]); |
1526 |
ieval(vs_base[0]); |
ieval(vs_base[0]); |
1527 |
vs_pop; |
vs_popp; |
1528 |
} |
} |
1529 |
|
|
1530 |
|
void |
1531 |
Lsharp_B_reader() |
Lsharp_B_reader() |
1532 |
{ |
{ |
1533 |
int i; |
int i; |
1534 |
|
|
1535 |
if(vs_base[2] != Cnil && !READsuppress) |
if(vs_base[2] != Cnil && !READsuppress) |
1536 |
extra_argument('B'); |
extra_argument('B'); |
1537 |
vs_pop; |
vs_popp; |
1538 |
vs_pop; |
vs_popp; |
1539 |
read_constituent(vs_base[0]); |
read_constituent(vs_base[0]); |
1540 |
if (READsuppress) { |
if (READsuppress) { |
1541 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1551 |
1, vs_base[0]); |
1, vs_base[0]); |
1552 |
} |
} |
1553 |
|
|
1554 |
|
void |
1555 |
Lsharp_O_reader() |
Lsharp_O_reader() |
1556 |
{ |
{ |
1557 |
int i; |
int i; |
1558 |
|
|
1559 |
if(vs_base[2] != Cnil && !READsuppress) |
if(vs_base[2] != Cnil && !READsuppress) |
1560 |
extra_argument('O'); |
extra_argument('O'); |
1561 |
vs_pop; |
vs_popp; |
1562 |
vs_pop; |
vs_popp; |
1563 |
read_constituent(vs_base[0]); |
read_constituent(vs_base[0]); |
1564 |
if (READsuppress) { |
if (READsuppress) { |
1565 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1575 |
1, vs_base[0]); |
1, vs_base[0]); |
1576 |
} |
} |
1577 |
|
|
1578 |
|
void |
1579 |
Lsharp_X_reader() |
Lsharp_X_reader() |
1580 |
{ |
{ |
1581 |
int i; |
int i; |
1582 |
|
|
1583 |
if(vs_base[2] != Cnil && !READsuppress) |
if(vs_base[2] != Cnil && !READsuppress) |
1584 |
extra_argument('X'); |
extra_argument('X'); |
1585 |
vs_pop; |
vs_popp; |
1586 |
vs_pop; |
vs_popp; |
1587 |
read_constituent(vs_base[0]); |
read_constituent(vs_base[0]); |
1588 |
if (READsuppress) { |
if (READsuppress) { |
1589 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1599 |
1, vs_base[0]); |
1, vs_base[0]); |
1600 |
} |
} |
1601 |
|
|
1602 |
|
void |
1603 |
Lsharp_R_reader() |
Lsharp_R_reader() |
1604 |
{ |
{ |
1605 |
int radix, i; |
int radix=0, i; |
1606 |
|
|
1607 |
check_arg(3); |
check_arg(3); |
1608 |
if (READsuppress) |
if (READsuppress) |
1613 |
FEerror("~S is an illegal radix.", 1, vs_base[2]); |
FEerror("~S is an illegal radix.", 1, vs_base[2]); |
1614 |
} else |
} else |
1615 |
FEerror("No radix was supplied in the #R readmacro.", 0); |
FEerror("No radix was supplied in the #R readmacro.", 0); |
1616 |
vs_pop; |
vs_popp; |
1617 |
vs_pop; |
vs_popp; |
1618 |
read_constituent(vs_base[0]); |
read_constituent(vs_base[0]); |
1619 |
if (READsuppress) { |
if (READsuppress) { |
1620 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1630 |
1, vs_base[0]); |
1, vs_base[0]); |
1631 |
} |
} |
1632 |
|
|
1633 |
Lsharp_A_reader(){} |
void Lsharp_A_reader(){} |
1634 |
|
|
1635 |
Lsharp_S_reader(){} |
void Lsharp_S_reader(){} |
1636 |
|
|
1637 |
|
void |
1638 |
Lsharp_eq_reader() |
Lsharp_eq_reader() |
1639 |
{ |
{ |
1640 |
int i; |
int i; |
1665 |
vs_top = vs_base+1; |
vs_top = vs_base+1; |
1666 |
} |
} |
1667 |
|
|
1668 |
|
void |
1669 |
Lsharp_sharp_reader() |
Lsharp_sharp_reader() |
1670 |
{ |
{ |
1671 |
int i; |
int i; |
1672 |
|
|
1673 |
check_arg(3); |
check_arg(3); |
1674 |
if (READsuppress) { |
if (READsuppress) { |
1675 |
vs_pop; |
vs_popp; |
1676 |
vs_pop; |
vs_popp; |
1677 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1678 |
} |
} |
1679 |
if (vs_base[2] == Cnil) |
if (vs_base[2] == Cnil) |
1692 |
vs_top = vs_base+1; |
vs_top = vs_base+1; |
1693 |
} |
} |
1694 |
|
|
1695 |
|
void |
1696 |
patch_sharp_cons(x) |
patch_sharp_cons(x) |
1697 |
object x; |
object x; |
1698 |
{ |
{ |
1764 |
break; |
break; |
1765 |
} |
} |
1766 |
|
|
1767 |
|
default: |
1768 |
|
break; |
1769 |
} |
} |
1770 |
return(x); |
return(x); |
1771 |
} |
} |
1772 |
|
|
1773 |
Lsharp_plus_reader(){} |
void Lsharp_plus_reader(){} |
1774 |
|
|
1775 |
Lsharp_minus_reader(){} |
void Lsharp_minus_reader(){} |
1776 |
|
|
1777 |
Lsharp_less_than_reader(){} |
void Lsharp_less_than_reader(){} |
1778 |
|
|
1779 |
Lsharp_whitespace_reader(){} |
void Lsharp_whitespace_reader(){} |
1780 |
|
|
1781 |
Lsharp_right_parenthesis_reader(){} |
void Lsharp_right_parenthesis_reader(){} |
1782 |
|
|
1783 |
|
void |
1784 |
Lsharp_vertical_bar_reader() |
Lsharp_vertical_bar_reader() |
1785 |
{ |
{ |
1786 |
int c; |
int c; |
1789 |
check_arg(3); |
check_arg(3); |
1790 |
if (vs_base[2] != Cnil && !READsuppress) |
if (vs_base[2] != Cnil && !READsuppress) |
1791 |
extra_argument('|'); |
extra_argument('|'); |
1792 |
vs_pop; |
vs_popp; |
1793 |
vs_pop; |
vs_popp; |
1794 |
for (;;) { |
for (;;) { |
1795 |
c = readc_stream(vs_base[0]); |
c = readc_stream(vs_base[0]); |
1796 |
L: |
L: |
1809 |
goto L; |
goto L; |
1810 |
} |
} |
1811 |
} |
} |
1812 |
vs_pop; |
vs_popp; |
1813 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1814 |
/* no result */ |
/* no result */ |
1815 |
} |
} |
1816 |
|
|
1817 |
|
void |
1818 |
Ldefault_dispatch_macro() |
Ldefault_dispatch_macro() |
1819 |
{ |
{ |
1820 |
FEerror("The default dispatch macro signalled an error.", 0); |
FEerror("The default dispatch macro signalled an error.", 0); |
1823 |
/* |
/* |
1824 |
#p" ... " returns the pathname with namestring ... . |
#p" ... " returns the pathname with namestring ... . |
1825 |
*/ |
*/ |
1826 |
static |
static void |
1827 |
Lsharp_p_reader() |
Lsharp_p_reader() |
1828 |
{ |
{ |
1829 |
check_arg(3); |
check_arg(3); |
1830 |
if (vs_base[2] != Cnil && !READsuppress) |
if (vs_base[2] != Cnil && !READsuppress) |
1831 |
extra_argument('p'); |
extra_argument('p'); |
1832 |
vs_pop; |
vs_popp; |
1833 |
vs_pop; |
vs_popp; |
1834 |
vs_base[0] = read_object(vs_base[0]); |
vs_base[0] = read_object(vs_base[0]); |
1835 |
vs_base[0] = coerce_to_pathname(vs_base[0]); |
vs_base[0] = coerce_to_pathname(vs_base[0]); |
1836 |
} |
} |
1838 |
/* |
/* |
1839 |
#" ... " returns the pathname with namestring ... . |
#" ... " returns the pathname with namestring ... . |
1840 |
*/ |
*/ |
1841 |
|
void |
1842 |
Lsharp_double_quote_reader() |
Lsharp_double_quote_reader() |
1843 |
{ |
{ |
1844 |
check_arg(3); |
check_arg(3); |
1845 |
|
|
1846 |
if (vs_base[2] != Cnil && !READsuppress) |
if (vs_base[2] != Cnil && !READsuppress) |
1847 |
extra_argument('"'); |
extra_argument('"'); |
1848 |
vs_pop; |
vs_popp; |
1849 |
unread_char(vs_base[1], vs_base[0]); |
unread_char(vs_base[1], vs_base[0]); |
1850 |
vs_pop; |
vs_popp; |
1851 |
vs_base[0] = read_object(vs_base[0]); |
vs_base[0] = read_object(vs_base[0]); |
1852 |
vs_base[0] = coerce_to_pathname(vs_base[0]); |
vs_base[0] = coerce_to_pathname(vs_base[0]); |
1853 |
} |
} |
1856 |
#$ fixnum returns a random-state with the fixnum |
#$ fixnum returns a random-state with the fixnum |
1857 |
as its content. |
as its content. |
1858 |
*/ |
*/ |
1859 |
|
void |
1860 |
Lsharp_dollar_reader() |
Lsharp_dollar_reader() |
1861 |
{ |
{ |
1862 |
int i; |
int i; |
1864 |
check_arg(3); |
check_arg(3); |
1865 |
if (vs_base[2] != Cnil && !READsuppress) |
if (vs_base[2] != Cnil && !READsuppress) |
1866 |
extra_argument('$'); |
extra_argument('$'); |
1867 |
vs_pop; |
vs_popp; |
1868 |
vs_pop; |
vs_popp; |
1869 |
vs_base[0] = read_object(vs_base[0]); |
vs_base[0] = read_object(vs_base[0]); |
1870 |
if (type_of(vs_base[0]) != t_fixnum) |
if (type_of(vs_base[0]) != t_fixnum) |
1871 |
FEerror("Cannot make a random-state with the value ~S.", |
FEerror("Cannot make a random-state with the value ~S.", |
2001 |
|
|
2002 |
int i; |
int i; |
2003 |
bool e; |
bool e; |
2004 |
int old_sharp_eq_context_max; |
volatile int old_sharp_eq_context_max=0; |
2005 |
struct sharp_eq_context_struct |
struct sharp_eq_context_struct |
2006 |
old_sharp_eq_context[SHARP_EQ_CONTEXT_SIZE]; |
old_sharp_eq_context[SHARP_EQ_CONTEXT_SIZE]; |
2007 |
int old_backq_level; |
volatile int old_backq_level=0; |
2008 |
|
|
2009 |
@ |
@ |
2010 |
|
|
2220 |
strm = symbol_value(sLAterminal_ioA); |
strm = symbol_value(sLAterminal_ioA); |
2221 |
check_type_stream(&strm); |
check_type_stream(&strm); |
2222 |
#ifdef LISTEN_FOR_INPUT |
#ifdef LISTEN_FOR_INPUT |
2223 |
while(listen_stream(strm)) {read_char(strm);} |
while(listen_stream(strm)) {readc_stream(strm);} |
2224 |
#endif |
#endif |
2225 |
@(return Cnil) |
@(return Cnil) |
2226 |
@) |
@) |
2239 |
fix(radix) < 2 || fix(radix) > 36) |
fix(radix) < 2 || fix(radix) > 36) |
2240 |
FEerror("~S is an illegal radix.", 1, radix); |
FEerror("~S is an illegal radix.", 1, radix); |
2241 |
setup_READtable(); |
setup_READtable(); |
2242 |
while (READtable->rt.rt_self[strng->st.st_self[s]].rte_chattrib |
while (READtable->rt.rt_self[(unsigned char)strng->st.st_self[s]].rte_chattrib |
2243 |
== cat_whitespace && s < e) |
== cat_whitespace && s < e) |
2244 |
s++; |
s++; |
2245 |
if (s >= e) { |
if (s >= e) { |
2262 |
if (junk_allowed != Cnil) |
if (junk_allowed != Cnil) |
2263 |
@(return x `make_fixnum(ep+s)`) |
@(return x `make_fixnum(ep+s)`) |
2264 |
for (s += ep ; s < e; s++) |
for (s += ep ; s < e; s++) |
2265 |
if (READtable->rt.rt_self[strng->st.st_self[s]] |
if (READtable->rt.rt_self[(unsigned char)strng->st.st_self[s]] |
2266 |
.rte_chattrib |
.rte_chattrib |
2267 |
!= cat_whitespace) |
!= cat_whitespace) |
2268 |
goto CANNOT_PARSE; |
goto CANNOT_PARSE; |
2320 |
@(return `copy_readtable(from, to)`) |
@(return `copy_readtable(from, to)`) |
2321 |
@) |
@) |
2322 |
|
|
2323 |
|
void |
2324 |
Lreadtablep() |
Lreadtablep() |
2325 |
{ |
{ |
2326 |
check_arg(1); |
check_arg(1); |
2469 |
return(x); |
return(x); |
2470 |
} |
} |
2471 |
|
|
2472 |
|
void |
2473 |
siLstring_to_object() |
siLstring_to_object() |
2474 |
{ |
{ |
2475 |
check_arg(1); |
check_arg(1); |
2479 |
} |
} |
2480 |
|
|
2481 |
|
|
2482 |
|
void |
2483 |
siLstandard_readtable() |
siLstandard_readtable() |
2484 |
{ |
{ |
2485 |
check_arg(0); |
check_arg(0); |
2487 |
vs_push(standard_readtable); |
vs_push(standard_readtable); |
2488 |
} |
} |
2489 |
|
|
2490 |
too_long_token() |
void |
2491 |
|
too_long_token(void) |
2492 |
{ |
{ |
2493 |
char *q; |
char *q; |
2494 |
int i; |
int i; |
2506 |
*/ |
*/ |
2507 |
} |
} |
2508 |
|
|
2509 |
too_long_string() |
void |
2510 |
|
too_long_string(void) |
2511 |
{ |
{ |
2512 |
char *q; |
char *q; |
2513 |
int i; |
int i; |
2524 |
*/ |
*/ |
2525 |
} |
} |
2526 |
|
|
2527 |
|
void |
2528 |
extra_argument(c) |
extra_argument(c) |
2529 |
int c; |
int c; |
2530 |
{ |
{ |
2541 |
DEFVAR("*READ-SUPPRESS*",sLAread_suppressA,LISP,Cnil,""); |
DEFVAR("*READ-SUPPRESS*",sLAread_suppressA,LISP,Cnil,""); |
2542 |
|
|
2543 |
|
|
2544 |
|
void |
2545 |
init_read() |
init_read() |
2546 |
{ |
{ |
2547 |
struct rtent *rtab; |
struct rtent *rtab; |
2687 |
*/ |
*/ |
2688 |
} |
} |
2689 |
|
|
2690 |
|
void |
2691 |
init_read_function() |
init_read_function() |
2692 |
{ |
{ |
2693 |
make_function("READ", Lread); |
make_function("READ", Lread); |
2734 |
{ |
{ |
2735 |
int dimcount, dim; |
int dimcount, dim; |
2736 |
object *vsp; |
object *vsp; |
|
|
|
2737 |
VOL object x; |
VOL object x; |
2738 |
int i; |
int i; |
2739 |
bool e; |
bool e; |
2746 |
old_sharp_eq_context[SHARP_EQ_CONTEXT_SIZE]; |
old_sharp_eq_context[SHARP_EQ_CONTEXT_SIZE]; |
2747 |
int old_backq_level; |
int old_backq_level; |
2748 |
|
|
2749 |
|
vsp=(object *)&vsp; |
2750 |
old_READtable = READtable; |
old_READtable = READtable; |
2751 |
old_READdefault_float_format = READdefault_float_format; |
old_READdefault_float_format = READdefault_float_format; |
2752 |
old_READbase = READbase; |
old_READbase = READbase; |