constant new_constant(block_t heap, enum constant_class vclass, ...)
{
va_list args;
constant newp = allocate(heap, sizeof *newp);
newp->vclass = vclass;
va_start(args, vclass);
switch (vclass)
{
case cst_int:
newp->u.integer = va_arg(args, int);
break;
case cst_string:
newp->u.string = va_arg(args, str_and_len_t);
break;
case cst_list:
{
cstlist clhead = newp->u.constants = va_arg(args, cstlist);
cstlist *clp = &newp->u.constants;
while (*clp && ((*clp)->cst == NULL
|| (*clp)->cst->vclass != cst_expression))
clp = &(*clp)->next;
cstlist cltail = *clp;
if (cltail == NULL)
break;
if (clp == &newp->u.constants)
{
/* the first expression is the list tail */
newp = clhead->cst;
cltail = cltail->next;
}
else if (clp == &newp->u.constants->next)
{
/* the first expression is the last element before the tail */
if (newp->u.constants->cst)
newp = newp->u.constants->cst;
else
newp->u.constants = NULL;
}
else
{
/* the first expression is here, so truncate the tail */
*clp = NULL;
}
build_heap = heap;
component l = new_component(heap, -1, c_constant, newp);
for (; cltail; cltail = cltail->next)
{
component c = new_component(heap, -1, c_constant, cltail->cst);
l = build_exec(build_recall(GEP "pcons"), 2, c, l);
}
newp = allocate(heap, sizeof *newp);
newp->vclass = cst_expression;
newp->u.expression = l;
break;
}
case cst_array: case cst_table:
{
newp->u.constants = va_arg(args, cstlist);
bool dynamic = false;
for (cstlist cl = newp->u.constants; cl; cl = cl->next)
if (cl->cst->vclass == cst_expression)
{
dynamic = true;
break;
}
if (!dynamic)
break;
build_heap = heap;
clist cargs = NULL;
for (cstlist cl = newp->u.constants; cl; cl = cl->next)
cargs = new_clist(heap, new_component(heap, -1, c_constant,
cl->cst),
cargs);
cargs = new_clist(heap, build_recall(GEP "sequence"), cargs);
component c = new_component(heap, 0, c_execute, cargs);
if (vclass == cst_table)
c = build_exec(build_recall(GEP "vector_to_ptable"), 1, c);
newp->vclass = cst_expression;
newp->u.expression = c;
break;
}
case cst_float:
newp->u.mudlle_float = va_arg(args, double);
break;
case cst_bigint:
newp->u.bigint_str = va_arg(args, const char *);
break;
case cst_symbol:
{
newp->u.constpair = va_arg(args, cstpair);
if (newp->u.constpair->cst1->vclass != cst_expression
&& newp->u.constpair->cst2->vclass != cst_expression)
break;
build_heap = heap;
component c = build_exec(build_recall(GEP "make_psymbol"), 2,
new_component(heap, -1, c_constant,
newp->u.constpair->cst1),
new_component(heap, -1, c_constant,
newp->u.constpair->cst2));
newp->vclass = cst_expression;
newp->u.expression = c;
break;
}
case cst_expression:
newp->u.expression = va_arg(args, component);
break;
default: abort();
}
va_end(args);
return newp;
}
jint Java_pp_compiler_Compile_compiler(JNIEnv* env, jobject obj, jstring jname)
{
int e;
const char*path;
int i;
char*name; // index of the file name
initialize();
// error capture
e=0;
if ((e=setjmp(jmp_env))!=0)
{
terminate();
if (iStackPtr>0)
{
#ifdef DEBUG
return 12345; // for debug to stay in console
#else
return e;
#endif
// lauch editor on the error if e>0
// stay on the console on fatal error <0
}
return -1;
}
// Parameters are used in other functons such as emitChar
// so save them in globals
Env=env;
Obj=obj;
// compute the identifier of the Java Method used by the compiler
jclass cls = (*env)->GetObjectClass(env, obj);
emitcharID = (*env)->GetMethodID(env, cls, "emitChar", "(C)V");
if (emitcharID == NULL) ReportError(INTERNAL,"method not found"); // Humm, method not found
// get the path of the file to compile
path=(*env)->GetStringUTFChars(env,jname,NULL);
if (path==NULL) ReportError(OUTOFMEMORY); // out of memory
// copy the path in the Pool and split it
// split the path into the path and the name
// a terminal zero is included in place of the last '/'
// assign LoPoolMax to the end of the path
name=split(path);
(*env)->ReleaseStringUTFChars(env,jname,path);
prompt(name);
do_compile();
do_link();
build_exec();
terminate();
post_message();
return 0;
}