static mlval ml_load_wordset(mlval wordset)
{
mlval result = load_wordset(wordset);
if(result == MLERROR)
switch(errno)
{
case ELOADNEWER:
exn_raise_string(perv_exn_ref_load, "Newer format than expected");
case ELOADOLDER:
exn_raise_string(perv_exn_ref_load, "Older format than expected");
case ELOADALIGN:
exn_raise_string(perv_exn_ref_load, "Code string of unaligned length");
case ELOADEMPTY:
exn_raise_string(perv_exn_ref_load, "Empty wordset");
default:
error("load_wordset() returned an unexpected error code %d", errno);
}
return(result);
}
static mlval ml_save_image(mlval argument)
{
mlval global, filename;
/* license_edition is a global C enum */
if ((license_edition == PERSONAL) || act_as_free) {
display_simple_message_box(
"Saving images is not enabled in the Personal edition of MLWorks");
return MLUNIT;
}
filename = FIELD(argument, 0);
image_continuation = FIELD(argument, 1);
declare_root(&filename, 1);
global = global_pack(0); /* 0 = not delivery */
declare_root(&global, 1);
{
mlval old_message_level = MLSUB(gc_message_level,0);
MLUPDATE(gc_message_level,0,MLINT(-1));
gc_collect_all();
MLUPDATE(gc_message_level,0,old_message_level);
}
argument = allocate_record(2);
FIELD(argument, 0) = filename;
FIELD(argument, 1) = global;
retract_root(&filename);
retract_root(&global);
if(image_save(argument) == MLERROR)
switch(errno)
{
case EIMPL:
exn_raise_string(perv_exn_ref_save, "Image save not implemented");
case EIMAGEWRITE:
exn_raise_string(perv_exn_ref_save, "Error writing opened image file");
case EIMAGEOPEN:
exn_raise_string(perv_exn_ref_save, "Unable to open image file");
default:
exn_raise_string(perv_exn_ref_save, "Unexpected error from image_save()");
}
argument = image_continuation;
image_continuation = MLUNIT;
return(argument);
}
static mlval ml_save_image(mlval argument)
{
mlval global, filename;
filename = FIELD(argument, 0);
image_continuation = FIELD(argument, 1);
declare_root(&filename, 1);
global = global_pack(0); /* 0 = not delivery */
declare_root(&global, 1);
{
mlval old_message_level = MLSUB(gc_message_level,0);
MLUPDATE(gc_message_level,0,MLINT(-1));
gc_collect_all();
MLUPDATE(gc_message_level,0,old_message_level);
}
argument = allocate_record(2);
FIELD(argument, 0) = filename;
FIELD(argument, 1) = global;
retract_root(&filename);
retract_root(&global);
if(image_save(argument) == MLERROR)
switch(errno)
{
case EIMPL:
exn_raise_string(perv_exn_ref_save, "Image save not implemented");
case EIMAGEWRITE:
exn_raise_string(perv_exn_ref_save, "Error writing opened image file");
case EIMAGEOPEN:
exn_raise_string(perv_exn_ref_save, "Unable to open image file");
default:
exn_raise_string(perv_exn_ref_save, "Unexpected error from image_save()");
}
argument = image_continuation;
image_continuation = MLUNIT;
return(argument);
}
/* This should raise an exception when an error occurs */
static mlval ml_load_link(mlval arg)
{
const char *filename = CSTRING(arg);
/* Maybe this should use options properly -- how are they propagated here? */
mlval mod_name = MLUNIT;
mlval result = internal_load_link(filename,&mod_name,0,1,0);
if(result == MLERROR)
switch(errno)
{
case ELOADREAD:
exn_raise_format (perv_exn_ref_load,"The loader was unable to read from the file '%s'", filename);
case ELOADOPEN:
exn_raise_format (perv_exn_ref_load,"The loader was unable to open the file '%s'", filename);
case ELOADALLOC:
exn_raise_string (perv_exn_ref_load,"The loader was unable to allocate enough memory");
case ELOADVERSION:
exn_raise_format (perv_exn_ref_load,"The file '%s' contains a module of a version the loader does not understand", filename);
case ELOADFORMAT:
exn_raise_format (perv_exn_ref_load,"The file '%s' is not in the correct loader format", filename);
case ELOADEXTERNAL:
exn_raise_format (perv_exn_ref_load,"The module in the file '%s' references an unloaded external module '%s'", filename, CSTRING(load_external));
default:
exn_raise_string (perv_exn_ref_load,"The loader returned an invalid error code.");
}
else
{
mlval pair;
declare_root (&mod_name, 0);
declare_root (&result, 0);
pair = allocate_record(2);
FIELD(pair, 0) = mod_name;
FIELD(pair, 1) = result;
retract_root (&mod_name);
retract_root (&result);
return(pair);
}
}
static mlval ml_image_table(mlval argument)
{
argument = image_table(argument);
if(argument == MLERROR)
switch(errno)
{
case EIMPL:
exn_raise_string(perv_exn_ref_save, "Image table not implemented");
case EIMAGEREAD:
exn_raise_string(perv_exn_ref_save, "Error reading opened image file");
case EIMAGEOPEN:
exn_raise_string(perv_exn_ref_save, "Unable to open image file");
default:
exn_raise_string(perv_exn_ref_save,
"Unexpected error from image_table()");
}
return(argument);
}
