static void
workspace_link( Workspace *ws, Workspacegroup *wsg, const char *name )
{
Workspaceroot *wsr = wsg->wsr;
Symbol *sym;
#ifdef DEBUG
printf( "workspace_link: naming ws %p as %s\n", ws, name );
#endif /*DEBUG*/
sym = symbol_new_defining( wsr->sym->expr->compile, name );
ws->sym = sym;
sym->type = SYM_WORKSPACE;
sym->ws = ws;
sym->expr = expr_new( sym );
(void) compile_new( sym->expr );
symbol_made( sym );
iobject_set( IOBJECT( ws ), name, NULL );
ws->local_kitg = toolkitgroup_new( ws->sym );
g_object_ref( G_OBJECT( ws->local_kitg ) );
iobject_sink( IOBJECT( ws->local_kitg ) );
}
/* the primitive function "execute" (uptack jot) */
void ex_execute()
{
struct item* p;
int i, dim0, dim1;
char* b;
Context* thisContext;
p = fetch1();
if (p->rank > 2)
error(ERR_rank, "");
if (p->itemType != CH)
error(ERR_domain, "not a literal value");
/*get out if nothing to do, apr 2-23-77 */
if (p->size == 0)
return;
b = (char*)p->datap;
dim0 = p->rank < 2 ? 1 : p->dim[0];
dim1 = p->rank < 2 ? p->size : p->dim[1];
thisContext = (Context*)alloc(sizeof(Context));
thisContext->prev = gsip; /* setup new context */
thisContext->text = (char*)alloc(dim1 + 1);
thisContext->Mode = exec;
thisContext->sp = sp;
thisContext->suspended = 0;
gsip = thisContext;
for (i = 0; i < dim0; i++) {
copy(CH, b, gsip->text, dim1);
gsip->text[dim1] = '\n';
compile_new(1);
if (gsip->pcode != 0) {
gsip->ptr = gsip->pcode;
gsip->sp = sp;
execute();
aplfree((int*)gsip->pcode);
if (gsip->sp == sp)
ex_nilret();
}
else {
gsip = thisContext->prev; /* restore previous context */
aplfree((int*)thisContext->text);
aplfree((int*)thisContext);
error(ERR_implicit, "");
}
b += dim1;
if (i < dim0 - 1)
pop();
}
aplfree((int*)thisContext->text);
gsip = thisContext->prev; /* restore previous context */
aplfree((int*)thisContext);
p = *--sp;
pop();
*sp++ = p;
}
