#define DEBUG 0 #define DEBUGD 0 #include #include #include #include #include #include #include #include #define __USE_GNU #include #include #include "debug.h" #include "prim.h" #include #include #include /* INSERT LEXICAL ANALYSER HERE */ #include "lex.yy.c" /* FUNCTION DECLARATIONS */ void obj_display (OBJ a, long islist, int op); void atom_parse (long islist); void obj_dump (OBJ a, long islist) { obj_display (a, islist, 1); } void obj_dump_err (OBJ a, long islist) { obj_display (a, islist, 2); } /* MILLISECONDS SINCE EPOCH */ struct timeval tv; U64 mytime(void) { gettimeofday(&tv, NULL); return (U64)tv.tv_sec*1000 + (U64)tv.tv_usec/1000;} void prim_critical (void); void threader (void); void prim_thread (void); void prim_unthread (void); void prim_signal (void); void prim_msleep (void); void prim_windowsize (void); void prim_time (void); void op_null (void); void op_pair (void); void op_nop (void); void op_comb (void); void op_procedure (void); void op_push (void); void op_pushbinding (void); void op_pushreference (void); void op_setbinding (void); void op_setreference (void); void op_apply (void); void op_call (void); void op_ret (void); void op_repl (void); void op_popacc (void); void op_if (void); void op_or (void); /* USEFULL FUNCTIONS */ void parse_string (char *s) { YY_BUFFER_STATE bs = yy_scan_string(s); /* DON'T NEED TO CALL yy_switch_to_buffer */ atom_parse(0); /* RESULT IN ACC */ eofflag=0; yy_delete_buffer(bs); } char *function_desc (OBJ o) { FP fn = obj_function(o); return fn==prim_doit ? ":DOIT:" : fn==prim_quit ? ":QUIT:" : fn==prim_critical ? ":CRITICAL:" : fn==prim_thread ? ":THREAD:" : fn==prim_unthread ? ":UNTHREAD:" : fn==prim_eval ? ":EVAL:" : fn==prim_read ? ":READ:" : fn==prim_load ? ":LOAD:" : fn==prim_read_char ? ":READ_CHAR:" : fn==prim_char_readyp ? ":CHAR-READY?:" : fn==prim_write_char ? ":WRITE_CHAR:" : fn==prim_write ? ":WRITE:" : fn==prim_display ? ":DISPLAY:" : fn==prim_char_2_integer ? ":CHAR->INTEGER:" : fn==prim_char_upcase ? ":CHAR-UPCASE:" : fn==prim_integer_2_char ? ":INTEGER->CHAR:" : fn==prim_number2string ? ":NUMBER->STRING:" : fn==prim_string2number ? ":STRING->NUMBER:" : fn==prim_string ? ":STRING:" : fn==prim_string_length ? ":STRING-LENGTH:" : fn==prim_string_ref ? ":STRING-REF:" : fn==prim_string_setb ? ":STRING-SET!:" : fn==prim_add ? ":ADD:" : fn==prim_sub ? ":SUB:" : fn==prim_mul ? ":MUL:" : fn==prim_div ? ":DIV:" : fn==prim_cos ? ":COS:" : fn==prim_sin ? ":SIN:" : fn==prim_tan ? ":TAN:" : fn==prim_sqrt ? ":SQRT:" : fn==prim_quotient ? ":QUOTIENT:" : fn==prim_modulo ? ":MODULO:" : fn==prim_remainder ? ":REMAINDER:" : fn==prim_inexact2exact ? ":INEXACT->EXACT:" : fn==prim_logand ? ":LOGAND:" : fn==prim_logor ? ":LOGOR:" : fn==prim_logxor ? ":LOGXOR:" : fn==prim_not ? ":NOT:" : fn==prim_equality ? ":=:" : fn==prim_greaterthan ? ":>:" : fn==prim_greaterthanequal ? ":>=:" : fn==prim_lessthan ? ":<:" : fn==prim_lessthanequal ? ":<=:" : fn==prim_eqp ? ":EQ?:" : fn==prim_vector ? ":VECTOR:" : fn==prim_make_vector ? ":MAKE-VECTOR:" : fn==prim_vector_length ? ":VECTOR-LENGTH:" : fn==prim_vector_ref ? ":VECTOR-REF:" : fn==prim_vector_setb ? ":VECTOR-SET!:" : fn==prim_cons ? ":CONS:" : fn==prim_set_carb ? ":SET-CAR!:" : fn==prim_set_cdrb ? ":SET-CDR!:" : fn==prim_car ? ":CAR:" : fn==prim_cdr ? ":CDR:" : fn==prim_nullp ? ":NULL?:" : fn==prim_pairp ? ":PAIR?:" : fn==prim_vectorp ? ":PAIR?:" : fn==prim_symbolp ? ":SYMBOL?:" : fn==prim_portp ? ":PORT?:" : fn==prim_eof_objectp ? ":EOF-OBJECT?:" : fn==prim_random ? ":RANDOM:" : fn==prim_open_file ? ":OPEN-FILE:" : fn==prim_lock_file ? ":LOCK-FILE:" : fn==prim_unlock_file ? ":UNLOCK-FILE:" : fn==prim_tell_port ? ":TELL-FILE:" : fn==prim_seek_port ? ":SEEK-FILE:" : fn==prim_close_port ? ":CLOSE-PORT:" : fn==prim_call_cc ? ":CALL/CC:" : fn==prim_send ? ":SEND:" : fn==prim_recv ? ":RECV:" : fn==prim_open_ear ? ":OPEN-EAR:" : fn==prim_signal ? ":SIGNAL:" : fn==prim_msleep ? ":MSLEEP:" : fn==prim_windowsize ? ":WINDOWSIZE:" : fn==prim_time ? ":TIME:" : "!???!"; } /* DISPLAY AND DUMPING */ static char write_buff[80]; void write_S64 (int fd, S64 x) { sprintf (write_buff, "%lld", x); write(fd, write_buff, strlen(write_buff)); } void write_R64 (int fd, R64 x) { sprintf (write_buff, "%.14f", x); write(fd, write_buff, strlen(write_buff)); } void write_xU32 (int fd, U32 x) { sprintf (write_buff, "%x", x); write(fd, write_buff, strlen(write_buff)); } void obj_write (OBJ a, long islist, int op) { int i; char *c; switch (obj_type(a)) { case TNULL : write(op,"()", 2); break; case TNULLSTR: write(op,"\"\"", 2); break; case TNULLVEC: write(op,"#()", 3); break; case TFALSE : write(op,"#f", 2); break; case TTRUE : write(op,"#t", 2); break; case TINTEGER: write_S64(op, obj_integer(a)); break; case TREAL : write_R64(op, obj_real(a)); break; case TSTRING : write (op, "\"", 1); c = obj_symbol(a); for (i=obj_symbol_len(a); i; i--) { switch (*c) { case '\\' : write(op, "\\\\", 2); break; case '\"' : write(op, "\\\"", 2); break; case '\a' : write(op, "\\a", 2); break; case '\e' : write(op, "\\e", 2); break; case '\233' : write(op, "\\c", 2); break; case '\n' : write(op, "\\n", 2); break; case '\r' : write(op, "\\r", 2); break; case '\t' : write(op, "\\t", 2); break; default : write(op, c, 1); } c++; } write (op, "\"", 1); break; case TSYMBOL : c = obj_symbol(a); for (i=obj_symbol_len(a); i; i--) { switch (*c) { case ' ' : write(op, "\\ ", 2); break; case '(' : write(op, "\\(", 2); break; case ')' : write(op, "\\)", 2); break; case ',' : write(op, "\\,", 2); break; case '\'' : write(op, "\\'", 2); break; case '`' : write(op, "\\`", 2); break; case '#' : write(op, "\\#", 2); break; case ';' : write(op, "\\;", 2); break; case '\\' : write(op, "\\\\", 2); break; case '\"' : write(op, "\\\"", 2); break; case '\a' : write(op, "\\a", 2); break; case '\e' : write(op, "\\e", 2); break; case '\233' : write(op, "\\c", 2); break; case '\n' : write(op, "\\n", 2); break; case '\r' : write(op, "\\r", 2); break; case '\t' : write(op, "\\t", 2); break; default : write(op, c, 1); } c++; } break; case TPAIR : islist || write (op, "(", 1); obj_write(car(a), 0, op); if (is_pair(cdr(a))) { write (op, " ", 1); obj_write(cdr(a), 1, op); } else { if (cdr(a)!=null) { write (op, " ", 1); obj_write(cdr(a), 0, op); } } islist || write (op, ")", 1); break; case TVECTOR : write (op, "#(", 2); for (i=0; i", 29); } } void obj_display (OBJ a, long islist, int op) { int i; if (!a) { write(op, "#<0>", 4); return; } switch (obj_type(a)) { case TSTRING : case TSYMBOL : write(op, obj_symbol(a), obj_symbol_len(a)); break; case TNULL : write(op, "()", 2); break; case TNULLSTR: break; case TNULLVEC: write(op, "#()", 2); break; case TFALSE : write(op, "#f", 2); break; case TTRUE : write(op, "#t", 2); break; case TPRIM : write(op, function_desc(a), sizeof(function_desc(a))); break; case TSYNTAX : write(op, function_desc(a), sizeof(function_desc(a))); break; case TOPCODE : write(op, function_desc(a), sizeof(function_desc(a))); break; case TINTEGER: write_S64(op, obj_integer(a)); break; case TREAL : write_R64(op, obj_real(a)); break; // case TENV : // case TBINDING: case TPAIR : islist || write (op, "(", 1); obj_display(car(a), 0, op); if (is_pair(cdr(a))) { write (op, " ", 1); obj_display(cdr(a), 1, op); } else { if (cdr(a)!=null) { write (op, " . ", 3); obj_display(cdr(a), 0, op); } } islist || write (op, ")", 1); break; case TNOP : write(op, "#", 6); obj_display(cdr(a), 0, op); break; case TVECTOR : write (op, "#(", 2); for (i=0; i", 1); obj_display(cdr(a), 1, op); break; case TCLOSURE : write(op, "#", 1); break; case TENV : write(op, "#", 1); break; case TBINDING : write(op, "#@", 2); obj_display(car(a), 0, op); break; case TREFERENCE : write(op, "#@", 2); write_xU32(op, reference_generation(a)); write(op, ",", 1); write_xU32(op, reference_offset(a)); break; case TPUSH : write(op, "#", 1); obj_display(cdr(a), 0, op); break; case TPUSHBINDING : write(op, "#", 1); obj_display(cdr(a), 0, op); break; case TPUSHREFERENCE : write(op, "#", 1); obj_display(cdr(a), 0, op); break; case TSETBINDING : write(op, "#", 1); obj_display(cdr(a), 0, op); break; case TSETREFERENCE : write(op, "#", 1); obj_display(cdr(a), 0, op); break; case TAPPLY : write(op, "#", 1); obj_display(cdr(a), 0, op); break; case TCALL : write(op, "#", 1); obj_display(cdr(a), 0, op); break; case TCOMB : write(op, "#", 1); obj_display(cdr(a), 0, op); break; case TREPL : write(op, "#", 7); break; case TPOPACC : write(op, "#", 9); obj_display(car(a), 0, op); break; case TIF : write(op, "#", 1); obj_display(cdr(a), 0, op); write(op, ">", 1); break; case TOR : write(op, "#", 5); obj_display(car(a), 0, op); break; case TDEFINE : write(op, "#", 1); obj_display(cdr(a), 0, op); break; case TSTACK : write(op, "#", 1); write_xU32 (op, mem_stk_count(a)); write(op, "[", 1); for (i=mem_stk_count(a); i>0; i--) { obj_display(mem_stk_obj(a, i-1), 0, op); (i-1) && write(op, " ", 1); } write(op, "]", 1); break; case TPORT : write(op, "#", 6); break; case TCONTINUATION : write(op, "#", 1); write_xU32(op, obj_len(a)); write (op, "", 1); break; default : write(op, "#", 1); } } /* PARSING */ /* THIS REQUIRES THERE TO BE A STACK WITH ENOUGH SPACE IN THE STACK REGISTER */ void atom_parse (long islist) { switch (yylex()) { case 0 : eofflag=1; case TCLOSEPAREN : acc=(null); return; case TNULL : acc=(null); break; case TNULLSTR : acc=(nullstr); break; case TNULLVEC : acc=(nullvec); break; case TFALSE : acc=(false); break; case TTRUE : acc=(true); break; case TOPENPAREN : atom_parse(1); break; case TDOT : atom_parse(1); acc=car(acc);return; case TINTEGER: new_integer(strtoll(yytext, NULL, 10)); break; case TREAL : new_real(strtod(yytext, NULL)); break; case THEX : new_integer(strtoll(yytext+2,NULL,16)); break; case TBIN : new_integer(strtoll(yytext+2,NULL, 2)); break; case TSTRING : new_string(yytext+1, yyleng-2); break; case TCHAR : new_symbol("quote", 5); push(acc); new_symbol(yytext+2, 1); push(acc); push(null); new_pair(); push(acc); new_pair(); break; case TSYMBOL : new_symbol(yytext, yyleng); break; case TVECTOR : atom_parse(1); list_to_vector(); break; case TQUOTE : new_symbol("quote", 5); push(acc); atom_parse(0); push(acc); push(null); new_pair(); push(acc); new_pair(); break; case TUNQUOTE : new_symbol("unquote", 7); push(acc); atom_parse(0); push(acc); push(null); new_pair(); push(acc); new_pair(); break; case TQUASIQUOTE : new_symbol("quasiquote", 10); push(acc); atom_parse(0); push(acc); push(null); new_pair(); push(acc); new_pair(); break; } if (islist) { /* ARE WE CONSTRUCTING A LIST? */ push(acc); atom_parse(1); push(acc); new_pair(); } } /* ENV=ENVIRONMENT TO EXTEND R2=OPERAND COUNT R3=ARGUMENTS * => ACCUMULATOR=EXTENED ENV */ void env_extend (void) { U32 opcount, argcount; BPUR;DB2("ENV_EXTEND: ", r2, r3); opcount = obj_integer(r2); argcount = obj_len(r3)-1; r4 = null; if (opcount > argcount) {/* PUT .ARGS INTO LIST (ALSO GET RID OF XTRA ARGS)*/ PUR;DB(" CONSTRUCTING .ARGS LIST"); push(r4); while (opcount > argcount) {new_pair(); push(acc); opcount--;} r4=pop(); } if (mem_vec_obj(r3, argcount)) {/* INCREMENT ARGCOUNT IF .ARGS EXISTS */ opcount++; argcount++; push(r4); } if (opcount != argcount) { printf("WARNING: env_extend(): invalid argument count"); } new_vector(argcount+2); /* BINDING VALUE VECTOR */ r5=acc; mem_vec_set(r5, 0, env); mem_vec_set(r5, 1, r3); while(opcount--) { acc=pop(); mem_vec_set(r5, opcount+2, acc); } acc=r5; PUR;DB1(" NEW ENV: ", acc); obj_type_set(acc, TENV); } /* acc=symbol env=env => * compiling==0 ? |... value or sym] * : |... value or sym] acc=ref or bind or sym */ void env_lookup (int compiling) { U32 length, i, generation=0, symbol_length; char *symbol_string; BGRN;DB1("ENV_LOOKUP ", acc); symbol_string = obj_symbol(acc); symbol_length = obj_symbol_len(acc); r2 = env; /* SEARCH ALL NON-GLOBAL ENVIRONMENTS */ while (r2!=tge) { GRN;DB(" SEARCHING ENV"); r3 = env_symbols(r2); i = obj_len(r2)-2; /* ENV BINDING COUNT */ while (i--) { r4 = mem_vec_obj(r3, i); /* THE SYMBOL */ GRN;DB1(" LOOKING AT: ", r4); if (symbol_length == obj_symbol_len(r4) && !strncmp(symbol_string, obj_symbol(r4), symbol_length)) { GRN;DB1(" FOUND: ", r4); acc = env_value(r2, i); if (compiling) { push(acc); /* PUSH VALUE */ new_reference(generation, i+2); /* acc= VALUE OFFSET */ } return; } } r2 = env_parent(r2); generation++; } /* SEARCH TGE */ GRN;DB(" SEARCHING TGE"); while (r2 != null) { r1 = car(r2); if (symbol_length == obj_symbol_len(r3=car(r1)) && !strncmp(symbol_string, obj_symbol(r3), symbol_length)) { GRN;DB1(" FOUND: ", r1); acc=binding_value(r1); if (compiling) { push(acc); /* PUSH VALUE */ acc=r1; /* acc = BINDING */ } return; } r2 = cdr(r2); } GRN;DB1(" NOT FOUND: ", acc); if (compiling) { push(acc); /* PUSH SYMBOL AS VALUE */ /* acc = SYMBOL AS VALUE */ } } void make_procedure (void) { U32 count=0,i=0; RED;DB2(" make_procedure ", r2, r3); /* MUTATE ARGUMENT LIST INTO ARGUMENT VECTOR r2=operands r3=body */ for (r1=r2; is_pair(r1); r1=cdr(r1)) count++;/* COUNT ARGUMENTS (NOT .VAR) */ new_vector(count+1); if(is_symbol(r1)) mem_vec_set(acc, count, r1); /* SET .VAR ARGUMENT */ for (i=count; i--; r2=cdr(r2)) /* SET NORMAL ARGUMENTS */ mem_vec_set(acc, count-i-1, car(r2)); push(acc); push(r3); new_pair();/* (#(args).body) */ RED;DB1(" returning ", acc); } /* CLOCK INTERRUPT MECHANISM */ int interrupt=0, sigio=0, signal_pending=0; char signal_raised[256]; void catch_alarm (int s) { interrupt=1; } void catch_sigio (int s) { YEL;DB("catch_sigio()"); interrupt=1; sigio++; } void catch_signal (int s) { interrupt=1; signal_pending=1; signal_raised[s]=1; } void reset_scheduler_alarm () { interrupt=0; signal(SIGALRM, catch_alarm); ualarm(10000,0); } int critical=0; void prim_critical (void) { critical = obj_integer(r1=pop());; acc=r1; push(acc); ip=cdr(ip); } /* every so often context switch occur check for signal & raise check for waking threads and wake set next thread else wait for sleeping & recurse (interrupt might come in again) else power off */ /* SHOULD POINT AT CURRENT THREAD (EVEN THOUGH IT MIGHT HAVE BEEN REMOVED * FROM THE LIST */ void thread_next (void) { int s=0, ch; S64 t; BRED;DB(" thread_next"); if (sigio>0) { RED;DB(" sigio_pending"); if (blocked != null) { ch = fgetc(stdin); if (ch != EOF) { /* REACTIVE BLOCKED THREAD */ blocked=cdr(blocked); push(car(blocked)); push(active); new_pair(); blocked=cdr(blocked); /* NEED TO PUSH NEXT CHAR TO STACK AS RETURN VALUE */ thread=active=acc; /* BF: WHAT TO DO WHEN CHAR AVAILABLE */ acc = car(thread); mem_swap_stack(); /* RESTORE IP AND ENV */ ip=pop(); env=pop(); new_string(&ch, 1); push(acc); sigio--; interrupt=signal_pending=0; return; } } sigio--; } // BUGGY HERE, NOT HANDLING SIGNALS VERY WELL if (signal_pending) { RED;DB(" signal_pending"); while (s<256) { if (signal_raised[s]) { signal_raised[s]=0; /* FAKE AN APPLICATION BY PUSHING THE ARGUMENT (THE EXPRESSION) */ push(mem_vec_obj(signals, s)); /* AND SETTING THE ARG COUNT */ new_integer(1); RED;DB1(" pushing signal handler:", acc); /* NOW LETS THREAD IT */ threader(); } s++; } thread = active; /* SINCE NEW THREADS ARE PREPENDED */ } interrupt = signal_pending=0; while (asleep!=null && (obj_integer(car(asleep)) <= mytime())) { asleep=cdr(asleep); /* SKIP OVER WAKEUP TIME */ /* PUT AND ASSIGN THREAD BACK ON ACTIVE LIST */ push(car(asleep)); push(active); new_pair(); asleep=cdr(asleep); thread=active=acc; } thread = (thread==null) ? active : cdr(thread); if (thread == null) thread=active; /* NO MORE THREADS */ if (thread == null) if (asleep == null) { if (blocked == null) { RED;DB("quitting !poweroff!"); prim_quit(); } else { ualarm(0,0); sleep (INT_MAX); reset_scheduler_alarm(); thread_next(); return; } } else { BRED;DB(" everything asleep (wait for first thing to wake up)"); DB1("", stack); DB1("", asleep); t=(obj_integer(car(asleep)) - mytime()); if (t>0) { ualarm(0,0); /* DISABLE ALARM SO AS NOT TO DISRUPT SLEEP */ usleep(t*1000); reset_scheduler_alarm(); } thread_next(); return; } /* SET THE CURRENT STACK TO THE CURRENT THREADS' */ acc = car(thread); mem_swap_stack(); /* RESTORE IP AND ENV */ ip=pop(); env=pop(); } void context_switch(void) { BRED;DB("thread_switch "); /* SAVE ENV AND INSTRUCTION POINTER */ push(env); push(ip); thread_next(); reset_scheduler_alarm(); } void threader (void) { U32 count; BRED;DB("threader"); /* POP ARGS INTO SEQUENCE THUS CREATING (arg1 arg2 ... argn (unthread))*/ count = obj_integer(acc); /* MAKE SURE LAST EXPRESSION IN SEQUENCE IS (unthread) */ new_symbol("unthread", 8); push(acc); push(null); new_pair(); push(acc); push(null); new_pair(); r2=acc; while(count--) { push(r2); new_pair(); r2=acc; } /* CREATE NEW STACK AND SET AS CURRENT */ r3=stack; new_stack(0x8000); mem_swap_stack(); /* STUFF WITH ENV AND EXPRESSION TO EVALUATE */ push(tge); acc=r2; tree_copy(); /* COPY EXPRESSION AS IT'S COMPILED AND MUTATED */ push(acc); /* INSERT THREAD IN FRONT OF ACTIVE LIST (MUTATES ACTIVE)*/ push(stack); push(active); new_pair(); active=acc; /* SET STACK BACK */ acc=r3; mem_swap_stack(); acc=true; /* PRIM_THREAD RETURN VALUE */ } void prim_thread (void) { BRED;DB("prim_thread"); threader(); push(acc); ip=cdr(ip); } void unthread_h (void) { BRED;DB("unthread"); if (r2==null) { /* CAN THIS EVER HAPPEN? */ printf("WARNING: unthread(): nothing to unthread"); return; } if (thread==r2) mem_vec_set(r1, 1, cdr(r2)); else { r2 = cdr(r1=r2); unthread_h(); } } void prim_unthread (void) { BCYN;DB("prim_unthread"); if (thread==active) { active=cdr(active); } else { r2=cdr(r1=active); unthread_h(); } thread_next(); } void prim_signal (void) { int sig; BCYN;DB("prim_signal"); r2 = pop(); sig = obj_integer(pop()); mem_vec_set(signals, sig, r2); signal(sig, catch_signal); acc=signals; push(acc); ip=cdr(ip); } void block_current_thread (int fd) { new_integer((S64)fd); push(acc); push(stack); push(blocked); new_pair(); push(acc); new_pair(); blocked=acc; prim_unthread(); } void sleep_current_thread (S64 t) { /* IN FRONT IF IT'S LESS THAN THE REST */ if (asleep == null || t < (U64)obj_integer(car(asleep))) { new_integer((S64)t); push(acc); push(stack); push(asleep); new_pair(); push(acc); new_pair(); asleep=acc; } else { /* INSERT JUST BEFORE LARGER ENTRY */ r2 = cdr(asleep); while (cdr(r2)!=null && (U64)t > obj_integer(car(cdr(r2)))) { r2 = cdr(cdr(r2)); } new_integer((S64)t); push(acc); push(stack); push (cdr(r2)); new_pair(); push(acc); new_pair(); mem_vec_set(r2, 1, acc); } /* REMOVE THREAD FROM ACTIVE LIST */ prim_unthread(); } void prim_msleep (void) { S64 t; BCYN;DB("prim_msleep"); t = (U64)obj_integer(peek()) + mytime(); /* THE TIME (IN MSEC) WE NEED TO WAKE UP */ if (critical) { CYN;DB(" critical"); ualarm(0,0); /* DISABLE ALARM SO AS NOT TO DISRUPT SLEEP */ usleep(obj_integer(peek())); reset_scheduler_alarm(); /* LEAVE ARGUMENT ON STACK AS RETURN VALUE */ ip=cdr(ip); return; } /* ARGUMENT LEFT ON STACK TO BECOME RETURN VALUE */ /* SAVE THREADS STATE */ push(env); push(cdr(ip)); sleep_current_thread(t); } void prim_windowsize (void) { struct winsize win; BPUR;DB("primitive_windowsize"); ioctl(1, TIOCGWINSZ, &win); new_integer(win.ws_col); push(acc); new_integer(win.ws_row); push(acc); new_pair(); push(acc); ip=cdr(ip); } void prim_time (void) { BPUR;DB("primitive_time"); new_integer(mytime()); push(acc); ip=cdr(ip); } /* INITIALIZATION. MUST BE CALLED BEFORE USING THIS LIB */ void(*op[256])(void); /* ARRAY OF FUNCTION POINTERS */ void scm_init(void) { DB("SCM_INIT"); mem_init(); /* INITIALIZE MEMORY ABSTRACTION */ mem_new_static(TNULL, 4); null = acc; /* BIND IMPLEMENTATION CONSTANTS*/ mem_new_static(TNULLSTR, 0);nullstr = acc; mem_new_static(TNULLVEC, 4);nullvec = acc; mem_new_static(TFALSE, 4); false = acc; mem_new_static(TTRUE, 4); true = acc; mem_new_static(TEOF, 4); eof = acc; asleep = null; /* SLEEPING THREADS LIST */ blocked = null; /* BLOCKED THREADS LIST */ tge = null; /* THE GLOBAL ENVIRONMENT */ new_stack(0x8000); mem_swap_stack(); /* STACK AND SP NOW SET */ new_vector(0xff); signals = acc; /* INSERT THREAD (STACK) ON TO ACTIVE LIST AND SET CURRENT THREAD REGISTER */ push(stack); push(null); new_pair(); thread=active=acc; /* STUFF GLOBAL ENVIRONMENT WITH USEFULL PRIMITIVES AND SYNTAX KEYWORDS */ #define BINDP(prim,sym,len) new_symbol(sym,len),push(acc),new_prim(prim),push(acc),new_binding(),push(acc),push(tge),new_pair(),tge=acc BINDP(prim_doit, "doit", 4); BINDP(prim_quit, "quit", 4); BINDP(prim_critical, "critical", 8); BINDP(prim_thread, "thread", 6); BINDP(prim_unthread, "unthread", 8); BINDP(prim_eval, "eval", 4); BINDP(prim_read, "read", 4); BINDP(prim_load, "load", 4); BINDP(prim_read_char, "read-char", 9); BINDP(prim_char_readyp, "char-ready?", 11); BINDP(prim_write_char, "write-char", 10); BINDP(prim_write, "write", 5); BINDP(prim_display, "display", 7); BINDP(prim_char_upcase, "char-upcase", 11); BINDP(prim_char_2_integer, "char->integer", 13); BINDP(prim_integer_2_char, "integer->char", 13); BINDP(prim_number2string, "number->string", 14); BINDP(prim_string2number, "string->number", 14); BINDP(prim_string, "string", 6); BINDP(prim_string_length, "string-length", 13); BINDP(prim_string_ref, "string-ref", 10); BINDP(prim_substring, "substring", 9); BINDP(prim_string_setb, "string-set!", 11); BINDP(prim_add, "+", 1); BINDP(prim_sub, "-", 1); BINDP(prim_mul, "*", 1); BINDP(prim_div, "/", 1); BINDP(prim_cos, "cos", 3); BINDP(prim_sin, "sin", 3); BINDP(prim_tan, "tan", 3); BINDP(prim_sqrt, "sqrt", 4); BINDP(prim_quotient, "quotient", 8); BINDP(prim_modulo, "modulo", 6); BINDP(prim_remainder, "%", 1); BINDP(prim_inexact2exact, "inexact->exact", 14); BINDP(prim_logand, "logand", 6); BINDP(prim_logor, "logor", 5); BINDP(prim_logxor, "logxor", 6); BINDP(prim_not, "not", 3); BINDP(prim_equality, "=", 1); BINDP(prim_greaterthan, ">", 1); BINDP(prim_greaterthanequal, ">=", 2); BINDP(prim_lessthan, "<", 1); BINDP(prim_lessthanequal, "<=", 2); BINDP(prim_eqp, "eq?", 3); BINDP(prim_vector, "vector", 6); BINDP(prim_make_vector, "make-vector", 11); BINDP(prim_vector_length, "vector-length", 13); BINDP(prim_vector_ref, "vector-ref", 10); BINDP(prim_vector_setb, "vector-set!", 11); BINDP(prim_cons, "cons", 4); BINDP(prim_set_carb, "set-car!", 8); BINDP(prim_set_cdrb, "set-cdr!", 8); BINDP(prim_car, "car", 3); BINDP(prim_cdr, "cdr", 3); BINDP(prim_nullp, "null?", 5); BINDP(prim_pairp, "pair?", 5); BINDP(prim_vectorp, "vector?", 7); BINDP(prim_stringp, "string?", 7); BINDP(prim_symbolp, "symbol?", 7); BINDP(prim_portp, "port?", 5); BINDP(prim_eof_objectp, "eof-object?", 11); BINDP(prim_random, "random", 6); BINDP(prim_open_file, "open-file", 9); BINDP(prim_lock_file, "lock-file", 9); BINDP(prim_unlock_file, "unlock-file", 11); BINDP(prim_tell_port, "tell-port", 9); BINDP(prim_seek_port, "seek-port", 9); BINDP(prim_close_port, "close-port", 10); BINDP(prim_call_cc, "call-with-current-continuation", 30); BINDP(prim_send, "send", 4); BINDP(prim_recv, "recv", 4); BINDP(prim_open_ear, "open-ear", 8); BINDP(prim_signal, "signal", 6); BINDP(prim_msleep, "msleep", 6); BINDP(prim_windowsize, "windowsize", 10); BINDP(prim_time, "time", 4); obj_type_set(tge, TENV); op[TREPL] = op_repl; op[TNULL] = op_null; op[TPAIR] = op_pair; op[TNOP] = op_nop; op[TCOMB] = op_comb; op[TPROCEDURE] = op_procedure; op[TPUSH] = op_push; op[TSETBINDING] = op_setbinding; op[TSETREFERENCE] = op_setreference; op[TPUSHBINDING] = op_pushbinding; op[TPUSHREFERENCE] = op_pushreference; op[TAPPLY] = op_apply; op[TCALL] = op_call; op[TPOPACC] = op_popacc; op[TIF] = op_if; op[TOR] = op_or; } /** MOST OF THESE OPCODES ARE JUST A PAIR (OR MAYBE TRIO) WITH THEIR ASSOCIATED ** OPERANDS (IN THE CAR) ALONG WITH THE NEXT OPCODE (USUALLY FOUND IN THE CDR). **/ /* YEA, I HARD CODED THE READ EVAL PRINT LOOP, SO WHAT */ void op_repl (void) { BCYN;DB("op_repl: "); obj_dump(r7, 0); /* DUMP THE COMPILED EXPRESSION WE JUST EVALUATED */ obj_dump(pop(), 0);NL; /* AND IT'S VALUE */ /* RECREATE THIS CONTINUATION */ push(env); push(ip); /* PUT BACK ENV AND THIS REPL OPCODE */ /* CALL READ PRIMITIVE (SPECIFY 0 ARGS)*/ putchar('>'); new_integer(0); prim_read(); acc=pop(); if (acc==eof) { prim_quit(); } /* POWER OFF ON EOF */ /* PARSED EXPRESSION -> LIST */ push(acc); push(null); new_pair(); /* SET IP TO THIS SEQUENCE */ ip=acc; r7=acc; /* AND WE'RE OFF...op_pair WILL BE NEXT OPCODE CALLED WHERE IT'LL BE COMPILED * INTO A SEQUENCE */ } /* ACTS LIKE A RETURN OPCODE (WHICH I'M TO LAZY TO IMPLEMENT IT. IT'S NOT * REALLY NEEDED, RIGHT?) */ void op_null (void) { BCYN;DB(" op_null"); acc=pop(); ip=pop(); env=pop(); push(acc); } /* IP=SEQUENCE TO COMPILE IE: (1 (+ 1 2) #t) -> c:1 ^ c:(+ 1 2) ^ c:#t ret * EVENTUALLY: c:(+ 1 2) -> nop v:1 v:2 a:2 ret * STACK EXPECTED TO HAVE CURRENT CONTINUATION (PREVIOUS ENV AND NEXT OPCODE) */ void op_pair (void) { U32 count=0; BCYN;DB("op_pair"); r2=ip; while (1) { /* NON TAIL CALL, EXPRESSION IN A SEQUENCE */ if (is_pair(r3=cdr(r2))) { obj_type_set(r2, TCOMB); /* ASSUME COMBINATION */ push(r3); new_popacc(); /* INSERT OP-POPACC */ mem_vec_set(r2,1,acc); r2=car(cdr(r2)); /* NEXT EXPRESSION (SKIPPING OVER OP-POPACC */ /* TAIL CALL... */ } else { obj_type_set(r2, TCOMB); mem_vec_set(r2, 1, null); /* THIS IS THE RETURN OPCODE */ return; } } } void op_nop (void) { BCYN;DB("op_nop"); ip=cdr(ip); } /* R2 = LIST OF EXPRESSIONS IF EQUIVALENT PUSHED ONTO STACK */ void and_to_if (void) { BGRN;DB1("and_to_if", r2); if (r2==null) push(true); else if (!is_pair(cdr(r2))) push(car(r2)); else { new_symbol("if", 2);push(acc); push(car(r2)); r2=cdr(r2); and_to_if(); push(false); push(null); new_pair(); push(acc); new_pair(); push(acc); new_pair(); push(acc); new_pair(); push(acc); } } void listify (U32 depth, OBJ o) { U32 count=0; BCYN;DB1(" listify",o); if (is_pair(o)) { if (is_symbol(r2=car(o))) { if (!strncmp(obj_symbol(r2), "unquote", 7)) { if (!depth) { push(car(cdr(o))); return; } else { depth--; } } else if (!strncmp(obj_symbol(r2), "quasiquote", 10)) { depth++; } } new_symbol("cons", 4); push(acc); listify(depth, car(o)); listify(depth, cdr(o)); push(null); new_pair(); push(acc); new_pair(); push(acc); new_pair(); push(acc); } else { /* RETURN (quote o) */ BCYN;DB(" atom: "); new_symbol("quote", 5); push(acc); push(o); push(null); new_pair(); push(acc); new_pair(); push(acc); } return; } /* COMPILE OPERAND INTO SELF EVALUATING, SYNTAX, OR NORMAL COMBINATION */ void op_comb (void) { char *sym, done=0; U32 count=0; BCYN;DB("op_comb"); /* SELF EVALUATING */ if (!is_pair(r5=car(ip))) { BCYN;DB(" self evaluating"); if (is_symbol(acc=r5)) { env_lookup(1); if (is_binding(acc)) { BCYN;DB(" found binding"); obj_type_set(ip, TPUSHBINDING); mem_vec_set(ip, 0, acc); } else if (is_reference(acc)) { BCYN;DB(" found reference"); obj_type_set(ip, TPUSHREFERENCE); mem_vec_set(ip, 0, acc); } /* OTHERWISE DON'T COMPLE, LEAVE SYMBOL ALONE */ /* VALUE OF SYMBOL ALREADY ON STACK, WHAT A DEAL */ ip=cdr(ip); } else obj_type_set(ip, TPUSH); /* PUSH SELF EVALUATING */ return; } /* PRIMITIVE SYNTATIC EXPRESSION */ if (is_symbol(acc=car(r5))) { sym=obj_symbol(acc); if (!strncmp(sym, "if", 2)) { BCYN;DB(" syntax if"); /* CREATE comb:a if:b().c() */ push(car(cdr(r5))); push(car(cdr(cdr(r5)))); push(null); new_comb();push(acc); /* IS THERE A FALSE CLAUSE? IF NOT USE FALSE */ if (is_pair(acc=cdr(cdr(cdr(r5))))) push(car(acc)); else push(false); push(null); new_comb();push(acc); new_if();push(acc); new_comb(); done=1; } else if (!strncmp(sym, "cond", 4)) { BCYN;DB(" syntax cond"); r2=cdr(r5); while (is_pair(r2)) { DB1("---",r2); count++; new_symbol("if", 2);push(acc); push(car(car(r2))); new_symbol("begin", 5);push(acc); push(cdr(car(r2))); new_pair();push(acc); r2=cdr(r2); } DB1("stack===", stack); acc=null; while(count--) { push(acc); new_pair(); push(acc); new_pair(); push(acc); new_pair(); push(acc); push(null); new_pair(); } DB1("created:::", acc); mem_vec_set(ip, 0, car(acc)); return; } else if (!strncmp(sym, "lambda", 6)) { BCYN;DB(" syntax lambda"); r2=car(acc=cdr(r5)); /* ARGUMENTS.. */ r3=cdr(acc); /* BODY.. */ make_procedure(); /* CREATE PROCEDURE DATA */ obj_type_set(ip, TPROCEDURE); /* PUSH COMPILED PROCEDURE */ mem_vec_set(ip, 0, acc); return; } else if (!strncmp(sym, "let", 3)) { BCYN;DB(" syntax let"); r2=car(cdr(r5)); while(is_pair(r2)) { count++; push(car(car(r2))); push(car(cdr(car(r2)))); r2=cdr(r2); } r2=r3=null; while (count--) { push(r3); new_pair(); r3=acc; /* EXPRESSIONS */ push(r2); new_pair(); r2=acc; /* ARGUMENTS */ } new_symbol("lambda", 6); push(acc); push(r2); /* ARGS */ push(cdr(cdr(r5))); /* BODY */ new_pair(); push(acc); new_pair(); push(acc); push(r3); new_pair(); mem_vec_set(ip, 0, acc); return; } else if (!strncmp(sym, "set!", 4)) { BCYN;DB(" syntax set!"); /* FIND SYMBOL'S BINDING OR REFERENCE */ if (is_symbol(acc=car(cdr(r5)))) { env_lookup(1); r3=pop(); /* KEEP TRACK OF SYMBOL IN CASE OF ERROR */ } if (is_binding(acc)) { BCYN;DB(" setbinding"); push(car(cdr(cdr(r5)))); /* EXPRESSION */ push(acc); push(null); new_setbinding(); push(acc); new_comb(); } else if (is_reference(acc)) { BCYN;DB(" setreference"); push(car(cdr(cdr(r5)))); /* EXPRESSION */ push(acc); push(null); new_setreference(); push(acc); new_comb(); } else { printf("WARNING: op_comb(): unbound symbol"); push(r3); /* SYMBOL WE KEPT TRACK OF */ ip=cdr(ip); return; } done=1; } else if (!strncmp(sym, "define", 6)) { BCYN;DB(" syntax define"); if (env!=tge) { printf("WARNING: op_comb(): can't 'define' here"); push(car(cdr(r5))); /* SYMBOL */ ip=cdr(ip); } else { if (is_pair(car(cdr(r5)))) { /* PROCEDURE DEFINITION SPECIAL FORM */ BCYN;DB(" PROCEDURE DEFINTION"); r4=car(car(cdr(r5))); /* SYMBOL */ new_symbol("lambda", 6); push(acc); push(cdr(car(cdr(r5)))); /* PROCEDURE ARGUMENTS */ push(cdr(cdr(r5))); /* PROCEDURE BODY */ new_pair(); push(acc); new_pair(); push(acc); push(null); new_pair(); r6=acc; } else { BCYN;DB(" SYMBOL ASSIGNMENT"); r4=car(cdr(r5)); /* SYMBOL */ r6=cdr(cdr(r5)); /* EXPRESSION */ } /* R4 IS OVERWRITTEN BY ENV_LOOKUP ``IF'' WE START IN CHILD ENV */ /* FOR NOW, THIS ISN'T THE CASE BUT A POTENTIAL FOR A BUG */ /* DID THIS TO FREE UP R8 FOR THE SIGNAL VECTOR */ acc = r4; env_lookup(1); /* SYMBOL */ pop(); /* IGNORE VALUE */ if (is_symbol(r2=acc)) { /* KEEP TRACK OF BINDING */ BCYN;DB(" inserting empty binding"); push(r4); push(null); new_binding(); push(acc); r2=acc; /* SINCE WE'RE BUILDING (set! binding/ref ...) */ push(cdr(tge)); new_pair(); mem_vec_set(tge, 1, acc); } BCYN;DB(" mutate define=>set!"); /* MUTATE (define x ...) => (set! binding ...) */ new_symbol("set!", 4); mem_vec_set(r5, 0, acc); mem_vec_set(cdr(r5), 0, r2); /* SYMBOL */ mem_vec_set(cdr(r5), 1, r6); /* EXPRESSION */ } return; } else if (!strncmp(sym, "begin", 5)) { BCYN;DB(" syntax begin"); acc=cdr(r5); done=1; } else if (!strncmp(sym, "or", 2)) { BCYN;DB(" syntax or"); r2=cdr(r5); /* OPERANDS */ if (!is_pair(r2)) { mem_vec_set(ip, 0, false); return; } if (!is_pair(cdr(r2))) { mem_vec_set(ip, 0, car(r2)); return; } while (is_pair(cdr(r2))) { obj_type_set(r2, TCOMB); push(cdr(r2)); new_or(); mem_vec_set(r2, 1, acc); r2=car(cdr(r2)); } obj_type_set(r2, TCOMB); acc=cdr(r5); done=1; } else if (!strncmp(sym, "and", 3)) { BCYN;DB(" syntax and"); r2=cdr(r5); and_to_if(); /* CONVERT (and a .. y z) => */ acc=pop(); /* STACK GETS (if a ... (if y z #f) #f) */ BCYN;DB1(" converted to: ", acc); mem_vec_set(ip, 0, acc); return; } else if (!strncmp(sym, "quote", 5)) { obj_type_set(ip, TPUSH); mem_vec_set(ip, 0, car(cdr(r5))); return; } else if (!strncmp(sym, "quasiquote", 10)) { BCYN;DB(" syntax quasiquote"); listify(0, car(cdr(car(ip)))); BPUR;DB1(" returned", peek()); mem_vec_set(ip, 0, pop()); return; } } /* STANDARD COMBINATION */ if (!done) { /* COMPILE COMBINATION INTO comb:arg1 comb:arg2 comb:op apply:2 ret */ BCYN;DB("combination"); /* FORM OPERAND EVALUTION OPCODE */ r5=car(ip); r3=car(r5); /* OPERATOR */ while(is_pair(r4=cdr(r5))) { count++; r5=r4; obj_type_set(r5, TCOMB); } /* FORM APPLICATION OPCODES */ push(acc); /* OPERATOR */ new_integer(count);push(acc); /* OPERAND COUNT */ push(null); /* RETURN */ new_apply();push(acc); new_comb(); mem_vec_set(r5,1,acc); acc=cdr(car(ip)); } /* TO SAVE STATE OR NOT TO SAVE STATE...IT DEPENDS ON IT BEING A TAIL CALL */ if (null==cdr(ip)) { BCYN;DB(" tail call"); obj_type_set(ip, TNOP); /* TAIL CALL, NO STATE SAVED */ mem_vec_set(ip,1,acc); } else { BCYN;DB(" non-tail call"); obj_type_set(ip, TCALL); /* MAKE SURE CONTINUATION IS SAVED */ mem_vec_set(ip,0,acc); } } /* THIS IS A SEMI-COMPILED CLOSURE. A MORE EFFICIENT LAMBDA EXPRESSION WHICH * PUSHES A CLOSURE BY COMBINING IT'S CURRENT ENVIRONMENT AND STORED ARG VECTOR * AND PROCEDURE-BODY. */ void op_procedure (void) { BCYN;DB("op_procedure"); acc=car(ip); push(env); push(car(acc)); push(cdr(acc)); new_closure(); push(acc); ip=cdr(ip); } void op_push (void) { BCYN;DB("op_push"); push(car(ip)); ip=cdr(ip); } void op_setbinding (void) { BCYN;DB("op_setbinding"); mem_vec_set(car(ip), 1, peek()); /* KEEP VALUE ON STACK */ ip=cdr(ip); } void op_setreference (void) { U32 g; BCYN;DB("op_setreference"); r3=env; g = reference_generation(acc=car(ip)); while(g--) r3 = env_parent(r3); mem_vec_set(r3, reference_offset(acc), peek()); /* KEEP VALUE ON STACK */ ip=cdr(ip); } void op_pushbinding (void) { BCYN;DB("op_pushbinding"); push(binding_value(car(ip))); ip=cdr(ip); } void op_pushreference (void) { int g; BCYN;DB("op_pushreference"); g = reference_generation(r2=car(ip)); for(r3=env; g--; r3=env_parent(r3)); push(mem_vec_obj(r3, reference_offset(r2))); ip=cdr(ip); } /* THIS OPCODES OPERAND HOLDS THE ARGUMENT COUNT (WHICH ARE ALL ON THE STACK) */ void op_apply (void) { U32 count; BCYN;DB("op_apply"); acc=car(ip);/* ARGUMENT COUNT IN APPLY OPCODE ARGUMENT */ r1=pop(); /* HOPFULLY THE PRIMITIVE/CLOSURE/CONTINUATION IN QUESTION */ switch (obj_type(r1)) { case TPRIM : BCYN;DB(" primitive"); (obj_function(r1))(); /* CALL THE C FUNCTION PRIMITIVE */ return; case TCLOSURE : BCYN;DB(" closure"); r2=acc; /* OPERAND COUNT */ env=closure_env(r1); r3=closure_args(r1); /* ARGUMENTS */ ip=closure_body(r1); if (mem_vec_obj(r3, 0)) { // ONLY EXTEND IF THE ARGUMENT COUNT IS > 0 env_extend(); env=acc; } else { // POP ARGUMENTS FROM STACK (NOT USED) count = obj_integer(r2); while (count--) obj_dump(pop(), 0); } return; case TCONTINUATION : BCYN;DB(" continuation"); r2=pop(); /* VALUE BEING PASSED TO CONTINUATION */ count = obj_len(r1); memcpy(stack+sizeof(OBJ), r1, count*sizeof(OBJ)); /*MORE NAUGHTYNESS*/ sp = (OBJ*)stack + count; ip=pop(); env=pop(); push(r2); /* VALUE BEING PASSED TO CONTINUATION */ return; default : printf("WARNING: op_apply(): invalid combination opcode: "); obj_dump(r1, 0); count = obj_integer(car(ip)); /* POP OFF ARGUMENTS */ while(count--) acc=pop(); push(r1); /* RETURN THE BOGUS OPERATOR AS THE VALUE OF THIS EXPRESSION */ ip=cdr(ip); } } /* PUSHES ENV AND NEXT OPCODE */ void op_call (void){ BCYN;DB("op_call (push continuation)"); push(env); push(cdr(ip)); ip=car(ip); } void op_ret (void) { BCYN;DB("op_ret"); acc=pop(); ip=pop(); env=pop(); push(acc); } void op_popacc (void) { BCYN;DB("op_popacc"); acc=pop(); ip=car(ip); } void op_if (void) { BCYN;DB("op_if"); ip = false==pop() ? cdr(ip) : car(ip); } /* LIKE IF ONLY RETURNS PREDICATE VALUE IF TRUE */ void op_or (void) { BCYN;DB("op_or"); acc=pop(); if (false==acc) { BCYN;DB(" false"); ip=car(ip); } else { BCYN;DB(" true"); push(acc); ip=null; } } static struct termios term_orig, term; void quit (void) { tcsetattr (0, TCSANOW, &term_orig); // UNRAW exit(0); } int main (int argc, char *argv[]) { char telnetraw[] = { IAC, DONT, TELOPT_LINEMODE, 0}; char telnetecho[] = { IAC, WILL, TELOPT_ECHO, 0}; char *LOADEXP = "((load \"scm.scm\"))"; int i=0; // STORE TTY STATE tcgetattr (0, &term); term_orig = term; /* PARSE ARGUMENTS: r=raw mode anything else assumed expresion to evaluate */ while (++i < argc) { if (*argv[i]=='r') { // TELL TELNET TO GET OUT OF LINEMODE AND NOT ECHO //write (1, telnetraw, sizeof(telnetraw)); //write (1, telnetecho, sizeof(telnetecho)); // AND TELL TTY THE SAME term.c_lflag &= ~(ECHO|ICANON); tcsetattr (0, TCSANOW, &term); } else { LOADEXP = argv[i]; } } setbuf (stdout, NULL); /* DEACTIVATE OUTPUT BUFFERING */ signal (SIGIO, catch_sigio); fcntl(0, F_SETOWN, getpid()); /* SEND SIGNAL TO MY PROCESS ID */ fcntl(0, F_SETFL, O_ASYNC|O_NONBLOCK);/* SEND A SIGNAL | DON'T BLOCK */ fcntl(0, F_SETSIG, SIGIO); /* SEND THE 'SIGIO' SIGNAL */ scm_init(); /* INITIALIZE MACHINE FOR SCHEME */ reset_scheduler_alarm(); /* INITIALIZE TIMER FOR TASK SWITCHING */ env=tge; push(env); #if DEBUGD new_integer(42); obj_type_set(acc, TREPL); push(acc); ip=null; push(null); /* BOGUS RETURN VALUE */ #else parse_string("((unthread))");push(acc); parse_string(LOADEXP); ip=acc; #endif /* BEGIN INTERPRETER */ for(;;) { #if DEBUG printf("\n\e[0;1;37m");obj_dump(stack, 0); printf("\n\e[0mActive:");obj_dump(active, 0); printf("\nAsleep:");obj_dump(asleep, 0); printf("\nlocked:");obj_dump(blocked, 0); printf("\n IP:");obj_dump(ip, 0); printf("\e[0m"); #endif if (interrupt && !critical) {context_switch();} (op[obj_type(ip)])(); } }