home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / brklyprl.lha / Emulator / fast.c < prev    next >
Encoding:
C/C++ Source or Header  |  1989-04-14  |  9.4 KB  |  545 lines
  1.  
  2. /* Copyright (C) 1988, 1989 Herve' Touati, Aquarius Project, UC Berkeley */
  3.  
  4. /* Copyright Herve' Touati, Aquarius Project, UC Berkeley */
  5.  
  6. #include <stream.h>
  7. #include "tags.h"
  8. #include "instr.h"
  9. #include "hash_table.h"
  10. #include "string_table.h"
  11. #include "scan.h"
  12. #include "inst_args.h"
  13. #include "inst_table.h"
  14. #include "memory.h"
  15. #include "basics.h"
  16. #include "top_level.h"
  17. #ifdef WITH_GC
  18. #include "gc.h"
  19. #endif
  20.  
  21. #define max(a,b) (((a) > (b)) ? (a) : (b))
  22.  
  23. inline void get_variable(Cell& Arg1, Cell Arg2) {
  24.   Arg1 = Arg2;
  25. }
  26.  
  27. inline void get_value(Cell Arg1, Cell Arg2) {
  28.   if (! unify(Arg1, Arg2))
  29.     P = FP0;
  30. }
  31.  
  32. inline void get_constant(Cell Arg1, Cell Arg2) {
  33.   Arg2 = deref(Arg2);
  34.   if (Arg1 != Arg2) {
  35.     if (get_tag(Arg2) == TAGREF)
  36.       Bind(Arg2, Arg1);
  37.     else
  38.       (P = FP0);
  39.   }
  40. }
  41.  
  42.  
  43.  /* PUT INSTRUCTIONS */
  44.  
  45.  
  46. inline void put_variable_X(Cell& Arg1, Cell& Arg2) 
  47. {
  48.   *H = make_ptr(TAGREF, H);
  49.   Arg2 = Arg1 = *H++;
  50. }
  51.  
  52. inline void put_variable_Y(Cell& Arg1, Cell& Arg2) 
  53. {
  54.   Arg2 = Arg1 = make_cell(TAGREF, &Arg1);
  55. }
  56.  
  57. inline void put_value(Cell Arg1, Cell& Arg2) 
  58. {
  59.   Arg2 = Arg1;
  60. }
  61.  
  62. inline void put_unsafe_value(Cell Arg1, Cell& Arg2) 
  63. {
  64.   Arg1 = deref(Arg1);
  65.   if (get_tag(Arg1) == TAGREF && cellp(Arg1) >= E0) {
  66.     *H = make_ptr(TAGREF, H);
  67.     Bind(Arg1, *H++);
  68.   }
  69.   Arg2 = Arg1;
  70. }
  71.  
  72. inline void put_structure(Cell atom, Cell& Var, Cell arity) 
  73. {
  74.   Var = make_ptr(TAGSTRUCT, H);
  75.   *H++ = atom;
  76.   *H++ = make_int(arity);
  77. }  
  78.  
  79. inline void put_list(Cell& Arg1) 
  80. {
  81.   Arg1 = make_ptr(TAGLIST, H);
  82. }
  83.  
  84.  
  85.  
  86.  /* UNIFY INSTRUCTIONS */
  87.  
  88.  
  89. inline void unify_void_write() 
  90. {
  91.   *H = make_ptr(TAGREF, H); H++;
  92. }
  93.  
  94. inline void unify_void() 
  95. {
  96.   if (MODE == MODE_READ) {
  97.     S++;
  98.   } else {
  99.     unify_void_write();
  100.   }
  101. }
  102.  
  103. inline void unify_value_write(Cell Arg1) 
  104. {
  105.   Arg1 = deref(Arg1);
  106.   if (get_tag(Arg1) == TAGREF && cellp(Arg1) >= E0) {
  107.     *H = make_ptr(TAGREF, H);
  108.     Bind(Arg1, *H++);
  109.   } else {
  110.     *H++ = Arg1;
  111.   }
  112. }
  113.  
  114. inline void unify_value(Cell Arg1) 
  115. {
  116.   if (MODE == MODE_READ) {
  117.     if (! unify(Arg1, *S++)) {
  118.       P = FP0;
  119.     }
  120.   } else {
  121.     unify_value_write(Arg1);
  122.   }
  123. }
  124.  
  125.  
  126. inline void unify_variable_write(Cell& Var) 
  127. {
  128.   *H = make_ptr(TAGREF, H);
  129.   Var = *H++;
  130. }
  131.  
  132. inline void unify_variable(Cell& Var) 
  133. {
  134.   if (MODE == MODE_READ) 
  135.     Var = *S++;
  136.   else
  137.     unify_variable_write(Var);
  138. }
  139.  
  140.  
  141. inline void unify_constant_write(Cell cst) 
  142. {
  143.   *H++ = cst;
  144. }
  145.  
  146. inline void unify_constant(Cell Arg1) 
  147. {
  148.   if (MODE == MODE_READ) 
  149.     get_constant(Arg1, *S++);
  150.   else
  151.     unify_constant_write(Arg1);
  152. }
  153.  
  154.  
  155.  /* unify_cdr is no different from unify_variable */
  156.  
  157.  
  158. inline void get_cdr_list_write() 
  159. {
  160.   *H = make_ptr(TAGLIST, H + 1); H++;
  161. }       
  162.  
  163. extern HashTable* table_of_tables;
  164.  
  165. void fast_execute()
  166. {
  167.   for (;; P++) {
  168.     switch (P->ID) {
  169.     case SWITCH_ON_TERM:
  170.       {
  171.     Cell X0 = deref(X[0]);
  172.     switch(get_tag(X0)) {
  173.     case TAGCONST:
  174.       P = instrp(P->arg1);
  175.       break;
  176.     case TAGLIST:
  177.       P = instrp(P->arg2);
  178.       break;
  179.     case TAGSTRUCT:
  180.       P = instrp(P->arg3);
  181.       break;
  182.     case TAGREF:
  183.       break;
  184.     }
  185.       }
  186.       break;
  187.     case SWITCH_ON_CONSTANT:
  188.       {
  189.     HashTable* table = (HashTable*) table_of_tables->get(P->arg1);
  190.     P = instrp(table->get(deref(X[0])));
  191.     if (table->status == HASH_MISS)
  192.       P = FP0;
  193.       }
  194.       break;
  195.     case SWITCH_ON_STRUCTURE:
  196.       {
  197.     HashTable* table = (HashTable*) table_of_tables->get(P->arg1);
  198.     P = instrp(table->get(*addr(deref(X[0]))));
  199.     if (table->status == HASH_MISS)
  200.       P = FP0;
  201.       }
  202.       break;
  203.     case TRY:
  204.       {
  205.     int number_of_registers = P->arg2;
  206.     B -= FIXED_CP_SIZE + number_of_registers;
  207.     B[E_CP_OFFSET] = cell(E);
  208.     B[H_CP_OFFSET] = cell(H);
  209.     B[TR_CP_OFFSET] = cell(TR);
  210.     B[P_CP_OFFSET] = cell(P);
  211.     B[SIZE_CP_OFFSET] = number_of_registers;
  212.     for (int i = 0; i < number_of_registers; i++)
  213.       B[X1_CP_OFFSET + i] = X[i];
  214.     P = instrp(P->arg1);
  215.       }
  216.       break;
  217.     case RETRY:
  218.       {
  219.     B[P_CP_OFFSET] = cell(P);
  220.     P = instrp(P->arg1);
  221.       }
  222.       break;
  223.     case TRUST:
  224.       {
  225.     B = cellp(E[B_ENV_OFFSET]);
  226.     P = instrp(P->arg1);
  227.       }
  228.       break;
  229.     case TRY_ME_ELSE:
  230.       {
  231.     int number_of_registers = P->arg2;
  232.     B -= FIXED_CP_SIZE + number_of_registers;
  233.     B[E_CP_OFFSET] = cell(E);
  234.     B[H_CP_OFFSET] = cell(H);
  235.     B[TR_CP_OFFSET] = cell(TR);
  236.     B[P_CP_OFFSET] = P->arg1;
  237.     B[SIZE_CP_OFFSET] = number_of_registers;
  238.     for (int i = 0; i < number_of_registers; i++)
  239.       B[X1_CP_OFFSET + i] = X[i];
  240.       }  
  241.       break;
  242.     case RETRY_ME_ELSE:
  243.       {
  244.     B[P_CP_OFFSET] = P->arg1;
  245.       }
  246.       break;
  247.     case TRUST_ME_ELSE:
  248.       {
  249.     B = cellp(E[B_ENV_OFFSET]);
  250.       }
  251.       break;
  252.     case FAIL:
  253.       Fail();
  254.       break;
  255.     case CUT:
  256.       {
  257.     B = cellp(E[B_ENV_OFFSET]);
  258.       }
  259.       break;
  260.     case PROCEED:
  261.       {
  262.     P = instrp(E[P_ENV_OFFSET]);
  263.     E = cellp(E[E_ENV_OFFSET]);
  264. #ifdef WITH_GC
  265.     if (E < E2)
  266.       E2 = E;
  267. #endif
  268.       }
  269.       break;
  270.     case EXECUTE_PROC:
  271.       {
  272.     if (cellp(B[E_CP_OFFSET]) >= E) {
  273.       Cell* NewE = cellp(B[E_CP_OFFSET]) + E_TOP_OFFSET;
  274.       NewE[B_ENV_OFFSET] = cell(B);
  275.       NewE[E_ENV_OFFSET] = E[E_ENV_OFFSET];
  276.       NewE[P_ENV_OFFSET] = E[P_ENV_OFFSET];
  277.       E = NewE;
  278.     }
  279.  
  280. #ifdef WITH_GC
  281.     if (H >= HMAXSOFT)
  282.       garbage_collector();
  283. #else
  284.     if (H > TR)
  285.       top_level_error("Heap Overflow");
  286. #endif
  287.  
  288.     P = instrp(P->arg1);
  289.       }
  290.       break;
  291.     case EXECUTE_LABEL:
  292.       {
  293.     P = instrp(P->arg1);
  294.       }
  295.       break;
  296.     case CALL:
  297.       {
  298.     Cell* top_for_E = E + P->arg2;
  299.     Cell* top_for_B = cellp(B[E_CP_OFFSET]);
  300.     Cell* NewE = max(top_for_E, top_for_B) + E_TOP_OFFSET;
  301.     NewE[B_ENV_OFFSET] = cell(B);
  302.     NewE[E_ENV_OFFSET] = cell(E);
  303.     NewE[P_ENV_OFFSET] = cell(P);
  304.     E = NewE;
  305.  
  306. #ifdef WITH_GC
  307.     if (H >= HMAXSOFT)
  308.       garbage_collector();
  309. #else
  310.     if (H > TR)
  311.       top_level_error("Heap Overflow");
  312. #endif
  313.  
  314.     P = instrp(P->arg1);
  315.       }
  316.       break;
  317.     case ESCAPE:
  318.       {
  319.     (*procp(P->arg1))();
  320.       }
  321.       break;
  322.     case INIT:
  323.       {
  324.     Cell* var = &E[P->arg1];
  325.     *var = make_cell(TAGREF, var);
  326.       }
  327.       break;
  328.     case GET_VARIABLE_X:
  329.       {
  330.     get_variable(X[P->arg1], X[P->arg2]);
  331.       }
  332.       break;
  333.     case GET_VARIABLE_Y:
  334.       {
  335.     get_variable(E[P->arg1], X[P->arg2]);
  336.       }
  337.       break;
  338.     case GET_VALUE_X:
  339.       {
  340.     get_value(X[P->arg1], X[P->arg2]);
  341.       }
  342.       break;
  343.     case GET_VALUE_Y:
  344.       {
  345.     get_value(E[P->arg1], X[P->arg2]);
  346.       }
  347.       break;
  348.     case GET_CONSTANT:
  349.       {
  350.     get_constant(P->arg1, X[P->arg2]);
  351.       }
  352.       break;
  353.     case GET_NIL:
  354.       {
  355.     get_constant(NIL, X[P->arg1]);
  356.       }
  357.       break;
  358.     case GET_STRUCTURE:
  359.       {
  360.     Cell var = deref(X[P->arg2]);
  361.     if (get_tag(var) == TAGREF) {
  362.       MODE = MODE_WRITE;
  363.       Bind(var, make_ptr(TAGSTRUCT, H));
  364.       *H++ = P->arg1;
  365.       *H++ = make_int(P->arg3);
  366.     } else if (get_tag(var) == TAGSTRUCT && rvalue(var) == P->arg1) {
  367.       MODE = MODE_READ;
  368.       S = addr(var) + 2;
  369.     } else {
  370.       P = FP0;
  371.     }
  372.       }
  373.       break;
  374.     case GET_LIST:
  375.       {
  376.     Cell Var = deref(X[P->arg1]);
  377.     switch (get_tag(Var)) {
  378.     case TAGREF:
  379.       MODE = MODE_WRITE;
  380.       Bind(Var, make_ptr(TAGLIST, H));
  381.       break;
  382.     case TAGLIST:
  383.       MODE = MODE_READ;
  384.       S = addr(Var);
  385.       break;
  386.     default:
  387.       P = FP0;
  388.       break;
  389.     }
  390.       }
  391.       break;
  392.     case GET_CDR_LIST:
  393.       {
  394.     if (MODE == MODE_READ) {
  395.       Cell Var = deref(*S++);
  396.       if (get_tag(Var) == TAGLIST) {
  397.         S = addr(Var);
  398.       } else if (get_tag(Var) == TAGREF) {
  399.         MODE = MODE_WRITE;
  400.         Bind(Var, make_ptr(TAGLIST, H));
  401.       } else {
  402.         P = FP0;
  403.       }
  404.     } else {
  405.       get_cdr_list_write();
  406.     }
  407.       }
  408.       break;
  409.     case GET_CDR_LIST_WRITE:
  410.       {
  411.     get_cdr_list_write();
  412.       }
  413.       break;
  414.     case PUT_VARIABLE_X:
  415.       {
  416.     put_variable_X(X[P->arg1], X[P->arg2]);
  417.       }
  418.       break;
  419.     case PUT_VARIABLE_Y:
  420.       {
  421.     put_variable_Y(E[P->arg1], X[P->arg2]);
  422.       }
  423.       break;
  424.     case PUT_VALUE_X:
  425.       {
  426.     put_value(X[P->arg1], X[P->arg2]);
  427.       }
  428.       break;
  429.     case PUT_VALUE_Y:
  430.       {
  431.     put_value(E[P->arg1], X[P->arg2]);
  432.       }
  433.       break;
  434.     case PUT_UNSAFE_VALUE:
  435.       {
  436.     put_unsafe_value(E[P->arg1], X[P->arg2]);
  437.       }
  438.       break;
  439.     case PUT_CONSTANT:
  440.       {
  441.     put_value(P->arg1, X[P->arg2]);
  442.       }
  443.       break;
  444.     case PUT_NIL:
  445.       {
  446.     put_value(NIL, X[P->arg1]);
  447.       }
  448.       break;
  449.     case PUT_STRUCTURE:
  450.       {
  451.     put_structure(P->arg1, X[P->arg2], P->arg3);
  452.       }
  453.       break;
  454.     case PUT_LIST:
  455.       {
  456.     put_list(X[P->arg1]);
  457.       }
  458.       break;
  459.     case UNIFY_VOID:
  460.       {
  461.     unify_void();
  462.       }
  463.       break;
  464.     case UNIFY_VOID_WRITE:
  465.       {
  466.     unify_void_write();
  467.       }
  468.       break;
  469.     case UNIFY_VALUE_X:
  470.       {
  471.     unify_value(X[P->arg1]);
  472.       }
  473.       break;
  474.     case UNIFY_VALUE_Y:
  475.       {
  476.     unify_value(E[P->arg1]);
  477.       }
  478.       break;
  479.     case UNIFY_VALUE_WRITE_X:
  480.       {
  481.     unify_value_write(X[P->arg1]);
  482.       }
  483.       break;
  484.     case UNIFY_VALUE_WRITE_Y:
  485.       {
  486.     unify_value_write(E[P->arg1]);
  487.       }
  488.       break;
  489.     case UNIFY_VARIABLE_X:
  490.       {
  491.     unify_variable(X[P->arg1]);
  492.       }
  493.       break;
  494.     case UNIFY_VARIABLE_Y:
  495.       {
  496.     unify_variable(E[P->arg1]);
  497.       }
  498.       break;
  499.     case UNIFY_VARIABLE_WRITE_X:
  500.       {
  501.     unify_variable_write(X[P->arg1]);
  502.       }
  503.       break;
  504.     case UNIFY_VARIABLE_WRITE_Y:
  505.       {
  506.     unify_variable_write(E[P->arg1]);
  507.       }
  508.       break;
  509.     case UNIFY_UNSAFE_VALUE:
  510.       {
  511.     unify_value(E[P->arg1]);
  512.       }
  513.       break;
  514.     case UNIFY_UNSAFE_VALUE_WRITE:
  515.       {
  516.     unify_value_write(E[P->arg1]);
  517.       }
  518.       break;
  519.     case UNIFY_CONSTANT:
  520.       {
  521.     unify_constant(P->arg1);
  522.       }
  523.       break;
  524.     case UNIFY_CONSTANT_WRITE:
  525.       {
  526.     unify_constant_write(P->arg1);
  527.       }
  528.       break;
  529.     case UNIFY_NIL:
  530.       {
  531.     unify_constant(NIL);
  532.       }
  533.       break;
  534.     case UNIFY_NIL_WRITE:
  535.       {
  536.     unify_constant_write(NIL);
  537.       }
  538.       break;
  539.     case HALT:
  540.       Halt();
  541.       break;
  542.     }
  543.   }
  544. }
  545.