plang: interpreter.c Source File

00001 /*
00002  * plang logic programming language
00003  * Copyright (C) 2011  Southern Storm Software, Pty Ltd.
00004  *
00005  * The plang package is free software: you can redistribute it and/or
00006  * modify it under the terms of the GNU Lesser General Public License
00007  * as published by the Free Software Foundation, either version 3 of
00008  * the License, or (at your option) any later version.
00009  *
00010  * The plang package is distributed in the hope that it will be useful,
00011  * but WITHOUT ANY WARRANTY; without even the implied warranty of
00012  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00013  * GNU Lesser General Public License for more details.
00014  *
00015  * You should have received a copy of the GNU Lesser General Public
00016  * License along with the libcompiler library.  If not,
00017  * see <http://www.gnu.org/licenses/>.
00018  */
00019 
00020 #include "inst-priv.h"
00021 #include "context-priv.h"
00022 
00025 #define P_INST_START_LOOP   \
00026     for (;;) { \
00027         switch (inst->header.opcode) {
00028 #define P_INST_END_LOOP     \
00029         default: break; \
00030         } \
00031     }
00032 
00033 #define P_INST_BEGIN(opcode)            case opcode: {
00034 #define P_INST_BEGIN_LARGE(opcode)      case opcode + 1: {
00035 #define P_INST_END(type)    \
00036     inst = (p_inst *)(((char *)inst) + sizeof(inst->type)); \
00037     break; }
00038 #define P_INST_END_NO_ADVANCE   \
00039     break; }
00040 
00041 #define P_INST_FAIL     return P_RESULT_FAIL /* FIXME */
00042 
00043 void _p_code_set_xreg(p_context *context, int reg, p_term *value)
00044 {
00045     p_term **xregs = context->xregs;
00046     if (reg >= context->num_xregs) {
00047         int num = (reg + 1 + 63) & ~63;
00048         xregs = (p_term **)GC_REALLOC(xregs, sizeof(p_term *) * num);
00049         if (!xregs)
00050             return;
00051         context->xregs = xregs;
00052         context->num_xregs = num;
00053     }
00054     xregs[reg] = value;
00055 }
00056 
00057 p_goal_result _p_code_run
00058     (p_context *context, const p_code_clause *clause, p_term **error)
00059 {
00060     const p_inst *inst;
00061     p_term *term;
00062     p_term *term2;
00063     p_term **xregs;
00064     p_term **yregs = 0;
00065     p_term **put_ptr = 0;
00066 
00067     inst = (p_inst *)(clause->code->inst);
00068 
00069     /* Extend the X register array if this clause needs more */
00070     xregs = context->xregs;
00071     if (clause->num_xregs > context->num_xregs) {
00072         int num = (clause->num_xregs + 63) & ~63;
00073         xregs = (p_term **)GC_REALLOC(xregs, sizeof(p_term *) * num);
00074         if (!xregs)
00075             return P_RESULT_FAIL;
00076         context->xregs = xregs;
00077         context->num_xregs = num;
00078     }
00079 
00080     P_INST_START_LOOP
00081 
00082     /* put_variable Xn
00083      *      Create a new variable and place it into Xn */
00084     P_INST_BEGIN(P_OP_PUT_X_VARIABLE)
00085         term = p_term_create_variable(context);
00086         xregs[inst->one_reg.reg1] = term;
00087     P_INST_END(one_reg)
00088 
00089     /* put_variable2 Xn, Xm
00090      *      Create a new variable and place it into Xn and Xm */
00091     P_INST_BEGIN(P_OP_PUT_X_VARIABLE2)
00092         term = p_term_create_variable(context);
00093         xregs[inst->two_reg.reg1] = term;
00094         xregs[inst->two_reg.reg2] = term;
00095     P_INST_END(two_reg)
00096     P_INST_BEGIN_LARGE(P_OP_PUT_X_VARIABLE2)
00097         term = p_term_create_variable(context);
00098         xregs[inst->large_two_reg.reg1] = term;
00099         xregs[inst->large_two_reg.reg2] = term;
00100     P_INST_END(large_two_reg)
00101 
00102     /* put_variable2 Yn, Xm
00103      *      Create a new variable and place it into Yn and Xm */
00104     P_INST_BEGIN(P_OP_PUT_Y_VARIABLE2)
00105         term = p_term_create_variable(context);
00106         yregs[inst->two_reg.reg1] = term;
00107         xregs[inst->two_reg.reg2] = term;
00108     P_INST_END(two_reg)
00109     P_INST_BEGIN_LARGE(P_OP_PUT_Y_VARIABLE2)
00110         term = p_term_create_variable(context);
00111         yregs[inst->large_two_reg.reg1] = term;
00112         xregs[inst->large_two_reg.reg2] = term;
00113     P_INST_END(large_two_reg)
00114 
00115     /* put_value Xn, Xm
00116      *      Puts the value of Xn into Xm */
00117     P_INST_BEGIN(P_OP_PUT_X_VALUE)
00118         xregs[inst->two_reg.reg2] = xregs[inst->two_reg.reg1];
00119     P_INST_END(two_reg)
00120     P_INST_BEGIN_LARGE(P_OP_PUT_X_VALUE)
00121         xregs[inst->large_two_reg.reg2] =
00122             xregs[inst->large_two_reg.reg1];
00123     P_INST_END(large_two_reg)
00124 
00125     /* put_value Yn, Xm
00126      *      Puts the value of Yn into Xm */
00127     P_INST_BEGIN(P_OP_PUT_Y_VALUE)
00128         xregs[inst->two_reg.reg2] = yregs[inst->two_reg.reg1];
00129     P_INST_END(two_reg)
00130     P_INST_BEGIN_LARGE(P_OP_PUT_Y_VALUE)
00131         xregs[inst->large_two_reg.reg2] =
00132             yregs[inst->large_two_reg.reg1];
00133     P_INST_END(large_two_reg)
00134 
00135     /* put_functor Name/Arity, Xn
00136      *      Puts a new term with functor Name/Arity into Xn */
00137     P_INST_BEGIN(P_OP_PUT_FUNCTOR)
00138         term = p_term_create_functor
00139             (context, inst->functor.name, inst->functor.arity);
00140         put_ptr = &(term->functor.arg[0]);
00141         xregs[inst->functor.reg1] = term;
00142     P_INST_END(functor)
00143     P_INST_BEGIN_LARGE(P_OP_PUT_FUNCTOR)
00144         term = p_term_create_functor
00145             (context, inst->large_functor.name,
00146              inst->large_functor.arity);
00147         put_ptr = &(term->functor.arg[0]);
00148         xregs[inst->large_functor.reg1] = term;
00149     P_INST_END(large_functor)
00150 
00151     /* put_list Xn
00152      *      Puts a new list term into Xn */
00153     P_INST_BEGIN(P_OP_PUT_LIST)
00154         term = p_term_create_list(context, 0, 0);
00155         xregs[inst->one_reg.reg1] = term;
00156         put_ptr = &(term->list.head);
00157     P_INST_END(one_reg)
00158 
00159     /* put_constant Value, Xn
00160      *      Puts a constant Value into Xn */
00161     P_INST_BEGIN(P_OP_PUT_CONSTANT)
00162         xregs[inst->constant.reg1] = inst->constant.value;
00163     P_INST_END(constant)
00164 
00165     /* put_member_variable Xn, Name, Xm
00166      *      Puts a member variable reference for Xn.Name into Xm */
00167     P_INST_BEGIN(P_OP_PUT_MEMBER_VARIABLE)
00168         term = p_term_create_member_variable
00169             (context, xregs[inst->functor.reg1], inst->functor.name, 0);
00170         xregs[inst->functor.arity] = term;
00171     P_INST_END(functor)
00172     P_INST_BEGIN_LARGE(P_OP_PUT_MEMBER_VARIABLE)
00173         term = p_term_create_member_variable
00174             (context, xregs[inst->large_functor.reg1],
00175              inst->large_functor.name, 0);
00176         xregs[inst->large_functor.arity] = term;
00177     P_INST_END(large_functor)
00178 
00179     /* put_member_variable_auto Xn, Name, Xm
00180      *      Puts a member variable reference for Xn..Name into Xm */
00181     P_INST_BEGIN(P_OP_PUT_MEMBER_VARIABLE_AUTO)
00182         term = p_term_create_member_variable
00183             (context, xregs[inst->functor.reg1], inst->functor.name, 1);
00184         xregs[inst->functor.arity] = term;
00185     P_INST_END(functor)
00186     P_INST_BEGIN_LARGE(P_OP_PUT_MEMBER_VARIABLE_AUTO)
00187         term = p_term_create_member_variable
00188             (context, xregs[inst->large_functor.reg1],
00189              inst->large_functor.name, 1);
00190         xregs[inst->large_functor.arity] = term;
00191     P_INST_END(large_functor)
00192 
00193     /* set_variable Xn
00194      *      Sets a variable into the put pointer and Xn */
00195     P_INST_BEGIN(P_OP_SET_X_VARIABLE)
00196         term = p_term_create_variable(context);
00197         *put_ptr++ = term;
00198         xregs[inst->one_reg.reg1] = term;
00199     P_INST_END(one_reg)
00200 
00201     /* set_variable Yn
00202      *      Sets a variable into the put pointer and Yn */
00203     P_INST_BEGIN(P_OP_SET_Y_VARIABLE)
00204         term = p_term_create_variable(context);
00205         *put_ptr++ = term;
00206         yregs[inst->one_reg.reg1] = term;
00207     P_INST_END(one_reg)
00208 
00209     /* set_value Xn
00210      *      Sets the put pointer to the value in Xn */
00211     P_INST_BEGIN(P_OP_SET_X_VALUE)
00212         *put_ptr++ = xregs[inst->one_reg.reg1];
00213     P_INST_END(one_reg)
00214 
00215     /* set_value Yn
00216      *      Sets the put pointer to the value in Yn */
00217     P_INST_BEGIN(P_OP_SET_Y_VALUE)
00218         *put_ptr++ = yregs[inst->one_reg.reg1];
00219     P_INST_END(one_reg)
00220 
00221     /* set_functor Name/Arity, Xn
00222      *      Sets a new term with functor Name/Arity into Xn */
00223     P_INST_BEGIN(P_OP_SET_FUNCTOR)
00224         term = p_term_create_functor
00225             (context, inst->functor.name, inst->functor.arity);
00226         *put_ptr = term;
00227         xregs[inst->functor.reg1] = term;
00228         put_ptr = &(term->functor.arg[0]);
00229     P_INST_END(functor)
00230     P_INST_BEGIN_LARGE(P_OP_SET_FUNCTOR)
00231         term = p_term_create_functor
00232             (context, inst->large_functor.name,
00233              inst->large_functor.arity);
00234         *put_ptr = term;
00235         xregs[inst->large_functor.reg1] = term;
00236         put_ptr = &(term->functor.arg[0]);
00237     P_INST_END(large_functor)
00238 
00239     /* set_list Xn
00240      *      Sets a new list term into Xn */
00241     P_INST_BEGIN(P_OP_SET_LIST)
00242         term = p_term_create_list(context, 0, 0);
00243         *put_ptr = term;
00244         xregs[inst->one_reg.reg1] = term;
00245         put_ptr = &(term->list.head);
00246     P_INST_END(one_reg)
00247 
00248     /* set_list_tail Xn
00249      *      Sets a new list term into the tail of Xn and then replace
00250      *      Xn's value with the new list */
00251     P_INST_BEGIN(P_OP_SET_LIST_TAIL)
00252         term = p_term_create_list(context, 0, 0);
00253         xregs[inst->one_reg.reg1]->list.tail = term;
00254         xregs[inst->one_reg.reg1] = term;
00255         put_ptr = &(term->list.head);
00256     P_INST_END(one_reg)
00257 
00258     /* set_nil_tail Xn
00259      *      Sets the tail of Xn to nil */
00260     P_INST_BEGIN(P_OP_SET_NIL_TAIL)
00261         xregs[inst->one_reg.reg1]->list.tail = context->nil_atom;
00262     P_INST_END(one_reg)
00263 
00264     /* set_constant Value
00265      *      Sets the contents of the put pointer to Value */
00266     P_INST_BEGIN(P_OP_SET_CONSTANT)
00267         *put_ptr++ = inst->constant.value;
00268     P_INST_END(constant)
00269 
00270     /* set_void
00271      *      Sets the put pointer to an anonymous variable */
00272     P_INST_BEGIN(P_OP_SET_VOID)
00273         *put_ptr++ = p_term_create_variable(context);
00274     P_INST_END(header)
00275 
00276     /* get_variable Xn, Ym
00277      *      Moves the value in Xn to Yn.  We create an extra variable
00278      *      shell around the value because Y registers must be vars.
00279      *      Note: "get_x_variable" is the same as "put_x_value" so
00280      *      we don't need a special instruction for that */
00281     P_INST_BEGIN(P_OP_GET_Y_VARIABLE)
00282         term = p_term_create_variable(context);
00283         term->var.value = xregs[inst->two_reg.reg1];
00284         yregs[inst->two_reg.reg2] = term;
00285     P_INST_END(two_reg)
00286     P_INST_BEGIN_LARGE(P_OP_GET_Y_VARIABLE)
00287         term = p_term_create_variable(context);
00288         term->var.value = xregs[inst->large_two_reg.reg1];
00289         yregs[inst->large_two_reg.reg2] = term;
00290     P_INST_END(large_two_reg)
00291 
00292     /* get_value Xn, Xm
00293      *      Unify the contents of Xn and Xm */
00294     P_INST_BEGIN(P_OP_GET_X_VALUE)
00295         if (!p_term_unify(context, xregs[inst->two_reg.reg1],
00296                           xregs[inst->two_reg.reg2], P_BIND_DEFAULT))
00297             P_INST_FAIL;
00298     P_INST_END(two_reg)
00299     P_INST_BEGIN_LARGE(P_OP_GET_X_VALUE)
00300         if (!p_term_unify(context, xregs[inst->large_two_reg.reg1],
00301                           xregs[inst->large_two_reg.reg2],
00302                           P_BIND_DEFAULT))
00303             P_INST_FAIL;
00304     P_INST_END(large_two_reg)
00305 
00306     /* get_value Yn, Xm
00307      *      Unify the contents of Yn and Xm */
00308     P_INST_BEGIN(P_OP_GET_Y_VALUE)
00309         if (!p_term_unify(context, yregs[inst->two_reg.reg1],
00310                           xregs[inst->two_reg.reg2], P_BIND_DEFAULT))
00311             P_INST_FAIL;
00312     P_INST_END(two_reg)
00313     P_INST_BEGIN_LARGE(P_OP_GET_Y_VALUE)
00314         if (!p_term_unify(context, yregs[inst->large_two_reg.reg1],
00315                           xregs[inst->large_two_reg.reg2],
00316                           P_BIND_DEFAULT))
00317             P_INST_FAIL;
00318     P_INST_END(large_two_reg)
00319 
00320     /* get_functor Name/Arity, Xn
00321      *      Unifies Xn against the functor Name/Arity and sets the
00322      *      "current put pointer" to the first functor argument */
00323     P_INST_BEGIN(P_OP_GET_FUNCTOR)
00324         term = p_term_deref(xregs[inst->functor.reg1]);
00325         if (term->header.type == P_TERM_FUNCTOR &&
00326                 term->header.size == inst->functor.arity &&
00327                 term->functor.functor_name == inst->functor.name) {
00328             put_ptr = &(term->functor.arg[0]);
00329         } else if (term->header.type & P_TERM_VARIABLE) {
00330             term2 = p_term_create_functor
00331                 (context, inst->functor.name, inst->functor.arity);
00332             if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00333                 P_INST_FAIL;
00334             put_ptr = &(term2->functor.arg[0]);
00335         } else {
00336             P_INST_FAIL;
00337         }
00338     P_INST_END(functor)
00339     P_INST_BEGIN_LARGE(P_OP_GET_FUNCTOR)
00340         term = p_term_deref(xregs[inst->large_functor.reg1]);
00341         if (term->header.type == P_TERM_FUNCTOR &&
00342                 term->header.size == inst->large_functor.arity &&
00343                 term->functor.functor_name ==
00344                         inst->large_functor.name) {
00345             put_ptr = &(term->functor.arg[0]);
00346         } else if (term->header.type & P_TERM_VARIABLE) {
00347             term2 = p_term_create_functor
00348                 (context, inst->large_functor.name,
00349                  inst->large_functor.arity);
00350             if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00351                 P_INST_FAIL;
00352             put_ptr = &(term2->functor.arg[0]);
00353         } else {
00354             P_INST_FAIL;
00355         }
00356     P_INST_END(large_functor)
00357 
00358     /* get_list Xn, Xm
00359      *      Unifies Xn against a list term and copies the term into Xm.
00360      *      The "current put pointer" is set to the list head */
00361     P_INST_BEGIN(P_OP_GET_LIST)
00362         term = p_term_deref(xregs[inst->two_reg.reg1]);
00363         if (term->header.type == P_TERM_LIST) {
00364             xregs[inst->two_reg.reg2] = term;
00365             put_ptr = &(term->list.head);
00366         } else if (term->header.type & P_TERM_VARIABLE) {
00367             term2 = p_term_create_list(context, 0, 0);
00368             if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00369                 P_INST_FAIL;
00370             xregs[inst->two_reg.reg2] = term2;
00371             put_ptr = &(term2->list.head);
00372         } else {
00373             P_INST_FAIL;
00374         }
00375     P_INST_END(two_reg)
00376     P_INST_BEGIN_LARGE(P_OP_GET_LIST)
00377         term = p_term_deref(xregs[inst->large_two_reg.reg1]);
00378         if (term->header.type == P_TERM_LIST) {
00379             xregs[inst->large_two_reg.reg2] = term;
00380             put_ptr = &(term->list.head);
00381         } else if (term->header.type & P_TERM_VARIABLE) {
00382             term2 = p_term_create_list(context, 0, 0);
00383             if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00384                 P_INST_FAIL;
00385             xregs[inst->large_two_reg.reg2] = term2;
00386             put_ptr = &(term2->list.head);
00387         } else {
00388             P_INST_FAIL;
00389         }
00390     P_INST_END(large_two_reg)
00391 
00392     /* get_atom Value, Xn
00393      *      Unifies Xn against the atom Value */
00394     P_INST_BEGIN(P_OP_GET_ATOM)
00395         term = p_term_deref(xregs[inst->constant.reg1]);
00396         if (term->header.type == P_TERM_ATOM) {
00397             if (term != inst->constant.value)
00398                 P_INST_FAIL;
00399         } else if (term->header.type & P_TERM_VARIABLE) {
00400             if (!p_term_unify(context, term, inst->constant.value,
00401                               P_BIND_DEFAULT))
00402                 P_INST_FAIL;
00403         } else {
00404             P_INST_FAIL;
00405         }
00406     P_INST_END(constant)
00407 
00408     /* get_constant Value, Xn
00409      *      Unifies Xn against the specified constant Value */
00410     P_INST_BEGIN(P_OP_GET_CONSTANT)
00411         term = p_term_deref(xregs[inst->constant.reg1]);
00412         term2 = inst->constant.value;
00413         if (term->header.type == term2->header.type ||
00414                 (term->header.type & P_TERM_VARIABLE) != 0) {
00415             if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00416                 P_INST_FAIL;
00417         } else {
00418             P_INST_FAIL;
00419         }
00420     P_INST_END(constant)
00421 
00422     /* get_in_value Xn, Xm
00423      *      Unify the contents of Xn and Xm, without binding
00424      *      variables within Xm */
00425     P_INST_BEGIN(P_OP_GET_IN_X_VALUE)
00426         if (!p_term_unify(context, xregs[inst->two_reg.reg1],
00427                           xregs[inst->two_reg.reg2], P_BIND_ONE_WAY))
00428             P_INST_FAIL;
00429     P_INST_END(two_reg)
00430     P_INST_BEGIN_LARGE(P_OP_GET_IN_X_VALUE)
00431         if (!p_term_unify(context, xregs[inst->large_two_reg.reg1],
00432                           xregs[inst->large_two_reg.reg2],
00433                           P_BIND_ONE_WAY))
00434             P_INST_FAIL;
00435     P_INST_END(large_two_reg)
00436 
00437     /* get_in_value Yn, Xm
00438      *      Unify the contents of Yn and Xm, without binding
00439      *      variables within Xm */
00440     P_INST_BEGIN(P_OP_GET_IN_Y_VALUE)
00441         if (!p_term_unify(context, yregs[inst->two_reg.reg1],
00442                           xregs[inst->two_reg.reg2], P_BIND_ONE_WAY))
00443             P_INST_FAIL;
00444     P_INST_END(two_reg)
00445     P_INST_BEGIN_LARGE(P_OP_GET_IN_Y_VALUE)
00446         if (!p_term_unify(context, yregs[inst->large_two_reg.reg1],
00447                           xregs[inst->large_two_reg.reg2],
00448                           P_BIND_ONE_WAY))
00449             P_INST_FAIL;
00450     P_INST_END(large_two_reg)
00451 
00452     /* get_in_functor Name/Arity, Xn
00453      *      Unifies Xn against the functor Name/Arity and sets the
00454      *      "current put pointer" to the first functor argument.
00455      *      This instruction does not bind variables in Xn */
00456     P_INST_BEGIN(P_OP_GET_IN_FUNCTOR)
00457         term = p_term_deref(xregs[inst->functor.reg1]);
00458         if (term->header.type == P_TERM_FUNCTOR &&
00459                 term->header.size == inst->functor.arity &&
00460                 term->functor.functor_name == inst->functor.name) {
00461             put_ptr = &(term->functor.arg[0]);
00462         } else {
00463             P_INST_FAIL;
00464         }
00465     P_INST_END(functor)
00466     P_INST_BEGIN_LARGE(P_OP_GET_IN_FUNCTOR)
00467         term = p_term_deref(xregs[inst->large_functor.reg1]);
00468         if (term->header.type == P_TERM_FUNCTOR &&
00469                 term->header.size == inst->large_functor.arity &&
00470                 term->functor.functor_name ==
00471                         inst->large_functor.name) {
00472             put_ptr = &(term->functor.arg[0]);
00473         } else {
00474             P_INST_FAIL;
00475         }
00476     P_INST_END(large_functor)
00477 
00478     /* get_in_list Xn, Xm
00479      *      Unifies Xn against a list term and copies the term into Xm.
00480      *      The "current put pointer" is set to the list head.
00481      *      This instruction does not bind variables in Xn */
00482     P_INST_BEGIN(P_OP_GET_IN_LIST)
00483         term = p_term_deref(xregs[inst->two_reg.reg1]);
00484         if (term->header.type == P_TERM_LIST) {
00485             xregs[inst->two_reg.reg2] = term;
00486             put_ptr = &(term->list.head);
00487         } else {
00488             P_INST_FAIL;
00489         }
00490     P_INST_END(two_reg)
00491     P_INST_BEGIN_LARGE(P_OP_GET_IN_LIST)
00492         term = p_term_deref(xregs[inst->large_two_reg.reg1]);
00493         if (term->header.type == P_TERM_LIST) {
00494             xregs[inst->large_two_reg.reg2] = term;
00495             put_ptr = &(term->list.head);
00496         } else {
00497             P_INST_FAIL;
00498         }
00499     P_INST_END(large_two_reg)
00500 
00501     /* get_in_atom Value, Xn
00502      *      Unifies Xn against the atom Value, without binding
00503      *      variables in Xn */
00504     P_INST_BEGIN(P_OP_GET_IN_ATOM)
00505         term = p_term_deref(xregs[inst->constant.reg1]);
00506         if (term->header.type == P_TERM_ATOM) {
00507             if (term != inst->constant.value)
00508                 P_INST_FAIL;
00509         } else {
00510             P_INST_FAIL;
00511         }
00512     P_INST_END(constant)
00513 
00514     /* get_in_constant Value, Xn
00515      *      Unifies Xn against the specified constant Value,
00516      *      without binding variables in Xn */
00517     P_INST_BEGIN(P_OP_GET_IN_CONSTANT)
00518         term = p_term_deref(xregs[inst->constant.reg1]);
00519         term2 = inst->constant.value;
00520         if (term->header.type == term2->header.type) {
00521             if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00522                 P_INST_FAIL;
00523         } else {
00524             P_INST_FAIL;
00525         }
00526     P_INST_END(constant)
00527 
00528     /* unify_variable Xn
00529      *      Loads the contents of the put pointer into Xn or creates a
00530      *      new variable if the contents are null */
00531     P_INST_BEGIN(P_OP_UNIFY_X_VARIABLE)
00532         term = *put_ptr;
00533         if (term) {
00534             xregs[inst->one_reg.reg1] = term;
00535             ++put_ptr;
00536         } else {
00537             *put_ptr++ = term = p_term_create_variable(context);
00538             xregs[inst->one_reg.reg1] = term;
00539         }
00540     P_INST_END(one_reg)
00541 
00542     /* unify_variable Yn
00543      *      Loads the contents of the put pointer into Yn or creates a
00544      *      new variable if the contents are null */
00545     P_INST_BEGIN(P_OP_UNIFY_Y_VARIABLE)
00546         term = *put_ptr;
00547         if (term) {
00548             yregs[inst->one_reg.reg1] = term;
00549             ++put_ptr;
00550         } else {
00551             *put_ptr++ = term = p_term_create_variable(context);
00552             yregs[inst->one_reg.reg1] = term;
00553         }
00554     P_INST_END(one_reg)
00555 
00556     /* unify_value Xn
00557      *      Unifies the contents of the put pointer with Xn */
00558     P_INST_BEGIN(P_OP_UNIFY_X_VALUE)
00559         term = *put_ptr;
00560         if (term) {
00561             ++put_ptr;
00562             if (!p_term_unify(context, term, xregs[inst->one_reg.reg1],
00563                               P_BIND_DEFAULT))
00564                 P_INST_FAIL;
00565         } else {
00566             *put_ptr++ = xregs[inst->one_reg.reg1];
00567         }
00568     P_INST_END(one_reg)
00569 
00570     /* unify_value Yn
00571      *      Unifies the contents of the put pointer with Yn */
00572     P_INST_BEGIN(P_OP_UNIFY_Y_VALUE)
00573         term = *put_ptr;
00574         if (term) {
00575             ++put_ptr;
00576             if (!p_term_unify(context, term, yregs[inst->one_reg.reg1],
00577                               P_BIND_DEFAULT))
00578                 P_INST_FAIL;
00579         } else {
00580             *put_ptr++ = yregs[inst->one_reg.reg1];
00581         }
00582     P_INST_END(one_reg)
00583 
00584     /* unify_functor Name/Arity, Xn
00585      *      Unifies the contents of the put pointer with the
00586      *      function Name/Arity and copies the term into Xn */
00587     P_INST_BEGIN(P_OP_UNIFY_FUNCTOR)
00588         term = *put_ptr;
00589         if (term) {
00590             term = p_term_deref(term);
00591             if (term->header.type == P_TERM_FUNCTOR &&
00592                     term->header.size == inst->functor.arity &&
00593                     term->functor.functor_name
00594                             == inst->functor.name) {
00595                 xregs[inst->functor.reg1] = term;
00596                 put_ptr = &(term->functor.arg[0]);
00597             } else if (term->header.type & P_TERM_VARIABLE) {
00598                 term2 = p_term_create_functor
00599                     (context, inst->functor.name, inst->functor.arity);
00600                 if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00601                     P_INST_FAIL;
00602                 xregs[inst->functor.reg1] = term2;
00603                 put_ptr = &(term2->functor.arg[0]);
00604             } else {
00605                 P_INST_FAIL;
00606             }
00607         } else {
00608             term = p_term_create_functor
00609                 (context, inst->functor.name, inst->functor.arity);
00610             *put_ptr = term;
00611             xregs[inst->functor.reg1] = term;
00612             put_ptr = &(term->functor.arg[0]);
00613         }
00614     P_INST_END(functor)
00615     P_INST_BEGIN_LARGE(P_OP_UNIFY_FUNCTOR)
00616         term = *put_ptr;
00617         if (term) {
00618             term = p_term_deref(term);
00619             if (term->header.type == P_TERM_FUNCTOR &&
00620                     term->header.size == inst->large_functor.arity &&
00621                     term->functor.functor_name
00622                             == inst->large_functor.name) {
00623                 xregs[inst->large_functor.reg1] = term;
00624                 put_ptr = &(term->functor.arg[0]);
00625             } else if (term->header.type & P_TERM_VARIABLE) {
00626                 term2 = p_term_create_functor
00627                     (context, inst->large_functor.name,
00628                      inst->large_functor.arity);
00629                 if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00630                     P_INST_FAIL;
00631                 xregs[inst->large_functor.reg1] = term2;
00632                 put_ptr = &(term2->functor.arg[0]);
00633             } else {
00634                 P_INST_FAIL;
00635             }
00636         } else {
00637             term = p_term_create_functor
00638                 (context, inst->large_functor.name,
00639                  inst->large_functor.arity);
00640             *put_ptr = term;
00641             xregs[inst->large_functor.reg1] = term;
00642             put_ptr = &(term->functor.arg[0]);
00643         }
00644     P_INST_END(large_functor)
00645 
00646     /* unify_list Xn
00647      *      Unifies the contents of the put pointer with a list
00648      *      and copies the list term into Xn */
00649     P_INST_BEGIN(P_OP_UNIFY_LIST)
00650         term = *put_ptr;
00651         if (term) {
00652             term = p_term_deref(term);
00653             if (term->header.type == P_TERM_LIST) {
00654                 xregs[inst->one_reg.reg1] = term;
00655                 put_ptr = &(term->list.head);
00656             } else if (term->header.type & P_TERM_VARIABLE) {
00657                 term2 = p_term_create_list(context, 0, 0);
00658                 if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00659                     P_INST_FAIL;
00660                 xregs[inst->one_reg.reg1] = term2;
00661                 put_ptr = &(term2->list.head);
00662             } else {
00663                 P_INST_FAIL;
00664             }
00665         } else {
00666             term = p_term_create_list(context, 0, 0);
00667             *put_ptr = term;
00668             xregs[inst->one_reg.reg1] = term;
00669             put_ptr = &(term->list.head);
00670         }
00671     P_INST_END(one_reg)
00672 
00673     /* unify_list_tail Xn
00674      *      Unifies the tail of Xn with a list and then replaces
00675      *      the contents of Xn with a reference to the new list */
00676     P_INST_BEGIN(P_OP_UNIFY_LIST_TAIL)
00677         term = xregs[inst->one_reg.reg1];
00678         if (term->list.tail) {
00679             term = p_term_deref(term->list.tail);
00680             if (term->header.type == P_TERM_LIST) {
00681                 xregs[inst->one_reg.reg1] = term;
00682                 put_ptr = &(term->list.head);
00683             } else if (term->header.type & P_TERM_VARIABLE) {
00684                 term2 = p_term_create_list(context, 0, 0);
00685                 if (!p_term_unify(context, term, term2, P_BIND_DEFAULT))
00686                     P_INST_FAIL;
00687                 xregs[inst->one_reg.reg1] = term2;
00688                 put_ptr = &(term2->list.head);
00689             } else {
00690                 P_INST_FAIL;
00691             }
00692         } else {
00693             term2 = p_term_create_list(context, 0, 0);
00694             term->list.tail = term2;
00695             xregs[inst->one_reg.reg1] = term2;
00696             put_ptr = &(term2->list.head);
00697         }
00698     P_INST_END(one_reg)
00699 
00700     /* unify_nil_tail Xn
00701      *      Unifies the tail of Xn with nil */
00702     P_INST_BEGIN(P_OP_UNIFY_NIL_TAIL)
00703         term = xregs[inst->one_reg.reg1];
00704         if (term->list.tail) {
00705             term = p_term_deref(term->list.tail);
00706             if (term->header.type & P_TERM_VARIABLE) {
00707                 if (!p_term_unify(context, term, context->nil_atom,
00708                                   P_BIND_DEFAULT))
00709                     P_INST_FAIL;
00710             } else if (term != context->nil_atom) {
00711                 P_INST_FAIL;
00712             }
00713         } else {
00714             term->list.tail = context->nil_atom;
00715         }
00716     P_INST_END(one_reg)
00717 
00718     /* unify_atom Value
00719      *      Unifies the contents of the put pointer with Value */
00720     P_INST_BEGIN(P_OP_UNIFY_ATOM)
00721         term = p_term_deref(*put_ptr);
00722         if (term == inst->constant.value) {
00723             ++put_ptr;
00724         } else if (term) {
00725             if (!p_term_unify(context, term, inst->constant.value,
00726                               P_BIND_DEFAULT))
00727                 P_INST_FAIL;
00728             ++put_ptr;
00729         } else {
00730             *put_ptr++ = inst->constant.value;
00731         }
00732     P_INST_END(constant)
00733 
00734     /* unify_constant Value
00735      *      Unifies the contents of the put pointer with Value */
00736     P_INST_BEGIN(P_OP_UNIFY_CONSTANT)
00737         term = *put_ptr;
00738         if (term) {
00739             if (!p_term_unify(context, term, inst->constant.value,
00740                               P_BIND_DEFAULT))
00741                 P_INST_FAIL;
00742             ++put_ptr;
00743         } else {
00744             *put_ptr++ = inst->constant.value;
00745         }
00746     P_INST_END(constant)
00747 
00748     /* unify_void
00749      *      Unifies the contents of the put pointer with an
00750      *      anonymous variable */
00751     P_INST_BEGIN(P_OP_UNIFY_VOID)
00752         term = *put_ptr;
00753         if (!term)
00754             *put_ptr++ = p_term_create_variable(context);
00755         else
00756             ++put_ptr;
00757     P_INST_END(header)
00758 
00759     /* unify_in_value Xn
00760      *      Unifies the contents of the put pointer with Xn,
00761      *      without modifying the put pointer's contents */
00762     P_INST_BEGIN(P_OP_UNIFY_IN_X_VALUE)
00763         term = *put_ptr++;
00764         if (!p_term_unify(context, xregs[inst->one_reg.reg1], term,
00765                           P_BIND_ONE_WAY))
00766             P_INST_FAIL;
00767     P_INST_END(one_reg)
00768 
00769     /* unify_in_value Yn
00770      *      Unifies the contents of the put pointer with Yn,
00771      *      without modifying the put pointer's contents */
00772     P_INST_BEGIN(P_OP_UNIFY_IN_Y_VALUE)
00773         term = *put_ptr++;
00774         if (!p_term_unify(context, yregs[inst->one_reg.reg1], term,
00775                           P_BIND_ONE_WAY))
00776             P_INST_FAIL;
00777     P_INST_END(one_reg)
00778 
00779     /* unify_in_functor Name/Arity, Xn
00780      *      Unifies the contents of the put pointer with the
00781      *      function Name/Arity and copies the term into Xn.
00782      *      The put pointer's contents must not be modified */
00783     P_INST_BEGIN(P_OP_UNIFY_IN_FUNCTOR)
00784         term = p_term_deref(*put_ptr);
00785         if (term->header.type == P_TERM_FUNCTOR &&
00786                 term->header.size == inst->functor.arity &&
00787                 term->functor.functor_name == inst->functor.name) {
00788             xregs[inst->functor.reg1] = term;
00789             put_ptr = &(term->functor.arg[0]);
00790         } else {
00791             P_INST_FAIL;
00792         }
00793     P_INST_END(functor)
00794     P_INST_BEGIN_LARGE(P_OP_UNIFY_IN_FUNCTOR)
00795         term = p_term_deref(*put_ptr);
00796         if (term->header.type == P_TERM_FUNCTOR &&
00797                 term->header.size == inst->large_functor.arity &&
00798                 term->functor.functor_name
00799                         == inst->large_functor.name) {
00800             xregs[inst->large_functor.reg1] = term;
00801             put_ptr = &(term->functor.arg[0]);
00802         } else {
00803             P_INST_FAIL;
00804         }
00805     P_INST_END(large_functor)
00806 
00807     /* unify_in_list Xn
00808      *      Unifies the contents of the put pointer with a list
00809      *      and copies the list term into Xn.  The contents of the
00810      *      put pointer must not be modified. */
00811     P_INST_BEGIN(P_OP_UNIFY_IN_LIST)
00812         term = p_term_deref(*put_ptr);
00813         if (term->header.type == P_TERM_LIST) {
00814             xregs[inst->one_reg.reg1] = term;
00815             put_ptr = &(term->list.head);
00816         } else {
00817             P_INST_FAIL;
00818         }
00819     P_INST_END(one_reg)
00820 
00821     /* unify_in_list_tail Xn
00822      *      Unifies the tail of Xn with a list and then replaces
00823      *      the contents of Xn with a reference to the new list.
00824      *      The put pointer's contents must not be modified */
00825     P_INST_BEGIN(P_OP_UNIFY_IN_LIST_TAIL)
00826         term = xregs[inst->one_reg.reg1];
00827         term = p_term_deref(term->list.tail);
00828         if (term->header.type == P_TERM_LIST) {
00829             xregs[inst->one_reg.reg1] = term;
00830             put_ptr = &(term->list.head);
00831         } else {
00832             P_INST_FAIL;
00833         }
00834     P_INST_END(one_reg)
00835 
00836     /* unify_in_nil_tail Xn
00837      *      Unifies the tail of Xn with nil, without modifying
00838      *      the term pointed to by Xn */
00839     P_INST_BEGIN(P_OP_UNIFY_IN_NIL_TAIL)
00840         term = xregs[inst->one_reg.reg1];
00841         term = p_term_deref(term->list.tail);
00842         if (term != context->nil_atom)
00843             P_INST_FAIL;
00844     P_INST_END(one_reg)
00845 
00846     /* unify_in_atom Value
00847      *      Unifies the contents of the put pointer with Value,
00848      *      without modifying the contents of the put pointer */
00849     P_INST_BEGIN(P_OP_UNIFY_IN_ATOM)
00850         term = p_term_deref(*put_ptr);
00851         if (term == inst->constant.value)
00852             ++put_ptr;
00853         else
00854             P_INST_FAIL;
00855     P_INST_END(constant)
00856 
00857     /* unify_in_constant Value
00858      *      Unifies the contents of the put pointer with Value,
00859      *      without modifying the contents of the put pointer */
00860     P_INST_BEGIN(P_OP_UNIFY_IN_CONSTANT)
00861         term = p_term_deref(*put_ptr);
00862         if (term->header.type == inst->constant.value->header.type) {
00863             if (!p_term_unify(context, term, inst->constant.value,
00864                               P_BIND_DEFAULT))
00865                 P_INST_FAIL;
00866             ++put_ptr;
00867         } else {
00868             P_INST_FAIL;
00869         }
00870     P_INST_END(constant)
00871 
00872     /* unify_in_void
00873      *      Unifies the contents of the put pointer with an
00874      *      anonymous variable, without modifying the incoming value */
00875     P_INST_BEGIN(P_OP_UNIFY_IN_VOID)
00876         ++put_ptr;
00877     P_INST_END(header)
00878 
00879     /* reset_argument Xn, ArgIndex
00880      *      Resets the put pointer to ArgIndex on functor Xn */
00881     P_INST_BEGIN(P_OP_RESET_ARGUMENT)
00882         term = p_term_deref(xregs[inst->two_reg.reg1]);
00883         put_ptr = &(term->functor.arg[inst->two_reg.reg2]);
00884     P_INST_END(two_reg)
00885     P_INST_BEGIN_LARGE(P_OP_RESET_ARGUMENT)
00886         term = p_term_deref(xregs[inst->large_two_reg.reg1]);
00887         put_ptr = &(term->functor.arg[inst->large_two_reg.reg2]);
00888     P_INST_END(large_two_reg)
00889 
00890     /* reset_tail Xn
00891      *      Resets the put pointer to the tail of Xn */
00892     P_INST_BEGIN(P_OP_RESET_TAIL)
00893         term = p_term_deref(xregs[inst->one_reg.reg1]);
00894         put_ptr = &(term->list.tail);
00895     P_INST_END(one_reg)
00896 
00897     /* jump Label
00898      *      Jumps to an instruction label */
00899     P_INST_BEGIN(P_OP_JUMP)
00900         inst = inst->label.label;
00901     P_INST_END_NO_ADVANCE
00902 
00903     /* proceed
00904      *      Returns from the current predicate and succeeds */
00905     P_INST_BEGIN(P_OP_PROCEED)
00906         /* FIXME */
00907         return P_RESULT_TRUE;
00908     P_INST_END_NO_ADVANCE
00909 
00910     /* fail
00911      *      Fails the current search path */
00912     P_INST_BEGIN(P_OP_FAIL)
00913         P_INST_FAIL;
00914     P_INST_END_NO_ADVANCE
00915 
00916     /* return Xn
00917      *      Returns from the current predicate with the value in Xn.
00918      *      This is used by dynamic clauses to return the body */
00919     P_INST_BEGIN(P_OP_RETURN)
00920         *error = xregs[inst->one_reg.reg1];
00921         return P_RESULT_RETURN_BODY;
00922     P_INST_END_NO_ADVANCE
00923 
00924     /* return_true
00925      *      Returns from the current predicate with success.
00926      *      This is used by dynamic clauses with no body */
00927     P_INST_BEGIN(P_OP_RETURN_TRUE)
00928         return P_RESULT_TRUE;
00929     P_INST_END_NO_ADVANCE
00930 
00931     /* throw Xn
00932      *      Throws the contents of Xn as an error */
00933     P_INST_BEGIN(P_OP_THROW)
00934         /* FIXME */
00935         *error = xregs[inst->one_reg.reg1];
00936         return P_RESULT_ERROR;
00937     P_INST_END_NO_ADVANCE
00938 
00939 #if 0
00940     P_OP_CALL,
00941     P_OP_EXECUTE,
00942 
00943     P_OP_TRY_ME_ELSE,
00944     P_OP_RETRY_ME_ELSE,
00945     P_OP_TRUST_ME,
00946 
00947     P_OP_NECK_CUT,
00948     P_OP_GET_LEVEL,
00949     P_OP_CUT,
00950 #endif
00951 
00952     /* end
00953      *      End of predicate marker that is used by the disassembler.
00954      *      Should never be executed because it will normally be
00955      *      preceded by a "return", "proceed", etc instruction. */
00956     P_INST_BEGIN(P_OP_END)
00957         P_INST_FAIL;
00958     P_INST_END_NO_ADVANCE
00959 
00960     P_INST_END_LOOP
00961 }
00962