Overview
Comment:Writes ports before components.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | origin/master | trunk
Files: files | file ages | folders
SHA3-256: 9aa24ddf0bc4cddf3602e329bc6c7787dc780c050ed45035e9cd1a5915ff4b07
User & Date: geraint@users.sourceforge.net on 2004-08-03 06:17:20
Other Links: branch diff | manifest | tags
Context
2004-08-03
06:32:38
Writes ports before components before junctions. check-in: 5ef80ccba4 user: geraint@users.sourceforge.net tags: origin/master, trunk
06:17:20
Writes ports before components. check-in: 9aa24ddf0b user: geraint@users.sourceforge.net tags: origin/master, trunk
2004-08-02
20:25:47
abg.m requires lbl.txt to allow units to be checked. check-in: 8b7e94d63e user: geraint@users.sourceforge.net tags: origin/master, trunk
Changes

Modified mttroot/mtt/bin/trans/lbl2cmp_txt2m.pl from [efef75dda9] to [f9442d404c].

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16




17
18

19

20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35



36
37
38
39
40
41
42
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
74
75
76
77
78
79
80
81
82
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
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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
#! /usr/bin/perl -w

### lbl2cmp_txt2m
## Creates _cmp.m from _lbl.txt
## Copyright (C) 2004 by Geraint Paul Bevan

  ###################################### 
  ##### Model Transformation Tools #####
  ######################################

use strict;

use Getopt::Long;

sub usage;
sub read_lbl;
sub read_cmp;




sub write_header;
sub write_body;



my (@component_name,
    %component_type,    
    %component_cr,
    %component_arg,
    %component_rep);

my $sys = '';

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

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


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




my $debug;

read_cmp();
read_lbl();

write_header();
write_body();


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

sub read_lbl() {
    my (@line, $name, $type, $cr, $arg, $i);

    $i = 0;

    open (LBL, $lbl) or die ("MTT: __FILE__, cannot open $lbl");

    while (<LBL>) {

	chomp;
	# skip blank lines
	next if (/^(\s)*$/);
	# skip comments
	next if (/^(\s)*[%\#]/);
	# remove leading and trailing whitespace
	s/^\s*(\S.*\S)\s*$/$1/;
	
	@line = split (/\s+/);
	$name = shift (@line);
	die ("MTT: __FILE__, cannot parse $lbl") if (! defined ($name));
	
	# strip repetitions from name, if any
	$name =~ s/\([^\*]*\)\*.*/$1/;

	$cr   = shift (@line);
	$arg  = shift (@line);
	
	$cr   = '' unless defined ($cr);
	$arg  = '' unless defined ($arg);
	
	$i++;
	
	$component_cr{$name} = $cr;
	$component_arg{$name} = $arg;
    }

    close (LBL);
}

sub read_cmp() {
    my ($line, $name, $type, $type_rep, $name_rep, $rep, $i, %anon_index);

    open (CMP, $cmp) or die ("MTT: __FILE__, cannot open $cmp");

    $i = 0;
    while (<CMP>) {
	
	chomp;
	# skip blank lines
	next if (/^(\s)*$/);
	# skip comments
	next if (/^(\s)*[%\#]/);
	# remove leading and trailing whitespace
	s/^\s*(\S.*\S)\s*$/$1/;

	$line = $_;
	print ("Processing: $line\n") if defined ($debug);
	($type, $name_rep) = split (/:/, $line);
	if (! defined ($name_rep)) {# anonymous component
	    $type_rep = $line;
	    ($type, $rep) = split (/\*/, $type_rep);
	    if (! defined ($rep)) {
		$type = $type_rep;
		$rep  = 1;
	    }
	    if (! defined ($anon_index{$type})) {
		$anon_index{$type} = 1;
	    } else {
		$anon_index{$type}++;
	    }
	    my $index = $anon_index{$type};

	    $name = "mtt${type}_${index}";

	    $rep  = 1;
	} else {		# named component
	    ($name, $rep) = split (/\*/, $name_rep);
	    if (! defined ($rep)) {
		$name = $name_rep;
		$rep  = 1;
	    }
	}

	$i++;
	
	print "i=$i : NAME='$name' TYPE='$type' REP='$rep'\n" if defined ($debug);
	$component_name[$i] = $name;
	$component_type{$name} = $type;
	$component_rep{$name}  = $rep;

	# place holders
	$component_cr{$name}  = '';
	$component_arg{$name}  = '';
    }
    close (CMP);



















































































































}

sub write_header() {
    my $date = `date`;
    chomp ($date);

    open (OUT, ">$out") or
	die "MTT: cannot open $out for writing.\n";
    
    print OUT << "EOF";
## $out -*-octave-*-
## Generated by MTT on $date
# writing header
    
function [comp_type, name, cr, arg, repetitions] = ${sys}_cmp(i)

EOF

    close (OUT);
}

sub write_body() {
    my ($name, $i);

    open (OUT, ">>$out") or
	die "MTT: cannot open $out for writing.\n";

    $i = 0;
    foreach $name (@component_name) {
	if (defined ($name)) {
	    $i++;
	    print "#Name: \"$name\"\n" if defined ($debug);
	    print OUT
		"if (i == $i)\n" .
		"\tcomp_type   = '$component_type{$name}';\n" .
		"\tname        = '$name'\n" .
		"\tcr          = '$component_cr{$name}';\n" .
		"\targ         = '$component_arg{$name}';\n" .
		"\trepetitions =  $component_rep{$name} ;\n" .
		"end\n";
	}
    }

    close (OUT);
}











>



|
|
>
>
>
>


>

>












>


|

>
>
>
|

|
|









|
|

<
|
<
|
<

<
<
<
<
<
<
<
|
<
<
<
|
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<









|

|
<
<
<
<
<
<
<
|
<
|
<
|
|
|
>
|
>
|
|
<
<
<
<
<
<
|
<
|
<
<
|
|
|
<
<
<


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












<


















<













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
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
74
75
76
77
78
79
80
81
82







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
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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244

245
246
247
248
249
250
251
252
253
254
255
256
257
#! /usr/bin/perl -w

### lbl2cmp_txt2m
## Creates _cmp.m from _lbl.txt
## Copyright (C) 2004 by Geraint Paul Bevan

  ###################################### 
  ##### Model Transformation Tools #####
  ######################################

use strict;
use diagnostics;
use Getopt::Long;

sub usage;
sub read_cmp_file;
sub read_cmp_line;
sub name_anonymous_component;
sub port_or_component;
sub read_lbl_file;
sub read_lbl_line;
sub write_header;
sub write_body;
sub strip_rubbish;

## fields to write to cmp.m
my (@component_name,
    %component_type,    
    %component_cr,
    %component_arg,
    %component_rep);

my $sys = '';

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

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

## files to read/write
my $lbl = "${sys}_lbl.txt";
my $cmp = "${sys}_cmp.txt";
my $out = "${sys}_cmp.m";

## other global variables
my (%anonymous_component_type_index);

my $debug = 1;

read_cmp_file();
read_lbl_file();

write_header();
write_body();


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

sub read_cmp_file() {
    my ($line, $name, $type, $type_rep, $name_rep, $rep, $i, %anon_index);


    my (@c_name, %c_type, %c_rep, $i_c);

    my (@p_name, %p_type, %p_rep, $i_p);









    $i_c = 0;



    $i_p = 0;





















    open (CMP, $cmp) or die ("MTT: lbl2cmp_txt2m, cannot open $cmp");
    

    while (<CMP>) {
	
	chomp;
	# skip blank lines
	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 defined ($debug);









	($type, $name, $rep) = read_cmp_line($line);

	$name = name_anonymous_component($type) if ($name eq '');
	
	if (port_or_component ($type, $name) eq "port") {
	    $i_p++;
	    $p_name[$i_p]  = $name;
	    $p_type{$name} = $type;
	    $p_rep{$name}  = $rep;
	} else {






	    $i_c++;

	    $c_name[$i_c]  = $name;


	    $c_type{$name} = $type;
	    $c_rep {$name} = $rep;
	}



    }
    close (CMP);

    $i = 0;
    while ($i < $i_p) {
	$i++;
	$name = $p_name[$i];
	$component_name[$i] = $name;
	$component_type{$name} = $p_type{$name};
	$component_rep {$name} = $p_rep{$name};
	$component_cr  {$name} = '';
	$component_arg {$name} = '';
    }
    while ($i < ($i_p + $i_c)) {
	$i++;
	$name = $c_name[${i}-${i_p}];
	$component_name[$i] = $name;
	$component_type{$name} = $c_type{$name};
	$component_rep {$name} = $c_rep{$name};
	$component_cr  {$name} = '';
	$component_arg {$name} = '';
    }
}

sub read_cmp_line() {
    my $line = $_;
    my ($type, $name, $rep, $misc);
    
    ($type, $misc) = split (/:/, $line);
    $type = $line unless defined ($type);

    if (defined ($misc)) {
	($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 defined ($debug);
    return ($type, $name, $rep);
}

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

sub port_or_component() {
    my ($type, $name) = @_;
    my $retval;
    if ($type ne "SS") {
	$retval = "component";
    } else {
	print "port_or_component: name='${name}'\n";
	$_ = $name;
	if (/\[.+\]/) {
	    $retval = "port";
	} else {
	    $retval = "component";
	}
    }
    print "port_or_component: type='$type', name='$name' class='$retval'\n" if defined ($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");
    
    while (<LBL>) {
	
	chomp;
	# skip blank lines
	next if (/^(\s)*$/);
	# skip comments
	next if (/^(\s)*[%\#]/);
	# remove leading and trailing whitespace
	s/^\s*(\S.*\S)\s*$/$1/;
	
	($name, $cr, $arg) = read_lbl_line (@line);
	
	$component_cr{$name}  = $cr;
	$component_arg{$name} = $arg;
    }

    close (LBL);
}

sub read_lbl_line() {
    my @line = @_;
    my ($name, $cr, $arg);

    @line = split (/\s+/);
    $name = shift (@line);

    # strip repetitions (if any)
    $name =~ s/([^\*]*)\*.*/$1/;

    $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 defined ($debug);
    return ($name, $cr, $arg);
}

sub write_header() {
    my $date = `date`;
    chomp ($date);

    open (OUT, ">$out") or
	die "MTT: cannot open $out for writing.\n";
    
    print OUT << "EOF";
## $out -*-octave-*-
## Generated by MTT on $date

    
function [comp_type, name, cr, arg, repetitions] = ${sys}_cmp(i)

EOF

    close (OUT);
}

sub write_body() {
    my ($name, $i);

    open (OUT, ">>$out") or
	die "MTT: cannot open $out for writing.\n";

    $i = 0;
    foreach $name (@component_name) {
	if (defined ($name)) {
	    $i++;

	    print OUT
		"if (i == $i)\n" .
		"\tcomp_type   = '$component_type{$name}';\n" .
		"\tname        = '$name'\n" .
		"\tcr          = '$component_cr{$name}';\n" .
		"\targ         = '$component_arg{$name}';\n" .
		"\trepetitions =  $component_rep{$name} ;\n" .
		"end\n";
	}
    }

    close (OUT);
}


MTT: Model Transformation Tools
GitHub | SourceHut | Sourceforge | Fossil RSS ]