Mercurial > hg > Others > Rakudo

comparison src/core.c/Backtrace.pm6 @ 0:c341f82e7ad7 default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rakudo branch in cr.ie.u-ryukyu.ac.jp
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 26 Dec 2019 16:50:27 +0900
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:c341f82e7ad7
1 my class Exception { ... }
2
3 my class Backtrace { ... }
4 my class CompUnit::RepositoryRegistry is repr('Uninstantiable') { ... }
5
6 my class Backtrace::Frame {
7 has Str $.file;
8 has Int $.line;
9 has Mu $.code;
10 has Str $.subname;
11
12 method !SET-SELF($!file,$!line,\code,$!subname) {
13 $!code := code;
14 self
15 }
16 multi method new(Backtrace::Frame: \file,\line,\code,\subname) {
17 nqp::create(self)!SET-SELF(file,line,code,subname)
18 }
19 multi method new(Backtrace::Frame: |c) {
20 self.bless(|c)
21 }
22
23 method subtype(Backtrace::Frame:D:) {
24 my $s = $!code.^name.lc.split('+', 2).cache[0];
25 $s eq 'mu' ?? '' !! $s;
26 }
27
28 method package(Backtrace::Frame:D:) {
29 $.code.package;
30 }
31
32 multi method Str(Backtrace::Frame:D:) {
33 my $s = self.subtype;
34 $s ~= ' ' if $s.chars;
35 my $text = " in {$s}$.subname at {$.file} line $.line\n";
36
37 if Backtrace.RAKUDO_VERBOSE_STACKFRAME -> $extra {
38 my $io = $!file.IO;
39 if $io.e {
40 my @lines = $io.lines;
41 my $from = max $!line - $extra, 1;
42 my $to = min $!line + $extra, +@lines;
43 for $from..$to -> $line {
44 my $star = $line == $!line ?? '*' !! ' ';
45 $text ~= "$line.fmt('%5d')$star @lines[$line - 1]\n";
46 }
47 $text ~= "\n";
48 }
49 }
50 $text;
51 }
52
53 method is-hidden(Backtrace::Frame:D:) {
54 nqp::if(
55 nqp::can($!code,"is-hidden-from-backtrace"),
56 $!code.is-hidden-from-backtrace,
57 False
58 )
59 }
60 method is-routine(Backtrace::Frame:D:) {
61 nqp::hllbool(nqp::istype($!code,Routine))
62 }
63 method is-setting(Backtrace::Frame:D:) {
64 $!file.starts-with("SETTING::")
65 #?if jvm
66 || $!file ~~ / "CORE." \w+ ".setting" $ /
67 #?endif
68 #?if !jvm
69 || $!file ~~ / "CORE." \w+ ".setting.{ Rakudo::Internals.PRECOMP-EXT }" $ /
70 #?endif
71 || $!file.ends-with(".nqp")
72 }
73 }
74
75 my class Backtrace {
76 has Mu $!bt;
77 has Mu $!frames;
78 has Int $!bt-next; # next bt index to vivify
79
80 my $RAKUDO_VERBOSE_STACKFRAME := nqp::null;
81 method RAKUDO_VERBOSE_STACKFRAME() {
82 nqp::ifnull(
83 $RAKUDO_VERBOSE_STACKFRAME,
84 $RAKUDO_VERBOSE_STACKFRAME :=
85 (%*ENV<RAKUDO_VERBOSE_STACKFRAME> // 0).Int
86 )
87 }
88
89 method !SET-SELF($!bt,$!bt-next) {
90 $!frames := nqp::list;
91 self
92 }
93 multi method new() {
94 try X::AdHoc.new(:payload("Died")).throw;
95 nqp::create(self)!SET-SELF(
96 nqp::backtrace(nqp::getattr(nqp::decont($!),Exception,'$!ex')),
97 1)
98 }
99 multi method new(Int:D $offset) {
100 try X::AdHoc.new(:payload("Died")).throw;
101 nqp::create(self)!SET-SELF(
102 nqp::backtrace(nqp::getattr(nqp::decont($!),Exception,'$!ex')),
103 1 + $offset)
104 }
105 multi method new(Mu \ex) {
106 nqp::create(self)!SET-SELF(
107 ex.^name eq 'BOOTException'
108 ?? nqp::backtrace(nqp::decont(ex))
109 !! nqp::backtrace(nqp::getattr(nqp::decont(ex),Exception,'$!ex')),
110 0)
111 }
112 multi method new(Mu \ex, Int:D $offset) {
113 nqp::create(self)!SET-SELF(
114 ex.^name eq 'BOOTException'
115 ?? nqp::backtrace(nqp::decont(ex))
116 !! nqp::backtrace(nqp::getattr(nqp::decont(ex),Exception,'$!ex')),
117 $offset)
118 }
119 # note that backtraces are nqp::list()s, marshalled to us as a List
120 multi method new(List:D $bt) {
121 nqp::create(self)!SET-SELF($bt,0)
122 }
123 multi method new(List:D $bt, Int:D $offset) {
124 nqp::create(self)!SET-SELF($bt,$offset)
125 }
126
127 method AT-POS($pos) {
128 return nqp::atpos($!frames,$pos) if nqp::existspos($!frames,$pos);
129
130 my int $elems = $!bt.elems;
131 return Nil if $!bt-next >= $elems; # bt-next can init > elems
132
133 my int $todo = $pos - nqp::elems($!frames) + 1;
134 return Nil if $todo < 1; # in case absurd $pos passed
135 while $!bt-next < $elems {
136 my $frame := $!bt.AT-POS($!bt-next++);
137 my $sub := $frame<sub>;
138 next unless defined $sub;
139
140 my Mu $do := nqp::getattr(nqp::decont($sub), ForeignCode, '$!do');
141 next if nqp::isnull($do);
142
143 my $annotations := $frame<annotations>;
144 next unless $annotations;
145
146 my $file := $annotations<file>;
147 next unless $file;
148
149 if CompUnit::RepositoryRegistry.file-for-spec($file) -> $path {
150 $file := $path.absolute;
151 }
152
153 next if $file.ends-with('BOOTSTRAP.nqp')
154 || $file.ends-with('QRegex.nqp')
155 || $file.ends-with('Perl6/Ops.nqp');
156 if $file.ends-with('NQPHLL.nqp') || $file.ends-with('NQPHLL.moarvm') {
157 # This could mean we're at the end of the interesting backtrace,
158 # or it could mean that we're in something like sprintf (which
159 # uses an NQP grammar to parse the format string).
160 while $!bt-next < $elems {
161 my $frame := $!bt.AT-POS($!bt-next++);
162 my $annotations := $frame<annotations>;
163 next unless $annotations;
164 my $file := $annotations<file>;
165 next unless $file;
166 if $file.starts-with('SETTING::') {
167 $!bt-next--; # re-visit this frame
168 last;
169 }
170 }
171 next;
172 }
173
174 my $line := $annotations<line>;
175 next unless $line;
176
177 my $name := nqp::p6box_s(nqp::getcodename($do));
178 if $name eq 'handle-begin-time-exceptions' {
179 $!bt-next = $elems;
180 last;
181 }
182
183 my $code;
184 try {
185 $code := nqp::getcodeobj($do);
186 $code := Any unless nqp::istype($code, Mu);
187 };
188
189 nqp::push($!frames,
190 Backtrace::Frame.new(
191 $file,
192 $line.Int,
193 $code,
194 $name.starts-with("_block") ?? '<anon>' !! $name,
195 )
196 );
197 last unless $todo = $todo - 1;
198 }
199
200 # found something
201 if nqp::existspos($!frames,$pos) {
202 nqp::atpos($!frames,$pos);
203 }
204
205 # we've reached the end, don't show the last <unit-outer> if there is one
206 else {
207 nqp::pop($!frames) if $!frames;
208 Nil;
209 }
210 }
211
212 method next-interesting-index(Backtrace:D:
213 Int $idx is copy = 0, :$named, :$noproto, :$setting) {
214 ++$idx;
215
216 while self.AT-POS($idx++) -> $cand {
217 next if $cand.is-hidden; # hidden is never interesting
218 next if $noproto # no proto's please
219 && nqp::can($cand,"is_dispatcher")
220 && $cand.code.is_dispatcher; # if a dispatcher
221 next if !$setting # no settings please
222 && $cand.is-setting; # and in setting
223
224 my $n := $cand.subname;
225 next if $named && !$n; # only want named ones and no name
226 next if $n eq '<unit-outer>'; # outer calling context
227
228 return $idx - 1;
229 }
230 Nil;
231 }
232
233 method outer-caller-idx(Backtrace:D: Int $startidx) {
234
235 if self.AT-POS($startidx).code -> $start {
236 my %outers;
237
238 my $current = $start.outer;
239 while $current.DEFINITE {
240 %outers{$current.static_id} = $start;
241 $current = $current.outer;
242 }
243
244 my @outers;
245 my $i = $startidx;
246 while self.AT-POS($i++) -> $cand {
247 my $code = $cand.code;
248 next unless $code.DEFINITE && %outers{$code.static_id}.DEFINITE;
249
250 @outers.push: $i - 1;
251 last if $cand.is-routine;
252 }
253 @outers;
254 }
255
256 else {
257 $startidx.list;
258 }
259 }
260
261 method nice(Backtrace:D: :$oneline) {
262 my $setting = %*ENV<RAKUDO_BACKTRACE_SETTING>;
263 try {
264 my @frames;
265 my Int $i = self.next-interesting-index(-1);
266 while $i.defined {
267 $i = self.next-interesting-index($i, :$setting) if $oneline;
268 last unless $i.defined;
269
270 my $prev = self.AT-POS($i);
271 if $prev.is-routine {
272 @frames.push: $prev;
273 } else {
274 my @outer_callers := self.outer-caller-idx($i);
275 my $target_idx = @outer_callers.keys.grep({self.AT-POS($i).code.^isa(Routine)})[0];
276 $target_idx ||= @outer_callers[0] || $i;
277 my $current = self.AT-POS($target_idx);
278 @frames.append: $current.clone(line => $prev.line);
279 $i = $target_idx;
280 }
281 last if $oneline;
282 $i = self.next-interesting-index($i, :$setting);
283 }
284 CATCH {
285 default {
286 return "<Internal error while creating backtrace: $_.message() $_.backtrace.full().\n"
287 ~ "Please report this as a bug (mail to rakudobug@perl.org)\n",
288 ~ "and re-run with the --ll-exception command line option\n"
289 ~ "to get more information about your error>";
290 }
291 }
292 @frames.join;
293 }
294 }
295
296 multi method gist(Backtrace:D:) {
297 my $els := +self.list;
298 'Backtrace(' ~ $els ~ ' frame' ~ 's' x ($els != 1) ~ ')'
299 }
300 multi method Str(Backtrace:D:) { self.nice }
301 multi method flat(Backtrace:D:) { self.list }
302 multi method map(Backtrace:D: &block) {
303 my $pos = 0;
304 gather while self.AT-POS($pos++) -> $cand {
305 take block($cand);
306 }
307 }
308 multi method first(Backtrace:D: Mu $test) {
309 my $pos = 0;
310 while self.AT-POS($pos++) -> $cand {
311 return-rw $cand if $cand ~~ $test;
312 }
313 Nil;
314 }
315 multi method list(Backtrace:D:) {
316 self.AT-POS(1_000_000); # will stop when no more frames to be found
317 nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', $!frames)
318 }
319
320 method first-none-setting-line(Backtrace:D:) {
321 (self.first({ !.is-hidden && !.is-setting }) // "\n").Str;
322 }
323
324 method concise(Backtrace:D:) {
325 (self.grep({ !.is-hidden && .is-routine && !.is-setting }) // "\n").join;
326 }
327
328 method full(Backtrace:D:) { self.list.join }
329
330 method summary(Backtrace:D:) {
331 (self.grep({ !.is-hidden && (.is-routine || !.is-setting)}) // "\n").join;
332 }
333
334 method is-runtime (Backtrace:D:) {
335 my $bt = $!bt;
336 for $bt.keys {
337 my $p6sub := $bt[$_]<sub>;
338 if nqp::istype($p6sub, ForeignCode) {
339 try {
340 my Mu $sub := nqp::getattr(nqp::decont($p6sub), ForeignCode, '$!do');
341 my str $name = nqp::getcodename($sub);
342 return True if nqp::iseq_s($name, 'THREAD-ENTRY');
343 return True if nqp::iseq_s($name, 'eval');
344 return True if nqp::iseq_s($name, 'print_control');
345 return False if nqp::iseq_s($name, 'compile');
346 }
347 }
348 }
349 False;
350 }
351
352 }
353
354 # vim: ft=perl6 expandtab sw=4