home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / src / vcode.d < prev    next >
Encoding:
Text File  |  1996-04-15  |  62.7 KB  |  1,474 lines
  1. #include "lispbibl.c"
  2.  
  3. #undef S
  4. #undef local
  5. #include <vcode.h>
  6.  
  7. typedef enum 
  8.   {
  9.     #define BYTECODE(code)  code,
  10.     #include "bytecode.c"
  11.     #undef BYTECODE
  12.     cod_for_broken_compilers_that_dont_like_trailing_commas
  13.   } bytecode_enum;
  14.  
  15.  
  16. #define CASE(cod) \
  17.  case cod: \
  18.  asciz_out(STRINGIFY(cod)); \
  19.  asciz_out("("); \
  20.  dez_out(cod); \
  21.  asciz_out(")\n");
  22.  
  23. static unsigned ibuffer;
  24.  
  25. struct v_reg reg_value1;
  26. struct v_reg reg_mv_count;
  27. struct v_reg reg_STACK;
  28.  
  29. struct v_reg reg_temp;
  30. struct v_reg reg_temp2;
  31.  
  32. #define LABEL_MAX 1024
  33. struct v_label label_vec[LABEL_MAX];
  34.  
  35. local setup_vcode()
  36.   {
  37.     reg_value1 = v_sym_to_phys(value1_register);
  38.     reg_STACK = v_sym_to_phys(STACK_register);
  39.     reg_mv_count = v_sym_to_phys(mv_count_register);
  40.     reg_SP = v_sum_to_phys(SP_register);
  41.     v_chg_rclass(V_UNAVAIL, V_P, V_R(reg_value1));
  42.     v_chg_rclass(V_UNAVAIL, V_P, V_R(reg_STACK));
  43.     v_chg_rclass(V_UNAVAIL, V_P, V_R(reg_SP));
  44.     v_chg_rclass(V_UNAVAIL, V_I, V_R(reg_mv_count));
  45.     v_getreg(®_temp, V_P, V_TEMP);
  46.     v_getreg(®_temp2, V_P, V_TEMP);
  47.   }
  48.  
  49. #ifdef STACK_DOWN
  50.   #define ST_off(n) (((sintP)(n))*sizeof(object*))
  51.   #define V_skipSTACK(offset) addpi(reg_STACK,reg_STACK,(sintP)(offset)*sizeof(object*))
  52. #else
  53.   #define ST_off(n) ((-1-(sintP)(n))*sizeof(object*))
  54.   #define V_skipSTACK(offset) subpi(reg_STACK,reg_STACK,(sintP)(offset)*sizeof(object*))
  55. #endif
  56. #define V_STACK(reg,offset) v_ldpi(reg,reg_STACK,SToff(offset))
  57. #define FR_off(n) SToff(n)
  58.  
  59. #ifdef SP_DOWN
  60.   #define SP_off(n) (((uintP)(n))*sizeof(object*))
  61.   #define V_skipSP(offset) addpi(reg_SP,reg_SP,(uintP)(offset)*sizeof(SPint))
  62. #else
  63.   #define SP_off(n) ((-1-(uintP)(n))*sizeof(object*))
  64.   #define V_skipSP(offset) subpi(reg_SP,reg_SP,(uintP)(offset)*sizeof(SPint))
  65. #endif
  66. #define V_SP_PTR(reg,offset) v_addpi(reg,reg_SP,SP_off(offset))
  67. #define P_off(x) ((x)*sizeof(object*))
  68.  
  69. #define operand_0() (posfixnum_to_L(Car(Cdr(code))))
  70. #define operand_1() (posfixnum_to_L(Car(Cdr(Cdr(code)))))
  71. #define operand_2() (posfixnum_to_L(Car(Cdr(Cdr(Cdr(code))))))
  72.  
  73. #define MV_COUNT_1()  v_setp(reg_mv_count,1)
  74.  
  75. local void V_reg_const (object closure,struct v_reg reg,uintL n);
  76. local void V_reg_const(closure,reg,n)
  77.   var object closure;
  78.   var struct v_reg reg;
  79.   var uintL n;
  80.   { v_setp(reg,TheCclosure(closure)->clos_consts[n]); }
  81.  
  82. local void V_reg_pushSP(struct v_reg reg);
  83. local void V_reg_pushSP(reg)
  84.   var struct v_reg reg;
  85.   {
  86.     V_SP_PTR(reg_sp,-1);
  87.     v_stpi(reg_sp,reg,0);
  88.   }
  89.  
  90. local void V_reg_popSP(struct v_reg reg);
  91. local void V_reg_popSP(reg)
  92.   var struct v_reg reg;
  93.   {
  94.     V_SP_PTR(reg,sp,0);
  95.     v_ldpi(reg,reg_sp,0);
  96.   }
  97.  
  98. local void V_reg_pushSTACK (struct v_reg reg);
  99. local void V_reg_pushSTACK(reg)
  100.   var struct v_reg reg;
  101.   {
  102.     v_addpi(reg_temp2,reg_STACK,SToff(-1));
  103.     v_stpi(reg_temp2,reg,0);
  104.   }
  105.  
  106. local void V_reg_popSTACK (struct v_reg reg);
  107. local void V_reg_popSTACK(reg)
  108.   var struct v_reg reg;
  109.   {
  110.     V_STACK(reg,0);
  111.     V_skipSTACK(1);
  112.   }
  113.  
  114. local void V_setSTACK (int offset,object val);
  115. local void V_setSTACK(offset,val)
  116.   var int offset;
  117.   var object val;
  118.   {
  119.     v_addpi(reg_temp2,reg_STACK,SToff(offset));
  120.     v_setp(reg_temp,val);
  121.     v_stpi(reg_temp2,reg_temp,0);
  122.   }
  123.  
  124. local void V_pushSTACK (object val);
  125. local void V_pushSTACK(val)
  126.   var object val;
  127.   {
  128.     V_setSTACK(-1,val);
  129.     V_skipSTACK(-1);
  130.   }
  131.  
  132. local void V_push_Symbol_value (object symbol);
  133. local void V_push_Symbol_value(symbol)
  134.   var object symbol;
  135.   {
  136.     v_setp(reg_temp,symbol);
  137.     v_ldpi(reg_temp,reg_temp,offsetof(Symbol,symvalue));
  138.     v_addpi(reg_temp2,reg_STACK,SToff(-1));
  139.     v_stpi(reg_temp2,reg_temp,0);
  140.     V_skipSTACK(-1);
  141.   }
  142.  
  143. local void set_value1 (object val);
  144. local void set_value1(val)
  145.   var object val;
  146.   {
  147.     v_setp(reg_value1,val);
  148.     MV_COUNT_1();
  149.   }
  150.  
  151.  
  152. local dynamic_frame (object STACKptr);
  153. local dynamic_frame(STACKptr)
  154.   {
  155.     return framebottomword(DYNBIND_frame_info,STACKptr);
  156.   }
  157.  
  158. local V_push_dynamic_frame (struct v_reg top_of_frame)
  159. local V_push_dynamic_frame(top_of_frame)
  160.   var struct v_reg top_of_frame;
  161.   { 
  162.     struct v_reg reg_ret;
  163.     reg_ret = v_scallv((v_vptr)dynamic_frame,"%p",top_of_frame);
  164.     v_addpi(reg_temp2,reg_STACK,SToff(-1));
  165.     v_stpi(reg_temp2,reg_temp,0);
  166.     V_skipSTACK(-1);
  167.   }
  168.  
  169. local fehler_STACK_putt (object closure);
  170. local fehler_STACK_putt(closure)
  171.   var object closure;
  172.   {
  173.     pushSTACK(closure);
  174.     //: DEUTSCH "Stack kaputt in ~"
  175.     //: ENGLISH "Corrupted STACK in ~"
  176.     //: FRANCAIS "Pile STACK corrompue dans ~"
  177.     fehler(serious_condition, GETTEXT("Corrupted STACK in ~"));
  178.   }
  179.  
  180. local unbind1 (void);
  181. local unbind1()
  182.   {
  183.     #if STACKCHECKC
  184.     if (!(mtypecode(STACK_0) == DYNBIND_frame_info))
  185.       fehler_STACK_putt();
  186.     #endif
  187.     # Variablenbindungsframe auflösen:
  188.     { # Pointer übern Frame
  189.       var reg7 object* new_STACK = topofframe(STACK_0);
  190.       var reg4 object* frame_end = STACKpointable(new_STACK);
  191.       var reg2 object* bindingptr = &STACK_1; # Beginn der Bindungen
  192.       # bindingptr läuft durch die Bindungen hoch
  193.       until (bindingptr == frame_end)
  194.         { # alten Wert zurückschreiben:
  195.           set_Symbol_value(*(bindingptr STACKop 0),*(bindingptr STACKop 1));
  196.           bindingptr skipSTACKop 2; # nächste Bindung
  197.         }
  198.       # STACK neu setzen, dadurch Frame auflösen:
  199.       setSTACK(STACK = new_STACK);
  200.     }
  201.   }
  202.  
  203. local void unbind (void);
  204. local void unbind()
  205.   { var reg8 uintC n;
  206.     U_operand(n); # n>0
  207.       {var reg2 object* FRAME = STACK;
  208.        do {
  209.          #if STACKCHECKC
  210.          if (!(mtypecode(FRAME_(0)) == DYNBIND_frame_info))
  211.            goto fehler_STACK_putt;
  212.          #endif
  213.          # Variablenbindungsframe auflösen:
  214.          { var reg7 object* new_FRAME = topofframe(FRAME_(0)); # Pointer übern Frame
  215.              var reg4 object* frame_end = STACKpointable(new_FRAME);
  216.            var reg2 object* bindingptr = &FRAME_(1); # Beginn der Bindungen
  217.            # bindingptr läuft durch die Bindungen hoch
  218.            until (bindingptr == frame_end)
  219.              { # alten Wert zurückschreiben:
  220.                set_Symbol_value(*(bindingptr STACKop 0),*(bindingptr STACKop 1));
  221.                bindingptr skipSTACKop 2; # nächste Bindung
  222.              }
  223.            FRAME = new_FRAME;
  224.         }}
  225.        until (--n == 0);
  226.        # STACK neu setzen
  227.        setSTACK(STACK = FRAME);
  228.      }
  229.   }
  230.  
  231. local boolean _atomp (object obj);
  232. local boolean _atomp(obj)
  233.   var object obj;
  234.   { return atomp(obj); }
  235.  
  236. local boolean _consp (object obj);
  237. local boolean _consp(obj)
  238.   var object obj;
  239.   { return consp(obj); }
  240.  
  241. local boolean _eq (object obj1,object obj2);
  242. local boolean _eq (obj1,obj2)
  243.   { return eq(obj1,obj2); }
  244.  
  245. local object loadv (object closure,uintC k,uintL m);
  246. local object loadv(closure,k,m)
  247.   var object closure;
  248.   var uintC k;
  249.   var uintL m;
  250.   { var reg3 uintC k = operand_0();
  251.     var reg2 uintL m = operand_1;
  252.     { var reg1 object venv = TheCclosure(closure)->clos_venv;
  253.       dotimesC(k,k, { venv = TheSvector(venv)->data[0]; });
  254.       return TheSVector(venv)->data[m];
  255.     }
  256.   }
  257.  
  258. local void *storev_adr (object closure,uintC k,uintL m);
  259. local void *storev_adr(closure,k,m)
  260.   var object closure;
  261.   var uintC k;
  262.   var uintL m;
  263.   { var reg3 object venv = TheCclosure(closure)->clos_venv;
  264.     dotimesC(k,k, { venv = TheSvector(venv)->data[0]; } );
  265.     return &TheSvector(venv)->data[m];
  266.   }
  267.  
  268. local void *const_symbol_value_adr (uintL k);
  269. local void *const_symbol_value_adr(k)
  270.   var uintL k;
  271.   { var reg3 object symbol = const_0();
  272.     return &Symbol_value(symbol);
  273.   }
  274.  
  275. local void *assign_const_symbol_value_adr (uintL k);
  276. local void *assign_const_symbol_value_adr(k)
  277.   var uintL k;
  278.   { var reg3 object symbol = const_0();
  279.     if (constantp(TheSymbol(symbol)) && noassign)
  280.       { pushSTACK(symbol);
  281.         //: DEUTSCH "Zuweisung nicht möglich auf das konstante Symbol ~"
  282.         //: ENGLISH "assignment to constant symbol ~ is impossible"
  283.         //: FRANCAIS "Une assignation du symbôle constant ~ n'est pas possible."
  284.         fehler(error, GETTEXT("assignment to constant symbol ~ is impossible"));
  285.       }
  286.     return &Symbol_value(symbol);
  287.   }
  288.  
  289. local uintL lookup_label_index (object code_vector,object label_sym);
  290. local uintL lookup_label_index(code_data_vector,label_sym)
  291.   var object code_vector;     
  292.   var object label_sym;
  293.   {
  294.     var reg1 object *code_data_vector;
  295.     var reg2 uintL label_index;
  296.     var reg3 uintL i;
  297.     var reg4 uintL code_count;
  298.  
  299.     code_count = TheSvector(code_vector)->length;
  300.     code_data_vector = &TheSvector(code_vector)->data[0];
  301.     label_index=0;
  302.     for (i=0;i<code_count;i++)
  303.       { if (eq(label_sym,code_data_vector[i])) return label_index;
  304.         if (symbolp(code_data_vector[i])) label_index++;
  305.       }
  306.     pushSTACK(label_sym);
  307.     //: DEUTSCH "Label ~ not found"
  308.     //: ENGLISH "Label ~ not found"
  309.     //: FRANCAIS "Label ~ not found"
  310.     fehler(error,GETTEXT("Label ~ not found"));
  311.   }
  312.  
  313. local v_label lookup_label (object code_vector,object labelsym);
  314. local v_label lookup_label(code_vector,labelsym)
  315.   var object labelsym;
  316.   { return label_vec[lookup_label_index(code_vector,labelsym)]; }
  317.  
  318.  
  319. v_label label_for_jmphash (object closure,object code_vector,uintL code_pos,uintL const_n,object key)
  320. v_label label_for_jmphash (closure,code_data_vector,code_pos,const_n,key)
  321.   var object closure;
  322.   var object code_vector;
  323.   var uintL code_pos;
  324.   var uintL const_n;
  325.   var object key;
  326.   { 
  327.     var reg1 object hashvalue = gethash(key,TheCclosure(closure)->clos_consts[const_n]);
  328.     var reg2 object *code_data_vector = &TheSvector(code_vector)->data[0];
  329.     var reg3 object code = code_data_vector[code_pos];
  330.     var reg4 object nohash_sym = Cdr(Cdr(code));
  331.     
  332.     if (eq(hashvalue,nullobj))
  333.       return lookup_label(nohash_sym);
  334.     code_pos += fixnum_to_L(hashvalue);
  335.     code = code_data_vector[code_pos];
  336.     return lookup_code_data_vector[code];
  337.   }
  338.  
  339. v_label label_for_jmphashv (object closure,object code_vector,uintL code_pos,uintL vec_n,object key);
  340. v_label label_for_jmphashv(closure,code_data_vector,code_pos,vec_n,key)
  341.   var object closure;
  342.   var object code_vector;
  343.   var uintL code_pos;
  344.   var uintL vec_n;
  345.   var object key;
  346.   { 
  347.     var reg1 object hashvalue = gethash(key,TheCclosure(closure)->clos_consts[0]->data[n]);
  348.     var reg2 object *code_data_vector = &TheSvector(code_vector)->data[0];
  349.     var reg3 object code = code_data_vector[code_pos];
  350.     var reg4 object nohash_sym = Car(Cdr(Cdr(code)));
  351.     
  352.     if (eq(hashvalue,nullobj))
  353.       return lookup_label(nohash_sym);
  354.     code_pos += fixnum_to_L(hashvalue);
  355.     code = code_data_vector[code_pos];
  356.     return lookup_code_data_vector[code];
  357.   }
  358.  
  359. local v_label jmptail (object code,uintL m,uintL n);
  360. local v_label jmptail(labelsym,m,n)
  361.   var object labelsym;
  362.   var uintL m;
  363.   var uintL n;
  364.   {
  365.     # Es gilt n>=m. m Stackeinträge um n-m nach oben kopieren:
  366.     var reg4 object* ptr1 = STACK STACKop m;
  367.     var reg2 object* ptr2 = STACK STACKop n;
  368.     var reg6 uintC count;
  369.     dotimesC(count,m, { NEXT(ptr2) = NEXT(ptr1); } );
  370.     # Nun ist ptr1 = STACK und ptr2 = STACK STACKop (n-m).
  371.     # *(closureptr = &NEXT(ptr2)) = closure; # Closure im Stack ablegen
  372.     setSTACK(STACK = ptr2); # STACK verkürzen
  373.     return lookup_label(labelsym);
  374.   }
  375.  
  376. local void make_vector1_push (uintL n,object val);
  377. local void make_vector1_push(n,val)
  378.   var uintL n;
  379.   var object val;
  380.   {
  381.     var object vec;
  382.     pushSTACK(val);
  383.     vec = allocate_vector(n+1);
  384.     TheSvector(vec)->data[0]=STACK_0;
  385.     STACK_0 = vec;
  386.   }
  387.  
  388. local void copy_closure (object closure,uintL m,uintL n);
  389. local void copy_closure(closure,m,n)
  390.   var object closure;
  391.   var uintL m;
  392.   var uintL n;
  393.   { var reg9 object old;
  394.     # zu kopierende Closure holen:
  395.     old = TheCclosure(closure)->clos_consts[m];
  396.     # Closure gleicher Länge allozieren:
  397.     {var reg8 object new;
  398.      pushSTACK(old);
  399.      new = allocate_srecord(0,Rectype_Closure,TheCclosure(old)->reclength,closure_type);
  400.      old = popSTACK();
  401.      # Inhalt der alten in die neue Closure kopieren:
  402.      { var reg2 object* newptr = &((Srecord)TheCclosure(new))->recdata[0];
  403.        var reg4 object* oldptr = &((Srecord)TheCclosure(old))->recdata[0];
  404.        var reg6 uintC count;
  405.        dotimespC(count,((Srecord)TheCclosure(old))->reclength,
  406.                  { *newptr++ = *oldptr++; }
  407.                  );
  408.      }
  409.      # Stackinhalt in die neue Closure kopieren:
  410.      {var reg2 object* newptr = &TheCclosure(new)->clos_consts[n];
  411.       dotimespL(n,n, { *--newptr = popSTACK(); } );
  412.      }
  413.      return new;
  414.    }}
  415.  
  416. local void callfunc (object closure,uintL k,uintL n);
  417. local void callfunc(k,n)
  418.   var object closure;
  419.   var uintL k;
  420.   var uintL n;
  421.   {  
  422.     funcall(TheCclosure(closure)->clos_consts[n],k);
  423.   }
  424.  
  425. extern Subr FUNTAB[];
  426.  
  427. local void callfunc_tab1 (uintL n);
  428. local void callfunc_tab1(n)
  429.   var uintL n;
  430.   { 
  431.     #define FUNTAB1  (&FUNTAB[0])
  432.     var Subr fun = FUNTAB1[n];
  433.     subr_self = subr_tab_ptr_as_object(fun);
  434.     (*(subr_norest_function*)(fun->function))();
  435.   }
  436.  
  437. local void callfunc_tab2 (uintL n);
  438. local void callfunc_tab2(n)
  439.   var uintL n;
  440.   { 
  441.     #define FUNTAB2  (&FUNTAB[256])
  442.     var Subr fun = FUNTAB2[n];
  443.     subr_self = subr_tab_ptr_as_object(fun);
  444.     (*(subr_norest_function*)(fun->function))();
  445.   }
  446.  
  447. local void callfunc_tabr (uintL m,uintL n);
  448. local void callfunc_tabr(m,n)
  449.   var uintL m;
  450.   var uintL n;
  451.   { 
  452.     var Subr fun = FUNTABR[n];
  453.     subr_self = subr_tab_ptr_as_object(fun);
  454.     (*(subr_norest_function*)(fun->function))(m,args_end_pointer STACKop m);
  455.   }
  456.  
  457. local void do_funcall (uintL n);
  458. local void do_funcall(n)
  459.   var uintL n;
  460.   {
  461.     funcall(STACK_(n),n);
  462.     skipSTACK(1);
  463.   }
  464.  
  465. local void do_apply (uintL n);
  466. local void do_apply(n)
  467.   var uintL n;
  468.   {
  469.     funcall(STACK_(n),n,value1);
  470.     skipSTACK(1);
  471.   }
  472.  
  473. local void push_unbound (uintC n);
  474. local void push_unbound(n)
  475.   var uintC n;
  476.   { dotimesC(n,n, { pushSTACK(unbound); } ); }
  477.  
  478. local void unlist (uintC n,uintC m,object l);
  479. local void unlist(n,m,val)
  480.   var uintC n;
  481.   var uintC m;
  482.   var object l;
  483.   {
  484.     if (n > 0)
  485.       do { if (atomp(l)) goto unlist_unbound;
  486.            pushSTACK(Car(l)); l = Cdr(l);
  487.          }
  488.     until (--n == 0);
  489.     if (atomp(l))
  490.       goto next_byte;
  491.     else
  492.       fehler_apply_zuviel(S(lambda));
  493.   unlist_unbound:
  494.     if (n > m) fehler_apply_zuwenig(S(lambda));
  495.     do { pushSTACK(unbound); } until (--n == 0);
  496.   }
  497.  
  498. local void unlistern (uintC n,uintC m,object l);
  499. local void unlistern(n,m,l)
  500.   var uintC n;
  501.   var uintC m;
  502.   var object l;
  503.   {
  504.     do { if (atomp(l)) goto unliststern_unbound;
  505.          pushSTACK(Car(l)); l = Cdr(l);
  506.        }
  507.     until (--n == 0);
  508.     pushSTACK(l);
  509.     goto next_byte;
  510.   unliststern_unbound:
  511.     if (n > m) fehler_apply_zuwenig(S(lambda));
  512.     do { pushSTACK(unbound); } until (--n == 0);
  513.     pushSTACK(NIL);
  514.   }
  515.  
  516. local void fehler_zuviele_werte (void);
  517. local void fehler_zuviele_werte()
  518.   {
  519.     //: DEUTSCH "Zu viele Werte erzeugt."
  520.     //: ENGLISH "too many return values"
  521.     //: FRANCAIS "Trop de valeurs VALUES."
  522.     fehler(error, GETTEXT("too many return values"));
  523.   }
  524.  
  525. local void _STACK_to_mv (uintL n);
  526. local void _STACK_to_mv(n)
  527.   { 
  528.     if (n >= mv_limit) fehler_zuviele_werte();
  529.     STACK_to_mv(n);
  530.   }
  531.  
  532. local void nv_to_STACK (uintL n);
  533. local void nv_to_STACK(n)
  534.   var uintL n;
  535.   {
  536.     # Test auf Stacküberlauf:
  537.     get_space_on_STACK(n*sizeof(object));
  538.     # n Werte in den Stack schieben:
  539.     {var reg7 uintC count = mv_count;
  540.      if (n==0) goto nv_to_stack_end; # kein Wert gewünscht -> fertig
  541.      # mindestens 1 Wert gewünscht
  542.      pushSTACK(value1);
  543.      n--; if (n==0) goto nv_to_stack_end; # nur 1 Wert gewünscht -> fertig
  544.      if (count<=1) goto nv_to_stack_fill; # nur 1 Wert vorhanden -> mit NILs auffüllen
  545.      count--;
  546.      # mindestens 2 Werte gewünscht und vorhanden
  547.      { var reg2 object* mvp = &mv_space[1];
  548.        loop
  549.          { pushSTACK(*mvp++);
  550.            n--; if (n==0) goto nv_to_stack_end; # kein Wert mehr gewünscht -> fertig
  551.            count--; if (count==0) goto nv_to_stack_fill; # kein Wert mehr vorhanden -> mit NILs auffüllen
  552.      }   }
  553.      nv_to_stack_fill: # Auffüllen mit n>0 NILs als zusätzlichen Werten:
  554.      dotimespL(n,n, { pushSTACK(NIL); } );
  555.      nv_to_stack_end: ;
  556.    }}
  557.  
  558. local void _mv_to_list (void);
  559. local void _mv_to_list()
  560.   { mv_to_list(); 
  561.     value1 = popSTACK();
  562.     mv_count=1;
  563.   }
  564.  
  565. local void _list_to_mv ();
  566. local void _list_to_mv()
  567.   { list_to_mv(value1, { fehler_zuviele_werte(); }); }
  568.  
  569. local void mvcall (void);
  570. local void mvcall()
  571.   { var reg2 object* FRAME; popSP( FRAME = (object*) ); # Pointer über Argumente und Funktion
  572.     var reg7 object fun = NEXT(FRAME); # Funktion
  573.     var reg4 uintL argcount = # Anzahl der Argumente auf dem Stack
  574.     STACK_item_count(STACK,FRAME);
  575.     if (((uintL)~(uintL)0 > ca_limit_1) && (argcount > ca_limit_1))
  576.       { pushSTACK(fun);
  577.         pushSTACK(S(multiple_value_call));
  578.         //: DEUTSCH "~: Zu viele Argumente für ~"
  579.         //: ENGLISH "~: too many arguments given to ~"
  580.         //: FRANCAIS "~: Trop d'arguments pour ~"
  581.         fehler(error, GETTEXT("~: too many arguments given to ~"));
  582.       }
  583.     # Funktion anwenden, Stack anheben bis unter die Funktion:
  584.     funcall(fun,argcount);
  585.     skipSTACK(1); # Funktion aus dem STACK streichen
  586.   }
  587.  
  588. local block_open (uintL n,sintL label_dist,uintL index);
  589. local block_open(n,label_dist)
  590.   var uintL n;
  591.   var sintL label_dist;
  592.   var uintL index;
  593.   {
  594.     # belegt 3 STACK-Einträge und 1 SP-jmp_buf-Eintrag und 2 SP-Einträge
  595.     # Block_Cons erzeugen:
  596.     {var reg2 object block_cons;
  597.      with_saved_context(
  598.                         block_cons = allocate_cons();
  599.                         label_dist += index; # CODEPTR+label_dist ist das Sprungziel
  600.                         );
  601.      # Block-Cons füllen: (CONST n) als CAR
  602.      Car(block_cons) = TheCclosure(closure)->clos_consts[n];
  603.      # Sprungziel in den SP:
  604.      pushSP(label_dist); pushSP((aint)closureptr);
  605.      # CBLOCK-Frame aufbauen:
  606.      { var reg7 object* top_of_frame = STACK; # Pointer übern Frame
  607.        pushSTACK(block_cons); # Cons ( (CONST n) . ...)
  608.        {var reg4 JMPBUF_on_SP(returner); # Rücksprungpunkt merken
  609.         finish_entry_frame_1(CBLOCK,returner, goto block_return; );
  610.      } }
  611.      # Framepointer im Block-Cons ablegen:
  612.      Cdr(block_cons) = make_framepointer(STACK);
  613.    }
  614.    return;
  615.    block_return: # Hierher wird gesprungen, wenn der oben aufgebaute
  616.    # CBLOCK-Frame ein RETURN-FROM gefangen hat.
  617.    { FREE_JMPBUF_on_SP();
  618.      skipSTACK(2); # CBLOCK-Frame auflösen, dabei
  619.      Cdr(popSTACK()) = disabled; # Block-Cons als Disabled markieren
  620.      {var reg2 uintL index;
  621.       # closure zurück, byteptr:=label_byteptr :
  622.       popSP(closureptr = (object*) ); popSP(index = );
  623.       closure = *closureptr; # Closure aus dem Stack holen
  624.       codeptr = TheSbvector(TheCclosure(closure)->clos_codevec);
  625.       byteptr = CODEPTR + index;
  626.    } }
  627.   }
  628.  
  629. local void block_close (void);
  630. local void block_close()
  631.   {
  632.     # CBLOCK-Frame auflösen:
  633.     #if STACKCHECKC
  634.     if (!(mtypecode(STACK_0) == CBLOCK_frame_info))
  635.       goto fehler_STACK_putt;
  636.     #endif
  637.     { FREE_JMPBUF_on_SP();
  638.       skipSTACK(2); # CBLOCK-Frame auflösen, dabei
  639.       Cdr(popSTACK()) = disabled; # Block-Cons als Disabled markieren
  640.       skipSP(2); # Ziel-Closureptr und Ziel-Label kennen wir
  641.     }
  642.   }
  643.  
  644. local void return_from (uintL n);
  645. local void return_from(n)
  646.   var uintL n;
  647.   {var reg2 object block_cons = TheCclosure(closure)->clos_consts[n];
  648.    if (eq(Cdr(block_cons),disabled))
  649.      { fehler_block_left(Car(block_cons)); }
  650.    # Bis zum Block-Frame unwinden, dann seine Routine zum Auflösen anspringen:
  651.    #ifndef FAST_SP
  652.    FREE_DYNAMIC_ARRAY(private_SP_space);
  653.    #endif
  654.    unwind_upto(uTheFramepointer(Cdr(block_cons)));
  655.   }
  656.  
  657. local void return_from_i (uintL k,uintL n);
  658. local void return_from_i(k,n)
  659.   {var reg2 object* FRAME = (object*) SP_(k);
  660.    var reg2 object block_cons = FRAME_(n);
  661.    if (eq(Cdr(block_cons),disabled))
  662.      { fehler_block_left(Car(block_cons)); }
  663.    # Bis zum Block-Frame unwinden, dann seine Routine zum Auflösen anspringen:
  664.    #ifndef FAST_SP
  665.    FREE_DYNAMIC_ARRAY(private_SP_space);
  666.    #endif
  667.    unwind_upto(uTheFramepointer(Cdr(block_cons)));
  668.   }
  669.  
  670. local void tagbody_open (object closure,uintL n);
  671. local void tagbody_open(closure,n)
  672.   var object closure;
  673.   var uintL n;
  674.   {
  675.     # belegt 3+m STACK-Einträge und 1 SP-jmp_buf-Eintrag und 1 SP-Eintrag
  676.     # Tagbody-Cons erzeugen:
  677.     {var reg2 object tagbody_cons;
  678.      with_saved_context(
  679.                         tagbody_cons = allocate_cons();
  680.                         );
  681.      # Tagbody-Cons füllen: Tag-Vektor (CONST n) als CAR
  682.      {var reg6 object tag_vector = TheCclosure(closure)->clos_consts[n];
  683.       var reg7 uintL m = TheSvector(tag_vector)->length;
  684.       Car(tagbody_cons) = tag_vector;
  685.       get_space_on_STACK(m*sizeof(object)); # Platz reservieren
  686.       # alle labeli als Fixnums auf den STACK legen:
  687.       {var reg4 uintL count;
  688.        var object list = Cdr(Cdr(code));
  689.        dotimespL(count,m, { pushSTACK(Car(list)); list=Cdr(list); } );
  690.      }}
  691.      # Sprungziel in den SP:
  692.      pushSP((aint)closureptr);
  693.      # CTAGBODY-Frame aufbauen:
  694.      { var reg9 object* top_of_frame = STACK; # Pointer übern Frame
  695.        pushSTACK(tagbody_cons); # Cons ( (CONST n) . ...)
  696.        {var reg4 JMPBUF_on_SP(returner); # Rücksprungpunkt merken
  697.         finish_entry_frame_1(CTAGBODY,returner, goto tagbody_go; );
  698.      } }
  699.      # Framepointer im Tagbody-Cons ablegen:
  700.      Cdr(tagbody_cons) = make_framepointer(STACK);
  701.     }
  702.     return;
  703.   tagbody_go: # Hierher wird gesprungen, wenn der oben aufgebaute
  704.     # CTAGBODY-Frame ein GO zum Label Nummer i gefangen hat.
  705.     { var reg7 uintL m = TheSvector(Car(STACK_2))->length; # Anzahl der Labels
  706.       # (Könnte auch das obige m als 'auto' deklarieren und hier benutzen.)
  707.       var reg4 uintL i = posfixnum_to_L(value1); # Nummer des Labels
  708.       var reg2 uintL index = posfixnum_to_L(STACK_((m-i)+3)); # labeli
  709.       # closure zurück, byteptr:=labeli_byteptr :
  710.       closureptr = (object*) SP_(jmpbufsize+0);
  711.       closure = *closureptr; # Closure aus dem Stack holen
  712.       codeptr = TheSbvector(TheCclosure(closure)->clos_codevec);
  713.       byteptr = CODEPTR + index;
  714.     }
  715.     return; # am Label i weiterinterpretieren
  716.  }
  717.  
  718. LISPFUNN(vcode_compile,1)
  719.   { 
  720.     var reg3 uintL code_pos;
  721.     var reg4 object closure = STACK_1;
  722.     var reg5 object code_vector = STACK_0;
  723.     var reg6 object *code_data_vector;
  724.     var reg7 uintL code_count;
  725.  
  726.     if (!simple_vector_p(code_vector))
  727.       fehler_vector(STACK_1);
  728.  
  729.     code_count = TheSvector(code_vec)->length;
  730.     code_data_vector = &TheSvector(code_vec)->data[0];
  731.  
  732.     for (code_pos=0;code_pos<code_count;code_pos++)
  733.       {
  734.         if (symbolp(code_data_vector[code_pos]))
  735.           { label_vec[label_index++]=v_genlabel(); }
  736.       }
  737.     
  738.     v_lambda("","", NULL, V_NLEAF, ibuffer);
  739.     for (code_pos=0;code_pos<code_count;code_pos++)
  740.       {
  741.         if (consp(code_data_vector[code_pos]))
  742.           { var reg1 object code = code_data_vector[code_pos];
  743.             var reg2 uint8 code = (uint8)posfixnum_to_L(Car(code));
  744.             switch (code)
  745.               { # (1) Konstanten                            
  746.                 case cod_nil:
  747.                 set_value1(NIL);
  748.                 break;                                          
  749.               case cod_push_nil:
  750.                 V_pushSTACK(NIL);
  751.                 break;                                          
  752.               case cod_t:
  753.                 set_value1(T);
  754.                 break;                                          
  755.               case cod_const:
  756.                 set_value1(const_0());
  757.                 break;
  758.               # (2) statische Variablen                         
  759.               case cod_load:
  760.                 V_STACK(reg_value1,operand_0());
  761.                 MV_COUNT_1();
  762.                 break;                                          
  763.               case cod_loadi:
  764.                 V_SP_PTR(reg_tmp,operand_0());
  765.                 v_ldpi(reg_value1,reg_tmp,FR_off(operand_1()));
  766.                 MV_COUNT_1();
  767.                 break;                                          
  768.               case cod_loadc:
  769.                 V_STACK(reg_temp,operand_0());
  770.                 v_ldpi(reg_temp,reg_temp,offsetof(Svector,data));
  771.                 v_ldpi(reg_value1,reg_temp,P_off(1+operand_1()));
  772.                 MV_COUNT_1();
  773.                 break;       
  774.               case cod_loadv:
  775.                 { var v_reg reg_ret;
  776.                   reg_ret = v_scallv((v_vptr)loadv,"%i%i",operand_0(),operand_1());
  777.                   v_movp(reg_value1,reg_ret);
  778.                 }
  779.                 MV_COUNT_1();
  780.                 break;                                          
  781.               case cod_loadic:
  782.                 V_STACK(reg_temp,operand_0());
  783.                 v_ldpi(reg_temp,reg_temp,offsetof(Svector,data));
  784.                 v_ldpi(reg_temp,reg_temp,P_off(1+operand_1()));
  785.                 v_ldpi(reg_value1,reg_temp,P_off(1+operand_2()));
  786.                 MV_COUNT_1();
  787.                 break;                                    
  788.               case cod_store:
  789.                 v_mov(reg_temp,reg_STACK);
  790.                 v_addpi(reg_temp,reg_temp,ST_off(operand_0()));
  791.                 v_stpi(reg_temp,reg_value1,0);
  792.                 MV_COUNT_1();
  793.                 break;                                          
  794.               case cod_storei:
  795.                 V_SP_PTR(reg_temp,operand_0());
  796.                 v_addpi(reg_temp,reg_temp,FR_off(operand_1()));
  797.                 v_stpi(reg_temp,reg_value1,0);
  798.                 MV_COUNT_1();
  799.                 break;                                          
  800.               case cod_storec:
  801.                 v_mov(reg_temp,reg_STACK);
  802.                 v_ldpi(reg_temp,reg_temp,ST_off(operand_0()));
  803.                 v_ldpi(reg_temp,reg_temp,offsetof(Svector,data));
  804.                 v_addpi(reg_temp,reg_temp,P_off(1+operand_1()));
  805.                 v_stpi(reg_temp,reg_value1);
  806.                 MV_COUNT_1();
  807.                 break;                                          
  808.               case cod_storev:
  809.                 { struct v_reg reg_ret;
  810.                   reg_ret=v_scallv((v_vptr)storev_adr,"%I%I",operand_0(),operand_1());
  811.                   v_stpi(reg_ret,reg_value1);
  812.                 }
  813.                 MV_COUNT_1();
  814.                 break;                                          
  815.               case cod_storeic:
  816.                 V_SP_PTR(reg_temp,operand_0());
  817.                 v_ldpi(reg_temp,reg_temp,FR_off(operand_1()));
  818.                 v_ldpi(reg_temp,reg_temp,offsetof(Svector,data));
  819.                 v_addpi(reg_temp,reg_temp,P_off(1+operand_2()));
  820.                 v_stpi(reg_temp,reg_value1,0);
  821.                 MV_COUNT_1();
  822.                 break;
  823.               # (3) dynamische Variablen                        
  824.               case cod_getvalue:
  825.                 { struct v_reg reg_ret;
  826.                   reg_ret=v_scallv((v_vptr)const_symbol_value_adr,"%I",operand_0());
  827.                   v_ldpi(reg_temp,reg_ret,0);
  828.                   MV_COUNT_1();
  829.                 }
  830.                 break;                                          
  831.               case cod_setvalue:
  832.                 { struct v_reg reg_ret;
  833.                   reg_ret=v_scallv((v_vptr)assign_const_symbol_value_adr,"%I",operand_0());
  834.                   v_stpi(reg_ret,reg_value1,0);
  835.                 }
  836.                 MV_COUNT_1();
  837.                 break;
  838.               case cod_bind:
  839.                 { var reg3 object sym_to_bind = const_0();
  840.                   var reg4 struct v_reg reg_top_of_frame;
  841.                   v_getreg(®_top_of_frame, V_P, V_TEMP);
  842.                   v_movp(reg_top_of_frame,reg_STACK);
  843.                   V_push_Symbol_value(sym_to_bind);
  844.                   V_pushSTACK(sym_to_bind);
  845.                   V_push_dynamic_frame(reg_top_of_frame);
  846.                   v_setp(reg_temp,&Symbol_value(sym_to_bind));
  847.                   v_stpi(reg_temp,reg_value1,0);
  848.                 }
  849.                 break;                                          
  850.               case cod_unbind1:
  851.                 v_scallv((v_vptr)unbind1,"");
  852.                 break;                                          
  853.               case cod_unbind:
  854.                 v_scallv((v_vptr)unbind,"");
  855.                 break;
  856.               case cod_progv:
  857.                 V_reg_popSTACK(reg_temp);
  858.                 V_reg_pushSP(reg_STACK);
  859.                 v_scallv((v_vptr)progv,"%p%p",reg_temp,reg_value1);
  860.                 break;                                          
  861.                 
  862.               # (4) Stackoperationen                            
  863.               case cod_push:
  864.                 V_pushSTACK(reg_value1);
  865.                 break;                                          
  866.               case cod_pop:
  867.                 V_popSTACK(reg_value1);
  868.                 MV_COUNT_1();
  869.                 break;                                          
  870.               case cod_skip:
  871.                 V_skipSTACK(operand_0());
  872.                 break;
  873.               case cod_skipi:
  874.                 V_skipSP(operand_0());
  875.                 V_reg_popSP(reg_STACK);
  876.                 V_skipSTACK(operand_1());
  877.                 break;
  878.               case cod_skipsp:
  879.                 V_skipSP(operand_0());
  880.                 break;                                          
  881.                 
  882.               # (5) Programmfluß und Sprünge                    
  883.               case cod_skip_ret:
  884.                 V_skipSTACK(operand_0());
  885.                 break;                                          
  886.               case cod_jmp:
  887.                 v_jl(lookup_label(operand_0()));
  888.                 break;
  889.               case cod_jmpif:
  890.                 v_bnepi(reg_value1,NIL,lookup_label(operand_0()));
  891.                 break;                                          
  892.               case cod_jmpifnot:
  893.                 v_beqpi(reg_value1,NIL,lookup_label(operand_0()));
  894.                 break;                                          
  895.               case cod_jmpif1:
  896.                 v_bnepi(reg_value1,NIL,lookup_label(operand_0()));
  897.                 MV_COUNT_1();
  898.                 break;                                          
  899.               case cod_jmpifnot1:
  900.                 v_beqpi(reg_value1,NIL,lookup_label(operand_0()));
  901.                 MV_COUNT_1();
  902.                 break;                                          
  903.               case cod_jmpifatom:
  904.                 { var struct v_reg reg_ret;
  905.                   reg_ret=v_scallv((v_vptr)_atomp,"%p",reg_value1);
  906.                   v_beqii(reg_ret,0,lookup_label(operand_0()));
  907.                 }
  908.                 break;
  909.               case cod_jmpifconsp:
  910.                 { var struct v_reg reg_ret;
  911.                   reg_ret=v_scallv((v_vptr)_consp,"%p",reg_value1);
  912.                   v_beqii(reg_ret,0,lookup_label(operand_0()));
  913.                 }
  914.                 break;
  915.               case cod_jmpifeq:
  916.                 { var struct v_reg reg_ret;
  917.                   V_reg_popSTACK(reg_temp);
  918.                   reg_ret=v_scallv((v_vptr)_eq,"%p%p",reg_value1,reg_temp);
  919.                   v_bneii(reg_ret,0,lookup_label(operand_0()));
  920.                 }
  921.                 break;                                 
  922.               case cod_jmpifnoteq:
  923.                 { var struct v_reg reg_ret;
  924.                   V_reg_popSTACK(reg_temp);
  925.                   reg_ret=v_scallv((v_vptr)_eq,"%p%p",reg_value1,reg_temp);
  926.                   v_beqii(reg_ret,0,lookup_label(operand_0()));
  927.                 }
  928.                 break;                                          
  929.               case cod_jmpifeqto:
  930.                 { var struct v_reg reg_ret;
  931.                   V_reg_popSTACK(reg_temp);
  932.                   V_reg_const(closure,reg_temp2,operand_0());
  933.                   reg_ret=v_scallv((v_vptr)_eq,"%p%p",reg_temp,reg_temp2);
  934.                   v_bneii(reg_ret,0,lookup_label(operand_1()));
  935.                 }
  936.                 break;
  937.               case cod_jmpifnoteqto:
  938.                 { var struct v_reg reg_ret;
  939.                   V_reg_popSTACK(reg_temp);
  940.                   V_reg_const(closure,reg_temp2,operand_0());
  941.                   reg_ret=v_scallv((v_vptr)_eq,"%p%p",reg_temp,reg_temp2);
  942.                   v_beqii(reg_ret,0,lookup_label(operand_1()));
  943.                 }
  944.                 break;                            
  945.               case cod_jmphash:
  946.                 v_jl(label_for_jmphash(code_vector,code_pos,operand_0(),value1));
  947.                 break;                                          
  948.               case cod_jmphashv:
  949.                 v_jl(label_for_jmphash(code_vector,code_pos,operand_0(),value1));
  950.                 break;                                          
  951.               case cod_jsr:
  952.                 v_jal(lookup_label(operand_0()));
  953.                 break;                                          
  954.               case cod_jmptail:
  955.                 v_jl(jmptail(operand_2(),operand_0(),operand_1()));
  956.                 break;                                          
  957.                 
  958.               # (6) Environments und Closures                   
  959.               case cod_venv:
  960.                 V_reg_const(closure,reg_value1,0);
  961.                 MV_COUNT_1();
  962.                 break;                                          
  963.               case cod_make_vector1_push:
  964.                 v_scallv((v_vptr)make_vector1_push,"%I%P",operand_0(),value1);
  965.                 break;
  966.               case cod_copy_closure:
  967.                 { struct v_reg reg_ret;
  968.                   reg_ret=v_scallv((v_vptr)copy_closure,"%P%I%I",closure,operand_0(),operand_1());
  969.                   v_movp(reg_value1,reg_ret);
  970.                 }
  971.                 MV_COUNT_1();
  972.                 break;                                        
  973.               # (7) Funktionsaufrufe                            
  974.               case cod_call:
  975.                 v_scallv((v_vptr)callfunc,"%P%I%I",closure,operand_0(),operand_1());
  976.                 break; 
  977.               case cod_call0:
  978.                 v_scallv((v_vptr)callfunc,"%P%I%I",closure,operand_0(),0);
  979.                 break;                                          
  980.               case cod_call1:                                   
  981.                 v_scallv((v_vptr)callfunc,"%P%I%I",closure,operand_0(),1);
  982.                 break;                                          
  983.               case cod_call2:                                   
  984.                 v_scallv((v_vptr)callfunc,"%P%I%I",closure,operand_0(),2);
  985.                 break;                                          
  986.               case cod_calls1:
  987.                 v_scallv((v_vptr)callfunc_tab1,"%I",operand_0());
  988.                 break;                                          
  989.               case cod_calls2:
  990.                 v_scallv((v_vptr)callfunc_tab2,"%I",operand_0());
  991.                 break;                                    
  992.               case cod_callsr:
  993.                 v_scallv((v_vptr)callfunc_tabr,"%I%I",operand_0(),operand_1());
  994.                 break;
  995.               case cod_callc:
  996.                 v_scallv((v_vptr)interpret_bytecode,"%P%P%I",value1,TheCclosure(value1)->clos_codevec,CCHD+6);
  997.                   break;
  998.               case cod_callckey:
  999.                 v_scallv((v_vptr)interpret_bytecode,"%P%P%I",value1,TheCclosure(value1)->clos_codevec,CCHD+10);
  1000.                 break;                                          
  1001.               case cod_funcall:
  1002.                 v_scallv((v_vptr)do_funcall,"%I",operand_0());
  1003.                 break;
  1004.               case cod_apply:
  1005.                 v_scallv((v_vptr)do_scallv,"%I",operand_0());
  1006.                 break; 
  1007.                 
  1008.               # (8) optionale und Keyword-Argumente             
  1009.               case cod_push_unbound:
  1010.                 v_scallv((v_vptr)push_unbound,"%I",operand_0());
  1011.                 break;
  1012.               case cod_unlist:
  1013.                 v_scallv((v_vptr)unlist,"%I%I%P",operand_0(),operand_1(),value1);
  1014.                 break;
  1015.               case cod_unliststern:
  1016.                 v_scallv((v_vptr)unlistern,"%I%I%P",operand_0(),operand_1(),value1);
  1017.                 break;                                          
  1018.               case cod_jmpifboundp:
  1019.                 V_STACK(reg_temp,operand_0());
  1020.                 v_beqpi(reg_temp,unbound,lookup_label(operand_1()));
  1021.                 break;
  1022.               case cod_boundp:
  1023.                 V_STACK(reg_temp,operand_0());
  1024.                 v_setp(reg_value1,T)
  1025.                 v_cmveqpii(reg_value1,NIL,reg_value1,unbound);
  1026.                 MV_COUNT_1();
  1027.                 break;                                    
  1028.               case cod_unbound_nil:
  1029.                 { uintL n = operand_0();
  1030.                   V_STACK(reg_temp,n);
  1031.                   v_cmveqpii(reg_temp,NIL,reg_temp,unbound);
  1032.                   V_setSTACK(n,reg_temp);
  1033.                 }
  1034.                 break;                
  1035.                 
  1036.               # (9) Behandlung mehrerer Werte                   
  1037.               case cod_values0:
  1038.                 v_setp(reg_value1,NIL);
  1039.                 v_seti(reg_mv_count,0);
  1040.                 break;                                          
  1041.               case cod_values1:
  1042.                 MV_COUNT_1();
  1043.                 break;                                          
  1044.               case cod_stack_to_mv:
  1045.                 v_scallv((v_vptr)_STACK_to_mv,"%I",operand_0());
  1046.                 break;                                          
  1047.               case cod_mv_to_stack:
  1048.                 v_scallv((v_vptr)_mv_to_STACK,"");
  1049.                 break;
  1050.               case cod_nv_to_stack:
  1051.                 v_scallv((v_vptr)_nv_to_STACK,"%I",operand_0());
  1052.                 break;                         
  1053.               case cod_mv_to_list:
  1054.                 v_scallv((v_vptr)_mv_to_list,"");
  1055.                 break;
  1056.               case cod_list_to_mv:
  1057.                 v_scallv((v_vptr)_list_to_mv,"");
  1058.                 break;                                
  1059.               case cod_mvcallp:
  1060.                 V_reg_pushSP(reg_STACK);
  1061.                 V_reg_pushSTACK(reg_value1);
  1062.                 break;                                          
  1063.               case cod_mvcall:
  1064.                 v_scallv((v_vptr)mvcall,"");
  1065.                 break;                 
  1066.               # (10) BLOCK                            
  1067.               case cod_block_open:
  1068.                 v_scallv((v_vptr)block_open,"%I%I%I",operand_0(),operand_1(),code_pos);
  1069.                 break;                                          
  1070.               case cod_block_close:
  1071.                 v_scallv((v_vptr)block_close,"");
  1072.                 break;                                          
  1073.               case cod_return_from:
  1074.                 v_scallv((v_vptr)return_from,"%I",operand_0());
  1075.                 break;
  1076.               case cod_return_from_i:
  1077.                 v_scallv((v_vptr)return_from_i,"%I%I",operand_0(),operand_1());
  1078.                   break;                                          
  1079.               # (11) TAGBODY                                    
  1080.               case cod_tagbody_open:
  1081.                 v_scallv((v_vptr)tagbody_open,
  1082.                   break;                                          
  1083.                 CASE(cod_tagbody_close_nil)                       
  1084.                   break;                                          
  1085.                 CASE(cod_tagbody_close)                           
  1086.                   break;                                          
  1087.                 CASE(cod_go)                                      
  1088.                   break;                                          
  1089.                 CASE(cod_go_i)                                    
  1090.                   break;                                          
  1091.                 
  1092. # (12) CATCH und THROW                            
  1093.                 CASE(cod_catch_open)                              
  1094.                   break;                                          
  1095.                 CASE(cod_catch_close)                             
  1096.                   break;                                          
  1097.                 CASE(cod_throw)                                   
  1098.                   break;                                          
  1099.                 
  1100. # (13) UNWIND-PROTECT                             
  1101.                 CASE(cod_uwp_open)                                
  1102.                   break;                                          
  1103.                 CASE(cod_uwp_normal_exit)                         
  1104.                   break;                                          
  1105.                 CASE(cod_uwp_close)                               
  1106.                   break;                                          
  1107.                 CASE(cod_uwp_cleanup)                             
  1108.                   break;                                          
  1109.                 
  1110. # (14) HANDLER-BIND                               
  1111.                 CASE(cod_handler_open)                            
  1112.                   break;                                          
  1113.                 CASE(cod_handler_begin_push)                      
  1114.                   break;                                          
  1115.                 
  1116. # (15) einige Funktionen                          
  1117.                 CASE(cod_not)                                     
  1118.                   break;                                          
  1119.                 CASE(cod_eq)                                      
  1120.                   break;                                          
  1121.                 CASE(cod_car)                                     
  1122.                   break;                                          
  1123.                 CASE(cod_cdr)                                     
  1124.                   break;                                          
  1125.                 CASE(cod_cons)                                    
  1126.                   break;                                          
  1127.                 CASE(cod_symbol_function)                         
  1128.                   break;                                          
  1129.                 CASE(cod_svref)                                   
  1130.                   break;                                          
  1131.                 CASE(cod_svset)                                   
  1132.                   break;                                          
  1133.                 CASE(cod_list)                                    
  1134.                   break;                                          
  1135.                 CASE(cod_liststern)                               
  1136.                   break;                                          
  1137.                 
  1138. # (16) kombinierte Operationen                    
  1139.                 CASE(cod_nil_push)                                
  1140.                   break;                                          
  1141.                 CASE(cod_t_push)                                  
  1142.                   break;                                          
  1143.                 CASE(cod_const_push)                              
  1144.                   break;                                          
  1145.                 CASE(cod_load_push)                               
  1146.                   break;                                          
  1147.                 CASE(cod_loadi_push)                              
  1148.                   break;                                          
  1149.                 CASE(cod_loadc_push)                              
  1150.                   break;                                          
  1151.                 CASE(cod_loadv_push)                              
  1152.                   break;                                          
  1153.                 CASE(cod_pop_store)                               
  1154.                   break;                                          
  1155.                 CASE(cod_getvalue_push)                           
  1156.                   break;                                          
  1157.                 CASE(cod_jsr_push)                                
  1158.                   break;                                          
  1159.                 CASE(cod_copy_closure_push)                       
  1160.                   break;                                          
  1161.                 CASE(cod_call_push)                               
  1162.                   break;                                          
  1163.                 CASE(cod_call1_push)                              
  1164.                   break;                                          
  1165.                 CASE(cod_call2_push)                              
  1166.                   break;                                          
  1167.                 CASE(cod_calls1_push)                             
  1168.                   break;                                          
  1169.                 CASE(cod_calls2_push)                             
  1170.                   break;                                          
  1171.                 CASE(cod_callsr_push)                             
  1172.                   break;                                          
  1173.                 CASE(cod_callc_push)                              
  1174.                   break;                                          
  1175.                 CASE(cod_callckey_push)                           
  1176.                   break;                                          
  1177.                 CASE(cod_funcall_push)                            
  1178.                   break;                                          
  1179.                 CASE(cod_apply_push)                              
  1180.                   break;                                          
  1181.                 CASE(cod_car_push)                                
  1182.                   break;                                          
  1183.                 CASE(cod_cdr_push)                                
  1184.                   break;                                          
  1185.                 CASE(cod_cons_push)                               
  1186.                   break;                                          
  1187.                 CASE(cod_list_push)                               
  1188.                   break;                                          
  1189.                 CASE(cod_liststern_push)                          
  1190.                   break;                                          
  1191.                 CASE(cod_nil_store)                               
  1192.                   break;                                          
  1193.                 CASE(cod_t_store)                                 
  1194.                   break;                                          
  1195.                 CASE(cod_load_storec)                             
  1196.                   break;                                          
  1197.                 CASE(cod_calls1_store)                            
  1198.                   break;                                          
  1199.                 CASE(cod_calls2_store)                            
  1200.                   break;                                          
  1201.                 CASE(cod_callsr_store)                            
  1202.                   break;                                          
  1203.                 CASE(cod_load_cdr_store)                          
  1204.                   break;                                          
  1205.                 CASE(cod_load_cons_store)                         
  1206.                   break;                                          
  1207.                 CASE(cod_load_inc_store)                          
  1208.                   break;                                          
  1209.                 CASE(cod_load_dec_store)                          
  1210.                   break;                                          
  1211.                 CASE(cod_load_car_store)                          
  1212.                   break;                                          
  1213.                 CASE(cod_call1_jmpif)                             
  1214.                   break;                                          
  1215.                 CASE(cod_call1_jmpifnot)                          
  1216.                   break;                                          
  1217.                 CASE(cod_call2_jmpif)                             
  1218.                   break;                                          
  1219.                 CASE(cod_call2_jmpifnot)                          
  1220.                   break;                                          
  1221.                 CASE(cod_calls1_jmpif)                            
  1222.                   break;                                          
  1223.                 CASE(cod_calls1_jmpifnot)                         
  1224.                   break;                                          
  1225.                 CASE(cod_calls2_jmpif)                            
  1226.                   break;                                          
  1227.                 CASE(cod_calls2_jmpifnot)                         
  1228.                   break;                                          
  1229.                 CASE(cod_callsr_jmpif)                            
  1230.                   break;                                          
  1231.                 CASE(cod_callsr_jmpifnot)                         
  1232.                   break;                                          
  1233.                 CASE(cod_load_jmpif)                              
  1234.                   break;                                          
  1235.                 CASE(cod_load_jmpifnot)                           
  1236.                   break;                                          
  1237.                 CASE(cod_load_car_push)                           
  1238.                   break;                                          
  1239.                 CASE(cod_load_cdr_push)                           
  1240.                   break;                                          
  1241.                 CASE(cod_load_inc_push)                           
  1242.                   break;                                          
  1243.                 CASE(cod_load_dec_push)                           
  1244.                   break;                                          
  1245.                 CASE(cod_const_symbol_function)                   
  1246.                   break;                                          
  1247.                 CASE(cod_const_symbol_function_push)              
  1248.                   break;                                          
  1249.                 CASE(cod_const_symbol_function_store)             
  1250.                   break;                                          
  1251.                 CASE(cod_apply_skip_ret)                          
  1252.                   break;                                          
  1253.                 
  1254. # (17) Kurzcodes                                  
  1255.                 CASE(cod_load0)                                   
  1256.                   break;                                          
  1257.                 CASE(cod_load1)                                   
  1258.                   break;                                          
  1259.                 CASE(cod_load2)                                   
  1260.                   break;                                          
  1261.                 CASE(cod_load3)                                   
  1262.                   break;                                          
  1263.                 CASE(cod_load4)                                   
  1264.                   break;                                          
  1265.                 CASE(cod_load5)                                   
  1266.                   break;                                          
  1267.                 CASE(cod_load6)                                   
  1268.                   break;                                          
  1269.                 CASE(cod_load7)                                   
  1270.                   break;                                          
  1271.                 CASE(cod_load8)                                   
  1272.                   break;                                          
  1273.                 CASE(cod_load9)                                   
  1274.                   break;                                          
  1275.                 CASE(cod_load10)                                  
  1276.                   break;                                          
  1277.                 CASE(cod_load11)                                  
  1278.                   break;                                          
  1279.                 CASE(cod_load12)                                  
  1280.                   break;                                          
  1281.                 CASE(cod_load13)                                  
  1282.                   break;                                          
  1283.                 CASE(cod_load14)                                  
  1284.                   break;                                          
  1285.                 CASE(cod_load_push0)                              
  1286.                   break;                                          
  1287.                 CASE(cod_load_push1)                              
  1288.                   break;                                          
  1289.                 CASE(cod_load_push2)                              
  1290.                   break;                                          
  1291.                 CASE(cod_load_push3)                              
  1292.                   break;                                          
  1293.                 CASE(cod_load_push4)                              
  1294.                   break;                                          
  1295.                 CASE(cod_load_push5)                              
  1296.                   break;                                          
  1297.                 CASE(cod_load_push6)                              
  1298.                   break;                                          
  1299.                 CASE(cod_load_push7)                              
  1300.                   break;                                          
  1301.                 CASE(cod_load_push8)                              
  1302.                   break;                                          
  1303.                 CASE(cod_load_push9)                              
  1304.                   break;                                          
  1305.                 CASE(cod_load_push10)                             
  1306.                   break;                                          
  1307.                 CASE(cod_load_push11)                             
  1308.                   break;                                          
  1309.                 CASE(cod_load_push12)                             
  1310.                   break;                                          
  1311.                 CASE(cod_load_push13)                             
  1312.                   break;                                          
  1313.                 CASE(cod_load_push14)                             
  1314.                   break;                                          
  1315.                 CASE(cod_load_push15)                             
  1316.                   break;                                          
  1317.                 CASE(cod_load_push16)                             
  1318.                   break;                                          
  1319.                 CASE(cod_load_push17)                             
  1320.                   break;                                          
  1321.                 CASE(cod_load_push18)                             
  1322.                   break;                                          
  1323.                 CASE(cod_load_push19)                             
  1324.                   break;                                          
  1325.                 CASE(cod_load_push20)                             
  1326.                   break;                                          
  1327.                 CASE(cod_load_push21)                             
  1328.                   break;                                          
  1329.                 CASE(cod_load_push22)                             
  1330.                   break;                                          
  1331.                 CASE(cod_load_push23)                             
  1332.                   break;                                          
  1333.                 CASE(cod_load_push24)                             
  1334.                   break;                                          
  1335.                 CASE(cod_const0)                                  
  1336.                   break;                                          
  1337.                 CASE(cod_const1)                                  
  1338.                   break;                                          
  1339.                 CASE(cod_const2)                                  
  1340.                   break;                                          
  1341.                 CASE(cod_const3)                                  
  1342.                   break;                                          
  1343.                 CASE(cod_const4)                                  
  1344.                   break;                                          
  1345.                 CASE(cod_const5)                                  
  1346.                   break;                                          
  1347.                 CASE(cod_const6)                                  
  1348.                   break;                                          
  1349.                 CASE(cod_const7)                                  
  1350.                   break;                                          
  1351.                 CASE(cod_const8)                                  
  1352.                   break;                                          
  1353.                 CASE(cod_const9)                                  
  1354.                   break;                                          
  1355.                 CASE(cod_const10)                                 
  1356.                   break;                                          
  1357.                 CASE(cod_const11)                                 
  1358.                   break;                                          
  1359.                 CASE(cod_const12)                                 
  1360.                   break;                                          
  1361.                 CASE(cod_const13)                                 
  1362.                   break;                                          
  1363.                 CASE(cod_const14)                                 
  1364.                   break;                                          
  1365.                 CASE(cod_const15)                                 
  1366.                   break;                                          
  1367.                 CASE(cod_const16)                                 
  1368.                   break;                                          
  1369.                 CASE(cod_const17)                                 
  1370.                   break;                                          
  1371.                 CASE(cod_const18)                                 
  1372.                   break;                                          
  1373.                 CASE(cod_const19)                                 
  1374.                   break;                                          
  1375.                 CASE(cod_const20)                                 
  1376.                   break;                                          
  1377.                 CASE(cod_const_push0)                             
  1378.                   break;                                          
  1379.                 CASE(cod_const_push1)                             
  1380.                   break;                                          
  1381.                 CASE(cod_const_push2)                             
  1382.                   break;                                          
  1383.                 CASE(cod_const_push3)                             
  1384.                   break;                                          
  1385.                 CASE(cod_const_push4)                             
  1386.                   break;                                          
  1387.                 CASE(cod_const_push5)                             
  1388.                   break;                                          
  1389.                 CASE(cod_const_push6)                             
  1390.                   break;                                          
  1391.                 CASE(cod_const_push7)                             
  1392.                   break;                                          
  1393.                 CASE(cod_const_push8)                             
  1394.                   break;                                          
  1395.                 CASE(cod_const_push9)                             
  1396.                   break;                                          
  1397.                 CASE(cod_const_push10)                            
  1398.                   break;                                          
  1399.                 CASE(cod_const_push11)                            
  1400.                   break;                                          
  1401.                 CASE(cod_const_push12)                            
  1402.                   break;                                          
  1403.                 CASE(cod_const_push13)                            
  1404.                   break;                                          
  1405.                 CASE(cod_const_push14)                            
  1406.                   break;                                          
  1407.                 CASE(cod_const_push15)                            
  1408.                   break;                                          
  1409.                 CASE(cod_const_push16)                            
  1410.                   break;                                          
  1411.                 CASE(cod_const_push17)                            
  1412.                   break;                                          
  1413.                 CASE(cod_const_push18)                            
  1414.                   break;                                          
  1415.                 CASE(cod_const_push19)                            
  1416.                   break;                                          
  1417.                 CASE(cod_const_push20)                            
  1418.                   break;                                          
  1419.                 CASE(cod_const_push21)                            
  1420.                   break;                                          
  1421.                 CASE(cod_const_push22)                            
  1422.                   break;                                          
  1423.                 CASE(cod_const_push23)                            
  1424.                   break;                                          
  1425.                 CASE(cod_const_push24)                            
  1426.                   break;                                          
  1427.                 CASE(cod_const_push25)                            
  1428.                   break;                                          
  1429.                 CASE(cod_const_push26)                            
  1430.                   break;                                          
  1431.                 CASE(cod_const_push27)                            
  1432.                   break;                                          
  1433.                 CASE(cod_const_push28)                            
  1434.                   break;                                          
  1435.                 CASE(cod_const_push29)                            
  1436.                   break;                                          
  1437.                 CASE(cod_store0)                                  
  1438.                   break;                                          
  1439.                 CASE(cod_store1)                                  
  1440.                   break;                                          
  1441.                 CASE(cod_store2)                                  
  1442.                   break;                                          
  1443.                 CASE(cod_store3)                                  
  1444.                   break;                                          
  1445.                 CASE(cod_store4)                                  
  1446.                   break;                                          
  1447.                 CASE(cod_store5)                                  
  1448.                   break;                                          
  1449.                 CASE(cod_store6)                                  
  1450.                   break;                                          
  1451.                 CASE(cod_store7)                                  
  1452.                   break;                                          
  1453.                 CASE(cod_store8)                                  
  1454.                   break;                                          
  1455.                 CASE(cod_store9)                                  
  1456.                   break;                                          
  1457.               default:                                            
  1458.                 asciz_out("unknown code:");                       
  1459.                 dez_out(code);                                    
  1460.                 asciz_out("\n");                                  
  1461.                 abort();                                          
  1462.               }                                                  
  1463.           }
  1464.         else
  1465.           {
  1466.             v_label(lookup_label(code_data_vector[code_pos]));
  1467.           }
  1468.       }
  1469.     skipSTACK(1);
  1470.     mv_count = 0;
  1471.   }
  1472.  
  1473.  
  1474.