35
36:- module(prolog_vm,
37 [ vm_list/1, 38 clause_vm/2, 39 vmi_labels/2 40 ]). 41:- autoload(library(lists), [member/2, selectchk/3]). 42:- autoload(library(prolog_clause), [predicate_name/2]). 43
44
50
51:- meta_predicate
52 vm_list(:). 53
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
124
125unify_args(_, _/_) :- !. 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
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
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
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
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
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)