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]).
51:- meta_predicate
52 vm_list().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).
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(_, _, []).
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].
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)
SWI-Prolog Virtual Machine utilities
This is an internal developers module to manage the virtual machine instructions. */