/* jit1.c                      Copyright (C) 2006-2007, Codemist Ltd */
/*                                                and J O'Connell    */

/*
 * Just in time compiler interfaces. The ideal is that this file does not
 * depend on the architecture of the machine being compiled for. At present
 * there is a bit of system-specific stuff here about allocating memory that
 * can be written to and then executed. But mostly what happens here is an
 * interface between the main CSL interpreter and the JIT system.
 */

/*
 * This code may be used and modified, and redistributed in binary
 * or source form, subject to the "CCL Public License", which should
 * accompany it. This license is a variant on the BSD license, and thus
 * permits use of code derived from this in either open and commercial
 * projects: but it does require that updates to this code be made
 * available back to the originators of the package.
 * Before merging other code in with this or linking this code
 * with other packages or libraries please check that the license terms
 * of the other material are compatible with those of this.
 */



/* Signature: 49ece4ba 18-Jan-2007 */

#include "headers.h"

#ifdef WIN32
#include <windows.h>
#else
#include <sys/mman.h>
#endif

#ifdef X86
#include "distorm.h"
#endif

extern int codep;
extern void *jit_space_p, *jit_space;

#define name_from(def) elt(qcdr(def), 0)

int set_jit_mem(char *jitcode)
{
#ifndef WIN32
    /* Check if mmap worked ok */
    if (jit_space==(caddr_t)-1) 
    {   printf("dead");
        return -1;
    }
#endif
    /* Check if enough space, if not try to get more or die nicely */
    while (codep >
           (jit_size - ((unsigned long)jit_space_p-(unsigned long)jit_space))) 
    {   err_printf("\nJIT SPACE IS FULL.  TRYING TO ALLOC MORE...\n");
        jit_size *= 2;
#ifndef WIN32
        jit_space = mremap(jit_space, jit_size/2, jit_size, 0);
        if (jit_space==(caddr_t)-1) 
        {
/*
 * I probably want to use strerror not perror here so that I can then
 * direct the diagnostic to the CSL error destination, which may sometimes
 * be a window rather than "stdout". 
 */
            perror("mmap failed");
            return -1;
        }
       err_printf("SUCCESSFUL. ALLOCATED %d\n", jit_size);
#endif
    }
    /* copy over jit compiled function */
    memcpy(jit_space_p, jitcode, codep);
    return 0;
}                                    

Lisp_Object MS_CDECL jitcompileme0(Lisp_Object def, int nargs, ...)
{
    Lisp_Object name = name_from(def);
    char *jitcode;
    if (nargs != 0) return error(2, err_wrong_no_args, name_from(def),
                                    fixnum_of_int((int32)nargs));
    jitcode = Jcompile(def, 0);
    if (jitcode != NULL) 
    {   if (set_jit_mem(jitcode)==0)
        {   ifnn(name) = (intptr_t)jit_space_p;
            jit_space_p += codep;
        }
        else ifnn(name) = (intptr_t)bytecoded0;
    }
    else ifnn(name) = (intptr_t)bytecoded0;

    return qfnn(name)(qenv(name), 0);
}

Lisp_Object jitcompileme1(Lisp_Object def, Lisp_Object a)
{
    Lisp_Object name = name_from(def);
/*
 * Jcompile does not have to do anything that could provoke a garbage
 * collection, so I am in the happy position that I do not need to
 * stack anything here or fuss in any way about the Lisp-ness of my
 * environment.
 */
    char *jitcode = Jcompile(def, 1);
/*
 * At present Jcompile builds its generated code in a private buffer
 * (probably of limited length) and I copy if to executable memory here.
 * The "copy" operation would have bad consequences for any code that
 * was location sensitive!
 */
    if (jitcode != NULL) 
    {   if (set_jit_mem(jitcode)==0)
        {   ifn1(name) = (intptr_t)jit_space_p;
            jit_space_p += codep;
        }
        else ifn1(name) = (intptr_t)bytecoded1;
    }
    else ifn1(name) = (intptr_t)bytecoded1;
/*
 * remember to pass the compiled code its "environment" of literals.
 */
    return qfn1(name)(qenv(name), a);
}

Lisp_Object jitcompileme2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    Lisp_Object name = name_from(def);
    char *jitcode = Jcompile(def, 2);

    if (jitcode != NULL) 
    {   if (set_jit_mem(jitcode)==0)
        {   ifn2(name) = (intptr_t)jit_space_p;
            jit_space_p += codep;
        }
        else ifn2(name) = (intptr_t)bytecoded2;
    }
    else ifn2(name) = (intptr_t)bytecoded2;
    return qfn2(name)(qenv(name), a, b);
}

Lisp_Object MS_CDECL jitcompileme3(Lisp_Object def, int nargs, ...)
{
    Lisp_Object name = name_from(def); 
    char *jitcode;
    va_list aa;
    Lisp_Object a, b, c;
    if (nargs != 3) return error(2, err_wrong_no_args, name_from(def),
                                    fixnum_of_int((int32)nargs));
    jitcode = Jcompile(def, 3);

    if (jitcode != NULL) 
    {   if (set_jit_mem(jitcode)==0) 
        {   ifnn(name) = (intptr_t)jit_space_p;
            jit_space_p += codep;
        }
        else ifnn(name) = (intptr_t)bytecoded3;
    }
    else ifnn(name) = (intptr_t)bytecoded3;

    va_start(aa, nargs);
    a = va_arg(aa, Lisp_Object);
    b = va_arg(aa, Lisp_Object);
    c = va_arg(aa, Lisp_Object);
    va_end(aa);
    return qfnn(name)(qenv(name), 3, a, b, c);
}

Lisp_Object MS_CDECL jitcompilemen(Lisp_Object def, int nargs, ...)
{
    Lisp_Object name = name_from(def);
    va_list a;
/*
 * Ought I to check the number of args here? Quite probably!!!!
 */
    char *jitcode = Jcompile(def, nargs);

    if (jitcode != NULL) 
    {   if (set_jit_mem(jitcode)==0) 
        {   ifnn(name) = (intptr_t)jit_space_p;
            jit_space_p += codep;
        }
        else ifnn(name) = (intptr_t)bytecodedn;
    }
    else ifnn(name) = (intptr_t)bytecodedn;
/*
 * I have a feeling that nargs should never be zero here....
 */
    if (nargs != 0)
    {   va_start(a, nargs);
        push_args(a, nargs); /* FIXME stack ok? or pushed too much */
    }
    return apply(name, nargs, qenv(name), name);
}



/* end of jit1.c */