Exemplo n.º 1
0
void Fmake_string_output_stream(CL_FORM *base, int nargs)
{
	switch(nargs)
	{
		case 0:
		LOAD_SMALLFIXNUM(10, ARG(0));
		LOAD_SYMBOL(SYMBOL(Slisp, 99), ARG(1));	/* ELEMENT-TYPE */
		LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(2));	/* CHARACTER */
		LOAD_SYMBOL(SYMBOL(Slisp, 100), ARG(3));	/* ADJUSTABLE */
		LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(4));	/* T */
		LOAD_SYMBOL(SYMBOL(Slisp, 101), ARG(5));	/* FILL-POINTER */
		LOAD_SMALLFIXNUM(0, ARG(6));
		Fmake_array(ARG(0), 7);
		case 1:
		break;
		default:
		Labort(TOO_MANY_ARGS);
	}
	make_string_output_stream1(ARG(0));
}
Exemplo n.º 2
0
void gensym1(CL_FORM *base)
{
	if(CL_TRUEP(ARG(0)))
	{
		LOAD_FIXNUM(ARG(2), 0, ARG(2));
		if(CL_FIXNUMP(ARG(0)) && GET_FIXNUM(ARG(0)) >= GET_FIXNUM(ARG(2)))
		{
			COPY(ARG(0), SYMVAL(Slisp, 662));	/* *GENSYM-COUNTER* */
		}
		else
		{
			COPY(ARG(0), ARG(1));
			Fstringp(ARG(1));
			if(CL_TRUEP(ARG(1)))
			{
				COPY(ARG(0), SYMVAL(Slisp, 674));	/* *GENSYM-PREFIX* */
			}
			else
			{
				LOAD_SMSTR((CL_FORM *)&Kgensym1[0], ARG(1));	/* positive integer or string expected */
				Ferror(ARG(1), 1);
			}
		}
	}
	LOAD_SYMBOL(SYMBOL(Slisp, 44), ARG(1));	/* STRING */
	COPY(SYMVAL(Slisp, 674), ARG(2));	/* *GENSYM-PREFIX* */
	COPY(SYMVAL(Slisp, 662), ARG(3));	/* *GENSYM-COUNTER* */
	LOAD_FIXNUM(ARG(4), 10, ARG(4));
	LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(5));	/* CHARACTER */
	LOAD_NIL(ARG(6));
	LOAD_NIL(ARG(7));
	LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(8));	/* T */
	LOAD_FIXNUM(ARG(9), 0, ARG(9));
	LOAD_NIL(ARG(10));
	LOAD_FIXNUM(ARG(11), 0, ARG(11));
	LOAD_NIL(ARG(12));
	LOAD_NIL(ARG(13));
	LOAD_NIL(ARG(14));
	make_array1(ARG(4));
	make_string_output_stream1(ARG(4));
	COPY(ARG(3), ARG(5));
	COPY(ARG(4), ARG(6));
	prin11(ARG(5));
	COPY(ARG(4), ARG(5));
	LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(6));	/* STREAM */
	rt_struct_typep(ARG(5));
	if(CL_TRUEP(ARG(5)))
	{
		COPY(OFFSET(AR_BASE(GET_FORM(ARG(4))), 0 + 1), ARG(5));
	}
	else
	{
		COPY(SYMVAL(Slisp, 352), ARG(5));	/* NO_STRUCT */
		COPY(ARG(4), ARG(6));
		LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(7));	/* STREAM */
		Ferror(ARG(5), 3);
	}
	if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 102))	/* STRING-OUTPUT */
	{
	}
	else
	{
		LOAD_SMSTR((CL_FORM *)&KClisp[268], ARG(5));	/* string-output-stream expected */
		Ferror(ARG(5), 1);
	}
	COPY(ARG(4), ARG(5));
	COPY(ARG(5), ARG(6));
	COPY(ARG(6), ARG(7));
	LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(8));	/* STREAM */
	rt_struct_typep(ARG(7));
	if(CL_TRUEP(ARG(7)))
	{
		COPY(OFFSET(AR_BASE(GET_FORM(ARG(6))), 1 + 1), ARG(5));
	}
	else
	{
		COPY(SYMVAL(Slisp, 352), ARG(5));	/* NO_STRUCT */
		LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(7));	/* STREAM */
		Ferror(ARG(5), 3);
	}
	Ffuncall(ARG(5), 1);
	mv_count = 1;
	COPY(ARG(5), ARG(3));
	Fconcatenate(ARG(1), 3);
	Fmake_symbol(ARG(1));
	COPY(SYMVAL(Slisp, 662), ARG(2));	/* *GENSYM-COUNTER* */
	F1plus(ARG(2));
	COPY(ARG(2), SYMVAL(Slisp, 662));	/* *GENSYM-COUNTER* */
	COPY(ARG(1), ARG(0));
}
Exemplo n.º 3
0
void write_to_string1(CL_FORM *base)
{
	BIND_SPECIAL(SYMBOL(Slisp, 474), ARG(1));	/* *PRINT-ESCAPE* */
	BIND_SPECIAL(SYMBOL(Slisp, 479), ARG(2));	/* *PRINT-RADIX* */
	BIND_SPECIAL(SYMBOL(Slisp, 471), ARG(3));	/* *PRINT-BASE* */
	BIND_SPECIAL(SYMBOL(Slisp, 473), ARG(4));	/* *PRINT-CIRCLE* */
	BIND_SPECIAL(SYMBOL(Slisp, 478), ARG(5));	/* *PRINT-PRETTY* */
	BIND_SPECIAL(SYMBOL(Slisp, 477), ARG(6));	/* *PRINT-LEVEL* */
	BIND_SPECIAL(SYMBOL(Slisp, 476), ARG(7));	/* *PRINT-LENGTH* */
	BIND_SPECIAL(SYMBOL(Slisp, 472), ARG(8));	/* *PRINT-CASE* */
	BIND_SPECIAL(SYMBOL(Slisp, 475), ARG(9));	/* *PRINT-GENSYM* */
	BIND_SPECIAL(SYMBOL(Slisp, 470), ARG(10));	/* *PRINT-ARRAY* */
	LOAD_FIXNUM(ARG(11), 10, ARG(11));
	LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(12));	/* CHARACTER */
	LOAD_NIL(ARG(13));
	LOAD_NIL(ARG(14));
	LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(15));	/* T */
	LOAD_FIXNUM(ARG(16), 0, ARG(16));
	LOAD_NIL(ARG(17));
	LOAD_FIXNUM(ARG(18), 0, ARG(18));
	LOAD_NIL(ARG(19));
	LOAD_NIL(ARG(20));
	LOAD_NIL(ARG(21));
	make_array1(ARG(11));
	make_string_output_stream1(ARG(11));
	COPY(ARG(0), ARG(12));
	COPY(ARG(11), ARG(13));
	write2(ARG(12));
	COPY(ARG(11), ARG(12));
	LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(13));	/* STREAM */
	rt_struct_typep(ARG(12));
	if(CL_TRUEP(ARG(12)))
	{
		COPY(OFFSET(AR_BASE(GET_FORM(ARG(11))), 0 + 1), ARG(12));
	}
	else
	{
		COPY(SYMVAL(Slisp, 352), ARG(12));	/* NO_STRUCT */
		COPY(ARG(11), ARG(13));
		LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(14));	/* STREAM */
		Ferror(ARG(12), 3);
	}
	if(CL_SYMBOLP(ARG(12)) && GET_SYMBOL(ARG(12)) == SYMBOL(Slisp, 102))	/* STRING-OUTPUT */
	{
	}
	else
	{
		LOAD_SMSTR((CL_FORM *)&KClisp[268], ARG(12));	/* string-output-stream expected */
		Ferror(ARG(12), 1);
	}
	COPY(ARG(11), ARG(12));
	COPY(ARG(12), ARG(13));
	COPY(ARG(13), ARG(14));
	LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(15));	/* STREAM */
	rt_struct_typep(ARG(14));
	if(CL_TRUEP(ARG(14)))
	{
		COPY(OFFSET(AR_BASE(GET_FORM(ARG(13))), 1 + 1), ARG(12));
	}
	else
	{
		COPY(SYMVAL(Slisp, 352), ARG(12));	/* NO_STRUCT */
		LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(14));	/* STREAM */
		Ferror(ARG(12), 3);
	}
	Ffuncall(ARG(12), 1);
	COPY(ARG(12), ARG(0));
	RESTORE_SPECIAL;
	RESTORE_SPECIAL;
	RESTORE_SPECIAL;
	RESTORE_SPECIAL;
	RESTORE_SPECIAL;
	RESTORE_SPECIAL;
	RESTORE_SPECIAL;
	RESTORE_SPECIAL;
	RESTORE_SPECIAL;
	RESTORE_SPECIAL;
}