src/lib/vampimg/JpegLib/imjerror.pas

   1 unit imjerror;
   2
   3 { This file contains simple error-reporting and trace-message routines.
   4   These are suitable for Unix-like systems and others where writing to
   5   stderr is the right thing to do.  Many applications will want to replace
   6   some or all of these routines.
   7
   8   These routines are used by both the compression and decompression code. }
   9
  10 { Source: jerror.c;  Copyright (C) 1991-1996, Thomas G. Lane. }
  11 { note: format_message still contains a hack }
  12 interface
  13
  14 {$I imjconfig.inc}
  15
  16 uses
  17   imjmorecfg,
  18   imjdeferr,
  19   imjpeglib;
  20 {
  21   jversion;
  22 }
  23
  24 const
  25   EXIT_FAILURE  = 1;   { define halt() codes if not provided }
  26
  27 {GLOBAL}
  28 function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr;
  29
  30
  31
  32 procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
  33
  34 procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt);
  35
  36 procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : int; p2 : int);
  37
  38 procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
  39                    p1 : int; p2 : int; p3 : int);
  40
  41 procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
  42                    p1 : int; p2 : int; p3 : int; p4 : int);
  43
  44 procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
  45                    str : AnsiString);
  46 { Nonfatal errors (we can keep going, but the data is probably corrupt) }
  47
  48 procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
  49
  50 procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int);
  51
  52 procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
  53                   p1 : int; p2 : int);
  54
  55 { Informational/debugging messages }
  56 procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE);
  57
  58 procedure TRACEMS1(cinfo : j_common_ptr; lvl : int;
  59                    code : J_MESSAGE_CODE; p1 : long);
  60
  61 procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
  62                    p1 : int;
  63                    p2 : int);
  64
  65 procedure TRACEMS3(cinfo : j_common_ptr;
  66                    lvl : int;
  67                    code : J_MESSAGE_CODE;
  68                    p1 : int; p2 : int; p3 : int);
  69
  70 procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
  71                    p1 : int; p2 : int; p3 : int; p4 : int);
  72
  73 procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
  74                    p1 : int; p2 : int; p3 : int; p4 : int; p5 : int);
  75
  76 procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
  77                   p1 : int; p2 : int; p3 : int; p4 : int;
  78                   p5 : int; p6 : int; p7 : int; p8 : int);
  79
  80 procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
  81                    code : J_MESSAGE_CODE; str : AnsiString);
  82
  83 implementation
  84
  85
  86 { How to format a message string, in format_message() ? }
  87
  88 {$IFDEF OS2}
  89   {$DEFINE NO_FORMAT}
  90 {$ENDIF}
  91 {$IFDEF FPC}
  92   {$DEFINE NO_FORMAT}
  93 {$ENDIF}
  94
  95 uses
  96 {$IFNDEF NO_FORMAT}
  97   {$IFDEF VER70}
  98     drivers, { Turbo Vision unit with FormatStr }
  99   {$ELSE}
 100     sysutils,  { Delphi Unit with Format() }
 101   {$ENDIF}
 102 {$ENDIF}
 103   imjcomapi;
 104
 105 { Error exit handler: must not return to caller.
 106
 107   Applications may override this if they want to get control back after
 108   an error.  Typically one would longjmp somewhere instead of exiting.
 109   The setjmp buffer can be made a private field within an expanded error
 110   handler object.  Note that the info needed to generate an error message
 111   is stored in the error object, so you can generate the message now or
 112   later, at your convenience.
 113   You should make sure that the JPEG object is cleaned up (with jpeg_abort
 114   or jpeg_destroy) at some point. }
 115
 116
 117 {METHODDEF}
 118 procedure error_exit (cinfo : j_common_ptr);
 119 begin
 120   { Always display the message }
 121   cinfo^.err^.output_message(cinfo);
 122
 123   { Let the memory manager delete any temp files before we die }
 124   jpeg_destroy(cinfo);
 125
 126   halt(EXIT_FAILURE);
 127 end;
 128
 129
 130 { Actual output of an error or trace message.
 131   Applications may override this method to send JPEG messages somewhere
 132   other than stderr. }
 133
 134 { Macros to simplify using the error and trace message stuff }
 135 { The first parameter is either type of cinfo pointer }
 136
 137 { Fatal errors (print message and exit) }
 138 procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
 139 begin
 140   cinfo^.err^.msg_code := ord(code);
 141   cinfo^.err^.error_exit(cinfo);
 142 end;
 143
 144 procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt);
 145 begin
 146   cinfo^.err^.msg_code := ord(code);
 147   cinfo^.err^.msg_parm.i[0] := p1;
 148   cinfo^.err^.error_exit (cinfo);
 149 end;
 150
 151 procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
 152                    p1 : int; p2 : int);
 153 begin
 154   cinfo^.err^.msg_code := ord(code);
 155   cinfo^.err^.msg_parm.i[0] := p1;
 156   cinfo^.err^.msg_parm.i[1] := p2;
 157   cinfo^.err^.error_exit (cinfo);
 158 end;
 159
 160 procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
 161                    p1 : int; p2 : int; p3 : int);
 162 begin
 163   cinfo^.err^.msg_code := ord(code);
 164   cinfo^.err^.msg_parm.i[0] := p1;
 165   cinfo^.err^.msg_parm.i[1] := p2;
 166   cinfo^.err^.msg_parm.i[2] := p3;
 167   cinfo^.err^.error_exit (cinfo);
 168 end;
 169
 170 procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
 171                    p1 : int; p2 : int; p3 : int; p4 : int);
 172 begin
 173   cinfo^.err^.msg_code := ord(code);
 174   cinfo^.err^.msg_parm.i[0] := p1;
 175   cinfo^.err^.msg_parm.i[1] := p2;
 176   cinfo^.err^.msg_parm.i[2] := p3;
 177   cinfo^.err^.msg_parm.i[3] := p4;
 178   cinfo^.err^.error_exit (cinfo);
 179 end;
 180
 181 procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
 182                    str : AnsiString);
 183 begin
 184   cinfo^.err^.msg_code := ord(code);
 185   cinfo^.err^.msg_parm.s := str;  { string[JMSG_STR_PARM_MAX] }
 186   cinfo^.err^.error_exit (cinfo);
 187 end;
 188
 189 { Nonfatal errors (we can keep going, but the data is probably corrupt) }
 190
 191 procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
 192 begin
 193   cinfo^.err^.msg_code := ord(code);
 194   cinfo^.err^.emit_message(cinfo, -1);
 195 end;
 196
 197 procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int);
 198 begin
 199   cinfo^.err^.msg_code := ord(code);
 200   cinfo^.err^.msg_parm.i[0] := p1;
 201   cinfo^.err^.emit_message (cinfo, -1);
 202 end;
 203
 204 procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
 205                   p1 : int; p2 : int);
 206 begin
 207   cinfo^.err^.msg_code := ord(code);
 208   cinfo^.err^.msg_parm.i[0] := p1;
 209   cinfo^.err^.msg_parm.i[1] := p2;
 210   cinfo^.err^.emit_message (cinfo, -1);
 211 end;
 212
 213 { Informational/debugging messages }
 214 procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE);
 215 begin
 216   cinfo^.err^.msg_code := ord(code);
 217   cinfo^.err^.emit_message(cinfo, lvl);
 218 end;
 219
 220 procedure TRACEMS1(cinfo : j_common_ptr; lvl : int;
 221                    code : J_MESSAGE_CODE; p1 : long);
 222 begin
 223   cinfo^.err^.msg_code := ord(code);
 224   cinfo^.err^.msg_parm.i[0] := p1;
 225   cinfo^.err^.emit_message (cinfo, lvl);
 226 end;
 227
 228 procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
 229                    p1 : int;
 230                    p2 : int);
 231 begin
 232   cinfo^.err^.msg_code := ord(code);
 233   cinfo^.err^.msg_parm.i[0] := p1;
 234   cinfo^.err^.msg_parm.i[1] := p2;
 235   cinfo^.err^.emit_message (cinfo, lvl);
 236 end;
 237
 238 procedure TRACEMS3(cinfo : j_common_ptr;
 239                    lvl : int;
 240                    code : J_MESSAGE_CODE;
 241                    p1 : int; p2 : int; p3 : int);
 242 var
 243   _mp : int8array;
 244 begin
 245   _mp[0] := p1; _mp[1] := p2; _mp[2] := p3;
 246   cinfo^.err^.msg_parm.i := _mp;
 247   cinfo^.err^.msg_code := ord(code);
 248   cinfo^.err^.emit_message (cinfo, lvl);
 249 end;
 250
 251
 252 procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
 253                    p1 : int; p2 : int; p3 : int; p4 : int);
 254 var
 255   _mp : int8array;
 256 begin
 257   _mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4;
 258   cinfo^.err^.msg_parm.i := _mp;
 259   cinfo^.err^.msg_code := ord(code);
 260   cinfo^.err^.emit_message (cinfo, lvl);
 261 end;
 262
 263 procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
 264                    p1 : int; p2 : int; p3 : int; p4 : int; p5 : int);
 265 var
 266   _mp : ^int8array;
 267 begin
 268   _mp := @cinfo^.err^.msg_parm.i;
 269   _mp^[0] := p1; _mp^[1] := p2; _mp^[2] := p3;
 270   _mp^[3] := p4; _mp^[5] := p5;
 271   cinfo^.err^.msg_code := ord(code);
 272   cinfo^.err^.emit_message (cinfo, lvl);
 273 end;
 274
 275 procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
 276                   p1 : int; p2 : int; p3 : int; p4 : int;
 277                   p5 : int; p6 : int; p7 : int; p8 : int);
 278 var
 279   _mp : int8array;
 280 begin
 281   _mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4;
 282   _mp[4] := p5; _mp[5] := p6; _mp[6] := p7; _mp[7] := p8;
 283   cinfo^.err^.msg_parm.i := _mp;
 284   cinfo^.err^.msg_code := ord(code);
 285   cinfo^.err^.emit_message (cinfo, lvl);
 286 end;
 287
 288 procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
 289                    code : J_MESSAGE_CODE; str : AnsiString);
 290 begin
 291   cinfo^.err^.msg_code := ord(code);
 292   cinfo^.err^.msg_parm.s := str; { string JMSG_STR_PARM_MAX }
 293   cinfo^.err^.emit_message (cinfo, lvl);
 294 end;
 295
 296 {METHODDEF}
 297 procedure output_message (cinfo : j_common_ptr);
 298 var
 299   buffer : AnsiString; {[JMSG_LENGTH_MAX];}
 300 begin
 301   { Create the message }
 302   cinfo^.err^.format_message (cinfo, buffer);
 303
 304   { Send it to stderr, adding a newline }
 305   WriteLn(output, buffer);
 306 end;
 307
 308
 309
 310 { Decide whether to emit a trace or warning message.
 311   msg_level is one of:
 312     -1: recoverable corrupt-data warning, may want to abort.
 313      0: important advisory messages (always display to user).
 314      1: first level of tracing detail.
 315      2,3,...: successively more detailed tracing messages.
 316   An application might override this method if it wanted to abort on warnings
 317   or change the policy about which messages to display. }
 318
 319
 320 {METHODDEF}
 321 procedure emit_message (cinfo : j_common_ptr; msg_level : int);
 322 var
 323   err : jpeg_error_mgr_ptr;
 324 begin
 325   err := cinfo^.err;
 326   if (msg_level < 0) then
 327   begin
 328     { It's a warning message.  Since corrupt files may generate many warnings,
 329       the policy implemented here is to show only the first warning,
 330       unless trace_level >= 3. }
 331
 332     if (err^.num_warnings = 0) or (err^.trace_level >= 3) then
 333       err^.output_message(cinfo);
 334     { Always count warnings in num_warnings. }
 335     Inc( err^.num_warnings );
 336   end
 337   else
 338   begin
 339     { It's a trace message.  Show it if trace_level >= msg_level. }
 340     if (err^.trace_level >= msg_level) then
 341       err^.output_message (cinfo);
 342   end;
 343 end;
 344
 345
 346 { Format a message string for the most recent JPEG error or message.
 347   The message is stored into buffer, which should be at least JMSG_LENGTH_MAX
 348   characters.  Note that no '\n' character is added to the string.
 349   Few applications should need to override this method. }
 350
 351
 352 {METHODDEF}
 353 procedure format_message (cinfo : j_common_ptr; var buffer : AnsiString);
 354 var
 355   err : jpeg_error_mgr_ptr;
 356   msg_code : J_MESSAGE_CODE;
 357   msgtext : AnsiString;
 358   isstring : boolean;
 359 begin
 360   err := cinfo^.err;
 361   msg_code := J_MESSAGE_CODE(err^.msg_code);
 362   msgtext := '';
 363
 364   { Look up message string in proper table }
 365   if (msg_code > JMSG_NOMESSAGE)
 366     and (msg_code <= J_MESSAGE_CODE(err^.last_jpeg_message)) then
 367   begin
 368     msgtext := err^.jpeg_message_table^[msg_code];
 369   end
 370   else
 371   if (err^.addon_message_table <> NIL) and
 372      (msg_code >= err^.first_addon_message) and
 373      (msg_code <= err^.last_addon_message) then
 374   begin
 375     msgtext := err^.addon_message_table^[J_MESSAGE_CODE
 376            (ord(msg_code) - ord(err^.first_addon_message))];
 377   end;
 378
 379   { Defend against bogus message number }
 380   if (msgtext = '') then
 381   begin
 382     err^.msg_parm.i[0] := int(msg_code);
 383     msgtext := err^.jpeg_message_table^[JMSG_NOMESSAGE];
 384   end;
 385
 386   { Check for string parameter, as indicated by %s in the message text }
 387   isstring := Pos('%s', msgtext) > 0;
 388
 389   { Format the message into the passed buffer }
 390   if (isstring) then
 391     buffer := Concat(msgtext, err^.msg_parm.s)
 392   else
 393   begin
 394  {$IFDEF VER70}
 395     FormatStr(buffer, msgtext, err^.msg_parm.i);
 396  {$ELSE}
 397    {$IFDEF NO_FORMAT}
 398    buffer := msgtext;
 399    {$ELSE}
 400    buffer := Format(msgtext, [
 401         err^.msg_parm.i[0], err^.msg_parm.i[1],
 402         err^.msg_parm.i[2], err^.msg_parm.i[3],
 403         err^.msg_parm.i[4], err^.msg_parm.i[5],
 404         err^.msg_parm.i[6], err^.msg_parm.i[7] ]);
 405    {$ENDIF}
 406  {$ENDIF}
 407   end;
 408 end;
 409
 410
 411
 412 { Reset error state variables at start of a new image.
 413   This is called during compression startup to reset trace/error
 414   processing to default state, without losing any application-specific
 415   method pointers.  An application might possibly want to override
 416   this method if it has additional error processing state. }
 417
 418
 419 {METHODDEF}
 420 procedure reset_error_mgr (cinfo : j_common_ptr);
 421 begin
 422   cinfo^.err^.num_warnings := 0;
 423   { trace_level is not reset since it is an application-supplied parameter }
 424   cinfo^.err^.msg_code := 0;      { may be useful as a flag for "no error" }
 425 end;
 426
 427
 428 { Fill in the standard error-handling methods in a jpeg_error_mgr object.
 429   Typical call is:
 430         cinfo : jpeg_compress_struct;
 431         err : jpeg_error_mgr;
 432
 433         cinfo.err := jpeg_std_error(@err);
 434   after which the application may override some of the methods. }
 435
 436
 437 {GLOBAL}
 438 function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr;
 439 begin
 440   err.error_exit := error_exit;
 441   err.emit_message := emit_message;
 442   err.output_message := output_message;
 443   err.format_message := format_message;
 444   err.reset_error_mgr := reset_error_mgr;
 445
 446   err.trace_level := 0;         { default := no tracing }
 447   err.num_warnings := 0;        { no warnings emitted yet }
 448   err.msg_code := 0;            { may be useful as a flag for "no error" }
 449
 450   { Initialize message table pointers }
 451   err.jpeg_message_table := @jpeg_std_message_table;
 452   err.last_jpeg_message := pred(JMSG_LASTMSGCODE);
 453
 454   err.addon_message_table := NIL;
 455   err.first_addon_message := JMSG_NOMESSAGE;  { for safety }
 456   err.last_addon_message := JMSG_NOMESSAGE;
 457
 458   jpeg_std_error := @err;
 459 end;
 460
 461
 462 end.