Example #1
0
double *gh_scm2doubles(repv vector, double *result)
{
    int len = gh_length (vector), i;

    if (len == 0)
	return result;

    if (result == NULL)
	result = malloc (len * sizeof (result[0]));

    for (i = 0; i < len; i++)
	result[i] = rep_get_float (Felt (vector, rep_MAKE_INT (i)));

    return result;
}
Example #2
0
short *gh_scm2shorts(repv vector, short *result)
{
    int len = gh_length (vector), i;

    if (len == 0)
	return result;

    if (result == NULL)
	result = malloc (len * sizeof (result[0]));

    for (i = 0; i < len; i++)
	result[i] = rep_get_long_int (Felt (vector, rep_MAKE_INT (i)));

    return result;
}
Example #3
0
char *gh_scm2chars(repv vector, char *result)
{
    int len = gh_length (vector), i;

    if (len == 0)
	return result;

    if (result == NULL)
	result = malloc (len * sizeof (result[0]));

    for (i = 0; i < len; i++)
	result[i] = gh_scm2char (Felt (vector, rep_MAKE_INT (i)));

    return result;
}
Example #4
0
File: Fmap.c Project: hoelzl/Clicc
static void Z146_get_elem(CL_FORM *base)
{
	if(CL_CONSP(ARG(1)))
	{
		COPY(GET_CAR(ARG(1)), ARG(2));
	}
	else
	{
		if(CL_TRUEP(ARG(1)))
		{
			LOAD_SMSTR((CL_FORM *)&KClisp[264], ARG(2));	/* ~a is not a list */
			COPY(ARG(1), ARG(3));
			Ferror(ARG(2), 2);
		}
		else
		{
			COPY(ARG(1), ARG(2));
		}
	}
	if(CL_LISTP(ARG(2)))
	{
		if(CL_CONSP(ARG(1)))
		{
			COPY(GET_CAR(ARG(1)), ARG(2));
		}
		else
		{
			if(CL_TRUEP(ARG(1)))
			{
				LOAD_SMSTR((CL_FORM *)&KClisp[264], ARG(2));	/* ~a is not a list */
				COPY(ARG(1), ARG(3));
				Ferror(ARG(2), 2);
			}
			else
			{
				COPY(ARG(1), ARG(2));
			}
		}
		if(CL_CONSP(ARG(2)))
		{
			COPY(GET_CAR(ARG(2)), ARG(3));
		}
		else
		{
			if(CL_TRUEP(ARG(2)))
			{
				LOAD_SMSTR((CL_FORM *)&KClisp[264], ARG(3));	/* ~a is not a list */
				COPY(ARG(2), ARG(4));
				Ferror(ARG(3), 2);
			}
			else
			{
				COPY(ARG(2), ARG(3));
			}
		}
		COPY(ARG(2), ARG(4));
		COPY(ARG(4), ARG(5));
		if(CL_CONSP(ARG(5)))
		{
			COPY(GET_CDR(ARG(5)), ARG(2));
		}
		else
		{
			if(CL_TRUEP(ARG(5)))
			{
				LOAD_SMSTR((CL_FORM *)&KClisp[262], ARG(6));	/* ~a is not a list */
				COPY(ARG(5), ARG(7));
				Ferror(ARG(6), 2);
			}
			else
			{
				COPY(ARG(5), ARG(2));
			}
		}
		if(CL_CONSP(ARG(1)))
		{
			COPY(ARG(2), GET_CAR(ARG(1)));
		}
		else
		{
			LOAD_SMSTR((CL_FORM *)&KClisp[252], ARG(4));	/* ~a is not a cons */
			COPY(ARG(1), ARG(5));
			Ferror(ARG(4), 2);
		}
		COPY(ARG(3), ARG(0));
	}
	else
	{
		if(CL_CONSP(ARG(1)))
		{
			COPY(GET_CAR(ARG(1)), ARG(2));
		}
		else
		{
			if(CL_TRUEP(ARG(1)))
			{
				LOAD_SMSTR((CL_FORM *)&KClisp[264], ARG(2));	/* ~a is not a list */
				COPY(ARG(1), ARG(3));
				Ferror(ARG(2), 2);
			}
			else
			{
				COPY(ARG(1), ARG(2));
			}
		}
		COPY(INDIRECT(GET_FORM(ARG(0)) + 3), ARG(3));
		Felt(ARG(2));
		COPY(ARG(2), ARG(0));
	}
}
Example #5
0
void quick_sort(CL_FORM *base)
{
    LOAD_FIXNUM(ARG(5), 0, ARG(5));
    LOAD_FIXNUM(ARG(6), 0, ARG(6));
    COPY(ARG(2), ARG(7));
    COPY(ARG(1), ARG(8));
    F1plus(ARG(8));
    Fle(ARG(7), 2);
    if(CL_TRUEP(ARG(7)))
    {
        goto RETURN1;
    }
    COPY(ARG(1), ARG(5));
    COPY(ARG(2), ARG(6));
    F1minus(ARG(6));
    COPY(ARG(0), ARG(7));
    COPY(ARG(1), ARG(8));
    Felt(ARG(7));
M1_1:
    ;
    COPY(ARG(5), ARG(8));
    COPY(ARG(6), ARG(9));
    Fgt(ARG(8), 2);
    if(CL_TRUEP(ARG(8)))
    {
        goto RETURN2;
    }
M2_1:
    ;
    COPY(ARG(5), ARG(8));
    COPY(ARG(6), ARG(9));
    Fgt(ARG(8), 2);
    if(CL_TRUEP(ARG(8)))
    {
        goto THEN1;
    }
    else
    {
        COPY(ARG(3), ARG(9));
        COPY(ARG(4), ARG(10));
        COPY(ARG(0), ARG(11));
        COPY(ARG(6), ARG(12));
        Felt(ARG(11));
        Ffuncall(ARG(10), 2);
        mv_count = 1;
        COPY(ARG(4), ARG(11));
        COPY(ARG(7), ARG(12));
        Ffuncall(ARG(11), 2);
        mv_count = 1;
        Ffuncall(ARG(9), 3);
        mv_count = 1;
    }
    if(CL_TRUEP(ARG(9)))
    {
THEN1:
        ;
        goto RETURN3;
    }
    F1minus(ARG(6));
    goto M2_1;
RETURN3:
    ;
    COPY(ARG(6), ARG(8));
    COPY(ARG(1), ARG(9));
    Flt(ARG(8), 2);
    if(CL_TRUEP(ARG(8)))
    {
        COPY(ARG(0), ARG(8));
        COPY(ARG(1), ARG(9));
        F1plus(ARG(9));
        COPY(ARG(2), ARG(10));
        COPY(ARG(3), ARG(11));
        COPY(ARG(4), ARG(12));
        quick_sort(ARG(8));
        goto RETURN1;
    }
M3_1:
    ;
    COPY(ARG(5), ARG(8));
    COPY(ARG(6), ARG(9));
    Fgt(ARG(8), 2);
    if(CL_TRUEP(ARG(8)))
    {
        goto THEN2;
    }
    else
    {
        COPY(ARG(3), ARG(9));
        COPY(ARG(4), ARG(10));
        COPY(ARG(0), ARG(11));
        COPY(ARG(5), ARG(12));
        Felt(ARG(11));
        Ffuncall(ARG(10), 2);
        mv_count = 1;
        COPY(ARG(4), ARG(11));
        COPY(ARG(7), ARG(12));
        Ffuncall(ARG(11), 2);
        mv_count = 1;
        Ffuncall(ARG(9), 3);
        mv_count = 1;
        if(CL_TRUEP(ARG(9)))
        {
            goto ELSE3;
        }
        else
        {
            goto THEN2;
        }
    }
    {
THEN2:
        ;
        goto RETURN4;
    }
ELSE3:
    ;
    F1plus(ARG(5));
    goto M3_1;
RETURN4:
    ;
    COPY(ARG(5), ARG(8));
    COPY(ARG(6), ARG(9));
    Fgt(ARG(8), 2);
    if(CL_TRUEP(ARG(8)))
    {
        goto RETURN2;
    }
    COPY(ARG(0), ARG(8));
    COPY(ARG(5), ARG(9));
    Felt(ARG(8));
    COPY(ARG(0), ARG(9));
    COPY(ARG(6), ARG(10));
    Felt(ARG(9));
    COPY(ARG(0), ARG(10));
    COPY(ARG(5), ARG(11));
    Fset_elt(ARG(9));
    COPY(ARG(8), ARG(9));
    COPY(ARG(0), ARG(10));
    COPY(ARG(6), ARG(11));
    Fset_elt(ARG(9));
    F1plus(ARG(5));
    F1minus(ARG(6));
    goto M1_1;
RETURN2:
    ;
    COPY(ARG(0), ARG(7));
    COPY(ARG(1), ARG(8));
    COPY(ARG(5), ARG(9));
    COPY(ARG(3), ARG(10));
    COPY(ARG(4), ARG(11));
    quick_sort(ARG(7));
    COPY(ARG(0), ARG(7));
    COPY(ARG(5), ARG(8));
    COPY(ARG(2), ARG(9));
    COPY(ARG(3), ARG(10));
    COPY(ARG(4), ARG(11));
    quick_sort(ARG(7));
RETURN1:
    ;
}
Example #6
0
void concatenate_to_list(CL_FORM *base, int nargs)
{
	CL_FORM *rest_0;
	CL_FORM *local;
	rest_0 = ARG(0);
	local = ARG(nargs);
	{
		LOAD_NIL(LOCAL(0));
		LOAD_NIL(LOCAL(1));
		ALLOC_CONS(LOCAL(2), LOCAL(0), LOCAL(1), LOCAL(0));
		{
			CL_FORM *rest_1;
			LOAD_NIL(LOCAL(1));
			rest_1 = rest_0;
			M1_1:;
			if(NOT(REST_NOT_EMPTY(rest_1)))
			{
				LOAD_NIL(LOCAL(1));
				goto RETURN1;
			}
			{
				CL_FORM *rest_2;
				rest_2 = rest_1;
				REST_CAR(rest_2, LOCAL(1));
			}
			if(CL_LISTP(LOCAL(1)))
			{
				LOAD_NIL(LOCAL(2));
				COPY(LOCAL(1), LOCAL(3));
				M2_1:;
				if(CL_ATOMP(LOCAL(3)))
				{
					LOAD_NIL(LOCAL(2));
					goto RETURN2;
				}
				{
					COPY(LOCAL(3), LOCAL(4));
					COPY(GET_CAR(LOCAL(4)), LOCAL(2));
				}
				COPY(LOCAL(2), LOCAL(4));
				COPY(LOCAL(0), LOCAL(5));
				add_q(LOCAL(4));
				{
					COPY(LOCAL(3), LOCAL(4));
					COPY(GET_CDR(LOCAL(4)), LOCAL(3));
				}
				goto M2_1;
				RETURN2:;
			}
			else
			{
				LOAD_FIXNUM(LOCAL(2), 0, LOCAL(2));
				M3_1:;
				COPY(LOCAL(2), LOCAL(3));
				COPY(LOCAL(1), LOCAL(4));
				Flength(LOCAL(4));
				Fge(LOCAL(3), 2);
				if(CL_TRUEP(LOCAL(3)))
				{
					goto RETURN3;
				}
				COPY(LOCAL(1), LOCAL(3));
				COPY(LOCAL(2), LOCAL(4));
				Felt(LOCAL(3));
				COPY(LOCAL(0), LOCAL(4));
				add_q(LOCAL(3));
				F1plus(LOCAL(2));
				goto M3_1;
				RETURN3:;
			}
			{
				CL_FORM *rest_3;
				rest_3 = rest_1;
				rest_1 = REST_CDR(rest_3);
			}
			goto M1_1;
		}
		RETURN1:;
		COPY(GET_CAR(LOCAL(0)), ARG(0));
	}
}
Example #7
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));
}
Example #8
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));
}