/*
 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
 * Copyright (C) ????-2008 - INRIA
 *
 * This file must be used under the terms of the CeCILL.
 * This source file is licensed as described in the file COPYING, which
 * you should have received as part of this distribution.  The terms
 * are also available at
 * http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
 *
 */

#include <stdlib.h>
#include "stackTypeVariable.h"
#include "intersci-n.h"

/*********************************************************************
 * Dealing with the set of variables
 *********************************************************************/

int ShowVariables()
{
    int i;
    VARPTR var;
    for (i = 0; i < nVariable; i++)
    {
        int j;
        var = variables[i];
        fprintf(stderr, "==============variable %d : name %s\n", i + 1, var->name);
        fprintf(stderr, "type %s<->%s\n", SGetSciType(var->type),
                SGetForType(var->for_type));
        fprintf(stderr, "elts : [");
        for (j = 0 ; j < var->length ; j++)
        {
            fprintf(stderr, "{var %d:%s}", var->el[j],
                    variables[var->el[j] - 1]->name);
        }
        fprintf(stderr, "]\n");
        /* fprintf(stderr," name of external function when type is  char *fexternal[MAXNAM];
        external
            */
        fprintf(stderr, " ?  equal %d\n", var->equal);
        fprintf(stderr, "for_names [");
        if ( var->nfor_name != 0)
        {
            for (j = 0 ; j < var->nfor_name ; j++)
            {
                fprintf(stderr, "{%s:%d}", var->for_name[j],
                        var->for_name_orig[j]);
                if ( j != var->nfor_name - 1)
                {
                    fprintf(stderr, ",");
                }
            }
        }
        fprintf(stderr, "]\n");
        fprintf(stderr, " position in a list %d\n", var->list_el);
        if ( var->list_el > 0 )
        {
            fprintf(stderr, " List name %s\n", var->list_name);
        }
        fprintf(stderr, " type of optional variable %d\n", var->opt_type);
        if ( var->opt_type != 0)
            fprintf(stderr, " name or value default for optional variable %s\n",
                    var->opt_name);
        fprintf(stderr, " 1 if the variable is really present %d\n", var->present);
        fprintf(stderr, "sciarg %d, rhs %d, lhs %d\n",
                var->is_sciarg,
                var->stack_position,
                var->out_position);
    }
    return 0;
}

/*******************************************************
 * this function recomputes the stack_positions
 * taking into account the fact that external
 * variables are not allocated on the stack.
 * We use the fact that after the readfunction
 * the stack_position increases when i increases  in variables[i]
 * CSTRINGV variables which are not given as arguments
 * must be treated the same way
 *******************************************************/

#define ISNONSTACK(var) ( (var)->for_type == EXTERNAL \
   || ( (var)->for_type == CSTRINGV && (var)->is_sciarg == 0  && (var)->list_el == 0 ))

int FixStackPositions()
{
    int i;
    VARPTR var, var1;
    for (i = nVariable - 1 ; i >= 0; i--)
    {
        int j;
        var = variables[i];
        if ( ISNONSTACK(var) )
        {
            icre--;
            for ( j = 0 ; j < nVariable ; j++ )
            {
                var1 = variables[j];
                if ( var1->stack_position > var->stack_position
                        && ! (ISNONSTACK(var1)))
                {
                    var1->stack_position--;
                }
            }
        }
    }
    return 0;
}

/********************************************************
 * return the variable number of variable name. if it does not already exist,
 *  it is created and "nVariable" is incremented
 * p corresponds to the present slot of var structure:
 *  - if the variable does not exist it is created with p value
 *  - if the variable exists it is created with (p or 0) value
 *********************************************************/


IVAR GetVar(name, p)
char *name;
int p;
{
    int i;
    VARPTR var;
    if (strcmp(name, "out") == 0)
    {
        printf("the name of a variable which is not the output variable\n");
        printf("  of SCILAB function cannot be \"out\"\n");
        exit(1);
    }
    for (i = 0; i < nVariable; i++)
    {
        var = variables[i];
        if (strcmp(var->name, name) == 0)
        {
            var->present = var->present || p;
            return(i + 1);
        }
    }
    if (nVariable == MAXVAR)
    {
        printf("too many variables\n");
        printf("  augment constant \"MAXVAR\" and recompile intersci\n");
        exit(1);
    }
    var = VarAlloc();
    if (var == 0)
    {
        printf("Running out of memory\n");
        exit(1);
    }
    var->name = (char *)malloc((unsigned)(strlen(name) + 1));
    strcpy(var->name, name);
    var->type = 0;
    var->length = 0;
    var->for_type = 0;
    var->equal = 0;
    var->nfor_name = 0;
    var->kp_state = -1;
    var->list_el = 0;
    var->opt_type = 0;
    var->present = p;
    var->out_position = 0;
    var->stack_position = 0;
    var->is_sciarg = 0;
    variables[nVariable++] = var;
    var->vpos = nVariable;
    return(nVariable);
}

/************************************************************************
 * return the variable number of variable name which must already  exist
 ***********************************************************************/

IVAR GetExistVar(name)
char *name;
{
    int i;
    VARPTR var;
    if (strcmp(name, "out") == 0)
    {
        printf("the name of a variable which is not the output variable\n");
        printf("  of SCILAB function cannot be \"out\"\n");
        exit(1);
    }
    for (i = 0; i < nVariable; i++)
    {
        var = variables[i];
        if (strcmp(var->name, name) == 0)
        {
            /* always present */
            var->present = 1;
            return(i + 1);
        }
    }
    i = CreatePredefVar(name);
    if ( i != -1)
    {
        return(i);
    }
    printf("variable \"%s\" must exist\n", name);
    exit(1);
}

/******************************************************************
 * fname,rhs,lhs,err are predefined variables
 * if someone want to add them in the Fortran or C Calling sequence
 * it's done without aby checks
 ******************************************************************/

int CreatePredefVar(name)
char *name;
{
    VARPTR var;
    if (strcmp(name, "err")  == 0
            || strcmp(name, "rhs") == 0
            || strcmp(name, "lhs") == 0
            || strcmp(name, "fname") == 0)
    {
        int num ;
        num = GetVar(name, 1);
        var = variables[num - 1];
        var->for_type = PREDEF;
        return(num);
    }
    return(-1);
}

/********************************************************
 * return the variable number of variable "out"
 * which is created and "nVariable" is incremented
 ********************************************************/

IVAR GetOutVar(name)
char *name;
{
    VARPTR var;
    if (strcmp(name, "out") != 0)
    {
        printf("the name of output variable of SCILAB function\n");
        printf("  must be \"out\"\n");
        exit(1);
    }
    if (nVariable == MAXVAR)
    {
        printf("too many variables\n");
        printf("  augmente constant \"MAXVAR\" and recompile intersci\n");
        exit(1);
    }
    var = VarAlloc();
    if (var == 0)
    {
        printf("Running out of memory\n");
        exit(1);
    }
    var->name = (char *)malloc((unsigned)(strlen(name) + 1));
    strcpy(var->name, name);
    var->type = 0;
    var->length = 0;
    var->for_type = 0;
    var->equal = 0;
    var->nfor_name = 0;
    var->kp_state = -1;
    var->list_el = 0;
    var->opt_type = 0;
    var->present = 0;
    var->out_position = 0;
    var->stack_position = 0;
    variables[nVariable++] = var;
    return(nVariable);
}

/* return the variable number of variable "out"
   which must exist */

IVAR GetExistOutVar()
{
    int i;
    char str[4];
    strcpy(str, "out");
    for (i = 0; i < nVariable; i++)
    {
        if (strcmp(variables[i]->name, str) == 0)
        {
            return(i + 1);
        }
    }
    printf("variable \"out\" must exist\n");
    exit(1);
}

/* return the variable number of variable "out" or 0 */

IVAR CheckOutVar()
{
    int i;
    char str[4];
    strcpy(str, "out");
    for (i = 0; i < nVariable; i++)
    {
        if (strcmp(variables[i]->name, str) == 0)
        {
            return(i + 1);
        }
    }
    return 0;
}




/************************************************
 * add name in the for_name array
 * field of variable ivar
 * and add the number ivar1 in the for_name_orig array
 * field (ivar1 is a stack position)
 * this is used for variables which code dimensions
 * if for_name contains [m1,n2,m3]
 * and for_name_orig contains [1,2,5]
 * this means that stack variables 1,2,5 must have
 * the same value for m1,n2,m3
 *************************************************/

void AddForName(ivar, name, cname, ivar1)
IVAR ivar;
IVAR ivar1;
char* name;
char* cname;
{
    VARPTR var;
    int l;
    var = variables[ivar - 1];
    l = var->nfor_name;
    if (l == MAXARG)
    {
        printf("too many \"for_name\" for variable \"%s\"\n", var->name);
        printf("  augment constant \"MAXARG\" and recompile intersci\n");
        exit(1);
    }
    var->for_name[l] = (char *)malloc((unsigned)(strlen(name) + 1));
    if ( cname != NULL)
    {
        var->C_name[l] = (char *)malloc((unsigned)(strlen(cname) + 1));
        strcpy(var->C_name[l], cname);
    }
    else
    {
        var->C_name[l] = NULL;
    }
    var->for_name_orig[l] = ivar1;
    strcpy(var->for_name[l], name);
    var->nfor_name = l + 1;
}

/***************************
 * add name in the for_name array
 * field of variable ivar
 * this names are not cleared between
 * the two passes
 ***************************/

void AddForName1(ivar, name, cname, ivar1)
IVAR ivar;
IVAR ivar1;
char* name;
char* cname;
{
    VARPTR var;
    int l;
    var = variables[ivar - 1];
    l = var->nfor_name;
    if ( pass == 0 && var->kp_state == -1 )
    {
        var->kp_state = var->nfor_name ;
    }
    if (l == MAXARG)
    {
        printf("too many \"for_name\" for variable \"%s\"\n", var->name);
        printf("  augment constant \"MAXARG\" and recompile intersci\n");
        exit(1);
    }
    var->for_name[l] = (char *)malloc((unsigned)(strlen(name) + 1));
    if ( cname != NULL)
    {
        var->C_name[l] = (char *)malloc((unsigned)(strlen(cname) + 1));
        strcpy(var->C_name[l], cname);
    }

    else
    {
        var->C_name[l] = NULL;
    }
    var->for_name_orig[l] = ivar1;
    strcpy(var->for_name[l], name);
    var->nfor_name = l + 1;
}


/********************************************************
 ** if kp_state is not -1 then kp_state is 0 and the for_names are cleaned
 *(in fact just forgotten the free call should be added
 ********************************************************/

void ForNameClean()
{
    VARPTR var;
    int i;
    for (i = 0; i < nVariable; i++)
    {
        var = variables[i];
        if ( var->kp_state != -1 )
        {
            var->nfor_name = var->kp_state ;
        }
    }
}

/***********************************************************
 * Changes the first for_name of variable number ivar to name
 * or add the forname if necessary.
 * if the forname is added, since we do not change the kp_state,
 * this value is kept between the two pass.
 ************************************************************/

#define FORNAME 128


#include <stdarg.h>

void ChangeForName2(VARPTR varptr, char * format , ...)
{
    char forbuf[FORNAME];
    va_list ap;
    va_start(ap, format);

    vsprintf(forbuf, format, ap);
    ChangeForName1(varptr, forbuf);
    va_end(ap);
}

void ChangeForName1(var, name)
VARPTR var;
char* name;
{
    int l, pos = 0;
    l = var->nfor_name;
    if ( l  != 0)
    {
        int i;
        for ( i = 0 ; i < l ; i++)
        {
            if ( var->for_name_orig[i] == var->stack_position )
            {
                pos = i ;
                break;
            }
        }
    }
    var->for_name[pos] = (char *)malloc((unsigned)(strlen(name) + 1));
    strcpy(var->for_name[pos], name);
    if ( pos != 0)
    {
        int xx;
        char *loc = var->for_name[pos];
        var->for_name[pos] =       var->for_name[0];
        var->for_name[0] = loc;
        xx = var->for_name_orig[pos];
        var->for_name_orig[pos] =       var->for_name_orig[0];
        var->for_name_orig[0] = xx;
    }
    /* we keep the C name  var->C_name[0] = NULL; */
    /** if l==0 a for_name **/
    if (l == 0)
    {
        var->nfor_name = 1;
    }
}

/***********************************************************
 * Function used to deal with types
 * conversion from code <-> to string
 ************************************************************/

/* Attention tableau en ordre alphabetique */

static struct btype
{
    char *sname ;
    int  code ;
}
SType[] =
{
    {"any",	ANY},
    {"bmatrix",    BMATRIX},
    {"bpointer",   SCIBPOINTER},
    {"column",	COLUMN},
    {"empty",	EMPTY},
    {"imatrix",    IMATRIX},
    {"list", 	LIST},
    {"lpointer",	SCILPOINTER},
    {"matrix",	MATRIX},
    {"mpointer",	SCIMPOINTER},
    {"opointer",	SCIOPOINTER},
    {"polynom",	POLYNOM},
    {"row",	ROW},
    {"scalar",	SCALAR},
    {"sequence",	SEQUENCE},
    {"smpointer",  SCISMPOINTER},
    {"sparse",    SPARSE},
    {"string",	STRING},
    {"stringmat",	STRINGMAT},
    {"tlist", 	TLIST},
    {"mlist", 	MLIST},
    {"vector",	VECTOR},
    {"work",	WORK},
    {(char *) 0 ,  -1}
};

/* Type Scilab:  renvoit un codage du type en nombre entier etant donne une chaine */

int GetBasType(sname)
char *sname;
{
    int i = 0;
    while ( SType[i].sname != (char *) NULL)
    {
        int j ;
        j = strcmp(sname, SType[i].sname);
        if ( j == 0 )
        {
            return(SType[i].code);
        }
        else
        {
            if ( j <= 0)
            {
                break;
            }
            else
            {
                i++;
            }
        }
    }
    printf("the type of variable \"%s\" is unknown\n", sname);
    exit(1);
}

/**********************************************
 * This function returns the string description of
 * a Scilab type given its code number
 **********************************************/

char *SGetSciType(type)
int type;
{
    int i = 0;
    while ( SType[i].code  != -1 )
    {
        if ( SType[i].code == type )
        {
            return(SType[i].sname);
        }
        else
        {
            i++;
        }
    }
    return("unknown");
}

/* Warning : Ftype is lexicographically sorted */

static struct ftype
{
    char *fname ; /* full fortran type name */
    int  code ; /* associated code */
    char *abrev; /* abbrev code : just for c d i r */
    char *st_name; /* stack to use :just for c d i r*/
    char *b_convert; /* converter for building lhs (for lists)*/
    int dec; /* declaration for the Fortran name */
    char *ctype; /* type in C */
}
FType[] =
{
    {"Cstringv", CSTRINGV, "XX", "XX", "XX", -1, "XX"},
    {"boolean", BOOLEAN, MATRIX_OF_BOOLEAN_DATATYPE, "istk", "icopy", DEC_INT, "int"},
    {"bpointer", BPOINTER, "XX", "XX", "XX", -1, "XX"},
    {"char", CHAR, STRING_DATATYPE, "cstk", "cvstr1", DEC_CHAR, "char"},
    {"double", DOUBLE, MATRIX_OF_DOUBLE_DATATYPE, "stk", "dcopy", DEC_DOUBLE, "double"},
    {"int", INT, MATRIX_OF_INTEGER_DATATYPE, "istk", "int2db", DEC_INT, "int"},
    {"integer", INT, MATRIX_OF_INTEGER_DATATYPE, "istk", "int2db", DEC_INT, "int"},
    {"lpointer", LPOINTER, "XX", "XX", "XX", -1, "XX"},
    {"mpointer", MPOINTER, "XX", "XX", "XX", -1, "XX"},
    {"opointer", OPOINTER, "XX", "XX", "XX", -1, "XX"},
    {"predef", PREDEF, "XX", "XX", "XX", -1, "XX"},
    {"real", REAL, MATRIX_OF_RATIONAL_DATATYPE, "sstk", "rea2db", DEC_REAL, "float"},
    {"smpointer", SMPOINTER, "XX", "XX", "XX", -1, "XX"},
    {(char *) 0 ,  -1}
};

/**********************************************
 * This function returns the code of a Fortran (or C) type
 * given its full name
 **********************************************/

int GetForType(type)
char *type;
{
    int i = 0;
    while ( FType[i].fname != (char *) NULL)
    {
        int j;
        j = strcmp(type, FType[i].fname);
        if ( j == 0 )
        {
            return(FType[i].code);
        }
        else
        {
            if ( j <= 0)
            {
                break;
            }
            else
            {
                i++;
            }
        }
    }
    return(EXTERNAL);
}

/**********************************************
 * This function returns the string description of
 * a C or Fortran type given its code number
 **********************************************/

char *SGetForType(type)
int type;
{
    int i = 0;
    while ( FType[i].code  != -1 )
    {
        if ( FType[i].code == type )
        {
            return(FType[i].fname);
        }
        else
        {
            i++;
        }
    }
    return("External");
}


/**********************************************
 * This function returns an abbrev string 'c' 'd' 'i' 'r' 'b'
 * of a C or Fortran type given its code number
 **********************************************/

char *SGetForTypeAbrev(var)
VARPTR var;
{
    int i = 0;
    while ( FType[i].code  != -1 )
    {
        if ( FType[i].code == var->for_type )
        {
            return(FType[i].abrev);
        }
        else
        {
            i++;
        }
    }
    return("XX");
}

/**********************************************
 * This function returns the code for declaration
 * of a C or Fortran type given its code number
 **********************************************/

int SGetForDec(type)
int type;
{
    int i = 0;
    while ( FType[i].code  != -1 )
    {
        if ( FType[i].code == type )
        {
            return(FType[i].dec);
        }
        else
        {
            i++;
        }
    }
    return(-1);
}

/**********************************************
 * This function returns the C string for declaration
 * of a C or Fortran type given its code number
 **********************************************/

char* SGetCDec(type)
int type;
{
    int i = 0;
    while ( FType[i].code  != -1 )
    {
        if ( FType[i].code == type )
        {
            return(FType[i].ctype);
        }
        else
        {
            i++;
        }
    }
    return("XXX");
}


/**********************************************
 * given a variable and according to its C or Fortran type,
 * this function returns the stack name to use
 **********************************************/

char *SGetForTypeStack(var)
VARPTR var;
{
    int i = 0;
    while ( FType[i].code  != -1 )
    {
        if ( FType[i].code == var->for_type )
        {
            if ( FType[i].st_name[0] == 'X' )
            {
                printf("incompatibility between Scilab and Fortran type for variable \"%s\"\n",
                       var->name);
                exit(1);
            }
            return(FType[i].st_name);
        }
        else
        {
            i++;
        }
    }
    printf("Unknown Fortran type for variable \"%s\"\n", var->name);
    exit(1);
}




/**********************************************
 * given a variable and according to its C or Fortran type,
 * this function returns the name of the converter to use
 * for back conversion
 **********************************************/

char *SGetForTypeBConvert(var)
VARPTR var;
{
    int i = 0;
    while ( FType[i].code  != -1 )
    {
        if ( FType[i].code == var->for_type )
        {
            if ( FType[i].b_convert[0] == 'X' )
            {
                printf("incompatibility between Scilab and Fortran type for variable \"%s\"\n",
                       var->name);
                exit(1);
            }
            return(FType[i].b_convert);
        }
        else
        {
            i++;
        }
    }
    printf("Unknown Fortran type for variable \"%s\"\n", var->name);
    exit(1);
}



/**********************************************
 * This function returns an abbrev string 'c' 'd' 'i' 'r' 'b'
 * of a C or Fortran type to use for back converting
 * an external variable
 * XXXXX : only for MATRIX et BMATRIX
 **********************************************/

char *SGetExtForTypeAbrev(var)
VARPTR var;
{
    if ( var->type == BMATRIX )
    {
        return MATRIX_OF_DOUBLE_DATATYPE;
    }
    else
    {
        if ( strcmp(var->fexternal, "cintf") == 0)
        {
            return MATRIX_OF_INTEGER_DATATYPE;
        }
        else
        {
            return MATRIX_OF_DOUBLE_DATATYPE;
        }
    }
}


/**********************************************
 * given a variable and according to its C or Fortran type,
 * this function returns the stack name to use
 * for back conversion of external
 * XXXXX : idem
 **********************************************/

char *SGetExtForTypeStack(var)
VARPTR var;
{
    if ( var->type == BMATRIX )
    {
        return(FType[1].st_name);
    }
    else
    {
        return(FType[4].st_name);
    }
}

