jmemdos.pas

DELPHI版的JPEG文件解码源程序

  info^.close_backing_store := close_file_store;
  TRACEMSS(cinfo, 1, JTRC_TFILE_OPEN, info^.temp_name);
  open_file_store := TRUE;                             { succeeded }
end;


{ Access methods for extended memory. }

{$ifdef XMS_SUPPORTED}

var
  xms_driver : XMSDRIVER;	{ saved address of XMS driver }

type
  XMSPTR = record               { either long offset or real-mode pointer }
    case byte of
    0:(offset : long);
    1:(ptr : pointer {FAR});
  end;

type
  XMSspec = record              { XMS move specification structure }
    length : long;
    src_handle : XMSH;
    src : XMSPTR;
    dst_handle : XMSH;
    dst : XMSPTR;
  end;
type
  TByteArray = Array[0..MAX_ALLOC_CHUNK-1] of byte;

{METHODDEF}
procedure read_xms_store (cinfo : j_common_ptr;
                          info : backing_store_ptr;
		          buffer_address : pointer; {FAR}
		          file_offset : long;
                          byte_count : long); far;
var
  ctx : XMScontext;
  spec : XMSspec;
  endbuffer : packed array[0..1] of byte;
begin
  { The XMS driver can't cope with an odd length, so handle the last byte
    specially if byte_count is odd.  We don't expect this to be common. }


  spec.length := byte_count and (not long(1));
  spec.src_handle := info^.handle.xms_handle;
  spec.src.offset := file_offset;
  spec.dst_handle := 0;
  spec.dst.ptr := buffer_address;

  ctx.ds_si := addr(spec);
  ctx.ax := $0b00;		{ EMB move }
  jxms_calldriver(xms_driver, ctx);
  if (ctx.ax <> 1) then
    ERREXIT(cinfo, JERR_XMS_READ);

  if odd(byte_count) then
  begin
    read_xms_store(cinfo, info, pointer(@endbuffer) {FAR},
		   file_offset + byte_count - long(1), long(2));
    TByteArray(buffer_address^)[byte_count - long(1)] := endbuffer[0];
  end;
end;


{METHODDEF}
procedure write_xms_store (cinfo : j_common_ptr;
                           info : backing_store_ptr;
		           buffer_address : pointer; {FAR}
		           file_offset : long;
                           byte_count : long); far;
var
  ctx : XMScontext;
  spec : XMSspec;
  endbuffer : packed array[0..1] of byte;
begin
  { The XMS driver can't cope with an odd length, so handle the last byte
    specially if byte_count is odd.  We don't expect this to be common. }

  spec.length := byte_count and (not long(1));
  spec.src_handle := 0;
  spec.src.ptr := buffer_address;
  spec.dst_handle := info^.handle.xms_handle;
  spec.dst.offset := file_offset;

  ctx.ds_si := addr(spec);
  ctx.ax := $0b00;		{ EMB move }
  jxms_calldriver(xms_driver, ctx);
  if (ctx.ax <> 1) then
    ERREXIT(cinfo, JERR_XMS_WRITE);

  if odd(byte_count) then
  begin
    read_xms_store(cinfo, info, pointer(@endbuffer) {FAR},
		   file_offset + byte_count - long(1), long(2));
    endbuffer[0] := TByteArray(buffer_address^)[byte_count - long(1)];
    write_xms_store(cinfo, info, pointer(@endbuffer) {FAR},
		    file_offset + byte_count - long(1), long(2));
  end;
end;


{METHODDEF}
procedure close_xms_store (cinfo : j_common_ptr;
                           info : backing_store_ptr); far;
var
  ctx : XMScontext;
begin
  ctx.dx := info^.handle.xms_handle;
  ctx.ax := $0a00;
  jxms_calldriver(xms_driver, ctx);
  TRACEMS1(cinfo, 1, JTRC_XMS_CLOSE, info^.handle.xms_handle);
  { we ignore any error return from the driver }
end;


{LOCAL}
function open_xms_store (cinfo : j_common_ptr;
                         info : backing_store_ptr;
		         total_bytes_needed : long) : boolean;
var
  ctx : XMScontext;
begin
  { Get address of XMS driver }
  jxms_getdriver(xms_driver);
  if (xms_driver = NIL) then
  begin
    open_xms_store := FALSE;    { no driver to be had }
    exit;
  end;

  { Get version number, must be >= 2.00 }
  ctx.ax := $0000;
  jxms_calldriver(xms_driver, ctx);
  if (ctx.ax < ushort($0200)) then
  begin
    open_xms_store := FALSE;
    exit;
  end;

  { Try to get space (expressed in kilobytes) }
  ctx.dx := ushort ((total_bytes_needed + long(1023)) shr 10);
  ctx.ax := $0900;
  jxms_calldriver(xms_driver, ctx);
  if (ctx.ax <> 1) then
  begin
    open_xms_store := FALSE;
    exit;
  end;

  { Succeeded, save the handle and away we go }
  info^.handle.xms_handle := ctx.dx;
  info^.read_backing_store := read_xms_store;
  info^.write_backing_store := write_xms_store;
  info^.close_backing_store := close_xms_store;
  TRACEMS1(cinfo, 1, JTRC_XMS_OPEN, ctx.dx);
  open_xms_store := TRUE;           { succeeded }
end;

{$endif} { XMS_SUPPORTED }


{ Access methods for expanded memory. }

{$ifdef EMS_SUPPORTED}

{ The EMS move specification structure requires word and long fields aligned
  at odd byte boundaries.  Some compilers will align struct fields at even
  byte boundaries.  While it's usually possible to force byte alignment,
  that causes an overall performance penalty and may pose problems in merging
  JPEG into a larger application.  Instead we accept some rather dirty code
  here.  Note this code would fail if the hardware did not allow odd-byte
  word & long accesses, but all 80x86 CPUs do. }


type
  EMSPTR = pointer; {FAR}


{ types for accessing misaligned fields }
type
  EMSAddrStruct = packed record                       {Size }
    MemType : byte; { emsConventional, emsExpanded }  {  1  }
    Handle : word;  { TEMSHandle; }                   {  2  }
    case integer of                                   {union}
      0 : (Offs : word;                               {  2  }
           Page : word);                              {  2  }
      1 : (Ptr : pointer);                            {or 4 }
  end;
  { EMS move specification structure }
  EMSspec = packed record
    length : longint;                                 { 4 }
    src : EMSAddrStruct;                              { 7 }
    dst : EMSAddrStruct;                              { 7 }
  end;


const
  EMSPAGESIZE = long(16384);    { gospel, see the EMS specs }


{METHODDEF}
procedure read_ems_store (cinfo : j_common_ptr;
                          info : backing_store_ptr;
                          buffer_address : pointer; {FAR}
                          file_offset : long;
                          byte_count : long); far;
var
  ctx : EMScontext;
  spec : EMSspec;
begin
  spec.length := byte_count;
  spec.src.memtype := 1;
  spec.src.handle  := info^.handle.ems_handle;
  spec.src.page  := ushort (file_offset div EMSPAGESIZE);
  spec.src.offs := ushort (file_offset mod EMSPAGESIZE);
  spec.dst.memtype  := 0;
  spec.dst.handle := 0;
  spec.dst.ptr  := buffer_address;

  ctx.ds_si := addr(spec);
  ctx.ax := $5700;		{ move memory region }
  jems_calldriver(ctx);
  if (hi(ctx.ax) <> 0) then
    ERREXIT(cinfo, JERR_EMS_READ);
end;


{METHODDEF}
procedure write_ems_store (cinfo : j_common_ptr;
                           info : backing_store_ptr;
                           buffer_address : pointer; {FAR}
                           file_offset : long;
                           byte_count : long); far;
var
  ctx : EMScontext;
  spec : EMSspec;
begin
  spec.length := byte_count;
  spec.src.memtype := 0;
  spec.src.handle := 0;
  spec.src.ptr := buffer_address;
  spec.dst.memtype := 1;
  spec.dst.handle := info^.handle.ems_handle;
  spec.dst.page := ushort (file_offset div EMSPAGESIZE);
  spec.dst.offs := ushort (file_offset mod EMSPAGESIZE);

  ctx.ds_si := addr(spec);
  ctx.ax := $5700;		{ move memory region }
  jems_calldriver(ctx);
  if (hi(ctx.ax) <> 0) then
    ERREXIT(cinfo, JERR_EMS_WRITE);
end;


{METHODDEF}
procedure close_ems_store (cinfo : j_common_ptr;
                           info : backing_store_ptr); far;
var
  ctx : EMScontext;
begin
  ctx.ax := $4500;
  ctx.dx := info^.handle.ems_handle;
  jems_calldriver(ctx);
  TRACEMS1(cinfo, 1, JTRC_EMS_CLOSE, info^.handle.ems_handle);
  { we ignore any error return from the driver }
end;


{LOCAL}
function open_ems_store (cinfo : j_common_ptr;
                         info : backing_store_ptr;
		         total_bytes_needed : long) : boolean;
var
  ctx : EMScontext;
begin
  { Is EMS driver there? }
  if (jems_available = 0) then
  begin
    open_ems_store := FALSE;
    exit;
  end;

  { Get status, make sure EMS is OK }
  ctx.ax := $4000;
  jems_calldriver(ctx);
  if (hi(ctx.ax) <> 0) then
  begin
    open_ems_store := FALSE;
    exit;
  end;

  { Get version, must be >= 4.0 }
  ctx.ax := $4600;
  jems_calldriver(ctx);
  if (hi(ctx.ax) <> 0) or (lo(ctx.ax) < $40) then
  begin
    open_ems_store := FALSE;
    exit;
  end;

  { Try to allocate requested space }
  ctx.ax := $4300;
  ctx.bx := ushort ((total_bytes_needed +
                     EMSPAGESIZE-long(1)) div EMSPAGESIZE);
  jems_calldriver(ctx);
  if (hi(ctx.ax) <> 0) then
  begin
    open_ems_store := FALSE;
    exit;
  end;

  { Succeeded, save the handle and away we go }
  info^.handle.ems_handle := ctx.dx;
  info^.read_backing_store := read_ems_store;
  info^.write_backing_store := write_ems_store;
  info^.close_backing_store := close_ems_store;
  TRACEMS1(cinfo, 1, JTRC_EMS_OPEN, ctx.dx);
  open_ems_store := TRUE;        { succeeded }
end;

{$endif} { EMS_SUPPORTED }

{ Initial opening of a backing-store object.  This must fill in the
  read/write/close pointers in the object.  The read/write routines
  may take an error exit if the specified maximum file size is exceeded.
  (If jpeg_mem_available always returns a large value, this routine can
  just take an error exit.) }




{ Initial opening of a backing-store object. }

{GLOBAL}
procedure jpeg_open_backing_store (cinfo : j_common_ptr;
                                   info : backing_store_ptr;
                                   total_bytes_needed : long);
begin
  { Try extended memory, then expanded memory, then regular file. }
{$ifdef XMS_SUPPORTED}
  if (open_xms_store(cinfo, info, total_bytes_needed)) then
    exit;
{$endif}
{$ifdef EMS_SUPPORTED}
  if (open_ems_store(cinfo, info, total_bytes_needed)) then
    exit;
{$endif}
  if (open_file_store(cinfo, info, total_bytes_needed)) then
    exit;
  ERREXITS(cinfo, JERR_TFILE_CREATE, '');
end;

{ These routines take care of any system-dependent initialization and
  cleanup required.  jpeg_mem_init will be called before anything is
  allocated (and, therefore, nothing in cinfo is of use except the error
  manager pointer).  It should return a suitable default value for
  max_memory_to_use; this may subsequently be overridden by the surrounding
  application.  (Note that max_memory_to_use is only important if
  jpeg_mem_available chooses to consult it ... no one else will.)
  jpeg_mem_term may assume that all requested memory has been freed and that
  all opened backing-store objects have been closed. }


{ These routines take care of any system-dependent initialization and
  cleanup required. }


{GLOBAL}
function jpeg_mem_init (cinfo : j_common_ptr) : long;
begin
  next_file_num := 0;		{ initialize temp file name generator }
  jpeg_mem_init := DEFAULT_MAX_MEM;   { default for max_memory_to_use }
end;

{GLOBAL}
procedure jpeg_mem_term (cinfo : j_common_ptr);
begin
  { Microsoft C, at least in v6.00A, will not successfully reclaim freed
    blocks of size > 32Kbytes unless we give it a kick in the rear,
    like so: }

{$ifdef NEED_FHEAPMIN}
  _fheapmin();
{$endif}
end;

end.