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>