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

        Alterations and additions, 1994, by G.C.Wraith
*/
#include <stdlib.h>
#include "bob.h"

/* argument check macros */
#define argcount(n,cnt) { if ((n) != (cnt)) wrongcnt(n,cnt); }

/* stdio dispatch table */
IODISPATCH fileio = {
               fclose,
               fgetc,
               fputc,
               fputs };

/* external variables */
extern VALUE symbols;

#ifdef RISCOS
extern int xinput(int argc);
extern int xsysvar(int argc);
extern int xtime(int argc);
extern int xrand(int argc);
extern int xsrand(int argc);
extern int xquit(int argc);
extern int xswi(int argc);
#endif
extern int xval(int argc);
extern int xstring_addr(int argc);
extern int xpeeks(int argc);
extern int xpokes(int argc);
extern int xpeekw(int argc);
extern int xpokew(int argc);
extern int xpeekb(int argc);
extern int xpokeb(int argc);
#ifdef RISCOS
extern int xwimp_closedown(int argc);
extern int xwimp_report(int argc);
extern int xwimp_init(int argc);
extern int xstart_task(int argc);
extern int xcall(int argc);
#endif

/* forward declarations */
#ifdef __STDC__
static int xtypeof(int argc);
static int xgc(int argc);
static int xnewvector(int argc);
static int xnewstring(int argc);
static int xsizeof(int argc);
static int xfopen(int argc);
static int xfclose(int argc);
static int xgetc(int argc);
static int xputc(int argc);
static int xprint(int argc);
static int xgetarg(int argc);
static int xsystem(int argc);
#else
int xtypeof(),xgc();
int xnewvector(),xnewstring(),xsizeof(),xprint(),xgetarg(),xsystem();
int xfopen(),xfclose(),xgetc(),xputc();
#endif

/* init_functions - initialize the internal functions */
void init_functions(void)
{
    add_function("typeof",xtypeof);
    add_function("gc",xgc);
    add_function("newvector",xnewvector);
    add_function("newstring",xnewstring);
    add_function("sizeof",xsizeof);
    add_function("fopen",xfopen);
    add_function("fclose",xfclose);
    add_function("getc",xgetc);
    add_function("putc",xputc);
    add_function("print",xprint);
    add_function("getarg",xgetarg);
#ifdef RISCOS
    add_function("oscli",xsystem);  /* renamed for RISC OS */
#else
    add_function("system",xsystem);
#endif
#ifdef RISCOS
    add_function("input",xinput); 
    add_function("sysvar",xsysvar);
    add_function("time",xtime);
    add_function("rnd",xrand);
    add_function("seed",xsrand);
    add_function("quit",xquit);
    add_function("swi",xswi);
#endif  
    add_function("val",xval); 
    add_function("@",xstring_addr);
    add_function("$",xpeeks);
    add_function("word",xpeekw);
    add_function("byte",xpeekb);
    add_function("$$",xpokes);
    add_function("putword",xpokew);
    add_function("putbyte",xpokeb);
#ifdef RISCOS
    add_function("wimp_closedown",xwimp_closedown);
    add_function("wimp_report",xwimp_report);
    add_function("wimp_init",xwimp_init);
    add_function("start_task",xstart_task);
    add_function("call",xcall);
#endif
    init_real_functions(); 
}

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

/* xtypeof - get the data type of a value */
static int xtypeof(int argc)
{
    argcount(argc,1);
    set_integer(&sp[1],sp->v_type);
    ++sp;
    return(0);
}

/* xgc - invoke the garbage collector */
static int xgc(int argc)
{
    argcount(argc,0);
    gc();
    set_nil(sp);
    return(0);
}

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

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

/* xsizeof - get the size of a vector or string */
static int xsizeof(int argc)
{
    argcount(argc,1);
    switch (sp->v_type) {
    case DT_VECTOR:
        set_integer(&sp[1],sp->v.v_vector->vec_size);
        break;
    case DT_STRING:
        set_integer(&sp[1],sp->v.v_string->str_size);
        break;
    default:
        break;
    }
    ++sp;
    return(0);
}

/* xfopen - open a file */
static int xfopen(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]);
    getcstring(mode,sizeof(mode),&sp[0]);
    if ((fp = fopen(name,mode)) == NULL)
        set_nil(&sp[2]);
    else
        set_iostream(&sp[2],newiostream(&fileio,fp));
    sp += 2;
    return(0);
}

/* xfclose - close a file */
static int xfclose(int argc)
{
    argcount(argc,1);
    chktype(0,DT_IOSTREAM);
    set_integer(&sp[1],iosclose(&sp[0]));
    ++sp;
    return(0);
}

/* xgetc - get a character from a file */
static int xgetc(int argc)
{
    argcount(argc,1);
    chktype(0,DT_IOSTREAM);
    set_integer(&sp[1],iosgetc(&sp[0]));
    ++sp;
    return(0);
}

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

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

/* print1 - print one value */
int print1(VALUE *ios,int qflag,VALUE *val)
{
    char name[TKNSIZE+1],buf[200],*p;
    VALUE *class;
    int len;
    switch (val->v_type) {
    case DT_NIL:
        iosputs("nil",ios);
        break;
    case DT_CLASS:
        getcstring(name,sizeof(name),clgetname(val));
        sprintf(buf,"#<Class-%s>",name);
        iosputs(buf,ios);
        break;
    case DT_OBJECT:
        sprintf(buf,"#<Object-%lx>",objaddr(val));
        iosputs(buf,ios);
        break;
    case DT_VECTOR:
        sprintf(buf,"#<Vector-%lx>",vecaddr(val));
        iosputs(buf,ios);
        break;
    case DT_INTEGER:
        sprintf(buf,"%ld",val->v.v_integer);
        iosputs(buf,ios);
        break;
    case DT_REAL:
        sprintf(buf,"%f",val->v.v_real);
        iosputs(buf,ios);
        break;        
    case DT_STRING:
        if (qflag) iosputc('"',ios);
        p = strgetdata(val);
        len = strgetsize(val);
        while (--len >= 0)
            iosputc(*p++,ios);
        if (qflag) iosputc('"',ios);
        break;
    case DT_BYTECODE:
        sprintf(buf,"#<Bytecode-%lx>",vecaddr(val));
        iosputs(buf,ios);
        break;
    case DT_CODE:
        sprintf(buf,"#<Code-%lx>",val->v.v_code);
        iosputs(buf,ios);
        break;
    case DT_VAR:
        class = digetclass(degetdictionary(val));
        if (!isnil(class)) {
            getcstring(name,sizeof(name),clgetname(class));
            sprintf(buf,"%s::",name);
            iosputs(buf,ios);
        }
        getcstring(name,sizeof(name),degetkey(val));
        iosputs(name,ios);
        break;
    case DT_IOSTREAM:
        sprintf(buf,"#<Stream-%lx>",val->v.v_iostream);
        iosputs(buf,ios);
        break;
    default:
        error1d("Undefined type: %d",valtype(val));
    }
}

/* xgetarg - get an argument from the argument list */
static int xgetarg(int argc)
{
    extern char **bobargv;
    extern int bobargc;
    int i;
    argcount(argc,1);
    chktype(0,DT_INTEGER);
    i = sp[0].v.v_integer;
    if (i >= 0 && i < bobargc)
        set_string(&sp[1],makestring(bobargv[i]));
    else
        set_nil(&sp[1]);
    ++sp;
    return(0);
}

/* xsystem - execute a system command */
static int xsystem(int argc)
{
    char cmd[256];
    argcount(argc,1);
    chktype(0,DT_STRING);
    getcstring(cmd,sizeof(cmd),&sp[0]);
    set_integer(&sp[1],system(cmd));
    ++sp;
    return(0);
}

/* wrongcnt - report wrong number of arguments */
void wrongcnt(int n,int cnt)
{
    if (n < cnt)
        error0("Too many arguments");
    else if (n > cnt)
        error0("Too few arguments");
}
