/* bobfcn.c - built-in classes and functions */
/*
	Copyright (c) 1991, by David Michael Betz
	All rights reserved
*/

#include "bob.h"

/* argument check macros */
#define argmin(n,min)	((n) < (min) ? toofew() : TRUE)
#define argmax(n,max)	((n) > (max) ? toomany() : TRUE)
#define argcount(n,cnt)	(argmin(n,cnt) ? argmax(n,cnt) : FALSE)

/* external variables */
extern DICTIONARY *symbols;

/* forward declarations */
int xnewvector(),xnewstring(),xprint();
int xfopen(),xfclose(),xgetc(),xputc();

/* init_functions - initialize the internal functions */
void init_functions()
{
    add_file("stdin",stdin);
    add_file("stdout",stdout);
    add_file("stderr",stderr);
    add_function("newvector",xnewvector);
    add_function("newstring",xnewstring);
    add_function("fopen",xfopen);
    add_function("fclose",xfclose);
    add_function("getc",xgetc);
    add_function("putc",xputc);
    add_function("print",xprint);
}

/* add_function - add a built-in function */
static add_function(name,fcn)
  char *name; int (*fcn)();
{
    DICT_ENTRY *sym;
    sym = addentry(symbols,name,ST_SFUNCTION);
    set_code(&sym->de_value,fcn);
}

/* add_file - add a built-in file */
static add_file(name,fp)
  char *name; FILE *fp;
{
    DICT_ENTRY *sym;
    sym = addentry(symbols,name,ST_SDATA);
    set_file(&sym->de_value,fp);
}

/* xnewvector - allocate a new vector */
static int xnewvector(argc)
  int argc;
{
    int size;
    argcount(argc,1);
    chktype(0,DT_INTEGER);
    size = sp->v.v_integer;
    ++sp;
    set_vector(&sp[0],newvector(size));
}

/* xnewstring - allocate a new string */
static int xnewstring(argc)
  int argc;
{
    int size;
    argcount(argc,1);
    chktype(0,DT_INTEGER);
    size = sp->v.v_integer;
    ++sp;
    set_string(&sp[0],newstring(size));
}

/* xfopen - open a file */
static int xfopen(argc)
  int argc;
{
    char name[50],mode[10];
    FILE *fp;
    argcount(argc,2);
    chktype(0,DT_STRING);
    chktype(1,DT_STRING);
    getcstring(name,sizeof(name),sp[1].v.v_string);
    getcstring(mode,sizeof(mode),sp[0].v.v_string);
    fp = fopen(name,mode);
    sp += 2;
    if (fp)
	set_file(&sp[0],fp);
    else
	set_nil(&sp[0]);
}

/* xfclose - close a file */
static int xfclose(argc)
  int argc;
{
    int sts;
    argcount(argc,1);
    chktype(0,DT_FILE);
    sts = fclose(sp[0].v.v_fp);
    ++sp;
    set_integer(&sp[0],sts);
}

/* xgetc - get a character from a file */
static int xgetc(argc)
  int argc;
{
    int ch;
    argcount(argc,1);
    chktype(0,DT_FILE);
    ch = getc(sp[0].v.v_fp);
    ++sp;
    set_integer(&sp[0],ch);
}

/* xputc - output a character to a file */
static int xputc(argc)
  int argc;
{
    int ch;
    argcount(argc,2);
    chktype(0,DT_FILE);
    chktype(1,DT_INTEGER);
    ch = putc(sp[1].v.v_integer,sp[0].v.v_fp);
    sp += 2;
    set_integer(&sp[0],ch);
}

/* xprint - generic print function */
static int xprint(argc)
  int argc;
{
    int n;
    for (n = argc; --n >= 0; )
	print1(FALSE,&sp[n]);
    sp += argc;
    set_nil(sp);
}

/* print1 - print one value */
print1(qflag,val)
  int qflag; VALUE *val;
{
    char buf[200],*p;
    CLASS *class;
    int len;
    switch (val->v_type) {
    case DT_NIL:
	osputs("nil");
	break;
    case DT_CLASS:
	sprintf(buf,"#<Class-%s>",val->v.v_class->cl_name);
	osputs(buf);
	break;
    case DT_OBJECT:
	sprintf(buf,"#<Object-%lx>",val->v.v_object);
	osputs(buf);
	break;
    case DT_VECTOR:
	sprintf(buf,"#<Vector-%lx>",val->v.v_vector);
	osputs(buf);
	break;
    case DT_INTEGER:
	sprintf(buf,"%ld",val->v.v_integer);
	osputs(buf);
	break;
    case DT_STRING:
	if (qflag) osputs("\"");
	p = val->v.v_string->s_data;
	len = val->v.v_string->s_length;
	while (--len >= 0)
	    osputc(*p++);
	if (qflag) osputs("\"");
	break;
    case DT_BYTECODE:
	sprintf(buf,"#<Bytecode-%lx>",val->v.v_bytecode);
	osputs(buf);
	break;
    case DT_CODE:
	sprintf(buf,"#<Code-%lx>",val->v.v_code);
	osputs(buf);
	break;
    case DT_VAR:
	if ((class = val->v.v_var->de_dictionary->di_class) == NULL)
	    osputs(val->v.v_var->de_key);
	else {
	    sprintf(buf,"%s::%s",class->cl_name,val->v.v_var->de_key);
	    osputs(buf);
	}
	break;
    case DT_FILE:
	sprintf(buf,"#<File-%lx>",val->v.v_fp);
	osputs(buf);
	break;
    default:
	error("Undefined type: %d",val->v_type);
    }
}

/* toofew - too few arguments */
static int toofew()
{
    error("Too few arguments");
    return (FALSE);
}

/* toomany - too many arguments */
static int toomany()
{
    error("Too many arguments");
    return (FALSE);
}