gforth/backtrac.fs - diff

Return to backtrac.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/backtrac.fs between versions 1.2 and 1.18

version 1.2, 2000/09/07 08:28:50	version 1.18, 2012/06/23 20:58:30
Line 1	Line 1
\ backtrace handling	\ backtrace handling

\ Copyright (C) 1999 Free Software Foundation, Inc.	\ Copyright (C) 1999,2000,2003,2004,2006,2007 Free Software Foundation, Inc.

\ This file is part of Gforth.	\ This file is part of Gforth.

\ Gforth is free software; you can redistribute it and/or	\ Gforth is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public License	\ modify it under the terms of the GNU General Public License
\ as published by the Free Software Foundation; either version 2	\ as published by the Free Software Foundation, either version 3
\ of the License, or (at your option) any later version.	\ of the License, or (at your option) any later version.

\ This program is distributed in the hope that it will be useful,	\ This program is distributed in the hope that it will be useful,
Line 15	Line 15
\ GNU General Public License for more details.	\ GNU General Public License for more details.

\ You should have received a copy of the GNU General Public License	\ You should have received a copy of the GNU General Public License
\ along with this program; if not, write to the Free Software	\ along with this program. If not, see http://www.gnu.org/licenses/.
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


\ growing buffers that need not be full	\ growing buffers that need not be full
Line 43 end-struct buffer%	Line 42 end-struct buffer%

\ backtrace stuff	\ backtrace stuff

create backtrace-rs-buffer buffer% %allot \ copy of the return stack at throw	create backtrace-rs-buffer buffer% %allot drop
	\ copy of the return stack at throw

: init-backtrace ( -- )	: init-backtrace ( -- )
backtrace-rs-buffer init-buffer ;	backtrace-rs-buffer init-buffer ;
Line 65 IS 'cold	Line 65 IS 'cold
else \ throw by signal handler with insufficient information	else \ throw by signal handler with insufficient information
handler @ cell - \ beyond that we know nothing	handler @ cell - \ beyond that we know nothing
then	then
backtrace-rp0 @ [ 2 cells ]L - over - 0 max ;	backtrace-rp0 @ [ 1 cells ]L - over - 0 max ;

:noname ( -- )	:noname ( -- )
backtrace-empty @	backtrace-return-stack
	dup backtrace-rs-buffer adjust-buffer
	backtrace-rs-buffer buffer-address @ swap move ;
	IS store-backtrace

	: print-bt-entry ( return-stack-item -- )
	cell - dup in-dictionary? over dup aligned = and
if	if
backtrace-return-stack	@ dup threaded>name dup if
dup backtrace-rs-buffer adjust-buffer	.name drop
backtrace-rs-buffer buffer-address @ swap move	else
backtrace-empty off	drop dup look if
	.name drop
	else
	drop body> look \ !! check for "call" in cell before?
	if
	.name
	else
	drop
	then
	then
	then
	else
	drop
then ;	then ;
IS store-backtrace

: print-backtrace ( addr1 addr2 -- )	: print-backtrace ( addr1 addr2 -- )
\G print a backtrace for the return stack addr1..addr2	\G print a backtrace for the return stack addr1..addr2
cr ." Backtrace:"	2dup u< IF cr ." Backtrace:" THEN
swap u+do	swap u+do
cr	cr
i @ dup hex. ( return-addr? )	i @ dup hex. ( return-addr? )
cell - dup in-dictionary? over dup aligned = and	print-bt-entry
if
@ look
if
.name
else
drop
then
else
drop
then
cell +loop ;	cell +loop ;

:noname ( -- )	:noname ( -- )
backtrace-rs-buffer 2@ over + print-backtrace ;	backtrace-rs-buffer 2@ over + print-backtrace ;
IS dobacktrace	IS dobacktrace

	[ifdef] defer-default
	:noname
	r@ >stderr cr ." deferred word " print-bt-entry ." is uninitialized" ;
	is defer-default
	[then]

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.2
changed lines
	Added in v.1.18