/* :DO-ACTION Method */
LVAL xsitem_do_action(V)
{
LVAL item, action, result;
item = xsgetmenuitem();
xllastarg();
action = slot_value(item, s_action);
result = (action != NIL) ? xlapply(pushargs(action, NIL)) : NIL;
return(result);
}
static int handle_script (lua_State *L, char **argv) {
int status;
const char *fname = argv[0];
if (strcmp(fname, "-") == 0 && strcmp(argv[-1], "--") != 0)
fname = NULL; /* stdin */
status = luaL_loadfile(L, fname);
if (status == LUA_OK) {
int n = pushargs(L); /* push arguments to script */
status = docall(L, n, LUA_MULTRET);
}
return report(L, status);
}
/* xapply - the built-in function 'apply' */
LVAL xapply(void)
{
LVAL fun,arglist;
/* get the function and argument list */
fun = xlgetarg();
arglist = xlgalist();
xllastarg();
/* apply the function to the arguments */
return (xlapply(pushargs(fun,arglist)));
}
static int
lfunc(lua_State *L) {
lbind_function f = (lbind_function)lua_touserdata(L, lua_upvalueindex(1));
struct vars * args = argvars(L,0);
struct vars * result = resultvars(L);
genargs(L, args);
f(args, result);
lbind_clear(args);
lua_settop(L, 0);
int n = pushargs(L, result);
lbind_clear(result);
return n;
}
void do_M (void) {
if (cilk_files) {
/* Create dependencies for cilk programs . */
MY_ARGV ma = make_my_argv();
push_stringified_args(ma, get_cc());
pusharg(ma, stop_at_m_arg);
pusharg(ma, "-xc");
pusharg(ma, "-include");
pusharg(ma, CILK_H_LOCATION);
{
PAIRLIST cf;
for (cf=cilk_files; cf; cf=cf->rest) {
assert(cf->b==0);
pusharg(ma, cf->a);
}
}
pushargs(ma, cpp1_args);
push_stringified_args(ma, CILKC_PTHREAD_CFLAGS);
VERBOSE(2, pusharg(ma, "-v"));
VERBOSE(1, print_my_argv(stderr, ma, 0));
if (my_system(ma, 0)!=0)
barf("creating dependencies for cilk files");
free_my_argv(ma);
}
if (n_gcc_files>0) {
MY_ARGV ma = make_my_argv();
push_stringified_args(ma, get_cc());
pusharg(ma, stop_at_m_arg);
pushargs(ma, cc_args);
push_stringified_args(ma, CILKC_PTHREAD_CFLAGS);
VERBOSE(2, pusharg(ma, "-v"));
VERBOSE(1, print_my_argv(stderr, ma, 0));
if (my_system(ma, 0)!=0)
barf("creating dependencies for cilk files");
free_my_argv(ma);
}
}
static int
lcall(lua_State *L) {
const char * funcname = lua_touserdata(L, 1);
struct vars *args = lua_touserdata(L,2);
lua_settop(L, 0);
if (lua_getglobal(L, funcname) != LUA_TFUNCTION) {
return luaL_error(L, "%s is not a function", funcname);
}
lua_call(L, pushargs(L, args), LUA_MULTRET);
luaL_checkstack(L, LUA_MINSTACK, NULL);
args = resultvars(L);
genargs(L, args);
lua_pushlightuserdata(L, args);
return 1;
}
/* macroexpand - expand a macro call */
int macroexpand(LVAL fun, LVAL args, LVAL *pval)
{
LVAL *argv;
int argc;
/* make sure it's really a macro call */
if (!closurep(fun) || gettype(fun) != s_macro)
return (FALSE);
/* call the expansion function */
argc = pushargs(fun,args);
argv = xlfp + 3;
*pval = evfun(fun,argc,argv);
xlsp = xlfp;
xlfp = xlfp - (int)getfixnum(*xlfp);
return (TRUE);
}
void do_cilk2c(void) {
PAIRLIST cf;
for (cf=cilki_files; cf; cf=cf->rest) {
MY_ARGV ma = make_my_argv();
pusharg(ma, CILK2C_LOCATION);
pusharg(ma, cf->a);
assert(cf->b);
pusharg(ma, "-o");
pusharg(ma, cf->b);
if (cilk_hint) pusharg(ma, "-hint");
pushargs(ma, cilkc_args);
VERBOSE(2, pusharg(ma, "-v"));
VERBOSE(1,print_my_argv(stderr, ma, 0));
if (my_system(ma, 0)!=0) barf("failed running cilk2c");
free_my_argv(ma);
}
}
static int handle_script (lua_State *L, char **argv) {
int status;
const char *fname = argv[0];
#if LUA_TILDE_DEBUGGER && _MSC_VER
char buffer[4096];
#endif // LUA_TILDE_DEBUGGER && _MSC_VER
if (strcmp(fname, "-") == 0 && strcmp(argv[-1], "--") != 0)
fname = NULL; /* stdin */
#if LUA_TILDE_DEBUGGER && _MSC_VER
if (fname) {
_fullpath(buffer, fname, 4096);
fname = buffer;
}
#endif // LUA_TILDE_DEBUGGER && _MSC_VER
status = luaL_loadfile(L, fname);
if (status == LUA_OK) {
int n = pushargs(L); /* push arguments to script */
status = docall(L, n, LUA_MULTRET);
}
return report(L, status);
}
void do_cpp1(void) {
PAIRLIST cf;
for (cf=cilk_files; cf; cf=cf->rest) {
MY_ARGV ma = make_my_argv();
push_stringified_args(ma, get_cc());
pusharg(ma, "-E");
pusharg(ma, "-xc");
pusharg(ma, "-include");
pusharg(ma, CILK_H_LOCATION);
pusharg(ma, cf->a);
assert(cf->b);
pushargs(ma, cpp1_args);
push_stringified_args(ma, CILKC_PTHREAD_CFLAGS);
VERBOSE(2, pusharg(ma, "-v"));
VERBOSE(1, print_my_argv(stderr, ma, cf->b));
if (my_system(ma, cf->b)!=0) barf("failed running cpp1");
free_my_argv(ma);
}
}
/* evform - evaluate a form */
LOCAL LVAL evform(LVAL form)
{
LVAL fun,args,val,type;
LVAL tracing=NIL;
LVAL *argv;
LVAL old_profile_fixnum = profile_fixnum;
FIXTYPE *old_profile_count_ptr = profile_count_ptr;
LVAL funname;
int argc;
/* protect some pointers */
xlstkcheck(2);
xlsave(fun);
xlsave(args);
(*profile_count_ptr)++; /* increment profile counter */
/* get the function and the argument list */
fun = car(form);
args = cdr(form);
funname = fun;
/* get the functional value of symbols */
if (symbolp(fun)) {
if (getvalue(s_tracelist) && member(fun,getvalue(s_tracelist)))
tracing = fun;
fun = xlgetfunction(fun);
}
/* check for nil */
if (null(fun))
xlerror("bad function",NIL);
/* dispatch on node type */
switch (ntype(fun)) {
case SUBR:
argv = xlargv;
argc = xlargc;
xlargc = evpushargs(fun,args);
xlargv = xlfp + 3;
trenter(tracing,xlargc,xlargv);
val = (*getsubr(fun))();
trexit(tracing,val);
xlsp = xlfp;
xlfp = xlfp - (int)getfixnum(*xlfp);
xlargv = argv;
xlargc = argc;
break;
case FSUBR:
argv = xlargv;
argc = xlargc;
xlargc = pushargs(fun,args);
xlargv = xlfp + 3;
val = (*getsubr(fun))();
xlsp = xlfp;
xlfp = xlfp - (int)getfixnum(*xlfp);
xlargv = argv;
xlargc = argc;
break;
case CONS:
if (!consp(cdr(fun)))
xlerror("bad function",fun);
if ((type = car(fun)) == s_lambda)
fun = xlclose(NIL,
s_lambda,
car(cdr(fun)),
cdr(cdr(fun)),
xlenv,xlfenv);
else
xlerror("bad function",fun);
/**** fall through into the next case ****/
case CLOSURE:
/* do profiling */
if (profile_flag && atomp(funname)) {
LVAL profile_prop = findprop(funname, s_profile);
if (null(profile_prop)) {
/* make a new fixnum, don't use cvfixnum because
it would return shared pointer to zero, but we
are going to modify this integer in place --
dangerous but efficient.
*/
profile_fixnum = newnode(FIXNUM);
profile_fixnum->n_fixnum = 0;
setplist(funname, cons(s_profile,
cons(profile_fixnum,
getplist(funname))));
setvalue(s_profile, cons(funname, getvalue(s_profile)));
} else profile_fixnum = car(profile_prop);
profile_count_ptr = &getfixnum(profile_fixnum);
}
if (gettype(fun) == s_lambda) {
argc = evpushargs(fun,args);
argv = xlfp + 3;
trenter(tracing,argc,argv);
val = evfun(fun,argc,argv);
trexit(tracing,val);
xlsp = xlfp;
xlfp = xlfp - (int)getfixnum(*xlfp);
}
else {
macroexpand(fun,args,&fun);
val = xleval(fun);
}
profile_fixnum = old_profile_fixnum;
profile_count_ptr = old_profile_count_ptr;
break;
default:
xlerror("bad function",fun);
}
/* restore the stack */
xlpopn(2);
/* return the result value */
return (val);
}
void do_cc(void) {
if (i_files) {
PAIRLIST pl;
/* The i_files variable was only filled in if we are stoping after -S or -c */
assert(stop_at==STOP_AT_S || stop_at==STOP_AT_O);
for (pl=i_files; pl; pl=pl->rest) {
MY_ARGV ma = make_my_argv();
push_stringified_args(ma, get_cc());
pusharg(ma, pl->a);
pusharg(ma, "-o");
pusharg(ma, pl->b);
pushargs(ma, cc_early_args);
if (stop_at==STOP_AT_S) pusharg(ma, "-S");
else if (stop_at==STOP_AT_O) pusharg(ma, "-c");
else abort(); /* This cannot happen. See the assert() above. */
push_stringified_args(ma, CILKC_PTHREAD_CFLAGS);
if (save_temps) pusharg(ma, "-save-temps");
VERBOSE(2, pusharg(ma, "-v"));
VERBOSE(1, print_my_argv(stderr, ma, 0));
if (my_system(ma, 0)!=0) barf("failed running the final %s to produce %s", get_cc(), pl->b);
free_my_argv(ma);
}
}
if (n_gcc_files>0) {
MY_ARGV ma = make_my_argv();
push_stringified_args(ma, get_cc());
switch (stop_at) {
case STOP_AT_M: barf("I called final cc when I was supposed to do -M");
case STOP_AT_CILKI:
case STOP_AT_CILKC: barf("I called final cc when I was supposed to stop earlier");
case STOP_AT_I: pusharg(ma, "-E"); break;
case STOP_AT_S: pusharg(ma, "-S"); break;
case STOP_AT_O: pusharg(ma, "-c"); break;
case STOP_AT_END: break;
}
pushargs(ma, cc_args);
if (stop_at==STOP_AT_END) {
pusharg(ma, "-L" LIBS_DIR);
pusharg(ma, "-L" LIBS2_DIR);
if (cilk_debug) {
if (cilk_profile) { pusharg(ma, "-lcilkrt0gp"); pusharg(ma, "-lcilk.g.p"); }
else { pusharg(ma, "-lcilkrt0g"); pusharg(ma, "-lcilk.g"); }
} else {
if (cilk_profile) { pusharg(ma, "-lcilkrt0p"); pusharg(ma, "-lcilk.p"); }
else { pusharg(ma, "-lcilkrt0"); pusharg(ma, "-lcilk"); }
}
# ifdef WITH_GNU_LD
pusharg(ma, "-Wl,-rpath," LIBS_DIR);
# endif
}
push_stringified_args(ma, CILKC_PTHREAD_CFLAGS);
push_stringified_args(ma, CILKC_PTHREAD_LIBS);
if (output_name) {
pusharg(ma, "-o");
pusharg(ma, output_name);
}
VERBOSE(2, pusharg(ma, "-v"));
VERBOSE(1, print_my_argv(stderr, ma, 0));
if (my_system(ma, 0)!=0) barf("failed running the final %s", get_cc());
free_my_argv(ma);
}
}
