plang: disassembler.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 
00024 enum {
00025     P_ARG_NONE,
00026     P_ARG_X,
00027     P_ARG_Y,
00028     P_ARG_X_X,
00029     P_ARG_Y_X,
00030     P_ARG_X_Y,
00031     P_ARG_X_X_LARGE,
00032     P_ARG_Y_X_LARGE,
00033     P_ARG_X_Y_LARGE,
00034     P_ARG_FUNCTOR,
00035     P_ARG_FUNCTOR_LARGE,
00036     P_ARG_CONSTANT,
00037     P_ARG_CONSTANT_X,
00038     P_ARG_MEMBER,
00039     P_ARG_MEMBER_LARGE,
00040     P_ARG_RESET,
00041     P_ARG_RESET_LARGE,
00042     P_ARG_LABEL
00043 };
00044 
00045 enum {
00046     P_TYPE_GET,
00047     P_TYPE_STOP,
00048     P_TYPE_SKIP
00049 };
00050 
00051 typedef struct p_inst_info p_inst_info;
00052 struct p_inst_info
00053 {
00054     const char *name;
00055 #if defined(P_TERM_64BIT)
00056     int arg_types;
00057     int get_put_type;
00058 #else
00059     short arg_types;
00060     short get_put_type;
00061 #endif
00062 };
00063 static p_inst_info const instructions[] = {
00064     {"put_variable",                P_ARG_X, P_TYPE_SKIP},
00065     {"put_variable2",               P_ARG_X_X, P_TYPE_SKIP},
00066     {"put_variable2_large",         P_ARG_X_X_LARGE, P_TYPE_SKIP},
00067     {"put_variable2",               P_ARG_Y_X, P_TYPE_SKIP},
00068     {"put_variable2_large",         P_ARG_Y_X_LARGE, P_TYPE_SKIP},
00069     {"put_value",                   P_ARG_X_X, P_TYPE_GET},
00070     {"put_value_large",             P_ARG_X_X_LARGE, P_TYPE_GET},
00071     {"put_value",                   P_ARG_Y_X, P_TYPE_SKIP},
00072     {"put_value_large",             P_ARG_Y_X_LARGE, P_TYPE_SKIP},
00073     {"put_functor",                 P_ARG_FUNCTOR, P_TYPE_STOP},
00074     {"put_functor_large",           P_ARG_FUNCTOR_LARGE, P_TYPE_STOP},
00075     {"put_list",                    P_ARG_X, P_TYPE_STOP},
00076     {"put_constant",                P_ARG_CONSTANT_X, P_TYPE_STOP},
00077     {"put_member_variable",         P_ARG_MEMBER, P_TYPE_SKIP},
00078     {"put_member_variable_large",   P_ARG_MEMBER_LARGE, P_TYPE_SKIP},
00079     {"put_member_variable_auto",    P_ARG_MEMBER, P_TYPE_SKIP},
00080     {"put_member_variable_auto_large", P_ARG_MEMBER_LARGE, P_TYPE_SKIP},
00081 
00082     {"set_variable",                P_ARG_X, P_TYPE_STOP},
00083     {"set_variable",                P_ARG_Y, P_TYPE_STOP},
00084     {"set_value",                   P_ARG_X, P_TYPE_STOP},
00085     {"set_value",                   P_ARG_Y, P_TYPE_STOP},
00086     {"set_functor",                 P_ARG_FUNCTOR, P_TYPE_STOP},
00087     {"set_functor_large",           P_ARG_FUNCTOR_LARGE, P_TYPE_STOP},
00088     {"set_list",                    P_ARG_X, P_TYPE_STOP},
00089     {"set_list_tail",               P_ARG_X, P_TYPE_STOP},
00090     {"set_nil_tail",                P_ARG_X, P_TYPE_STOP},
00091     {"set_constant",                P_ARG_CONSTANT, P_TYPE_STOP},
00092     {"set_void",                    P_ARG_NONE, P_TYPE_STOP},
00093 
00094     {"get_variable",                P_ARG_X_Y, P_TYPE_GET},
00095     {"get_variable_large",          P_ARG_X_Y_LARGE, P_TYPE_GET},
00096     {"get_value",                   P_ARG_X_X, P_TYPE_GET},
00097     {"get_value_large",             P_ARG_X_X_LARGE, P_TYPE_GET},
00098     {"get_value",                   P_ARG_Y_X, P_TYPE_GET},
00099     {"get_value_large",             P_ARG_Y_X_LARGE, P_TYPE_GET},
00100     {"get_functor",                 P_ARG_FUNCTOR, P_TYPE_GET},
00101     {"get_functor_large",           P_ARG_FUNCTOR_LARGE, P_TYPE_GET},
00102     {"get_list",                    P_ARG_X_X, P_TYPE_GET},
00103     {"get_list_large",              P_ARG_X_X_LARGE, P_TYPE_GET},
00104     {"get_atom",                    P_ARG_CONSTANT_X, P_TYPE_GET},
00105     {"get_constant",                P_ARG_CONSTANT_X, P_TYPE_GET},
00106 
00107     {"get_in_value",                P_ARG_X_X, P_TYPE_GET},
00108     {"get_in_value_large",          P_ARG_X_X_LARGE, P_TYPE_GET},
00109     {"get_in_value",                P_ARG_Y_X, P_TYPE_GET},
00110     {"get_in_value_large",          P_ARG_Y_X_LARGE, P_TYPE_GET},
00111     {"get_in_functor",              P_ARG_FUNCTOR, P_TYPE_GET},
00112     {"get_in_functor_large",        P_ARG_FUNCTOR_LARGE, P_TYPE_GET},
00113     {"get_in_list",                 P_ARG_X_X, P_TYPE_GET},
00114     {"get_in_list_large",           P_ARG_X_X_LARGE, P_TYPE_GET},
00115     {"get_in_atom",                 P_ARG_CONSTANT_X, P_TYPE_GET},
00116     {"get_in_constant",             P_ARG_CONSTANT_X, P_TYPE_GET},
00117 
00118     {"unify_variable",              P_ARG_X, P_TYPE_SKIP},
00119     {"unify_variable",              P_ARG_Y, P_TYPE_SKIP},
00120     {"unify_value",                 P_ARG_X, P_TYPE_SKIP},
00121     {"unify_value",                 P_ARG_Y, P_TYPE_SKIP},
00122     {"unify_functor",               P_ARG_FUNCTOR, P_TYPE_SKIP},
00123     {"unify_functor_large",         P_ARG_FUNCTOR_LARGE, P_TYPE_SKIP},
00124     {"unify_list",                  P_ARG_X, P_TYPE_SKIP},
00125     {"unify_list_tail",             P_ARG_X, P_TYPE_SKIP},
00126     {"unify_nil_tail",              P_ARG_X, P_TYPE_SKIP},
00127     {"unify_atom",                  P_ARG_CONSTANT, P_TYPE_SKIP},
00128     {"unify_constant",              P_ARG_CONSTANT, P_TYPE_SKIP},
00129     {"unify_void",                  P_ARG_NONE, P_TYPE_SKIP},
00130 
00131     {"unify_in_value",              P_ARG_X, P_TYPE_SKIP},
00132     {"unify_in_value",              P_ARG_Y, P_TYPE_SKIP},
00133     {"unify_in_functor",            P_ARG_FUNCTOR, P_TYPE_SKIP},
00134     {"unify_in_functor_large",      P_ARG_FUNCTOR_LARGE, P_TYPE_SKIP},
00135     {"unify_in_list",               P_ARG_X, P_TYPE_SKIP},
00136     {"unify_in_list_tail",          P_ARG_X, P_TYPE_SKIP},
00137     {"unify_in_nil_tail",           P_ARG_X, P_TYPE_SKIP},
00138     {"unify_in_atom",               P_ARG_CONSTANT, P_TYPE_SKIP},
00139     {"unify_in_constant",           P_ARG_CONSTANT, P_TYPE_SKIP},
00140     {"unify_in_void",               P_ARG_NONE, P_TYPE_SKIP},
00141 
00142     {"reset_argument",              P_ARG_RESET, P_TYPE_SKIP},
00143     {"reset_argument_large",        P_ARG_RESET_LARGE, P_TYPE_SKIP},
00144     {"reset_tail",                  P_ARG_X, P_TYPE_SKIP},
00145 
00146     {"jump",                        P_ARG_LABEL, P_TYPE_SKIP},
00147 
00148     {"proceed",                     P_ARG_NONE, P_TYPE_STOP},
00149     {"fail",                        P_ARG_NONE, P_TYPE_STOP},
00150     {"return",                      P_ARG_X, P_TYPE_STOP},
00151     {"return_true",                 P_ARG_NONE, P_TYPE_STOP},
00152     {"throw",                       P_ARG_X, P_TYPE_STOP},
00153 
00154 #if 0
00155     P_OP_CALL,
00156     P_OP_EXECUTE,
00157 
00158     P_OP_TRY_ME_ELSE,
00159     P_OP_RETRY_ME_ELSE,
00160     P_OP_TRUST_ME,
00161 
00162     P_OP_NECK_CUT,
00163     P_OP_GET_LEVEL,
00164     P_OP_CUT,
00165 #endif
00166 
00167     {"end",                         P_ARG_NONE, P_TYPE_STOP}
00168 };
00169 
00170 void _p_code_disassemble
00171     (FILE *output, p_context *context, const p_code_clause *clause)
00172 {
00173     p_opcode opcode;
00174     size_t size;
00175     const p_inst *inst = (p_inst *)(clause->code->inst);
00176     for (;;) {
00177         opcode = (p_opcode)(inst->header.opcode);
00178         if (opcode == P_OP_JUMP) {
00179             /* Jump to next continuation code block - not important */
00180             inst = inst->label.label;
00181             continue;
00182         } else if (opcode == P_OP_END) {
00183             /* We've reached the end of the predicate code */
00184             break;
00185         }
00186         fprintf(output, "%08lx: %s", (long)inst,
00187                 instructions[opcode].name);
00188         switch (instructions[opcode].arg_types) {
00189         case P_ARG_NONE:
00190         default:
00191             size = sizeof(inst->header);
00192             break;
00193         case P_ARG_X:
00194             fprintf(output, " X%u", inst->one_reg.reg1);
00195             size = sizeof(inst->one_reg);
00196             break;
00197         case P_ARG_Y:
00198             fprintf(output, " Y%u", inst->one_reg.reg1);
00199             size = sizeof(inst->one_reg);
00200             break;
00201         case P_ARG_X_X:
00202             fprintf(output, " X%u, X%u", inst->two_reg.reg1,
00203                     inst->two_reg.reg2);
00204             size = sizeof(inst->two_reg);
00205             break;
00206         case P_ARG_Y_X:
00207             fprintf(output, " Y%u, X%u", inst->two_reg.reg1,
00208                     inst->two_reg.reg2);
00209             size = sizeof(inst->two_reg);
00210             break;
00211         case P_ARG_X_Y:
00212             fprintf(output, " X%u, Y%u", inst->two_reg.reg1,
00213                     inst->two_reg.reg2);
00214             size = sizeof(inst->two_reg);
00215             break;
00216         case P_ARG_X_X_LARGE:
00217             fprintf(output, " X%u, X%u", inst->large_two_reg.reg1,
00218                     inst->large_two_reg.reg2);
00219             size = sizeof(inst->large_two_reg);
00220             break;
00221         case P_ARG_Y_X_LARGE:
00222             fprintf(output, " Y%u, X%u", inst->large_two_reg.reg1,
00223                     inst->large_two_reg.reg2);
00224             size = sizeof(inst->large_two_reg);
00225             break;
00226         case P_ARG_X_Y_LARGE:
00227             fprintf(output, " X%u, Y%u", inst->large_two_reg.reg1,
00228                     inst->large_two_reg.reg2);
00229             size = sizeof(inst->large_two_reg);
00230             break;
00231         case P_ARG_FUNCTOR:
00232             putc(' ', output);
00233             p_term_print(context, inst->functor.name,
00234                          p_term_stdio_print_func, output);
00235             fprintf(output, "/%u, X%u",
00236                     inst->functor.arity, inst->functor.reg1);
00237             size = sizeof(inst->functor);
00238             break;
00239         case P_ARG_FUNCTOR_LARGE:
00240             putc(' ', output);
00241             p_term_print(context, inst->large_functor.name,
00242                          p_term_stdio_print_func, output);
00243             fprintf(output, "/%u, X%u",
00244                     inst->large_functor.arity,
00245                     inst->large_functor.reg1);
00246             size = sizeof(inst->large_functor);
00247             break;
00248         case P_ARG_CONSTANT:
00249             putc(' ', output);
00250             p_term_print(context, inst->constant.value,
00251                          p_term_stdio_print_func, output);
00252             size = sizeof(inst->constant);
00253             break;
00254         case P_ARG_CONSTANT_X:
00255             putc(' ', output);
00256             p_term_print(context, inst->constant.value,
00257                          p_term_stdio_print_func, output);
00258             fprintf(output, ", X%u", inst->constant.reg1);
00259             size = sizeof(inst->constant);
00260             break;
00261         case P_ARG_MEMBER:
00262             fprintf(output, " X%u, ", inst->functor.reg1);
00263             p_term_print(context, inst->functor.name,
00264                          p_term_stdio_print_func, output);
00265             fprintf(output, ", X%u", inst->functor.arity);
00266             size = sizeof(inst->functor);
00267             break;
00268         case P_ARG_MEMBER_LARGE:
00269             fprintf(output, " X%u, ", inst->large_functor.reg1);
00270             p_term_print(context, inst->large_functor.name,
00271                          p_term_stdio_print_func, output);
00272             fprintf(output, ", X%u", inst->large_functor.arity);
00273             size = sizeof(inst->large_functor);
00274             break;
00275         case P_ARG_RESET:
00276             fprintf(output, " X%u, %u", inst->two_reg.reg1,
00277                     inst->two_reg.reg2);
00278             size = sizeof(inst->two_reg);
00279             break;
00280         case P_ARG_RESET_LARGE:
00281             fprintf(output, " X%u, %u", inst->large_two_reg.reg1,
00282                     inst->large_two_reg.reg2);
00283             size = sizeof(inst->large_two_reg);
00284             break;
00285         case P_ARG_LABEL:
00286             fprintf(output, " %08lx", (long)(inst->label.label));
00287             size = sizeof(inst->label);
00288             break;
00289         }
00290         putc('\n', output);
00291         inst = (p_inst *)(((char *)inst) + size);
00292     }
00293 }
00294 
00295 /* Extract the red-black key for a specific "get" argument */
00296 int _p_code_argument_key
00297     (p_rbkey *key, const p_code_clause *clause, unsigned int arg)
00298 {
00299     p_opcode opcode;
00300     size_t size;
00301     const p_inst *inst = (p_inst *)(clause->code->inst);
00302     for (;;) {
00303         opcode = (p_opcode)(inst->header.opcode);
00304         if (opcode == P_OP_JUMP) {
00305             /* Jump to next continuation code block */
00306             inst = inst->label.label;
00307             continue;
00308         } else if (opcode == P_OP_END) {
00309             /* We've reached the end of the predicate code */
00310             break;
00311         }
00312         switch (instructions[opcode].get_put_type) {
00313         case P_TYPE_GET:
00314             switch (opcode) {
00315 
00316             /* Variable arguments, which aren't indexable */
00317             case P_OP_PUT_X_VALUE:  /* Same as get_x_variable */
00318             case P_OP_GET_Y_VARIABLE:
00319                 if (inst->two_reg.reg1 == arg)
00320                     return 0;
00321                 break;
00322             case P_OP_PUT_X_VALUE_LARGE:
00323             case P_OP_GET_Y_VARIABLE_LARGE:
00324                 if (inst->large_two_reg.reg1 == arg)
00325                     return 0;
00326                 break;
00327             case P_OP_GET_X_VALUE:
00328             case P_OP_GET_Y_VALUE:
00329             case P_OP_GET_IN_X_VALUE:
00330             case P_OP_GET_IN_Y_VALUE:
00331                 if (inst->two_reg.reg2 == arg)
00332                     return 0;
00333                 break;
00334             case P_OP_GET_X_VALUE_LARGE:
00335             case P_OP_GET_Y_VALUE_LARGE:
00336             case P_OP_GET_IN_X_VALUE_LARGE:
00337             case P_OP_GET_IN_Y_VALUE_LARGE:
00338                 if (inst->large_two_reg.reg2 == arg)
00339                     return 0;
00340                 break;
00341 
00342             case P_OP_GET_FUNCTOR:
00343             case P_OP_GET_IN_FUNCTOR:
00344                 if (inst->functor.reg1 != arg)
00345                     break;
00346                 key->type = P_TERM_FUNCTOR;
00347                 key->size = inst->functor.arity;
00348                 key->name = inst->functor.name;
00349                 return 1;
00350             case P_OP_GET_FUNCTOR_LARGE:
00351             case P_OP_GET_IN_FUNCTOR_LARGE:
00352                 if (inst->large_functor.reg1 != arg)
00353                     break;
00354                 key->type = P_TERM_FUNCTOR;
00355                 key->size = inst->large_functor.arity;
00356                 key->name = inst->large_functor.name;
00357                 return 1;
00358             case P_OP_GET_LIST:
00359             case P_OP_GET_IN_LIST:
00360                 if (inst->two_reg.reg1 != arg)
00361                     break;
00362                 key->type = P_TERM_LIST;
00363                 key->size = 0;
00364                 key->name = 0;
00365                 return 1;
00366             case P_OP_GET_LIST_LARGE:
00367             case P_OP_GET_IN_LIST_LARGE:
00368                 if (inst->large_two_reg.reg1 != arg)
00369                     break;
00370                 key->type = P_TERM_LIST;
00371                 key->size = 0;
00372                 key->name = 0;
00373                 return 1;
00374             case P_OP_GET_ATOM:
00375             case P_OP_GET_IN_ATOM:
00376                 if (inst->constant.reg1 != arg)
00377                     break;
00378                 key->type = P_TERM_ATOM;
00379                 key->size = 0;
00380                 key->name = inst->constant.value;
00381                 return 1;
00382             case P_OP_GET_CONSTANT:
00383             case P_OP_GET_IN_CONSTANT:
00384                 if (inst->constant.reg1 != arg)
00385                     break;
00386                 key->type = inst->constant.value->header.type;
00387                 if (key->type == P_TERM_INTEGER) {
00388                     key->size = p_term_integer_value
00389                         (inst->constant.value);
00390                     key->name = 0;
00391                 } else {
00392                     key->size = 0;
00393                     key->name = inst->constant.value;
00394                 }
00395                 return 1;
00396             default: break;
00397             }
00398             break;
00399 
00400         case P_TYPE_STOP:
00401             /* No possibility of get instructions beyond this point */
00402             return 0;
00403 
00404         case P_TYPE_SKIP: break;
00405         }
00406         switch (instructions[opcode].arg_types) {
00407         case P_ARG_NONE:
00408         default:
00409             size = sizeof(inst->header);
00410             break;
00411         case P_ARG_X:
00412             size = sizeof(inst->one_reg);
00413             break;
00414         case P_ARG_Y:
00415             size = sizeof(inst->one_reg);
00416             break;
00417         case P_ARG_X_X:
00418             size = sizeof(inst->two_reg);
00419             break;
00420         case P_ARG_Y_X:
00421             size = sizeof(inst->two_reg);
00422             break;
00423         case P_ARG_X_Y:
00424             size = sizeof(inst->two_reg);
00425             break;
00426         case P_ARG_X_X_LARGE:
00427             size = sizeof(inst->large_two_reg);
00428             break;
00429         case P_ARG_Y_X_LARGE:
00430             size = sizeof(inst->large_two_reg);
00431             break;
00432         case P_ARG_X_Y_LARGE:
00433             size = sizeof(inst->large_two_reg);
00434             break;
00435         case P_ARG_FUNCTOR:
00436             size = sizeof(inst->functor);
00437             break;
00438         case P_ARG_FUNCTOR_LARGE:
00439             size = sizeof(inst->large_functor);
00440             break;
00441         case P_ARG_CONSTANT:
00442             size = sizeof(inst->constant);
00443             break;
00444         case P_ARG_CONSTANT_X:
00445             size = sizeof(inst->constant);
00446             break;
00447         case P_ARG_MEMBER:
00448             size = sizeof(inst->functor);
00449             break;
00450         case P_ARG_MEMBER_LARGE:
00451             size = sizeof(inst->large_functor);
00452             break;
00453         case P_ARG_RESET:
00454             size = sizeof(inst->two_reg);
00455             break;
00456         case P_ARG_RESET_LARGE:
00457             size = sizeof(inst->large_two_reg);
00458             break;
00459         case P_ARG_LABEL:
00460             size = sizeof(inst->label);
00461             break;
00462         }
00463         inst = (p_inst *)(((char *)inst) + size);
00464     }
00465     return 0;
00466 }
00467