Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # -*- perl -*- |
2 | ||
3 | package Midas::Error; | |
4 | ||
5 | use strict; | |
6 | ||
7 | use File::Basename; | |
8 | ||
9 | use Exporter; | |
10 | ||
11 | ||
12 | our $Prg = basename $0; | |
13 | our $ERR = "$Prg: FATAL ERROR"; | |
14 | ||
15 | our @ISA = qw(Exporter); | |
16 | ||
17 | our $Print_Errors = 1; | |
18 | ||
19 | # IMPORTANT! | |
20 | # The error codes need to be kept consistent with goldfinger/gf_error.h | |
21 | # since the error codes from goldfinger are passed through to midas! | |
22 | ||
23 | use constant M_NOERROR => 0; | |
24 | use constant M_MISC => 1; | |
25 | use constant M_CODE => 2; | |
26 | use constant M_DIR => 3; | |
27 | use constant M_FILE => 4; | |
28 | use constant M_CMDFAIL => 5; | |
29 | use constant M_SECSYNTAX => 6; | |
30 | use constant M_ATTRSYNTAX => 7; | |
31 | use constant M_MISSINGPARAM => 8; | |
32 | use constant M_ILLEGALPARAM => 9; | |
33 | use constant M_OUTOFRANGE => 10; | |
34 | use constant M_NOTNUM => 11; | |
35 | use constant M_VACOLLIDE => 12; | |
36 | use constant M_PACOLLIDE => 13; | |
37 | use constant M_DIRECTIVESYNTAX => 14; | |
38 | use constant M_GENFAIL => 15; | |
39 | use constant M_ASMFAIL => 16; | |
40 | use constant M_CCFAIL => 17; | |
41 | use constant M_LINKFAIL => 18; | |
42 | use constant M_CPPFAIL => 19; | |
43 | use constant M_M4FAIL => 20; | |
44 | use constant M_BADCONFIG => 21; | |
45 | use constant M_EVENTERR => 22; | |
46 | use constant M_ARGERR => 23; | |
47 | use constant M_NOSEC => 24; | |
48 | use constant M_BADTSB => 25; | |
49 | use constant M_BADALIGN => 26; | |
50 | use constant M_EMPTYSECTION => 27; | |
51 | use constant M_TSBSYNTAX => 28; | |
52 | use constant M_APPSYNTAX => 29; | |
53 | use constant M_MEMORY => 30; | |
54 | use constant M_GOLDFINGERPARSE => 31; | |
55 | use constant M_GOLDFINGERARG => 32; | |
56 | use constant M_ELF => 33; | |
57 | use constant M_BADLABEL => 34; | |
58 | use constant M_GOLDFINGERMISC => 35; | |
59 | use constant M_GOLDFINGERVERSION => 36; | |
60 | use constant M_DUPLICATETAG => 37; | |
61 | use constant M_BLOCKSYNTAX => 38; | |
62 | ||
63 | ||
64 | our %ERRCODES = | |
65 | ( | |
66 | M_NOERROR() => "M_NOERROR (#%d): No error.", | |
67 | M_MISC() => 'M_MISC (#%d): Miscellaneous error.', | |
68 | M_CODE() => 'M_CODE (#%d): Error in midas code.', | |
69 | M_DIR () => 'M_DIR (#%d): Directory error.', | |
70 | M_FILE() => 'M_FILE (#%d): File error.', | |
71 | M_CMDFAIL() => 'M_CMDFAIL (#%d): Command failed.', | |
72 | M_SECSYNTAX() => 'M_SECSYNTAX (#%d): Error in section syntax.', | |
73 | M_ATTRSYNTAX() => 'M_ATTRSYNTAX (#%d): Error in attr syntax.', | |
74 | M_MISSINGPARAM() => 'M_MISSINGPARAM (#%d): Missing parameter.', | |
75 | M_ILLEGALPARAM() => 'M_ILLEGALPARAM (#%d): Illegal parameter.', | |
76 | M_OUTOFRANGE() => 'M_OUTOFRANGE (#%d): Out of range.', | |
77 | M_NOTNUM() => 'M_NOTNUM (#%d): Not a number.', | |
78 | M_VACOLLIDE() => 'M_VACOLLIDE (#%d): VA collision.', | |
79 | M_PACOLLIDE() => 'M_PACOLLIDE (#%d): PA collision.', | |
80 | M_DIRECTIVESYNTAX() => 'M_DIRECTIVESYNTAX (#%d): Directive syntax error.', | |
81 | M_GENFAIL() => 'M_GENFAIL (#%d): File generation failed.', | |
82 | M_ASMFAIL() => 'M_ASMFAIL (#%d): Assembler failed.', | |
83 | M_CCFAIL() => 'M_CCFAIL (#%d): C compiler failed.', | |
84 | M_LINKFAIL() => 'M_LINKFAIL (#%d): Linker failed.', | |
85 | M_CPPFAIL() => 'M_CPPFAIL (#%d): CPP failed.', | |
86 | M_M4FAIL() => 'M_M4FAIL (#%d): M4 preprocessor failed.', | |
87 | M_BADCONFIG() => 'M_BADCONFIG (#%d): Bad configuration.', | |
88 | M_EVENTERR() => 'M_EVENTERR (#%d): Event parsing error.', | |
89 | M_ARGERR() => 'M_ARGERR (#%d): Argument error.', | |
90 | M_NOSEC() => 'M_NOSEC (#%d): Undefined section.', | |
91 | M_BADTSB() => 'M_BADTSB (#%d): Bad TSB.', | |
92 | M_BADALIGN() => 'M_BADALIGN (#%d): Bad Alignment.', | |
93 | M_EMPTYSECTION() => 'M_EMPTYSECTION (#%d): Empty section.', | |
94 | M_TSBSYNTAX() => 'M_TSBSYNTAX (#%d): Error in tsb syntax.', | |
95 | M_APPSYNTAX() => 'M_APPSYNTAX (#%d): Error in app syntax.', | |
96 | M_MEMORY() => 'M_MEMORY (#%d): Memory error.', | |
97 | M_GOLDFINGERPARSE() => 'M_GOLDFINGERPARSE (#%d): Goldfinger parse error.', | |
98 | M_GOLDFINGERARG() => 'M_GOLDFINGERARG (#%d): Goldfinger arg error.', | |
99 | M_ELF() => 'M_ELF (#%d): ELF error.', | |
100 | M_BADLABEL() => 'M_BADLABEL (#%d): Bad label.', | |
101 | M_GOLDFINGERMISC() => 'M_GOLDFINGERMISC (#%d): Uncategorized goldfinger error.', | |
102 | M_GOLDFINGERVERSION() => 'M_GOLDFINGERVERSION (#%d): Bad version of goldfinger', | |
103 | M_DUPLICATETAG() => 'M_DUPLICATETAG (#%d): Duplicate tags in TSB', | |
104 | M_BLOCKSYNTAX() => 'M_BLOCKSYNTAX (#%d): Error defining goldfinger BLOCK' | |
105 | ); | |
106 | ||
107 | our @Error_Codes = qw( | |
108 | M_NOERROR | |
109 | M_MISC | |
110 | M_CODE | |
111 | M_DIR | |
112 | M_FILE | |
113 | M_CMDFAIL | |
114 | M_SECSYNTAX | |
115 | M_ATTRSYNTAX | |
116 | M_MISSINGPARAM | |
117 | M_ILLEGALPARAM | |
118 | M_OUTOFRANGE | |
119 | M_NOTNUM | |
120 | M_VACOLLIDE | |
121 | M_PACOLLIDE | |
122 | M_DIRECTIVESYNTAX | |
123 | M_GENFAIL | |
124 | M_ASMFAIL | |
125 | M_CCFAIL | |
126 | M_LINKFAIL | |
127 | M_CPPFAIL | |
128 | M_M4FAIL | |
129 | M_BADCONFIG | |
130 | M_EVENTERR | |
131 | M_ARGERR | |
132 | M_NOSEC | |
133 | M_BADTSB | |
134 | M_BADALIGN | |
135 | M_EMPTYSECTION | |
136 | M_TSBSYNTAX | |
137 | M_APPSYNTAX | |
138 | M_MEMORY | |
139 | M_GOLDFINGERPARSE | |
140 | M_GOLDFINGERARG | |
141 | M_ELF | |
142 | M_BADLABEL | |
143 | M_GOLDFINGERMISC | |
144 | M_GOLDFINGERVERSION | |
145 | M_DUPLICATETAG | |
146 | M_BLOCKSYNTAX | |
147 | ); | |
148 | ||
149 | our @EXPORT = (qw( | |
150 | @Error_Codes | |
151 | %ERRCODES | |
152 | handle_error | |
153 | get_error_code | |
154 | init_error | |
155 | suppress_error_messages | |
156 | errcode_to_string | |
157 | ), @Error_Codes); | |
158 | ||
159 | ||
160 | ############################################################################### | |
161 | ||
162 | sub init_error { | |
163 | $Print_Errors = 1; | |
164 | } | |
165 | ||
166 | ############################################################################### | |
167 | ||
168 | sub suppress_error_messages { | |
169 | $Print_Errors = 0; | |
170 | } | |
171 | ||
172 | ############################################################################### | |
173 | ||
174 | sub errcode_to_string { | |
175 | my $code = shift; | |
176 | ||
177 | if(not exists $ERRCODES{$code}) { | |
178 | return "Invalid error code \"$code\""; | |
179 | } | |
180 | return sprintf $ERRCODES{$code}, $code; | |
181 | } | |
182 | ||
183 | ############################################################################### | |
184 | ||
185 | sub handle_error { | |
186 | my $errobj = shift; | |
187 | ||
188 | return 0 unless defined $errobj; | |
189 | return 0 unless $errobj; | |
190 | ||
191 | my ($pkg, $file, $line) = caller; | |
192 | print STDERR "$Prg: At pkg=$pkg, file=$file, line=$line\n" if $Print_Errors; | |
193 | ||
194 | if(not ref $errobj) { | |
195 | $errobj = Midas::Error->throw($errobj); | |
196 | } | |
197 | ||
198 | die "Unknown exception \"$errobj\"\n" unless $errobj->can('catch'); | |
199 | return $errobj->catch(); | |
200 | } | |
201 | ||
202 | ############################################################################### | |
203 | ||
204 | sub get_error_code { | |
205 | my $errobj = shift; | |
206 | ||
207 | return 0 unless defined $errobj; | |
208 | return 0 unless $errobj; | |
209 | return M_CODE unless ref $errobj; | |
210 | return M_CODE unless $errobj->can('catch'); | |
211 | return $errobj->{code}; | |
212 | } | |
213 | ||
214 | ############################################################################### | |
215 | ||
216 | sub throw { | |
217 | my $class = shift; | |
218 | my $msg = shift; | |
219 | my $code = shift; | |
220 | $code = M_MISC unless defined $code; | |
221 | ||
222 | $class = ref $class if ref $class; | |
223 | my $this = bless {}, $class; | |
224 | $this->{code} = $code; | |
225 | $this->{msg} = $msg; | |
226 | ||
227 | return $this; | |
228 | } | |
229 | ||
230 | ############################################################################### | |
231 | ||
232 | sub catch { | |
233 | my $this = shift; | |
234 | ||
235 | my $msg = $this->{msg}; | |
236 | ||
237 | $this->{code} = M_CODE unless exists $ERRCODES{$this->{code}}; | |
238 | my $codemsg = errcode_to_string($this->{code}); | |
239 | ||
240 | $msg = "$codemsg\n$msg"; | |
241 | ||
242 | my @lines = split /\n/, "$msg"; | |
243 | my $string = join "\n", map { "$ERR: $_" } @lines; | |
244 | ||
245 | print STDERR "$string\n" if $Print_Errors; | |
246 | ||
247 | return $this->{code}; | |
248 | } | |
249 | ||
250 | ############################################################################### | |
251 | 1; |