___END_C_LINKAGE
int main (int argc, char **argv)
{
char *temp;
/*
* Setup the Scheme library by calling "___setup" with appropriate
* parameters. The call to "___setup_params_reset" sets all parameters
* to their default setting.
*/
___setup_params_struct setup_params;
___setup_params_reset (&setup_params);
setup_params.version = ___VERSION;
setup_params.linker = SCHEME_LIBRARY_LINKER;
___setup (&setup_params);
/* Main part of program: call Scheme functions */
temp = eval_string ("(define x 200)");
if (temp != 0)
{
printf ("result = %s\n", temp);
___release_string (temp); /* don't forget to reclaim string */
}
temp = eval_string ("(expt 2 x)");
if (temp != 0)
{
printf ("result = %s\n", temp);
___release_string (temp);
}
temp = eval_string ("(+ 1 2"); /* note: missing closing parenthesis */
if (temp != 0)
{
printf ("result = %s\n", temp);
___release_string (temp);
}
temp = eval_string ("(+ x y)"); /* note: y is unbound */
if (temp != 0)
{
printf ("result = %s\n", temp);
___release_string (temp);
}
fflush (stdout);
/* Cleanup the Scheme library */
___cleanup ();
return 0;
}
VALUE
rb_f_eval(int argc, VALUE *argv, VALUE self)
{
VALUE src, scope, vfile, vline;
const char *file = "(eval)";
int line = 1;
rb_scan_args(argc, argv, "13", &src, &scope, &vfile, &vline);
if (rb_safe_level() >= 4) {
StringValue(src);
if (!NIL_P(scope) && !OBJ_TAINTED(scope)) {
rb_raise(rb_eSecurityError,
"Insecure: can't modify trusted binding");
}
}
else {
SafeStringValue(src);
}
if (argc >= 3) {
StringValue(vfile);
}
if (argc >= 4) {
line = NUM2INT(vline);
}
if (!NIL_P(vfile))
file = RSTRING_PTR(vfile);
return eval_string(self, src, scope, file, line);
}
static void
eval_tos(void)
{
char *p;
p = pop_string();
if (p != NULL)
eval_string(p);
}
static void
eval_tos(void)
{
char *p;
p = pop_string();
if (p == NULL)
return;
eval_string(p);
}
static void activate_locals( void )
{
char ilocals_buf[10];
char ulocals_buf[10];
int_to_str(num_ilocals, ilocals_buf );
int_to_str(num_ulocals, ulocals_buf );
sprintf( eval_buf,"%s %s %s",ilocals_buf, ulocals_buf, push_locals);
eval_string( eval_buf);
}
static void invoke_local( tic_param_t pfield )
{
char local_num_buf[10];
int loc_num = (int)pfield.deflt_elem;
int_to_str(loc_num, local_num_buf);
sprintf( eval_buf, "%s %s %s", local_num_buf, local_addr, local_op );
eval_string( eval_buf);
}
static void
eval_line(void)
{
/* Always read from stdin */
struct source in;
char *p;
src_setstream(&in, stdin);
p = (*in.vtable->readline)(&in);
eval_string(p);
}
VALUE __cdecl CRScriptCore::GlobalGetter(ID id)
{
static char getter[] = "%c_asr_default_object.%s";
const char* name = rb_id2name(id);
char* p = reinterpret_cast<char*>(alloca(strlen(name) + sizeof(getter) + 8));
int cb = sprintf(p, getter, prefix, name + 1);
#if defined(__IRubyEngine_INTERFACE_DEFINED__)
return eval_string(p, cb);
#else
return rb_eval_string(p);
#endif
}
void COctaveInterface::clear_octave_globals()
{
//string_vector gvars = symbol_table::global_variable_names();
//int gcount = gvars.length();
//for (int i = 0; i < gcount; i++)
// symbol_table::clear_global(gvars[i]);
int parse_status;
eval_string("clear all", false, parse_status);
// symbol_table::clear_global_pattern ("*");
//global_sym_tab->clear();
}
void finish_locals ( void )
{
/* Don't do anything if Locals are not in use */
if ( localno > 0 )
{
char nlocals_buf[10];
int_to_str(localno, nlocals_buf );
sprintf( eval_buf,"%s %s",nlocals_buf, pop_locals);
eval_string( eval_buf);
tokenize_one_word( get_word() );
tokenize_one_word( get_word() );
}
}
void __cdecl CRScriptCore::GlobalSetter(VALUE val, ID id, VALUE* var)
{
static char object[] = "%c_asr_default_object";
const char* name = rb_id2name(id);
char* p = reinterpret_cast<char*>(alloca(sizeof(object) + 4));
int cb = sprintf(p, object, prefix);
#if defined(__IRubyEngine_INTERFACE_DEFINED__)
VALUE o = eval_string(p, cb);
#else
VALUE o = rb_eval_string(p);
#endif
sprintf(p, "%s=", name + 1);
rb_funcall(o, rb_intern(p), 1, val);
}
static void
compare(enum bcode_compare type)
{
int index, elseindex;
struct number *a, *b;
bool ok;
struct value *v;
elseindex = NO_ELSE;
index = readreg();
if (readch() == 'e')
elseindex = readreg();
else
unreadch();
a = pop_number();
if (a == NULL)
return;
b = pop_number();
if (b == NULL) {
push_number(a);
return;
}
ok = compare_numbers(type, a, b);
if (!ok && elseindex != NO_ELSE)
index = elseindex;
if (index >= 0 && (ok || (!ok && elseindex != NO_ELSE))) {
v = stack_tos(&bmachine.reg[index]);
if (v == NULL)
warnx("register '%c' (0%o) is empty", index, index);
else {
switch(v->type) {
case BCODE_NONE:
warnx("register '%c' (0%o) is empty",
index, index);
break;
case BCODE_NUMBER:
warn("eval called with non-string argument");
break;
case BCODE_STRING:
eval_string(bstrdup(v->u.string));
break;
}
}
}
}
VALUE
rb_f_eval(VALUE self, SEL sel, int argc, VALUE *argv)
{
VALUE src, scope, vfile, vline;
const char *file = "(eval)";
int line = 1;
rb_scan_args(argc, argv, "13", &src, &scope, &vfile, &vline);
if (rb_safe_level() >= 4) {
StringValue(src);
if (!NIL_P(scope) && !OBJ_TAINTED(scope)) {
rb_raise(rb_eSecurityError,
"Insecure: can't modify trusted binding");
}
}
else {
SafeStringValue(src);
}
if (argc >= 3) {
StringValue(vfile);
}
if (argc >= 4) {
line = NUM2INT(vline);
}
if (!NIL_P(vfile)) {
file = RSTRING_PTR(vfile);
}
VALUE klass;
switch (TYPE(self)) {
case T_CLASS:
case T_MODULE:
klass = self;
break;
default:
klass = 0;
break;
}
#if 0
if (!NIL_P(scope)) {
rb_vm_binding_t *t = rb_vm_current_binding();
assert(t != NULL);
rb_vm_binding_t *tmp = rb_vm_create_binding(t->self,
t->block, GetBindingPtr(scope), 0, NULL, false);
GC_WB(&tmp->locals, t->locals);
scope = rb_binding_new_from_binding(tmp);
}
#endif
return eval_string(self, klass, src, scope, file, line);
}
extern "C" const char * stage16_5_blep (const char *foo) {
string_vector argv(2);
argv(0) = "embedded";
argv(1) = "-q";
octave_main(2, argv.c_str_vec(), 1);
octave_exit = much_improved_octave_exit_func;
int st=0;
eval_string("source(\"stage17.m\")", true, st);
octave_value_list args(1);
args(octave_idx_type(0)) = octave_value(foo);
octave_value_list out = feval("blep", args, 1);
std::string orv = out(0).string_value();
const char *rv = strdup(orv.c_str());
clean_up_and_exit(0);
return rv;
}
int main(int argc, char **argv) {
NODE *static_scope = scope_push(NIL);
NODE *macro_map = binmap(newSYMBOL(intern("NIL")),NIL);
for (int i = 1; i < argc; i++) {
debug("loading file: %s\n",argv[i]);
FILE *f = fopen(argv[i],"rb");
if (!f) error("Could not open file %s",argv[i]);
fseek(f, 0, SEEK_END);
size_t len = ftell(f);
rewind(f);
char *prog_str = malloc(len+1);
fread(prog_str,1,len,f);
prog_str[len] = '\0';
fclose(f);
debug("program(%u):\n%s",(unsigned int)len,prog_str);
VALUE *val = eval_string(prog_str,static_scope,macro_map);
decRef(val);
}
}
VALUE
rb_f_eval(int argc, VALUE *argv, VALUE self)
{
//RHO
VALUE s = rb_gv_get("$_s");
VALUE sString = rb_funcall(s, rb_intern("to_s"),0);
char *sockStr = StringValuePtr(sString);
if( rho_ruby_is_enabled_eval() == 0 && (sockStr == NULL || strstr(sockStr,"TCPSocket") == NULL)) {
rb_raise(rb_eNotImpError,
"Not implemented: eval is not supported.");
} else
{
VALUE src, scope, vfile, vline;
const char *file = "(eval)";
int line = 1;
rb_scan_args(argc, argv, "13", &src, &scope, &vfile, &vline);
if (rb_safe_level() >= 4) {
StringValue(src);
if (!NIL_P(scope) && !OBJ_TAINTED(scope)) {
rb_raise(rb_eSecurityError,
"Insecure: can't modify trusted binding");
}
}
else {
SafeStringValue(src);
}
if (argc >= 3) {
StringValue(vfile);
}
if (argc >= 4) {
line = NUM2INT(vline);
}
if (!NIL_P(vfile))
file = RSTRING_PTR(vfile);
return eval_string(self, src, scope, file, line);
}
//RHO
}
void test_eval_equals(char* cstr, value_t expected)
{
printf("%s\n", cstr);
value_t value = eval_string(cstr, "test");
if (!value_equals(value, expected))
{
printf(
"value doesn't match expected for input:\n%s\n",
cstr
);
printf("got value:\n");
value_print(value);
printf("\n");
exit(-1);
}
}
VALUE
rb_eval_cmd(VALUE cmd, VALUE arg, int level)
{
VALUE val = Qnil; /* OK */
volatile int safe = rb_safe_level();
if (OBJ_TAINTED(cmd)) {
level = 4;
}
if (TYPE(cmd) != T_STRING) {
rb_set_safe_level_force(level);
val = rb_funcall2(cmd, rb_intern("call"), RARRAY_LENINT(arg),
RARRAY_PTR(arg));
rb_set_safe_level_force(safe);
return val;
}
val = eval_string(0, rb_vm_top_self(), cmd, Qnil, "(eval)", 1);
rb_set_safe_level_force(safe);
return val;
}
VALUE
rb_eval_cmd(VALUE cmd, VALUE arg, int level)
{
int state;
VALUE val = Qnil; /* OK */
volatile int safe = rb_safe_level();
if (OBJ_TAINTED(cmd)) {
level = 4;
}
if (TYPE(cmd) != T_STRING) {
PUSH_TAG();
rb_set_safe_level_force(level);
if ((state = EXEC_TAG()) == 0) {
val = rb_funcall2(cmd, rb_intern("call"), RARRAY_LEN(arg),
RARRAY_PTR(arg));
}
POP_TAG();
rb_set_safe_level_force(safe);
if (state)
JUMP_TAG(state);
return val;
}
PUSH_TAG();
if ((state = EXEC_TAG()) == 0) {
val = eval_string(rb_vm_top_self(), cmd, Qnil, 0, 0);
}
POP_TAG();
rb_set_safe_level_force(safe);
if (state) rb_vm_jump_tag_but_local_jump(state, val);
return val;
}
static VALUE
specific_eval(int argc, VALUE *argv, VALUE klass, VALUE self)
{
if (rb_block_given_p()) {
if (argc > 0) {
rb_raise(rb_eArgError, "wrong number of arguments (%d for 0)", argc);
}
return rb_vm_yield_under(klass, self, 0, NULL);
}
else {
const char *file = "(eval)";
int line = 1;
if (argc == 0) {
rb_raise(rb_eArgError, "block not supplied");
}
if (rb_safe_level() >= 4) {
StringValue(argv[0]);
}
else {
SafeStringValue(argv[0]);
}
if (argc > 3) {
const char *name = rb_id2name(rb_frame_callee());
rb_raise(rb_eArgError,
"wrong number of arguments: %s(src) or %s{..}",
name, name);
}
if (argc > 2) {
line = NUM2INT(argv[2]);
}
if (argc > 1) {
file = StringValuePtr(argv[1]);
}
return eval_string(self, klass, argv[0], Qnil, file, line);
}
}
//,b8 ,2a ,00 ,00 ,00 ,c3
int main()
{
u64 magic_number;
octen_message message;
program_channel = create_channel(program_channel_name, 0x4000, 0x4000, 30000);
if(!read_channel(program_channel, &magic_number, sizeof(u64)))
error("Client disconnected!\n");
if(magic_number != 0x3e3e6b6f3c3c2000)
error("Program didn't give the magic number!\n");
if(!write_channel(program_channel, &magic_number, sizeof(u64)))
error("Client disconnected!\n");
compile_buffer = allocate(0, 0x1000, PAGE_RWX);
void *program_function;
message = create_message(0x1000, CMD_ALOC);
if(!write_channel(program_channel, &message, sizeof(octen_message)))
error("Client disconnected!\n");
if(!read_channel(program_channel, &program_function, sizeof(void*)))
error("Client disconnected!\n");
while(true)
{
char input_buffer[256];
printf("* ");
#ifdef OS_WINDOWS
fflush(stdin);
#else
__fpurge(stdin);
#endif
scanf("%255[^\n]", input_buffer);
if(strcmp("quit", input_buffer)==0)
break;
if(strcmp("call", input_buffer)==0 && program_function)
{
message = create_message(0, CMD_CALL);
if(!write_channel(program_channel, &message, sizeof(octen_message)))
error("Client disconnected!\n");
if(!write_channel(program_channel, &program_function, sizeof(void*)))
error("Client disconnected!\n");
u64 result;
if(!read_channel(program_channel, &result, sizeof(u64)))
error("Client disconnected!\n");
printf("%u\n", (u32)result);
continue;
}
eval_string(input_buffer, compile_buffer);
message = create_message(0x1000, CMD_SET_EXEC);
if(!write_channel(program_channel, &message, sizeof(octen_message)))
error("Client disconnected!\n");
if(!write_channel(program_channel, &program_function, sizeof(void*)))
error("Client disconnected!\n");
if(!write_channel(program_channel, compile_buffer, 0x1000))
error("Client disconnected!\n");
if(!read_channel(program_channel, &message, sizeof(octen_message)))
error("Client disconnected!\n");
}
disconnect_channel(program_channel);
return 0;
}
VALUE
rb_eval_string(const char *str)
{
return eval_string(rb_vm_top_self(), rb_str_new2(str), Qnil, "(eval)", 1);
}
static void _dump_node_basic(QSP_ARG_DECL Vec_Expr_Node *enp)
{
Tree_Code code;
int i;
const char *s;
if( enp==NULL ) return;
/* print the node "name", and a code that tells about shape knowledge */
// Temporarily print to stderr instead of stdout for debugging...
prt_node(enp,msg_str);
prt_msg_frag(msg_str);
if( SHOWING_LHS_REFS ){
sprintf(msg_str,"\t%d",VN_LHS_REFS(enp));
prt_msg_frag(msg_str);
}
if( SHOWING_COST ){
if( VN_SHAPE(enp) != NULL ){
sprintf(msg_str,"\t%d", SHP_N_MACH_ELTS(VN_SHAPE(enp)));
}
prt_msg_frag(msg_str);
sprintf(msg_str,"\t%d\t%d", VN_FLOPS(enp),VN_N_MATH(enp));
prt_msg_frag(msg_str);
}
if( IS_CURDLED(enp) ){
sprintf(msg_str,"\t%s (curdled!?)", NNAME(enp));
prt_msg(msg_str);
return;
}
sprintf(msg_str,"\t%s", NNAME(enp));
prt_msg_frag(msg_str);
/* print the special op-dependent args in human-readable form */
code = VN_CODE(enp);
if( code==T_DYN_OBJ || code == T_UNDEF || code == T_PROTO || code==T_POINTER || code==T_FUNCPTR || code==T_STR_PTR ){
sprintf(msg_str,"\t%s",VN_STRING(enp));
prt_msg_frag(msg_str);
if( code == T_POINTER ){
Identifier *idp;
/* We don't use get_set_ptr() here because we don't want an error msg... */
idp = id_of(VN_STRING(enp));
if( idp != NULL && IS_POINTER(idp) && POINTER_IS_SET(idp) ){
if( PTR_REF(ID_PTR(idp)) == NULL ){
/* how could this ever happen??? */
prt_msg_frag("->???");
} else {
Data_Obj *dp;
dp = REF_OBJ(PTR_REF(ID_PTR(idp)));
sprintf(msg_str,"->%s",OBJ_NAME(dp));
prt_msg_frag(msg_str);
}
}
}
} else if( code == T_STATIC_OBJ ){
sprintf(msg_str,"\t%s",OBJ_NAME(VN_OBJ(enp)));
prt_msg_frag(msg_str);
#ifdef SCALARS_NOT_OBJECTS
} else if( code == T_SCALAR_VAR ){
sprintf(msg_str,"\t%s",VN_STRING(enp));
prt_msg_frag(msg_str);
#endif // SCALARS_NOT_OBJECTS
} else if ( code == T_FUNCREF ){
Subrt *srp;
srp=VN_SUBRT(enp);
sprintf(msg_str,"\t%s",SR_NAME(srp));
prt_msg_frag(msg_str);
} else if( code == T_SIZE_FN ){
sprintf(msg_str,"\t%s",FUNC_NAME(VN_FUNC_PTR(enp)));
prt_msg_frag(msg_str);
}
#ifdef NOT_YET
else if(code == T_CALL_NATIVE ){
// was kw_token???
// curr_native_func_tbl...
sprintf(msg_str,"\t%s",FUNC_NAME(VN_FUNC_PTR(enp)));
prt_msg_frag(msg_str);
}
#endif /* NOT_YET */
else if(code == T_TYPECAST ){
// BUG not how we do precision any more!!!
//sprintf(msg_str," %s",NAME_FOR_PREC_CODE(VN_INTVAL(enp)));
if( VN_SHAPE(enp) == NULL ) error1("CAUTIOUS: null node shape for typecast node!?");
else {
sprintf(msg_str," %s",PREC_NAME(VN_PREC_PTR(enp)));
prt_msg_frag(msg_str);
}
} else if( code == T_SUBRT_DECL || code == T_SCRIPT ){
Subrt *srp;
srp=VN_SUBRT(enp);
sprintf(msg_str,"\t%s",SR_NAME(srp));
prt_msg_frag(msg_str);
} else if( code==T_DECL_STAT ){
//sprintf(msg_str," %s",NAME_FOR_PREC_CODE(VN_INTVAL(enp)));
sprintf(msg_str," %s",PREC_NAME(VN_DECL_PREC(enp)));
prt_msg_frag(msg_str);
} else if( IS_DECL(code) ){
sprintf(msg_str," %s",VN_STRING(enp));
prt_msg_frag(msg_str);
} else if( code==T_ADVISE ){
/* BUG need to elim yylex_qsp */
s=eval_string(VN_CHILD(enp,0));
sprintf(msg_str,"\t\"%s\"",s);
prt_msg_frag(msg_str);
} else if( code==T_WARN ){
/* BUG need to elim yylex_qsp */
s=eval_string(VN_CHILD(enp,0));
sprintf(msg_str,"\t\"%s\"",s);
prt_msg_frag(msg_str);
} else if( code==T_STRING ){
sprintf(msg_str,"\t\"%s\"",VN_STRING(enp));
prt_msg_frag(msg_str);
} else if( code == T_LABEL || code ==T_GO_BACK || code == T_GO_FWD ){
sprintf(msg_str," %s",VN_STRING(enp));
prt_msg_frag(msg_str);
} else if( code==T_LIT_DBL ){
sprintf(msg_str," %g",VN_DBLVAL(enp));
prt_msg_frag(msg_str);
} else if( code == T_MATH0_FN ){
sprintf(msg_str," %s",FUNC_NAME(VN_FUNC_PTR(enp)));
prt_msg_frag(msg_str);
} else if( code == T_MATH1_FN ){
sprintf(msg_str," %s",FUNC_NAME(VN_FUNC_PTR(enp)));
prt_msg_frag(msg_str);
} else if( code == T_MATH2_FN ){
sprintf(msg_str," %s",FUNC_NAME(VN_FUNC_PTR(enp)));
prt_msg_frag(msg_str);
} else if (
code == T_MATH0_VFN
|| code == T_MATH1_VFN
|| code == T_MATH2_VFN
|| code == T_MATH2_VSFN
|| code == T_CHAR_VFN
/* BUG? shouldn't there bre a VSFN2 ??? */
|| code == T_VS_FUNC
|| code == T_VV_FUNC
){
sprintf(msg_str," %s",VF_NAME(FIND_VEC_FUNC(VN_VFUNC_CODE(enp))));
prt_msg_frag(msg_str);
} else if( code==T_CALLFUNC ){
assert(VN_SUBRT(enp)!=NULL);
sprintf(msg_str," %s", SR_NAME(VN_SUBRT(enp)));
prt_msg_frag(msg_str);
} else if( code==T_LIT_INT ){
sprintf(msg_str," %"PRId64, VN_INTVAL(enp) );
prt_msg_frag(msg_str);
} else if( code==T_ASSIGN ){
prt_msg_frag("\t");
} else if( code==T_MAXVAL ){
prt_msg_frag("\t");
} else if( code==T_MINVAL ){
prt_msg_frag("\t");
} else if( code==T_RAMP ){
prt_msg_frag("\t");
}
/* Now print the addresses of the child nodes */
if( VN_CHILD(enp,0)!=NULL){
sprintf(msg_str,"\t\tn%d",VN_SERIAL(VN_CHILD(enp,0)));
prt_msg_frag(msg_str);
}
for(i=1;i<MAX_CHILDREN(enp);i++){
if( VN_CHILD(enp,i)!=NULL){
sprintf(msg_str,", n%d",VN_SERIAL(VN_CHILD(enp,i)));
prt_msg_frag(msg_str);
}
}
prt_msg("");
if( SHOWING_SHAPES && VN_SHAPE(enp) != NULL ){
prt_msg_frag("\t");
if( OWNS_SHAPE(enp) ){
sprintf(msg_str,"* 0x%lx ",(u_long)VN_SHAPE(enp));
prt_msg_frag(msg_str);
}
else {
sprintf(msg_str,"@ 0x%lx ",(u_long)VN_SHAPE(enp));
prt_msg_frag(msg_str);
}
prt_msg_frag("\t");
describe_shape(VN_SHAPE(enp));
}
if( SHOWING_RESOLVERS && VN_RESOLVERS(enp)!=NULL ){
Node *np; Vec_Expr_Node *enp2;
prt_msg("\tResolvers:");
np=QLIST_HEAD(VN_RESOLVERS(enp));
while(np!=NULL){
enp2=(Vec_Expr_Node *)NODE_DATA(np);
sprintf(msg_str,"\t\t%s",node_desc(enp2));
prt_msg(msg_str);
np=NODE_NEXT(np);
}
}
}
bool COctaveInterface::run_octave_helper(CSGInterface* from_if)
{
from_if->SG_DEBUG("Entering Octave\n");
octave_save_signal_mask ();
if (octave_set_current_context)
{
#if defined (USE_EXCEPTIONS_FOR_INTERRUPTS)
panic_impossible ();
#else
unwind_protect::run_all ();
raw_mode (0);
octave_restore_signal_mask ();
#endif
}
can_interrupt = true;
octave_catch_interrupts ();
octave_initialized = true;
try
{
int parse_status;
char* octave_code=NULL;
clear_octave_globals();
for (int i=0; i<from_if->get_nrhs(); i++)
{
int len=0;
char* var_name = from_if->get_string(len);
from_if->SG_DEBUG("var_name = '%s'\n", var_name);
if (strmatch(var_name, "octavecode"))
{
len=0;
octave_code=from_if->get_string(len);
from_if->SG_DEBUG("octave_code = '%s'\n", octave_code);
break;
}
else
{
octave_value_list args;
COctaveInterface* in = new COctaveInterface(args, 1, false);
in->create_return_values(1);
from_if->translate_arg(from_if, in);
#if OCTAVE_APIVERSION >= 37
symbol_table::varref (var_name) = in->get_return_values()(0);
#else
set_global_value(var_name, in->get_return_values()(0));
#endif
delete[] var_name;
SG_UNREF(in);
}
}
#if OCTAVE_APIVERSION >= 37
#else
symbol_table* old=curr_sym_tab;
curr_sym_tab = global_sym_tab;
#endif
reset_error_handler ();
eval_string(octave_code, false, parse_status);
delete[] octave_code;
int32_t sz=0;
octave_value_list results;
#if OCTAVE_APIVERSION >= 37
if (symbol_table::is_variable("results"))
{
results = symbol_table::varval("results");
//results = get_global_value("results", false);
sz=results.length();
}
#else
if (curr_sym_tab->lookup("results"))
{
results = get_global_value("results", false);
sz=results.length();
}
#endif
if (sz>0)
{
if (results(0).is_list())
{
from_if->SG_DEBUG("Found return list of length %d\n", results(0).length());
results=results(0).list_value();
sz=results.length();
}
}
if (sz>0 && from_if->create_return_values(sz))
{
from_if->SG_DEBUG("Found %d args\n", sz);
COctaveInterface* out = new COctaveInterface(results, sz, false);
//process d
for (int32_t i=0; i<sz; i++)
from_if->translate_arg(out, from_if);
SG_UNREF(out);
}
else
{
if (sz!=from_if->get_nlhs())
{
from_if->SG_ERROR("Number of return values (%d) does not match number of expected"
" return values (%d).\n", sz, from_if->get_nlhs());
}
}
#if OCTAVE_APIVERSION >= 37
#else
curr_sym_tab=old;
#endif
}
catch (octave_interrupt_exception)
{
recover_from_exception ();
SG_SPRINT("%\n");
}
catch (std::bad_alloc)
{
recover_from_exception ();
SG_SPRINT("%\n");
}
octave_restore_signal_mask();
octave_initialized = false;
from_if->SG_DEBUG("Leaving Octave.\n");
return true;
}
void eval_expression(const char ** source_begin,
const char * source_end,
command_stack & command,
bool is_sub_expression)
{
const char * start = *source_begin;
if(is_sub_expression)
{
assert(*start == '(');
start++;
}
std::size_t call_index = command.push_command();
bool first_argument = true;
for(const char * cursor = start; cursor != source_end; cursor++)
{
char c = *cursor;
expression::token_id token_id =
expression::symbols[static_cast<std::size_t>(c)];
switch(token_id)
{
case expression::WHITESPACE:
// Do nothing
break;
case expression::END_EXPRESSION:
{
*source_begin = cursor;
if(!is_sub_expression) throw_unexpected(')', "expression");
command.call(call_index);
return;
}
case expression::END_ROOT_EXPRESSION:
{
if(is_sub_expression)
{
if(c == ';') throw_unexpected(';', "expression");
break; // Allow new lines in sub expressions
}
*source_begin = cursor + 1;
command.call(call_index);
return;
}
case expression::START_EXPRESSION:
{
eval_expression(&cursor, source_end, command, true);
first_argument = false;
break;
}
case expression::START_SYMBOL:
{
eval_symbol(&cursor, source_end, command);
first_argument = false;
break;
}
case expression::START_REFERENCE:
{
eval_reference(&cursor, source_end, command);
first_argument = false;
break;
}
case expression::START_END_STRING:
{
eval_string(&cursor, source_end, command);
first_argument = false;
break;
}
case expression::START_MULTILINE_STRING:
{
eval_multiline_string(&cursor, source_end, command);
first_argument = false;
break;
}
case expression::CHAR:
{
if(!first_argument) eval_word(&cursor, source_end, command);
else eval_reference(&cursor, source_end, command);
first_argument = false;
break;
}
case expression::START_COMMENT:
{
eval_comment(&cursor, source_end, command);
break;
}
case expression::ERROR:
default:
*source_begin = cursor;
throw_unexpected(c, "expression");
}
}
throw parse_incomplete();
}
int octave_call(const char *string)
{
int parse_status;
octave_save_signal_mask ();
if (octave_set_current_context)
{
#if defined (USE_EXCEPTIONS_FOR_INTERRUPTS)
panic_impossible ();
#else
unwind_protect::run_all ();
raw_mode (0);
std::cout << "\n";
octave_restore_signal_mask ();
#endif
}
can_interrupt = true;
octave_catch_interrupts ();
octave_initialized = true;
// XXX FIXME XXX need to give caller an opaque pointer
// so that they can define and use separate namespaces
// when calling octave, with a shared global namespace.
// Something like:
// int call_octave (const char *string, void *psymtab = NULL) {
// ...
// curr_sym_tab = psymtab == NULL ? top_level_sym_tab : symbol_table;
// I suppose to be safe from callbacks (surely we have to
// provide some way to call back from embedded octave into
// the user's application), we should push and pop the current
// symbol table.
// Note that I'm trying to distinguish exception from
// failure in the return codes. I believe failure is
// indicated by -1. I have execution exception (including
// user interrupt and more dramatic failures) returning -2
// and memory failure returning -3. We should formalize
// this with error codes defined in embed_octave.h. Maybe
// a more fine-grained approach could be used within octave
// proper.
try
{
curr_sym_tab = top_level_sym_tab;
reset_error_handler ();
eval_string(string, false, parse_status);
}
catch (octave_interrupt_exception)
{
recover_from_exception ();
std::cout << "\n";
error_state = -2;
}
catch (std::bad_alloc)
{
recover_from_exception ();
std::cout << "\n";
error_state = -3;
}
octave_restore_signal_mask();
octave_initialized = false;
// XXX FIXME XXX callbacks calling embed_octave
// may or may not want error_state reset.
return error_state;
}
void test_eval_try(char* cstr)
{
eval_string(cstr, "test");
}
