/* bobmem.c - memory manager */
/*
        Copyright (c) 1991, by David Michael Betz
        All rights reserved.

        Alterations and additions, 1994, by G.C.Wraith
*/

#include <setjmp.h>
#include <string.h>
#include "bob.h"

#define pushr(x,t,f)     (--spr,spr->v_type = (t), spr->v.f = (x))
#define pushr_var(x)      pushr(x,DT_VAR,v_var)
#define pushr_class(x)    pushr(x,DT_CLASS,v_class)

/* allocation unit */
typedef char *AUNIT;
#define ALLOCSIZE(x)    (((x) + sizeof(AUNIT) - 1) / sizeof(AUNIT))

/* block flags */
#define MARK    1

/* size of each type of memory segment */
#define VSSIZE  10000   /* number of LVAL's per vector segment */
#define VCOMPARE(f,s,t) ((f) + (s) <= (t))

#ifdef RISCOS
#define PAGE (0x8000)
#endif

/* macros to compute the size of a segment */
#define vsegsize(n) (sizeof(VSEGMENT)+((n)-1)*sizeof(char *))

/* macro to convert a byte size to a word size */
#define btow_size(n)    (((n) + sizeof(char *) - 1) / sizeof(char *))

/* vector segment structure */
typedef struct vsegment {
    struct vsegment *vs_next;   /* next vector segment */
    AUNIT *vs_free;             /* next free location in this segment */
    AUNIT *vs_top;              /* top of segment (plus one) */
    AUNIT vs_data[1];           /* segment data */
} VSEGMENT;

/* global variables */
VALUE symbols;          /* the symbol table */
VALUE classes;          /* the class table */
VALUE stdin_iostream;   /* standard input i/o stream */
VALUE stdout_iostream;  /* standard output i/o stream */
VALUE stderr_iostream;  /* standard error i/o stream */
VALUE nil;              /* the nil value */

/* vector (and string) space */
static VSEGMENT *vsegments=NULL;/* list of vector segments */
static VSEGMENT *vscurrent=NULL;/* current vector segment */
static AUNIT *vfree=NULL;       /* next free location in current segment */
static AUNIT *vtop=NULL;        /* top of current segment */
#ifdef RISCOS
static int current_slotsize;   
#endif

#ifdef RISCOS
/* external functions */
extern int SlotSize(int size);
#endif

/* external variables */
extern jmp_buf error_trap;      /* the error trap target */
extern VECTOR *code;            /* currently executing code vector */

/* forward declarations */
#ifdef __STDC__
static DICT_ENTRY *newentry(VALUE *dict,char *key,int type);
static HDR *allocmemory(int type,int size);
static int findvmemory(int size);
static int checkvmemory(int size);
static int makevmemory(int size);
static int vexpand(int size);
static VSEGMENT *newvsegment(unsigned int n);
static void markclass(CLASS *class);
static void markdictionary(DICTIONARY *dict);
static void markentry(DICT_ENTRY *entry);
static void markobject(OBJECT *obj);
static void markvector(VECTOR *vect);
static void compact(void);
static int getblocksize(HDR *hdr);
static void compact_vector(VSEGMENT *vseg);
#else
static HDR *allocmemory();
static void markclass(),markdictionary(),markentry(),markobject();
static void markvector(),compact(),compact_vector();
static DICT_ENTRY *newentry();
#endif

/* initialize - initialize the virtual machine */
int initialize(int smax)
{
    char *calloc();
    
    /* setup an error trap handler */
    if (setjmp(error_trap) != 0)
        return (FALSE);

#ifdef RISCOS
    current_slotsize = SlotSize(-1);
#endif

    /* allocate the stack */
    if ((stkbase = (VALUE *)calloc(1,smax * sizeof(VALUE))) == NULL)
        return (FALSE);
    stktop = sp = stkbase + smax;
    code = NULL;

    /* initialize the memory manager */
    vsegments = vscurrent = NULL;
    vfree = vtop = NULL;

    /* initialize globals */
    set_nil(&symbols);
    set_nil(&classes);
    set_nil(&stdin_iostream);
    set_nil(&stdout_iostream);
    set_nil(&stderr_iostream);
    set_nil(&nil);

    /* create the initial segment */
    if (!vexpand(VSSIZE))
        return (FALSE);

    /* create the symbol and class tables */
    set_dictionary(&symbols,newdictionary(&nil));
    set_dictionary(&classes,newdictionary(&nil));

    /* enter the built-in functions */
    init_functions();
    return (TRUE);
}

/* addentry - add an entry to a dictionary */
DICT_ENTRY *addentry(VALUE *dict,char *key,int type)
{
    register VALUE *spr;
    DICT_ENTRY *entry;
    if ((entry = findentry(dict,key)) == NULL) {
        check(1);
        spr = sp;
        pushr_var(newentry(dict,key,type));
        spr->v.v_var->de_next = *digetcontents(dict);
        dict->v.v_dictionary->di_contents = *spr;
        entry = deaddr(spr++);
        sp = spr;
    }
    return (entry);
}

/* findentry - find an entry in a dictionary */
DICT_ENTRY *findentry(VALUE *dict,char *key)
{
    DICT_ENTRY *entry;
    int size;
    for (entry = digetcontents(dict)->v.v_var;
         entry != NULL;
         entry = entry->de_next.v.v_var)
        if ((size = strgetsize(&entry->de_key)) == strlen(key)
        &&  strncmp(key,
                    strgetdata(&entry->de_key),
                    size) == 0)
            return (entry);
    return (NULL);
}

/* makestring - make an initialized string from a C-style string */
STRING *makestring(char *str)
{
    STRING *val;
    int len;
    len = strlen(str);
    val = newstring(len);
    strncpy(val->str_data,str,len);
    return (val);
}

/* getcstring - get a C-style version of a string */
char *getcstring(char *buf,int max,VALUE *str)
{
    int len;
    if ((len = strgetsize(str)) >= max)
        len = max - 1;
    strncpy(buf,strgetdata(str),len);
    buf[len] = '\0';
    return (buf);
}

/* newstring - allocate a new string object */
STRING *newstring(int n)
{
    STRING *val;
    int size;
    char *p;
    size = sizeof(STRING) + n - 1;
    val = (STRING *)allocmemory(DT_STRING,size);
    val->str_size = n;
    for (p = val->str_data; --n >= 0; )
        *p++ = '\0';
    return (val);
}

/* newobject - allocate a new object */
OBJECT *newobject(VALUE *class)
{
    OBJECT *val;
    int size,n;
    VALUE *p;
    n = clgetsize(class);
    size = sizeof(OBJECT) + (n - 1) * sizeof(VALUE);
    val = (OBJECT *)allocmemory(DT_OBJECT,size);
    val->obj_class = *class;
    for (p = val->obj_members; --n >= 0; ++p)
        p->v_type = DT_NIL;
    return (val);
}

/* newvector - allocate a new vector */
VECTOR *newvector(int n)
{
    VECTOR *val;
    VALUE *p;
    int size;
    size = sizeof(VECTOR) + (n - 1) * sizeof(VALUE);
    val = (VECTOR *)allocmemory(DT_VECTOR,size);
    val->vec_size = n;
    for (p = val->vec_data; --n >= 0; ++p)
        p->v_type = DT_NIL;
    return (val);
}

/* newclass - create a new class */
CLASS *newclass(char *name,VALUE *base)
{
    register VALUE *spr;
    register CLASS *classptr;
    /* allocate the memory for the new class */
    check(1);
    spr = sp;
    pushr_class((CLASS *)allocmemory(DT_CLASS,sizeof(CLASS)));
    classptr = spr->v.v_class;
    set_nil(&classptr->cl_name);
    set_nil(&classptr->cl_members);
    set_nil(&classptr->cl_functions);

    /* initialize */
    classptr->cl_base = *base;
    set_string(&classptr->cl_name,makestring(name));
    set_dictionary(&classptr->cl_members,newdictionary(spr));
    set_dictionary(&classptr->cl_functions,newdictionary(spr));
    classptr->cl_size = 0;
    sp = spr;
    /* return the new class */
    return (claddr(sp++));
}

/* newdictionary - create a new dictionary */
DICTIONARY *newdictionary(VALUE *class)
{
    DICTIONARY *dict;
    dict = (DICTIONARY *)allocmemory(DT_DICTIONARY,sizeof(DICTIONARY));
    dict->di_class = *class;
    set_nil(&dict->di_contents);
    return (dict);
}

/* newentry - allocate a new dictionary entry */
static DICT_ENTRY *newentry(VALUE *dict,char *key,int type)
{
    register VALUE *spr;
    register DICT_ENTRY *deptr;
    check(1);
    spr = sp;
    pushr_var((DICT_ENTRY *)allocmemory(DT_VAR,sizeof(DICT_ENTRY)));
    deptr = spr->v.v_var;
    deptr->de_dictionary = *dict;
    deptr->de_type = type;
    set_nil(&deptr->de_key);
    set_nil(&deptr->de_value);
    set_nil(&deptr->de_next);
    set_string(&deptr->de_key,makestring(key));
    sp = spr;
    return (deaddr(sp++));
}

/* newiostream - create a new i/o stream */
IOSTREAM *newiostream(IODISPATCH *iod,void *data)
{
    IOSTREAM *ios;
    ios = (IOSTREAM *)allocmemory(DT_IOSTREAM,sizeof(IOSTREAM));
    ios->ios_dispatch = iod;
    ios->ios_data = data;
    return (ios);
}

/* allocmemory - allocate a block of memory */
static HDR *allocmemory(int type,int size)
{
    HDR *val;

    /* make sure there's enough space */
    size = ALLOCSIZE(size);
    if (!VCOMPARE(vfree,size,vtop)
    &&  !checkvmemory(size)
    &&  !findvmemory(size))
        error0("Insufficient memory");

    /* allocate the next available block */
    val = (HDR *)vfree;
    vfree += size;
    
    /* return the new block of memory */
    val->hdr_type = type;
    val->hdr_flags = 0;
    val->hdr_chain = NULL;
    return (val);
}

/* findvmemory - find vector memory */
static int findvmemory(int size)
{
    /* try garbage collecting */
    gc();

    /* check to see if we found enough memory */
    if (VCOMPARE(vfree,size,vtop) || checkvmemory(size))
        return (TRUE);

    /* expand vector space */
    return (makevmemory(size));
}

/* checkvmemory - check for vector memory (used by 'xsimage.c') */
static int checkvmemory(int size)
{
    VSEGMENT *vseg;
    for (vseg = vsegments; vseg != NULL; vseg = vseg->vs_next)
        if (vseg != vscurrent && VCOMPARE(vseg->vs_free,size,vseg->vs_top)) {
            if (vscurrent != NULL)
                vscurrent->vs_free = vfree;
            vfree = vseg->vs_free;
            vtop = vseg->vs_top;
            vscurrent = vseg;
            return (TRUE);
        }       
    return (FALSE);
}
    
/* makevmemory - make vector memory (used by 'xsimage.c') */
static int makevmemory(int size)
{
    return (vexpand(size < VSSIZE ? VSSIZE : size));
}

/* vexpand - expand vector space */
static int vexpand(int size)
{
    VSEGMENT *vseg;

    /* allocate the new segment */
    if ((vseg = newvsegment(size)) != NULL) {

        /* initialize the new segment and make it current */
        if (vscurrent != NULL)
            vscurrent->vs_free = vfree;
        vfree = vseg->vs_free;
        vtop = vseg->vs_top;
        vscurrent = vseg;
    }
    return (vseg != NULL);
}

/* newvsegment - create a new vector segment */
static VSEGMENT *newvsegment(unsigned int n)
{
    char *calloc();
    VSEGMENT *newseg;

    /* allocate the new segment */
    if ((newseg = (VSEGMENT *)calloc(1,vsegsize(n))) == NULL)
#ifdef RISCOS
   {
    current_slotsize = SlotSize(current_slotsize+PAGE);
    if ((newseg = (VSEGMENT *)calloc(1,vsegsize(n))) == NULL)
       return (NULL);
   }
#else
        return (NULL);
#endif

    /* initialize the new segment */
    newseg->vs_free = newseg->vs_data;
    newseg->vs_top = newseg->vs_free + n;
    newseg->vs_next = vsegments;
    vsegments = newseg;

    /* return the new segment */
    return (newseg);
}
 
/* gc - garbage collect */
void gc(void)
{
    extern unsigned char *cbase,*pc;
    VALUE codeval,*p;
    int pcoff;
/*info("GC");*/

    /* protect the current bytecode vector */
    if (code) {
        set_bytecode(&codeval,code);
        pcoff = pc - cbase;
        mark(&codeval);
    }

    /* mark all reachable values */
    mark(&symbols);
    mark(&classes);
    mark(&stdin_iostream);
    mark(&stdout_iostream);
    mark(&stderr_iostream);

    /* mark the stack */
    for (p = sp; p < stktop; )
        mark(p++);

    /* mark compiler variables */
    mark_compiler();

    /* compact all active blocks */
    compact();

    /* reload the interpreter's registers */
    if (code) {
        code = codeval.v.v_vector;
        cbase = (void *)code->vec_data[0].v.v_string->str_data;
        pc = cbase + pcoff;
    }
}

/* mark - mark all accessible nodes */
void mark(VALUE *val)
{
    HDR *hdr;
    switch (val->v_type) {
    case DT_CLASS:
    case DT_OBJECT:
    case DT_VECTOR:
    case DT_BYTECODE:
    case DT_STRING:
    case DT_DICTIONARY:
    case DT_VAR:
    case DT_IOSTREAM:
        hdr = val->v.v_hdr;
        val->v.v_chain = hdr->hdr_chain;
        hdr->hdr_chain = val;
        if ((hdr->hdr_flags & MARK) == 0) {
            hdr->hdr_flags |= MARK;
            switch (hdr->hdr_type) {
            case DT_CLASS:
                markclass((CLASS *)hdr);
                break;
            case DT_OBJECT:
                markobject((OBJECT *)hdr);
                break;
            case DT_VECTOR:
                markvector((VECTOR *)hdr);
                break;
            case DT_DICTIONARY:
                markdictionary((DICTIONARY *)hdr);
                break;
            case DT_VAR:
                markentry((DICT_ENTRY *)hdr);
                break;
            }
        }
        break;
    }
}

/* markclass - mark a class */
static void markclass(CLASS *class)
{
    mark(&class->cl_name);
    mark(&class->cl_base);
    mark(&class->cl_members);
    mark(&class->cl_functions);
}

/* markdictionary - mark a dictionary */
static void markdictionary(DICTIONARY *dict)
{
    VALUE *next,*val;
    mark(&dict->di_class);
    for (val = &dict->di_contents;
         !isnil(val);
         val = next) {
        next = degetnext(val);
        mark(val);
    }
}

/* markentry - mark a dictionary entry */
static void markentry(DICT_ENTRY *entry)
{
    mark(&entry->de_dictionary);
    mark(&entry->de_key);
    mark(&entry->de_value);
}

/* markobject - mark an object */
static void markobject(OBJECT *obj)
{
    VALUE *p;
    int n;
    p = obj->obj_members;
    n = clgetsize(&obj->obj_class);
    while (--n >= 0)
        mark(p++);
}

/* markvector - mark a vector */
static void markvector(VECTOR *vect)
{
    VALUE *p;
    int n;
    p = vect->vec_data;
    n = vect->vec_size;
    while (--n >= 0)
        mark(p++);
}

/* compact - compact vector space */
static void compact(void)
{
    VSEGMENT *vseg;

    /* store the current segment information */
    if (vscurrent)
        vscurrent->vs_free = vfree;

    /* compact each vector segment */
    for (vseg = vsegments; vseg != NULL; vseg = vseg->vs_next)
        compact_vector(vseg);

    /* make the first vector segment current */
    if ((vscurrent = vsegments) != NULL) {
        vfree = vscurrent->vs_free;
        vtop = vscurrent->vs_top;
    }
}

/* getblocksize - get the size of a block */
static int getblocksize(HDR *hdr)
{
    switch (hdr->hdr_type) {
    case DT_CLASS:
        return (ALLOCSIZE(sizeof(CLASS)));
    case DT_OBJECT:
        return (ALLOCSIZE(sizeof(OBJECT)
             +  (clgetsize(&((OBJECT *)hdr)->obj_class) - 1) * sizeof(VALUE)));
    case DT_VECTOR:
        return (ALLOCSIZE(sizeof(VECTOR)
             +  (((VECTOR *)hdr)->vec_size - 1) * sizeof(VALUE)));
    case DT_STRING:
        return (ALLOCSIZE(sizeof(STRING)
             +  ((STRING *)hdr)->str_size - 1));
    case DT_DICTIONARY:
        return (ALLOCSIZE(sizeof(DICTIONARY)));
    case DT_VAR:
        return (ALLOCSIZE(sizeof(DICT_ENTRY)));
    case DT_IOSTREAM:
        return (ALLOCSIZE(sizeof(IOSTREAM)));
    }
    error1d("Bad block type: %d",hdr->hdr_type);
    return (0);
}

/* compact_vector - compact a vector segment */
static void compact_vector(VSEGMENT *vseg)
{
    AUNIT *vdata,*vnext,*vfree;
    VALUE *vp,*nextvp;
    int vsize;
    HDR *hdr;

    /* update pointers */
    vdata = vnext = vseg->vs_data;
    vfree = vseg->vs_free;
    while (vdata < vfree) {
        hdr = (HDR *)vdata;
        vsize = getblocksize(hdr);
        if (hdr->hdr_flags & MARK) {
            for (vp = hdr->hdr_chain; vp != NULL; vp = nextvp) {
                nextvp = vp->v.v_chain;
                vp->v.v_hdr = (HDR *)vnext;
            }
            hdr->hdr_chain = NULL;
            vnext += vsize;
        }
        else {
            switch (hdr->hdr_type) {
            case DT_IOSTREAM:
                ((IOSTREAM *)hdr)->ios_dispatch->iod_close(
                        ((IOSTREAM *)hdr)->ios_data);
                break;
            }
        }
        vdata += vsize;
    }

    /* compact free space */
    vdata = vnext = vseg->vs_data;
    vfree = vseg->vs_free;
    while (vdata < vfree) {
        hdr = (HDR *)vdata;
        vsize = getblocksize(hdr);
        if (hdr->hdr_flags & MARK) {
            hdr->hdr_flags &= ~MARK;
            if (vdata == vnext) {
                vdata += vsize;
                vnext += vsize;
            }
            else
                while (--vsize >= 0)
                    *vnext++ = *vdata++;
        }
        else
            vdata += vsize;
    }
    vseg->vs_free = vnext;
}
