/* <list> -> (<datum>*) | (<datum>+ . <datum>) | <abbreviation>
*/
static SCM read_list(FILE *file)
{
int c;
SCM lst = SCM_NULL;
SCM last_pair = SCM_NULL;
SCM datum = SCM_NULL;
for (;;) {
c = skip_comment_and_space(file);
switch (c) {
case EOF:
goto syntax_error;
break;
case ')': /* end of list */
return lst;
case '.': /* dot pair */
if (NULL_P(last_pair)) /* ( . <datum>) is invalid */
goto syntax_error;
CDR(last_pair) = scm_proc_read(file);
c = skip_comment_and_space(file);
if (c != ')')
goto syntax_error;
return lst;
break;
default: /* read datum */
ungetc(c, file);
datum = scm_proc_read(file);
if (NULL_P(lst)) { /* initialize list */
lst = new_cons(datum, SCM_NULL);
last_pair= lst;
} else {
CDR(last_pair) = new_cons(datum, SCM_NULL);
last_pair = CDR(last_pair);
}
}
}
syntax_error:
scheme_error("syntax error");
return NULL;
}
void krelease_joiners( obj t )
{
obj p;
for (p=gvec_ref( t, THREAD_JOINS ); !NULL_P(p); p=pair_cdr(p))
{
obj jt = pair_car(p);
assert( EQ( gvec_ref( jt, THREAD_BLOCKED_ON ), t ));
UNBLOCK_THREAD( jt );
store_resume_value( jt, REG0 );
mark_thread_ready( jt );
}
gvec_write_non_ptr( t, THREAD_JOINS, NIL_OBJ );
}
unsigned expand_last( void )
{
obj list = ZERO;
unsigned N = 0;
switch (arg_count_reg)
{
case 0:
scheme_error( "expand_list: no arguments", 0 );
break;
STAGE(0,1);
STAGE(1,2);
STAGE(2,3);
STAGE(3,4);
STAGE(4,5);
STAGE(5,6);
STAGE(6,7);
STAGE(7,8);
STAGE(8,9);
STAGE(9,10);
default:
/* this is for cases 11, 12, ..., since STAGE(9,10) is case 10
* hence, N = (arg_count_reg - 1) is at least 10
*/
N = arg_count_reg - 1;
list = REG(N);
filled_10:
while (PAIR_P(list))
{
REG(N) = pair_car( list );
list = pair_cdr( list );
N++;
if (N >= IMPL_ARG_LIMIT)
scheme_error( "expand_last: list of args too long at: ~#*@40s",
1, list );
}
break;
}
if (!NULL_P(list))
{
scheme_error( "expand_last: last arg not a proper list at ~a",
1,
list );
}
return N;
}
static void primop_list_to_string(long argc) {
object l = sp[0];
long i, max = 0;
object s;
char *p;
while (PAIR_P(l)) {
object c = CAR(l);
if (!CHARACTER_P(c))
error(sp[0],"list contains a non-character");
max++;
l = CDR(l);
}
if (!NULL_P(l))
error(sp[0],"not a proper list");
s = make_string_of_size(max,0);
p = STRING_VALUE(s);
l = sp[0];
for (i=0; i<max; i++) {
*p++ = CHARACTER_VALUE(CAR(l));
l = CDR(l);
}
*p = '\0';
*sp = s;
}