Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # -*- perl -*- |
2 | ||
3 | package Midas::Application; | |
4 | ||
5 | use strict; | |
6 | ||
7 | use File::Copy; | |
8 | ||
9 | use Midas::AttrBlock; | |
10 | use Midas::Configure; | |
11 | use Midas::Globals; | |
12 | use Midas::Command; | |
13 | use Midas::Segment; | |
14 | use Midas::Paths; | |
15 | use Midas::Error; | |
16 | use Midas::Preprocess ':all'; | |
17 | require Midas::Section; | |
18 | ||
19 | ||
20 | use fields qw(name filetag sections srcfile srcline args | |
21 | is_linked external_path goldfinger_cmds | |
22 | ); | |
23 | ||
24 | ############################################################################## | |
25 | ||
26 | sub new { | |
27 | my $this = shift; | |
28 | my %args = @_; | |
29 | ||
30 | unless (ref $this) { | |
31 | $this = fields::new($this); | |
32 | } | |
33 | ||
34 | $this->set_defaults(); | |
35 | ||
36 | foreach my $key (keys %args) { | |
37 | $this->{$key} = $args{$key}; | |
38 | } | |
39 | ||
40 | $this->parse_args() if defined $this->{args}; | |
41 | ||
42 | return $this; | |
43 | } | |
44 | ||
45 | ############################################################################## | |
46 | ||
47 | sub set_defaults { | |
48 | my $this = shift; | |
49 | $this->{sections} = [] unless defined $this->{sections}; | |
50 | $this->{goldfinger_cmds} = [] unless defined $this->{goldfinger_cmds}; | |
51 | $this->{is_linked} = 0; | |
52 | } | |
53 | ||
54 | ############################################################################## | |
55 | ||
56 | sub name { | |
57 | my $this = shift; | |
58 | return $this->{name}; | |
59 | } | |
60 | ||
61 | ############################################################################## | |
62 | ||
63 | sub parse_args { | |
64 | my $this = shift; | |
65 | ||
66 | my $args = $this->{args}; | |
67 | $args =~ s/\s//g; | |
68 | my @args = split /,/, $args; | |
69 | foreach my $arg (@args) { | |
70 | if($args =~ /FILE\=(\S+)/i) { | |
71 | $this->{is_linked} = 1; | |
72 | $this->{external_path} = $1; | |
73 | ||
74 | $this->copy_external_to_build_dir(); | |
75 | } | |
76 | } | |
77 | } | |
78 | ||
79 | ############################################################################## | |
80 | ||
81 | sub is_blank { | |
82 | my $this = shift; | |
83 | ||
84 | return 0 if @{$this->{sections}}; | |
85 | return 0 if $this->{is_linked}; | |
86 | return 1; | |
87 | } | |
88 | ||
89 | ############################################################################## | |
90 | ||
91 | sub copy_external_to_build_dir { | |
92 | my $this = shift; | |
93 | ||
94 | ||
95 | my @search = get_includes($CONFIG{link_paths}); | |
96 | my $local_exe = path_to_build_file($this->exe_name(), $STATE); | |
97 | ||
98 | foreach my $testdir (@search) { | |
99 | my $testfile = File::Spec->catfile($testdir, $this->{external_path}); | |
100 | if(-e $testfile) { | |
101 | chat "Copying $testfile to $local_exe\n"; | |
102 | copy($testfile, $local_exe); | |
103 | last; | |
104 | } | |
105 | } | |
106 | ||
107 | if(not -e $local_exe) { | |
108 | fatal "Couldn't find \"$this->{external_path}\" in search path: @search\n", | |
109 | M_FILE; | |
110 | } | |
111 | } | |
112 | ||
113 | ############################################################################## | |
114 | ||
115 | sub filetag { | |
116 | my $this = shift; | |
117 | ||
118 | return '' if($this->name() eq 'default'); | |
119 | ||
120 | my $tag = lc $this->{name}; | |
121 | $tag =~ s/\.//; | |
122 | $tag =~ s/\.$//; | |
123 | return $tag; | |
124 | } | |
125 | ||
126 | ############################################################################## | |
127 | ||
128 | sub is_linked { | |
129 | my $this = shift; | |
130 | return $this->{is_linked}; | |
131 | } | |
132 | ||
133 | ############################################################################## | |
134 | ||
135 | sub exe_name { | |
136 | my $this = shift; | |
137 | ||
138 | return $this->expand_file($CONFIG{local_exe}); | |
139 | } | |
140 | ||
141 | ############################################################################## | |
142 | ||
143 | sub ldscr_name { | |
144 | my $this = shift; | |
145 | ||
146 | return $this->expand_file($CONFIG{local_ldscr}); | |
147 | ||
148 | } | |
149 | ||
150 | ############################################################################## | |
151 | ||
152 | sub expand_file { | |
153 | my $this = shift; | |
154 | my $file = shift; | |
155 | my $name = $this->{name}; | |
156 | ||
157 | my $filetag = $this->filetag(); | |
158 | ||
159 | $filetag = '.' . $filetag unless ($filetag =~ /^\./ or $filetag eq ''); | |
160 | $file =~ s/\*/${filetag}/; | |
161 | return $file; | |
162 | } | |
163 | ||
164 | ############################################################################## | |
165 | ||
166 | sub add_section { | |
167 | my $this = shift; | |
168 | my $section = shift; | |
169 | ||
170 | if($this->{is_linked}) { | |
171 | my $appname = $this->{name}; | |
172 | my $secname = $section->{name}; | |
173 | my $srcfile = $section->{srcfile}; | |
174 | my $srcline = $section->{srcline}; | |
175 | fatal "Application $appname cannot contain SECTIONs\n" . | |
176 | "($secname at file=$srcfile, line=$srcline\n", M_SECSYNTAX; | |
177 | } | |
178 | ||
179 | push @{$this->{sections}}, $section; | |
180 | } | |
181 | ||
182 | ############################################################################## | |
183 | ||
184 | sub add_goldfinger_cmd { | |
185 | my $this = shift; | |
186 | my $cmdstring = shift; | |
187 | ||
188 | push @{$this->{goldfinger_cmds}}, $cmdstring; | |
189 | } | |
190 | ||
191 | ############################################################################## | |
192 | ||
193 | sub get_sec_list { | |
194 | my $this = shift; | |
195 | return @{ $this->{sections} }; | |
196 | } | |
197 | ||
198 | ############################################################################## | |
199 | ||
200 | sub write_to_goldfinger { | |
201 | my $this = shift; | |
202 | my $fh = shift; | |
203 | ||
204 | my $app_name = $this->name(); | |
205 | my $exe_name = $this->exe_name(); | |
206 | my $exe = path_to_build_file($exe_name, $STATE); | |
207 | my $srcfile = $this->{srcfile}; | |
208 | my $srcline = $this->{srcline}; | |
209 | ||
210 | print $fh "APP $app_name\n"; | |
211 | print $fh "\n"; | |
212 | print $fh " ELF_FILE = \"$exe\";\n"; | |
213 | print $fh " SRC_FILE = \"$srcfile\";\n" if defined $srcfile; | |
214 | print $fh " SRC_LINE = $srcline;\n" if defined $srcline; | |
215 | print $fh "\n"; | |
216 | ||
217 | my @sections = $this->get_sec_list(); | |
218 | ||
219 | ||
220 | foreach my $section (@sections) { | |
221 | foreach my $seg (Midas::Segment->all_names()) { | |
222 | my @attrs = $section->get_segment_attrs($seg); | |
223 | next unless @attrs; | |
224 | ||
225 | my $linkname = $section->get_segment_link_name($seg); | |
226 | ||
227 | foreach my $attr (@attrs) { | |
228 | $attr->write_to_goldfinger($seg, $linkname, $fh); | |
229 | } | |
230 | } | |
231 | } | |
232 | ||
233 | print $fh "\n"; | |
234 | ||
235 | foreach my $cmd (@{$this->{goldfinger_cmds}}) { | |
236 | print $fh "$cmd\n"; | |
237 | print $fh "\n"; | |
238 | } | |
239 | ||
240 | print $fh "END APP\n"; | |
241 | print $fh "\n"; | |
242 | } | |
243 | ||
244 | ############################################################################## | |
245 | ||
246 | sub print_debug { | |
247 | my $this = shift; | |
248 | ||
249 | chat "App: $this->{name}\n", 3; | |
250 | foreach my $sec (@{$this->{sections}}) { | |
251 | my $str = ''; | |
252 | $str .= " Section: \"$sec->{name}\" "; | |
253 | ||
254 | my @link_attrs = $sec->get_link_attrs(); | |
255 | ||
256 | foreach my $seg (Midas::Segment->all_names()) { | |
257 | my $va = $link_attrs[0]->get_segment_va($seg); | |
258 | $str .= "${seg}_va=$va " if defined $va; | |
259 | } | |
260 | ||
261 | chat "$str\n", 3 if $str =~ /\S/; | |
262 | } | |
263 | } | |
264 | ||
265 | ############################################################################## | |
266 | 1; |