View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           www.swi-prolog.org
    6    Copyright (c)  2008-2020, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(prolog_vm,
   37          [ vm_list/1,                  % :Spec
   38            clause_vm/2,                % +ClauseRef,-VM:list
   39            vmi_labels/2                % ?VMI,?Labeled
   40          ]).   41:- autoload(library(lists), [member/2, selectchk/3]).   42:- autoload(library(prolog_clause), [predicate_name/2]).   43
   44
   45/** <module> SWI-Prolog Virtual Machine utilities
   46
   47This is an internal developers  module   to  manage  the virtual machine
   48instructions.
   49*/
   50
   51:- meta_predicate
   52    vm_list(:).   53
   54%!  vm_list(:Spec) is det.
   55%
   56%   Lists  the  definition  of  the   predicates  matching  Spec  to
   57%   =current_output=. Spec is also allowed to be a clause-reference.
   58
   59vm_list(_:Ref) :-
   60    blob(Ref, clause),
   61    !,
   62    (   nth_clause(_Head, N, Ref),
   63        format('~40c~nclause ~d (~w):~n~40c~n', [0'-, N, Ref, 0'-]),
   64        vm_list_clause(Ref),
   65        fail
   66    ;   true
   67    ).
   68vm_list(Spec) :-
   69    '$find_predicate'(Spec, List),
   70    (   member(PI, List),
   71        pi_to_head(PI, Head),
   72        unify_args(Head, Spec),
   73        predicate_name(Head, Name),
   74        format('~72c~n~w~n~72c~n', [0'=, Name, 0'=]),
   75        (   '$fetch_vm'(Head, 0, _, _)
   76        ->  vm_list_clause(Head)
   77        ;   format('    (No supervisor)~n')
   78        ),
   79        (   nth_clause(Head, N, Ref),
   80            clause(MHead, _, Ref),
   81            same_head(Head, MHead),
   82            format('~40c~nclause ~d (~w):~n~40c~n', [0'-, N, Ref, 0'-]),
   83            vm_list_clause(Ref),
   84            fail
   85        ;   true
   86        ),
   87        fail
   88    ;   true
   89    ).
   90
   91pi_to_head(M:PI, M:Head) :-
   92    !,
   93    pi_to_head(PI, Head).
   94pi_to_head(Name/Arity, Head) :-
   95    functor(Head, Name, Arity).
   96
   97vm_list_clause(Clause) :-
   98    clause_vm(Clause, VM),
   99    vmi_labels(VM, Labeled),
  100    vm_list_labeled(Labeled, 0).
  101
  102vm_list_labeled([], _).
  103vm_list_labeled([label(L),vmi(break(VMI),Size)|T], PC) :-
  104    !,
  105    format('~w: ~t~d~8| ~q % <breakpoint>~n', [L, PC, VMI]),
  106    PC1 is PC+Size,
  107    vm_list_labeled(T, PC1).
  108vm_list_labeled([label(L),vmi(VMI,Size)|T], PC) :-
  109    format('~w: ~t~d~8| ~q~n', [L, PC, VMI]),
  110    PC1 is PC+Size,
  111    vm_list_labeled(T, PC1).
  112vm_list_labeled([vmi(break(VMI),Size)|T], PC) :-
  113    !,
  114    format('~t~d~8| ~q % <breakpoint>~n', [PC, VMI]),
  115    PC1 is PC+Size,
  116    vm_list_labeled(T, PC1).
  117vm_list_labeled([vmi(VMI,Size)|T], PC) :-
  118    format('~t~d~8| ~q~n', [PC, VMI]),
  119    PC1 is PC+Size,
  120    vm_list_labeled(T, PC1).
  121
  122%       Unify the arguments of the specification with the given term,
  123%       so we can partially instantate the head.
  124
  125unify_args(_, _/_) :- !.                % Name/arity spec
  126unify_args(X, X) :- !.
  127unify_args(_:X, X) :- !.
  128unify_args(_, _).
  129
  130same_head(X, X) :- !.
  131same_head(H1, H2) :-
  132    strip_module(H1, _, H),
  133    strip_module(H2, _, H).
  134
  135
  136%!  clause_vm(+ClauseRef, -VM:list) is det.
  137%
  138%   True when VM  is  the  virtual   machine  code  of  ClauseRef.  Each
  139%   instruction is a term vmi(VMI,Size).
  140
  141clause_vm(Ref, VM) :-
  142    clause_vm(Ref, 0, VM).
  143
  144clause_vm(Clause, PC, [vmi(VMI,Size)|T]) :-
  145    '$fetch_vm'(Clause, PC, NextPC, VMI),
  146    !,
  147    Size is NextPC-PC,
  148    clause_vm(Clause, NextPC, T).
  149clause_vm(_, _, []).
  150
  151
  152%!  vmi_labels(?VMI, ?Labeled)
  153%
  154%   Translated between a raw and  a   labeled  representation  for a VMI
  155%   sequence  as  produced  by  clause_vm/2.    Assumes   we  only  jump
  156%   _forwards_.
  157%
  158%   In the labeled represention the `jump`   arguments of VMIs are label
  159%   names and there are entries label(Name) in the list.
  160
  161vmi_labels(VMI, Labeled) :-
  162    nonvar(VMI),
  163    !,
  164    label_vmi(VMI, 0, 0, [], Labeled).
  165vmi_labels(VMI, Labeled) :-
  166    unlabel_vmi(Labeled, 0, [], VMI).
  167
  168% Raw --> Labeled
  169
  170label_vmi([], _, _, _, []).
  171label_vmi([H|T], Here0, LI0, Pending0, Labeled) :-
  172    H = vmi(VMI0,Size),
  173    Here is Here0+Size,
  174    new_labels(VMI0, VMI, LI0, LI1, Here0, Here, Pending0, Pending1),
  175    (   selectchk(Label-Here0, Pending1, Pending2)
  176    ->  Labeled = [label(Label),vmi(VMI,Size)|Labeled1]
  177    ;   Labeled = [vmi(VMI,Size)|Labeled1],
  178        Pending2 = Pending1
  179    ),
  180    label_vmi(T, Here, LI1, Pending2, Labeled1).
  181
  182new_labels(break(VMI0), break(VMI), LI0, LI, Start, End, Labels0, Labels) :-
  183    !,
  184    new_labels(VMI0, VMI, LI0, LI, Start, End, Labels0, Labels).
  185new_labels(VMI0, VMI, LI0, LI, Start, End, Labels0, Labels) :-
  186    VMI0 =.. [Name|Argv0],
  187    '$vmi_property'(Name, argv(ArgvTypes)),
  188    jmp_rel(Name, Start, End, Rel),
  189    new_labels_(ArgvTypes, Argv0, Argv, LI0, LI, Rel, Labels0, Labels),
  190    VMI =.. [Name|Argv].
  191
  192%!  jmp_rel(+VMIName, +Start, +End, -JmpRel)
  193%
  194%   Relative position for the (choice) jump.  This   is  the  end of the
  195%   instruction for most, but after the   address  for the compiled trie
  196%   instructions.   Should be made consistent.
  197
  198jmp_rel(TrieVMI, Start, _End, Rel) :-
  199    trie_vmi(TrieVMI), !,
  200    Rel is Start+2.
  201jmp_rel(_, _, End, End).
  202
  203trie_vmi(VMI) :- sub_atom(VMI, 0, _, _, t_).
  204
  205new_labels_([], [], [], LI, LI, _, Labels, Labels).
  206new_labels_([jump|TT], [Offset|AT], [Label|LT], LI0, LI, End, Labels0, Labels) :-
  207    !,
  208    To is End+Offset,
  209    (   memberchk(Label-To, Labels0)
  210    ->  Labels1 = Labels0,
  211        LI1 = LI0
  212    ;   LI1 is LI0+1,
  213        atom_concat('L', LI1, Label),
  214        Labels1 = [Label-To|Labels0]
  215    ),
  216    new_labels_(TT, AT, LT, LI1, LI, End, Labels1, Labels).
  217new_labels_([_|TT], [A|AT], [A|LT], LI0, LI, End, Labels0, Labels) :-
  218    new_labels_(TT, AT, LT, LI0, LI, End, Labels0, Labels).
  219
  220% Labeled --> Raw
  221
  222unlabel_vmi([], _, _, []).
  223unlabel_vmi([label(L)|T0], Here, Labels0, T) :-
  224    !,
  225    resolve_labels(L, Here, Labels0, Labels),
  226    unlabel_vmi(T0, Here, Labels, T).
  227unlabel_vmi([vmi(VMI0,Size)|T0], Here0, Labels0, [vmi(VMI,Size)|T]) :-
  228    Here is Here0+Size,
  229    get_labels(VMI0, VMI, Here, Labels0, Labels),
  230    unlabel_vmi(T0, Here, Labels, T).
  231
  232get_labels(VMI0, VMI, Here, Labels0, Labels) :-
  233    VMI0 =.. [Name|Argv0],
  234    '$vmi_property'(Name, argv(ArgvTypes)),
  235    get_labels_(ArgvTypes, Argv0, Argv, Here, Labels0, Labels),
  236    VMI =.. [Name|Argv].
  237
  238get_labels_([], [], [], _, Labels, Labels).
  239get_labels_([jump|TT], [Label|LT], [Offset|AT], Here,
  240            Labels0, [l(Label,Here,Offset)|Labels]) :-
  241    !,
  242    get_labels_(TT, LT, AT, Here, Labels0, Labels).
  243get_labels_([_|TT], [A|LT], [A|AT], Here, Labels0, Labels) :-
  244    get_labels_(TT, LT, AT, Here, Labels0, Labels).
  245
  246resolve_labels(L, Here, Labels0, Labels) :-
  247    selectchk(l(L,End,Offset), Labels0, Labels1),
  248    !,
  249    Offset is Here-End,
  250    resolve_labels(L, Here, Labels1, Labels).
  251resolve_labels(_, _, Labels, Labels)