| ︙ | | |
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 ()
|
| ︙ | | |