예제 #1
0
파일: unintern1.c 프로젝트: hoelzl/Clicc
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));
	}
}
예제 #2
0
파일: lisp467.c 프로젝트: hoelzl/Clicc
void rt_setup_symbol(CL_FORM *base)
{
	if(CL_SYMBOLP(ARG(0)))
	{
		COPY(SYM_PACKAGE(ARG(0)), ARG(2));
	}
	else
	{
		if(CL_TRUEP(ARG(0)))
		{
			LOAD_NIL(ARG(2));
		}
		else
		{
			COPY(SYMVAL(Slisp, 679), ARG(2));	/* *NIL-PACKAGE* */
		}
	}
	if(CL_TRUEP(ARG(2)))
	{
		COPY(ARG(1), ARG(3));
		COPY(ARG(2), ARG(4));
		Fminusp(ARG(4));
		if(CL_TRUEP(ARG(4)))
		{
			COPY(ARG(2), ARG(4));
			Fminus(ARG(4), 1);
		}
		else
		{
			COPY(ARG(2), ARG(4));
		}
		Fsvref(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_FIXNUM(ARG(5), 101, ARG(5));
		COPY(ARG(4), ARG(6));
		string_to_simple_string(ARG(6));
		rt_sxhash_string(ARG(6));
		COPY(ARG(6), ARG(7));
		LOAD_FIXNUM(ARG(8), 101, ARG(8));
		rt_floor(ARG(7));
		COPY(&mv_buf[0], ARG(8));
		mv_count = 1;
		{
			COPY(ARG(8), ARG(4));
		}
		COPY(ARG(0), ARG(5));
		COPY(ARG(3), ARG(6));
		set_symbol_package(ARG(5));
		COPY(ARG(2), ARG(5));
		Fplusp(ARG(5));
		if(CL_TRUEP(ARG(5)))
		{
			COPY(ARG(3), ARG(5));
			Ppackage_internal(ARG(5));
			COPY(ARG(5), ARG(7));
			COPY(ARG(4), ARG(8));
			Fsvref(ARG(7));
			ALLOC_CONS(ARG(8), ARG(0), ARG(7), ARG(6));
			COPY(ARG(5), ARG(7));
			COPY(ARG(4), ARG(8));
			Fset_svref(ARG(6));
			COPY(ARG(6), ARG(0));
		}
		else
		{
			COPY(ARG(3), ARG(5));
			Ppackage_external(ARG(5));
			COPY(ARG(5), ARG(7));
			COPY(ARG(4), ARG(8));
			Fsvref(ARG(7));
			ALLOC_CONS(ARG(8), ARG(0), ARG(7), ARG(6));
			COPY(ARG(5), ARG(7));
			COPY(ARG(4), ARG(8));
			Fset_svref(ARG(6));
			COPY(ARG(6), ARG(0));
		}
	}
	else
	{
		LOAD_NIL(ARG(0));
	}
}
예제 #3
0
파일: setup_symbol.c 프로젝트: plops/clicc
void setup_symbol(CL_FORM *base)
{
	LOAD_NIL(STACK(base, 2));
	COPY(STACK(base, 0), STACK(base, 2));
	symbol_package_index(STACK(base, 2));
	if(CL_TRUEP(STACK(base, 2)))
	{
		COPY(STACK(base, 1), STACK(base, 3));
		COPY(STACK(base, 2), STACK(base, 4));
		Fminusp(STACK(base, 4));
		if(CL_TRUEP(STACK(base, 4)))
		{
			COPY(STACK(base, 2), STACK(base, 4));
			Fminus(STACK(base, 4), 1);
		}
		else
		{
			COPY(STACK(base, 2), STACK(base, 4));
		}
		vref(STACK(base, 3));
		COPY(STACK(base, 0), STACK(base, 4));
		Fsymbol_name(STACK(base, 4));
		LOAD_FIXNUM(101, STACK(base, 5));
		string_hash(STACK(base, 4));
		COPY(STACK(base, 3), STACK(base, 5));
		COPY(STACK(base, 0), STACK(base, 6));
		set_symbol_package(STACK(base, 5));
		COPY(STACK(base, 2), STACK(base, 5));
		LOAD_FIXNUM(0, STACK(base, 6));
		Fle(STACK(base, 5), 2);
		if(CL_TRUEP(STACK(base, 5)))
		{
			COPY(STACK(base, 3), STACK(base, 5));
			LOAD_FIXNUM(3, STACK(base, 6));
			LOAD_SYMBOL(SYMBOL(Slisp, 273), STACK(base, 7));	/* PACKAGE */
			struct_ref(STACK(base, 5));
			COPY(STACK(base, 5), STACK(base, 6));
			COPY(STACK(base, 4), STACK(base, 7));
			Fsvref(STACK(base, 6));
			{
				CL_FORM *lptr;
				lptr = form_alloc(STACK(base, 7), 2);
				COPY(STACK(base, 0), CAR(lptr));
				COPY(STACK(base, 6), CDR(lptr));
				LOAD_CONS(lptr, STACK(base, 6));
			}
			COPY(STACK(base, 6), STACK(base, 0));
			COPY(STACK(base, 5), STACK(base, 1));
			COPY(STACK(base, 4), STACK(base, 2));
			Fset_svref(STACK(base, 0));
		}
		else
		{
			COPY(STACK(base, 3), STACK(base, 5));
			LOAD_FIXNUM(2, STACK(base, 6));
			LOAD_SYMBOL(SYMBOL(Slisp, 273), STACK(base, 7));	/* PACKAGE */
			struct_ref(STACK(base, 5));
			COPY(STACK(base, 5), STACK(base, 6));
			COPY(STACK(base, 4), STACK(base, 7));
			Fsvref(STACK(base, 6));
			{
				CL_FORM *lptr;
				lptr = form_alloc(STACK(base, 7), 2);
				COPY(STACK(base, 0), CAR(lptr));
				COPY(STACK(base, 6), CDR(lptr));
				LOAD_CONS(lptr, STACK(base, 6));
			}
			COPY(STACK(base, 6), STACK(base, 0));
			COPY(STACK(base, 5), STACK(base, 1));
			COPY(STACK(base, 4), STACK(base, 2));
			Fset_svref(STACK(base, 0));
		}
	}
	else
	{
		LOAD_NIL(STACK(base, 0));
	}
}