79 |
#define MAX_PACKAGE_STACK 1024 |
#define MAX_PACKAGE_STACK 1024 |
80 |
static object P0[MAX_PACKAGE_STACK],*PP0=P0,LP; |
static object P0[MAX_PACKAGE_STACK],*PP0=P0,LP; |
81 |
|
|
82 |
|
static int inlp; |
83 |
|
|
84 |
static void |
static void |
85 |
setup_READ() |
setup_READ() |
86 |
{ |
{ |
112 |
|
|
113 |
PP0=P0; |
PP0=P0; |
114 |
LP=NULL; |
LP=NULL; |
115 |
|
inlp=0; |
116 |
|
|
117 |
} |
} |
118 |
|
|
481 |
FEerror("The readmacro ~S returned ~D values.", |
FEerror("The readmacro ~S returned ~D values.", |
482 |
2, fun_box[0], vs_top[-1]); |
2, fun_box[0], vs_top[-1]); |
483 |
} |
} |
484 |
result = vs_base[0]; |
result = READsuppress ? Cnil : vs_base[0]; /*FIXME, centralize here rather than in |
485 |
|
reader macros ??*/ |
486 |
vs_base = old_vs_base; |
vs_base = old_vs_base; |
487 |
vs_reset; |
vs_reset; |
488 |
return(result); |
return(result); |
531 |
} else { |
} else { |
532 |
|
|
533 |
if (trt(c)==trait_invalid) |
if (trt(c)==trait_invalid) |
534 |
READER_ERROR("Cannot read character"); |
READER_ERROR(in,"Cannot read character"); |
535 |
|
|
536 |
if ('A' <= char_code(c) && char_code(c) <= 'z') { |
if ('A' <= char_code(c) && char_code(c) <= 'z') { |
537 |
if ('a' <= char_code(c) && char_code(c) <= 'z' && |
if ('a' <= char_code(c) && char_code(c) <= 'z' && |
648 |
return(x); |
return(x); |
649 |
} |
} |
650 |
|
|
|
static int inlp; |
|
|
|
|
651 |
static void |
static void |
652 |
Lleft_parenthesis_reader() |
Lleft_parenthesis_reader() |
653 |
{ |
{ |
1144 |
{ |
{ |
1145 |
check_arg(2); |
check_arg(2); |
1146 |
if (!inlp) |
if (!inlp) |
1147 |
READER_ERROR("Right paren found with no left."); |
READER_ERROR(vs_base[0],"Right paren found with no left."); |
1148 |
vs_popp; |
vs_popp; |
1149 |
vs_popp; |
vs_popp; |
1150 |
/* no result */ |
/* no result */ |
1183 |
static void |
static void |
1184 |
Lsharp_C_reader() |
Lsharp_C_reader() |
1185 |
{ |
{ |
1186 |
object x, c; |
object x; |
1187 |
|
|
1188 |
check_arg(3); |
check_arg(3); |
1189 |
if (vs_base[2] != Cnil && !READsuppress) |
if (vs_base[2] != Cnil && !READsuppress) |
1190 |
extra_argument('C'); |
extra_argument('C'); |
1191 |
vs_popp; |
vs_popp; |
1192 |
vs_popp; |
vs_popp; |
1193 |
c = read_char(vs_base[0]); |
|
1194 |
if (char_code(c) != '(') |
if (READsuppress) { |
1195 |
FEerror("A left parenthesis is expected.", 0); |
read_object(vs_base[0]); |
1196 |
delimiting_char = code_char(')'); |
vs_base[0]= Cnil; |
|
x = read_object(vs_base[0]); |
|
|
if (x == OBJNULL) |
|
|
FEerror("No real part.", 0); |
|
|
if (!realp(x)) |
|
|
TYPE_ERROR(x,TSor_rational_float); |
|
|
vs_push(x); |
|
|
delimiting_char = code_char(')'); |
|
|
x = read_object(vs_base[0]); |
|
|
if (x == OBJNULL) |
|
|
FEerror("No imaginary part.", 0); |
|
|
if (!realp(x)) |
|
|
TYPE_ERROR(x,TSor_rational_float); |
|
|
vs_push(x); |
|
|
delimiting_char = code_char(')'); |
|
|
x = read_object(vs_base[0]); |
|
|
if (x != OBJNULL) |
|
|
FEerror("A right parenthesis is expected.", 0); |
|
|
if (READsuppress) vs_base[0]= Cnil ; |
|
|
else |
|
|
if (contains_sharp_comma(vs_base[1]) || |
|
|
contains_sharp_comma(vs_base[2])) { |
|
|
vs_base[0] = alloc_object(t_complex); |
|
|
vs_base[0]->cmp.cmp_real = vs_base[1]; |
|
|
vs_base[0]->cmp.cmp_imag = vs_base[2]; |
|
1197 |
} else { |
} else { |
1198 |
check_type_number(&vs_base[1]); |
x = read_char(vs_base[0]); |
1199 |
check_type_number(&vs_base[2]); |
if (char_code(x) != '(') |
1200 |
vs_base[0] = make_complex(vs_base[1], vs_base[2]); |
READER_ERROR(vs_base[0],"A left parenthesis is expected."); |
1201 |
|
delimiting_char = code_char(')'); |
1202 |
|
x = read_object(vs_base[0]); |
1203 |
|
if (x==OBJNULL || !realp(x)) |
1204 |
|
TYPE_ERROR(x,TSor_rational_float); |
1205 |
|
vs_push(x); |
1206 |
|
delimiting_char = code_char(')'); |
1207 |
|
x = read_object(vs_base[0]); |
1208 |
|
if (x==OBJNULL || !realp(x)) |
1209 |
|
TYPE_ERROR(x,TSor_rational_float); |
1210 |
|
vs_push(x); |
1211 |
|
delimiting_char = code_char(')'); |
1212 |
|
x = read_object(vs_base[0]); |
1213 |
|
if (x != OBJNULL) |
1214 |
|
READER_ERROR(vs_base[0],"A right parenthesis is expected."); |
1215 |
|
if (contains_sharp_comma(vs_base[1]) || |
1216 |
|
contains_sharp_comma(vs_base[2])) { |
1217 |
|
vs_base[0] = alloc_object(t_complex); |
1218 |
|
vs_base[0]->cmp.cmp_real = vs_base[1]; |
1219 |
|
vs_base[0]->cmp.cmp_imag = vs_base[2]; |
1220 |
|
} else { |
1221 |
|
check_type_number(&vs_base[1]); |
1222 |
|
check_type_number(&vs_base[2]); |
1223 |
|
vs_base[0] = make_complex(vs_base[1], vs_base[2]); |
1224 |
|
} |
1225 |
} |
} |
1226 |
vs_top = vs_base + 1; |
vs_top = vs_base + 1; |
1227 |
} |
} |
1681 |
vs_popp; |
vs_popp; |
1682 |
vs_popp; |
vs_popp; |
1683 |
read_constituent(vs_base[0]); |
read_constituent(vs_base[0]); |
1684 |
|
vs_base[0] |
1685 |
|
= parse_number(token_buffer, token->st.st_fillp, &i, radix); |
1686 |
if (READsuppress) { |
if (READsuppress) { |
1687 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1688 |
return; |
return; |
1689 |
} |
} |
|
vs_base[0] |
|
|
= parse_number(token_buffer, token->st.st_fillp, &i, radix); |
|
1690 |
if (vs_base[0] == OBJNULL || i != token->st.st_fillp) |
if (vs_base[0] == OBJNULL || i != token->st.st_fillp) |
1691 |
FEerror("Cannot parse the #R readmacro.", 0); |
FEerror("Cannot parse the #R readmacro.", 0); |
1692 |
if (type_of(vs_base[0]) == t_shortfloat || |
if (type_of(vs_base[0]) == t_shortfloat || |
1740 |
vs_popp; |
vs_popp; |
1741 |
vs_popp; |
vs_popp; |
1742 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
1743 |
|
return; |
1744 |
} |
} |
1745 |
if (vs_base[2] == Cnil) |
if (vs_base[2] == Cnil) |
1746 |
FEerror("The ## readmacro requires an argument.", 0); |
FEerror("The ## readmacro requires an argument.", 0); |
1883 |
static void |
static void |
1884 |
Ldefault_dispatch_macro() |
Ldefault_dispatch_macro() |
1885 |
{ |
{ |
1886 |
READER_ERROR("The default dispatch macro signalled an error."); |
READER_ERROR(vs_base[0],"The default dispatch macro signalled an error."); |
1887 |
} |
} |
1888 |
|
|
1889 |
/* |
/* |
1898 |
vs_popp; |
vs_popp; |
1899 |
vs_popp; |
vs_popp; |
1900 |
vs_base[0] = read_object(vs_base[0]); |
vs_base[0] = read_object(vs_base[0]); |
1901 |
vs_base[0] = coerce_to_pathname(vs_base[0]); |
vs_base[0] = READsuppress ? Cnil : coerce_to_pathname(vs_base[0]); |
1902 |
} |
} |
1903 |
|
|
1904 |
/* |
/* |