#include <math.h>
#include "../common/lelisp.h"

int
tlno () {
	return 0;
}

int 
tlfix (x) int x; {
	return x + x;
}

int
tlfloat (x) double x; {
	return x + x;
}

int
tlstring (x) char *x; {
	if (*x) *x = 'C';
	return strlen(x);
}

int
tlvector (x, l) int x[], l; {
	if (l >= 3) x[2] = x[1];
	return x[0];
}

int
tlt (x) char **x; {
	return (int) *x;
}

int
tlexternal (x) char **x; {
	return (int) *x;
}

/* Verify that functions with many arguments pass the right values
   in the right order */
int
tlnadic (a,b,c,d,e,f,g,h,i,j,k) int a, b, c, d, e, f, g, h, i, j, k; {
	if (k >= a)
		return(a+b+c+d+e+f+g+h+i+j+k);
	else
		return(-1);
}
/* Verification du nbre maxi d'arguments */
tnbmaxi (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa,ab,ac,ad,ae,af)
int a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa,ab,ac,ad,ae,af;
{
	return af;
}
tnbmaxf (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa,ab,ac,ad,ae,af)
double a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa,ab,ac,ad,ae,af;
{
	return (int)af;
}
tnbmaxri(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa,ab,ac,ad,ae,af)
int a[],b[],c[],d[],e[],f[],g[],h[],i[],j[],k[],l[],m[],n[],o[],p[],q[];
int r[],s[],t[],u[],v[],w[],x[],y[],z[],aa[],ab[],ac[],ad[],ae[],af[];
{
	return af[0];
}
tnbmaxrf(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa,ab,ac,ad,ae,af)
double *a,*b,*c,*d,*e,*f,*g,*h,*i,*j,*k,*l,*m,*n,*o,*p,*q;
double *r,*s,*t,*u,*v,*w,*x,*y,*z,*aa,*ab,*ac,*ad,*ae,*af;
{
	return (int)af[0];
}

double
tcfloat (x) int x; {
	return x + x;
}

double
tcfloat2 (x, y) double x, y; {
	return (x * y) + (sin(x) * cos(y));
}

float single_float=2.3;
double f_s_to_d () {
       return (single_float);
}


static char *chaines[] = {"a", "ab", "abc", "abcd", ""};

char *
tcstring (x) int x; {
	if ((x >= 0) && (x < 5))
		return chaines[x];
        else
		return "abcdefghijklmnopqrstuvwxyz";
}

char **
tct (x) int x; {
	return (char **) x;
}

char **
tcexternal (x) int x; {
	return (char **) x;
}

/* pour affecter une structure GLOBALE de C et la recuperer en lisp */
struct sfoo {
  int a;
  float b;
  char *c;
};

struct sfoo *struct_un (x,y,z)
int x; float y; char *z; {
  struct sfoo foo;
  foo.a = x;
  foo.b = y;
  foo.c = z;
  return &foo;
}

int
tltout (i, f, s, v, l) int i, l; double f; char *s, **v; {
	return (i * ((int) f) * strlen(s) * ((int) v[0])) + l;
}

char *
tlmalloc (x) int x; {
	return (char *) malloc (x);
}

/* les fonctions qui testent le lispcaller */

struct LL_CONS *
cons_en_c (a, b) LL_OBJECT a, b; {
	struct LL_SYMBOL *lisp_cons;

	lisp_cons = getsym("cons");

	pusharg(LLT_T, a);
	pusharg(LLT_T, b);

	return (struct LL_CONS *) lispcall(LLT_T, 2, lisp_cons);
}

#define NOSYMB (struct LL_SYMBOL *) 0

struct LL_SYMBOL *lisp_list = NOSYMB;

struct LL_CONS *
vect_to_list (v, l) int v[], l; {
	int i;

	if (lisp_list == NOSYMB) lisp_list = getsym ("list");

	for (i = 0; i < l; i++) pusharg(LLT_T, v[i]);

	return (struct LL_CONS *) lispcall(LLT_T, l, lisp_list);
}


struct LL_SYMBOL *lisp_fib;

init_fib(){
	lisp_fib = getsym("fib");
	return 0;
}

int
fib (n) int n; {
    int x;
	if (n == 1) return 1;
	if (n == 2) return 1;

	pusharg(LLT_FIX, n-1);
	x = (int) lispcall (LLT_FIX, 1, lisp_fib);

	pusharg(LLT_FIX, n-2);

	return x + (int) lispcall (LLT_FIX, 1, lisp_fib);
}

char *tlcfloat() {
     pusharg(LLT_FLOAT, 1.2);
     return (char *)(lispcall(LLT_T, 1, getsym("identity")));
}

int tpastring () {
	pusharg(LLT_FIX, 0);
	pusharg(LLT_STRING, "Cat");
	return (int) (lispcall(LLT_T, 2, getsym("chrnth")));
}

char * tlcstring () {
    	pusharg(LLT_T, getsym("concat"));
	return (char *) (lispcall(LLT_STRING, 1,getsym("string")));
}	

/* Pour tester les entiers et flottants par reference */
/* les fix sont sur 32 bits et les float sur 64bits */
int trfix (rfix)
int *rfix;
{
	int a;
	a=rfix[0];
	return a+a;
}

double trfloat (rfloat)
double *rfloat;
{
	double a;
	a=rfloat[0];
	return a*a;
}

double trfixrfloat (fix, flt)
int *fix;
double *flt;
{
	return (double)(flt[0] + fix[0]);
}

/* Pour tester les vecteur d'entiers & flottants, avec modifications
 du tableau re-comprises par Lisp */
int ttabint (size, tabi)
int size;
int tabi[];
{
	int i;
	for (i=0; i<size; i++)
		tabi[i] = tabi[i] * 2;
        return size;
}

int ttabflt (size, tabf)
int size;
float tabf[];
{
	int i;
	for (i=0; i<size; i++)
		tabf[i] = tabf[i] * tabf[i];
        return size;
}

/* Pour tester les tableaux melanges avec
   d'autres parametres (teste le CALLG)*/
int ttabother (i1, siz1, tab1, flt1, flt2, i2, tab2, tab3, siz3, siz2)
int i1,i2,siz1,siz2,siz3;
int tab1[], tab3[];
double flt1, flt2;
float tab2[];
{
	int j,a;
	for (j=0; j<siz1; j++) {
		a=tab1[j];
		tab1[j]=tab3[j]+i1;
	        tab3[j]=a+i2;
	}
	for (j=0; j<siz2; j++)
		tab2[j]=tab2[j] + flt1 * flt2;
        return siz2;
}