1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
|
Unit JcHuff;
{ This file contains Huffman entropy encoding routines.
Much of the complexity here has to do with supporting output suspension.
If the data destination module demands suspension, we want to be able to
back up to the start of the current MCU. To do this, we copy state
variables into local working storage, and update them back to the
permanent JPEG objects only upon successful completion of an MCU. }
{ Original: jchuff.c; Copyright (C) 1991-1997, Thomas G. Lane. }
interface
{$I jconfig.inc}
uses
jmorecfg, { longptr definition missing }
jpeglib,
jdeferr,
jerror,
jutils,
jinclude,
jcomapi;
{ The legal range of a DCT coefficient is
-1024 .. +1023 for 8-bit data;
-16384 .. +16383 for 12-bit data.
Hence the magnitude should always fit in 10 or 14 bits respectively. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
const
MAX_COEF_BITS = 10;
{$else}
const
MAX_COEF_BITS = 14;
{$endif}
{ Derived data constructed for each Huffman table }
{ Declarations shared with jcphuff.c }
type
c_derived_tbl_ptr = ^c_derived_tbl;
c_derived_tbl = record
ehufco : array[0..256-1] of uInt; { code for each symbol }
ehufsi : array[0..256-1] of byte; { length of code for each symbol }
{ If no code has been allocated for a symbol S, ehufsi[S] contains 0 }
end;
{ for JCHUFF und JCPHUFF }
type
TLongTable = array[0..256] of long;
TLongTablePtr = ^TLongTable;
{ Compute the derived values for a Huffman table.
Note this is also used by jcphuff.c. }
{GLOBAL}
procedure jpeg_make_c_derived_tbl (cinfo : j_compress_ptr;
isDC : boolean;
tblno : int;
var pdtbl : c_derived_tbl_ptr);
{ Generate the optimal coding for the given counts, fill htbl.
Note this is also used by jcphuff.c. }
{GLOBAL}
procedure jpeg_gen_optimal_table (cinfo : j_compress_ptr;
htbl : JHUFF_TBL_PTR;
var freq : TLongTable); { Nomssi }
{ Module initialization routine for Huffman entropy encoding. }
{GLOBAL}
procedure jinit_huff_encoder (cinfo : j_compress_ptr);
implementation
{ Expanded entropy encoder object for Huffman encoding.
The savable_state subrecord contains fields that change within an MCU,
but must not be updated permanently until we complete the MCU. }
type
savable_state = record
put_buffer : INT32; { current bit-accumulation buffer }
put_bits : int; { # of bits now in it }
last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int;
{ last DC coef for each component }
end;
type
huff_entropy_ptr = ^huff_entropy_encoder;
huff_entropy_encoder = record
pub : jpeg_entropy_encoder; { public fields }
saved : savable_state; { Bit buffer & DC state at start of MCU }
{ These fields are NOT loaded into local working state. }
restarts_to_go : uInt; { MCUs left in this restart interval }
next_restart_num : int; { next restart number to write (0-7) }
{ Pointers to derived tables (these workspaces have image lifespan) }
dc_derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr;
ac_derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr;
{$ifdef ENTROPY_OPT_SUPPORTED} { Statistics tables for optimization }
dc_count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr;
ac_count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr;
{$endif}
end;
{ Working state while writing an MCU.
This struct contains all the fields that are needed by subroutines. }
type
working_state = record
next_output_byte : JOCTETptr; { => next byte to write in buffer }
free_in_buffer : size_t; { # of byte spaces remaining in buffer }
cur : savable_state; { Current bit buffer & DC state }
cinfo : j_compress_ptr; { dump_buffer needs access to this }
end;
{ Forward declarations }
{METHODDEF}
function encode_mcu_huff (cinfo : j_compress_ptr;
const MCU_data : array of JBLOCKROW) : boolean; far;
forward;
{METHODDEF}
procedure finish_pass_huff (cinfo : j_compress_ptr); far; forward;
{$ifdef ENTROPY_OPT_SUPPORTED}
{METHODDEF}
function encode_mcu_gather (cinfo : j_compress_ptr;
const MCU_data: array of JBLOCKROW) : boolean;
far; forward;
{METHODDEF}
procedure finish_pass_gather (cinfo : j_compress_ptr); far; forward;
{$endif}
{ Initialize for a Huffman-compressed scan.
If gather_statistics is TRUE, we do not output anything during the scan,
just count the Huffman symbols used and generate Huffman code tables. }
{METHODDEF}
procedure start_pass_huff (cinfo : j_compress_ptr;
gather_statistics : boolean); far;
var
entropy : huff_entropy_ptr;
ci, dctbl, actbl : int;
compptr : jpeg_component_info_ptr;
begin
entropy := huff_entropy_ptr (cinfo^.entropy);
if (gather_statistics) then
begin
{$ifdef ENTROPY_OPT_SUPPORTED}
entropy^.pub.encode_mcu := encode_mcu_gather;
entropy^.pub.finish_pass := finish_pass_gather;
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif}
end
else
begin
entropy^.pub.encode_mcu := encode_mcu_huff;
entropy^.pub.finish_pass := finish_pass_huff;
end;
for ci := 0 to pred(cinfo^.comps_in_scan) do
begin
compptr := cinfo^.cur_comp_info[ci];
dctbl := compptr^.dc_tbl_no;
actbl := compptr^.ac_tbl_no;
if (gather_statistics) then
begin
{$ifdef ENTROPY_OPT_SUPPORTED}
{ Check for invalid table indexes }
{ (make_c_derived_tbl does this in the other path) }
if (dctbl < 0) or (dctbl >= NUM_HUFF_TBLS) then
ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, dctbl);
if (actbl < 0) or (actbl >= NUM_HUFF_TBLS) then
ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, actbl);
{ Allocate and zero the statistics tables }
{ Note that jpeg_gen_optimal_table expects 257 entries in each table! }
if (entropy^.dc_count_ptrs[dctbl] = NIL) then
entropy^.dc_count_ptrs[dctbl] := TLongTablePtr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
257 * SIZEOF(long)) );
MEMZERO(entropy^.dc_count_ptrs[dctbl], 257 * SIZEOF(long));
if (entropy^.ac_count_ptrs[actbl] = NIL) then
entropy^.ac_count_ptrs[actbl] := TLongTablePtr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
257 * SIZEOF(long)) );
MEMZERO(entropy^.ac_count_ptrs[actbl], 257 * SIZEOF(long));
{$endif}
end
else
begin
{ Compute derived values for Huffman tables }
{ We may do this more than once for a table, but it's not expensive }
jpeg_make_c_derived_tbl(cinfo, TRUE, dctbl,
entropy^.dc_derived_tbls[dctbl]);
jpeg_make_c_derived_tbl(cinfo, FALSE, actbl,
entropy^.ac_derived_tbls[actbl]);
end;
{ Initialize DC predictions to 0 }
entropy^.saved.last_dc_val[ci] := 0;
end;
{ Initialize bit buffer to empty }
entropy^.saved.put_buffer := 0;
entropy^.saved.put_bits := 0;
{ Initialize restart stuff }
entropy^.restarts_to_go := cinfo^.restart_interval;
entropy^.next_restart_num := 0;
end;
{ Compute the derived values for a Huffman table.
This routine also performs some validation checks on the table.
Note this is also used by jcphuff.c. }
{GLOBAL}
procedure jpeg_make_c_derived_tbl (cinfo : j_compress_ptr;
isDC : boolean;
tblno : int;
var pdtbl : c_derived_tbl_ptr);
var
htbl : JHUFF_TBL_PTR;
dtbl : c_derived_tbl_ptr;
p, i, l, lastp, si, maxsymbol : int;
huffsize : array[0..257-1] of byte;
huffcode : array[0..257-1] of uInt;
code : uInt;
begin
{ Note that huffsize[] and huffcode[] are filled in code-length order,
paralleling the order of the symbols themselves in htbl->huffval[]. }
{ Find the input Huffman table }
if (tblno < 0) or (tblno >= NUM_HUFF_TBLS) then
ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno);
if isDC then
htbl := cinfo^.dc_huff_tbl_ptrs[tblno]
else
htbl := cinfo^.ac_huff_tbl_ptrs[tblno];
if (htbl = NIL) then
ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno);
{ Allocate a workspace if we haven't already done so. }
if (pdtbl = NIL) then
pdtbl := c_derived_tbl_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(c_derived_tbl)) );
dtbl := pdtbl;
{ Figure C.1: make table of Huffman code length for each symbol }
p := 0;
for l := 1 to 16 do
begin
i := int(htbl^.bits[l]);
if (i < 0) and (p + i > 256) then { protect against table overrun }
ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE);
while (i > 0) do
begin
huffsize[p] := byte(l);
Inc(p);
Dec(i);
end;
end;
huffsize[p] := 0;
lastp := p;
{ Figure C.2: generate the codes themselves }
{ We also validate that the counts represent a legal Huffman code tree. }
code := 0;
si := huffsize[0];
p := 0;
while (huffsize[p] <> 0) do
begin
while (( int(huffsize[p]) ) = si) do
begin
huffcode[p] := code;
Inc(p);
Inc(code);
end;
{ code is now 1 more than the last code used for codelength si; but
it must still fit in si bits, since no code is allowed to be all ones. }
if (INT32(code) >= (INT32(1) shl si)) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE);
code := code shl 1;
Inc(si);
end;
{ Figure C.3: generate encoding tables }
{ These are code and size indexed by symbol value }
{ Set all codeless symbols to have code length 0;
this lets us detect duplicate VAL entries here, and later
allows emit_bits to detect any attempt to emit such symbols. }
MEMZERO(@dtbl^.ehufsi, SIZEOF(dtbl^.ehufsi));
{ This is also a convenient place to check for out-of-range
and duplicated VAL entries. We allow 0..255 for AC symbols
but only 0..15 for DC. (We could constrain them further
based on data depth and mode, but this seems enough.) }
if isDC then
maxsymbol := 15
else
maxsymbol := 255;
for p := 0 to pred(lastp) do
begin
i := htbl^.huffval[p];
if (i < 0) or (i > maxsymbol) or (dtbl^.ehufsi[i] <> 0) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE);
dtbl^.ehufco[i] := huffcode[p];
dtbl^.ehufsi[i] := huffsize[p];
end;
end;
{ Outputting bytes to the file }
{LOCAL}
function dump_buffer (var state : working_state) : boolean;
{ Empty the output buffer; return TRUE if successful, FALSE if must suspend }
var
dest : jpeg_destination_mgr_ptr;
begin
dest := state.cinfo^.dest;
if (not dest^.empty_output_buffer (state.cinfo)) then
begin
dump_buffer := FALSE;
exit;
end;
{ After a successful buffer dump, must reset buffer pointers }
state.next_output_byte := dest^.next_output_byte;
state.free_in_buffer := dest^.free_in_buffer;
dump_buffer := TRUE;
end;
{ Outputting bits to the file }
{ Only the right 24 bits of put_buffer are used; the valid bits are
left-justified in this part. At most 16 bits can be passed to emit_bits
in one call, and we never retain more than 7 bits in put_buffer
between calls, so 24 bits are sufficient. }
{LOCAL}
function emit_bits (var state : working_state;
code : uInt;
size : int) : boolean; {INLINE}
{ Emit some bits; return TRUE if successful, FALSE if must suspend }
var
{ This routine is heavily used, so it's worth coding tightly. }
{register} put_buffer : INT32;
{register} put_bits : int;
var
c : int;
begin
put_buffer := INT32 (code);
put_bits := state.cur.put_bits;
{ if size is 0, caller used an invalid Huffman table entry }
if (size = 0) then
ERREXIT(j_common_ptr(state.cinfo), JERR_HUFF_MISSING_CODE);
put_buffer := put_buffer and pred(INT32(1) shl size);
{ mask off any extra bits in code }
Inc(put_bits, size); { new number of bits in buffer }
put_buffer := put_buffer shl (24 - put_bits);
{ align incoming bits }
put_buffer := put_buffer or state.cur.put_buffer;
{ and merge with old buffer contents }
while (put_bits >= 8) do
begin
c := int ((put_buffer shr 16) and $FF);
{emit_byte(state, c, return FALSE);}
{ Emit a byte, return FALSE if must suspend. }
state.next_output_byte^ := JOCTET (c);
Inc(state.next_output_byte);
Dec(state.free_in_buffer);
if (state.free_in_buffer = 0) then
if not dump_buffer(state) then
begin
emit_bits := FALSE;
exit;
end;
if (c = $FF) then { need to stuff a zero byte? }
begin
{emit_byte(state, 0, return FALSE);}
state.next_output_byte^ := JOCTET (0);
Inc(state.next_output_byte);
Dec(state.free_in_buffer);
if (state.free_in_buffer = 0) then
if not dump_buffer(state) then
begin
emit_bits := FALSE;
exit;
end;
end;
put_buffer := put_buffer shl 8;
Dec(put_bits, 8);
end;
state.cur.put_buffer := put_buffer; { update state variables }
state.cur.put_bits := put_bits;
emit_bits := TRUE;
end;
{LOCAL}
function flush_bits (var state : working_state) : boolean;
begin
if (not emit_bits(state, $7F, 7)) then { fill any partial byte with ones }
begin
flush_bits := FALSE;
exit;
end;
state.cur.put_buffer := 0; { and reset bit-buffer to empty }
state.cur.put_bits := 0;
flush_bits := TRUE;
end;
{ Encode a single block's worth of coefficients }
{LOCAL}
function encode_one_block (var state : working_state;
const block : JBLOCK;
last_dc_val : int;
dctbl : c_derived_tbl_ptr;
actbl : c_derived_tbl_ptr) : boolean;
var
{register} temp, temp2 : int;
{register} nbits : int;
{register} k, r, i : int;
begin
{ Encode the DC coefficient difference per section F.1.2.1 }
temp2 := block[0] - last_dc_val;
temp := temp2;
if (temp < 0) then
begin
temp := -temp; { temp is abs value of input }
{ For a negative input, want temp2 := bitwise complement of abs(input) }
{ This code assumes we are on a two's complement machine }
Dec(temp2);
end;
{ Find the number of bits needed for the magnitude of the coefficient }
nbits := 0;
while (temp <> 0) do
begin
Inc(nbits);
temp := temp shr 1;
end;
{ Check for out-of-range coefficient values.
Since we're encoding a difference, the range limit is twice as much. }
if (nbits > MAX_COEF_BITS+1) then
ERREXIT(j_common_ptr(state.cinfo), JERR_BAD_DCT_COEF);
{ Emit the Huffman-coded symbol for the number of bits }
if not emit_bits(state, dctbl^.ehufco[nbits], dctbl^.ehufsi[nbits]) then
begin
encode_one_block := FALSE;
exit;
end;
{ Emit that number of bits of the value, if positive, }
{ or the complement of its magnitude, if negative. }
if (nbits <> 0) then { emit_bits rejects calls with size 0 }
if not emit_bits(state, uInt(temp2), nbits) then
begin
encode_one_block := FALSE;
exit;
end;
{ Encode the AC coefficients per section F.1.2.2 }
r := 0; { r := run length of zeros }
for k := 1 to pred(DCTSIZE2) do
begin
temp := block[jpeg_natural_order[k]];
if (temp = 0) then
begin
Inc(r);
end
else
begin
{ if run length > 15, must emit special run-length-16 codes ($F0) }
while (r > 15) do
begin
if not emit_bits(state, actbl^.ehufco[$F0], actbl^.ehufsi[$F0]) then
begin
encode_one_block := FALSE;
exit;
end;
Dec(r, 16);
end;
temp2 := temp;
if (temp < 0) then
begin
temp := -temp; { temp is abs value of input }
{ This code assumes we are on a two's complement machine }
Dec(temp2);
end;
{ Find the number of bits needed for the magnitude of the coefficient }
nbits := 0; { there must be at least one 1 bit }
repeat
Inc(nbits);
temp := temp shr 1;
until (temp = 0);
{ Check for out-of-range coefficient values }
if (nbits > MAX_COEF_BITS) then
ERREXIT(j_common_ptr(state.cinfo), JERR_BAD_DCT_COEF);
{ Emit Huffman symbol for run length / number of bits }
i := (r shl 4) + nbits;
if not emit_bits(state, actbl^.ehufco[i], actbl^.ehufsi[i]) then
begin
encode_one_block := FALSE;
exit;
end;
{ Emit that number of bits of the value, if positive, }
{ or the complement of its magnitude, if negative. }
if not emit_bits(state, uInt(temp2), nbits) then
begin
encode_one_block := FALSE;
exit;
end;
r := 0;
end;
end;
{ If the last coef(s) were zero, emit an end-of-block code }
if (r > 0) then
if not emit_bits(state, actbl^.ehufco[0], actbl^.ehufsi[0]) then
begin
encode_one_block := FALSE;
exit;
end;
encode_one_block := TRUE;
end;
{ Emit a restart marker & resynchronize predictions. }
{LOCAL}
function emit_restart (var state : working_state;
restart_num : int) : boolean;
var
ci : int;
begin
if (not flush_bits(state)) then
begin
emit_restart := FALSE;
exit;
end;
{emit_byte(state, $FF, return FALSE);}
{ Emit a byte, return FALSE if must suspend. }
state.next_output_byte^ := JOCTET ($FF);
Inc(state.next_output_byte);
Dec(state.free_in_buffer);
if (state.free_in_buffer = 0) then
if not dump_buffer(state) then
begin
emit_restart := FALSE;
exit;
end;
{emit_byte(state, JPEG_RST0 + restart_num, return FALSE);}
{ Emit a byte, return FALSE if must suspend. }
state.next_output_byte^ := JOCTET (JPEG_RST0 + restart_num);
Inc(state.next_output_byte);
Dec(state.free_in_buffer);
if (state.free_in_buffer = 0) then
if not dump_buffer(state) then
begin
emit_restart := FALSE;
exit;
end;
{ Re-initialize DC predictions to 0 }
for ci := 0 to pred(state.cinfo^.comps_in_scan) do
state.cur.last_dc_val[ci] := 0;
{ The restart counter is not updated until we successfully write the MCU. }
emit_restart := TRUE;
end;
{ Encode and output one MCU's worth of Huffman-compressed coefficients. }
{METHODDEF}
function encode_mcu_huff (cinfo : j_compress_ptr;
const MCU_data: array of JBLOCKROW) : boolean;
var
entropy : huff_entropy_ptr;
state : working_state;
blkn, ci : int;
compptr : jpeg_component_info_ptr;
begin
entropy := huff_entropy_ptr (cinfo^.entropy);
{ Load up working state }
state.next_output_byte := cinfo^.dest^.next_output_byte;
state.free_in_buffer := cinfo^.dest^.free_in_buffer;
{ASSIGN_STATE(state.cur, entropy^.saved);}
state.cur := entropy^.saved;
state.cinfo := cinfo;
{ Emit restart marker if needed }
if (cinfo^.restart_interval <> 0) then
begin
if (entropy^.restarts_to_go = 0) then
if not emit_restart(state, entropy^.next_restart_num) then
begin
encode_mcu_huff := FALSE;
exit;
end;
end;
{ Encode the MCU data blocks }
for blkn := 0 to pred(cinfo^.blocks_in_MCU) do
begin
ci := cinfo^.MCU_membership[blkn];
compptr := cinfo^.cur_comp_info[ci];
if not encode_one_block(state,
MCU_data[blkn]^[0],
state.cur.last_dc_val[ci],
entropy^.dc_derived_tbls[compptr^.dc_tbl_no],
entropy^.ac_derived_tbls[compptr^.ac_tbl_no]) then
begin
encode_mcu_huff := FALSE;
exit;
end;
{ Update last_dc_val }
state.cur.last_dc_val[ci] := MCU_data[blkn]^[0][0];
end;
{ Completed MCU, so update state }
cinfo^.dest^.next_output_byte := state.next_output_byte;
cinfo^.dest^.free_in_buffer := state.free_in_buffer;
{ASSIGN_STATE(entropy^.saved, state.cur);}
entropy^.saved := state.cur;
{ Update restart-interval state too }
if (cinfo^.restart_interval <> 0) then
begin
if (entropy^.restarts_to_go = 0) then
begin
entropy^.restarts_to_go := cinfo^.restart_interval;
Inc(entropy^.next_restart_num);
with entropy^ do
next_restart_num := next_restart_num and 7;
end;
Dec(entropy^.restarts_to_go);
end;
encode_mcu_huff := TRUE;
end;
{ Finish up at the end of a Huffman-compressed scan. }
{METHODDEF}
procedure finish_pass_huff (cinfo : j_compress_ptr);
var
entropy : huff_entropy_ptr;
state : working_state;
begin
entropy := huff_entropy_ptr (cinfo^.entropy);
{ Load up working state ... flush_bits needs it }
state.next_output_byte := cinfo^.dest^.next_output_byte;
state.free_in_buffer := cinfo^.dest^.free_in_buffer;
{ASSIGN_STATE(state.cur, entropy^.saved);}
state.cur := entropy^.saved;
state.cinfo := cinfo;
{ Flush out the last data }
if not flush_bits(state) then
ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);
{ Update state }
cinfo^.dest^.next_output_byte := state.next_output_byte;
cinfo^.dest^.free_in_buffer := state.free_in_buffer;
{ASSIGN_STATE(entropy^.saved, state.cur);}
entropy^.saved := state.cur;
end;
{ Huffman coding optimization.
We first scan the supplied data and count the number of uses of each symbol
that is to be Huffman-coded. (This process MUST agree with the code above.)
Then we build a Huffman coding tree for the observed counts.
Symbols which are not needed at all for the particular image are not
assigned any code, which saves space in the DHT marker as well as in
the compressed data. }
{$ifdef ENTROPY_OPT_SUPPORTED}
{ Process a single block's worth of coefficients }
{LOCAL}
procedure htest_one_block (cinfo : j_compress_ptr;
const block : JBLOCK;
last_dc_val : int;
dc_counts : TLongTablePtr;
ac_counts : TLongTablePtr);
var
{register} temp : int;
{register} nbits : int;
{register} k, r : int;
begin
{ Encode the DC coefficient difference per section F.1.2.1 }
temp := block[0] - last_dc_val;
if (temp < 0) then
temp := -temp;
{ Find the number of bits needed for the magnitude of the coefficient }
nbits := 0;
while (temp <> 0) do
begin
Inc(nbits);
temp := temp shr 1;
end;
{ Check for out-of-range coefficient values.
Since we're encoding a difference, the range limit is twice as much. }
if (nbits > MAX_COEF_BITS+1) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF);
{ Count the Huffman symbol for the number of bits }
Inc(dc_counts^[nbits]);
{ Encode the AC coefficients per section F.1.2.2 }
r := 0; { r := run length of zeros }
for k := 1 to pred(DCTSIZE2) do
begin
temp := block[jpeg_natural_order[k]];
if (temp = 0) then
begin
Inc(r);
end
else
begin
{ if run length > 15, must emit special run-length-16 codes ($F0) }
while (r > 15) do
begin
Inc(ac_counts^[$F0]);
Dec(r, 16);
end;
{ Find the number of bits needed for the magnitude of the coefficient }
if (temp < 0) then
temp := -temp;
{ Find the number of bits needed for the magnitude of the coefficient }
nbits := 0; { there must be at least one 1 bit }
repeat
Inc(nbits);
temp := temp shr 1;
until (temp = 0);
{ Count Huffman symbol for run length / number of bits }
Inc(ac_counts^[(r shl 4) + nbits]);
r := 0;
end;
end;
{ If the last coef(s) were zero, emit an end-of-block code }
if (r > 0) then
Inc(ac_counts^[0]);
end;
{ Trial-encode one MCU's worth of Huffman-compressed coefficients.
No data is actually output, so no suspension return is possible. }
{METHODDEF}
function encode_mcu_gather (cinfo : j_compress_ptr;
const MCU_data: array of JBLOCKROW) : boolean;
var
entropy : huff_entropy_ptr;
blkn, ci : int;
compptr : jpeg_component_info_ptr;
begin
entropy := huff_entropy_ptr (cinfo^.entropy);
{ Take care of restart intervals if needed }
if (cinfo^.restart_interval <> 0) then
begin
if (entropy^.restarts_to_go = 0) then
begin
{ Re-initialize DC predictions to 0 }
for ci := 0 to pred(cinfo^.comps_in_scan) do
entropy^.saved.last_dc_val[ci] := 0;
{ Update restart state }
entropy^.restarts_to_go := cinfo^.restart_interval;
end;
Dec(entropy^.restarts_to_go);
end;
for blkn := 0 to pred(cinfo^.blocks_in_MCU) do
begin
ci := cinfo^.MCU_membership[blkn];
compptr := cinfo^.cur_comp_info[ci];
htest_one_block(cinfo, MCU_data[blkn]^[0],
entropy^.saved.last_dc_val[ci],
entropy^.dc_count_ptrs[compptr^.dc_tbl_no],
entropy^.ac_count_ptrs[compptr^.ac_tbl_no]);
entropy^.saved.last_dc_val[ci] := MCU_data[blkn]^[0][0];
end;
encode_mcu_gather := TRUE;
end;
{ Generate the best Huffman code table for the given counts, fill htbl.
Note this is also used by jcphuff.c.
The JPEG standard requires that no symbol be assigned a codeword of all
one bits (so that padding bits added at the end of a compressed segment
can't look like a valid code). Because of the canonical ordering of
codewords, this just means that there must be an unused slot in the
longest codeword length category. Section K.2 of the JPEG spec suggests
reserving such a slot by pretending that symbol 256 is a valid symbol
with count 1. In theory that's not optimal; giving it count zero but
including it in the symbol set anyway should give a better Huffman code.
But the theoretically better code actually seems to come out worse in
practice, because it produces more all-ones bytes (which incur stuffed
zero bytes in the final file). In any case the difference is tiny.
The JPEG standard requires Huffman codes to be no more than 16 bits long.
If some symbols have a very small but nonzero probability, the Huffman tree
must be adjusted to meet the code length restriction. We currently use
the adjustment method suggested in JPEG section K.2. This method is *not*
optimal; it may not choose the best possible limited-length code. But
typically only very-low-frequency symbols will be given less-than-optimal
lengths, so the code is almost optimal. Experimental comparisons against
an optimal limited-length-code algorithm indicate that the difference is
microscopic --- usually less than a hundredth of a percent of total size.
So the extra complexity of an optimal algorithm doesn't seem worthwhile. }
{GLOBAL}
procedure jpeg_gen_optimal_table (cinfo : j_compress_ptr;
htbl : JHUFF_TBL_PTR;
var freq : TLongTable);
const
MAX_CLEN = 32; { assumed maximum initial code length }
var
bits : array[0..MAX_CLEN+1-1] of UINT8; { bits[k] := # of symbols with code length k }
codesize : array[0..257-1] of int; { codesize[k] := code length of symbol k }
others : array[0..257-1] of int; { next symbol in current branch of tree }
c1, c2 : int;
p, i, j : int;
v : long;
begin
{ This algorithm is explained in section K.2 of the JPEG standard }
MEMZERO(@bits, SIZEOF(bits));
MEMZERO(@codesize, SIZEOF(codesize));
for i := 0 to 256 do
others[i] := -1; { init links to empty }
freq[256] := 1; { make sure 256 has a nonzero count }
{ Including the pseudo-symbol 256 in the Huffman procedure guarantees
that no real symbol is given code-value of all ones, because 256
will be placed last in the largest codeword category. }
{ Huffman's basic algorithm to assign optimal code lengths to symbols }
while TRUE do
begin
{ Find the smallest nonzero frequency, set c1 := its symbol }
{ In case of ties, take the larger symbol number }
c1 := -1;
v := long(1000000000);
for i := 0 to 256 do
begin
if (freq[i] <> 0) and (freq[i] <= v) then
begin
v := freq[i];
c1 := i;
end;
end;
{ Find the next smallest nonzero frequency, set c2 := its symbol }
{ In case of ties, take the larger symbol number }
c2 := -1;
v := long(1000000000);
for i := 0 to 256 do
begin
if (freq[i] <> 0) and (freq[i] <= v) and (i <> c1) then
begin
v := freq[i];
c2 := i;
end;
end;
{ Done if we've merged everything into one frequency }
if (c2 < 0) then
break;
{ Else merge the two counts/trees }
Inc(freq[c1], freq[c2]);
freq[c2] := 0;
{ Increment the codesize of everything in c1's tree branch }
Inc(codesize[c1]);
while (others[c1] >= 0) do
begin
c1 := others[c1];
Inc(codesize[c1]);
end;
others[c1] := c2; { chain c2 onto c1's tree branch }
{ Increment the codesize of everything in c2's tree branch }
Inc(codesize[c2]);
while (others[c2] >= 0) do
begin
c2 := others[c2];
Inc(codesize[c2]);
end;
end;
{ Now count the number of symbols of each code length }
for i := 0 to 256 do
begin
if (codesize[i]<>0) then
begin
{ The JPEG standard seems to think that this can't happen, }
{ but I'm paranoid... }
if (codesize[i] > MAX_CLEN) then
ERREXIT(j_common_ptr(cinfo), JERR_HUFF_CLEN_OVERFLOW);
Inc(bits[codesize[i]]);
end;
end;
{ JPEG doesn't allow symbols with code lengths over 16 bits, so if the pure
Huffman procedure assigned any such lengths, we must adjust the coding.
Here is what the JPEG spec says about how this next bit works:
Since symbols are paired for the longest Huffman code, the symbols are
removed from this length category two at a time. The prefix for the pair
(which is one bit shorter) is allocated to one of the pair; then,
skipping the BITS entry for that prefix length, a code word from the next
shortest nonzero BITS entry is converted into a prefix for two code words
one bit longer. }
for i := MAX_CLEN downto 17 do
begin
while (bits[i] > 0) do
begin
j := i - 2; { find length of new prefix to be used }
while (bits[j] = 0) do
Dec(j);
Dec(bits[i], 2); { remove two symbols }
Inc(bits[i-1]); { one goes in this length }
Inc(bits[j+1], 2); { two new symbols in this length }
Dec(bits[j]); { symbol of this length is now a prefix }
end;
end;
{ Delphi 2: FOR-loop variable 'i' may be undefined after loop }
i := 16; { Nomssi: work around }
{ Remove the count for the pseudo-symbol 256 from the largest codelength }
while (bits[i] = 0) do { find largest codelength still in use }
Dec(i);
Dec(bits[i]);
{ Return final symbol counts (only for lengths 0..16) }
MEMCOPY(@htbl^.bits, @bits, SIZEOF(htbl^.bits));
{ Return a list of the symbols sorted by code length }
{ It's not real clear to me why we don't need to consider the codelength
changes made above, but the JPEG spec seems to think this works. }
p := 0;
for i := 1 to MAX_CLEN do
begin
for j := 0 to 255 do
begin
if (codesize[j] = i) then
begin
htbl^.huffval[p] := UINT8 (j);
Inc(p);
end;
end;
end;
{ Set sent_table FALSE so updated table will be written to JPEG file. }
htbl^.sent_table := FALSE;
end;
{ Finish up a statistics-gathering pass and create the new Huffman tables. }
{METHODDEF}
procedure finish_pass_gather (cinfo : j_compress_ptr);
var
entropy : huff_entropy_ptr;
ci, dctbl, actbl : int;
compptr : jpeg_component_info_ptr;
htblptr : ^JHUFF_TBL_PTR;
did_dc : array[0..NUM_HUFF_TBLS-1] of boolean;
did_ac : array[0..NUM_HUFF_TBLS-1] of boolean;
begin
entropy := huff_entropy_ptr (cinfo^.entropy);
{ It's important not to apply jpeg_gen_optimal_table more than once
per table, because it clobbers the input frequency counts! }
MEMZERO(@did_dc, SIZEOF(did_dc));
MEMZERO(@did_ac, SIZEOF(did_ac));
for ci := 0 to pred(cinfo^.comps_in_scan) do
begin
compptr := cinfo^.cur_comp_info[ci];
dctbl := compptr^.dc_tbl_no;
actbl := compptr^.ac_tbl_no;
if (not did_dc[dctbl]) then
begin
htblptr := @(cinfo^.dc_huff_tbl_ptrs[dctbl]);
if ( htblptr^ = NIL) then
htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo));
jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.dc_count_ptrs[dctbl]^);
did_dc[dctbl] := TRUE;
end;
if (not did_ac[actbl]) then
begin
htblptr := @(cinfo^.ac_huff_tbl_ptrs[actbl]);
if ( htblptr^ = NIL) then
htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo));
jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.ac_count_ptrs[actbl]^);
did_ac[actbl] := TRUE;
end;
end;
end;
{$endif} { ENTROPY_OPT_SUPPORTED }
{ Module initialization routine for Huffman entropy encoding. }
{GLOBAL}
procedure jinit_huff_encoder (cinfo : j_compress_ptr);
var
entropy : huff_entropy_ptr;
i : int;
begin
entropy := huff_entropy_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(huff_entropy_encoder)) );
cinfo^.entropy := jpeg_entropy_encoder_ptr (entropy);
entropy^.pub.start_pass := start_pass_huff;
{ Mark tables unallocated }
for i := 0 to pred(NUM_HUFF_TBLS) do
begin
entropy^.ac_derived_tbls[i] := NIL;
entropy^.dc_derived_tbls[i] := NIL;
{$ifdef ENTROPY_OPT_SUPPORTED}
entropy^.ac_count_ptrs[i] := NIL;
entropy^.dc_count_ptrs[i] := NIL;
{$endif}
end;
end;
end.
|