示例#1
0
文件: list.o.c 项目: hoobaa/mecl
cl_object cl_make_list(cl_narg narg, ...)
{
#line 414
// ------------------------------2
#line 414
	const cl_env_ptr the_env = ecl_process_env();
#line 414
	static cl_object KEYS[1] = {(cl_object)(cl_symbols+1251)};
	cl_object initial_element;
#line 414
	cl_object x;
#line 414
	cl_object KEY_VARS[2];
#line 414
	ecl_va_list ARGS;
	ecl_va_start(ARGS, narg, narg, 0);
	cl_object size = ecl_va_arg(ARGS);  
#line 414
// ------------------------------3

	cl_fixnum i;
#line 417
// ------------------------------4
#line 417
#line 417
	if (ecl_unlikely(narg < 1)) FEwrong_num_arguments(ecl_make_fixnum(529));
#line 417
	cl_parse_key(ARGS, 1, KEYS, KEY_VARS, NULL, 0);
#line 417
	if (KEY_VARS[1]==ECL_NIL) {
#line 417
	  initial_element = ECL_NIL;
	} else {
#line 417
	  initial_element = KEY_VARS[0];
	}
#line 417
	x = ECL_NIL;
#line 417
// ------------------------------5
	/* INV: ecl_to_size() signals a type-error if SIZE is not a integer >=0 */
	i = ecl_to_size(size);
	while (i-- > 0)
		x = CONS(initial_element, x);
	{
#line 421
		#line 421
		cl_object __value0 = x;
#line 421
		the_env->nvalues = 1;
#line 421
		return __value0;
#line 421
	}

}
示例#2
0
文件: num_arith.o.c 项目: hoobaa/mecl
cl_object cl_lcm(cl_narg narg, ...)
{
#line 94
// ------------------------------2
#line 94
	const cl_env_ptr the_env = ecl_process_env();
#line 94
	ecl_va_list nums;
	ecl_va_start(nums, narg, narg, 0);
#line 94
// ------------------------------3

	cl_object lcm;
#line 97
// ------------------------------4
#line 97
#line 97
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(456));
#line 97
// ------------------------------5
	if (narg == 0)
		{
#line 98
			#line 98
			cl_object __value0 = ecl_make_fixnum(1);
#line 98
			the_env->nvalues = 1;
#line 98
			return __value0;
#line 98
		}

	/* INV: ecl_gcd() checks types. By placing `numi' before `lcm' in
	   this call, we make sure that errors point to `numi' */
	lcm = ecl_va_arg(nums);
	assert_type_integer(lcm);
	while (narg-- > 1) {
		cl_object numi = ecl_va_arg(nums);
		cl_object t = ecl_times(lcm, numi);
		cl_object g = ecl_gcd(numi, lcm);
		if (g != ecl_make_fixnum(0))
			lcm = ecl_divide(t, g);
	}
	{
#line 110
		#line 110
		cl_object __value0 = (ecl_minusp(lcm) ? ecl_negate(lcm) : lcm);
#line 110
		the_env->nvalues = 1;
#line 110
		return __value0;
#line 110
	}

}
示例#3
0
文件: divide.o.c 项目: hoobaa/mecl
cl_object cl_N(cl_narg narg, ...)
{
#line 19
// ------------------------------2
#line 19
	const cl_env_ptr the_env = ecl_process_env();
#line 19
	ecl_va_list nums;
	ecl_va_start(nums, narg, narg, 0);
	cl_object num = ecl_va_arg(nums);  
#line 19
// ------------------------------3

#line 21
// ------------------------------4
#line 21
#line 21
	if (ecl_unlikely(narg < 1)) FEwrong_num_arguments(ecl_make_fixnum(21));
#line 21
// ------------------------------5
	/* INV: type check is in ecl_divide() */
	if (narg == 0)
		FEwrong_num_arguments(ecl_make_fixnum(/*/*/21));
	if (narg == 1)
		{
#line 25
			#line 25
			cl_object __value0 = ecl_divide(ecl_make_fixnum(1), num);
#line 25
			the_env->nvalues = 1;
#line 25
			return __value0;
#line 25
		}

	while (--narg)
		num = ecl_divide(num, ecl_va_arg(nums));
	{
#line 28
		#line 28
		cl_object __value0 = num;
#line 28
		the_env->nvalues = 1;
#line 28
		return __value0;
#line 28
	}

}
示例#4
0
文件: minus.o.c 项目: hoobaa/mecl
cl_object cl_M(cl_narg narg, ...)
{
#line 19
// ------------------------------2
#line 19
	const cl_env_ptr the_env = ecl_process_env();
#line 19
	ecl_va_list nums;
	ecl_va_start(nums, narg, narg, 0);
	cl_object num = ecl_va_arg(nums);  
#line 19
// ------------------------------3

	cl_object diff;
#line 22
// ------------------------------4
#line 22
#line 22
	if (ecl_unlikely(narg < 1)) FEwrong_num_arguments(ecl_make_fixnum(17));
#line 22
// ------------------------------5
	/* INV: argument type check in number_{negate,minus}() */
	if (narg == 1)
		{
#line 24
			#line 24
			cl_object __value0 = ecl_negate(num);
#line 24
			the_env->nvalues = 1;
#line 24
			return __value0;
#line 24
		}

	for (diff = num;  --narg; )
		diff = ecl_minus(diff, ecl_va_arg(nums));
	{
#line 27
		#line 27
		cl_object __value0 = diff;
#line 27
		the_env->nvalues = 1;
#line 27
		return __value0;
#line 27
	}

}
示例#5
0
文件: rwlock.o.c 项目: hoobaa/mecl
cl_object mp_make_rwlock(cl_narg narg, ...)
{
#line 88
// ------------------------------2
#line 88
	const cl_env_ptr the_env = ecl_process_env();
#line 88
	static cl_object KEYS[1] = {(cl_object)(cl_symbols+1273)};
	cl_object name;
#line 88
	cl_object KEY_VARS[2];
#line 88
	ecl_va_list ARGS;
	ecl_va_start(ARGS, narg, narg, 0);
#line 88
// ------------------------------3

#line 90
// ------------------------------4
#line 90
#line 90
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(1434));
#line 90
	cl_parse_key(ARGS, 1, KEYS, KEY_VARS, NULL, 0);
#line 90
	if (KEY_VARS[1]==ECL_NIL) {
#line 90
	  name = ECL_NIL;
	} else {
#line 90
	  name = KEY_VARS[0];
	}
#line 90
// ------------------------------5
	{
#line 90
		#line 90
		cl_object __value0 = ecl_make_rwlock(name);
#line 90
		the_env->nvalues = 1;
#line 90
		return __value0;
#line 90
	}

}
示例#6
0
文件: list.o.c 项目: hoobaa/mecl
cl_object cl_listX(cl_narg narg, ...)
{
#line 154
// ------------------------------2
#line 154
	const cl_env_ptr the_env = ecl_process_env();
#line 154
	ecl_va_list args;
	ecl_va_start(args, narg, narg, 0);
#line 154
// ------------------------------3

	cl_object head;
#line 157
// ------------------------------4
#line 157
#line 157
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(482));
#line 157
// ------------------------------5
	if (narg == 0)
		FEwrong_num_arguments(ecl_make_fixnum(/*LIST**/482));
	head = ecl_va_arg(args);
	if (--narg) {
		cl_object tail = head = ecl_list1(head);
		while (--narg) {
			cl_object cons = ecl_list1(ecl_va_arg(args));
			ECL_RPLACD(tail, cons);
			tail = cons;
		}
		ECL_RPLACD(tail, ecl_va_arg(args));
	}
	{
#line 169
		#line 169
		cl_object __value0 = head;
#line 169
		the_env->nvalues = 1;
#line 169
		return __value0;
#line 169
	}

}
示例#7
0
文件: list.o.c 项目: hoobaa/mecl
cl_object cl_append(cl_narg narg, ...)
{
#line 189
// ------------------------------2
#line 189
	const cl_env_ptr the_env = ecl_process_env();
#line 189
	ecl_va_list rest;
	ecl_va_start(rest, narg, narg, 0);
#line 189
// ------------------------------3

	cl_object head = ECL_NIL, *tail = &head;
#line 192
// ------------------------------4
#line 192
#line 192
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(88));
#line 192
// ------------------------------5
	for (; narg > 1; narg--) {
		cl_object other = ecl_va_arg(rest);
                tail = append_into(head, tail, other);
	}
        if (narg) {
                if (!Null(*tail)) {
                        /* (APPEND '(1 . 2) 3) */
                        FEtype_error_proper_list(head);
                }
                *tail = ecl_va_arg(rest);
        }
	{
#line 203
		#line 203
		cl_object __value0 = head;
#line 203
		the_env->nvalues = 1;
#line 203
		return __value0;
#line 203
	}

}
示例#8
0
文件: list.o.c 项目: hoobaa/mecl
cl_object cl_list(cl_narg narg, ...)
{
#line 140
// ------------------------------2
#line 140
	const cl_env_ptr the_env = ecl_process_env();
#line 140
	ecl_va_list args;
	ecl_va_start(args, narg, narg, 0);
#line 140
// ------------------------------3

	cl_object head = ECL_NIL;
#line 143
// ------------------------------4
#line 143
#line 143
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(481));
#line 143
// ------------------------------5
	if (narg--) {
		cl_object tail = head = ecl_list1(ecl_va_arg(args));
		while (narg--) {
			cl_object cons = ecl_list1(ecl_va_arg(args));
			ECL_RPLACD(tail, cons);
			tail = cons;
		}
	}
	{
#line 151
		#line 151
		cl_object __value0 = head;
#line 151
		the_env->nvalues = 1;
#line 151
		return __value0;
#line 151
	}

}
示例#9
0
文件: symbol.o.c 项目: hoobaa/mecl
cl_object si_put_properties(cl_narg narg, ...)
{
#line 437
// ------------------------------2
#line 437
	const cl_env_ptr the_env = ecl_process_env();
#line 437
	ecl_va_list ind_values;
	ecl_va_start(ind_values, narg, narg, 0);
	cl_object sym = ecl_va_arg(ind_values);  
#line 437
// ------------------------------3

#line 439
// ------------------------------4
#line 439
#line 439
	if (ecl_unlikely(narg < 1)) FEwrong_num_arguments(ecl_make_fixnum(1123));
#line 439
// ------------------------------5
	while (--narg >= 2) {
		cl_object prop = ecl_va_arg(ind_values);
		si_putprop(sym, ecl_va_arg(ind_values), prop);
		narg--;
	}
	{
#line 444
		#line 444
		cl_object __value0 = sym;
#line 444
		the_env->nvalues = 1;
#line 444
		return __value0;
#line 444
	}

}
示例#10
0
文件: list.o.c 项目: hoobaa/mecl
cl_object cl_tree_equal(cl_narg narg, ...)
{
#line 259
// ------------------------------2
#line 259
	const cl_env_ptr the_env = ecl_process_env();
#line 259
	static cl_object KEYS[2] = {(cl_object)(cl_symbols+1316), (cl_object)(cl_symbols+1317)};
	cl_object test;
	cl_object test_not;
#line 259
	cl_object KEY_VARS[4];
#line 259
	ecl_va_list ARGS;
	ecl_va_start(ARGS, narg, narg, 0);
	cl_object x = ecl_va_arg(ARGS);  
	cl_object y = ecl_va_arg(ARGS);  
#line 259
// ------------------------------3

	struct cl_test t;
	cl_object output;
#line 263
// ------------------------------4
#line 263
#line 263
	if (ecl_unlikely(narg < 2)) FEwrong_num_arguments(ecl_make_fixnum(863));
#line 263
	cl_parse_key(ARGS, 2, KEYS, KEY_VARS, NULL, 0);
#line 263
	if (KEY_VARS[2]==ECL_NIL) {
#line 263
	  test = ECL_NIL;
	} else {
#line 263
	  test = KEY_VARS[0];
	}
#line 263
	if (KEY_VARS[3]==ECL_NIL) {
#line 263
	  test_not = ECL_NIL;
	} else {
#line 263
	  test_not = KEY_VARS[1];
	}
#line 263
// ------------------------------5
	setup_test(&t, ECL_NIL, test, test_not, ECL_NIL);
	output = tree_equal(&t, x, y)? ECL_T : ECL_NIL;
	close_test(&t);
	{
#line 266
		#line 266
		cl_object __value0 = output;
#line 266
		the_env->nvalues = 1;
#line 266
		return __value0;
#line 266
	}

}
示例#11
0
/*	optimize speed 3, debug 3, space 0, safety 2                  */
static cl_object L1seq(cl_narg narg, ...)
{
 cl_object T0;
 struct ecl_ihs_frame ihs;
 const cl_object _ecl_debug_env = ECL_NIL;
 const cl_env_ptr cl_env_copy = ecl_process_env();
 cl_object value0;
 ecl_cs_check(cl_env_copy,value0);
 {
  cl_object V1;
  cl_object V2;
  cl_object V3;
  ecl_va_list args; ecl_va_start(args,narg,narg,0);
  {
   ecl_ihs_push(cl_env_copy,&ihs,VV[0],_ecl_debug_env);
   {
    cl_object keyvars[6];
    cl_parse_key(args,3,L1seqkeys,keyvars,NULL,FALSE);
    ecl_va_end(args);
    if (Null(keyvars[3])) {
     V1 = ecl_make_fixnum(0);
    } else {
     V1 = keyvars[0];
    }
    if (Null(keyvars[4])) {
     V2 = ecl_make_fixnum(10);
    } else {
     V2 = keyvars[1];
    }
    if (Null(keyvars[5])) {
     V3 = ecl_make_fixnum(1);
    } else {
     V3 = keyvars[2];
    }
   }
   {
    cl_object V4;                                 /*  I               */
    cl_object V5;
    cl_object V6;
    {
     T0 = cl_realp(V1);
     if (ecl_unlikely(!((T0)!=ECL_NIL)))
         FEwrong_type_argument(ECL_SYM("REAL",703),V1);
     V4 = V1;
    }
    {
     T0 = cl_realp(V2);
     if (ecl_unlikely(!((T0)!=ECL_NIL)))
         FEwrong_type_argument(ECL_SYM("REAL",703),V2);
     V5 = V2;
    }
    {
     T0 = cl_realp(V3);
     if (ecl_unlikely(!((T0)!=ECL_NIL)))
         FEwrong_type_argument(ECL_SYM("REAL",703),V3);
     V6 = V3;
    }
    {
     static const struct ecl_var_debug_info _ecl_descriptors[]={
     {"#:LOOP-STEP-BY1",_ecl_object_loc}
     ,{"#:LOOP-LIMIT0",_ecl_object_loc}
     ,{"COMMON-LISP-USER::I",_ecl_object_loc}};
     const cl_index _ecl_debug_info_raw[]={
     (cl_index)(_ecl_debug_env),(cl_index)(_ecl_descriptors),(cl_index)(&V6),(cl_index)(&V5),(cl_index)(&V4)};
     ecl_def_ct_vector(_ecl_debug_env,ecl_aet_index,_ecl_debug_info_raw,5,,);
     ihs.lex_env = _ecl_debug_env;
     {
      cl_object V7;
      cl_object V8;
      V7 = ecl_list1(ECL_NIL);
      V8 = V7;
      {
       static const struct ecl_var_debug_info _ecl_descriptors[]={
       {"#:LOOP-LIST-TAIL3",_ecl_object_loc}
       ,{"#:LOOP-LIST-HEAD2",_ecl_object_loc}};
       const cl_index _ecl_debug_info_raw[]={
       (cl_index)(_ecl_debug_env),(cl_index)(_ecl_descriptors),(cl_index)(&V8),(cl_index)(&V7)};
       ecl_def_ct_vector(_ecl_debug_env,ecl_aet_index,_ecl_debug_info_raw,4,,);
       ihs.lex_env = _ecl_debug_env;
L12:;
       if (!(ecl_number_compare(V4,V5)>0)) { goto L14; }
       goto L13;
L14:;
       T0 = V8;
       V8 = ecl_list1(V4);
       cl_rplacd(T0, V8);
       V4 = ecl_plus(V4,V6);
       goto L12;
L13:;
       value0 = ecl_cdr(V7);
       cl_env_copy->nvalues = 1;
       ecl_ihs_pop(cl_env_copy);
       return value0;
      }
      ihs.lex_env = _ecl_debug_env;
     }
    }
    ihs.lex_env = _ecl_debug_env;
   }
  }
 }
}
示例#12
0
文件: num_arith.o.c 项目: hoobaa/mecl
cl_object cl_gcd(cl_narg narg, ...)
{
#line 51
// ------------------------------2
#line 51
	const cl_env_ptr the_env = ecl_process_env();
#line 51
	ecl_va_list nums;
	ecl_va_start(nums, narg, narg, 0);
#line 51
// ------------------------------3

	cl_object gcd;
#line 54
// ------------------------------4
#line 54
#line 54
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(399));
#line 54
// ------------------------------5
	if (narg == 0)
		{
#line 55
			#line 55
			cl_object __value0 = ecl_make_fixnum(0);
#line 55
			the_env->nvalues = 1;
#line 55
			return __value0;
#line 55
		}

	/* INV: ecl_gcd() checks types */
	gcd = ecl_va_arg(nums);
	if (narg == 1) {
		assert_type_integer(gcd);
		{
#line 60
			#line 60
			cl_object __value0 = (ecl_minusp(gcd) ? ecl_negate(gcd) : gcd);
#line 60
			the_env->nvalues = 1;
#line 60
			return __value0;
#line 60
		}

	}
	while (--narg)
		gcd = ecl_gcd(gcd, ecl_va_arg(nums));
	{
#line 64
		#line 64
		cl_object __value0 = gcd;
#line 64
		the_env->nvalues = 1;
#line 64
		return __value0;
#line 64
	}

}