#include "m.h"
#include "init.h"
#include "matlab.h"

/*
 * keywords must be installed first, then procs, then fns, then cmds
 *  so symbol table will contain:
 *
 *  head -> VAR's, PROCEDURE's, FUNCTION's ... CMD's, FN's, PROC's, keywords
 */

static Symbolptr head = NULL;
Symbolptr cmd_head = NULL;

void init( void)
{
    Symbolptr s;

    m_init();

    cmd_head = head = s = init_symlist;

    while( s->name != NULL) {	/* fix next pointers in init_symlist array, */
				/*  so it becomes a linked-list */
	s->next = s + 1;
	++s;
    }

    --s;
    s->next = NULL;
}

Symbolptr lookup( char *name)	/* find name in symbol table */
{
    Symbolptr p;

    for( p = head;  p != NULL;  p = p->next)
	if( p->name && strcmp( p->name, name) == 0)
	    return p;

    return NULL; /* not found */
}

Symbolptr install( char * name, int type, int class, int rows, int cols) 
{
    Symbolptr sp;				/* install symbol entry */

#ifdef NEWSTUFF
/*
 * if it's a NUMBER, and we can find another number with the same class
 * and value already in the symbol table, just return a pointer to the
 * existing symbol.  Only problem is, we don't have the value here...
 * Would have to change install() to take a value argument.
 *
 * I think the class has to be DEFN or LOOP.  With class == CONST,
 * the storage can get reassigned to a variable.  Both CONST and LOOP
 * get wiped out during cleanup.
 */
    if( name == NULL  &&  type == NUMBER  &&  (sp = num_find( class)) != NULL)
	return sp;
#endif

    if( (sp = new()) == NULL)
	error("new() failed in install()","");

    if( name) {
	if( (sp->name = strdup(name)) == NULL)
	    error("strdup() failed in install()","");
    } else
	sp->name = NULL;

    sp->type = type;
    sp->class = class;
    sp->rows = rows;
    sp->cols = cols;
    sp->u.ptr = NULL;
    sp->next = head;
    head = sp;
    return sp;
}

void who( void)	/* list user VAR's, PROCEDURE's, FUNCTION's */
{
    Symbolptr p;
    int n;

    dprint("VARS:   ");

    for( n = 1, p = head;  p->type != CMD;  p = p->next)
	if( p->name &&
	    (p->type == NUMBER || p->type == STRING || p->type == MATRIX)) {
		dprint(" %-7s", p->name);
		if( ++n > 8) {
		    n = 1;
		    dprint("\n        ");
		}
	}

    dprint("\nFUNS:   ");

    for( n = 1, p = head;  p->type != CMD;  p = p->next)
	if( p->name && p->type == FUNCTION) {
	    dprint(" %-7s", p->name);
	    if( ++n > 8) {
		n = 1;
		dprint("\n        ");
	    }
	}

    dprint("\nPROCS:  ");

    for( n = 1, p = head;  p->type != CMD;  p = p->next)
	if( p->name && p->type == PROCEDURE) {
	    dprint(" %-7s", p->name);
	    if( ++n > 8) {
		n = 1;
		dprint("\n        ");
	    }
	}

    dprint("\n");
}

void what( void)	/* list system FN's, PROC's */
{
    Symbolptr p;
    int n;
    static Symbolptr start = NULL;	/* first CMD */

    if( !start)
	for( start = head; start->type != CMD; start = start->next)
	    ;

    dprint("CMDS:   ");

    for( n = 1, p = start;  p->type == CMD;  p = p->next) {
	dprint(" %-7s", p->name);
	if( ++n > 8 && p->next->type == CMD) {
	    n = 1;
	    dprint("\n        ");
	}
    }

    dprint("\nFUNS:   ");

    for( n = 1;  p->type == FN;  p = p->next) {
	dprint(" %-7s", p->name);
	if( ++n > 8) {
	    n = 1;
	    dprint("\n        ");
	}
    }

    dprint("\nPROCS:  ");

    for( n = 1;  p->type == PROC;  p = p->next) {
	dprint(" %-7s", p->name);
	if( ++n > 8) {
	    n = 1;
	    dprint("\n        ");
	}
    }

    dprint("\n");
}

void display( Symbolptr p, char *msg)
{
    if( !p) {
	dprint("%s NULL\n", msg);
	return;
    }

    dprint("%s%s %s, %s ", msg,NAME(p),str_type(p->type),str_class(p->class));

    switch( p->type) {
	case NUMBER: dprint("= %g", VAL(p)); break;
	case STRING: dprint("@ %p = \"%s\", rows = %d, cols = %d",
			STR(p),STR(p),ROWS(p),COLS(p)); break;
	case MATRIX: dprint("@ %p, rows = %d, cols = %d",
			MAT(p),ROWS(p),COLS(p)); break;
	case PROCEDURE:
	case FUNCTION: dprint("@ %p, narg = %d, size = %d",
			p->u.fptr, NARG(p), SIZE(p)); break;
    }
    dprint("\n");
}

void dump( void)	/* dump symbol table */
{
    Symbolptr p;

    for( p = head;  p->type != CMD;  p = p->next)
	display( p, "");
}

void clear( Symbolptr p)
{
    switch( p->type) {

	case NUMBER:	VAL(p) = 0.0;
			break;

	case MATRIX:	matfree( MAT(p));
			MAT(p) = NULL;
			break;

	case STRING:	free( STR(p));
			STR(p) = NULL;
			break;

	case FUNCTION:
	case PROCEDURE: if( p->u.fptr)
			    free(i2d(*p->u.fptr)); /* defn */
			free( p->u.fptr);
			p->u.fptr = NULL;
			break;

	default:	return;
    }

    p->type = UNDEF;
    p->class = NEW;
    ROWS(p) = COLS(p) = 0;
}

static Symbolptr delete( Symbolptr p2)
{
    Symbolptr p;

    if( p2->name)
	free(p2->name);
    p2->name = NULL;
    clear(p2);

    p = p2->next;
    dispose(p2);
    return p;
}

static int useless( Symbolptr p, int all)
{
  if( p->class == CONST || (all && (p->class == LOOP || p->class == AUTO)))
    return 1;
  else
    return 0;
}

void cleanup( int all)	/* clear CONST entries */
			/* if all != 0, also clear LOOP and AUTO entries */
{
    Symbolptr p1, p2;
    static int count = 0;	/* counter for cleanup(0) */

    if( !all && ++count < CLEAN.u.val)
	return;
    else
	count = 0;

    while( head->type != CMD && useless( head, all) )
	head = delete(head);

    p1 = head;
    p2 = head->next;

    while( p2->type != CMD)
	if( useless( p2, all) )
	    p1->next = p2 = delete(p2);
	else {
	    p1 = p2;
	    p2 = p2->next;
	}
}

void clear_all( void)	/* remove all variables, FUNCTIONS, and PROCEDURES */
{
    while( head->type != CMD)
	head = delete(head);
}

void save( FILE *fout, Symbolptr a, int binary)
{
    int i, j;

#ifdef DEBUG
    if( prog_debug &&
	(a->type == STRING || a->type == NUMBER || a->type == MATRIX ||
	 a->type == FUNCTION || a->type == PROCEDURE) )
	    dprint("save: saving %s\n", a->name);
#endif

    if( binary) {

	Matlab_header h;

	switch( a->type) {

	case MATRIX: case NUMBER:

#ifdef MSDOS
		h.type = 100;
#else
		h.type = 1100;		/* Sparc */
#endif
		h.rows = ROWS(a);
		h.cols = COLS(a);
		h.imag = 0;
		h.namelen = strlen( a->name) + 1;

		if( fwrite( &h, sizeof(h), 1, fout) != 1  ||
		 fwrite( a->name, sizeof(char), h.namelen, fout) != h.namelen) {
		    perror( "write");
		    error( "fwrite() failed in save", "");
		}

		for( i = 0; i < ROWS(a); i++)
		  if( fwrite( a->type == MATRIX ? MAT(a)[i] : &VAL(a),
			sizeof(double), COLS(a), fout) != COLS(a) ) {
		    perror( "write");
		    error( "fwrite() failed in save, writing ", a->name);
		  }

		break;

	default:	dprint( "can't write %s, type = %s\n",
				a->name, str_type( a->type) );
			break;
    }

    } else switch( a->type) {

	case STRING: fprintf( fout, "%s = \"%s\"\n", a->name, STR(a));
		     break;

	case NUMBER: fprintf( fout, "%s = %26.18e\n", a->name, VAL(a));
		     break;

	case MATRIX:	fprintf( fout, "%s = [", a->name);
			for( i = 0; i < ROWS(a); i++) {
			    for( j = 0; j < COLS(a); j++) {
				fprintf( fout, " %26.18e", A(i,j));
				if( j % 4 == 3)
				    fprintf( fout, "\\\n");
			    }
			    putc( i == ROWS(a)-1 ? ']' : '\n', fout);
			}
			putc( '\n', fout);
			break;
	case FUNCTION:
	case PROCEDURE: if( *a->u.fptr)
			    fprintf( fout, "%s", (char *) i2d(*a->u.fptr));
			break;
	default:	dprint( "can't write %s, type = %s\n",
				a->name, str_type( a->type) );
			break;
    }
}

void save_all( FILE *fout, int binary)
{
    Symbolptr a;

    for( a = head;  a->type != CMD;  a = a->next)
	if( a->name  &&  a->type != UNDEF)
	    save( fout, a, binary);
}

void readfile( char *fname)
{
    FILE *fp;
    Matlab_header h;
    Symbolptr a;
    char name[BUFSIZ];
    int num;

    if( (fp = fopen( fname, "rb")) == NULL) {
	perror( fname);
	error( "readfile() can't open ", fname);
    }

    while( fread( &h, sizeof(h), 1, fp) == 1) {

#ifdef MSDOS
	if( h.type != 100  &&  h.type  != 0)
#else
	if( h.type != 1100  &&  h.type  != 1000)
#endif
	{
	    fclose( fp);
	    error( "readfile() got bad type code","");
	}

	if( fread( &name, sizeof(char), h.namelen, fp) != h.namelen) {
	    fclose( fp);
	    perror( fname);
	    error( "readfile() can't read matrix name", "");
	}

	if( (a = lookup(name)) == NULL) {
	    a = m_create( h.rows, h.cols);
	    if( (a->name = strdup( name)) == NULL) {
		fclose( fp);
		error( "strdup() failed in readfile() on ", name);
	    }
	} else {
	    a = m_new( a, h.rows, h.cols);
	}

	a->class = EXTERN;

	num = h.rows * h.cols;
	if( fread( a->type == MATRIX ? MAT(a)[0] : &VAL(a),
		sizeof(double), num, fp) != num) {
	    fclose( fp);
	    perror( fname);
	    error( "readfile() error reading ", name);
	}
    }

}