DEADSOFTWARE

render: fix archvile fire animation
[d2df-sdl.git] / src / lib / vampimg / JpegLib / imjmemmgr.pas
1 unit imjmemmgr;
3 { This file contains the JPEG system-independent memory management
4 routines. This code is usable across a wide variety of machines; most
5 of the system dependencies have been isolated in a separate file.
6 The major functions provided here are:
7 * pool-based allocation and freeing of memory;
8 * policy decisions about how to divide available memory among the
9 virtual arrays;
10 * control logic for swapping virtual arrays between main memory and
11 backing storage.
12 The separate system-dependent file provides the actual backing-storage
13 access code, and it contains the policy decision about how much total
14 main memory to use.
15 This file is system-dependent in the sense that some of its functions
16 are unnecessary in some systems. For example, if there is enough virtual
17 memory so that backing storage will never be used, much of the virtual
18 array control logic could be removed. (Of course, if you have that much
19 memory then you shouldn't care about a little bit of unused code...) }
21 { Original : jmemmgr.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
23 interface
25 {$I imjconfig.inc}
27 uses
28 imjmorecfg,
29 imjinclude,
30 imjdeferr,
31 imjerror,
32 imjpeglib,
33 imjutils,
34 {$IFDEF VER70}
35 {$ifndef NO_GETENV}
36 Dos, { DOS unit should declare getenv() }
37 { function GetEnv(name : string) : string; }
38 {$endif}
39 imjmemdos; { import the system-dependent declarations }
40 {$ELSE}
41 imjmemnobs;
42 {$DEFINE NO_GETENV}
43 {$ENDIF}
45 { Memory manager initialization.
46 When this is called, only the error manager pointer is valid in cinfo! }
48 {GLOBAL}
49 procedure jinit_memory_mgr (cinfo : j_common_ptr);
51 implementation
54 { Some important notes:
55 The allocation routines provided here must never return NIL.
56 They should exit to error_exit if unsuccessful.
58 It's not a good idea to try to merge the sarray and barray routines,
59 even though they are textually almost the same, because samples are
60 usually stored as bytes while coefficients are shorts or ints. Thus,
61 in machines where byte pointers have a different representation from
62 word pointers, the resulting machine code could not be the same. }
65 { Many machines require storage alignment: longs must start on 4-byte
66 boundaries, doubles on 8-byte boundaries, etc. On such machines, malloc()
67 always returns pointers that are multiples of the worst-case alignment
68 requirement, and we had better do so too.
69 There isn't any really portable way to determine the worst-case alignment
70 requirement. This module assumes that the alignment requirement is
71 multiples of sizeof(ALIGN_TYPE).
72 By default, we define ALIGN_TYPE as double. This is necessary on some
73 workstations (where doubles really do need 8-byte alignment) and will work
74 fine on nearly everything. If your machine has lesser alignment needs,
75 you can save a few bytes by making ALIGN_TYPE smaller.
76 The only place I know of where this will NOT work is certain Macintosh
77 680x0 compilers that define double as a 10-byte IEEE extended float.
78 Doing 10-byte alignment is counterproductive because longwords won't be
79 aligned well. Put "#define ALIGN_TYPE long" in jconfig.h if you have
80 such a compiler. }
82 {$ifndef ALIGN_TYPE} { so can override from jconfig.h }
83 type
84 ALIGN_TYPE = double;
85 {$endif}
88 { We allocate objects from "pools", where each pool is gotten with a single
89 request to jpeg_get_small() or jpeg_get_large(). There is no per-object
90 overhead within a pool, except for alignment padding. Each pool has a
91 header with a link to the next pool of the same class.
92 Small and large pool headers are identical except that the latter's
93 link pointer must be FAR on 80x86 machines.
94 Notice that the "real" header fields are union'ed with a dummy ALIGN_TYPE
95 field. This forces the compiler to make SIZEOF(small_pool_hdr) a multiple
96 of the alignment requirement of ALIGN_TYPE. }
98 type
99 small_pool_ptr = ^small_pool_hdr;
100 small_pool_hdr = record
101 case byte of
102 0:(hdr : record
103 next : small_pool_ptr; { next in list of pools }
104 bytes_used : size_t; { how many bytes already used within pool }
105 bytes_left : size_t; { bytes still available in this pool }
106 end);
107 1:(dummy : ALIGN_TYPE); { included in union to ensure alignment }
108 end; {small_pool_hdr;}
110 type
111 large_pool_ptr = ^large_pool_hdr; {FAR}
112 large_pool_hdr = record
113 case byte of
114 0:(hdr : record
115 next : large_pool_ptr; { next in list of pools }
116 bytes_used : size_t; { how many bytes already used within pool }
117 bytes_left : size_t; { bytes still available in this pool }
118 end);
119 1:(dummy : ALIGN_TYPE); { included in union to ensure alignment }
120 end; {large_pool_hdr;}
123 { Here is the full definition of a memory manager object. }
125 type
126 my_mem_ptr = ^my_memory_mgr;
127 my_memory_mgr = record
128 pub : jpeg_memory_mgr; { public fields }
130 { Each pool identifier (lifetime class) names a linked list of pools. }
131 small_list : array[0..JPOOL_NUMPOOLS-1] of small_pool_ptr ;
132 large_list : array[0..JPOOL_NUMPOOLS-1] of large_pool_ptr ;
134 { Since we only have one lifetime class of virtual arrays, only one
135 linked list is necessary (for each datatype). Note that the virtual
136 array control blocks being linked together are actually stored somewhere
137 in the small-pool list. }
139 virt_sarray_list : jvirt_sarray_ptr;
140 virt_barray_list : jvirt_barray_ptr;
142 { This counts total space obtained from jpeg_get_small/large }
143 total_space_allocated : long;
145 { alloc_sarray and alloc_barray set this value for use by virtual
146 array routines. }
148 last_rowsperchunk : JDIMENSION; { from most recent alloc_sarray/barray }
149 end; {my_memory_mgr;}
151 {$ifndef AM_MEMORY_MANAGER} { only jmemmgr.c defines these }
153 { The control blocks for virtual arrays.
154 Note that these blocks are allocated in the "small" pool area.
155 System-dependent info for the associated backing store (if any) is hidden
156 inside the backing_store_info struct. }
157 type
158 jvirt_sarray_control = record
159 mem_buffer : JSAMPARRAY; { => the in-memory buffer }
160 rows_in_array : JDIMENSION; { total virtual array height }
161 samplesperrow : JDIMENSION; { width of array (and of memory buffer) }
162 maxaccess : JDIMENSION; { max rows accessed by access_virt_sarray }
163 rows_in_mem : JDIMENSION; { height of memory buffer }
164 rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer }
165 cur_start_row : JDIMENSION; { first logical row # in the buffer }
166 first_undef_row : JDIMENSION; { row # of first uninitialized row }
167 pre_zero : boolean; { pre-zero mode requested? }
168 dirty : boolean; { do current buffer contents need written? }
169 b_s_open : boolean; { is backing-store data valid? }
170 next : jvirt_sarray_ptr; { link to next virtual sarray control block }
171 b_s_info : backing_store_info; { System-dependent control info }
172 end;
174 jvirt_barray_control = record
175 mem_buffer : JBLOCKARRAY; { => the in-memory buffer }
176 rows_in_array : JDIMENSION; { total virtual array height }
177 blocksperrow : JDIMENSION; { width of array (and of memory buffer) }
178 maxaccess : JDIMENSION; { max rows accessed by access_virt_barray }
179 rows_in_mem : JDIMENSION; { height of memory buffer }
180 rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer }
181 cur_start_row : JDIMENSION; { first logical row # in the buffer }
182 first_undef_row : JDIMENSION; { row # of first uninitialized row }
183 pre_zero : boolean; { pre-zero mode requested? }
184 dirty : boolean; { do current buffer contents need written? }
185 b_s_open : boolean; { is backing-store data valid? }
186 next : jvirt_barray_ptr; { link to next virtual barray control block }
187 b_s_info : backing_store_info; { System-dependent control info }
188 end;
189 {$endif} { AM_MEMORY_MANAGER}
191 {$ifdef MEM_STATS} { optional extra stuff for statistics }
193 {LOCAL}
194 procedure print_mem_stats (cinfo : j_common_ptr; pool_id : int);
195 var
196 mem : my_mem_ptr;
197 shdr_ptr : small_pool_ptr;
198 lhdr_ptr : large_pool_ptr;
199 begin
200 mem := my_mem_ptr (cinfo^.mem);
202 { Since this is only a debugging stub, we can cheat a little by using
203 fprintf directly rather than going through the trace message code.
204 This is helpful because message parm array can't handle longs. }
206 WriteLn(output, 'Freeing pool ', pool_id,', total space := ',
207 mem^.total_space_allocated);
209 lhdr_ptr := mem^.large_list[pool_id];
210 while (lhdr_ptr <> NIL) do
211 begin
212 WriteLn(output, ' Large chunk used ',
213 long (lhdr_ptr^.hdr.bytes_used));
214 lhdr_ptr := lhdr_ptr^.hdr.next;
215 end;
217 shdr_ptr := mem^.small_list[pool_id];
219 while (shdr_ptr <> NIL) do
220 begin
221 WriteLn(output, ' Small chunk used ',
222 long (shdr_ptr^.hdr.bytes_used), ' free ',
223 long (shdr_ptr^.hdr.bytes_left) );
224 shdr_ptr := shdr_ptr^.hdr.next;
225 end;
226 end;
228 {$endif} { MEM_STATS }
231 {LOCAL}
232 procedure out_of_memory (cinfo : j_common_ptr; which : int);
233 { Report an out-of-memory error and stop execution }
234 { If we compiled MEM_STATS support, report alloc requests before dying }
235 begin
236 {$ifdef MEM_STATS}
237 cinfo^.err^.trace_level := 2; { force self_destruct to report stats }
238 {$endif}
239 ERREXIT1(cinfo, JERR_OUT_OF_MEMORY, which);
240 end;
243 { Allocation of "small" objects.
245 For these, we use pooled storage. When a new pool must be created,
246 we try to get enough space for the current request plus a "slop" factor,
247 where the slop will be the amount of leftover space in the new pool.
248 The speed vs. space tradeoff is largely determined by the slop values.
249 A different slop value is provided for each pool class (lifetime),
250 and we also distinguish the first pool of a class from later ones.
251 NOTE: the values given work fairly well on both 16- and 32-bit-int
252 machines, but may be too small if longs are 64 bits or more. }
254 const
255 first_pool_slop : array[0..JPOOL_NUMPOOLS-1] of size_t =
256 (1600, { first PERMANENT pool }
257 16000); { first IMAGE pool }
259 const
260 extra_pool_slop : array[0..JPOOL_NUMPOOLS-1] of size_t =
261 (0, { additional PERMANENT pools }
262 5000); { additional IMAGE pools }
264 const
265 MIN_SLOP = 50; { greater than 0 to avoid futile looping }
268 {METHODDEF}
269 function alloc_small (cinfo : j_common_ptr;
270 pool_id : int;
271 sizeofobject : size_t) : pointer;
272 type
273 byteptr = ^byte;
274 { Allocate a "small" object }
275 var
276 mem : my_mem_ptr;
277 hdr_ptr, prev_hdr_ptr : small_pool_ptr;
278 data_ptr : byteptr;
279 odd_bytes, min_request, slop : size_t;
280 begin
281 mem := my_mem_ptr (cinfo^.mem);
283 { Check for unsatisfiable request (do now to ensure no overflow below) }
284 if (sizeofobject > size_t(MAX_ALLOC_CHUNK-SIZEOF(small_pool_hdr))) then
285 out_of_memory(cinfo, 1); { request exceeds malloc's ability }
287 { Round up the requested size to a multiple of SIZEOF(ALIGN_TYPE) }
288 odd_bytes := sizeofobject mod SIZEOF(ALIGN_TYPE);
289 if (odd_bytes > 0) then
290 Inc(sizeofobject, SIZEOF(ALIGN_TYPE) - odd_bytes);
292 { See if space is available in any existing pool }
293 if (pool_id < 0) or (pool_id >= JPOOL_NUMPOOLS) then
294 ERREXIT1(j_common_ptr(cinfo), JERR_BAD_POOL_ID, pool_id); { safety check }
295 prev_hdr_ptr := NIL;
296 hdr_ptr := mem^.small_list[pool_id];
297 while (hdr_ptr <> NIL) do
298 begin
299 if (hdr_ptr^.hdr.bytes_left >= sizeofobject) then
300 break; { found pool with enough space }
301 prev_hdr_ptr := hdr_ptr;
302 hdr_ptr := hdr_ptr^.hdr.next;
303 end;
305 { Time to make a new pool? }
306 if (hdr_ptr = NIL) then
307 begin
308 { min_request is what we need now, slop is what will be leftover }
309 min_request := sizeofobject + SIZEOF(small_pool_hdr);
310 if (prev_hdr_ptr = NIL) then { first pool in class? }
311 slop := first_pool_slop[pool_id]
312 else
313 slop := extra_pool_slop[pool_id];
314 { Don't ask for more than MAX_ALLOC_CHUNK }
315 if (slop > size_t (MAX_ALLOC_CHUNK-min_request)) then
316 slop := size_t (MAX_ALLOC_CHUNK-min_request);
317 { Try to get space, if fail reduce slop and try again }
318 while TRUE do
319 begin
320 hdr_ptr := small_pool_ptr(jpeg_get_small(cinfo, min_request + slop));
321 if (hdr_ptr <> NIL) then
322 break;
323 slop := slop div 2;
324 if (slop < MIN_SLOP) then { give up when it gets real small }
325 out_of_memory(cinfo, 2); { jpeg_get_small failed }
326 end;
327 Inc(mem^.total_space_allocated, min_request + slop);
328 { Success, initialize the new pool header and add to end of list }
329 hdr_ptr^.hdr.next := NIL;
330 hdr_ptr^.hdr.bytes_used := 0;
331 hdr_ptr^.hdr.bytes_left := sizeofobject + slop;
332 if (prev_hdr_ptr = NIL) then { first pool in class? }
333 mem^.small_list[pool_id] := hdr_ptr
334 else
335 prev_hdr_ptr^.hdr.next := hdr_ptr;
336 end;
338 { OK, allocate the object from the current pool }
339 data_ptr := byteptr (hdr_ptr);
340 Inc(small_pool_ptr(data_ptr)); { point to first data byte in pool }
341 Inc(data_ptr, hdr_ptr^.hdr.bytes_used); { point to place for object }
342 Inc(hdr_ptr^.hdr.bytes_used, sizeofobject);
343 Dec(hdr_ptr^.hdr.bytes_left, sizeofobject);
345 alloc_small := pointer(data_ptr);
346 end;
349 { Allocation of "large" objects.
351 The external semantics of these are the same as "small" objects,
352 except that FAR pointers are used on 80x86. However the pool
353 management heuristics are quite different. We assume that each
354 request is large enough that it may as well be passed directly to
355 jpeg_get_large; the pool management just links everything together
356 so that we can free it all on demand.
357 Note: the major use of "large" objects is in JSAMPARRAY and JBLOCKARRAY
358 structures. The routines that create these structures (see below)
359 deliberately bunch rows together to ensure a large request size. }
361 {METHODDEF}
362 function alloc_large (cinfo : j_common_ptr;
363 pool_id : int;
364 sizeofobject : size_t) : pointer;
365 { Allocate a "large" object }
366 var
367 mem : my_mem_ptr;
368 hdr_ptr : large_pool_ptr;
369 odd_bytes : size_t;
370 var
371 dest_ptr : large_pool_ptr;
372 begin
373 mem := my_mem_ptr (cinfo^.mem);
375 { Check for unsatisfiable request (do now to ensure no overflow below) }
376 if (sizeofobject > size_t (MAX_ALLOC_CHUNK-SIZEOF(large_pool_hdr))) then
377 out_of_memory(cinfo, 3); { request exceeds malloc's ability }
379 { Round up the requested size to a multiple of SIZEOF(ALIGN_TYPE) }
380 odd_bytes := sizeofobject mod SIZEOF(ALIGN_TYPE);
381 if (odd_bytes > 0) then
382 Inc(sizeofobject, SIZEOF(ALIGN_TYPE) - odd_bytes);
384 { Always make a new pool }
385 if (pool_id < 0) or (pool_id >= JPOOL_NUMPOOLS) then
386 ERREXIT1(cinfo, JERR_BAD_POOL_ID, pool_id); { safety check }
388 hdr_ptr := large_pool_ptr (jpeg_get_large(cinfo, sizeofobject +
389 SIZEOF(large_pool_hdr)));
390 if (hdr_ptr = NIL) then
391 out_of_memory(cinfo, 4); { jpeg_get_large failed }
392 Inc(mem^.total_space_allocated, sizeofobject + SIZEOF(large_pool_hdr));
394 { Success, initialize the new pool header and add to list }
395 hdr_ptr^.hdr.next := mem^.large_list[pool_id];
396 { We maintain space counts in each pool header for statistical purposes,
397 even though they are not needed for allocation. }
399 hdr_ptr^.hdr.bytes_used := sizeofobject;
400 hdr_ptr^.hdr.bytes_left := 0;
401 mem^.large_list[pool_id] := hdr_ptr;
403 {alloc_large := pointerFAR (hdr_ptr + 1); - point to first data byte in pool }
404 dest_ptr := hdr_ptr;
405 Inc(large_pool_ptr(dest_ptr));
406 alloc_large := dest_ptr;
407 end;
410 { Creation of 2-D sample arrays.
411 The pointers are in near heap, the samples themselves in FAR heap.
413 To minimize allocation overhead and to allow I/O of large contiguous
414 blocks, we allocate the sample rows in groups of as many rows as possible
415 without exceeding MAX_ALLOC_CHUNK total bytes per allocation request.
416 NB: the virtual array control routines, later in this file, know about
417 this chunking of rows. The rowsperchunk value is left in the mem manager
418 object so that it can be saved away if this sarray is the workspace for
419 a virtual array. }
421 {METHODDEF}
422 function alloc_sarray (cinfo : j_common_ptr;
423 pool_id : int;
424 samplesperrow : JDIMENSION;
425 numrows : JDIMENSION) : JSAMPARRAY;
426 { Allocate a 2-D sample array }
427 var
428 mem : my_mem_ptr;
429 the_result : JSAMPARRAY;
430 workspace : JSAMPROW;
431 rowsperchunk, currow, i : JDIMENSION;
432 ltemp : long;
433 begin
434 mem := my_mem_ptr(cinfo^.mem);
436 { Calculate max # of rows allowed in one allocation chunk }
437 ltemp := (MAX_ALLOC_CHUNK-SIZEOF(large_pool_hdr)) div
438 (long(samplesperrow) * SIZEOF(JSAMPLE));
439 if (ltemp <= 0) then
440 ERREXIT(cinfo, JERR_WIDTH_OVERFLOW);
441 if (ltemp < long(numrows)) then
442 rowsperchunk := JDIMENSION (ltemp)
443 else
444 rowsperchunk := numrows;
445 mem^.last_rowsperchunk := rowsperchunk;
447 { Get space for row pointers (small object) }
448 the_result := JSAMPARRAY (alloc_small(cinfo, pool_id,
449 size_t (numrows * SIZEOF(JSAMPROW))));
451 { Get the rows themselves (large objects) }
452 currow := 0;
453 while (currow < numrows) do
454 begin
455 {rowsperchunk := MIN(rowsperchunk, numrows - currow);}
456 if rowsperchunk > numrows - currow then
457 rowsperchunk := numrows - currow;
459 workspace := JSAMPROW (alloc_large(cinfo, pool_id,
460 size_t (size_t(rowsperchunk) * size_t(samplesperrow)
461 * SIZEOF(JSAMPLE))) );
462 for i := pred(rowsperchunk) downto 0 do
463 begin
464 the_result^[currow] := workspace;
465 Inc(currow);
466 Inc(JSAMPLE_PTR(workspace), samplesperrow);
467 end;
468 end;
470 alloc_sarray := the_result;
471 end;
474 { Creation of 2-D coefficient-block arrays.
475 This is essentially the same as the code for sample arrays, above. }
477 {METHODDEF}
478 function alloc_barray (cinfo : j_common_ptr;
479 pool_id : int;
480 blocksperrow : JDIMENSION;
481 numrows : JDIMENSION) : JBLOCKARRAY;
482 { Allocate a 2-D coefficient-block array }
483 var
484 mem : my_mem_ptr;
485 the_result : JBLOCKARRAY;
486 workspace : JBLOCKROW;
487 rowsperchunk, currow, i : JDIMENSION;
488 ltemp : long;
489 begin
490 mem := my_mem_ptr(cinfo^.mem);
492 { Calculate max # of rows allowed in one allocation chunk }
493 ltemp := (MAX_ALLOC_CHUNK-SIZEOF(large_pool_hdr)) div
494 (long(blocksperrow) * SIZEOF(JBLOCK));
496 if (ltemp <= 0) then
497 ERREXIT(cinfo, JERR_WIDTH_OVERFLOW);
498 if (ltemp < long(numrows)) then
499 rowsperchunk := JDIMENSION (ltemp)
500 else
501 rowsperchunk := numrows;
502 mem^.last_rowsperchunk := rowsperchunk;
504 { Get space for row pointers (small object) }
505 the_result := JBLOCKARRAY (alloc_small(cinfo, pool_id,
506 size_t (numrows * SIZEOF(JBLOCKROW))) );
508 { Get the rows themselves (large objects) }
509 currow := 0;
510 while (currow < numrows) do
511 begin
512 {rowsperchunk := MIN(rowsperchunk, numrows - currow);}
513 if rowsperchunk > numrows - currow then
514 rowsperchunk := numrows - currow;
516 workspace := JBLOCKROW (alloc_large(cinfo, pool_id,
517 size_t (size_t(rowsperchunk) * size_t(blocksperrow)
518 * SIZEOF(JBLOCK))) );
519 for i := rowsperchunk downto 1 do
520 begin
521 the_result^[currow] := workspace;
522 Inc(currow);
523 Inc(JBLOCK_PTR(workspace), blocksperrow);
524 end;
525 end;
527 alloc_barray := the_result;
528 end;
531 { About virtual array management:
533 The above "normal" array routines are only used to allocate strip buffers
534 (as wide as the image, but just a few rows high). Full-image-sized buffers
535 are handled as "virtual" arrays. The array is still accessed a strip at a
536 time, but the memory manager must save the whole array for repeated
537 accesses. The intended implementation is that there is a strip buffer in
538 memory (as high as is possible given the desired memory limit), plus a
539 backing file that holds the rest of the array.
541 The request_virt_array routines are told the total size of the image and
542 the maximum number of rows that will be accessed at once. The in-memory
543 buffer must be at least as large as the maxaccess value.
545 The request routines create control blocks but not the in-memory buffers.
546 That is postponed until realize_virt_arrays is called. At that time the
547 total amount of space needed is known (approximately, anyway), so free
548 memory can be divided up fairly.
550 The access_virt_array routines are responsible for making a specific strip
551 area accessible (after reading or writing the backing file, if necessary).
552 Note that the access routines are told whether the caller intends to modify
553 the accessed strip; during a read-only pass this saves having to rewrite
554 data to disk. The access routines are also responsible for pre-zeroing
555 any newly accessed rows, if pre-zeroing was requested.
557 In current usage, the access requests are usually for nonoverlapping
558 strips; that is, successive access start_row numbers differ by exactly
559 num_rows := maxaccess. This means we can get good performance with simple
560 buffer dump/reload logic, by making the in-memory buffer be a multiple
561 of the access height; then there will never be accesses across bufferload
562 boundaries. The code will still work with overlapping access requests,
563 but it doesn't handle bufferload overlaps very efficiently. }
566 {METHODDEF}
567 function request_virt_sarray (cinfo : j_common_ptr;
568 pool_id : int;
569 pre_zero : boolean;
570 samplesperrow : JDIMENSION;
571 numrows : JDIMENSION;
572 maxaccess : JDIMENSION) : jvirt_sarray_ptr;
573 { Request a virtual 2-D sample array }
574 var
575 mem : my_mem_ptr;
576 the_result : jvirt_sarray_ptr;
577 begin
578 mem := my_mem_ptr (cinfo^.mem);
580 { Only IMAGE-lifetime virtual arrays are currently supported }
581 if (pool_id <> JPOOL_IMAGE) then
582 ERREXIT1(cinfo, JERR_BAD_POOL_ID, pool_id); { safety check }
584 { get control block }
585 the_result := jvirt_sarray_ptr (alloc_small(cinfo, pool_id,
586 SIZEOF(jvirt_sarray_control)) );
588 the_result^.mem_buffer := NIL; { marks array not yet realized }
589 the_result^.rows_in_array := numrows;
590 the_result^.samplesperrow := samplesperrow;
591 the_result^.maxaccess := maxaccess;
592 the_result^.pre_zero := pre_zero;
593 the_result^.b_s_open := FALSE; { no associated backing-store object }
594 the_result^.next := mem^.virt_sarray_list; { add to list of virtual arrays }
595 mem^.virt_sarray_list := the_result;
597 request_virt_sarray := the_result;
598 end;
601 {METHODDEF}
602 function request_virt_barray (cinfo : j_common_ptr;
603 pool_id : int;
604 pre_zero : boolean;
605 blocksperrow : JDIMENSION;
606 numrows : JDIMENSION;
607 maxaccess : JDIMENSION) : jvirt_barray_ptr;
608 { Request a virtual 2-D coefficient-block array }
609 var
610 mem : my_mem_ptr;
611 the_result : jvirt_barray_ptr;
612 begin
613 mem := my_mem_ptr(cinfo^.mem);
615 { Only IMAGE-lifetime virtual arrays are currently supported }
616 if (pool_id <> JPOOL_IMAGE) then
617 ERREXIT1(cinfo, JERR_BAD_POOL_ID, pool_id); { safety check }
619 { get control block }
620 the_result := jvirt_barray_ptr(alloc_small(cinfo, pool_id,
621 SIZEOF(jvirt_barray_control)) );
623 the_result^.mem_buffer := NIL; { marks array not yet realized }
624 the_result^.rows_in_array := numrows;
625 the_result^.blocksperrow := blocksperrow;
626 the_result^.maxaccess := maxaccess;
627 the_result^.pre_zero := pre_zero;
628 the_result^.b_s_open := FALSE; { no associated backing-store object }
629 the_result^.next := mem^.virt_barray_list; { add to list of virtual arrays }
630 mem^.virt_barray_list := the_result;
632 request_virt_barray := the_result;
633 end;
636 {METHODDEF}
637 procedure realize_virt_arrays (cinfo : j_common_ptr);
638 { Allocate the in-memory buffers for any unrealized virtual arrays }
639 var
640 mem : my_mem_ptr;
641 space_per_minheight, maximum_space, avail_mem : long;
642 minheights, max_minheights : long;
643 sptr : jvirt_sarray_ptr;
644 bptr : jvirt_barray_ptr;
645 begin
646 mem := my_mem_ptr (cinfo^.mem);
647 { Compute the minimum space needed (maxaccess rows in each buffer)
648 and the maximum space needed (full image height in each buffer).
649 These may be of use to the system-dependent jpeg_mem_available routine. }
651 space_per_minheight := 0;
652 maximum_space := 0;
653 sptr := mem^.virt_sarray_list;
654 while (sptr <> NIL) do
655 begin
656 if (sptr^.mem_buffer = NIL) then
657 begin { if not realized yet }
658 Inc(space_per_minheight, long(sptr^.maxaccess) *
659 long(sptr^.samplesperrow) * SIZEOF(JSAMPLE));
660 Inc(maximum_space, long(sptr^.rows_in_array) *
661 long(sptr^.samplesperrow) * SIZEOF(JSAMPLE));
662 end;
663 sptr := sptr^.next;
664 end;
665 bptr := mem^.virt_barray_list;
666 while (bptr <> NIL) do
667 begin
668 if (bptr^.mem_buffer = NIL) then
669 begin { if not realized yet }
670 Inc(space_per_minheight, long(bptr^.maxaccess) *
671 long(bptr^.blocksperrow) * SIZEOF(JBLOCK));
672 Inc(maximum_space, long(bptr^.rows_in_array) *
673 long(bptr^.blocksperrow) * SIZEOF(JBLOCK));
674 end;
675 bptr := bptr^.next;
676 end;
678 if (space_per_minheight <= 0) then
679 exit; { no unrealized arrays, no work }
681 { Determine amount of memory to actually use; this is system-dependent. }
682 avail_mem := jpeg_mem_available(cinfo, space_per_minheight, maximum_space,
683 mem^.total_space_allocated);
685 { If the maximum space needed is available, make all the buffers full
686 height; otherwise parcel it out with the same number of minheights
687 in each buffer. }
689 if (avail_mem >= maximum_space) then
690 max_minheights := long(1000000000)
691 else
692 begin
693 max_minheights := avail_mem div space_per_minheight;
694 { If there doesn't seem to be enough space, try to get the minimum
695 anyway. This allows a "stub" implementation of jpeg_mem_available(). }
696 if (max_minheights <= 0) then
697 max_minheights := 1;
698 end;
700 { Allocate the in-memory buffers and initialize backing store as needed. }
702 sptr := mem^.virt_sarray_list;
703 while (sptr <> NIL) do
704 begin
705 if (sptr^.mem_buffer = NIL) then
706 begin { if not realized yet }
707 minheights := (long(sptr^.rows_in_array) - long(1)) div LongInt(sptr^.maxaccess) + long(1);
708 if (minheights <= max_minheights) then
709 begin
710 { This buffer fits in memory }
711 sptr^.rows_in_mem := sptr^.rows_in_array;
712 end
713 else
714 begin
715 { It doesn't fit in memory, create backing store. }
716 sptr^.rows_in_mem := JDIMENSION(max_minheights) * sptr^.maxaccess;
717 jpeg_open_backing_store(cinfo,
718 @sptr^.b_s_info,
719 long(sptr^.rows_in_array) *
720 long(sptr^.samplesperrow) *
721 long(SIZEOF(JSAMPLE)));
722 sptr^.b_s_open := TRUE;
723 end;
724 sptr^.mem_buffer := alloc_sarray(cinfo, JPOOL_IMAGE,
725 sptr^.samplesperrow, sptr^.rows_in_mem);
726 sptr^.rowsperchunk := mem^.last_rowsperchunk;
727 sptr^.cur_start_row := 0;
728 sptr^.first_undef_row := 0;
729 sptr^.dirty := FALSE;
730 end;
731 sptr := sptr^.next;
732 end;
734 bptr := mem^.virt_barray_list;
735 while (bptr <> NIL) do
736 begin
737 if (bptr^.mem_buffer = NIL) then
738 begin { if not realized yet }
739 minheights := (long(bptr^.rows_in_array) - long(1)) div LongInt(bptr^.maxaccess) + long(1);
740 if (minheights <= max_minheights) then
741 begin
742 { This buffer fits in memory }
743 bptr^.rows_in_mem := bptr^.rows_in_array;
744 end
745 else
746 begin
747 { It doesn't fit in memory, create backing store. }
748 bptr^.rows_in_mem := JDIMENSION (max_minheights) * bptr^.maxaccess;
749 jpeg_open_backing_store(cinfo,
750 @bptr^.b_s_info,
751 long(bptr^.rows_in_array) *
752 long(bptr^.blocksperrow) *
753 long(SIZEOF(JBLOCK)));
754 bptr^.b_s_open := TRUE;
755 end;
756 bptr^.mem_buffer := alloc_barray(cinfo, JPOOL_IMAGE,
757 bptr^.blocksperrow, bptr^.rows_in_mem);
758 bptr^.rowsperchunk := mem^.last_rowsperchunk;
759 bptr^.cur_start_row := 0;
760 bptr^.first_undef_row := 0;
761 bptr^.dirty := FALSE;
762 end;
763 bptr := bptr^.next;
764 end;
765 end;
768 {LOCAL}
769 procedure do_sarray_io (cinfo : j_common_ptr;
770 ptr : jvirt_sarray_ptr;
771 writing : boolean);
772 { Do backing store read or write of a virtual sample array }
773 var
774 bytesperrow, file_offset, byte_count, rows, thisrow, i : long;
775 begin
777 bytesperrow := long(ptr^.samplesperrow * SIZEOF(JSAMPLE));
778 file_offset := LongInt(ptr^.cur_start_row) * bytesperrow;
779 { Loop to read or write each allocation chunk in mem_buffer }
780 i := 0;
781 while i < long(ptr^.rows_in_mem) do
782 begin
784 { One chunk, but check for short chunk at end of buffer }
785 {rows := MIN(long(ptr^.rowsperchunk), long(ptr^.rows_in_mem - i));}
786 rows := long(ptr^.rowsperchunk);
787 if rows > long(ptr^.rows_in_mem) - i then
788 rows := long(ptr^.rows_in_mem) - i;
789 { Transfer no more than is currently defined }
790 thisrow := long (ptr^.cur_start_row) + i;
791 {rows := MIN(rows, long(ptr^.first_undef_row) - thisrow);}
792 if (rows > long(ptr^.first_undef_row) - thisrow) then
793 rows := long(ptr^.first_undef_row) - thisrow;
794 { Transfer no more than fits in file }
795 {rows := MIN(rows, long(ptr^.rows_in_array) - thisrow);}
796 if (rows > long(ptr^.rows_in_array) - thisrow) then
797 rows := long(ptr^.rows_in_array) - thisrow;
799 if (rows <= 0) then { this chunk might be past end of file! }
800 break;
801 byte_count := rows * bytesperrow;
802 if (writing) then
803 ptr^.b_s_info.write_backing_store (cinfo,
804 @ptr^.b_s_info,
805 pointer {FAR} (ptr^.mem_buffer^[i]),
806 file_offset, byte_count)
807 else
808 ptr^.b_s_info.read_backing_store (cinfo,
809 @ptr^.b_s_info,
810 pointer {FAR} (ptr^.mem_buffer^[i]),
811 file_offset, byte_count);
812 Inc(file_offset, byte_count);
813 Inc(i, ptr^.rowsperchunk);
814 end;
815 end;
818 {LOCAL}
819 procedure do_barray_io (cinfo : j_common_ptr;
820 ptr : jvirt_barray_ptr;
821 writing : boolean);
822 { Do backing store read or write of a virtual coefficient-block array }
823 var
824 bytesperrow, file_offset, byte_count, rows, thisrow, i : long;
825 begin
826 bytesperrow := long (ptr^.blocksperrow) * SIZEOF(JBLOCK);
827 file_offset := LongInt(ptr^.cur_start_row) * bytesperrow;
828 { Loop to read or write each allocation chunk in mem_buffer }
829 i := 0;
830 while (i < long(ptr^.rows_in_mem)) do
831 begin
832 { One chunk, but check for short chunk at end of buffer }
833 {rows := MIN(long(ptr^.rowsperchunk), long(ptr^.rows_in_mem - i));}
834 rows := long(ptr^.rowsperchunk);
835 if rows > long(ptr^.rows_in_mem) - i then
836 rows := long(ptr^.rows_in_mem) - i;
837 { Transfer no more than is currently defined }
838 thisrow := long (ptr^.cur_start_row) + i;
839 {rows := MIN(rows, long(ptr^.first_undef_row - thisrow));}
840 if rows > long(ptr^.first_undef_row) - thisrow then
841 rows := long(ptr^.first_undef_row) - thisrow;
842 { Transfer no more than fits in file }
843 {rows := MIN(rows, long (ptr^.rows_in_array - thisrow));}
844 if (rows > long (ptr^.rows_in_array) - thisrow) then
845 rows := long (ptr^.rows_in_array) - thisrow;
847 if (rows <= 0) then { this chunk might be past end of file! }
848 break;
849 byte_count := rows * bytesperrow;
850 if (writing) then
851 ptr^.b_s_info.write_backing_store (cinfo,
852 @ptr^.b_s_info,
853 {FAR} pointer(ptr^.mem_buffer^[i]),
854 file_offset, byte_count)
855 else
856 ptr^.b_s_info.read_backing_store (cinfo,
857 @ptr^.b_s_info,
858 {FAR} pointer(ptr^.mem_buffer^[i]),
859 file_offset, byte_count);
860 Inc(file_offset, byte_count);
861 Inc(i, ptr^.rowsperchunk);
862 end;
863 end;
866 {METHODDEF}
867 function access_virt_sarray (cinfo : j_common_ptr;
868 ptr : jvirt_sarray_ptr;
869 start_row : JDIMENSION;
870 num_rows : JDIMENSION;
871 writable : boolean ) : JSAMPARRAY;
872 { Access the part of a virtual sample array starting at start_row }
873 { and extending for num_rows rows. writable is true if }
874 { caller intends to modify the accessed area. }
875 var
876 end_row : JDIMENSION;
877 undef_row : JDIMENSION;
878 var
879 bytesperrow : size_t;
880 var
881 ltemp : long;
882 begin
883 end_row := start_row + num_rows;
884 { debugging check }
885 if (end_row > ptr^.rows_in_array) or (num_rows > ptr^.maxaccess) or
886 (ptr^.mem_buffer = NIL) then
887 ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS);
889 { Make the desired part of the virtual array accessible }
890 if (start_row < ptr^.cur_start_row) or
891 (end_row > ptr^.cur_start_row+ptr^.rows_in_mem) then
892 begin
893 if (not ptr^.b_s_open) then
894 ERREXIT(cinfo, JERR_VIRTUAL_BUG);
895 { Flush old buffer contents if necessary }
896 if (ptr^.dirty) then
897 begin
898 do_sarray_io(cinfo, ptr, TRUE);
899 ptr^.dirty := FALSE;
900 end;
901 { Decide what part of virtual array to access.
902 Algorithm: if target address > current window, assume forward scan,
903 load starting at target address. If target address < current window,
904 assume backward scan, load so that target area is top of window.
905 Note that when switching from forward write to forward read, will have
906 start_row := 0, so the limiting case applies and we load from 0 anyway. }
907 if (start_row > ptr^.cur_start_row) then
908 begin
909 ptr^.cur_start_row := start_row;
910 end
911 else
912 begin
913 { use long arithmetic here to avoid overflow & unsigned problems }
916 ltemp := long(end_row) - long(ptr^.rows_in_mem);
917 if (ltemp < 0) then
918 ltemp := 0; { don't fall off front end of file }
919 ptr^.cur_start_row := JDIMENSION(ltemp);
920 end;
921 { Read in the selected part of the array.
922 During the initial write pass, we will do no actual read
923 because the selected part is all undefined. }
925 do_sarray_io(cinfo, ptr, FALSE);
926 end;
927 { Ensure the accessed part of the array is defined; prezero if needed.
928 To improve locality of access, we only prezero the part of the array
929 that the caller is about to access, not the entire in-memory array. }
930 if (ptr^.first_undef_row < end_row) then
931 begin
932 if (ptr^.first_undef_row < start_row) then
933 begin
934 if (writable) then { writer skipped over a section of array }
935 ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS);
936 undef_row := start_row; { but reader is allowed to read ahead }
937 end
938 else
939 begin
940 undef_row := ptr^.first_undef_row;
941 end;
942 if (writable) then
943 ptr^.first_undef_row := end_row;
944 if (ptr^.pre_zero) then
945 begin
946 bytesperrow := size_t(ptr^.samplesperrow) * SIZEOF(JSAMPLE);
947 Dec(undef_row, ptr^.cur_start_row); { make indexes relative to buffer }
948 Dec(end_row, ptr^.cur_start_row);
949 while (undef_row < end_row) do
950 begin
951 jzero_far({FAR} pointer(ptr^.mem_buffer^[undef_row]), bytesperrow);
952 Inc(undef_row);
953 end;
954 end
955 else
956 begin
957 if (not writable) then { reader looking at undefined data }
958 ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS);
959 end;
960 end;
961 { Flag the buffer dirty if caller will write in it }
962 if (writable) then
963 ptr^.dirty := TRUE;
964 { Return address of proper part of the buffer }
965 access_virt_sarray := JSAMPARRAY(@ ptr^.mem_buffer^[start_row - ptr^.cur_start_row]);
966 end;
969 {METHODDEF}
970 function access_virt_barray (cinfo : j_common_ptr;
971 ptr : jvirt_barray_ptr;
972 start_row : JDIMENSION;
973 num_rows : JDIMENSION;
974 writable : boolean) : JBLOCKARRAY;
975 { Access the part of a virtual block array starting at start_row }
976 { and extending for num_rows rows. writable is true if }
977 { caller intends to modify the accessed area. }
978 var
979 end_row : JDIMENSION;
980 undef_row : JDIMENSION;
981 ltemp : long;
982 var
983 bytesperrow : size_t;
984 begin
985 end_row := start_row + num_rows;
987 { debugging check }
988 if (end_row > ptr^.rows_in_array) or (num_rows > ptr^.maxaccess) or
989 (ptr^.mem_buffer = NIL) then
990 ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS);
992 { Make the desired part of the virtual array accessible }
993 if (start_row < ptr^.cur_start_row) or
994 (end_row > ptr^.cur_start_row+ptr^.rows_in_mem) then
995 begin
996 if (not ptr^.b_s_open) then
997 ERREXIT(cinfo, JERR_VIRTUAL_BUG);
998 { Flush old buffer contents if necessary }
999 if (ptr^.dirty) then
1000 begin
1001 do_barray_io(cinfo, ptr, TRUE);
1002 ptr^.dirty := FALSE;
1003 end;
1004 { Decide what part of virtual array to access.
1005 Algorithm: if target address > current window, assume forward scan,
1006 load starting at target address. If target address < current window,
1007 assume backward scan, load so that target area is top of window.
1008 Note that when switching from forward write to forward read, will have
1009 start_row := 0, so the limiting case applies and we load from 0 anyway. }
1011 if (start_row > ptr^.cur_start_row) then
1012 begin
1013 ptr^.cur_start_row := start_row;
1014 end
1015 else
1016 begin
1017 { use long arithmetic here to avoid overflow & unsigned problems }
1019 ltemp := long(end_row) - long(ptr^.rows_in_mem);
1020 if (ltemp < 0) then
1021 ltemp := 0; { don't fall off front end of file }
1022 ptr^.cur_start_row := JDIMENSION (ltemp);
1023 end;
1024 { Read in the selected part of the array.
1025 During the initial write pass, we will do no actual read
1026 because the selected part is all undefined. }
1028 do_barray_io(cinfo, ptr, FALSE);
1029 end;
1030 { Ensure the accessed part of the array is defined; prezero if needed.
1031 To improve locality of access, we only prezero the part of the array
1032 that the caller is about to access, not the entire in-memory array. }
1034 if (ptr^.first_undef_row < end_row) then
1035 begin
1036 if (ptr^.first_undef_row < start_row) then
1037 begin
1038 if (writable) then { writer skipped over a section of array }
1039 ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS);
1040 undef_row := start_row; { but reader is allowed to read ahead }
1041 end
1042 else
1043 begin
1044 undef_row := ptr^.first_undef_row;
1045 end;
1046 if (writable) then
1047 ptr^.first_undef_row := end_row;
1048 if (ptr^.pre_zero) then
1049 begin
1050 bytesperrow := size_t (ptr^.blocksperrow) * SIZEOF(JBLOCK);
1051 Dec(undef_row, ptr^.cur_start_row); { make indexes relative to buffer }
1052 Dec(end_row, ptr^.cur_start_row);
1053 while (undef_row < end_row) do
1054 begin
1055 jzero_far({FAR}pointer(ptr^.mem_buffer^[undef_row]), bytesperrow);
1056 Inc(undef_row);
1057 end;
1058 end
1059 else
1060 begin
1061 if (not writable) then { reader looking at undefined data }
1062 ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS);
1063 end;
1064 end;
1065 { Flag the buffer dirty if caller will write in it }
1066 if (writable) then
1067 ptr^.dirty := TRUE;
1068 { Return address of proper part of the buffer }
1069 access_virt_barray := JBLOCKARRAY(@ ptr^.mem_buffer^[start_row - ptr^.cur_start_row]);
1070 end;
1073 { Release all objects belonging to a specified pool. }
1075 {METHODDEF}
1076 procedure free_pool (cinfo : j_common_ptr; pool_id : int);
1077 var
1078 mem : my_mem_ptr;
1079 shdr_ptr : small_pool_ptr;
1080 lhdr_ptr : large_pool_ptr;
1081 space_freed : size_t;
1082 var
1083 sptr : jvirt_sarray_ptr;
1084 bptr : jvirt_barray_ptr;
1085 var
1086 next_lhdr_ptr : large_pool_ptr;
1087 next_shdr_ptr : small_pool_ptr;
1088 begin
1089 mem := my_mem_ptr(cinfo^.mem);
1091 if (pool_id < 0) or (pool_id >= JPOOL_NUMPOOLS) then
1092 ERREXIT1(cinfo, JERR_BAD_POOL_ID, pool_id); { safety check }
1094 {$ifdef MEM_STATS}
1095 if (cinfo^.err^.trace_level > 1) then
1096 print_mem_stats(cinfo, pool_id); { print pool's memory usage statistics }
1097 {$endif}
1099 { If freeing IMAGE pool, close any virtual arrays first }
1100 if (pool_id = JPOOL_IMAGE) then
1101 begin
1102 sptr := mem^.virt_sarray_list;
1103 while (sptr <> NIL) do
1104 begin
1105 if (sptr^.b_s_open) then
1106 begin { there may be no backing store }
1107 sptr^.b_s_open := FALSE; { prevent recursive close if error }
1108 sptr^.b_s_info.close_backing_store (cinfo, @sptr^.b_s_info);
1109 end;
1110 sptr := sptr^.next;
1111 end;
1112 mem^.virt_sarray_list := NIL;
1113 bptr := mem^.virt_barray_list;
1114 while (bptr <> NIL) do
1115 begin
1116 if (bptr^.b_s_open) then
1117 begin { there may be no backing store }
1118 bptr^.b_s_open := FALSE; { prevent recursive close if error }
1119 bptr^.b_s_info.close_backing_store (cinfo, @bptr^.b_s_info);
1120 end;
1121 bptr := bptr^.next;
1122 end;
1123 mem^.virt_barray_list := NIL;
1124 end;
1126 { Release large objects }
1127 lhdr_ptr := mem^.large_list[pool_id];
1128 mem^.large_list[pool_id] := NIL;
1130 while (lhdr_ptr <> NIL) do
1131 begin
1132 next_lhdr_ptr := lhdr_ptr^.hdr.next;
1133 space_freed := lhdr_ptr^.hdr.bytes_used +
1134 lhdr_ptr^.hdr.bytes_left +
1135 SIZEOF(large_pool_hdr);
1136 jpeg_free_large(cinfo, {FAR} pointer(lhdr_ptr), space_freed);
1137 Dec(mem^.total_space_allocated, space_freed);
1138 lhdr_ptr := next_lhdr_ptr;
1139 end;
1141 { Release small objects }
1142 shdr_ptr := mem^.small_list[pool_id];
1143 mem^.small_list[pool_id] := NIL;
1145 while (shdr_ptr <> NIL) do
1146 begin
1147 next_shdr_ptr := shdr_ptr^.hdr.next;
1148 space_freed := shdr_ptr^.hdr.bytes_used +
1149 shdr_ptr^.hdr.bytes_left +
1150 SIZEOF(small_pool_hdr);
1151 jpeg_free_small(cinfo, pointer(shdr_ptr), space_freed);
1152 Dec(mem^.total_space_allocated, space_freed);
1153 shdr_ptr := next_shdr_ptr;
1154 end;
1155 end;
1158 { Close up shop entirely.
1159 Note that this cannot be called unless cinfo^.mem is non-NIL. }
1161 {METHODDEF}
1162 procedure self_destruct (cinfo : j_common_ptr);
1163 var
1164 pool : int;
1165 begin
1166 { Close all backing store, release all memory.
1167 Releasing pools in reverse order might help avoid fragmentation
1168 with some (brain-damaged) malloc libraries. }
1170 for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT do
1171 begin
1172 free_pool(cinfo, pool);
1173 end;
1175 { Release the memory manager control block too. }
1176 jpeg_free_small(cinfo, pointer(cinfo^.mem), SIZEOF(my_memory_mgr));
1177 cinfo^.mem := NIL; { ensures I will be called only once }
1179 jpeg_mem_term(cinfo); { system-dependent cleanup }
1180 end;
1183 { Memory manager initialization.
1184 When this is called, only the error manager pointer is valid in cinfo! }
1186 {GLOBAL}
1187 procedure jinit_memory_mgr (cinfo : j_common_ptr);
1188 var
1189 mem : my_mem_ptr;
1190 max_to_use : long;
1191 pool : int;
1192 test_mac : size_t;
1193 {$ifndef NO_GETENV}
1194 var
1195 memenv : string;
1196 code : integer;
1197 {$endif}
1198 begin
1199 cinfo^.mem := NIL; { for safety if init fails }
1201 { Check for configuration errors.
1202 SIZEOF(ALIGN_TYPE) should be a power of 2; otherwise, it probably
1203 doesn't reflect any real hardware alignment requirement.
1204 The test is a little tricky: for X>0, X and X-1 have no one-bits
1205 in common if and only if X is a power of 2, ie has only one one-bit.
1206 Some compilers may give an "unreachable code" warning here; ignore it. }
1207 if ((SIZEOF(ALIGN_TYPE) and (SIZEOF(ALIGN_TYPE)-1)) <> 0) then
1208 ERREXIT(cinfo, JERR_BAD_ALIGN_TYPE);
1209 { MAX_ALLOC_CHUNK must be representable as type size_t, and must be
1210 a multiple of SIZEOF(ALIGN_TYPE).
1211 Again, an "unreachable code" warning may be ignored here.
1212 But a "constant too large" warning means you need to fix MAX_ALLOC_CHUNK. }
1214 test_mac := size_t (MAX_ALLOC_CHUNK);
1215 if (long (test_mac) <> MAX_ALLOC_CHUNK) or
1216 ((MAX_ALLOC_CHUNK mod SIZEOF(ALIGN_TYPE)) <> 0) then
1217 ERREXIT(cinfo, JERR_BAD_ALLOC_CHUNK);
1219 max_to_use := jpeg_mem_init(cinfo); { system-dependent initialization }
1221 { Attempt to allocate memory manager's control block }
1222 mem := my_mem_ptr (jpeg_get_small(cinfo, SIZEOF(my_memory_mgr)));
1224 if (mem = NIL) then
1225 begin
1226 jpeg_mem_term(cinfo); { system-dependent cleanup }
1227 ERREXIT1(cinfo, JERR_OUT_OF_MEMORY, 0);
1228 end;
1230 { OK, fill in the method pointers }
1231 mem^.pub.alloc_small := alloc_small;
1232 mem^.pub.alloc_large := alloc_large;
1233 mem^.pub.alloc_sarray := alloc_sarray;
1234 mem^.pub.alloc_barray := alloc_barray;
1235 mem^.pub.request_virt_sarray := request_virt_sarray;
1236 mem^.pub.request_virt_barray := request_virt_barray;
1237 mem^.pub.realize_virt_arrays := realize_virt_arrays;
1238 mem^.pub.access_virt_sarray := access_virt_sarray;
1239 mem^.pub.access_virt_barray := access_virt_barray;
1240 mem^.pub.free_pool := free_pool;
1241 mem^.pub.self_destruct := self_destruct;
1243 { Make MAX_ALLOC_CHUNK accessible to other modules }
1244 mem^.pub.max_alloc_chunk := MAX_ALLOC_CHUNK;
1246 { Initialize working state }
1247 mem^.pub.max_memory_to_use := max_to_use;
1249 for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT do
1250 begin
1251 mem^.small_list[pool] := NIL;
1252 mem^.large_list[pool] := NIL;
1253 end;
1254 mem^.virt_sarray_list := NIL;
1255 mem^.virt_barray_list := NIL;
1257 mem^.total_space_allocated := SIZEOF(my_memory_mgr);
1259 { Declare ourselves open for business }
1260 cinfo^.mem := @mem^.pub;
1262 { Check for an environment variable JPEGMEM; if found, override the
1263 default max_memory setting from jpeg_mem_init. Note that the
1264 surrounding application may again override this value.
1265 If your system doesn't support getenv(), define NO_GETENV to disable
1266 this feature. }
1268 {$ifndef NO_GETENV}
1269 memenv := getenv('JPEGMEM');
1270 if (memenv <> '') then
1271 begin
1272 Val(memenv, max_to_use, code);
1273 if (Code = 0) then
1274 begin
1275 max_to_use := max_to_use * long(1000);
1276 mem^.pub.max_memory_to_use := max_to_use * long(1000);
1277 end;
1278 end;
1279 {$endif}
1281 end;
1283 end.