Example #1
0
// ### %set-documentation object doctype new-value => new-value
Value SYS_set_documentation_internal(Value object, Value doctype, Value new_value)
{
  Value alist = DOCUMENTATION_HASH_TABLE->get(object);
  Value entry;
  if (alist == NULL_VALUE)
    {
      // no alist
      if (new_value != NIL)
        {
          entry = make_cons(doctype, new_value);
          alist = make_cons(entry, NIL);
          DOCUMENTATION_HASH_TABLE->put(object, alist);
        }
    }
  else
    {
      entry = EXT_assq(doctype, alist);
      if (consp(entry))
        the_cons(entry)->setcdr(new_value);
      else if (new_value != NIL)
        {
          // no entry
          entry = make_cons(doctype, new_value);
          alist = make_cons(entry, alist);
          DOCUMENTATION_HASH_TABLE->put(object, alist);
        }
    }
  return new_value;
}
Example #2
0
// ### fasl-read-backquote stream character => value
Value SYS_fasl_read_backquote(Value streamarg, Value ignored)
{
//   Stream * stream = check_ansi_stream(streamarg);
//   return make_cons(S_backquote,
//                    make_cons(stream->read(true, NIL, true, current_thread(), FASL_READTABLE)));
  return make_cons(S_backquote,
                   make_cons(stream_read(streamarg, true, NIL, true, current_thread(), FASL_READTABLE)));
}
Example #3
0
Value merge_directories(Value dir, Value default_dir)
{
    if (dir == NIL)
        return default_dir;
    if (car(dir) == K_relative && default_dir != NIL)
    {
        Value temp = NIL;
        while (default_dir != NIL)
        {
            temp = make_cons(car(default_dir), temp);
            default_dir = xcdr(default_dir);
        }
        dir = cdr(dir); // Skip :RELATIVE.
        while (dir != NIL)
        {
            temp = make_cons(car(dir), temp);
            dir = xcdr(dir);
        }
//       Value[] array = result.copyToArray();
//       for (long i = 0; i < array.length - 1; i++)
//         {
//           if (array[i] == Keyword.BACK)
//             {
//               if (array[i+1] instanceof AbstractString || array[i+1] == Keyword.WILD)
//                 {
//                   array[i] = null;
//                   array[i+1] = null;
//                 }
//             }
//         }
//       result = NIL;
//       for (long i = 0; i < array.length; i++)
//         {
//           if (array[i] != null)
//             result = new Cons(array[i], result);
//         }
        Value result = NIL;
        while (temp != NIL)
        {
            Value first = car(temp);
            if (first == K_back)
            {
                Value second = CL_cadr(temp);
                if (stringp(second) || second == K_wild)
                {
                    temp = CL_cddr(temp);
                    continue;
                }
            }
            result = make_cons(first, result);
            temp = xcdr(temp);
        }
        return result;
    }
    else
        return dir;
}
// ### multiple-value-call
Value CL_multiple_value_call(Value args, Environment * env, Thread * thread)
{
  const unsigned long numargs = length(args);
  if (numargs == 0)
    return wrong_number_of_arguments(S_multiple_value_call, numargs, 1, MANY);
  Function * function;
  Value value = eval(car(args), env, thread);
  args = xcdr(args);
  if (symbolp(value))
    {
      Symbol * sym = the_symbol(value);
      if (sym->is_special_operator() || sym->is_macro()
          || (function = (Function *) sym->function()) == NULL)
        {
          String * string = new String("The symbol ");
          string->append(sym->prin1_to_string());
          string->append(" does not designate a function.");
          return signal_lisp_error(new Error(string));
        }
    }
  else if (functionp(value))
    function = the_function(value);
  else
    {
      String * string = new String("The value ");
      string->append(::prin1_to_string(value));
      string->append(" does not designate a function.");
      return signal_lisp_error(new Error(string));
    }
  Value list = NIL;
  while (args != NIL)
    {
      Value result = eval(car(args), env, thread);
      if (thread->values_length() >= 0)
        {
          Value * values = thread->values();
          const long limit = thread->values_length();
          for (long i = 0; i < limit; i++)
            list = make_cons(values[i], list);
        }
      else
        list = make_cons(result, list);
      args = xcdr(args);
    }
  unsigned long len = length(list);
  Value * funcall_args = new (GC) Value[len + 1];
  funcall_args[0] = make_value(function);
  if (list != NIL)
    {
      for (long i = len; i > 0; i--)
        {
          funcall_args[i] = xcar(list);
          list = xcdr(list);
        }
    }
  return CL_funcall(len + 1, funcall_args);
}
Example #5
0
cons_t split(cons_t *ls, int n){
  if(n == 0){
    return (cons_t){.car = NULL, .cdr = ls};
  }
  cons_t *ret = make_cons(POP(ls), NULL);
  cons_t *ptr = ret;
  while(--n && ls){
    XSETCDR(ptr, make_cons(POP(ls), NULL));
    ptr = XCDR(ptr);
  }
  return (cons_t){.car = ret, .cdr = ls};
}
Example #6
0
static cons_t* mergesort_cons(cons_t *input, cmp_fun cmp){
  if(!input || !XCDR(input)){
    return input;
  }
  cons_t *head = NULL, *tail = NULL;
  while(input){
    head = make_cons(POP(input, head));
    if(!input){break;}
    tail = make_cons(POP(input, tail));
  }
  head = mergesort_cons(head, cmp);
  tail = mergesort_cons(tail, cmp);
  return merge_cons(head, tail, cmp);
}
Example #7
0
File: spec.c Project: Liutos/LiutCL
Cons values2cons(Values vals)
{
    Cons cur, head, pre;
    values_t v;

    pre = head = make_cons(lt_nil, lt_nil);
    v = theVALUES(vals);
    for (int i = 0; i < v->count; i++) {
        cur = make_cons(v->objs[i], lt_nil);
        set_cdr(pre, cur);
        pre = cur;
    }

    return CDR(head);
}
Example #8
0
// ### primitive-format
Value SYS_primitive_format(unsigned int numargs, Value args[])
{
  if (numargs < 2)
    return wrong_number_of_arguments(S_format, numargs, 2, MANY);
  Value destination = args[0];
  Value format_control = args[1];
  Value format_arguments = NIL;
  for (long i = numargs; i-- > 2;)
    format_arguments = make_cons(args[i], format_arguments);
  String * string = format_to_string(format_control, format_arguments);
  if (destination == T)
    {
      AnsiStream * out = check_ansi_stream(current_thread()->symbol_value(S_standard_output));
      out->write_string(string);
      return NIL;
    }
  if (destination == NIL)
    return make_value(string);
  // REVIEW
  if (ansi_stream_p(destination))
    {
      the_ansi_stream(destination)->write_string(string);
      return NIL;
    }
  assert(false);
  return NIL;
}
Example #9
0
Value Array_T::dimensions() const
{
    Value result = NIL;
    for (unsigned long i = _rank; i-- > 0;)
      result = make_cons(make_fixnum(_dimensions[i]), result);
    return result;
}
Example #10
0
CELL func_string_to_list(CELL frame)
{
	CELL string = FV0;
	if (!STRINGP(string)) {
		return make_exception("expects string");
	}
	CELL result = V_NULL;
	CELL pre_tail = V_EMPTY;

	gc_root_3("func_string_to_list", string, result, pre_tail);

	const size_t len = GET_STRING(string)->len;
	int i;
	for(i = 0; i < len; ++i) {
		const CELL next = make_cons(make_char(GET_STRING(string)->data[i]), V_NULL);
		if (i == 0) {
			result = next;
		}
		else {
			CDR(pre_tail) = next;
		}
		pre_tail = next;
	}
	gc_unroot();
	return result;
}
Example #11
0
CELL func_append(CELL frame)
{
	if (FC == 0) {
		return V_NULL;
	}

	CELL pre_tail = V_EMPTY;
	CELL result = V_EMPTY;
	CELL arg = V_EMPTY;
	gc_root_4("func_append", frame, pre_tail, result, arg);

	result = FV[FC-1];
	int argi = 0;
	while(argi < FC-1) {
		arg = FV[argi++];
		while(CONSP(arg)) {
			const CELL next = make_cons(CAR(arg), FV[FC-1]);
			if (EMPTYP(pre_tail)) {
				pre_tail = result = next;
			}
			else {
				pre_tail = CDR(pre_tail) = next;
			}
			arg = CDR(arg);
		}
		if (!NULLP(arg)) {
			gc_unroot();
			return make_exception("expects a <proper list> for all but last argument");
		}
	}
	gc_unroot();
	return result;
}
Example #12
0
CELL make_name_counted(char* s, size_t len)
{
	CELL list = g_interned_names;
	for( ; !NULLP(list); list = CDR(list)) {
		CELL name = CAR(list);
		NAME* p = GET_NAME(name);
		if (p->len == len && (opt_case_sensitive ? strncmp : strncasecmp)(p->data, s, len) == 0) {
			return name;
		}
	}

	CELL name = make_raw_name_counted(len);
    NAME* p = GET_NAME(name);
    if (opt_case_sensitive) {
        memcpy(p->data, s, len);
    }
    else {
        int i;
        for(i=0; i<len; ++i) {
            p->data[i] = tolower(s[i]);
        }
    }

	gc_root_1("make_name_counted", name);
	g_interned_names = make_cons(name, g_interned_names);
	gc_unroot();
	return name;
}
Example #13
0
CELL make_keyword_counted(char* s, size_t len)
{
	CELL list = g_interned_keywords;
	for( ; !NULLP(list); list = CDR(list)) {
		CELL keyword = CAR(list);
		KEYWORD* p = GET_KEYWORD(keyword);
		if (p->len == len && (opt_case_sensitive ? strncmp : strncasecmp)(p->data, s, len) == 0) {
			return keyword;
		}
	}

	CELL keyword = make_raw_keyword_counted(len);
    KEYWORD* p = GET_KEYWORD(keyword);
    if (opt_case_sensitive) {
        memcpy(p->data, s, len);
    }
    else {
        int i;
        for(i=0; i<len; ++i) {
            GET_KEYWORD(keyword)->data[i] = tolower(s[i]);
        }
    }

	gc_root_1("make_keyword_counted", keyword);
	g_interned_keywords = make_cons(keyword, g_interned_keywords);
	gc_unroot();
	return keyword;
}
Example #14
0
// ### fasl-sharp-left-paren stream sub-char numarg => value
Value SYS_fasl_sharp_left_paren(Value streamarg, Value subchar, Value numarg)
{
  Thread * thread = current_thread();
  if (thread->symbol_value(S_read_suppress) != NIL)
    {
      stream_read_list(streamarg, true, thread, FASL_READTABLE);
      return NIL;
    }
  if (numarg != NIL && thread->symbol_value(S_backquote_count) == FIXNUM_ZERO)
    return stream_read_vector(streamarg, check_index(numarg), thread, FASL_READTABLE);
  Value list = stream_read_list(streamarg, true, thread, FASL_READTABLE);
  if (thread->symbol_value(S_backquote_count) == FIXNUM_ZERO)
    {
      if (numarg != NIL)
        {
          INDEX len = check_index(numarg);
          SimpleVector * vector = new_simple_vector(len);
          for (INDEX i = 0; i < len; i++)
            {
              vector->inline_xaset(i, car(list));
              if (cdr(list) != NIL)
                list = xcdr(list);
            }
          return make_value(vector);
        }
      return make_value(new_simple_vector(list));
    }
  return make_cons(thread->symbol_value(S_backquote_vector_flag), list);
}
Example #15
0
Value parse_logical_pathname_directory(AbstractString * s)
{
  Value result;
  unsigned long i;
  if (s->length() > 1 && s->char_at(0) == ';')
    {
      result = make_cons(K_relative);
      i = 1;
    }
  else
    {
      result = make_cons(K_absolute);
      i = 0;
    }
  const unsigned long limit = s->length();
  while (i < limit)
    {
      String * token = new String();
      while (i < limit)
        {
          char c = s->char_at(i++);
          if (is_separator_char(c))
            break;
          else
            token->append_char(c);
        }
      Value value;
      if (token->equal("*"))
        value = K_wild;
      else if (token->equal("**"))
        value = K_wild_inferiors;
      else if (token->equal(".."))
        {
          if (stringp(car(result)))
            {
              result = cdr(result);
              continue;
            }
          value = K_up;
        }
      else
        value = make_value(token);
      result = make_cons(value, result);
    }
  return CL_nreverse(result);
}
Example #16
0
// returns a list
static Value structure_class_instance_slots()
{
  Value instance_slots = NIL;
  instance_slots = make_cons(S_direct_methods, instance_slots);
  instance_slots = make_cons(S_prototype, instance_slots);
  instance_slots = make_cons(S_name, instance_slots);
  instance_slots = make_cons(S_layout, instance_slots);
  instance_slots = make_cons(S_precedence_list, instance_slots);
  instance_slots = make_cons(S_direct_superclasses, instance_slots);
  instance_slots = make_cons(S_direct_subclasses, instance_slots);
  instance_slots = make_cons(S_direct_slots, instance_slots);
  instance_slots = make_cons(S_slots, instance_slots);
  return CL_nreverse(instance_slots);
}
Example #17
0
Cons parse_cons(char *string, int *offset)
{
    Cons cur, head, pre;
    int step;

    pre = head = make_cons(lt_nil, lt_nil);
    for (int i = 0; string[i] != '\0'; i += step) {
	switch (string[i]) {
	case '(':
	    cur = make_cons(parse_cons(string + i + 1, &step), lt_nil);
	    break;
	case ' ':
        case '\n':
	    step = 1;
	    continue;
	case ')':
	    *offset = i + 2;
	    pre = CDR(head);
            free_cons(head);

	    return pre;
        case '\'': {
            /* Symbol quote; */
            LispObject obj;

            /* quote = S("QUOTE"); */
            obj = parse_sexp(string + i + 1, &step);
            /* cur = make_cons(make_cons(S("QUOTE"), make_cons(obj, lt_nil)), lt_nil); */
            cur = make_cons(make_list(S("QUOTE"), obj), lt_nil);
            step++;
            break;
        }
	default :
	    cur = make_cons(parse_atom(string + i, &step), lt_nil);
	}
        set_cdr(pre, cur);
	pre = cur;
    }
    pre = CDR(head);
    free_cons(head);

    return pre;
}
Example #18
0
static cons_t* merge_cons(cons_t *A, cons_t *B, cmp_fun cmp){
  cons_t *ret = NULL;
  while(A && B){
    if(cmp(XCAR(A),XCAR(B))){
      ret = make_cons(XCAR(A), ret);
      A = XCDR(A);
    } else {
      ret = make_cons(XCDR(B), ret);
      B = XCDR(B);
    }
  }
//Only one of these loops will run
  while(A){
    ret = make_cons(XCAR(A), ret);
  }
  while(B){
    ret = make_cons(XCAR(B), ret);
  }
}
// ### record-source-information
Value SYS_record_source_information(Value name, Value source_position)
{
  if (non_nil_symbol_p(name)) // FIXME support setf functions too
    {
      Thread * thread = current_thread();
      Value source = thread->symbol_value(S_source_file);
      the_non_nil_symbol(name)->put(S_source_internal,
                                    source != NIL ? make_cons(source, source_position) : NIL);
    }
  return T;
}
Example #20
0
CELL func_list(CELL frame)
{
	if (FC == 0) {
		return V_NULL;
	}

	CELL result = V_EMPTY;
	CELL pre_tail = V_EMPTY;
	gc_root_3("func_list", frame, result, pre_tail);

	int argi = 0;
	pre_tail = result = make_cons(FV[argi++], V_NULL);
	while(argi < FC) {
		const CELL next = make_cons(FV[argi++], V_NULL);
		pre_tail = CDR(pre_tail) = next;
	}

	gc_unroot();
	return result;
}
Example #21
0
// ### make-structure-class name include slots => class
Value SYS_make_structure_class(Value name, Value slots, Value include)
{
  if (!symbolp(name))
    return signal_type_error(name, S_symbol);
  if (!listp(slots))
    return signal_type_error(name, S_list);
  StructureClass * c = new StructureClass(name, slots);
  if (include != NIL)
    {
      Value included_class = find_class(include);
      if (included_class == NULL_VALUE)
        {
          String * message = new String(::prin1_to_string(include));
          message->append(" does not name a class.");
          return signal_lisp_error(message);
        }
      c->set_cpl(make_cons(make_value(c), the_class(included_class)->cpl()));
    }
  else
    c->set_cpl(make_cons(make_value(c), the_class(C_structure_object)->cpl()));

  return add_class(name, make_value(c));
}
Example #22
0
CELL func_reverse(CELL frame)
{
	CELL list = FV0;
	CELL result = V_NULL;
	gc_root_2("func_reverse", list, result);

	while(CONSP(list)) {
		result = make_cons(CAR(list), result);
		list = CDR(list);
	}
	if (!NULLP(list)) {
		gc_unroot();
		return make_exception("expects a <proper list>");
	}
	gc_unroot();
	return result;
}
Example #23
0
static WispObject *
find_date_matches (WispObject *database, char *key, char *string)
{
  WispObject *result = NIL;

  while (database != NIL)
    {
      WispObject *entry;
      char *contents;

      entry = CAR (database);
      database = CDR (database);

      contents = sassoc (key, entry);

      if (contents != (char *)NULL)
	{
	  char *buff = strdup (contents);
	  char *temp = strchr (buff, '/');

	  if (temp != (char *)NULL)
	    {
	      char *temp1;
	      char dstring[20];
	      int month, day;

	      *temp = '\0';
	      month = atoi (buff);
	      temp++;
	      temp1 = strchr (temp, '/');
	      if (temp1 != (char *)NULL)
		*temp1 = '\0';
	      day = atoi (temp);

	      sprintf (dstring, "%02d/%02d", month, day);
	      if (strcasestr (dstring, string) != (char *)NULL)
		result = make_cons (entry, result);
	    }

	  free (buff);
	}
    }
  return (result);
}
Example #24
0
Value Function::parts()
{
  String * description = new String(prin1_to_string());
  description->append_char('\n');
  Value elements = NIL;
  Value name = operator_name();
  elements = make_cons(make_cons(make_simple_string("NAME"),
                                 name != NULL_VALUE ? name : NIL),
                       elements);
  elements = make_cons(make_cons(make_simple_string("ARITY"),
                                 make_fixnum(arity())),
                       elements);
  elements = make_cons(make_cons(make_simple_string("MINARGS"),
                                 make_fixnum(minargs())),
                       elements);
  elements = make_cons(make_cons(make_simple_string("MAXARGS"),
                                 make_fixnum(maxargs())),
                       elements);
  return current_thread()->set_values(make_value(description), T, CL_nreverse(elements));
}
Example #25
0
object_t *parse_list(FILE *fp){
  cons_t tmp_cons;
  char buf;
  buf=skip_space_getchar(fp);


  tmp_cons.car = parse_sexp(fp);
  buf=skip_space_getchar(fp);

  if(buf == ')'){
    tmp_cons.cdr = NULL;
  }
  else{
    ungetc(buf,fp);
    tmp_cons.cdr = parse_list_inner(fp);
  }
  
  return make_cons(tmp_cons.car,tmp_cons.cdr);
}
Example #26
0
File: prim.c Project: 8l/lisp-1
sexp_t *prim_append(sexp_t *args)
{
	sexp_t *lst, *ret;
	if (list_len(args) == 0)
		return nil;
	if (isnil(car(args)))
		return prim_append(cdr(args));
	if (isnil(cdr(args)))
		return copy_list(car(args));
	if (!iscons(car(args)) || list_len(car(args)) < 0) {
		fprintf(stderr, "error: proper list expected\n");
		return NULL;
	}
	for (ret = lst = copy_list(car(args)); cdr(lst) != nil; lst = cdr(lst))
		;
	gc_push(&ret);
	lst->data = make_cons(car(lst), prim_append(cdr(args)));
	gc_pop();
	return ret;
}
Example #27
0
static WispObject *
find_matches (WispObject *database, char *key, char *string)
{
  WispObject *result = NIL;

  while (database != NIL)
    {
      WispObject *entry;
      char *contents;

      entry = CAR (database);
      database = CDR (database);

      contents = sassoc (key, entry);

      if ((contents != (char *)NULL) &&
	  (strcasestr (contents, string) != (char *)NULL))
	result = make_cons (entry, result);
    }

  return (result);
}
Example #28
0
CELL make_name_from_string(CELL string)
{
	const char* data = GET_STRING(string)->data;
	const size_t len = GET_STRING(string)->len;
	CELL list = g_interned_names;
	for( ; !NULLP(list); list = CDR(list)) {
		CELL name = CAR(list);
		NAME* p = GET_NAME(name);
		if (p->len == len && memcmp(p->data, data, len) == 0) {
			return name;
		}
	}

	CELL name = V_EMPTY;
	gc_root_2("make_name_from_string", string, name);

	name = make_raw_name_counted(len);
	memcpy(GET_NAME(name)->data, GET_STRING(string)->data, len);
	g_interned_names = make_cons(name, g_interned_names);

	gc_unroot();
	return name;
}
Example #29
0
CELL make_keyword_from_string(CELL string)
{
	const char* data = GET_STRING(string)->data;
	const size_t len = GET_STRING(string)->len;
	CELL list = g_interned_keywords;
	for( ; !NULLP(list); list = CDR(list)) {
		CELL keyword = CAR(list);
		KEYWORD* p = GET_KEYWORD(keyword);
		if (p->len == len && memcmp(p->data, data, len) == 0) {
			return keyword;
		}
	}

	CELL keyword = V_EMPTY;
	gc_root_2("make_keyword_from_string", string, keyword);

	keyword = make_raw_keyword_counted(len);
	memcpy(GET_KEYWORD(keyword)->data, GET_STRING(string)->data, len);
	g_interned_keywords = make_cons(keyword, g_interned_keywords);

	gc_unroot();
	return keyword;
}
Example #30
0
static void L16()
{register object *base=vs_base;
	register object *sup=base+VM16; VC16
	vs_check;
	{object V31;
	object V32;
	register object V33;
	check_arg(3);
	V31=(base[0]);
	V32=(base[1]);
	V33=(base[2]);
	vs_top=sup;
	goto TTL;
TTL:;
	if(((VV[2]->s.s_dbind))!=Cnil){
	goto T81;}
	if(((VV[3]->s.s_dbind))==Cnil){
	goto T81;}
	base[3]= (V31);
	base[4]= (V32);
	base[5]= (V33);
	vs_top=(vs_base=base+3)+3;
	(void) (*Lnk179)();
	return;
	goto T81;
T81:;
	{register object V34;
	register object V35;
	object V36;
	object V37;
	object V38;
	object V39;
	V37= (*(LnkLI180))(VV[17]);
	V38= (((V31))==(VV[0])?Ct:Cnil);
	V39= (*(LnkLI181))((V33),VV[18],VV[19]);
	V34= Cnil;
	V35= Cnil;
	V36= Cnil;
	{object V41= V31;
	if((V41!= VV[0]))goto T93;
	V34= (*(LnkLI182))(small_fixnum(0));
	V35= make_cons((V34),Cnil);
	goto T92;
	goto T93;
T93:;
	if((V41!= VV[1]))goto T97;
	V34= (*(LnkLI182))(small_fixnum(1));
	V42= (*(LnkLI182))(small_fixnum(0));
	V35= list(2,/* INLINE-ARGS */V42,(V34));
	goto T92;
	goto T97;
T97:;
	base[3]= VV[20];
	base[4]= VV[21];
	base[5]= VV[22];
	base[6]= VV[23];
	base[7]= V31;
	base[8]= VV[24];
	base[9]= VV[25];
	base[10]= VV[26];
	base[11]= VV[27];
	vs_top=(vs_base=base+3)+9;
	(void) (*Lnk183)();
	vs_top=sup;}
	goto T92;
T92:;
	{object V44= V32;
	if(!eql(V44,VV[28]))goto T111;
	V36= VV[29];
	goto T110;
	goto T111;
T111:;
	if(!eql(V44,VV[30]))goto T113;
	V36= VV[31];
	goto T110;
	goto T113;
T113:;
	base[3]= VV[20];
	base[4]= VV[21];
	base[5]= VV[22];
	base[6]= VV[23];
	base[7]= V32;
	base[8]= VV[24];
	base[9]= VV[32];
	base[10]= VV[26];
	base[11]= VV[33];
	vs_top=(vs_base=base+3)+9;
	(void) (*Lnk183)();
	vs_top=sup;}
	goto T110;
T110:;
	base[3]= (V36);
	base[4]= (V35);
	if(((V33))!=Cnil){
	goto T129;}
	V45= VV[35];
	goto T127;
	goto T129;
T129:;
	V45= Cnil;
	goto T127;
T127:;
	V46= list(2,VV[38],(V34));
	if(((V33))!=Cnil){
	goto T133;}
	V48= list(3,VV[39],VV[19],list(2,VV[40],(V34)));
	V47= make_cons(/* INLINE-ARGS */V48,Cnil);
	goto T131;
	goto T133;
T133:;
	V47= Cnil;
	goto T131;
T131:;
	V49= list(2,VV[41],(V34));
	V50= make_cons(/* INLINE-ARGS */V49,Cnil);
	V51= append(V47,/* INLINE-ARGS */V50);
	V52= make_cons(/* INLINE-ARGS */V46,/* INLINE-ARGS */V51);
	V53= list(2,VV[42],(V34));
	if(((V33))!=Cnil){
	goto T137;}
	V55= list(3,VV[39],VV[19],list(2,VV[43],(V34)));
	V54= make_cons(/* INLINE-ARGS */V55,Cnil);
	goto T135;
	goto T137;
T137:;
	V54= Cnil;
	goto T135;
T135:;
	V56= list(2,VV[44],(V34));
	V57= make_cons(/* INLINE-ARGS */V56,Cnil);
	V58= append(V54,/* INLINE-ARGS */V57);
	V59= list(2,VV[36],list(3,VV[37],/* INLINE-ARGS */V52,make_cons(/* INLINE-ARGS */V53,/* INLINE-ARGS */V58)));
	if(((V38))==Cnil){
	goto T141;}
	V60= VV[45];
	goto T139;
	goto T141;
T141:;
	V60= Cnil;
	goto T139;
T139:;
	V61= make_cons(/* INLINE-ARGS */V59,V60);
	V62= append(V45,/* INLINE-ARGS */V61);
	V63= list(2,VV[49],list(3,VV[50],VV[36],(V37)));
	if(!(eql(small_fixnum(2),(V32)))){
	goto T145;}
	V64= VV[53];
	goto T143;
	goto T145;
T145:;
	V64= Cnil;
	goto T143;
T143:;
	V65= list(2,VV[51],listA(3,VV[47],VV[52],V64));
	if(((V38))==Cnil){
	goto T149;}
	V67= list(3,VV[54],VV[55],list(3,VV[39],VV[56],(V39)));
	V66= make_cons(/* INLINE-ARGS */V67,Cnil);
	goto T147;
	goto T149;
T149:;
	V66= Cnil;
	goto T147;
T147:;
	V68= listA(5,VV[47],VV[48],/* INLINE-ARGS */V63,/* INLINE-ARGS */V65,V66);
	V69= listA(3,VV[57],VV[11],(V35));
	if(((V38))==Cnil){
	goto T153;}
	V70= VV[56];
	goto T151;
	goto T153;
T153:;
	V70= list(3,VV[58],(V39),CMPcar((V35)));
	goto T151;
T151:;
	base[5]= list(3,VV[34],/* INLINE-ARGS */V62,list(4,VV[46],/* INLINE-ARGS */V68,/* INLINE-ARGS */V69,V70));
	vs_top=(vs_base=base+3)+3;
	(void) (*Lnk176)();
	return;}
	}
}