View source with raw 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]).   42:- autoload(library(prolog_clause),[predicate_name/2]).

SWI-Prolog Virtual Machine utilities

This is an internal developers module to manage the virtual machine instructions. */

   51:- meta_predicate
   52    vm_list(:).
 vm_list(:Spec) is det
Lists the definition of the predicates matching Spec to current_output. Spec is also allowed to be a clause-reference.
   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).
 clause_vm(+ClauseRef, -VM:list) is det
True when VM is the virtual machine code of ClauseRef. Each instruction is a term vmi(VMI,Size).
  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(_, _, []).
 vmi_labels(?VMI, ?Labeled)
Translated between a raw and a labeled representation for a VMI sequence as produced by clause_vm/2. Assumes we only jump forwards.

In the labeled represention the jump arguments of VMIs are label names and there are entries label(Name) in the list.

  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].
 jmp_rel(+VMIName, +Start, +End, -JmpRel)
Relative position for the (choice) jump. This is the end of the instruction for most, but after the address for the compiled trie instructions. Should be made consistent.
  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)