home *** CD-ROM | disk | FTP | other *** search
- /*
- interp.c
- */
- /* Copyright (c) 1994 Christian F. Tschudin. All rights reserved.
-
- Distributed under the terms of the GNU General Public License
- version 2 of june 1991 as published by the Free Software
- Foundation, Inc.
-
- This file is part of M0.
-
- M0 is distributed in the hope that it will be useful, but WITHOUT ANY
- WARRANTY. No author or distributor accepts responsibility to anyone for
- the consequences of using it or for whether it serves any particular
- purpose or works at all, unless he says so in writing. Refer to the GNU
- General Public License for full details.
-
- Everyone is granted permission to copy, modify and redistribute M0, but
- only under the conditions described in the GNU General Public License.
- A copy of this license is supposed to have been given to you along with
- M0 so you can know your rights and responsibilities. It should be in a
- file named LICENSE. Among other things, the copyright notice and this
- notice must be preserved on all copies. */
-
- #include "l_proto.h"
- #include "o_proto.h"
-
-
- static retcode interpret();
- static retcode schedule();
-
-
- retcode
- init_interpreter(char *bin, char *lib)
- {
- byteptr startup;
- uint mlen;
- byteptr mstr;
- eindex m;
- retcode rc;
-
- startup = load_m0(bin, lib, "startup.m0");
- if (!startup)
- return ERR_IN_INIT;
- mstr = make_msgr(startup,startup,strlen((char*)startup),0,0,&mlen);
- m = str_import(0, mstr, mlen, mlen);
- rc = new_proc(m, 0);
- if (rc != OK)
- return ERR_IN_INIT;
- decref(0, m);
- rc = run();
- /* this initialisation process must terminate */
- if (rc != OK || current != 0)
- return ERR_IN_INIT;
-
- return OK;
- }
-
-
- int runable(void)
- {
- return schedule() == OK;
- }
-
-
- retcode
- run(void)
- {
- eindex err_name, err_handler;
- eindex ei;
- retcode rc;
- char *fn;
-
- if (!current || current->state != S_RUNNING)
- return IDLE;
- for(;;) {
- rc = interpret();
- if (rc==YIELD_CPU || rc==OK) {
- if (current->state == S_TERMINATED)
- remove_proc(current);
- return rc;
- }
- /* else we have an error condition */
- if (rc == ERR_NOT_IN_HALTED) {
- abort:
- current->state = S_TERMINATED;
- current->last_error = rc;
- #ifdef DEBUG
- fn = unique_filename("abrt");
- TRACE(0, printf(" ## abort: process %d dumped to file <%s>\n",
- current->pid, fn))
- TRACE(0, dump_process_to_file(fn, current))
- #endif
- remove_proc(current);
- return ABORT;
- }
- if (current->esp >= MAXESTACK)
- goto abort;
- if (dict_load(current, errorhandler_name, &err_handler) != OK)
- goto abort;
- if (rc == ERR_OSTACK_OVERFLOW || current->osp >= (MAXOSTACK-2)) {
- ei = make_array(current, current->os, current->osp);
- current->osp = 1;
- current->os[0] = ei;
- rc = ERR_OSTACK_OVERFLOW;
- }
-
- /*
- at this place we should also deal with
- an ESTACK_OVERFLOW error ...
- */
-
- /* Push the error object and the name on the operand stack */
- current->os[current->osp++] = current->err_element;
- incref(current, current->err_element);
- err_name = eaddr(current,err_name_array)->V.arr.a[rc];
- current->os[current->osp++] = err_name;
- incref(current, err_name);
- /* Push the error handling routine on the exec stack */
- ei = make_sub(current, err_handler, 0);
- eattr(current,ei) |= A_EXECUTABLE;
- current->es[current->esp++] = ei;
- }
- }
-
-
- static retcode
- schedule()
- {
- mproc p = current;
- retcode rc;
-
- if (!current)
- return IDLE;
- while ((p = p->next) != current)
- if (p->state == S_RUNNING)
- break;
- if (p->state == S_RUNNING) {
- current = p;
- TRACE(1, printf(" ## current process is now %d\n", current->pid))
- rc = OK;
- } else {
- TRACE(1, printf(" ## currently no active process\n"))
- rc = IDLE;
- }
-
- return rc;
- }
-
-
- static retcode
- interpret()
- {
- eindex ei, e;
- eptr ep;
- uint len;
- retcode rc;
-
- pop_estack:
- TRACE(5, printf("interpreter loop, pop_estack %d\n", current->esp))
-
- if (current->esp == 0 ) {
- current->state = S_TERMINATED;
- return OK;
- }
- current->esp--;
- ei = current->es[current->esp];
-
- for (;;) {
-
- TRACE(4, printf("top of interpreter loop: "))
- TRACE(4, dump_element(stdout, current, ei))
-
- ep = eaddr(current,ei);
- if (!(epattr(ep)&A_EXECUTABLE)) {
- /* push the element on the o-stack */
- if (current->osp >= MAXOSTACK)
- return ERR_OSTACK_OVERFLOW;
- current->os[current->osp] = ei;
- current->osp++;
- goto pop_estack;
- }
- switch (eptype(ep)) {
- case T_EMPTY: /* returned on end-of-string */
- decrefp(current, ei, ep);
- goto pop_estack;
- case T_ARRAY:
- TRACE(5, printf("exec array %d: %d\n",
- ei, (int) eplen(ep)))
-
- if (eplen(ep) == 0) {
- decrefp(current, ei, ep);
- goto pop_estack;
- }
- e = array_get(current, ei, 0);
- incref(current, e);
- if (etype(current,e) == T_ARRAY) {
- /* it must be a user defined procedure */
- if (current->osp >= MAXOSTACK)
- return ERR_OSTACK_OVERFLOW;
- current->os[current->osp++] = e;
- e = 0;
- }
- if (eplen(ep) == 1) {
- decrefp(current, ei, ep);
- if (!e)
- goto pop_estack;
- ei = e;
- continue;
- }
- if ((epattr(ep)&A_SUB) && eprefcnt(ep) == 1) {
- eplen(ep) -= 1;
- ep->V.sub.offset += 1;
- } else {
- eindex i = make_sub(current, ei, 1);
- if (!i) {
- current->err_element = ei;
- return ERR_OUT_OF_LOCALS;
- }
- eattr(current,i) |= epattr(ep) & A_EXECUTABLE;
- decrefp(current, ei, ep);
- ei = i;
- }
- if (e) {
- current->es[current->esp++] = ei;
- ei = e;
- }
- continue;
- case T_STRING:
- if (eplen(ep) == 0) {
- decrefp(current, ei, ep);
- goto pop_estack;
- }
- rc = str_gettoken(current, ei, &len, &e);
- if (rc != OK ) {
- current->err_element = ei;
- return rc;
- }
- if (etype(current,e) == T_EMPTY) {
- decref(current, e);
- e = 0;
- } else if (etype(current,e) == T_ARRAY) {
- /* it must be a user defined procedure */
- if (current->osp >= MAXOSTACK)
- return ERR_OSTACK_OVERFLOW;
- current->os[current->osp++] = e;
- e = 0;
- }
-
- if (len == eplen(ep)) {
- decrefp(current, ei, ep);
- if (!e)
- goto pop_estack;
- ei = e;
- continue;
- }
- if ((epattr(ep)&A_SUB) && eprefcnt(ep) == 1) {
- ep->V.sub.offset += len;
- eplen(ep) -= len;
- } else {
- eindex i = make_sub(current, ei, len);
- if (!i) {
- current->err_element = ei;
- return ERR_OUT_OF_LOCALS;
- }
- decrefp(current, ei, ep);
- ei = i;
- eattr(current,ei) |= A_EXECUTABLE;
- }
-
- if (e) {
- current->es[current->esp++] = ei;
- ei = e;
- }
- continue;
- case T_NAME:
- TRACE(5, printf("interpreter: name resultion %d\n", ei))
-
- if (dict_load(current, ei, &e) == OK) {
- decrefp(current, ei, ep);
- ep = eaddr(current,e);
- if (eptype(ep)==T_ARRAY && (epattr(ep)&A_EXECUTABLE)) {
- ei = make_sub(current, e, 0);
- eattr(current,ei) |= A_EXECUTABLE;
- } else {
- ei = e;
- incref(current,ei);
- }
- continue;
- }
- current->err_element = ei;
- return ERR_UNDEFINED;
- case T_PROC:
- rc = (ep->V.pro.fct)();
- TRACE(5,
- printf("interpreter proc: %d, rc=%d, e-top=%d\n", ei, rc, current->es[current->esp-1]))
-
- if (rc == OK) {
- decrefp(current, ei, ep);
- goto pop_estack;
- }
- if (rc == YIELD_CPU) {
- decrefp(current, ei, ep);
- } else
- current->err_element = ei;
- return rc;
- default:
- current->err_element = ei;
- return ERR_NOT_IMPLEMENTED;
- }
- }
- }
-
-
-