/* xlsys.c - xlisp builtin system functions */

#ifdef AZTEC
#include "stdio.h"
#else
#include <stdio.h>
#endif

#include "xlisp.h"

/* external variables */
extern struct node *xlstack;
extern int anodes;

/* external symbols */
extern struct node *a_subr;
extern struct node *a_fsubr;
extern struct node *a_list;
extern struct node *a_sym;
extern struct node *a_int;
extern struct node *a_str;
extern struct node *a_obj;
extern struct node *a_fptr;

/* xload - direct input from a file */
struct node *xload(args)
  struct node *args;
{
    struct node *oldstk,fname,*val;

    /* create a new stack frame */
    oldstk = xlsave(&fname,NULL);

    /* get the file name */
    fname.n_ptr = xlmatch(STR,&args);
    xllastarg(args);

    /* load the file */
    val = (xlload(fname.n_ptr->n_str) ? fname.n_ptr : NULL);

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the status */
    return (val);
}

/* xgc - xlisp function to force garbage collection */
struct node *xgc(args)
  struct node *args;
{
    /* make sure there aren't any arguments */
    xllastarg(args);

    /* garbage collect */
    gc();

    /* return null */
    return (NULL);
}

/* xexpand - xlisp function to force memory expansion */
struct node *xexpand(args)
  struct node *args;
{
    struct node *val;
    int n,i;

    /* get the new number to allocate */
    if (args == NULL)
	n = 1;
    else
	n = xlmatch(INT,&args)->n_int;

    /* make sure there aren't any more arguments */
    xllastarg(args);

    /* allocate more segments */
    for (i = 0; i < n; i++)
	if (!addseg())
	    break;

    /* return the number of segments added */
    val = newnode(INT);
    val->n_int = i;
    return (val);
}

/* xalloc - xlisp function to set the number of nodes to allocate */
struct node *xalloc(args)
  struct node *args;
{
    struct node *val;
    int n,oldn;

    /* get the new number to allocate */
    n = xlmatch(INT,&args)->n_int;

    /* make sure there aren't any more arguments */
    xllastarg(args);

    /* set the new number of nodes to allocate */
    oldn = anodes;
    anodes = n;

    /* return the old number */
    val = newnode(INT);
    val->n_int = oldn;
    return (val);
}

/* xmem - xlisp function to print memory statistics */
struct node *xmem(args)
  struct node *args;
{
    /* make sure there aren't any arguments */
    xllastarg(args);

    /* print the statistics */
    stats();

    /* return null */
    return (NULL);
}

/* xtype - return type of a thing */
struct node *xtype(args)
    struct node *args;
{
    struct node *arg;

    if (!(arg = xlarg(&args)))
	return (NULL);

    switch (arg->n_type) {
	case SUBR:	return (a_subr);
	case FSUBR:	return (a_fsubr);
	case LIST:	return (a_list);
	case SYM:	return (a_sym);
	case INT:	return (a_int);
	case STR:	return (a_str);
	case OBJ:	return (a_obj);
	case FPTR:	return (a_fptr);
	default:	xlfail("bad node type");
    }
}

/* xexit - get out of xlisp */
xexit()
{
    exit();
}