Artifact e522382724bb5e148d12f937a077c39a0f3cd09bd5c966e3bc23e0da076f64eb:
- Executable file
r38/lisp/csl/cslbase/jit1.c
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 6185) [annotate] [blame] [check-ins using] [more...]
/* 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 */