Changeset 323 for trunk/thune/eval.c

Show
Ignore:
Timestamp:
12/26/06 22:10:34 (2 years ago)
Author:
krobillard
Message:

Rune is now stand-alone.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • trunk/thune/eval.c

    r312 r323  
    2626 
    2727extern void uc_console_out( UThread*, UCell* ); 
    28 #ifdef UR_CONFIG_THREADS 
    29 extern void ur_threadUnlink( UThread* ); 
    30 extern UThread* ur_threadNextReady( UThread* ); 
    31 #endif 
    32  
    33  
    34 /* 
    35    There is a data stack and a control stack which share the UThread::stack 
    36    buffer.  The control stack is at the start and grows upward. 
    37    The data stack is at the end and grows downward. 
    38 */ 
    39  
    40  
    41 #define SET_BLK_PC(bn,it) \ 
    42     blkN = bn; \ 
    43     blk = ur_blockPtr( blkN ); \ 
    44     start = blk->ptr.cells; \ 
    45     pc    = start + it; \ 
    46     end   = start + blk->used 
    47  
    48  
    49 #define PUSHC_END(blkn) \ 
    50     UR_TOC->end.code = CC_END; \ 
    51     UR_TOC->end.blkN = blkn; \ 
    52     UR_C_GROW 
    53  
    54 #define POPC_END    UR_C_DEC 
    55  
    56 #define PUSHC_CELL(val) \ 
    57     *((UCell*) UR_TOC) = val; \ 
    58     UR_C_GROW 
    59  
    60 #define PUSHC_EVAL(blkn,start,pc) \ 
    61     UR_TOC->eval.code = CC_EVAL; \ 
    62     UR_TOC->eval.n    = blkn; \ 
    63     UR_TOC->eval.it   = pc - start; \ 
    64     UR_C_GROW 
    65  
    66 #define PUSHC_EVAL_RUNNING(blkn) \ 
    67     UR_TOC->eval.code = CC_EVAL_RUNNING; \ 
    68     UR_TOC->eval.n    = blkn; \ 
    69     UR_C_GROW 
    70  
    71 #define PUSHC_REDUCE(blkn) \ 
    72     UR_TOC->reduce.code = CC_REDUCE; \ 
    73     UR_TOC->reduce.cell = UR_TOS; \ 
    74     UR_TOC->reduce.n    = blkn; \ 
    75     UR_C_GROW 
    76  
    77  
    78 #define PUSHC_FUNC(loop,bod,sig,varc) \ 
    79     UR_TOC->func.code   = (loop) ? CC_FUNC_LOOP : CC_FUNC; \ 
    80     UR_TOC->func.locals = varc; \ 
    81     UR_TOC->func.bodyN  = bod; \ 
    82     UR_TOC->func.sigN   = sig; \ 
    83     UR_C_GROW 
    84  
    85 #define POPC_FUNC \ 
    86     if( UR_TOC->func.locals ) \ 
    87         UR_S_DROPN( UR_TOC->func.locals ); \ 
    88     UR_C_DEC 
    89  
    90  
    91 #define PUSHC_ITER(blkn,a,b,itSkip) \ 
    92     UR_TOC->cp.cell = a; \ 
    93     UR_C_GROW; \ 
    94     UR_TOC->iter.code = CC_ITER; \ 
    95     UR_TOC->iter.skip = itSkip; \ 
    96     UR_TOC->iter.n    = blkn; \ 
    97     UR_TOC->iter.cell = b; \ 
    98     UR_C_GROW 
    99  
    100 #define RESET_ITER(a,b) \ 
    101     b = UR_TOC->iter.cell; \ 
    102     a = UR_TOC[-1].cp.cell; \ 
    103     UR_C_GROW 
    104  
    105  
    106 // Evaluation Monitor Hook 
    107  
    108 #ifdef UR_CONFIG_EMH 
    109 #define EMH_STEP(pc,end) \ 
    110     if( ur_thread->env->monitor(UR_EMH_STEP,pc,end) ) \ 
    111         goto call_return; 
    112  
    113 #define EMH_HALT(pc,end) \ 
    114     if( ! ur_thread->env->monitor(UR_EMH_HALT,pc,end) ) \ 
    115         goto execute; 
    116 #else 
    117 #define EMH_STEP(pc,end) 
    118 #define EMH_HALT(pc,end) 
    119 #endif 
    12028 
    12129 
    … …  
    15866    blk = ur_bind( blkN, &ur_global ); 
    15967 
    160     wrdN = ur_lookup( &ur_global, UR_ATOM_URLAN_OPS ); 
     68    wrdN = ur_lookup( &ur_global, UR_ATOM_KERNEL_OPS ); 
    16169    //assert( wrdN > -1 ); 
    16270    if( wrdN > -1 ) 
    … …  
    407315 
    408316 
    409 static int _verifyTypes( UThread* ur_thread, UCell* it, UCell* dt, int count ) 
    410 { 
    411     UCell* end = it + count; 
    412     while( it != end ) 
    413     { 
    414         if( ur_is(dt, UT_DATATYPE ) ) 
    415         { 
    416             if( ! ur_verifyDatatype( it, dt ) ) 
    417             { 
    418                 UString* str; 
    419                 ur_throwErr( ur_thread, UR_EX_DATATYPE, 
    420                              "found %s at TOS-%d; expected ", 
    421                              ur_typeName( ur_type(it) ), 
    422                              count - (int) (end - it) ); 
    423                 str = ur_binPtr( UR_TOS->err.messageStr ); 
    424                 ur_toStr( dt, str, 0 ); 
    425  
    426                 //_appendTraceBlk( &UR_TOS->err, blkN, pc - start ); 
    427                 UR_CALL_OP = 0; 
    428                 return 0; 
    429             } 
    430         } 
    431         ++it; 
    432         ++dt; 
    433     } 
    434     return 1; 
    435 } 
    436  
    437  
    438317static void _appendTraceBlk( UCellError* err, int n, int it ) 
    439318{ 
    … …  
    467346 
    468347/* 
    469    Returns control code or -1 if bad code found. 
    470    Scan starts at *tocp. 
    471 */ 
    472 static int _scanControlStack( CEntry** tocp, int retMask ) 
    473 { 
    474     int cc; 
    475     CEntry* toc = *tocp; 
    476  
    477     while( 1 ) 
    478     { 
    479         cc = toc[-1].id.code; 
    480  
    481         if( (1 << cc) & retMask ) 
    482         { 
    483             *tocp = toc; 
    484             return cc; 
    485         } 
    486  
    487         switch( cc ) 
    488         { 
    489             case CC_FUNC: 
    490             case CC_FUNC_LOOP: 
    491                 toc -= CC_LEN_FUNC; 
    492                 break; 
    493  
    494             case CC_EVAL: 
    495             case CC_EVAL_RUNNING: 
    496             case CC_FOREVER: 
    497             case CC_REDUCE: 
    498                 toc -= CC_LEN_EVAL; 
    499                 break; 
    500  
    501             case CC_ITER: 
    502                 toc -= CC_LEN_ITER; 
    503                 break; 
    504  
    505             case CC_CATCH: 
    506                 toc -= CC_LEN_CATCH; 
    507                 break; 
    508  
    509             case CC_TERM: 
    510             case CC_END: 
    511                 *tocp = toc; 
    512                 return cc; 
    513  
    514             default: 
    515                 return -1; 
    516         } 
    517     } 
    518 } 
    519  
    520  
    521 extern void ur_copyCells( const UCell* src, const UCell* end, UCell* dest ); 
    522 //extern void ur_copyCellsRev( const UCell* src, UCell* dest, int n ); 
    523 extern int ur_greaterThan( const UCell*, const UCell* ); 
    524 extern int ur_lessThan( const UCell*, const UCell* ); 
    525 extern int ur_greaterOrEqual( const UCell*, const UCell* ); 
    526 extern int ur_lessOrEqual( const UCell*, const UCell* ); 
    527  
    528 #define DO_BLOCK(vp) \ 
    529     PUSHC_EVAL( blkN, start, pc ); \ 
    530     SET_BLK_PC( vp->series.n, vp->series.it ) 
    531  
    532  
    533 /* 
    534348   Returns cell pointer or zero if word does not reference a valid cell. 
    535349*/ 
    … …  
    544358        // Find function local frame i. 
    545359 
    546         CEntry* it; 
    547         CEntry* end; 
     360        LocalFrame* it; 
     361        LocalFrame* end; 
    548362 
    549363        it  = UR_LF_BEG; 
    … …  
    580394 
    581395 
    582 int ur_eval( UThread* ur_thread, UIndex blkN, UIndex si ) 
    583 { 
    584     UBlock* blk; 
    585     UCell* val; 
    586     UCell* start; 
    587     UCell* pc; 
    588     UCell* end; 
    589 #ifdef UR_CONFIG_THREADS 
    590     int insCycle = 0; 
    591 #endif 
    592  
    593     //ur_dumpBlock( blkN ); 
    594     //return; 
    595  
    596     PUSHC_END( blkN ); 
    597  
    598     blk   = ur_blockPtr( blkN ); 
    599     start = blk->ptr.cells; 
    600     pc    = start + si; 
    601     end   = start + blk->used; 
    602  
    603 execute: 
    604  
    605 #ifdef UR_CONFIG_THREADS 
    606     if( ++insCycle == 100 ) 
    607     { 
    608         if( ur_thread->nextThread != ur_thread ) 
    609         { 
    610             ur_thread->state = UR_THREAD_READY; 
    611 switch_thread: 
    612             PUSHC_EVAL( blkN, start, pc ); 
    613             ur_thread = ur_threadNextReady( ur_thread ); 
    614             if( ! ur_thread ) 
    615                 goto error; 
    616 run_thread: 
    617             UR_C_DEC; 
    618             SET_BLK_PC( UR_TOC->eval.n, UR_TOC->eval.it ); 
    619         } 
    620  
    621         insCycle = 0; 
    622     } 
    623 #endif 
    624  
    625     if( pc >= end ) 
    626         goto control; 
    627     EMH_STEP(pc, end) 
    628     val = pc++; 
    629  
    630     if( ur_is(val, UT_WORD) ) 
    631     { 
    632         val = ur_wordCell( ur_thread, val ); 
    633         if( ! val ) 
    634             goto throw_cc; 
    635         if( ur_is(val, UT_PAREN) ) 
    636             goto push_val; 
    637     } 
    638  
    639 do_val: 
    640  
    641     switch( ur_type(val) ) 
    642     { 
    643         case UT_UNSET: 
    644             --pc; 
    645 #ifdef UR_CONFIG_THREADS 
    646             if( ur_thread->nextThread != ur_thread ) 
    647             { 
    648                 ur_thread->state = UR_THREAD_BLOCKED; 
    649                 goto switch_thread; 
    650             } 
    651 #endif 
    652             _throwUnset( ur_thread, pc ); 
    653             _appendTraceBlk( &UR_TOS->err, blkN, pc - start ); 
    654             goto throw_cc; 
    655  
    656         case UT_OPCODE: 
    657             switch( ur_opcode(val) ) 
    658             { 
    659                 case OP_NOP: 
    660 #ifdef DEBUG 
    661                     val = 0;             
    662 #endif 
    663                     break; 
    664  
    665                 case OP_DROP:           // (a -- ) 
    666                     UR_S_SAFE_DROP; 
    667                     break; 
    668  
    669                 case OP_DUP:            // (a -- a a) 
    670                     UR_S_DUP; 
    671                     break; 
    672  
    673                 case OP_DUP2:           // (a b -- a b a b) 
    674                     val = UR_TOS; 
    675                     ur_copyCells( ur_s_prev(val), ur_s_next(val), 
    676                                   ur_s_next(val) ); 
    677                     UR_S_GROWN(2); 
    678                     break; 
    679  
    680                 case OP_OVER:           // (a b -- a b a) 
    681                     UR_S_GROW; 
    682                     *UR_TOS = UR_TOS[-2]; 
    683                     break; 
    684  
    685                 case OP_SWAP:           // (a b -- b a) 
    686                 { 
    687                     UCell tmp = *UR_TOS; 
    688                     *UR_TOS = UR_TOS[-1]; 
    689                     UR_TOS[-1] = tmp; 
    690                 } 
    691                     break; 
    692  
    693                 case OP_NIP:            // (a b -- b) 
    694                     UR_S_NIP; 
    695                     break; 
    696  
    697                 case OP_TUCK:           // (a b -- b a b) 
    698                 { 
    699                     UR_S_GROW; 
    700                     *UR_TOS = UR_TOS[-1]; 
    701                     UR_TOS[-1] = UR_TOS[-2]; 
    702                     UR_TOS[-2] = *UR_TOS; 
    703                 } 
    704                     break; 
    705  
    706                 case OP_ROT:            // (a b c -- b c a) 
    707                 { 
    708                     UCell tmp = UR_TOS[-2]; 
    709                     UR_TOS[-2] = UR_TOS[-1]; 
    710                     UR_TOS[-1] = *UR_TOS; 
    711                     *UR_TOS = tmp; 
    712                 } 
    713                     break; 
    714  
    715                 case OP_ROT_R:          // (a b c -- c a b) 
    716                 { 
    717                     UCell tmp = *UR_TOS; 
    718                     *UR_TOS = UR_TOS[-1]; 
    719                     UR_TOS[-1] = UR_TOS[-2]; 
    720                     UR_TOS[-2] = tmp; 
    721                 } 
    722                     break; 
    723  
    724                 case OP_DO:             // (value -- [result]) 
    725 op_do: 
    726                     val = UR_TOS; 
    727                     UR_S_DROP; 
    728                     if( ur_is(val, UT_BLOCK) ) 
    729                     { 
    730 do_block: 
    731                         DO_BLOCK( val ); 
    732                         PUSHC_EVAL_RUNNING( val->series.n ); 
    733                         goto execute; 
    734                     } 
    735                     else if( ur_is(val, UT_STRING) ) 
    736                     { 
    737                         UIndex tblkN; 
    738                         UString* str = ur_bin(val); 
    739                         if( str->used ) 
    740                         { 
    741                             tblkN = ur_tokenize( ur_thread, 
    742                                                  str->ptr.c + val->series.it, 
    743                                                  str->ptr.c + str->used, 0 ); 
    744                             if( ! tblkN ) 
    745                                 goto throw_cc; 
    746  
    747                             _infuseOpcodes( ur_thread, tblkN ); 
    748                             ur_setSeries(val, tblkN, 0); 
    749                             goto do_block; 
    750                         } 
    751                         goto execute; 
    752                     } 
    753                     else if( ur_is(val, UT_WORD) ) 
    754                     { 
    755                         val = ur_wordCell( ur_thread, val ); 
    756                         if( ! val ) 
    757                             goto throw_cc; 
    758                     } 
    759                     goto do_val; 
    760  
    761                 case OP_PROC: 
    762                 { 
    763                     int loop = 0; 
    764  
    765                     val = UR_TOS; 
    766                     if( ur_is(val, UT_LITWORD) && 
    767                         (ur_atom(val) == UR_ATOM_LOOP) ) 
    768                     { 
    769                         loop = 1; 
    770                         val = ur_s_prev(val); 
    771                         UR_S_DROP; 
    772                     } 
    773                     if( ! ur_is(val, UT_BLOCK) ) 
    774                         goto bad_opcode_type; 
    775  
    776                     ur_initType( val, UT_FUNCTION ); 
    777                     if( loop ) 
    778                         val->func.flags |= UR_FLAG_FUNC_LOOP; 
    779                     // localArgs & localVars cleared by ur_initType(). 
    780                     // bodyN = series.n 
    781                     val->func.closureN  = 0; 
    782                     val->func.sigN      = 0; 
    783                 } 
    784                     break; 
    785  
    786                 case OP_ITER:           // (series blk -- ) 
    787                     if( ur_is(UR_TOS, UT_BLOCK) && 
    788                         (ur_itLen( ur_s_prev(UR_TOS) ) > 0) ) 
    789                     { 
    790                         PUSHC_EVAL( blkN, start, pc ); 
    791                         SET_BLK_PC( UR_TOS->series.n, 
    792                                     UR_TOS->series.it ); 
    793                         PUSHC_ITER( blkN, pc, end, 
    794                                     (ur_sel(val) > 1) ? ur_sel(val) : 1 ); 
    795  
    796                         // Loop code must drop TOS. 
    797                         *UR_TOS = UR_TOS[-1];   // drop dup 
    798                     } 
    799                     else 
    800                     { 
    801                         UR_S_DROPN(2); 
    802                     } 
    803                     break; 
    804  
    805                 case OP_RECURSE: 
    806                     goto op_recurse; 
    807  
    808                 case OP_RETURN: 
    809                     goto op_return; 
    810  
    811                 case OP_THROW:          // (val -- val) 
    812                     goto op_throw; 
    813  
    814                 case OP_TRY:            // (block! block! -- ) 
    815                     //check0( UT_BLOCK ); 
    816                     //check1( UT_BLOCK ); 
    817  
    818                     PUSHC_EVAL( blkN, start, pc ); 
    819  
    820                     // Push catch block. 
    821                     UR_TOC->eval.n  = UR_TOS->series.n; 
    822                     UR_TOC->eval.it = UR_TOS->series.it; 
    823                     UR_C_GROW; 
    824  
    825                     UR_S_DROP; 
    826                     SET_BLK_PC( UR_TOS->series.n, 
    827                                 UR_TOS->series.it ); 
    828                     UR_S_DROP; 
    829  
    830                     // Save stack position. 
    831                     UR_TOC->cp.code = CC_CATCH; 
    832                     UR_TOC->cp.cell = UR_TOS; 
    833                     UR_C_GROW; 
    834                     break; 
    835  
    836                 case OP_IF_TRUE:       // (logic -- ) 
    837                     val = UR_TOS; 
    838                     if( ur_is(val, UT_NONE) || 
    839                         (ur_is(val, UT_LOGIC) && ! ur_logic(val)) ) 
    840                         goto if_skip; 
    841                     UR_S_DROP; 
    842                     break; 
    843  
    844                 case OP_IF_FALSE:      // (logic -- ) 
    845                     val = UR_TOS; 
    846                     if( ur_is(val, UT_NONE) || 
    847                         (ur_is(val, UT_LOGIC) && ! ur_logic(val)) ) 
    848                         goto if_do; 
    849 if_skip: 
    850                     if( pc != end ) 
    851                         ++pc; 
    852 if_do: 
    853                     UR_S_DROP; 
    854                     break; 
    855  
    856                 case OP_IF:            // (val val -- ) 
    857                 { 
    858                     int n; 
    859                     UR_S_DROP; 
    860                     switch( ur_sel(val) ) 
    861                     { 
    862                         case UR_ATOM_EQ: 
    863                             if( ur_equal( UR_TOS, ur_s_next(UR_TOS) ) ) 
    864                                 goto if_do; 
    865                             goto if_skip; 
    866  
    867                         case UR_ATOM_GT: 
    868                             n = ur_greaterThan( UR_TOS, ur_s_next(UR_TOS) ); 
    869                             break; 
    870  
    871                         case UR_ATOM_LT: 
    872                             n = ur_lessThan( UR_TOS, ur_s_next(UR_TOS) ); 
    873                             break; 
    874  
    875                         case UR_ATOM_NEQ: 
    876                             if( ! ur_equal( UR_TOS, ur_s_next(UR_TOS) ) ) 
    877                                 goto if_do; 
    878                             goto if_skip; 
    879  
    880                         case UR_ATOM_GTE: 
    881                             n = ur_greaterOrEqual( UR_TOS, ur_s_next(UR_TOS) ); 
    882                             break; 
    883  
    884                         case UR_ATOM_LTE: 
    885                             n = ur_lessOrEqual( UR_TOS, ur_s_next(UR_TOS) ); 
    886                             break; 
    887  
    888                         case UR_ATOM_KEEP:  // (val -- [val]) 
    889                             UR_S_GROW; 
    890                             val = UR_TOS; 
    891                             if( ur_is(val, UT_NONE) || 
    892                                 (ur_is(val, UT_LOGIC) && ! ur_logic(val)) ) 
    893                                 goto if_skip; 
    894                             goto execute; 
    895  
    896                         //case UR_ATOM_ZERO: 
    897                         //    break; 
    898                     } 
    899                     if( n == -1 ) 
    900                     { 
    901                         ur_throwErr( UR_ERR_DATATYPE, 
    902                              "Comparison requires char!/int!/decimal!" ); 
    903                         goto throw_cc; 
    904                     } 
    905                     if( n == 1 ) 
    906                         goto if_do; 
    907                 } 
    908                     goto if_skip; 
    909  
    910                 case OP_HALT: 
    911                     EMH_HALT(pc, end) 
    912                     goto halt; 
    913  
    914                 case OP_QUIT: 
    915                     goto quit; 
    916  
    917                 case OP_INCREMENT: 
    918                     if( ur_is(UR_TOS, UT_INT) ) 
    919                         ur_int(UR_TOS) += 1; 
    920                     else if( ur_is(UR_TOS, UT_DECIMAL) ) 
    921                         ur_decimal(UR_TOS) += 1.0; 
    922                     else 
    923                         goto bad_opcode_type; 
    924                     break; 
    925  
    926                 case OP_DECREMENT: 
    927                     if( ur_is(UR_TOS, UT_INT) ) 
    928                         ur_int(UR_TOS) -= 1; 
    929                     else if( ur_is(UR_TOS, UT_DECIMAL) ) 
    930                         ur_decimal(UR_TOS) -= 1.0; 
    931                     else 
    932                         goto bad_opcode_type; 
    933                     break; 
    934  
    935                 case OP_VERIFY:     // (val type -- val) 
    936                                     // (v1 v2 t1 t2 -- v1 v2) 
    937                                     // (v1 v2 v3 t1 t2 t3 -- v1 v2 v3) 
    938                                     // etc. 
    939                 { 
    940                     UCell* dt; 
    941                     int n; 
    942  
    943                     n = ur_sel(val); 
    944                     if( n < 1 ) 
    945                         n = 1; 
    946                     dt = ur_s_backN( UR_TOS, (n - 1) ); 
    947                     if( ! _verifyTypes(ur_thread, ur_s_backN(dt, n), dt, n) ) 
    948                         goto op_throw; 
    949                     UR_S_DROPN(n); 
    950                 } 
    951                     break; 
    952  
    953                 case OP_FOREVER:        // (block! -- ) 
    954                     PUSHC_EVAL( blkN, start, pc ); 
    955                     UR_TOC->eval.code = CC_FOREVER; 
    956                     UR_TOC->eval.n    = UR_TOS->series.n; 
    957                     UR_TOC->eval.it   = UR_TOS->series.it; 
    958                     UR_C_GROW; 
    959                     UR_S_DROP; 
    960                     goto control; 
    961  
    962                 //case OP_END: 
    963                 //    goto finish; 
    964  
    965                 default: 
    966                     _throwUnsetF( ur_thread, val, "an invalid opcode" ); 
    967                     goto throw_cc; 
    968             } 
    969             break; 
    970  
    971         case UT_FUNCTION: 
    972         { 
    973             int totc = val->func.localVars; 
    974  
    975             PUSHC_EVAL( blkN, start, pc ); 
    976  
    977             if( totc ) 
    978             { 
    979                 int argc = val->func.localArgs; 
    980                 int locc = totc - argc; 
    981  
    982                 UR_LF_PUSH( -val->func.sigN, UR_TOS - (argc - 1) ); 
    983  
    984                 if( argc ) 
    985                 { 
    986                     UBlock* sigBlk = ur_blockPtr( val->func.sigN ); 
    987                     if( ! _verifyTypes( ur_thread, 
    988                                         UR_TOS - (argc - 1), 
    989                                         sigBlk->ptr.cells + totc, argc ) ) 
    990                         goto op_throw; 
    991                 } 
    992  
    993                 if( locc ) 
    994                 { 
    995                     UCell* vit  = ur_s_next(UR_TOS); 
    996                     UCell* vend = vit + locc; 
    997                     do 
    998                     { 
    999                         ur_initType(vit, UT_NONE); 
    1000                         ++vit; 
    1001                     } 
    1002                     while( vit != vend ); 
    1003                     UR_TOS = vit; 
    1004                 } 
    1005                 else 
    1006                 { 
    1007                     UR_S_GROW; 
    1008                 } 
    1009  
    1010                 ur_initType(UR_TOS, UT_UNSET); 
    1011             } 
    1012  
    1013             if( val->func.closureN ) 
    1014             { 
    1015                 blk = ur_blockPtr( val->func.closureN ); 
    1016                 UR_S_GROWN( blk->used ); 
    1017                 memCpy( UR_TOS, blk->ptr.cells, 
    1018                         sizeof(UCell) * blk->used ); 
    1019             } 
    1020  
    1021             PUSHC_FUNC( val->func.flags & UR_FLAG_FUNC_LOOP, 
    1022                         val->func.bodyN, val->func.sigN, totc ); 
    1023  
    1024             SET_BLK_PC( val->func.bodyN, 0 ); 
    1025         } 
    1026             break; 
    1027  
    1028         case UT_CALL: 
    1029             val->call.addr( ur_thread, UR_TOS ); 
    1030 call_return: 
    1031             switch( UR_CALL_OP ) 
    1032             { 
    1033                 // Similar to the opcode switch cases above. 
    1034  
    1035                 case OP_DO:             // (block! -- ) 
    1036                     UR_CALL_OP = 0; 
    1037                     goto op_do; 
    1038  
    1039                 case OP_RETURN: 
    1040                     UR_CALL_OP = 0; 
    1041                     goto op_return; 
    1042  
    1043                 case OP_THROW: 
    1044                     UR_CALL_OP = 0; 
    1045                     if( ur_is(UR_TOS, UT_ERROR) ) 
    1046                     { 
    1047                         _appendTraceBlk( &UR_TOS->err, blkN, 
    1048                                          pc - start - 1 ); 
    1049                     } 
    1050                     goto op_throw; 
    1051  
    1052                 case OP_HALT: 
    1053                     UR_CALL_OP = 0; 
    1054                     goto halt; 
    1055  
    1056                 case OP_QUIT: 
    1057                     UR_CALL_OP = 0; 
    1058                     goto quit; 
    1059  
    1060                 case OP_REDUCE:         // (block! -- ) 
    1061                     UR_CALL_OP = 0; 
    1062                     DO_BLOCK( UR_TOS ); 
    1063                     PUSHC_REDUCE( UR_TOS->series.n ); 
    1064                     UR_S_DROP; 
    1065                     break; 
    1066  
    1067                 default: 
    1068                     break; 
    1069             } 
    1070             break; 
    1071  
    1072 #ifdef UR_CONFIG_DT_