jmemmgr.pas

用pascal寫的jpeg codec, 測試過的

  if (writable) then
    ptr^.dirty := TRUE;
  { Return address of proper part of the buffer }
  access_virt_sarray := JSAMPARRAY(@ ptr^.mem_buffer^[start_row - ptr^.cur_start_row]);
end;


{METHODDEF}
function access_virt_barray (cinfo : j_common_ptr;
                             ptr : jvirt_barray_ptr;
		             start_row : JDIMENSION;
                             num_rows : JDIMENSION;
		             writable : boolean) : JBLOCKARRAY; far;
{ Access the part of a virtual block array starting at start_row }
{ and extending for num_rows rows.  writable is true if  }
{ caller intends to modify the accessed area. }
var
  end_row : JDIMENSION;
  undef_row : JDIMENSION;
  ltemp : long;
var
  bytesperrow : size_t;
begin
  end_row := start_row + num_rows;

  { debugging check }
  if (end_row > ptr^.rows_in_array) or (num_rows > ptr^.maxaccess) or
     (ptr^.mem_buffer = NIL) then
    ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS);

  { Make the desired part of the virtual array accessible }
  if (start_row < ptr^.cur_start_row) or
     (end_row > ptr^.cur_start_row+ptr^.rows_in_mem) then
  begin
    if (not ptr^.b_s_open) then
      ERREXIT(cinfo, JERR_VIRTUAL_BUG);
    { Flush old buffer contents if necessary }
    if (ptr^.dirty) then
    begin
      do_barray_io(cinfo, ptr, TRUE);
      ptr^.dirty := FALSE;
    end;
    { Decide what part of virtual array to access.
      Algorithm: if target address > current window, assume forward scan,
      load starting at target address.  If target address < current window,
      assume backward scan, load so that target area is top of window.
      Note that when switching from forward write to forward read, will have
      start_row := 0, so the limiting case applies and we load from 0 anyway. }

    if (start_row > ptr^.cur_start_row) then
    begin
      ptr^.cur_start_row := start_row;
    end
    else
    begin
      { use long arithmetic here to avoid overflow & unsigned problems }

      ltemp := long(end_row) - long(ptr^.rows_in_mem);
      if (ltemp < 0) then
	ltemp := 0;		{ don't fall off front end of file }
      ptr^.cur_start_row := JDIMENSION (ltemp);
    end;
    { Read in the selected part of the array.
      During the initial write pass, we will do no actual read
      because the selected part is all undefined. }

    do_barray_io(cinfo, ptr, FALSE);
  end;
  { Ensure the accessed part of the array is defined; prezero if needed.
    To improve locality of access, we only prezero the part of the array
    that the caller is about to access, not the entire in-memory array. }

  if (ptr^.first_undef_row < end_row) then
  begin
    if (ptr^.first_undef_row < start_row) then
    begin
      if (writable) then	{ writer skipped over a section of array }
	ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS);
      undef_row := start_row;	{ but reader is allowed to read ahead }
    end
    else
    begin
      undef_row := ptr^.first_undef_row;
    end;
    if (writable) then
      ptr^.first_undef_row := end_row;
    if (ptr^.pre_zero) then
    begin
      bytesperrow := size_t (ptr^.blocksperrow) * SIZEOF(JBLOCK);
      Dec(undef_row, ptr^.cur_start_row); { make indexes relative to buffer }
      Dec(end_row, ptr^.cur_start_row);
      while (undef_row < end_row) do
      begin
	jzero_far({FAR}pointer(ptr^.mem_buffer^[undef_row]), bytesperrow);
	Inc(undef_row);
      end;
    end
    else
    begin
      if (not writable) then	{ reader looking at undefined data }
	ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS);
    end;
  end;
  { Flag the buffer dirty if caller will write in it }
  if (writable) then
    ptr^.dirty := TRUE;
  { Return address of proper part of the buffer }
  access_virt_barray := JBLOCKARRAY(@ ptr^.mem_buffer^[start_row - ptr^.cur_start_row]);
end;


{ Release all objects belonging to a specified pool. }

{METHODDEF}
procedure free_pool (cinfo : j_common_ptr; pool_id : int); far;
var
  mem : my_mem_ptr;
  shdr_ptr : small_pool_ptr;
  lhdr_ptr : large_pool_ptr;
  space_freed : size_t;
var
  sptr : jvirt_sarray_ptr;
  bptr : jvirt_barray_ptr;
var
  next_lhdr_ptr : large_pool_ptr;
  next_shdr_ptr : small_pool_ptr;
begin
  mem := my_mem_ptr(cinfo^.mem);

  if (pool_id < 0) or (pool_id >= JPOOL_NUMPOOLS) then
    ERREXIT1(cinfo, JERR_BAD_POOL_ID, pool_id);	{ safety check }

{$ifdef MEM_STATS}
  if (cinfo^.err^.trace_level > 1) then
    print_mem_stats(cinfo, pool_id); { print pool's memory usage statistics }
{$endif}

  { If freeing IMAGE pool, close any virtual arrays first }
  if (pool_id = JPOOL_IMAGE) then
  begin
    sptr := mem^.virt_sarray_list;
    while (sptr <> NIL) do
    begin
      if (sptr^.b_s_open) then
      begin	{ there may be no backing store }
	sptr^.b_s_open := FALSE;	{ prevent recursive close if error }
	sptr^.b_s_info.close_backing_store (cinfo, @sptr^.b_s_info);
      end;
      sptr := sptr^.next;
    end;
    mem^.virt_sarray_list := NIL;
    bptr := mem^.virt_barray_list;
    while (bptr <> NIL) do
    begin
      if (bptr^.b_s_open) then
      begin	{ there may be no backing store }
	bptr^.b_s_open := FALSE;	{ prevent recursive close if error }
	bptr^.b_s_info.close_backing_store (cinfo, @bptr^.b_s_info);
      end;
      bptr := bptr^.next;
    end;
    mem^.virt_barray_list := NIL;
  end;

  { Release large objects }
  lhdr_ptr := mem^.large_list[pool_id];
  mem^.large_list[pool_id] := NIL;

  while (lhdr_ptr <> NIL) do
  begin
    next_lhdr_ptr := lhdr_ptr^.hdr.next;
    space_freed := lhdr_ptr^.hdr.bytes_used +
		  lhdr_ptr^.hdr.bytes_left +
		  SIZEOF(large_pool_hdr);
    jpeg_free_large(cinfo, {FAR} pointer(lhdr_ptr), space_freed);
    Dec(mem^.total_space_allocated, space_freed);
    lhdr_ptr := next_lhdr_ptr;
  end;

  { Release small objects }
  shdr_ptr := mem^.small_list[pool_id];
  mem^.small_list[pool_id] := NIL;

  while (shdr_ptr <> NIL) do
  begin
    next_shdr_ptr := shdr_ptr^.hdr.next;
    space_freed := shdr_ptr^.hdr.bytes_used +
		  shdr_ptr^.hdr.bytes_left +
		  SIZEOF(small_pool_hdr);
    jpeg_free_small(cinfo, pointer(shdr_ptr), space_freed);
    Dec(mem^.total_space_allocated, space_freed);
    shdr_ptr := next_shdr_ptr;
  end;
end;


{ Close up shop entirely.
  Note that this cannot be called unless cinfo^.mem is non-NIL. }

{METHODDEF}
procedure self_destruct (cinfo : j_common_ptr); far;
var
  pool : int;
begin
  { Close all backing store, release all memory.
    Releasing pools in reverse order might help avoid fragmentation
    with some (brain-damaged) malloc libraries. }

  for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT do
  begin
    free_pool(cinfo, pool);
  end;

  { Release the memory manager control block too. }
  jpeg_free_small(cinfo, pointer(cinfo^.mem), SIZEOF(my_memory_mgr));
  cinfo^.mem := NIL;		{ ensures I will be called only once }

  jpeg_mem_term(cinfo);		{ system-dependent cleanup }
end;


{ Memory manager initialization.
  When this is called, only the error manager pointer is valid in cinfo! }

{GLOBAL}
procedure jinit_memory_mgr (cinfo : j_common_ptr);
var
  mem : my_mem_ptr;
  max_to_use : long;
  pool : int;
  test_mac : size_t;
{$ifndef NO_GETENV}
var
  memenv : string;
  code : integer;
{$endif}
begin
  cinfo^.mem := NIL;		{ for safety if init fails }

  { Check for configuration errors.
    SIZEOF(ALIGN_TYPE) should be a power of 2; otherwise, it probably
    doesn't reflect any real hardware alignment requirement.
    The test is a little tricky: for X>0, X and X-1 have no one-bits
    in common if and only if X is a power of 2, ie has only one one-bit.
    Some compilers may give an "unreachable code" warning here; ignore it. }
  if ((SIZEOF(ALIGN_TYPE) and (SIZEOF(ALIGN_TYPE)-1)) <> 0) then
    ERREXIT(cinfo, JERR_BAD_ALIGN_TYPE);
  { MAX_ALLOC_CHUNK must be representable as type size_t, and must be
    a multiple of SIZEOF(ALIGN_TYPE).
    Again, an "unreachable code" warning may be ignored here.
    But a "constant too large" warning means you need to fix MAX_ALLOC_CHUNK. }

  test_mac := size_t (MAX_ALLOC_CHUNK);
  if (long (test_mac) <> MAX_ALLOC_CHUNK) or
      ((MAX_ALLOC_CHUNK mod SIZEOF(ALIGN_TYPE)) <> 0) then
    ERREXIT(cinfo, JERR_BAD_ALLOC_CHUNK);

  max_to_use := jpeg_mem_init(cinfo); { system-dependent initialization }

  { Attempt to allocate memory manager's control block }
  mem := my_mem_ptr (jpeg_get_small(cinfo, SIZEOF(my_memory_mgr)));

  if (mem = NIL) then
  begin
    jpeg_mem_term(cinfo);	{ system-dependent cleanup }
    ERREXIT1(cinfo, JERR_OUT_OF_MEMORY, 0);
  end;

  { OK, fill in the method pointers }
  mem^.pub.alloc_small := alloc_small;
  mem^.pub.alloc_large := alloc_large;
  mem^.pub.alloc_sarray := alloc_sarray;
  mem^.pub.alloc_barray := alloc_barray;
  mem^.pub.request_virt_sarray := request_virt_sarray;
  mem^.pub.request_virt_barray := request_virt_barray;
  mem^.pub.realize_virt_arrays := realize_virt_arrays;
  mem^.pub.access_virt_sarray := access_virt_sarray;
  mem^.pub.access_virt_barray := access_virt_barray;
  mem^.pub.free_pool := free_pool;
  mem^.pub.self_destruct := self_destruct;

  { Initialize working state }
  mem^.pub.max_memory_to_use := max_to_use;

  for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT do
  begin
    mem^.small_list[pool] := NIL;
    mem^.large_list[pool] := NIL;
  end;
  mem^.virt_sarray_list := NIL;
  mem^.virt_barray_list := NIL;

  mem^.total_space_allocated := SIZEOF(my_memory_mgr);

  { Declare ourselves open for business }
  cinfo^.mem := @mem^.pub;

  { Check for an environment variable JPEGMEM; if found, override the
    default max_memory setting from jpeg_mem_init.  Note that the
    surrounding application may again override this value.
    If your system doesn't support getenv(), define NO_GETENV to disable
    this feature. }

{$ifndef NO_GETENV}
  memenv := getenv('JPEGMEM');
  if (memenv <> '') then
  begin
    Val(memenv, max_to_use, code);
    if (Code = 0) then
    begin
      max_to_use := max_to_use * long(1000);
      mem^.pub.max_memory_to_use := max_to_use * long(1000);
    end;
  end;
{$endif}

end;

end.