示例#1
0
文件: read.c 项目: troter/thesis
/* <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;
}
示例#2
0
文件: synch.c 项目: Fuhuiang/rscheme
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 );
}
示例#3
0
文件: vinsns.c 项目: Fuhuiang/rscheme
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;
}
示例#4
0
文件: string.c 项目: Archs/scheme
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;
}