| 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; |