OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [itcl/] [itcl/] [tests/] [old/] [toasters/] [Hazard.tcl] - Blame information for rev 1773

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# ----------------------------------------------------------------------
2
#  PURPOSE:  Tracking for hazardous products manufactured by the
3
#            "toaster" company.
4
#
5
#   AUTHOR:  Michael J. McLennan       Phone: (610)712-2842
6
#            AT&T Bell Laboratories   E-mail: michael.mclennan@att.com
7
#
8
#      RCS:  $Id: Hazard.tcl,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
9
# ----------------------------------------------------------------------
10
#               Copyright (c) 1993  AT&T Bell Laboratories
11
# ======================================================================
12
# Permission to use, copy, modify, and distribute this software and its
13
# documentation for any purpose and without fee is hereby granted,
14
# provided that the above copyright notice appear in all copies and that
15
# both that the copyright notice and warranty disclaimer appear in
16
# supporting documentation, and that the names of AT&T Bell Laboratories
17
# any of their entities not be used in advertising or publicity
18
# pertaining to distribution of the software without specific, written
19
# prior permission.
20
#
21
# AT&T disclaims all warranties with regard to this software, including
22
# all implied warranties of merchantability and fitness.  In no event
23
# shall AT&T be liable for any special, indirect or consequential
24
# damages or any damages whatsoever resulting from loss of use, data or
25
# profits, whether in an action of contract, negligence or other
26
# tortuous action, arising out of or in connection with the use or
27
# performance of this software.
28
# ======================================================================
29
 
30
itcl_class HazardRec {
31
        constructor {cname} {
32
                set class $cname
33
        }
34
        method change {var inc} {
35
                if {![info exists $var]} {
36
                        error "bad field \"$var\""
37
                }
38
                incr $var $inc
39
        }
40
        method report {} {
41
                return "$class: $total produced, $actives active, $accidents accidents"
42
        }
43
        protected class {}
44
        protected total 0
45
        protected actives 0
46
        protected accidents 0
47
}
48
 
49
itcl_class Hazard {
50
 
51
        constructor {} {
52
                set class [virtual info class]
53
                if {![info exists recs($class)]} {
54
                        set recs($class) [HazardRec #auto $class]
55
                }
56
                $recs($class) change total +1
57
                $recs($class) change actives +1
58
        }
59
        destructor {
60
                set class [virtual info class]
61
                $recs($class) change actives -1
62
        }
63
 
64
        method accident {mesg} {
65
                set class [virtual info class]
66
                $recs($class) change accidents +1
67
                puts stderr $mesg
68
        }
69
 
70
        proc report {class} {
71
                if {[info exists recs($class)]} {
72
                        return [$recs($class) report]
73
                } else {
74
                        error "no information for class \"$class\""
75
                }
76
        }
77
    common recs
78
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.