errval_t get_record(struct ast_object* ast, struct oct_query_state* sqs)
{
assert(ast != NULL);
assert(sqs != NULL);
struct skb_ec_terms sr;
errval_t err = transform_record(ast, &sr);
if (err_is_ok(err)) {
// Calling get_object(Name, Attrs, Constraints, Y), print_object(Y).
dident get_object = ec_did("get_first_object", 4);
dident print_object = ec_did("print_object", 1);
pword print_var = ec_newvar();
pword get_object_term = ec_term(get_object, sr.name, sr.attribute_list,
sr.constraint_list, print_var);
pword print_term = ec_term(print_object, print_var);
ec_post_goal(get_object_term);
ec_post_goal(print_term);
err = run_eclipse(sqs);
if (err_no(err) == SKB_ERR_GOAL_FAILURE) {
err = err_push(err, OCT_ERR_NO_RECORD);
}
OCT_DEBUG(" get_record:\n");
debug_skb_output(sqs);
}
return err;
}
errval_t del_record(struct ast_object* ast, struct oct_query_state* dqs)
{
// TODO sr.attributes, sr.constraints currently not used for delete
// it's just based on the name
// Think about how to constraints / attributes behave with del
assert(ast != NULL);
assert(dqs != NULL);
struct skb_ec_terms sr;
errval_t err = transform_record(ast, &sr);
if (err_is_ok(err)) {
// Calling del_object(Name)
dident del_object = ec_did("del_object", 3);
pword del_object_term = ec_term(del_object, sr.name,
sr.attribute_list, sr.constraint_list);
ec_post_goal(del_object_term);
err = run_eclipse(dqs);
if (err_no(err) == SKB_ERR_GOAL_FAILURE) {
err = err_push(err, OCT_ERR_NO_RECORD);
}
OCT_DEBUG(" del_record:\n");
debug_skb_output(dqs);
}
return err;
}
errval_t set_record(struct ast_object* ast, uint64_t mode,
struct oct_query_state* sqs)
{
assert(ast != NULL);
assert(sqs != NULL);
struct skb_ec_terms sr;
errval_t err = transform_record(ast, &sr);
if (err_is_ok(err)) {
// Calling add_object(Name, Attributes)
dident add_object;
if (mode & SET_SEQUENTIAL) {
add_object = ec_did("add_seq_object", 3);
}
else {
add_object = ec_did("add_object", 3);
}
pword add_object_term = ec_term(add_object, sr.name, sr.attribute_list,
sr.constraint_list);
ec_post_goal(add_object_term);
err = run_eclipse(sqs);
OCT_DEBUG(" set_record:\n");
debug_skb_output(sqs);
if (err_no(err) == SKB_ERR_GOAL_FAILURE) {
/*OCT_DEBUG("Goal failure during set record. Should not happen!\n");
assert(!"SKB_ERR_GOAL_FAILURE during set?");*/
err = err_push(err, OCT_ERR_CONSTRAINT_MISMATCH);
}
}
return err;
}
void Winapi
ec_post_exdr(int length, const char *exdr_string)
{
ec_post_goal(ec_term(ec_.d.colon,
ec_atom(ec_.d.kernel_sepia),
ec_term(ec_did("exec_exdr",1), ec_length_string(length, exdr_string))));
}
void Winapi
ec_post_string(const char *callstring)
{
ec_post_goal(ec_term(ec_.d.colon,
ec_atom(ec_.d.kernel_sepia),
ec_term(ec_did("exec_string",2), ec_string(callstring), ec_newvar())));
}
errval_t get_record_names(struct ast_object* ast, struct oct_query_state* dqs)
{
assert(ast != NULL);
assert(dqs != NULL);
struct skb_ec_terms sr;
errval_t err = transform_record(ast, &sr);
if (err_is_ok(err)) {
// Calling findall(X, get_object(X, Attrs, Constraints, _), L),
// prune_instances(L, PL), print_names(PL).
dident prune_instances = ec_did("prune_instances", 2);
dident findall = ec_did("findall", 3);
dident get_object = ec_did("get_object", 4);
dident print_names = ec_did("print_names", 1);
pword var_l = ec_newvar();
pword var_pl = ec_newvar();
pword var_rec = ec_newvar();
pword get_object_term = ec_term(get_object, sr.name, sr.attribute_list,
sr.constraint_list, var_rec);
pword findall_term = ec_term(findall, var_rec, get_object_term, var_l);
pword prune_results = ec_term(prune_instances, var_l, var_pl);
pword print_names_term = ec_term(print_names, var_pl);
ec_post_goal(findall_term);
ec_post_goal(prune_results);
ec_post_goal(print_names_term);
err = run_eclipse(dqs);
if (err_is_ok(err) && dqs->std_out.buffer[0] == '\0') {
err = OCT_ERR_NO_RECORD;
}
else if (err_no(err) == SKB_ERR_GOAL_FAILURE) {
assert(!"findall failed - should not happen!");
// see http://eclipseclp.org/doc/bips/kernel/allsols/findall-3.html
}
OCT_DEBUG(" get_record_names:\n");
debug_skb_output(dqs);
}
return err;
}
int Winapi
ec_exec_string(
char *callstring,
ec_ref varsref) /* NULL is allowed */
{
pword vars;
dident exec_string_2 = enter_dict("exec_string",2);
vars = ec_newvar();
if (varsref)
ec_ref_set(varsref, vars);
ec_post_goal(ec_term(ec_.d.colon,
ec_atom(ec_.d.kernel_sepia),
ec_term(exec_string_2, ec_string(callstring), vars)));
return ec_resume1(0);
}
main(int argc, char **argv)
{
char * eclipsedir = (char *) 0;
int c, new_argc, err;
int init_flags = INIT_SHARED|INIT_PRIVATE|INIT_ENGINE|INIT_PROCESS;
char * session, * nsrv_hostname;
unsigned nsrv_port_number;
uword size;
/*
* If stdio is not a tty, get rid of the console window. This is not ideal
* since the window flashes up briefly, but no better solution yet.
* (The correct way would be not to build eclipse.exe as a "console
* application" and have a WinMain() instead of main(). But then we have
* to do all the setup of stdin/out/err, argc/argv, environment etc
* ourselves)
*/
if (!isatty(_fileno(stdin))
&& !isatty(_fileno(stdout))
&& !isatty(_fileno(stderr)))
{
FreeConsole();
}
/*
* collect information from the command line
* remove some internally used arguments from the command line
*/
for (c = new_argc = 1; c < argc; )
{
if (argv[c][0] == '-' && argv[c][2] == 0) /* single char opt */
{
switch (argv[c][1])
{
case 'a': /* -a <worker> <session>
<nsrv_hostname> <nsrv_port_no> */
if (++c + 4 > argc) usage(argv[c-1]);
ec_set_option_int(EC_OPTION_PARALLEL_WORKER, atoi(argv[c++]));
session = argv[c++];
nsrv_hostname = argv[c++];
nsrv_port_number = atoi(argv[c++]);
break;
case 'c': /* -c <shared_map_file> */
if (++c + 1 > argc) usage(argv[c-1]);
ec_set_option_ptr(EC_OPTION_MAPFILE, argv[c++]);
ec_set_option_int(EC_OPTION_ALLOCATION, ALLOC_FIXED);
init_flags &= ~INIT_SHARED;
break;
case 'm': /* -m <shared_map_file> */
if (++c + 1 > argc) usage(argv[c-1]);
ec_set_option_ptr(EC_OPTION_MAPFILE, argv[c++]);
ec_set_option_int(EC_OPTION_ALLOCATION, ALLOC_FIXED);
break;
case 'b': /* -b <bootfile> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c++]; /* shift */
break;
case 'e': /* -e <goal> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c++]; /* shift */
break;
case 'g': /* -g <size> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c]; /* shift */
size = sizearg(argv[c++]);
ec_set_option_long(EC_OPTION_GLOBALSIZE, size);
if (size < MIN_GLOBAL) {
fprintf(stderr,"Global stack size out of range\n");
exit(-1);
}
break;
case 'd': /* -d <n> */
/* delay worker startup by <n> seconds */
if (++c + 1 > argc) usage(argv[c-1]);
Sleep(1000 * atoi(argv[c++]));
break;
case 'D': /* -D <eclipsedir> */
if (++c + 1 > argc) usage(argv[c-1]);
eclipsedir = argv[c++];
break;
case 'l': /* -l <size> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c]; /* shift */
size = sizearg(argv[c++]);
ec_set_option_long(EC_OPTION_LOCALSIZE, size);
if (size < MIN_LOCAL) {
fprintf(stderr,"Local stack size out of range\n");
exit(-1);
}
break;
case 'h': /* -h <size> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c]; /* shift */
size = sizearg(argv[c++]);
ec_set_option_long(EC_OPTION_PRIVATESIZE, size);
if (size < MIN_PRIVATE) {
fprintf(stderr,"Private heap size out of range\n");
exit(-1);
}
break;
case 's': /* -s <size> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c]; /* shift */
size = sizearg(argv[c++]);
ec_set_option_long(EC_OPTION_SHAREDSIZE, size);
if (size < MIN_SHARED) {
fprintf(stderr,"Shared heap size out of range\n");
exit(-1);
}
break;
case 'o': /* enable oracles */
c += 1;
/* vm_options = ORACLES_ENABLED; */
break;
case '-': /* -- give the rest to Prolog */
for (; c < argc; )
argv[new_argc++] = argv[c++];
break;
default: /* unknown: error */
usage(argv[c]);
break;
}
}
else if (!strcmp(argv[c], "-debug_level"))
{
if (++c + 1 > argc) usage(argv[c-1]);
ec_set_option_int(EC_OPTION_DEBUG_LEVEL, atoi(argv[c++]));
}
else /* raise error unless preceeded by a -- option */
{
usage(argv[c]);
}
}
/*----------------------------------------------------------------
* Entry point after longjmp(reset)
*----------------------------------------------------------------*/
switch (setjmp(reset))
{
case 0: /* raw boot or -r from above */
break;
case 3: /* restore program state */
case 2:
init_flags = REINIT_SHARED|INIT_ENGINE|INIT_PRIVATE;
break;
case 4: /* restore execution state */
init_flags = REINIT_SHARED|INIT_PRIVATE;
break;
case 1: /* reset after fatal error */
default:
init_flags = INIT_ENGINE;
switch (memory_corrupted++)
{
case 0:
break;
case 1:
/* try to print a message */
memory_corrupted = 2;
fprintf(stderr,"\n*** SEPIA Fatal error: memory corrupted\n");
/* fall to */
case 2:
/* we couldn't even print the message */
exit(-1);
}
break;
}
/*
* set up our own panic function which longjumps back to reset
*/
ec_set_option_ptr(EC_OPTION_PANIC, main_panic);
ec_set_option_int(EC_OPTION_INIT, init_flags);
ec_set_option_int(EC_OPTION_ARGC, new_argc);
ec_set_option_ptr(EC_OPTION_ARGV, argv);
if (eclipsedir)
ec_set_option_ptr(EC_OPTION_ECLIPSEDIR, eclipsedir);
ec_init();
ec_post_goal(ec_term(ec_did(":",2), ec_atom(ec_did("sepia_kernel",0)),
ec_atom(ec_did("standalone_toplevel",0))));
do {
err = ec_resume();
} while (err == PYIELD);
ec_cleanup();
return err;
}
int
main(int argc, char **argv)
{
char bootfile_buf[MAX_PATH_LEN];
char * initfile = (char *) 0;
char * eclipsedir = (char *) 0;
int c, new_argc;
pword goal, module;
int err;
int init_flags = INIT_SHARED|INIT_PRIVATE|INIT_ENGINE|INIT_PROCESS;
unsigned startup_delay = 0;
int vm_options = 0;
char * session, * nsrv_hostname;
unsigned nsrv_port_number;
#ifdef PROFILE
moncontrol(0); /* disable profiling by default */
#endif
/*
* collect information from the command line
* remove some internally used arguments from the command line
*/
for (c = new_argc = 1; c < argc; )
{
if (argv[c][0] == '-' && argv[c][2] == 0) /* single char opt */
{
switch (argv[c][1])
{
case 'a': /* -a <worker> <session>
<nsrv_hostname> <nsrv_port_no> */
if (++c + 4 > argc) usage(argv[c-1]);
ec_options.parallel_worker = atoi(argv[c++]);
session = argv[c++];
nsrv_hostname = argv[c++];
nsrv_port_number = atoi(argv[c++]);
break;
case 'c': /* -c <shared_map_file> */
if (++c + 1 > argc) usage(argv[c-1]);
ec_options.mapfile = argv[c++];
ec_options.allocation = ALLOC_FIXED;
init_flags &= ~INIT_SHARED;
break;
case 'm': /* -m <shared_map_file> */
if (++c + 1 > argc) usage(argv[c-1]);
ec_options.mapfile = argv[c++];
ec_options.allocation = ALLOC_FIXED;
break;
case 'b': /* -b <bootfile> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c++]; /* shift */
break;
case 'e': /* -e <goal> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c++]; /* shift */
break;
case 'g': /* -g <size> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c]; /* shift */
ec_options.globalsize = sizearg(argv[c++]);
if (ec_options.globalsize < MIN_GLOBAL) {
ec_bad_exit("ECLiPSe: Global stack size out of range.");
}
break;
case 'd': /* -d <n> */
/* delay worker startup by <n> seconds */
if (++c + 1 > argc) usage(argv[c-1]);
startup_delay = atoi(argv[c++]);
if (startup_delay == 0)
ec_options.io_option = OWN_IO; /* every worker has its own i/o */
else
sleep(startup_delay);
break;
case 'D': /* -D <eclipsedir> */
if (++c + 1 > argc) usage(argv[c-1]);
eclipsedir = argv[c++];
break;
case 'l': /* -l <size> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c]; /* shift */
ec_options.localsize = sizearg(argv[c++]);
if (ec_options.localsize < MIN_LOCAL) {
ec_bad_exit("ECLiPSe: local stack size out of range.");
}
break;
case 'h': /* -h <size> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c]; /* shift */
ec_options.privatesize = sizearg(argv[c++]);
if (ec_options.privatesize < MIN_PRIVATE) {
ec_bad_exit("ECLiPSe: Private heap size out of range.");
}
break;
case 's': /* -s <size> */
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-1]);
argv[new_argc++] = argv[c]; /* shift */
ec_options.sharedsize = sizearg(argv[c++]);
if (ec_options.sharedsize < MIN_SHARED) {
ec_bad_exit("ECLiPSe: Shared heap size out of range.");
}
break;
case 'o': /* enable oracles */
c += 1;
vm_options = ORACLES_ENABLED;
break;
case 'p':
argv[new_argc++] = argv[c]; /* shift */
if (++c + 1 > argc) usage(argv[c-2]);
argv[new_argc++] = argv[c]; /* shift */
ec_options.option_p = atoi(argv[c++]);
break;
case '-': /* -- give the rest to Prolog */
for (; c < argc;)
argv[new_argc++] = argv[c++];
break;
default: /* unknown: error */
usage(argv[c]);
break;
}
}
else if (!strcmp(argv[c], "-debug_level"))
{
if (++c + 1 > argc) usage(argv[c-1]);
ec_options.debug_level = atoi(argv[c++]);
}
else if (!strcmp(argv[c], "-layout"))
{
int lflags = 0;
char *from = 0;
char *to = 0;
long increment = 0L;
if (++c + 1 <= argc)
lflags = (int) strtol(argv[c++], (char **) 0, 16);
if (c + 1 <= argc)
increment = strtol(argv[c++], (char **) 0, 16);
if (c + 1 <= argc)
from = (char *) strtol(argv[c++], (char **) 0, 16);
if (c + 1 <= argc)
to = (char *) strtol(argv[c++], (char **) 0, 16);
if (ec_options.allocation == ALLOC_FIXED)
mem_layout();
#ifdef HAVE_MMAP
ec_layout(lflags, from, to, increment);
#else
ec_bad_exit("ECLiPSe: The -layout scan is not supported without\nmemory mapping.");
#endif
}
else if (!strcmp(argv[c], "-norl"))
{
argv[new_argc++] = argv[c++]; /* shift */
ec_options.rl = 0;
}
else /* raise error unless preceeded by a -- option */
{
usage(argv[c]);
}
}
/*----------------------------------------------------------------
* Initialize private heap as early as possible
* (must be before setup_mps())
*----------------------------------------------------------------*/
malloc_init();
irq_lock_init(delayed_break);
/*----------------------------------------------------------------
* Init message passing system
*----------------------------------------------------------------*/
if (ec_options.parallel_worker)
{
setup_mps(ec_options.parallel_worker, session, nsrv_hostname,
nsrv_port_number, init_flags & INIT_SHARED);
}
/*----------------------------------------------------------------
* Make the connection to the shared heap, if any.
* Because of mmap problems on some machines this should
* happen AFTER initializing the message passing system.
*----------------------------------------------------------------*/
mem_init(init_flags); /* depends on -c and -m options */
/*----------------------------------------------------------------
* Init parallel scheduler etc.
*----------------------------------------------------------------*/
if (ec_options.parallel_worker)
{
parallel_init(init_flags);
}
/*----------------------------------------------------------------
* Init the low-level I/O stuff, ie the part which should
* really not be done by eclipse itself...
*----------------------------------------------------------------*/
/* char_io_init(); does not yet exist */
/*----------------------------------------------------------------
* Entry point after longjmp(reset)
*----------------------------------------------------------------*/
switch (setjmp(reset))
{
case 0: /* raw boot or -r from above */
break;
case 3: /* restore program state */
case 2:
init_flags = REINIT_SHARED|INIT_ENGINE|INIT_PRIVATE;
break;
case 4: /* restore execution state */
init_flags = REINIT_SHARED|INIT_PRIVATE;
break;
case 1: /* reset after fatal error */
default:
if (!(GlobalFlags & HEAP_READY) || ec_options.parallel_worker)
{
(void) ec_cleanup();
exit(-1);
}
init_flags = INIT_ENGINE;
switch (memory_corrupted++)
{
case 0:
break;
case 1:
/* try to print a message */
memory_corrupted = 2;
ec_bad_exit("ECLiPSe: Fatal error, memory corrupted.");
/* fall to */
case 2:
/* we couldn't even print the message */
exit(-1);
}
break;
}
/*
* set up our own panic function which longjumps back to reset
* To access command line through global variabes
*/
ec_options.user_panic = main_panic;
ec_options.Argc = new_argc;
ec_options.Argv = argv;
ec_options.eclipse_home = (char *) 0;
ec_options.init_flags = init_flags;
if (eclipsedir)
ec_options.eclipse_home = eclipsedir;
/*
* Init the global (shared) eclipse structures, dictionary, code...
* Maybe load a saved state.
* Note that we don't have an engine yet!
*/
eclipse_global_init(init_flags);
/*----------------------------------------------------------------
* Setup the Prolog engine
*----------------------------------------------------------------*/
/*
* If we have a PROG_AND_DATA saved state (execution state saved)
* we are finished and enter the emulator.
*/
if (!(init_flags & INIT_ENGINE))
{
err = restart_emulc();
(void) ec_cleanup();
exit(err);
}
/*
* Initialize the Prolog engine
*/
emu_init(init_flags, vm_options);
/*
* If we are not running an already booted eclipse,
* compile $ECLIPSEDIR/lib/kernel.eco
*/
if (init_flags & INIT_SHARED)
{
char msg[1024];
initfile = strcat(strcpy(bootfile_buf, ec_eclipse_home), "/lib/kernel.eco");
if (ec_access(initfile, R_OK) < 0)
{
sprintf(msg,
"ECLiPSe: Can't find boot file %s!\nPlease check the setting of your ECLIPSEDIR environment variable\nor use the -D <dir> command line option.",
initfile);
ec_bad_exit(msg);
}
err = eclipse_boot(initfile);
if (err != PSUCCEED)
{
(void) ec_cleanup();
exit(err);
}
}
if (init_flags & (INIT_SHARED|REINIT_SHARED))
GlobalFlags |= HEAP_READY; /* for the other workers */
goal = ec_term(ec_did("main",1), ec_long(init_flags & INIT_SHARED ? 0 : 1));
module.val.did = d_.kernel_sepia;
module.tag.kernel = ModuleTag(d_.kernel_sepia);
if (ec_options.parallel_worker <= 1) /* only or first worker */
{
err = main_emulc_noexit(goal.val, goal.tag, module.val, module.tag);
if (err == PYIELD)
{
memory_corrupted = 0; /* assume it's ok */
ec_post_goal(ec_term(ec_did(":",2), ec_atom(ec_did("sepia_kernel",0)),
ec_atom(ec_did("standalone_toplevel",0))));
do {
err = ec_resume();
} while (err == PYIELD);
}
}
else
{
err = slave_emulc();
}
ec_cleanup();
exit(err);
/*NOTREACHED*/
}