]> git.sesse.net Git - x264/blob - encoder/rdo.c
Fix two bugs in QPRD
[x264] / encoder / rdo.c
1 /*****************************************************************************
2  * rdo.c: h264 encoder library (rate-distortion optimization)
3  *****************************************************************************
4  * Copyright (C) 2005-2008 x264 project
5  *
6  * Authors: Loren Merritt <lorenm@u.washington.edu>
7  *          Fiona Glaser <fiona@x264.com>
8  *
9  * This program is free software; you can redistribute it and/or modify
10  * it under the terms of the GNU General Public License as published by
11  * the Free Software Foundation; either version 2 of the License, or
12  * (at your option) any later version.
13  *
14  * This program is distributed in the hope that it will be useful,
15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17  * GNU General Public License for more details.
18  *
19  * You should have received a copy of the GNU General Public License
20  * along with this program; if not, write to the Free Software
21  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02111, USA.
22  *****************************************************************************/
23
24 /* duplicate all the writer functions, just calculating bit cost
25  * instead of writing the bitstream.
26  * TODO: use these for fast 1st pass too. */
27
28 #define RDO_SKIP_BS 1
29
30 /* Transition and size tables for abs<9 MVD and residual coding */
31 /* Consist of i_prefix-2 1s, one zero, and a bypass sign bit */
32 static uint8_t cabac_transition_unary[15][128];
33 static uint16_t cabac_size_unary[15][128];
34 /* Transition and size tables for abs>9 MVD */
35 /* Consist of 5 1s and a bypass sign bit */
36 static uint8_t cabac_transition_5ones[128];
37 static uint16_t cabac_size_5ones[128];
38
39 /* CAVLC: produces exactly the same bit count as a normal encode */
40 /* this probably still leaves some unnecessary computations */
41 #define bs_write1(s,v)     ((s)->i_bits_encoded += 1)
42 #define bs_write(s,n,v)    ((s)->i_bits_encoded += (n))
43 #define bs_write_ue(s,v)   ((s)->i_bits_encoded += bs_size_ue(v))
44 #define bs_write_se(s,v)   ((s)->i_bits_encoded += bs_size_se(v))
45 #define bs_write_te(s,v,l) ((s)->i_bits_encoded += bs_size_te(v,l))
46 #define x264_macroblock_write_cavlc  static x264_macroblock_size_cavlc
47 #include "cavlc.c"
48
49 /* CABAC: not exactly the same. x264_cabac_size_decision() keeps track of
50  * fractional bits, but only finite precision. */
51 #undef  x264_cabac_encode_decision
52 #undef  x264_cabac_encode_decision_noup
53 #define x264_cabac_encode_decision(c,x,v) x264_cabac_size_decision(c,x,v)
54 #define x264_cabac_encode_decision_noup(c,x,v) x264_cabac_size_decision_noup(c,x,v)
55 #define x264_cabac_encode_terminal(c)     ((c)->f8_bits_encoded += 7)
56 #define x264_cabac_encode_bypass(c,v)     ((c)->f8_bits_encoded += 256)
57 #define x264_cabac_encode_ue_bypass(c,e,v) ((c)->f8_bits_encoded += (bs_size_ue_big(v+(1<<e)-1)-e)<<8)
58 #define x264_macroblock_write_cabac  static x264_macroblock_size_cabac
59 #include "cabac.c"
60
61 #define COPY_CABAC h->mc.memcpy_aligned( &cabac_tmp.f8_bits_encoded, &h->cabac.f8_bits_encoded, \
62         sizeof(x264_cabac_t) - offsetof(x264_cabac_t,f8_bits_encoded) )
63
64
65 /* Sum the cached SATDs to avoid repeating them. */
66 static inline int sum_satd( x264_t *h, int pixel, int x, int y )
67 {
68     int satd = 0;
69     int min_x = x>>2;
70     int min_y = y>>2;
71     int max_x = (x>>2) + (x264_pixel_size[pixel].w>>2);
72     int max_y = (y>>2) + (x264_pixel_size[pixel].h>>2);
73     if( pixel == PIXEL_16x16 )
74         return h->mb.pic.fenc_satd_sum;
75     for( y = min_y; y < max_y; y++ )
76         for( x = min_x; x < max_x; x++ )
77             satd += h->mb.pic.fenc_satd[y][x];
78     return satd;
79 }
80
81 static inline int sum_sa8d( x264_t *h, int pixel, int x, int y )
82 {
83     int sa8d = 0;
84     int min_x = x>>3;
85     int min_y = y>>3;
86     int max_x = (x>>3) + (x264_pixel_size[pixel].w>>3);
87     int max_y = (y>>3) + (x264_pixel_size[pixel].h>>3);
88     if( pixel == PIXEL_16x16 )
89         return h->mb.pic.fenc_sa8d_sum;
90     for( y = min_y; y < max_y; y++ )
91         for( x = min_x; x < max_x; x++ )
92             sa8d += h->mb.pic.fenc_sa8d[y][x];
93     return sa8d;
94 }
95
96 /* Psy RD distortion metric: SSD plus "Absolute Difference of Complexities" */
97 /* SATD and SA8D are used to measure block complexity. */
98 /* The difference between SATD and SA8D scores are both used to avoid bias from the DCT size.  Using SATD */
99 /* only, for example, results in overusage of 8x8dct, while the opposite occurs when using SA8D. */
100
101 /* FIXME:  Is there a better metric than averaged SATD/SA8D difference for complexity difference? */
102 /* Hadamard transform is recursive, so a SATD+SA8D can be done faster by taking advantage of this fact. */
103 /* This optimization can also be used in non-RD transform decision. */
104
105 static inline int ssd_plane( x264_t *h, int size, int p, int x, int y )
106 {
107     DECLARE_ALIGNED_16(static uint8_t zero[16]);
108     int satd = 0;
109     uint8_t *fdec = h->mb.pic.p_fdec[p] + x + y*FDEC_STRIDE;
110     uint8_t *fenc = h->mb.pic.p_fenc[p] + x + y*FENC_STRIDE;
111     if( p == 0 && h->mb.i_psy_rd )
112     {
113         /* If the plane is smaller than 8x8, we can't do an SA8D; this probably isn't a big problem. */
114         if( size <= PIXEL_8x8 )
115         {
116             uint64_t acs = h->pixf.hadamard_ac[size]( fdec, FDEC_STRIDE );
117             satd = abs((int32_t)acs - sum_satd( h, size, x, y ))
118                  + abs((int32_t)(acs>>32) - sum_sa8d( h, size, x, y ));
119             satd >>= 1;
120         }
121         else
122         {
123             int dc = h->pixf.sad[size]( fdec, FDEC_STRIDE, zero, 0 ) >> 1;
124             satd = abs(h->pixf.satd[size]( fdec, FDEC_STRIDE, zero, 0 ) - dc - sum_satd( h, size, x, y ));
125         }
126         satd = (satd * h->mb.i_psy_rd * h->mb.i_psy_rd_lambda + 128) >> 8;
127     }
128     return h->pixf.ssd[size](fenc, FENC_STRIDE, fdec, FDEC_STRIDE) + satd;
129 }
130
131 static inline int ssd_mb( x264_t *h )
132 {
133     int chromassd = ssd_plane(h, PIXEL_8x8, 1, 0, 0) + ssd_plane(h, PIXEL_8x8, 2, 0, 0);
134     chromassd = (chromassd * h->mb.i_chroma_lambda2_offset + 128) >> 8;
135     return ssd_plane(h, PIXEL_16x16, 0, 0, 0) + chromassd;
136 }
137
138 static int x264_rd_cost_mb( x264_t *h, int i_lambda2 )
139 {
140     int b_transform_bak = h->mb.b_transform_8x8;
141     int i_ssd;
142     int i_bits;
143
144     x264_macroblock_encode( h );
145
146     i_ssd = ssd_mb( h );
147
148     if( IS_SKIP( h->mb.i_type ) )
149     {
150         i_bits = (1 * i_lambda2 + 128) >> 8;
151     }
152     else if( h->param.b_cabac )
153     {
154         x264_cabac_t cabac_tmp;
155         COPY_CABAC;
156         x264_macroblock_size_cabac( h, &cabac_tmp );
157         i_bits = ( (uint64_t)cabac_tmp.f8_bits_encoded * i_lambda2 + 32768 ) >> 16;
158     }
159     else
160     {
161         bs_t bs_tmp = h->out.bs;
162         bs_tmp.i_bits_encoded = 0;
163         x264_macroblock_size_cavlc( h, &bs_tmp );
164         i_bits = ( bs_tmp.i_bits_encoded * i_lambda2 + 128 ) >> 8;
165     }
166
167     h->mb.b_transform_8x8 = b_transform_bak;
168
169     return i_ssd + i_bits;
170 }
171
172 /* partition RD functions use 8 bits more precision to avoid large rounding errors at low QPs */
173
174 static uint64_t x264_rd_cost_subpart( x264_t *h, int i_lambda2, int i4, int i_pixel )
175 {
176     uint64_t i_ssd, i_bits;
177
178     x264_macroblock_encode_p4x4( h, i4 );
179     if( i_pixel == PIXEL_8x4 )
180         x264_macroblock_encode_p4x4( h, i4+1 );
181     if( i_pixel == PIXEL_4x8 )
182         x264_macroblock_encode_p4x4( h, i4+2 );
183
184     i_ssd = ssd_plane( h, i_pixel, 0, block_idx_x[i4]*4, block_idx_y[i4]*4 );
185
186     if( h->param.b_cabac )
187     {
188         x264_cabac_t cabac_tmp;
189         COPY_CABAC;
190         x264_subpartition_size_cabac( h, &cabac_tmp, i4, i_pixel );
191         i_bits = ( (uint64_t)cabac_tmp.f8_bits_encoded * i_lambda2 + 128 ) >> 8;
192     }
193     else
194     {
195         i_bits = x264_subpartition_size_cavlc( h, i4, i_pixel );
196     }
197
198     return (i_ssd<<8) + i_bits;
199 }
200
201 uint64_t x264_rd_cost_part( x264_t *h, int i_lambda2, int i4, int i_pixel )
202 {
203     uint64_t i_ssd, i_bits;
204     int i8 = i4 >> 2;
205     int chromassd;
206
207     if( i_pixel == PIXEL_16x16 )
208     {
209         int type_bak = h->mb.i_type;
210         int i_cost = x264_rd_cost_mb( h, i_lambda2 );
211         h->mb.i_type = type_bak;
212         return i_cost;
213     }
214
215     if( i_pixel > PIXEL_8x8 )
216         return x264_rd_cost_subpart( h, i_lambda2, i4, i_pixel );
217
218     h->mb.i_cbp_luma = 0;
219
220     x264_macroblock_encode_p8x8( h, i8 );
221     if( i_pixel == PIXEL_16x8 )
222         x264_macroblock_encode_p8x8( h, i8+1 );
223     if( i_pixel == PIXEL_8x16 )
224         x264_macroblock_encode_p8x8( h, i8+2 );
225
226     chromassd = ssd_plane( h, i_pixel+3, 1, (i8&1)*4, (i8>>1)*4 )
227               + ssd_plane( h, i_pixel+3, 2, (i8&1)*4, (i8>>1)*4 );
228     chromassd = (chromassd * h->mb.i_chroma_lambda2_offset + 128) >> 8;
229     i_ssd = ssd_plane( h, i_pixel,   0, (i8&1)*8, (i8>>1)*8 ) + chromassd;
230
231     if( h->param.b_cabac )
232     {
233         x264_cabac_t cabac_tmp;
234         COPY_CABAC;
235         x264_partition_size_cabac( h, &cabac_tmp, i8, i_pixel );
236         i_bits = ( (uint64_t)cabac_tmp.f8_bits_encoded * i_lambda2 + 128 ) >> 8;
237     }
238     else
239     {
240         i_bits = x264_partition_size_cavlc( h, i8, i_pixel ) * i_lambda2;
241     }
242
243     return (i_ssd<<8) + i_bits;
244 }
245
246 static uint64_t x264_rd_cost_i8x8( x264_t *h, int i_lambda2, int i8, int i_mode )
247 {
248     uint64_t i_ssd, i_bits;
249     h->mb.i_cbp_luma &= ~(1<<i8);
250     h->mb.b_transform_8x8 = 1;
251
252     x264_mb_encode_i8x8( h, i8, h->mb.i_qp );
253     i_ssd = ssd_plane( h, PIXEL_8x8, 0, (i8&1)*8, (i8>>1)*8 );
254
255     if( h->param.b_cabac )
256     {
257         x264_cabac_t cabac_tmp;
258         COPY_CABAC;
259         x264_partition_i8x8_size_cabac( h, &cabac_tmp, i8, i_mode );
260         i_bits = ( (uint64_t)cabac_tmp.f8_bits_encoded * i_lambda2 + 128 ) >> 8;
261     }
262     else
263     {
264         i_bits = x264_partition_i8x8_size_cavlc( h, i8, i_mode ) * i_lambda2;
265     }
266
267     return (i_ssd<<8) + i_bits;
268 }
269
270 static uint64_t x264_rd_cost_i4x4( x264_t *h, int i_lambda2, int i4, int i_mode )
271 {
272     uint64_t i_ssd, i_bits;
273
274     x264_mb_encode_i4x4( h, i4, h->mb.i_qp );
275     i_ssd = ssd_plane( h, PIXEL_4x4, 0, block_idx_x[i4]*4, block_idx_y[i4]*4 );
276
277     if( h->param.b_cabac )
278     {
279         x264_cabac_t cabac_tmp;
280         COPY_CABAC;
281         x264_partition_i4x4_size_cabac( h, &cabac_tmp, i4, i_mode );
282         i_bits = ( (uint64_t)cabac_tmp.f8_bits_encoded * i_lambda2 + 128 ) >> 8;
283     }
284     else
285     {
286         i_bits = x264_partition_i4x4_size_cavlc( h, i4, i_mode ) * i_lambda2;
287     }
288
289     return (i_ssd<<8) + i_bits;
290 }
291
292 static uint64_t x264_rd_cost_i8x8_chroma( x264_t *h, int i_lambda2, int i_mode, int b_dct )
293 {
294     uint64_t i_ssd, i_bits;
295
296     if( b_dct )
297         x264_mb_encode_8x8_chroma( h, 0, h->mb.i_chroma_qp );
298     i_ssd = ssd_plane( h, PIXEL_8x8, 1, 0, 0 ) +
299             ssd_plane( h, PIXEL_8x8, 2, 0, 0 );
300
301     h->mb.i_chroma_pred_mode = i_mode;
302
303     if( h->param.b_cabac )
304     {
305         x264_cabac_t cabac_tmp;
306         COPY_CABAC;
307         x264_i8x8_chroma_size_cabac( h, &cabac_tmp );
308         i_bits = ( (uint64_t)cabac_tmp.f8_bits_encoded * i_lambda2 + 128 ) >> 8;
309     }
310     else
311     {
312         i_bits = x264_i8x8_chroma_size_cavlc( h ) * i_lambda2;
313     }
314
315     return (i_ssd<<8) + i_bits;
316 }
317 /****************************************************************************
318  * Trellis RD quantization
319  ****************************************************************************/
320
321 #define TRELLIS_SCORE_MAX ((uint64_t)1<<50)
322 #define CABAC_SIZE_BITS 8
323 #define SSD_WEIGHT_BITS 5
324 #define LAMBDA_BITS 4
325
326 /* precalculate the cost of coding various combinations of bits in a single context */
327 void x264_rdo_init( void )
328 {
329     int i_prefix, i_ctx, i;
330     for( i_prefix = 0; i_prefix < 15; i_prefix++ )
331     {
332         for( i_ctx = 0; i_ctx < 128; i_ctx++ )
333         {
334             int f8_bits = 0;
335             uint8_t ctx = i_ctx;
336
337             for( i = 1; i < i_prefix; i++ )
338                 f8_bits += x264_cabac_size_decision2( &ctx, 1 );
339             if( i_prefix > 0 && i_prefix < 14 )
340                 f8_bits += x264_cabac_size_decision2( &ctx, 0 );
341             f8_bits += 1 << CABAC_SIZE_BITS; //sign
342
343             cabac_size_unary[i_prefix][i_ctx] = f8_bits;
344             cabac_transition_unary[i_prefix][i_ctx] = ctx;
345         }
346     }
347     for( i_ctx = 0; i_ctx < 128; i_ctx++ )
348     {
349         int f8_bits = 0;
350         uint8_t ctx = i_ctx;
351
352         for( i = 0; i < 5; i++ )
353             f8_bits += x264_cabac_size_decision2( &ctx, 1 );
354         f8_bits += 1 << CABAC_SIZE_BITS; //sign
355
356         cabac_size_5ones[i_ctx] = f8_bits;
357         cabac_transition_5ones[i_ctx] = ctx;
358     }
359 }
360
361 typedef struct {
362     int64_t score;
363     int level_idx; // index into level_tree[]
364     uint8_t cabac_state[10]; //just the contexts relevant to coding abs_level_m1
365 } trellis_node_t;
366
367 // TODO:
368 // save cabac state between blocks?
369 // use trellis' RD score instead of x264_mb_decimate_score?
370 // code 8x8 sig/last flags forwards with deadzone and save the contexts at
371 //   each position?
372 // change weights when using CQMs?
373
374 // possible optimizations:
375 // make scores fit in 32bit
376 // save quantized coefs during rd, to avoid a duplicate trellis in the final encode
377 // if trellissing all MBRD modes, finish SSD calculation so we can skip all of
378 //   the normal dequant/idct/ssd/cabac
379
380 // the unquant_mf here is not the same as dequant_mf:
381 // in normal operation (dct->quant->dequant->idct) the dct and idct are not
382 // normalized. quant/dequant absorb those scaling factors.
383 // in this function, we just do (quant->unquant) and want the output to be
384 // comparable to the input. so unquant is the direct inverse of quant,
385 // and uses the dct scaling factors, not the idct ones.
386
387 static ALWAYS_INLINE int quant_trellis_cabac( x264_t *h, int16_t *dct,
388                                  const uint16_t *quant_mf, const int *unquant_mf,
389                                  const int *coef_weight, const uint8_t *zigzag,
390                                  int i_ctxBlockCat, int i_lambda2, int b_ac, int dc, int i_coefs, int idx )
391 {
392     int abs_coefs[64], signs[64];
393     trellis_node_t nodes[2][8];
394     trellis_node_t *nodes_cur = nodes[0];
395     trellis_node_t *nodes_prev = nodes[1];
396     trellis_node_t *bnode;
397     const int b_interlaced = h->mb.b_interlaced;
398     uint8_t *cabac_state_sig = &h->cabac.state[ significant_coeff_flag_offset[b_interlaced][i_ctxBlockCat] ];
399     uint8_t *cabac_state_last = &h->cabac.state[ last_coeff_flag_offset[b_interlaced][i_ctxBlockCat] ];
400     const int f = 1 << 15; // no deadzone
401     int i_last_nnz;
402     int i, j;
403
404     // (# of coefs) * (# of ctx) * (# of levels tried) = 1024
405     // we don't need to keep all of those: (# of coefs) * (# of ctx) would be enough,
406     // but it takes more time to remove dead states than you gain in reduced memory.
407     struct {
408         uint16_t abs_level;
409         uint16_t next;
410     } level_tree[64*8*2];
411     int i_levels_used = 1;
412
413     /* init coefs */
414     for( i = i_coefs-1; i >= b_ac; i-- )
415         if( (unsigned)(dct[zigzag[i]] * (dc?quant_mf[0]>>1:quant_mf[zigzag[i]]) + f-1) >= 2*f )
416             break;
417
418     if( i < b_ac )
419     {
420         /* We only need to memset an empty 4x4 block.  8x8 can be
421            implicitly emptied via zero nnz, as can dc. */
422         if( i_coefs == 16 && !dc )
423             memset( dct, 0, 16 * sizeof(int16_t) );
424         return 0;
425     }
426
427     i_last_nnz = i;
428
429     for( ; i >= b_ac; i-- )
430     {
431         int coef = dct[zigzag[i]];
432         abs_coefs[i] = abs(coef);
433         signs[i] = coef < 0 ? -1 : 1;
434     }
435
436     /* init trellis */
437     for( i = 1; i < 8; i++ )
438         nodes_cur[i].score = TRELLIS_SCORE_MAX;
439     nodes_cur[0].score = 0;
440     nodes_cur[0].level_idx = 0;
441     level_tree[0].abs_level = 0;
442     level_tree[0].next = 0;
443
444     // coefs are processed in reverse order, because that's how the abs value is coded.
445     // last_coef and significant_coef flags are normally coded in forward order, but
446     // we have to reverse them to match the levels.
447     // in 4x4 blocks, last_coef and significant_coef use a separate context for each
448     // position, so the order doesn't matter, and we don't even have to update their contexts.
449     // in 8x8 blocks, some positions share contexts, so we'll just have to hope that
450     // cabac isn't too sensitive.
451
452     memcpy( nodes_cur[0].cabac_state, &h->cabac.state[ coeff_abs_level_m1_offset[i_ctxBlockCat] ], 10 );
453
454     for( i = i_last_nnz; i >= b_ac; i-- )
455     {
456         int i_coef = abs_coefs[i];
457         int q = ( f + i_coef * (dc?quant_mf[0]>>1:quant_mf[zigzag[i]]) ) >> 16;
458         int abs_level;
459         int cost_sig[2], cost_last[2];
460         trellis_node_t n;
461
462         // skip 0s: this doesn't affect the output, but saves some unnecessary computation.
463         if( q == 0 )
464         {
465             // no need to calculate ssd of 0s: it's the same in all nodes.
466             // no need to modify level_tree for ctx=0: it starts with an infinite loop of 0s.
467             int sigindex = i_coefs == 64 ? significant_coeff_flag_offset_8x8[b_interlaced][i] : i;
468             const uint32_t cost_sig0 = x264_cabac_size_decision_noup2( &cabac_state_sig[sigindex], 0 )
469                                      * (uint64_t)i_lambda2 >> ( CABAC_SIZE_BITS - LAMBDA_BITS );
470             for( j = 1; j < 8; j++ )
471             {
472                 if( nodes_cur[j].score != TRELLIS_SCORE_MAX )
473                 {
474 #define SET_LEVEL(n,l) \
475                     level_tree[i_levels_used].abs_level = l; \
476                     level_tree[i_levels_used].next = n.level_idx; \
477                     n.level_idx = i_levels_used; \
478                     i_levels_used++;
479
480                     SET_LEVEL( nodes_cur[j], 0 );
481                     nodes_cur[j].score += cost_sig0;
482                 }
483             }
484             continue;
485         }
486
487         XCHG( trellis_node_t*, nodes_cur, nodes_prev );
488
489         for( j = 0; j < 8; j++ )
490             nodes_cur[j].score = TRELLIS_SCORE_MAX;
491
492         if( i < i_coefs-1 )
493         {
494             int sigindex = i_coefs == 64 ? significant_coeff_flag_offset_8x8[b_interlaced][i] : i;
495             int lastindex = i_coefs == 64 ? last_coeff_flag_offset_8x8[i] : i;
496             cost_sig[0] = x264_cabac_size_decision_noup2( &cabac_state_sig[sigindex], 0 );
497             cost_sig[1] = x264_cabac_size_decision_noup2( &cabac_state_sig[sigindex], 1 );
498             cost_last[0] = x264_cabac_size_decision_noup2( &cabac_state_last[lastindex], 0 );
499             cost_last[1] = x264_cabac_size_decision_noup2( &cabac_state_last[lastindex], 1 );
500         }
501         else
502         {
503             cost_sig[0] = cost_sig[1] = 0;
504             cost_last[0] = cost_last[1] = 0;
505         }
506
507         // there are a few cases where increasing the coeff magnitude helps,
508         // but it's only around .003 dB, and skipping them ~doubles the speed of trellis.
509         // could also try q-2: that sometimes helps, but also sometimes decimates blocks
510         // that are better left coded, especially at QP > 40.
511         for( abs_level = q; abs_level >= q-1; abs_level-- )
512         {
513             int unquant_abs_level = (((dc?unquant_mf[0]<<1:unquant_mf[zigzag[i]]) * abs_level + 128) >> 8);
514             int d = i_coef - unquant_abs_level;
515             int64_t ssd;
516             /* Psy trellis: bias in favor of higher AC coefficients in the reconstructed frame. */
517             if( h->mb.i_psy_trellis && i && !dc && i_ctxBlockCat != DCT_CHROMA_AC )
518             {
519                 int orig_coef = (i_coefs == 64) ? h->mb.pic.fenc_dct8[idx][i] : h->mb.pic.fenc_dct4[idx][i];
520                 int predicted_coef = orig_coef - i_coef * signs[i];
521                 int psy_value = h->mb.i_psy_trellis * abs(predicted_coef + unquant_abs_level * signs[i]);
522                 int psy_weight = (i_coefs == 64) ? x264_dct8_weight_tab[zigzag[i]] : x264_dct4_weight_tab[zigzag[i]];
523                 ssd = (int64_t)d*d * coef_weight[i] - psy_weight * psy_value;
524             }
525             else
526             /* FIXME: for i16x16 dc is this weight optimal? */
527                 ssd = (int64_t)d*d * (dc?256:coef_weight[i]);
528
529             for( j = 0; j < 8; j++ )
530             {
531                 int node_ctx = j;
532                 if( nodes_prev[j].score == TRELLIS_SCORE_MAX )
533                     continue;
534                 n = nodes_prev[j];
535
536                 /* code the proposed level, and count how much entropy it would take */
537                 if( abs_level || node_ctx )
538                 {
539                     unsigned f8_bits = cost_sig[ abs_level != 0 ];
540                     if( abs_level )
541                     {
542                         const int i_prefix = X264_MIN( abs_level - 1, 14 );
543                         f8_bits += cost_last[ node_ctx == 0 ];
544                         f8_bits += x264_cabac_size_decision2( &n.cabac_state[coeff_abs_level1_ctx[node_ctx]], i_prefix > 0 );
545                         if( i_prefix > 0 )
546                         {
547                             uint8_t *ctx = &n.cabac_state[coeff_abs_levelgt1_ctx[node_ctx]];
548                             f8_bits += cabac_size_unary[i_prefix][*ctx];
549                             *ctx = cabac_transition_unary[i_prefix][*ctx];
550                             if( abs_level >= 15 )
551                                 f8_bits += bs_size_ue_big( abs_level - 15 ) << CABAC_SIZE_BITS;
552                             node_ctx = coeff_abs_level_transition[1][node_ctx];
553                         }
554                         else
555                         {
556                             f8_bits += 1 << CABAC_SIZE_BITS;
557                             node_ctx = coeff_abs_level_transition[0][node_ctx];
558                         }
559                     }
560                     n.score += (uint64_t)f8_bits * i_lambda2 >> ( CABAC_SIZE_BITS - LAMBDA_BITS );
561                 }
562
563                 n.score += ssd;
564
565                 /* save the node if it's better than any existing node with the same cabac ctx */
566                 if( n.score < nodes_cur[node_ctx].score )
567                 {
568                     SET_LEVEL( n, abs_level );
569                     nodes_cur[node_ctx] = n;
570                 }
571             }
572         }
573     }
574
575     /* output levels from the best path through the trellis */
576     bnode = &nodes_cur[0];
577     for( j = 1; j < 8; j++ )
578         if( nodes_cur[j].score < bnode->score )
579             bnode = &nodes_cur[j];
580
581     if( bnode == &nodes_cur[0] )
582     {
583         if( i_coefs == 16 && !dc )
584             memset( dct, 0, 16 * sizeof(int16_t) );
585         return 0;
586     }
587
588     j = bnode->level_idx;
589     for( i = b_ac; j; i++ )
590     {
591         dct[zigzag[i]] = level_tree[j].abs_level * signs[i];
592         j = level_tree[j].next;
593     }
594     for( ; i < i_coefs; i++ )
595         dct[zigzag[i]] = 0;
596
597     return 1;
598 }
599
600 const static uint8_t x264_zigzag_scan2[4] = {0,1,2,3};
601
602 int x264_quant_dc_trellis( x264_t *h, int16_t *dct, int i_quant_cat,
603                             int i_qp, int i_ctxBlockCat, int b_intra, int b_chroma )
604 {
605     return quant_trellis_cabac( h, (int16_t*)dct,
606         h->quant4_mf[i_quant_cat][i_qp], h->unquant4_mf[i_quant_cat][i_qp],
607         NULL, i_ctxBlockCat==DCT_CHROMA_DC ? x264_zigzag_scan2 : x264_zigzag_scan4[h->mb.b_interlaced],
608         i_ctxBlockCat, h->mb.i_trellis_lambda2[b_chroma][b_intra], 0, 1, i_ctxBlockCat==DCT_CHROMA_DC ? 4 : 16, 0 );
609 }
610
611 int x264_quant_4x4_trellis( x264_t *h, int16_t dct[4][4], int i_quant_cat,
612                              int i_qp, int i_ctxBlockCat, int b_intra, int b_chroma, int idx )
613 {
614     int b_ac = (i_ctxBlockCat == DCT_LUMA_AC || i_ctxBlockCat == DCT_CHROMA_AC);
615     return quant_trellis_cabac( h, (int16_t*)dct,
616         h->quant4_mf[i_quant_cat][i_qp], h->unquant4_mf[i_quant_cat][i_qp],
617         x264_dct4_weight2_zigzag[h->mb.b_interlaced],
618         x264_zigzag_scan4[h->mb.b_interlaced],
619         i_ctxBlockCat, h->mb.i_trellis_lambda2[b_chroma][b_intra], b_ac, 0, 16, idx );
620 }
621
622 int x264_quant_8x8_trellis( x264_t *h, int16_t dct[8][8], int i_quant_cat,
623                              int i_qp, int b_intra, int idx )
624 {
625     return quant_trellis_cabac( h, (int16_t*)dct,
626         h->quant8_mf[i_quant_cat][i_qp], h->unquant8_mf[i_quant_cat][i_qp],
627         x264_dct8_weight2_zigzag[h->mb.b_interlaced],
628         x264_zigzag_scan8[h->mb.b_interlaced],
629         DCT_LUMA_8x8, h->mb.i_trellis_lambda2[0][b_intra], 0, 0, 64, idx );
630 }
631