Overview
Comment:Writes messages to logfile instead of stdout if debug is enabled.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | origin/master | trunk
Files: files | file ages | folders
SHA3-256: 29839ea8b90259a19da77d11bd794a32b22ed7205faa2b8d4967051d6d890336
User & Date: geraint@users.sourceforge.net on 2004-09-07 18:25:50.000
Other Links: branch diff | manifest | tags
Context
2004-09-07
20:34:39
Reformats elementary system equations. check-in: fd75fa927a user: geraint@users.sourceforge.net tags: origin/master, trunk
18:25:50
Writes messages to logfile instead of stdout if debug is enabled. check-in: 29839ea8b9 user: geraint@users.sourceforge.net tags: origin/master, trunk
18:22:53
Issues a more helpful error message than the cryptic Octave stuff
if there are unconnected ports. check-in: 5b281f0ce4 user: geraint@users.sourceforge.net tags: origin/master, trunk
Changes
Side-by-Side Diff Ignore Whitespace Patch
Modified mttroot/mtt/bin/trans/ese_r2make.pl from [499a5fe272] to [d21f011f7e].
︙
45
46
47
48
49
50
51





52
53
54
55
56
57
58
59
60
61
62
63
64
65

66
67
68
69
70
71
72

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78








+
+
+
+
+














+








# default file names
$infile	 = "${sys}_ese.r"	if ($infile  eq '');
$outfile = "${sys}_ese.make"	if ($outfile eq '');

#-------------------------------------------------------------------------------
# main
#-------------------------------------------------------------------------------

if ($debug) {
    my $logfile = "ese_r2make_${sys}.log";
    open (LOG, ">$logfile") or die ("MTT: ese_r2make, cannot open $logfile");
}

# First the elementary system equations are read
# and placed in the "expressions" hash.
read_ese_r ();

# Then the occurence of any lvalue in the expression
# of any other is sought. 
get_dependencies ();

# Finally the expressions are written to a makefile
# where the targets are the left hand values and the
# pre-requisites are the dependencies
write_make ($sys);

close (LOG) if ($debug);

#-------------------------------------------------------------------------------
# subroutines
#-------------------------------------------------------------------------------
sub read_ese_r {

    open (ESE, $infile)
︙
83
84
85
86
87
88
89
90

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109

110
111
112
113
114
115
116

89
90
91
92
93
94
95

96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

115
116
117
118
119
120
121
122








-
+


















-
+








	next if /^(\s)*$/;	# skip blank lines

	# separate the left and right side of equations
	# and assign them to the expressions hash
	my ($lvar,$expr) = split (/:=/);
	$expressions{$lvar} = $expr;

	print "$lvar\t= $expressions{$lvar}\n" if $debug;
	print LOG "$lvar\t= $expressions{$lvar}\n" if $debug;
    }
    
    close (ESE);
}
#-------------------------------------------------------------------------------
sub get_dependencies {

    # compare the pattern to each expression
    foreach my $lvar (keys %expressions) {
	$dependencies{$lvar} = "";
	$_ = $expressions{$lvar};
	for my $lvar2 (keys %expressions) {
	    if ($expressions{$lvar} =~ /$lvar2/) {
		# a left value has been found in the expression
		# add it to the dependencies for this lvar
		$dependencies{$lvar} = "$dependencies{$lvar} $lvar2";
	    }
	}
	print "$lvar:\t$dependencies{$lvar}\n" if $debug;
	print LOG "$lvar:\t$dependencies{$lvar}\n" if $debug;
    }
}
#-------------------------------------------------------------------------------
sub write_make {
    
    # create lists of rates, states and tmpvars so that
    # separate rules can be created in the makefile
︙
Modified mttroot/mtt/bin/trans/lbl2cmp_txt2m.pl from [975fe12492] to [aba4e1a1e3].
︙
43
44
45
46
47
48
49





50
51
52
53
54
55
56
57
58
59
60

61
62
63
64
65
66
67

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73








+
+
+
+
+











+









my $sys = '';

GetOptions ('sys=s' => \$sys,
	    'debug' => \$debug);

die usage() if ($sys eq '');

if ($debug) {
    my $logfile = "lbl2cmp_txt2m_${sys}.log";
    open (LOG, ">$logfile") or die ("MTT: lbl2cmp_txt2m, cannot open $logfile");
}

$cmp = "${sys}_cmp.txt";
$lbl = "${sys}_lbl.txt";
$out = "${sys}_cmp.m";

read_cmp_file();
read_lbl_file();
sort_components();
write_header();
write_body();

close (LOG) if ($debug);

sub usage() {
    return "Usage: lbl2cmp_txt2m --sys=<sys>\n";
}

sub read_cmp_file() {
    my ($line, $name, $type, $class, $rep, $i);
︙
76
77
78
79
80
81
82
83

84
85
86
87
88
89
90

82
83
84
85
86
87
88

89
90
91
92
93
94
95
96








-
+








	next if (/^(\s)*$/);
	# skip comments
	next if (/^(\s)*[%\#]/);
	# remove leading and trailing whitespace
	s/^\s*(\S.*\S)\s*$/$1/;
	
	$line = $_;
	print "read_cmp_file: line='${line}'\n" if ($debug);
	print LOG "read_cmp_file: line='${line}'\n" if ($debug);

	# cmp provides type, name and repetition information
	# class is inferred from type and name
	# (cr and args are placeholders)

	($type, $name, $rep) = read_cmp_line($line);
	$name = name_anonymous_component($type) if ($name eq '');
︙
111
112
113
114
115
116
117
118

119
120
121
122
123
124
125
126
127
128
129
130
131
132

133
134
135
136
137
138
139

117
118
119
120
121
122
123

124
125
126
127
128
129
130
131
132
133
134
135
136
137

138
139
140
141
142
143
144
145








-
+













-
+








	($name, $rep) = split (/\*/, $misc);
	$name = $misc unless defined ($name);
    }

    $name = '' unless defined $name;
    $rep  = 1  unless defined $rep;
    
    print "read_cmp_line: type='$type', name='$name', rep='$rep'\n" if ($debug);
    print LOG "read_cmp_line: type='$type', name='$name', rep='$rep'\n" if ($debug);
    return ($type, $name, $rep);
}

sub name_anonymous_component() {
    my $type = $_;
    my ($name, $num);
    if (defined ($anonymous_component_type_index{$type})) {
	$num = ++$anonymous_component_type_index{$type};
	$name = "mtt${type}_${num}";
    } else {
	$anonymous_component_type_index{$type} = 1;
	$name = "mtt${type}";
    }
    print "name_anonymous_component: type='${type}', name='${name}'\n" if ($debug);
    print LOG "name_anonymous_component: type='${type}', name='${name}'\n" if ($debug);
    return ($name);
}

sub port_or_component_or_junction() {

    # ports are internal SS components (SS:[...])
    # junctions are '0' and '1' types
︙
151
152
153
154
155
156
157
158

159
160
161
162
163
164
165

157
158
159
160
161
162
163

164
165
166
167
168
169
170
171








-
+








    } elsif ($type eq "0") {
	$retval = "0junction";
    } elsif ($type eq "1") {
	$retval = "1junction";
    } else {
	$retval = "component";
    }
    print "port_or_component_or_junction: type='$type', name='$name' class='$retval'\n" if ($debug);
    print LOG "port_or_component_or_junction: type='$type', name='$name' class='$retval'\n" if ($debug);
    return ($retval);
}

sub read_lbl_file() {
    my (@line, $name, $type, $cr, $arg, $i);
    
    open (LBL, $lbl) or die ("MTT: lbl2cmp_txt2m, cannot open $lbl");
︙
198
199
200
201
202
203
204
205

206
207
208
209
210
211
212

204
205
206
207
208
209
210

211
212
213
214
215
216
217
218








-
+









    $cr  = shift (@line);
    $arg = shift (@line);

    $cr   = '' unless defined ($cr);
    $arg  = '' unless defined ($arg);
    
    print "read_lbl_line: name='$name' cr='$cr' arg='$arg'\n" if ($debug);
    print LOG "read_lbl_line: name='$name' cr='$cr' arg='$arg'\n" if ($debug);
    return ($name, $cr, $arg);
}

sub write_header() {
    my $date = `date`;
    chomp ($date);
︙
235
236
237
238
239
240
241
242

243
244
245
246
247
248
249

241
242
243
244
245
246
247

248
249
250
251
252
253
254
255








-
+








    foreach $target ("port", "component", "0junction", "1junction") {
	my @sorted_list = sort (sort_rule @component_name);
	for $name (@sorted_list) {
	    $class = $component_class{$name};
	    if ($class eq $target) {
		if (! defined ($sorted_component_list{$name})) {
		    $sorted_component_list{$name} = $i++;
		    print "sorted: '$name' '$i'\n" if ($debug); 
		    print LOG "sorted: '$name' '$i'\n" if ($debug); 
		}
	    }
	}
    }
}

sub sort_rule ()
︙
MTT: Model Transformation Tools
[ GitHub | SourceHut | Sourceforge | Fossil RSS ]