예제 #1
0
파일: lisp507.c 프로젝트: plops/clicc
void token_push_extend(CL_FORM *base)
{
	COPY(ARG(0), ARG(1));
	COPY(SYMVAL(Slisp, 439), ARG(2));	/* *TOKEN* */
	COPY(SYMVAL(Slisp, 440), ARG(3));	/* *FILL-POINTER* */
	Fset_schar(ARG(1));
	COPY(SYMVAL(Slisp, 440), ARG(1));	/* *FILL-POINTER* */
	F1plus(ARG(1));
	COPY(ARG(1), SYMVAL(Slisp, 440));	/* *FILL-POINTER* */
	COPY(SYMVAL(Slisp, 441), ARG(2));	/* *TOKEN-LENGTH* */
	Fge(ARG(1), 2);
	if(CL_TRUEP(ARG(1)))
	{
		LOAD_SYMBOL(SYMBOL(Slisp, 44), ARG(1));	/* STRING */
		COPY(SYMVAL(Slisp, 439), ARG(2));	/* *TOKEN* */
		COPY(SYMVAL(Slisp, 442), ARG(3));	/* *TOKEN-EXTENSION* */
		LOAD_CHAR(ARG(4), ' ', ARG(4));
		make_string1(ARG(3));
		Fconcatenate(ARG(1), 3);
		COPY(ARG(1), SYMVAL(Slisp, 439));	/* *TOKEN* */
		COPY(SYMVAL(Slisp, 441), ARG(1));	/* *TOKEN-LENGTH* */
		COPY(SYMVAL(Slisp, 442), ARG(2));	/* *TOKEN-EXTENSION* */
		Fplus(ARG(1), 2);
		COPY(ARG(1), SYMVAL(Slisp, 441));	/* *TOKEN-LENGTH* */
		COPY(SYMVAL(Slisp, 441), ARG(0));	/* *TOKEN-LENGTH* */
	}
	else
	{
		LOAD_NIL(ARG(0));
	}
}
예제 #2
0
파일: print1.c 프로젝트: hoelzl/Clicc
void print1(CL_FORM *base)
{
	LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(2));	/* T */
	BIND_SPECIAL(SYMBOL(Slisp, 474), ARG(2));	/* *PRINT-ESCAPE* */
	if(CL_TRUEP(ARG(1)))
	{
		if(CL_SYMBOLP(ARG(1)) && GET_SYMBOL(ARG(1)) == SYMBOL(Slisp, 48))	/* T */
		{
			COPY(SYMVAL(Slisp, 59), ARG(1));	/* *TERMINAL-IO* */
		}
	}
	else
	{
		COPY(SYMVAL(Slisp, 61), ARG(1));	/* *STANDARD-OUTPUT* */
	}
	COPY(ARG(1), ARG(3));
	terpri1(ARG(3));
	COPY(ARG(0), ARG(3));
	COPY(ARG(1), ARG(4));
	write2(ARG(3));
	LOAD_CHAR(ARG(3), ' ', ARG(3));
	COPY(ARG(1), ARG(4));
	write_char1(ARG(3));
	mv_count = 1;
	RESTORE_SPECIAL;
}
예제 #3
0
파일: Fmake_string.c 프로젝트: hoelzl/Clicc
void Fmake_string(CL_FORM *base, int nargs)
{
	BOOL supl_flags[1];
	static CL_FORM * keylist[] =
	{
		SYMBOL(Slisp, 155),	/* INITIAL-ELEMENT */
	};
	keysort(ARG(1), nargs - 1, 1, keylist, supl_flags, FALSE);
	if(NOT(supl_flags[0]))
	{
		LOAD_CHAR(ARG(2), ' ', ARG(1));
	}
	make_string1(ARG(0));
}
예제 #4
0
파일: fresh_line1.c 프로젝트: hoelzl/Clicc
void fresh_line1(CL_FORM *base)
{
	if(CL_TRUEP(ARG(0)))
	{
		if(CL_SYMBOLP(ARG(0)) && GET_SYMBOL(ARG(0)) == SYMBOL(Slisp, 48))	/* T */
		{
			COPY(SYMVAL(Slisp, 59), ARG(0));	/* *TERMINAL-IO* */
		}
	}
	else
	{
		COPY(SYMVAL(Slisp, 61), ARG(0));	/* *STANDARD-OUTPUT* */
	}
	COPY(ARG(0), ARG(1));
	COPY(ARG(1), ARG(2));
	COPY(ARG(2), ARG(3));
	LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(4));	/* STREAM */
	rt_struct_typep(ARG(3));
	if(CL_TRUEP(ARG(3)))
	{
		COPY(OFFSET(AR_BASE(GET_FORM(ARG(2))), 5 + 1), ARG(1));
	}
	else
	{
		COPY(SYMVAL(Slisp, 352), ARG(1));	/* NO_STRUCT */
		LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(3));	/* STREAM */
		Ferror(ARG(1), 3);
	}
	Ffuncall(ARG(1), 1);
	mv_count = 1;
	if(CL_FIXNUMP(ARG(1)) && GET_FIXNUM(ARG(1)) == 0)
	{
		LOAD_NIL(ARG(0));
	}
	else
	{
		LOAD_CHAR(ARG(1), '\n', ARG(1));
		COPY(ARG(0), ARG(2));
		write_char1(ARG(1));
		COPY(ARG(1), ARG(0));
	}
}
예제 #5
0
파일: lisp373.c 프로젝트: hoelzl/Clicc
void quick_integer_to_string(CL_FORM *base)
{
	COPY(ARG(0), ARG(1));
	Fzerop(ARG(1));
	if(CL_TRUEP(ARG(1)))
	{
		LOAD_SMSTR((CL_FORM *)&Kquick_integer_to_string[0], ARG(0));	/* 0 */
	}
	else
	{
		if(CL_FIXNUMP(ARG(0)) && GET_FIXNUM(ARG(0)) == 1)
		{
			LOAD_SMSTR((CL_FORM *)&Kquick_integer_to_string[2], ARG(0));	/* 1 */
		}
		else
		{
			COPY(ARG(0), ARG(1));
			Fminusp(ARG(1));
			if(CL_TRUEP(ARG(1)))
			{
				LOAD_SYMBOL(SYMBOL(Slisp, 40), ARG(1));	/* SIMPLE-STRING */
				LOAD_SMSTR((CL_FORM *)&Kquick_integer_to_string[4], ARG(2));	/* - */
				COPY(ARG(0), ARG(3));
				Fminus(ARG(3), 1);
				quick_integer_to_string(ARG(3));
				if(CL_SMSTRP(ARG(3)))
				{
				}
				else
				{
					LOAD_SMSTR((CL_FORM *)&KClisp[244], ARG(4));	/* type error: ~S is not of type ~S */
					COPY(ARG(3), ARG(5));
					LOAD_SYMBOL(SYMBOL(Slisp, 40), ARG(6));	/* SIMPLE-STRING */
					Ferror(ARG(4), 3);
				}
				Fconcatenate(ARG(1), 3);
				COPY(ARG(1), ARG(0));
			}
			else
			{
				COPY(ARG(0), ARG(1));
				Finteger_length(ARG(1));
				LOAD_FIXNUM(ARG(2), 3, ARG(2));
				LOAD_FIXNUM(ARG(2), 3, ARG(2));
				rt_truncate(ARG(1));
				mv_count = 1;
				F1plus(ARG(1));
				COPY(ARG(1), ARG(2));
				LOAD_CHAR(ARG(3), ' ', ARG(3));
				make_string1(ARG(2));
				COPY(ARG(1), ARG(3));
				F1minus(ARG(3));
				COPY(ARG(0), ARG(4));
				LOAD_FIXNUM(ARG(5), 0, ARG(5));
				M1_1:;
				COPY(ARG(4), ARG(6));
				Fzerop(ARG(6));
				if(CL_TRUEP(ARG(6)))
				{
					F1plus(ARG(3));
					COPY(ARG(2), ARG(6));
					COPY(ARG(2), ARG(7));
					LOAD_FIXNUM(ARG(8), 0, ARG(8));
					LOAD_NIL(ARG(9));
					COPY(ARG(3), ARG(10));
					COPY(ARG(1), ARG(11));
					replace1(ARG(6));
					COPY(ARG(2), ARG(0));
					COPY(ARG(3), ARG(2));
					Fminus(ARG(1), 2);
					shrink_simple_string(ARG(0));
					goto RETURN1;
				}
				LOAD_FIXNUM(ARG(6), 10, ARG(6));
				COPY(ARG(4), ARG(6));
				LOAD_FIXNUM(ARG(7), 10, ARG(7));
				rt_truncate(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(4));
						COPY(ARG(7), ARG(5));
					}
				}
				LOAD_SMSTR((CL_FORM *)&Kquick_integer_to_string[6], ARG(6));	/* 0123456789 */
				COPY(ARG(5), ARG(7));
				pvref(ARG(6));
				COPY(ARG(6), ARG(7));
				COPY(ARG(2), ARG(8));
				COPY(ARG(3), ARG(9));
				Fset_schar(ARG(7));
				F1minus(ARG(3));
				goto M1_1;
				RETURN1:;
			}
		}
	}
}
예제 #6
0
파일: print_float.c 프로젝트: hoelzl/Clicc
void print_float(CL_FORM *base)
{
	COPY(ARG(0), ARG(2));
	Fminusp(ARG(2));
	if(CL_TRUEP(ARG(2)))
	{
		LOAD_CHAR(ARG(2), '-', ARG(2));
		COPY(ARG(1), ARG(3));
		write_char1(ARG(2));
		mv_count = 1;
		COPY(ARG(0), ARG(2));
		Fminus(ARG(2), 1);
		COPY(ARG(2), ARG(0));
	}
	COPY(ARG(0), ARG(2));
	Fzerop(ARG(2));
	if(CL_TRUEP(ARG(2)))
	{
		LOAD_SMSTR((CL_FORM *)&Kprint_float[0], ARG(2));	/* 0.0 */
		COPY(ARG(2), ARG(3));
		COPY(ARG(1), ARG(4));
		LOAD_FIXNUM(ARG(5), 0, ARG(5));
		COPY(ARG(2), ARG(6));
		Flength(ARG(6));
		write_string1(ARG(3));
		COPY(ARG(3), ARG(0));
	}
	else
	{
		LOAD_FIXNUM(ARG(2), 10, ARG(2));
		COPY(ARG(0), ARG(2));
		LOAD_FIXNUM(ARG(3), 10, ARG(3));
		rt_log(ARG(2));
		LOAD_FIXNUM(ARG(3), 1, ARG(3));
		LOAD_FIXNUM(ARG(3), 1, ARG(3));
		rt_floor(ARG(2));
		mv_count = 1;
		COPY(ARG(0), ARG(3));
		GEN_FLOAT(ARG(4), 10.0, ARG(4));
		LOAD_FIXNUM(ARG(5), -1, ARG(5));
		COPY(ARG(2), ARG(6));
		Fminus(ARG(5), 2);
		COPY(ARG(5), ARG(6));
		Fminusp(ARG(6));
		if(CL_TRUEP(ARG(6)))
		{
			LOAD_FIXNUM(ARG(6), 1, ARG(6));
			COPY(ARG(4), ARG(7));
			COPY(ARG(5), ARG(8));
			Fminus(ARG(8), 1);
			Fexpt(ARG(7));
			Fdiv(ARG(6), 2);
			COPY(ARG(6), ARG(4));
		}
		else
		{
			rt_expt(ARG(4));
		}
		Fmult(ARG(3), 2);
		LOAD_NIL(ARG(4));
		COPY(SYMVAL(Slisp, 2), ARG(5));	/* SHORT-FLOAT-EPSILON */
		LOAD_NIL(ARG(6));
		COPY(ARG(3), ARG(7));
		LOAD_FIXNUM(ARG(8), 1, ARG(8));
		COPY(ARG(5), ARG(9));
		Fminus(ARG(8), 2);
		Fge(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			GEN_FLOAT(ARG(7), 0.1, ARG(3));
			F1plus(ARG(2));
		}
		COPY(ARG(2), ARG(7));
		LOAD_FIXNUM(ARG(8), 7, ARG(8));
		Fgt(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			goto THEN1;
		}
		else
		{
			COPY(ARG(2), ARG(8));
			LOAD_FIXNUM(ARG(9), -3, ARG(9));
			Flt(ARG(8), 2);
		}
		if(CL_TRUEP(ARG(8)))
		{
			THEN1:;
			LOAD_FIXNUM(ARG(7), 0, ARG(4));
		}
		else
		{
			COPY(ARG(2), ARG(4));
			LOAD_FIXNUM(ARG(7), 0, ARG(2));
		}
		COPY(ARG(4), ARG(7));
		Fminusp(ARG(7));
		if(CL_TRUEP(ARG(7)))
		{
			LOAD_CHAR(ARG(7), '0', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
			LOAD_CHAR(ARG(7), '.', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
			LOAD_FIXNUM(ARG(7), 0, ARG(7));
			M1_1:;
			COPY(ARG(7), ARG(8));
			COPY(ARG(4), ARG(9));
			Fminus(ARG(9), 1);
			F1minus(ARG(9));
			Fge(ARG(8), 2);
			if(CL_TRUEP(ARG(8)))
			{
				goto RETURN1;
			}
			LOAD_CHAR(ARG(8), '0', ARG(8));
			COPY(ARG(1), ARG(9));
			write_char1(ARG(8));
			mv_count = 1;
			F1plus(ARG(7));
			goto M1_1;
			RETURN1:;
			LOAD_FIXNUM(ARG(7), -1, ARG(4));
		}
		M2_1:;
		COPY(ARG(5), ARG(7));
		LOAD_FIXNUM(ARG(8), 10, ARG(8));
		Fmult(ARG(7), 2);
		COPY(ARG(7), ARG(5));
		LOAD_FIXNUM(ARG(7), 10, ARG(7));
		COPY(ARG(3), ARG(8));
		Fmult(ARG(7), 2);
		LOAD_FIXNUM(ARG(8), 1, ARG(8));
		LOAD_FIXNUM(ARG(8), 1, ARG(8));
		rt_truncate(ARG(7));
		COPY(&mv_buf[0], ARG(8));
		{
			int nargs;
			nargs = 2;
			mv_count = 1;
			{
				switch(nargs)
				{
					case 0:
					LOAD_NIL(ARG(7));
					case 1:
					LOAD_NIL(ARG(8));
					nargs = 2;
				}
				COPY(ARG(7), ARG(6));
				COPY(ARG(8), ARG(3));
			}
		}
		COPY(ARG(3), ARG(7));
		LOAD_FIXNUM(ARG(8), 1, ARG(8));
		COPY(ARG(5), ARG(9));
		Fminus(ARG(8), 2);
		Fge(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			goto THEN2;
		}
		else
		{
			COPY(ARG(3), ARG(8));
			COPY(ARG(5), ARG(9));
			Fle(ARG(8), 2);
		}
		if(CL_TRUEP(ARG(8)))
		{
			THEN2:;
			goto RETURN2;
		}
		COPY(ARG(6), ARG(7));
		LOAD_FIXNUM(ARG(8), 10, ARG(8));
		digit_char1(ARG(7));
		COPY(ARG(1), ARG(8));
		write_char1(ARG(7));
		mv_count = 1;
		COPY(ARG(4), ARG(7));
		Fzerop(ARG(7));
		if(CL_TRUEP(ARG(7)))
		{
			LOAD_CHAR(ARG(7), '.', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
		}
		F1minus(ARG(4));
		goto M2_1;
		RETURN2:;
		COPY(ARG(3), ARG(7));
		GEN_FLOAT(ARG(8), 0.5, ARG(8));
		Fge(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			F1plus(ARG(6));
		}
		COPY(ARG(6), ARG(7));
		LOAD_FIXNUM(ARG(8), 10, ARG(8));
		digit_char1(ARG(7));
		COPY(ARG(1), ARG(8));
		write_char1(ARG(7));
		mv_count = 1;
		COPY(ARG(4), ARG(7));
		LOAD_FIXNUM(ARG(8), 0, ARG(8));
		Fge(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			LOAD_FIXNUM(ARG(7), 0, ARG(7));
			M3_1:;
			COPY(ARG(7), ARG(8));
			COPY(ARG(4), ARG(9));
			Fge(ARG(8), 2);
			if(CL_TRUEP(ARG(8)))
			{
				goto RETURN3;
			}
			LOAD_CHAR(ARG(8), '0', ARG(8));
			COPY(ARG(1), ARG(9));
			write_char1(ARG(8));
			mv_count = 1;
			F1plus(ARG(7));
			goto M3_1;
			RETURN3:;
			LOAD_CHAR(ARG(7), '.', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
			LOAD_CHAR(ARG(7), '0', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
		}
		COPY(ARG(2), ARG(7));
		Fzerop(ARG(7));
		if(CL_TRUEP(ARG(7)))
		{
		}
		else
		{
			LOAD_CHAR(ARG(7), 'E', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
			COPY(ARG(2), ARG(7));
			COPY(ARG(1), ARG(8));
			print_integer(ARG(7));
			mv_count = 1;
		}
		LOAD_NIL(ARG(0));
	}
}