Annotation of gforth/profile.fs, revision 1.1
1.1 ! anton 1: \ count execution of control-flow edges
! 2:
! 3: \ Copyright (C) 2004 Free Software Foundation, Inc.
! 4:
! 5: \ This file is part of Gforth.
! 6:
! 7: \ Gforth is free software; you can redistribute it and/or
! 8: \ modify it under the terms of the GNU General Public License
! 9: \ as published by the Free Software Foundation; either version 2
! 10: \ of the License, or (at your option) any later version.
! 11:
! 12: \ This program is distributed in the hope that it will be useful,
! 13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
! 14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 15: \ GNU General Public License for more details.
! 16:
! 17: \ You should have received a copy of the GNU General Public License
! 18: \ along with this program; if not, write to the Free Software
! 19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
! 20:
! 21:
! 22: \ relies on some Gforth internals
! 23:
! 24: \ !! assumption: each file is included only once; otherwise you get
! 25: \ the counts for just one of the instances of the file. This can be
! 26: \ fixed by making sure that every source position occurs only once as
! 27: \ a profile point.
! 28:
! 29: struct
! 30: cell% field profile-next
! 31: cell% 2* field profile-count
! 32: cell% 2* field profile-sourcepos
! 33: cell% field profile-char \ character position in line
! 34: end-struct profile% \ profile point
! 35:
! 36: variable profile-points \ linked list of profile%
! 37: 0 profile-points !
! 38:
! 39: : new-profile-point ( -- addr )
! 40: profile% %alloc >r
! 41: 0. r@ profile-count 2!
! 42: current-sourcepos r@ profile-sourcepos 2!
! 43: >in @ r@ profile-char !
! 44: profile-points @ r@ profile-next !
! 45: r@ profile-points !
! 46: r> ;
! 47:
! 48: : dinc ( d-addr -- )
! 49: \ increment double pointed to by d-addr
! 50: dup 2@ 1. d+ rot 2! ;
! 51:
! 52: : profile-this ( -- )
! 53: new-profile-point profile-count POSTPONE literal POSTPONE dinc ;
! 54:
! 55: : profile-:-hook ( -- )
! 56: defers :-hook profile-this ;
! 57:
! 58: : print-profile ( -- )
! 59: profile-points @ begin
! 60: dup while
! 61: dup >r
! 62: r@ profile-sourcepos 2@ .sourcepos ." :"
! 63: r@ profile-char @ 0 .r ." : "
! 64: r@ profile-count 2@ 0 d.r cr
! 65: r> profile-next @
! 66: repeat
! 67: drop ;
! 68:
! 69: ' profile-:-hook is :-hook
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>