Exemplo n.º 1
0
void FFI_lisp_character(CL_FORM *base)
{
	LOAD_BOOL(CL_C_CHAR_P(ARG(0)), ARG(1));
	if(CL_TRUEP(ARG(1)))
	{
		goto THEN1;
	}
	else
	{
	}
	if(CL_C_UNSIGNED_CHAR_P(ARG(0)))
	{
		THEN1:;
		rt_make_lisp_character(ARG(0));
	}
	else
	{
		LOAD_SMSTR((CL_FORM *)&KClisp[240], ARG(1));	/* ~&Error in ~A: ~?~% */
		LOAD_SMSTR((CL_FORM *)&KClisp[10], ARG(2));	/* LISP-CHARACTER */
		LOAD_SMSTR((CL_FORM *)&KClisp[8], ARG(3));	/* The evaluated value ~S is not of type c-<char>. */
		COPY(ARG(0), ARG(4));
		Flist(ARG(4), 1);
		Ferror(ARG(1), 4);
	}
}
Exemplo n.º 2
0
void Fmapcon(CL_FORM *base, int nargs)
{
	CL_FORM *display[2];
	Flist(ARG(2), nargs - 2);
	display[0] = ARG(0);
	Z130_mapcon_internal(ARG(3), display);
	COPY(ARG(3), ARG(0));
}
Exemplo n.º 3
0
void Fyes_or_no_p(CL_FORM *base, int nargs)
{
	switch(nargs)
	{
		case 0:
		LOAD_NIL(ARG(0));
		nargs = 1;
	}
	Flist(ARG(1), nargs - 1);
	yes_or_no_p1(ARG(0));
}
Exemplo n.º 4
0
void quote_reader(CL_FORM *base)
{
	LOAD_SYMBOL(SYMBOL(Slisp, 455), ARG(2));	/* QUOTE */
	COPY(ARG(0), ARG(3));
	LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(4));	/* T */
	LOAD_NIL(ARG(5));
	LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(6));	/* T */
	internal_read(ARG(3));
	Flist(ARG(2), 2);
	COPY(ARG(2), ARG(0));
}
Exemplo n.º 5
0
void Flogeqv(CL_FORM *base, int nargs)
{
	Flist(ARG(0), nargs - 0);
	LOAD_FIXNUM(ARG(1), -1, ARG(1));
	M1_1:;
	if(CL_TRUEP(ARG(0)))
	{
	}
	else
	{
		COPY(ARG(1), ARG(0));
		goto RETURN1;
	}
	COPY(ARG(0), ARG(3));
	COPY(ARG(3), ARG(4));
	if(CL_CONSP(ARG(4)))
	{
		COPY(GET_CAR(ARG(4)), ARG(3));
	}
	else
	{
		LOAD_SMSTR((CL_FORM *)&KClisp[264], ARG(3));	/* ~a is not a list */
		Ferror(ARG(3), 2);
	}
	COPY(ARG(0), ARG(4));
	COPY(ARG(4), ARG(5));
	if(CL_CONSP(ARG(5)))
	{
		COPY(GET_CDR(ARG(5)), ARG(0));
	}
	else
	{
		LOAD_SMSTR((CL_FORM *)&KClisp[262], ARG(6));	/* ~a is not a list */
		COPY(ARG(5), ARG(7));
		Ferror(ARG(6), 2);
	}
	if(CL_FIXNUMP(ARG(3)))
	{
	}
	else
	{
		COPY(ARG(3), ARG(4));
		LOAD_SMSTR((CL_FORM *)&KClisp[244], ARG(3));	/* type error: ~S is not of type ~S */
		LOAD_SYMBOL(SYMBOL(Slisp, 23), ARG(5));	/* FIXNUM */
		Ferror(ARG(3), 3);
	}
	LOAD_FIXNUM(ARG(4), GET_FIXNUM(ARG(1)) ^ GET_FIXNUM(ARG(3)), ARG(2));
	LOAD_FIXNUM(ARG(3),  ~ GET_FIXNUM(ARG(2)), ARG(1));
	goto M1_1;
	RETURN1:;
}
Exemplo n.º 6
0
Arquivo: Fsome.c Projeto: hoelzl/Clicc
void Fsome(CL_FORM *base, int nargs)
{
	Flist(ARG(2), nargs - 2);
	ALLOC_CONS(ARG(5), ARG(1), ARG(2), ARG(2));
	LOAD_GLOBFUN(&CFmin, ARG(3));
	LOAD_GLOBFUN(&CFlength, ARG(4));
	COPY(ARG(2), ARG(5));
	Fmapcar(ARG(4), 2);
	Fapply(ARG(3), 2);
	mv_count = 1;
	LOAD_FIXNUM(ARG(4), 0, ARG(4));
	GEN_HEAPVAR(ARG(4), ARG(5));
	{
		GEN_CLOSURE(array, ARG(5), 4, Z147_get_elem, 1);
		COPY(ARG(4), &array[3]);
		LOAD_CLOSURE(array, ARG(5));
	}
	M1_1:;
	COPY(INDIRECT(ARG(4)), ARG(6));
	COPY(ARG(3), ARG(7));
	Fge(ARG(6), 2);
	if(CL_TRUEP(ARG(6)))
	{
		LOAD_NIL(ARG(0));
		goto RETURN1;
	}
	COPY(ARG(0), ARG(6));
	COPY(ARG(5), ARG(7));
	COPY(ARG(2), ARG(8));
	Fmaplist(ARG(7), 2);
	Fapply(ARG(6), 2);
	mv_count = 1;
	if(CL_TRUEP(ARG(6)))
	{
		COPY(ARG(6), ARG(0));
		goto RETURN1;
	}
	COPY(INDIRECT(ARG(4)), ARG(6));
	F1plus(ARG(6));
	COPY(ARG(6), INDIRECT(ARG(4)));
	goto M1_1;
	RETURN1:;
}
Exemplo n.º 7
0
void Fmake_concatenated_stream(CL_FORM *base, int nargs)
{
	Flist(ARG(0), nargs - 0);
	GEN_HEAPVAR(ARG(0), ARG(1));
	LOAD_SYMBOL(SYMBOL(Slisp, 95), ARG(1));	/* CONCATENATED */
	{
		GEN_CLOSURE(array, ARG(2), 4, Z87_readc, 0);
		COPY(ARG(0), &array[3]);
		LOAD_CLOSURE(array, ARG(2));
	}
	COPY(ARG(2), ARG(2));
	{
		GEN_CLOSURE(array, ARG(3), 4, Z86_lambda, 1);
		COPY(ARG(0), &array[3]);
		LOAD_CLOSURE(array, ARG(3));
	}
	COPY(ARG(3), ARG(3));
	LOAD_GLOBFUN(&Cclose1, ARG(4));
	LOAD_NIL(ARG(5));
	LOAD_GLOBFUN(&Cundef_stream_op, ARG(6));
	LOAD_GLOBFUN(&Cnil_fun, ARG(7));
	LOAD_GLOBFUN(&Cnil_fun, ARG(8));
	LOAD_GLOBFUN(&Cundef_stream_op, ARG(9));
	LOAD_GLOBFUN(&Cundef_stream_op, ARG(10));
	LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(11));	/* STREAM */
	COPY(ARG(1), ARG(12));
	LOAD_NIL(ARG(13));
	COPY(ARG(2), ARG(14));
	COPY(ARG(3), ARG(15));
	LOAD_GLOBFUN(&Cundef_stream_op, ARG(16));
	LOAD_GLOBFUN(&Cnil_fun, ARG(17));
	LOAD_GLOBFUN(&Cnil_fun, ARG(18));
	LOAD_GLOBFUN(&Cundef_stream_op, ARG(19));
	LOAD_GLOBFUN(&Cundef_stream_op, ARG(20));
	LOAD_GLOBFUN(&Cclose1, ARG(21));
	rt_make_struct(ARG(11), 11);
	COPY(ARG(11), ARG(0));
}
Exemplo n.º 8
0
Arquivo: Fmap.c Projeto: hoelzl/Clicc
void Fmap(CL_FORM *base, int nargs)
{
	Flist(ARG(3), nargs - 3);
	ALLOC_CONS(ARG(6), ARG(2), ARG(3), ARG(3));
	LOAD_GLOBFUN(&CFmin, ARG(4));
	LOAD_GLOBFUN(&CFlength, ARG(5));
	COPY(ARG(3), ARG(6));
	Fmapcar(ARG(5), 2);
	Fapply(ARG(4), 2);
	mv_count = 1;
	LOAD_FIXNUM(ARG(5), 0, ARG(5));
	GEN_HEAPVAR(ARG(5), ARG(6));
	{
		GEN_CLOSURE(array, ARG(6), 4, Z146_get_elem, 1);
		COPY(ARG(5), &array[3]);
		LOAD_CLOSURE(array, ARG(6));
	}
	if(CL_TRUEP(ARG(0)))
	{
		if(CL_SYMBOLP(ARG(0)) && GET_SYMBOL(ARG(0)) == SYMBOL(Slisp, 28))	/* LIST */
		{
			LOAD_NIL(ARG(7));
			LOAD_NIL(ARG(8));
			ALLOC_CONS(ARG(9), ARG(7), ARG(8), ARG(7));
			M1_1:;
			COPY(INDIRECT(ARG(5)), ARG(8));
			COPY(ARG(4), ARG(9));
			Fge(ARG(8), 2);
			if(CL_TRUEP(ARG(8)))
			{
				COPY(GET_CAR(ARG(7)), ARG(0));
				goto RETURN1;
			}
			COPY(ARG(1), ARG(8));
			COPY(ARG(6), ARG(9));
			COPY(ARG(3), ARG(10));
			Fmaplist(ARG(9), 2);
			Fapply(ARG(8), 2);
			mv_count = 1;
			COPY(ARG(7), ARG(9));
			add_q(ARG(8));
			COPY(INDIRECT(ARG(5)), ARG(8));
			F1plus(ARG(8));
			COPY(ARG(8), INDIRECT(ARG(5)));
			goto M1_1;
			RETURN1:;
		}
		else
		{
			COPY(ARG(0), ARG(7));
			COPY(ARG(4), ARG(8));
			LOAD_NIL(ARG(9));
			LOAD_NIL(ARG(10));
			make_sequence1(ARG(7));
			M2_1:;
			COPY(INDIRECT(ARG(5)), ARG(8));
			COPY(ARG(4), ARG(9));
			Fge(ARG(8), 2);
			if(CL_TRUEP(ARG(8)))
			{
				COPY(ARG(7), ARG(0));
				goto RETURN2;
			}
			COPY(ARG(7), ARG(8));
			COPY(INDIRECT(ARG(5)), ARG(9));
			COPY(ARG(1), ARG(10));
			COPY(ARG(6), ARG(11));
			COPY(ARG(3), ARG(12));
			Fmaplist(ARG(11), 2);
			Fapply(ARG(10), 2);
			mv_count = 1;
			COPY(ARG(10), ARG(11));
			COPY(ARG(8), ARG(12));
			COPY(ARG(9), ARG(13));
			Fset_elt(ARG(11));
			COPY(INDIRECT(ARG(5)), ARG(8));
			F1plus(ARG(8));
			COPY(ARG(8), INDIRECT(ARG(5)));
			goto M2_1;
			RETURN2:;
		}
	}
	else
	{
		M3_1:;
		COPY(INDIRECT(ARG(5)), ARG(7));
		COPY(ARG(4), ARG(8));
		Fge(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			LOAD_NIL(ARG(0));
			goto RETURN3;
		}
		COPY(ARG(1), ARG(7));
		COPY(ARG(6), ARG(8));
		COPY(ARG(3), ARG(9));
		Fmaplist(ARG(8), 2);
		Fapply(ARG(7), 2);
		mv_count = 1;
		COPY(INDIRECT(ARG(5)), ARG(7));
		F1plus(ARG(7));
		COPY(ARG(7), INDIRECT(ARG(5)));
		goto M3_1;
		RETURN3:;
	}
}
Exemplo n.º 9
0
void export1(CL_FORM *base)
{
	coerce_to_package(ARG(1));
	if(CL_LISTP(ARG(0)))
	{
	}
	else
	{
		COPY(ARG(0), ARG(2));
		Flist(ARG(2), 1);
		COPY(ARG(2), ARG(0));
	}
	LOAD_NIL(ARG(2));
	COPY(ARG(0), ARG(3));
	M1_1:;
	if(CL_ATOMP(ARG(3)))
	{
		LOAD_NIL(ARG(2));
		goto RETURN1;
	}
	COPY(ARG(3), ARG(4));
	COPY(GET_CAR(ARG(4)), ARG(2));
	if(CL_SYMBOLP(ARG(2)))
	{
		LOAD_SMSTR(SYM_NAME(ARG(2)), ARG(4));
	}
	else
	{
		if(CL_TRUEP(ARG(2)))
		{
			COPY(SYMVAL(Slisp, 676), ARG(4));	/* SYM_EXPECTED */
			COPY(ARG(2), ARG(5));
			Ferror(ARG(4), 2);
		}
		else
		{
			LOAD_SMSTR((CL_FORM *)&KClisp[266], ARG(4));	/* NIL */
		}
	}
	COPY(ARG(1), ARG(5));
	find_symbol1(ARG(4));
	COPY(&mv_buf[0], ARG(5));
	{
		int nargs;
		nargs = 2;
		mv_count = 1;
		{
			switch(nargs)
			{
				case 0:
				LOAD_NIL(ARG(4));
				case 1:
				LOAD_NIL(ARG(5));
				nargs = 2;
			}
			if(CL_TRUEP(ARG(5)))
			{
				LOAD_NIL(ARG(6));
			}
			else
			{
				LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(6));	/* T */
			}
			if(CL_TRUEP(ARG(6)))
			{
				goto THEN1;
			}
			else
			{
				if(EQ(ARG(4), ARG(2)))
				{
					goto ELSE2;
				}
				else
				{
					goto THEN1;
				}
			}
			{
				THEN1:;
				LOAD_SMSTR((CL_FORM *)&Kexport1[0], ARG(6));	/* ~S is not accessible in ~S */
				COPY(ARG(2), ARG(7));
				COPY(ARG(1), ARG(8));
				Ferror(ARG(6), 3);
			}
			ELSE2:;
			if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 385))	/* EXTERNAL */
			{
				goto RETURN1;
			}
			LOAD_NIL(ARG(6));
			COPY(ARG(1), ARG(7));
			LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(8));	/* PACKAGE */
			rt_struct_typep(ARG(7));
			if(CL_TRUEP(ARG(7)))
			{
				COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 6 + 1), ARG(7));
			}
			else
			{
				COPY(SYMVAL(Slisp, 352), ARG(7));	/* NO_STRUCT */
				COPY(ARG(1), ARG(8));
				LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(9));	/* PACKAGE */
				Ferror(ARG(7), 3);
			}
			M2_1:;
			if(CL_ATOMP(ARG(7)))
			{
				LOAD_NIL(ARG(6));
				goto RETURN2;
			}
			COPY(ARG(7), ARG(8));
			COPY(GET_CAR(ARG(8)), ARG(6));
			if(CL_SYMBOLP(ARG(2)))
			{
				LOAD_SMSTR(SYM_NAME(ARG(2)), ARG(8));
			}
			else
			{
				if(CL_TRUEP(ARG(2)))
				{
					COPY(SYMVAL(Slisp, 676), ARG(8));	/* SYM_EXPECTED */
					COPY(ARG(2), ARG(9));
					Ferror(ARG(8), 2);
				}
				else
				{
					LOAD_SMSTR((CL_FORM *)&KClisp[266], ARG(8));	/* NIL */
				}
			}
			COPY(ARG(6), ARG(9));
			find_symbol1(ARG(8));
			COPY(&mv_buf[0], ARG(9));
			{
				int nargs;
				nargs = 2;
				mv_count = 1;
				{
					switch(nargs)
					{
						case 0:
						LOAD_NIL(ARG(8));
						case 1:
						LOAD_NIL(ARG(9));
						nargs = 2;
					}
					if(CL_TRUEP(ARG(9)))
					{
						if(EQ(ARG(8), ARG(2)))
						{
							goto ELSE3;
						}
						else
						{
							COPY(ARG(6), ARG(10));
							LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(11));	/* PACKAGE */
							rt_struct_typep(ARG(10));
							if(CL_TRUEP(ARG(10)))
							{
								COPY(OFFSET(AR_BASE(GET_FORM(ARG(6))), 4 + 1), ARG(10));
							}
							else
							{
								COPY(SYMVAL(Slisp, 352), ARG(10));	/* NO_STRUCT */
								COPY(ARG(6), ARG(11));
								LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(12));	/* PACKAGE */
								Ferror(ARG(10), 3);
							}
							COPY(ARG(8), ARG(11));
							COPY(ARG(10), ARG(12));
							LOAD_NIL(ARG(13));
							LOAD_NIL(ARG(14));
							LOAD_NIL(ARG(15));
							member1(ARG(11));
							COPY(ARG(11), ARG(10));
							if(CL_TRUEP(ARG(10)))
							{
								goto ELSE3;
							}
							else
							{
								goto THEN4;
							}
						}
					}
					else
					{
						goto ELSE3;
					}
					{
						THEN4:;
						LOAD_SMSTR((CL_FORM *)&Kexport1[2], ARG(10));	/* ~S will cause a name conflict in ~S */
						COPY(ARG(2), ARG(11));
						COPY(ARG(6), ARG(12));
						Ferror(ARG(10), 3);
					}
					ELSE3:;
				}
			}
			COPY(ARG(7), ARG(8));
			COPY(GET_CDR(ARG(8)), ARG(7));
			goto M2_1;
			RETURN2:;
			if(CL_SYMBOLP(ARG(2)))
			{
				LOAD_SMSTR(SYM_NAME(ARG(2)), ARG(6));
			}
			else
			{
				if(CL_TRUEP(ARG(2)))
				{
					COPY(SYMVAL(Slisp, 676), ARG(6));	/* SYM_EXPECTED */
					COPY(ARG(2), ARG(7));
					Ferror(ARG(6), 2);
				}
				else
				{
					LOAD_SMSTR((CL_FORM *)&KClisp[266], ARG(6));	/* NIL */
				}
			}
			LOAD_FIXNUM(ARG(7), 101, ARG(7));
			COPY(ARG(6), ARG(8));
			string_to_simple_string(ARG(8));
			rt_sxhash_string(ARG(8));
			COPY(ARG(8), ARG(9));
			LOAD_FIXNUM(ARG(10), 101, ARG(10));
			rt_floor(ARG(9));
			COPY(&mv_buf[0], ARG(10));
			mv_count = 1;
			{
				COPY(ARG(10), ARG(6));
			}
			if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 384))	/* INTERNAL */
			{
				COPY(ARG(2), ARG(7));
				COPY(ARG(1), ARG(8));
				LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(9));	/* PACKAGE */
				rt_struct_typep(ARG(8));
				if(CL_TRUEP(ARG(8)))
				{
					COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 2 + 1), ARG(8));
				}
				else
				{
					COPY(SYMVAL(Slisp, 352), ARG(8));	/* NO_STRUCT */
					COPY(ARG(1), ARG(9));
					LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(10));	/* PACKAGE */
					Ferror(ARG(8), 3);
				}
				COPY(ARG(6), ARG(9));
				del_pack_sym(ARG(7));
			}
			COPY(ARG(1), ARG(7));
			LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(8));	/* PACKAGE */
			rt_struct_typep(ARG(7));
			if(CL_TRUEP(ARG(7)))
			{
				COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 3 + 1), ARG(7));
			}
			else
			{
				COPY(SYMVAL(Slisp, 352), ARG(7));	/* NO_STRUCT */
				COPY(ARG(1), ARG(8));
				LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(9));	/* PACKAGE */
				Ferror(ARG(7), 3);
			}
			COPY(ARG(7), ARG(9));
			COPY(ARG(6), ARG(10));
			Fsvref(ARG(9));
			ALLOC_CONS(ARG(10), ARG(2), ARG(9), ARG(8));
			COPY(ARG(8), ARG(9));
			COPY(ARG(7), ARG(10));
			COPY(ARG(6), ARG(11));
			Fset_svref(ARG(9));
		}
	}
	COPY(ARG(3), ARG(4));
	COPY(GET_CDR(ARG(4)), ARG(3));
	goto M1_1;
	RETURN1:;
	LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(0));	/* T */
}
Exemplo n.º 10
0
void shadowing_import1(CL_FORM *base)
{
	coerce_to_package(ARG(1));
	if(CL_LISTP(ARG(0)))
	{
	}
	else
	{
		COPY(ARG(0), ARG(2));
		Flist(ARG(2), 1);
		COPY(ARG(2), ARG(0));
	}
	LOAD_NIL(ARG(2));
	COPY(ARG(0), ARG(3));
	M1_1:;
	if(CL_ATOMP(ARG(3)))
	{
		LOAD_NIL(ARG(2));
		goto RETURN1;
	}
	COPY(ARG(3), ARG(4));
	COPY(GET_CAR(ARG(4)), ARG(2));
	if(CL_SYMBOLP(ARG(2)))
	{
		LOAD_SMSTR(SYM_NAME(ARG(2)), ARG(4));
	}
	else
	{
		if(CL_TRUEP(ARG(2)))
		{
			COPY(SYMVAL(Slisp, 676), ARG(4));	/* SYM_EXPECTED */
			COPY(ARG(2), ARG(5));
			Ferror(ARG(4), 2);
		}
		else
		{
			LOAD_SMSTR((CL_FORM *)&KClisp[266], ARG(4));	/* NIL */
		}
	}
	COPY(ARG(1), ARG(5));
	find_symbol1(ARG(4));
	COPY(&mv_buf[0], ARG(5));
	{
		int nargs;
		nargs = 2;
		mv_count = 1;
		{
			switch(nargs)
			{
				case 0:
				LOAD_NIL(ARG(4));
				case 1:
				LOAD_NIL(ARG(5));
				nargs = 2;
			}
			if(CL_SYMBOLP(ARG(2)))
			{
				LOAD_SMSTR(SYM_NAME(ARG(2)), ARG(6));
			}
			else
			{
				if(CL_TRUEP(ARG(2)))
				{
					COPY(SYMVAL(Slisp, 676), ARG(6));	/* SYM_EXPECTED */
					COPY(ARG(2), ARG(7));
					Ferror(ARG(6), 2);
				}
				else
				{
					LOAD_SMSTR((CL_FORM *)&KClisp[266], ARG(6));	/* NIL */
				}
			}
			LOAD_FIXNUM(ARG(7), 101, ARG(7));
			COPY(ARG(6), ARG(8));
			string_to_simple_string(ARG(8));
			rt_sxhash_string(ARG(8));
			COPY(ARG(8), ARG(9));
			LOAD_FIXNUM(ARG(10), 101, ARG(10));
			rt_floor(ARG(9));
			COPY(&mv_buf[0], ARG(10));
			mv_count = 1;
			{
				COPY(ARG(10), ARG(6));
			}
			if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 384))	/* INTERNAL */
			{
				COPY(ARG(4), ARG(7));
				COPY(ARG(1), ARG(8));
				LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(9));	/* PACKAGE */
				rt_struct_typep(ARG(8));
				if(CL_TRUEP(ARG(8)))
				{
					COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 2 + 1), ARG(8));
				}
				else
				{
					COPY(SYMVAL(Slisp, 352), ARG(8));	/* NO_STRUCT */
					COPY(ARG(1), ARG(9));
					LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(10));	/* PACKAGE */
					Ferror(ARG(8), 3);
				}
				COPY(ARG(6), ARG(9));
				del_pack_sym(ARG(7));
			}
			else
			{
				if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 385))	/* EXTERNAL */
				{
					COPY(ARG(4), ARG(7));
					COPY(ARG(1), ARG(8));
					LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(9));	/* PACKAGE */
					rt_struct_typep(ARG(8));
					if(CL_TRUEP(ARG(8)))
					{
						COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 3 + 1), ARG(8));
					}
					else
					{
						COPY(SYMVAL(Slisp, 352), ARG(8));	/* NO_STRUCT */
						COPY(ARG(1), ARG(9));
						LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(10));	/* PACKAGE */
						Ferror(ARG(8), 3);
					}
					COPY(ARG(6), ARG(9));
					del_pack_sym(ARG(7));
				}
			}
		}
	}
	COPY(ARG(2), ARG(4));
	COPY(ARG(1), ARG(5));
	internal_import(ARG(4));
	COPY(ARG(1), ARG(5));
	LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(6));	/* PACKAGE */
	rt_struct_typep(ARG(5));
	if(CL_TRUEP(ARG(5)))
	{
		COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 4 + 1), ARG(5));
	}
	else
	{
		COPY(SYMVAL(Slisp, 352), ARG(5));	/* NO_STRUCT */
		COPY(ARG(1), ARG(6));
		LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(7));	/* PACKAGE */
		Ferror(ARG(5), 3);
	}
	ALLOC_CONS(ARG(6), ARG(2), ARG(5), ARG(4));
	LOAD_FIXNUM(ARG(5), 4, ARG(5));
	COPY(ARG(1), ARG(6));
	LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(7));	/* PACKAGE */
	rt_struct_typep(ARG(6));
	if(CL_TRUEP(ARG(6)))
	{
		COPY(ARG(4), OFFSET(AR_BASE(GET_FORM(ARG(1))), 4 + 1));
	}
	else
	{
		COPY(SYMVAL(Slisp, 352), ARG(6));	/* NO_STRUCT */
		COPY(ARG(1), ARG(7));
		LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(8));	/* PACKAGE */
		Ferror(ARG(6), 3);
	}
	COPY(ARG(3), ARG(4));
	COPY(GET_CDR(ARG(4)), ARG(3));
	goto M1_1;
	RETURN1:;
	LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(0));	/* T */
}
Exemplo n.º 11
0
void vector_push_extend1(CL_FORM *base)
{
	COPY(ARG(1), ARG(3));
	Farray_has_fill_pointer_p(ARG(3));
	if(CL_TRUEP(ARG(3)))
	{
	}
	else
	{
		COPY(SYMVAL(Slisp, 154), ARG(3));	/* NO_FILL_PTR */
		COPY(ARG(1), ARG(4));
		Ferror(ARG(3), 2);
	}
	COPY(ARG(1), ARG(3));
	LOAD_SYMBOL(SYMBOL(Slisp, 150), ARG(4));	/* COMPLEX-VECTOR */
	rt_struct_typep(ARG(3));
	if(CL_TRUEP(ARG(3)))
	{
		COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 3 + 1), ARG(3));
	}
	else
	{
		COPY(SYMVAL(Slisp, 352), ARG(3));	/* NO_STRUCT */
		COPY(ARG(1), ARG(4));
		LOAD_SYMBOL(SYMBOL(Slisp, 150), ARG(5));	/* COMPLEX-VECTOR */
		Ferror(ARG(3), 3);
	}
	COPY(ARG(3), ARG(4));
	COPY(ARG(1), ARG(5));
	Farray_total_size(ARG(5));
	Fge(ARG(4), 2);
	if(CL_TRUEP(ARG(4)))
	{
		COPY(ARG(1), ARG(4));
		if(CL_TRUEP(ARG(2)))
		{
			COPY(ARG(1), ARG(5));
			Farray_total_size(ARG(5));
			COPY(ARG(2), ARG(6));
			Fplus(ARG(5), 2);
		}
		else
		{
			LOAD_FIXNUM(ARG(5), 2, ARG(5));
			COPY(ARG(1), ARG(6));
			Farray_total_size(ARG(6));
			Fmult(ARG(5), 2);
		}
		LOAD_NIL(ARG(6));
		LOAD_NIL(ARG(7));
		LOAD_NIL(ARG(8));
		COPY(ARG(3), ARG(9));
		LOAD_NIL(ARG(10));
		LOAD_NIL(ARG(11));
		LOAD_SYMBOL(SYMBOL(Slisp, 101), ARG(12));	/* FILL-POINTER */
		COPY(ARG(3), ARG(13));
		Flist(ARG(12), 2);
		LOAD_NIL(ARG(13));
		LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(14));	/* T */
		adjust_array1(ARG(4));
	}
	COPY(ARG(0), ARG(4));
	COPY(ARG(1), ARG(5));
	COPY(ARG(3), ARG(6));
	rt_set_vref(ARG(4));
	COPY(ARG(3), ARG(4));
	F1plus(ARG(4));
	COPY(ARG(1), ARG(5));
	Fset_fill_pointer(ARG(4));
	COPY(ARG(3), ARG(0));
}
Exemplo n.º 12
0
void unintern1(CL_FORM *base)
{
	LOAD_NIL(ARG(2));
	LOAD_NIL(ARG(3));
	if(CL_SYMBOLP(ARG(0)))
	{
		LOAD_SMSTR(SYM_NAME(ARG(0)), ARG(4));
	}
	else
	{
		if(CL_TRUEP(ARG(0)))
		{
			COPY(SYMVAL(Slisp, 676), ARG(4));	/* SYM_EXPECTED */
			COPY(ARG(0), ARG(5));
			Ferror(ARG(4), 2);
		}
		else
		{
			LOAD_SMSTR((CL_FORM *)&KClisp[266], ARG(4));	/* NIL */
		}
	}
	LOAD_NIL(ARG(5));
	COPY(ARG(1), ARG(6));
	coerce_to_package(ARG(6));
	COPY(ARG(6), ARG(1));
	COPY(ARG(4), ARG(6));
	COPY(ARG(1), ARG(7));
	find_symbol1(ARG(6));
	COPY(&mv_buf[0], ARG(7));
	{
		int nargs;
		nargs = 2;
		mv_count = 1;
		{
			switch(nargs)
			{
				case 0:
				LOAD_NIL(ARG(6));
				case 1:
				LOAD_NIL(ARG(7));
				nargs = 2;
			}
			COPY(ARG(6), ARG(2));
			COPY(ARG(7), ARG(3));
		}
	}
	if(EQ(ARG(2), ARG(0)))
	{
		LOAD_BOOL(CL_SYMBOLP(ARG(3)) && GET_SYMBOL(ARG(3)) == SYMBOL(Slisp, 384), ARG(6));	/* INTERNAL */
		if(CL_TRUEP(ARG(6)))
		{
			goto THEN1;
		}
		else
		{
		}	/* EXTERNAL */
	}
	else
	{
		goto ELSE2;
	}
	if(CL_SYMBOLP(ARG(3)) && GET_SYMBOL(ARG(3)) == SYMBOL(Slisp, 385))
	{
		THEN1:;
		if(CL_SYMBOLP(ARG(3)) && GET_SYMBOL(ARG(3)) == SYMBOL(Slisp, 385))	/* EXTERNAL */
		{
			COPY(ARG(1), ARG(6));
			COPY(ARG(6), ARG(7));
			COPY(ARG(7), ARG(8));
			LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(9));	/* PACKAGE */
			rt_struct_typep(ARG(8));
			if(CL_TRUEP(ARG(8)))
			{
				COPY(OFFSET(AR_BASE(GET_FORM(ARG(7))), 3 + 1), ARG(5));
			}
			else
			{
				COPY(SYMVAL(Slisp, 352), ARG(5));	/* NO_STRUCT */
				COPY(ARG(7), ARG(6));
				LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(7));	/* PACKAGE */
				Ferror(ARG(5), 3);
			}
		}
		else
		{
			COPY(ARG(1), ARG(6));
			COPY(ARG(6), ARG(7));
			COPY(ARG(7), ARG(8));
			LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(9));	/* PACKAGE */
			rt_struct_typep(ARG(8));
			if(CL_TRUEP(ARG(8)))
			{
				COPY(OFFSET(AR_BASE(GET_FORM(ARG(7))), 2 + 1), ARG(5));
			}
			else
			{
				COPY(SYMVAL(Slisp, 352), ARG(5));	/* NO_STRUCT */
				COPY(ARG(7), ARG(6));
				LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(7));	/* PACKAGE */
				Ferror(ARG(5), 3);
			}
		}
		COPY(ARG(1), ARG(6));
		LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(7));	/* PACKAGE */
		rt_struct_typep(ARG(6));
		if(CL_TRUEP(ARG(6)))
		{
			COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 4 + 1), ARG(6));
		}
		else
		{
			COPY(SYMVAL(Slisp, 352), ARG(6));	/* NO_STRUCT */
			COPY(ARG(1), ARG(7));
			LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(8));	/* PACKAGE */
			Ferror(ARG(6), 3);
		}
		COPY(ARG(0), ARG(7));
		COPY(ARG(6), ARG(8));
		LOAD_NIL(ARG(9));
		LOAD_NIL(ARG(10));
		LOAD_NIL(ARG(11));
		member1(ARG(7));
		if(CL_TRUEP(ARG(7)))
		{
			LOAD_FIXNUM(ARG(6), 0, ARG(6));
			LOAD_NIL(ARG(7));
			COPY(ARG(1), ARG(8));
			LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(9));	/* PACKAGE */
			rt_struct_typep(ARG(8));
			if(CL_TRUEP(ARG(8)))
			{
				COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 5 + 1), ARG(8));
			}
			else
			{
				COPY(SYMVAL(Slisp, 352), ARG(8));	/* NO_STRUCT */
				COPY(ARG(1), ARG(9));
				LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(10));	/* PACKAGE */
				Ferror(ARG(8), 3);
			}
			M1_1:;
			if(CL_ATOMP(ARG(8)))
			{
				LOAD_NIL(ARG(7));
				goto RETURN1;
			}
			COPY(ARG(8), ARG(9));
			COPY(GET_CAR(ARG(9)), ARG(7));
			COPY(ARG(4), ARG(9));
			COPY(ARG(7), ARG(10));
			find_symbol1(ARG(9));
			COPY(&mv_buf[0], ARG(10));
			{
				int nargs;
				nargs = 2;
				mv_count = 1;
				{
					switch(nargs)
					{
						case 0:
						LOAD_NIL(ARG(9));
						case 1:
						LOAD_NIL(ARG(10));
						nargs = 2;
					}
					COPY(ARG(9), ARG(2));
					COPY(ARG(10), ARG(3));
				}
			}
			if(CL_SYMBOLP(ARG(3)) && GET_SYMBOL(ARG(3)) == SYMBOL(Slisp, 385))	/* EXTERNAL */
			{
				if(CL_FIXNUMP(ARG(6)) && GET_FIXNUM(ARG(6)) == 0)
				{
					COPY(ARG(2), ARG(6));
				}
				else
				{
					if(EQ(ARG(2), ARG(6)))
					{
					}
					else
					{
						LOAD_SMSTR((CL_FORM *)&Kunintern1[0], ARG(9));	/* ~S and ~S will cause a name conflict */
						COPY(ARG(6), ARG(10));
						COPY(ARG(2), ARG(11));
						Ferror(ARG(9), 3);
					}
				}
			}
			COPY(ARG(8), ARG(9));
			COPY(GET_CDR(ARG(9)), ARG(8));
			goto M1_1;
			RETURN1:;
			COPY(ARG(1), ARG(6));
			LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(7));	/* PACKAGE */
			rt_struct_typep(ARG(6));
			if(CL_TRUEP(ARG(6)))
			{
				COPY(OFFSET(AR_BASE(GET_FORM(ARG(1))), 4 + 1), ARG(6));
			}
			else
			{
				COPY(SYMVAL(Slisp, 352), ARG(6));	/* NO_STRUCT */
				COPY(ARG(1), ARG(7));
				LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(8));	/* PACKAGE */
				Ferror(ARG(6), 3);
			}
			LOAD_SYMBOL(SYMBOL(Slisp, 392), ARG(7));	/* COUNT */
			LOAD_FIXNUM(ARG(8), 1, ARG(8));
			Flist(ARG(7), 2);
			LOAD_GLOBFUN(&CFremove, ARG(8));
			COPY(ARG(0), ARG(9));
			COPY(ARG(6), ARG(10));
			COPY(ARG(7), ARG(11));
			Fapply(ARG(8), 4);
			mv_count = 1;
			COPY(ARG(8), ARG(6));
			LOAD_FIXNUM(ARG(7), 4, ARG(7));
			COPY(ARG(1), ARG(8));
			LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(9));	/* PACKAGE */
			rt_struct_typep(ARG(8));
			if(CL_TRUEP(ARG(8)))
			{
				COPY(ARG(6), OFFSET(AR_BASE(GET_FORM(ARG(1))), 4 + 1));
			}
			else
			{
				COPY(SYMVAL(Slisp, 352), ARG(8));	/* NO_STRUCT */
				COPY(ARG(1), ARG(9));
				LOAD_SYMBOL(SYMBOL(Slisp, 354), ARG(10));	/* PACKAGE */
				Ferror(ARG(8), 3);
			}
		}
		COPY(ARG(0), ARG(6));
		COPY(ARG(5), ARG(7));
		LOAD_FIXNUM(ARG(8), 101, ARG(8));
		COPY(ARG(4), ARG(9));
		string_to_simple_string(ARG(9));
		rt_sxhash_string(ARG(9));
		COPY(ARG(9), ARG(10));
		LOAD_FIXNUM(ARG(11), 101, ARG(11));
		rt_floor(ARG(10));
		COPY(&mv_buf[0], ARG(11));
		mv_count = 1;
		{
			COPY(ARG(11), ARG(8));
		}
		del_pack_sym(ARG(6));
		if(CL_SYMBOLP(ARG(0)))
		{
			COPY(SYM_PACKAGE(ARG(0)), ARG(6));
		}
		else
		{
			if(CL_TRUEP(ARG(0)))
			{
				COPY(SYMVAL(Slisp, 676), ARG(6));	/* SYM_EXPECTED */
				COPY(ARG(0), ARG(7));
				Ferror(ARG(6), 2);
			}
			else
			{
				COPY(SYMVAL(Slisp, 679), ARG(6));	/* *NIL-PACKAGE* */
			}
		}
		if(EQ(ARG(6), ARG(1)))
		{
			COPY(ARG(0), ARG(6));
			LOAD_NIL(ARG(7));
			set_symbol_package(ARG(6));
		}
		LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(0));	/* T */
	}
	else
	{
		ELSE2:;
		LOAD_NIL(ARG(0));
	}
}
Exemplo n.º 13
0
void concatenate_to_list(CL_FORM *base, int nargs)
{
	Flist(STACK(base, 0), nargs - 0);
	LOAD_NIL(STACK(base, 1));
	LOAD_NIL(STACK(base, 2));
	{
		CL_FORM *lptr;
		lptr = form_alloc(STACK(base, 3), 2);
		COPY(STACK(base, 1), CAR(lptr));
		COPY(STACK(base, 2), CDR(lptr));
		LOAD_CONS(lptr, STACK(base, 1));
	}
	LOAD_NIL(STACK(base, 2));
	COPY(STACK(base, 0), STACK(base, 3));
	M148_1:;
	if(CL_ATOMP(STACK(base, 3)))
	{
		LOAD_NIL(STACK(base, 2));
		goto RETURN162;
	}
	COPY(STACK(base, 3), STACK(base, 4));
	Fcar(STACK(base, 4));
	COPY(STACK(base, 4), STACK(base, 2));
	if(CL_LISTP(STACK(base, 2)))
	{
		LOAD_NIL(STACK(base, 4));
		COPY(STACK(base, 2), STACK(base, 5));
		M149_1:;
		if(CL_ATOMP(STACK(base, 5)))
		{
			LOAD_NIL(STACK(base, 4));
			goto RETURN163;
		}
		COPY(STACK(base, 5), STACK(base, 6));
		Fcar(STACK(base, 6));
		COPY(STACK(base, 6), STACK(base, 4));
		COPY(STACK(base, 1), STACK(base, 7));
		add_q(STACK(base, 6));
		Fcdr(STACK(base, 5));
		goto M149_1;
		RETURN163:;
	}
	else
	{
		COPY(STACK(base, 2), STACK(base, 4));
		Flength(STACK(base, 4));
		LOAD_FIXNUM(0, STACK(base, 5));
		M150_1:;
		COPY(STACK(base, 5), STACK(base, 6));
		COPY(STACK(base, 4), STACK(base, 7));
		Fge(STACK(base, 6), 2);
		if(CL_TRUEP(STACK(base, 6)))
		{
			goto RETURN164;
		}
		COPY(STACK(base, 2), STACK(base, 6));
		COPY(STACK(base, 5), STACK(base, 7));
		Felt(STACK(base, 6));
		COPY(STACK(base, 1), STACK(base, 7));
		add_q(STACK(base, 6));
		F1plus(STACK(base, 5));
		goto M150_1;
		RETURN164:;
	}
	Fcdr(STACK(base, 3));
	goto M148_1;
	RETURN162:;
	COPY(STACK(base, 1), STACK(base, 0));
	Fcar(STACK(base, 0));
}
Exemplo n.º 14
0
void concatenate_to_non_list(CL_FORM *base, int nargs)
{
	Flist(STACK(base, 1), nargs - 1);
	LOAD_NIL(STACK(base, 2));
	LOAD_FIXNUM(0, STACK(base, 3));
	LOAD_FIXNUM(0, STACK(base, 4));
	LOAD_NIL(STACK(base, 5));
	COPY(STACK(base, 1), STACK(base, 6));
	M144_1:;
	if(CL_ATOMP(STACK(base, 6)))
	{
		LOAD_NIL(STACK(base, 5));
		goto RETURN158;
	}
	COPY(STACK(base, 6), STACK(base, 7));
	Fcar(STACK(base, 7));
	COPY(STACK(base, 7), STACK(base, 5));
	COPY(STACK(base, 3), STACK(base, 7));
	COPY(STACK(base, 5), STACK(base, 8));
	Flength(STACK(base, 8));
	Fplus(STACK(base, 7), 2);
	COPY(STACK(base, 7), STACK(base, 3));
	Fcdr(STACK(base, 6));
	goto M144_1;
	RETURN158:;
	COPY(STACK(base, 0), STACK(base, 5));
	COPY(STACK(base, 3), STACK(base, 6));
	Fmake_sequence(STACK(base, 5), 2);
	COPY(STACK(base, 5), STACK(base, 2));
	LOAD_NIL(STACK(base, 5));
	COPY(STACK(base, 1), STACK(base, 6));
	M145_1:;
	if(CL_ATOMP(STACK(base, 6)))
	{
		LOAD_NIL(STACK(base, 5));
		goto RETURN159;
	}
	COPY(STACK(base, 6), STACK(base, 7));
	Fcar(STACK(base, 7));
	COPY(STACK(base, 7), STACK(base, 5));
	if(CL_LISTP(STACK(base, 5)))
	{
		LOAD_NIL(STACK(base, 7));
		COPY(STACK(base, 5), STACK(base, 8));
		M146_1:;
		if(CL_ATOMP(STACK(base, 8)))
		{
			LOAD_NIL(STACK(base, 7));
			goto RETURN160;
		}
		COPY(STACK(base, 8), STACK(base, 9));
		Fcar(STACK(base, 9));
		COPY(STACK(base, 9), STACK(base, 7));
		COPY(STACK(base, 2), STACK(base, 10));
		COPY(STACK(base, 4), STACK(base, 11));
		Fset_elt(STACK(base, 9));
		COPY(STACK(base, 4), STACK(base, 9));
		F1plus(STACK(base, 9));
		COPY(STACK(base, 9), STACK(base, 4));
		Fcdr(STACK(base, 8));
		goto M146_1;
		RETURN160:;
	}
	else
	{
		COPY(STACK(base, 5), STACK(base, 7));
		Flength(STACK(base, 7));
		LOAD_FIXNUM(0, STACK(base, 8));
		M147_1:;
		COPY(STACK(base, 8), STACK(base, 9));
		COPY(STACK(base, 7), STACK(base, 10));
		Fge(STACK(base, 9), 2);
		if(CL_TRUEP(STACK(base, 9)))
		{
			goto RETURN161;
		}
		COPY(STACK(base, 5), STACK(base, 9));
		COPY(STACK(base, 8), STACK(base, 10));
		Felt(STACK(base, 9));
		COPY(STACK(base, 9), STACK(base, 10));
		COPY(STACK(base, 2), STACK(base, 11));
		COPY(STACK(base, 4), STACK(base, 12));
		Fset_elt(STACK(base, 10));
		COPY(STACK(base, 4), STACK(base, 9));
		F1plus(STACK(base, 9));
		COPY(STACK(base, 9), STACK(base, 4));
		F1plus(STACK(base, 8));
		goto M147_1;
		RETURN161:;
	}
	Fcdr(STACK(base, 6));
	goto M145_1;
	RETURN159:;
	COPY(STACK(base, 2), STACK(base, 0));
}