/* ** FAAD2 - Freeware Advanced Audio (AAC) Decoder including SBR decoding ** Copyright (C) 2003-2004 M. Bakker, Ahead Software AG, http://www.nero.com ** ** This program is free software; you can redistribute it and/or modify ** it under the terms of the GNU General Public License as published by ** the Free Software Foundation; either version 2 of the License, or ** (at your option) any later version. ** ** This program is distributed in the hope that it will be useful, ** but WITHOUT ANY WARRANTY; without even the implied warranty of ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ** GNU General Public License for more details. ** ** You should have received a copy of the GNU General Public License ** along with this program; if not, write to the Free Software ** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ** ** Any non-GPL usage of this software or parts of this software is strictly ** forbidden. ** ** Commercial non-GPL licensing of this software is possible. ** For more info contact Ahead Software through Mpeg4AAClicense@nero.com. ** ** $Id$ **/ /* High Frequency generation */ #include "common.h" #include "structs.h" #ifdef SBR_DEC #include "sbr_syntax.h" #include "sbr_hfgen.h" #include "sbr_fbt.h" /* static function declarations */ #ifdef SBR_LOW_POWER static void calc_prediction_coef_lp(sbr_info *sbr, qmf_t Xlow[MAX_NTSRHFG][64], complex_t *alpha_0, complex_t *alpha_1, real_t *rxx); static void calc_aliasing_degree(sbr_info *sbr, real_t *rxx, real_t *deg); #else static void calc_prediction_coef(sbr_info *sbr, qmf_t Xlow[MAX_NTSRHFG][64], complex_t *alpha_0, complex_t *alpha_1, uint8_t k); #endif static void calc_chirp_factors(sbr_info *sbr, uint8_t ch); static void patch_construction(sbr_info *sbr); void hf_generation(sbr_info *sbr, qmf_t Xlow[MAX_NTSRHFG][64], qmf_t Xhigh[MAX_NTSRHFG][64] #ifdef SBR_LOW_POWER ,real_t *deg #endif ,uint8_t ch) { uint8_t l, i, x; complex_t alpha_0[64] MEM_ALIGN_ATTR; complex_t alpha_1[64] MEM_ALIGN_ATTR; #ifdef SBR_LOW_POWER real_t rxx[64]; #endif uint8_t offset = sbr->tHFAdj; uint8_t first = sbr->t_E[ch][0]; uint8_t last = sbr->t_E[ch][sbr->L_E[ch]]; calc_chirp_factors(sbr, ch); #ifdef SBR_LOW_POWER memset(deg, 0, 64*sizeof(real_t)); #endif if ((ch == 0) && (sbr->Reset)) patch_construction(sbr); /* calculate the prediction coefficients */ #ifdef SBR_LOW_POWER calc_prediction_coef_lp(sbr, Xlow, alpha_0, alpha_1, rxx); calc_aliasing_degree(sbr, rxx, deg); #endif /* actual HF generation */ for (i = 0; i < sbr->noPatches; i++) { for (x = 0; x < sbr->patchNoSubbands[i]; x++) { real_t a0_r, a0_i, a1_r, a1_i; real_t bw, bw2; uint8_t q, p, k, g; /* find the low and high band for patching */ k = sbr->kx + x; for (q = 0; q < i; q++) { k += sbr->patchNoSubbands[q]; } p = sbr->patchStartSubband[i] + x; #ifdef SBR_LOW_POWER if (x != 0 /*x < sbr->patchNoSubbands[i]-1*/) deg[k] = deg[p]; else deg[k] = 0; #endif g = sbr->table_map_k_to_g[k]; bw = sbr->bwArray[ch][g]; bw2 = MUL_C(bw, bw); /* do the patching */ /* with or without filtering */ if (bw2 > 0) { real_t temp1_r, temp2_r, temp3_r; #ifndef SBR_LOW_POWER real_t temp1_i, temp2_i, temp3_i; calc_prediction_coef(sbr, Xlow, alpha_0, alpha_1, p); #endif a0_r = MUL_C(RE(alpha_0[p]), bw); a1_r = MUL_C(RE(alpha_1[p]), bw2); #ifndef SBR_LOW_POWER a0_i = MUL_C(IM(alpha_0[p]), bw); a1_i = MUL_C(IM(alpha_1[p]), bw2); #endif temp2_r = QMF_RE(Xlow[first - 2 + offset][p]); temp3_r = QMF_RE(Xlow[first - 1 + offset][p]); #ifndef SBR_LOW_POWER temp2_i = QMF_IM(Xlow[first - 2 + offset][p]); temp3_i = QMF_IM(Xlow[first - 1 + offset][p]); #endif for (l = first; l < last; l++) { temp1_r = temp2_r; temp2_r = temp3_r; temp3_r = QMF_RE(Xlow[l + offset][p]); #ifndef SBR_LOW_POWER temp1_i = temp2_i; temp2_i = temp3_i; temp3_i = QMF_IM(Xlow[l + offset][p]); #endif #ifdef SBR_LOW_POWER QMF_RE(Xhigh[l + offset][k]) = temp3_r + (MUL_R(a0_r, temp2_r) + MUL_R(a1_r, temp1_r)); #else QMF_RE(Xhigh[l + offset][k]) = temp3_r + (MUL_R(a0_r, temp2_r) - MUL_R(a0_i, temp2_i) + MUL_R(a1_r, temp1_r) - MUL_R(a1_i, temp1_i)); QMF_IM(Xhigh[l + offset][k]) = temp3_i + (MUL_R(a0_i, temp2_r) + MUL_R(a0_r, temp2_i) + MUL_R(a1_i, temp1_r) + MUL_R(a1_r, temp1_i)); #endif } } else { for (l = first; l < last; l++) { QMF_RE(Xhigh[l + offset][k]) = QMF_RE(Xlow[l + offset][p]); #ifndef SBR_LOW_POWER QMF_IM(Xhigh[l + offset][k]) = QMF_IM(Xlow[l + offset][p]); #endif } } } } if (sbr->Reset) { limiter_frequency_table(sbr); } } typedef struct { complex_t r01; complex_t r02; complex_t r11; complex_t r12; complex_t r22; real_t det; } acorr_coef; /* Within auto_correlation(...) a pre-shift of >>ACDET_EXP is needed to avoid * overflow when multiply-adding the FRACT-variables -- FRACT part is 31 bits. * After the calculation has been finished the result 'ac->det' needs to be * post-shifted by <<(4*ACDET_EXP). This pre-/post-shifting is needed for * FIXED_POINT only. */ #ifdef FIXED_POINT #define ACDET_EXP 3 #define ACDET_PRE(A) (A)>>ACDET_EXP #define ACDET_POST(A) (A)<<(4*ACDET_EXP) #else #define ACDET_PRE(A) (A) #define ACDET_POST(A) (A) #endif #ifdef SBR_LOW_POWER static void auto_correlation(sbr_info *sbr, acorr_coef *ac, qmf_t buffer[MAX_NTSRHFG][64], uint8_t bd, uint8_t len) { real_t r01 = 0, r02 = 0, r11 = 0; real_t tmp1, tmp2; int8_t j; uint8_t offset = sbr->tHFAdj; const real_t rel = FRAC_CONST(0.999999); // 1 / (1 + 1e-6f); for (j = offset; j < len + offset; j++) { real_t buf_j = ACDET_PRE(QMF_RE(buffer[j ][bd])); real_t buf_j_1 = ACDET_PRE(QMF_RE(buffer[j-1][bd])); real_t buf_j_2 = ACDET_PRE(QMF_RE(buffer[j-2][bd])); r01 += MUL_F(buf_j , buf_j_1); r02 += MUL_F(buf_j , buf_j_2); r11 += MUL_F(buf_j_1, buf_j_1); } tmp1 = ACDET_PRE(QMF_RE(buffer[len+offset-1][bd])); tmp2 = ACDET_PRE(QMF_RE(buffer[ offset-1][bd])); RE(ac->r12) = r01 - MUL_F(tmp1, tmp1) + MUL_F(tmp2, tmp2); tmp1 = ACDET_PRE(QMF_RE(buffer[len+offset-2][bd])); tmp2 = ACDET_PRE(QMF_RE(buffer[ offset-2][bd])); RE(ac->r22) = r11 - MUL_F(tmp1, tmp1) + MUL_F(tmp2, tmp2); RE(ac->r01) = r01; RE(ac->r02) = r02; RE(ac->r11) = r11; ac->det = MUL_F(RE(ac->r11), RE(ac->r22)) - MUL_F(MUL_F(RE(ac->r12), RE(ac->r12)), rel); ac->det = ACDET_POST(ac->det); } #else static void auto_correlation(sbr_info *sbr, acorr_coef *ac, qmf_t buffer[MAX_NTSRHFG][64], uint8_t bd, uint8_t len) { real_t r01r = 0, r01i = 0, r02r = 0, r02i = 0, r11r = 0; real_t temp1_r, temp1_i, temp2_r, temp2_i, temp3_r, temp3_i; real_t temp4_r, temp4_i, temp5_r, temp5_i; int8_t j; uint8_t offset = sbr->tHFAdj; const real_t rel = FRAC_CONST(0.999999); // 1 / (1 + 1e-6f); temp2_r = ACDET_PRE(QMF_RE(buffer[offset-2][bd])); temp2_i = ACDET_PRE(QMF_IM(buffer[offset-2][bd])); temp3_r = ACDET_PRE(QMF_RE(buffer[offset-1][bd])); temp3_i = ACDET_PRE(QMF_IM(buffer[offset-1][bd])); // Save these because they are needed after loop temp4_r = temp2_r; temp4_i = temp2_i; temp5_r = temp3_r; temp5_i = temp3_i; for (j = offset; j < len + offset; j++) { temp1_r = temp2_r; temp1_i = temp2_i; temp2_r = temp3_r; temp2_i = temp3_i; temp3_r = ACDET_PRE(QMF_RE(buffer[j][bd])); temp3_i = ACDET_PRE(QMF_IM(buffer[j][bd])); r01r += MUL_F(temp3_r, temp2_r) + MUL_F(temp3_i, temp2_i); r01i += MUL_F(temp3_i, temp2_r) - MUL_F(temp3_r, temp2_i); r02r += MUL_F(temp3_r, temp1_r) + MUL_F(temp3_i, temp1_i); r02i += MUL_F(temp3_i, temp1_r) - MUL_F(temp3_r, temp1_i); r11r += MUL_F(temp2_r, temp2_r) + MUL_F(temp2_i, temp2_i); } RE(ac->r12) = r01r - (MUL_F(temp3_r, temp2_r) + MUL_F(temp3_i, temp2_i)) + (MUL_F(temp5_r, temp4_r) + MUL_F(temp5_i, temp4_i)); IM(ac->r12) = r01i - (MUL_F(temp3_i, temp2_r) - MUL_F(temp3_r, temp2_i)) + (MUL_F(temp5_i, temp4_r) - MUL_F(temp5_r, temp4_i)); RE(ac->r22) = r11r - (MUL_F(temp2_r, temp2_r) + MUL_F(temp2_i, temp2_i)) + (MUL_F(temp4_r, temp4_r) + MUL_F(temp4_i, temp4_i)); RE(ac->r01) = r01r; IM(ac->r01) = r01i; RE(ac->r02) = r02r; IM(ac->r02) = r02i; RE(ac->r11) = r11r; ac->det = MUL_F(RE(ac->r11), RE(ac->r22)) - MUL_F((MUL_F(RE(ac->r12), RE(ac->r12)) + MUL_F(IM(ac->r12), IM(ac->r12))), rel); ac->det = ACDET_POST(ac->det); } #endif /* calculate linear prediction coefficients using the covariance method */ #ifndef SBR_LOW_POWER static void calc_prediction_coef(sbr_info *sbr, qmf_t Xlow[MAX_NTSRHFG][64], complex_t *alpha_0, complex_t *alpha_1, uint8_t k) { real_t tmp, mul; acorr_coef ac; auto_correlation(sbr, &ac, Xlow, k, sbr->numTimeSlotsRate + 6); if (ac.det == 0) { RE(alpha_1[k]) = 0; IM(alpha_1[k]) = 0; } else { mul = DIV_R(REAL_CONST(1.0), ac.det); tmp = (MUL_R(RE(ac.r01), RE(ac.r12)) - MUL_R(IM(ac.r01), IM(ac.r12)) - MUL_R(RE(ac.r02), RE(ac.r11))); RE(alpha_1[k]) = MUL_R(tmp, mul); tmp = (MUL_R(IM(ac.r01), RE(ac.r12)) + MUL_R(RE(ac.r01), IM(ac.r12)) - MUL_R(IM(ac.r02), RE(ac.r11))); IM(alpha_1[k]) = MUL_R(tmp, mul); } if (RE(ac.r11) == 0) { RE(alpha_0[k]) = 0; IM(alpha_0[k]) = 0; } else { mul = DIV_R(REAL_CONST(1.0), RE(ac.r11)); tmp = -(RE(ac.r01) + MUL_R(RE(alpha_1[k]), RE(ac.r12)) + MUL_R(IM(alpha_1[k]), IM(ac.r12))); RE(alpha_0[k]) = MUL_R(tmp, mul); tmp = -(IM(ac.r01) + MUL_R(IM(alpha_1[k]), RE(ac.r12)) - MUL_R(RE(alpha_1[k]), IM(ac.r12))); IM(alpha_0[k]) = MUL_R(tmp, mul); } if ((MUL_R(RE(alpha_0[k]),RE(alpha_0[k])) + MUL_R(IM(alpha_0[k]),IM(alpha_0[k])) >= REAL_CONST(16)) || (MUL_R(RE(alpha_1[k]),RE(alpha_1[k])) + MUL_R(IM(alpha_1[k]),IM(alpha_1[k])) >= REAL_CONST(16))) { RE(alpha_0[k]) = 0; IM(alpha_0[k]) = 0; RE(alpha_1[k]) = 0; IM(alpha_1[k]) = 0; } } #else static void calc_prediction_coef_lp(sbr_info *sbr, qmf_t Xlow[MAX_NTSRHFG][64], complex_t *alpha_0, complex_t *alpha_1, real_t *rxx) { uint8_t k; real_t tmp, mul; acorr_coef ac; for (k = 1; k < sbr->f_master[0]; k++) { auto_correlation(sbr, &ac, Xlow, k, sbr->numTimeSlotsRate + 6); if (ac.det == 0) { RE(alpha_0[k]) = 0; RE(alpha_1[k]) = 0; } else { mul = DIV_R(REAL_CONST(1.0), ac.det); tmp = MUL_R(RE(ac.r01), RE(ac.r22)) - MUL_R(RE(ac.r12), RE(ac.r02)); RE(alpha_0[k]) = -MUL_R(tmp, mul); tmp = MUL_R(RE(ac.r01), RE(ac.r12)) - MUL_R(RE(ac.r02), RE(ac.r11)); RE(alpha_1[k]) = MUL_R(tmp, mul); } if ((RE(alpha_0[k]) >= REAL_CONST(4)) || (RE(alpha_1[k]) >= REAL_CONST(4))) { RE(alpha_0[k]) = REAL_CONST(0); RE(alpha_1[k]) = REAL_CONST(0); } /* reflection coefficient */ if (RE(ac.r11) == 0) { rxx[k] = COEF_CONST(0.0); } else { rxx[k] = DIV_C(RE(ac.r01), RE(ac.r11)); rxx[k] = -rxx[k]; if (rxx[k] > COEF_CONST( 1.0)) rxx[k] = COEF_CONST(1.0); if (rxx[k] < COEF_CONST(-1.0)) rxx[k] = COEF_CONST(-1.0); } } } static void calc_aliasing_degree(sbr_info *sbr, real_t *rxx, real_t *deg) { uint8_t k; rxx[0] = COEF_CONST(0.0); deg[1] = COEF_CONST(0.0); for (k = 2; k < sbr->k0; k++) { deg[k] = COEF_CONST(0.0); if ((k % 2 == 0) && (rxx[k] < COEF_CONST(0.0))) { if (rxx[k-1] < COEF_CONST(0.0)) { deg[k] = COEF_CONST(1.0); if (rxx[k-2] > COEF_CONST(0.0)) { deg[k-1] = COEF_CONST(1.0) - MUL_C(rxx[k-1], rxx[k-1]); } } else if (rxx[k-2] > COEF_CONST(0.0)) { deg[k] = COEF_CONST(1.0) - MUL_C(rxx[k-1], rxx[k-1]); } } if ((k % 2 == 1) && (rxx[k] > COEF_CONST(0.0))) { if (rxx[k-1] > COEF_CONST(0.0)) { deg[k] = COEF_CONST(1.0); if (rxx[k-2] < COEF_CONST(0.0)) { deg[k-1] = COEF_CONST(1.0) - MUL_C(rxx[k-1], rxx[k-1]); } } else if (rxx[k-2] < COEF_CONST(0.0)) { deg[k] = COEF_CONST(1.0) - MUL_C(rxx[k-1], rxx[k-1]); } } } } #endif /* FIXED POINT: bwArray = COEF */ static real_t mapNewBw(uint8_t invf_mode, uint8_t invf_mode_prev) { switch (invf_mode) { case 1: /* LOW */ if (invf_mode_prev == 0) /* NONE */ return COEF_CONST(0.6); else return COEF_CONST(0.75); case 2: /* MID */ return COEF_CONST(0.9); case 3: /* HIGH */ return COEF_CONST(0.98); default: /* NONE */ if (invf_mode_prev == 1) /* LOW */ return COEF_CONST(0.6); else return COEF_CONST(0.0); } } /* FIXED POINT: bwArray = COEF */ static void calc_chirp_factors(sbr_info *sbr, uint8_t ch) { uint8_t i; for (i = 0; i < sbr->N_Q; i++) { sbr->bwArray[ch][i] = mapNewBw(sbr->bs_invf_mode[ch][i], sbr->bs_invf_mode_prev[ch][i]); if (sbr->bwArray[ch][i] < sbr->bwArray_prev[ch][i]) sbr->bwArray[ch][i] = MUL_F(sbr->bwArray[ch][i], FRAC_CONST(0.75)) + MUL_F(sbr->bwArray_prev[ch][i], FRAC_CONST(0.25)); else sbr->bwArray[ch][i] = MUL_F(sbr->bwArray[ch][i], FRAC_CONST(0.90625)) + MUL_F(sbr->bwArray_prev[ch][i], FRAC_CONST(0.09375)); if (sbr->bwArray[ch][i] < COEF_CONST(0.015625)) sbr->bwArray[ch][i] = COEF_CONST(0.0); if (sbr->bwArray[ch][i] > COEF_CONST(0.99609375)) sbr->bwArray[ch][i] = COEF_CONST(0.99609375); sbr->bwArray_prev[ch][i] = sbr->bwArray[ch][i]; sbr->bs_invf_mode_prev[ch][i] = sbr->bs_invf_mode[ch][i]; } } static void patch_construction(sbr_info *sbr) { uint8_t i, k; uint8_t odd, sb; uint8_t msb = sbr->k0; uint8_t usb = sbr->kx; uint8_t goalSbTab[] = { 21, 23, 32, 43, 46, 64, 85, 93, 128, 0, 0, 0 }; /* (uint8_t)(2.048e6/sbr->sample_rate + 0.5); */ uint8_t goalSb = goalSbTab[get_sr_index(sbr->sample_rate)]; sbr->noPatches = 0; if (goalSb < (sbr->kx + sbr->M)) { for (i = 0, k = 0; sbr->f_master[i] < goalSb; i++) k = i+1; } else { k = sbr->N_master; } if (sbr->N_master == 0) { sbr->noPatches = 0; sbr->patchNoSubbands[0] = 0; sbr->patchStartSubband[0] = 0; return; } do { int8_t j = k + 1; do { j--; sb = sbr->f_master[j]; odd = (sb - 2 + sbr->k0) % 2; } while (sb > (sbr->k0 - 1 + msb - odd)); sbr->patchNoSubbands[sbr->noPatches] = max(sb - usb, 0); sbr->patchStartSubband[sbr->noPatches] = sbr->k0 - odd - sbr->patchNoSubbands[sbr->noPatches]; if (sbr->patchNoSubbands[sbr->noPatches] > 0) { usb = sb; msb = sb; sbr->noPatches++; } else { msb = sbr->kx; } if (sbr->f_master[k] - sb < 3) k = sbr->N_master; } while (sb != (sbr->kx + sbr->M)); if ((sbr->patchNoSubbands[sbr->noPatches-1] < 3) && (sbr->noPatches > 1)) { sbr->noPatches--; } sbr->noPatches = min(sbr->noPatches, 5); } #endif ef='#n418'>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 
/*
** $Id: lbaselib.c,v 1.191.1.6 2008/02/14 16:46:22 roberto Exp $
** Basic library
** See Copyright Notice in lua.h
*/



#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define lbaselib_c
#define LUA_LIB

#include "lua.h"

#include "lauxlib.h"
#include "lualib.h"




/*
** If your system does not support `stdout', you can just remove this function.
** If you need, you can define your own `print' function, following this
** model but changing `fputs' to put the strings at a proper place
** (a console window or a log file, for instance).
*/
#if 0
static int luaB_print (lua_State *L) {
  int n = lua_gettop(L);  /* number of arguments */
  int i;
  lua_getglobal(L, "tostring");
  for (i=1; i<=n; i++) {
    const char *s;
    lua_pushvalue(L, -1);  /* function to be called */
    lua_pushvalue(L, i);   /* value to print */
    lua_call(L, 1, 1);
    s = lua_tostring(L, -1);  /* get result */
    if (s == NULL)
      return luaL_error(L, LUA_QL("tostring") " must return a string to "
                           LUA_QL("print"));
    if (i>1) fputs("\t", stdout);
    fputs(s, stdout);
    lua_pop(L, 1);  /* pop result */
  }
  fputs("\n", stdout);
  return 0;
}
#endif


static int luaB_tonumber (lua_State *L) {
  int base = luaL_optint(L, 2, 10);
  if (base == 10) {  /* standard conversion */
    luaL_checkany(L, 1);
    if (lua_isnumber(L, 1)) {
      lua_pushnumber(L, lua_tonumber(L, 1));
      return 1;
    }
  }
  else {
    const char *s1 = luaL_checkstring(L, 1);
    char *s2;
    unsigned long n;
    luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
    n = strtoul(s1, &s2, base);
    if (s1 != s2) {  /* at least one valid digit? */
      while (isspace((unsigned char)(*s2))) s2++;  /* skip trailing spaces */
      if (*s2 == '\0') {  /* no invalid trailing characters? */
        lua_pushnumber(L, (lua_Number)n);
        return 1;
      }
    }
  }
  lua_pushnil(L);  /* else not a number */
  return 1;
}


static int luaB_error (lua_State *L) {
  int level = luaL_optint(L, 2, 1);
  lua_settop(L, 1);
  if (lua_isstring(L, 1) && level > 0) {  /* add extra information? */
    luaL_where(L, level);
    lua_pushvalue(L, 1);
    lua_concat(L, 2);
  }
  return lua_error(L);
}


static int luaB_getmetatable (lua_State *L) {
  luaL_checkany(L, 1);
  if (!lua_getmetatable(L, 1)) {
    lua_pushnil(L);
    return 1;  /* no metatable */
  }
  luaL_getmetafield(L, 1, "__metatable");
  return 1;  /* returns either __metatable field (if present) or metatable */
}


static int luaB_setmetatable (lua_State *L) {
  int t = lua_type(L, 2);
  luaL_checktype(L, 1, LUA_TTABLE);
  luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
                    "nil or table expected");
  if (luaL_getmetafield(L, 1, "__metatable"))
    luaL_error(L, "cannot change a protected metatable");
  lua_settop(L, 2);
  lua_setmetatable(L, 1);
  return 1;
}


static void getfunc (lua_State *L, int opt) {
  if (lua_isfunction(L, 1)) lua_pushvalue(L, 1);
  else {
    lua_Debug ar;
    int level = opt ? luaL_optint(L, 1, 1) : luaL_checkint(L, 1);
    luaL_argcheck(L, level >= 0, 1, "level must be non-negative");
    if (lua_getstack(L, level, &ar) == 0)
      luaL_argerror(L, 1, "invalid level");
    lua_getinfo(L, "f", &ar);
    if (lua_isnil(L, -1))
      luaL_error(L, "no function environment for tail call at level %d",
                    level);
  }
}


static int luaB_getfenv (lua_State *L) {
  getfunc(L, 1);
  if (lua_iscfunction(L, -1))  /* is a C function? */
    lua_pushvalue(L, LUA_GLOBALSINDEX);  /* return the thread's global env. */
  else
    lua_getfenv(L, -1);
  return 1;
}


static int luaB_setfenv (lua_State *L) {
  luaL_checktype(L, 2, LUA_TTABLE);
  getfunc(L, 0);
  lua_pushvalue(L, 2);
  if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) {
    /* change environment of current thread */
    lua_pushthread(L);
    lua_insert(L, -2);
    lua_setfenv(L, -2);
    return 0;
  }
  else if (lua_iscfunction(L, -2) || lua_setfenv(L, -2) == 0)
    luaL_error(L,
          LUA_QL("setfenv") " cannot change environment of given object");
  return 1;
}


static int luaB_rawequal (lua_State *L) {
  luaL_checkany(L, 1);
  luaL_checkany(L, 2);
  lua_pushboolean(L, lua_rawequal(L, 1, 2));
  return 1;
}


static int luaB_rawget (lua_State *L) {
  luaL_checktype(L, 1, LUA_TTABLE);
  luaL_checkany(L, 2);
  lua_settop(L, 2);
  lua_rawget(L, 1);
  return 1;
}

static int luaB_rawset (lua_State *L) {
  luaL_checktype(L, 1, LUA_TTABLE);
  luaL_checkany(L, 2);
  luaL_checkany(L, 3);
  lua_settop(L, 3);
  lua_rawset(L, 1);
  return 1;
}


static int luaB_gcinfo (lua_State *L) {
  lua_pushinteger(L, lua_getgccount(L));
  return 1;
}


static int luaB_collectgarbage (lua_State *L) {
  static const char *const opts[] = {"stop", "restart", "collect",
    "count", "step", "setpause", "setstepmul", NULL};
  static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
    LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL};
  int o = luaL_checkoption(L, 1, "collect", opts);
  int ex = luaL_optint(L, 2, 0);
  int res = lua_gc(L, optsnum[o], ex);
  switch (optsnum[o]) {
    case LUA_GCCOUNT: {
      int b = lua_gc(L, LUA_GCCOUNTB, 0);
      lua_pushnumber(L, res + ((lua_Number)b/1024));
      return 1;
    }
    case LUA_GCSTEP: {
      lua_pushboolean(L, res);
      return 1;
    }
    default: {
      lua_pushnumber(L, res);
      return 1;
    }
  }
}


static int luaB_type (lua_State *L) {
  luaL_checkany(L, 1);
  lua_pushstring(L, luaL_typename(L, 1));
  return 1;
}


static int luaB_next (lua_State *L) {
  luaL_checktype(L, 1, LUA_TTABLE);
  lua_settop(L, 2);  /* create a 2nd argument if there isn't one */
  if (lua_next(L, 1))
    return 2;
  else {
    lua_pushnil(L);
    return 1;
  }
}


static int luaB_pairs (lua_State *L) {
  luaL_checktype(L, 1, LUA_TTABLE);
  lua_pushvalue(L, lua_upvalueindex(1));  /* return generator, */
  lua_pushvalue(L, 1);  /* state, */
  lua_pushnil(L);  /* and initial value */
  return 3;
}


static int ipairsaux (lua_State *L) {
  int i = luaL_checkint(L, 2);
  luaL_checktype(L, 1, LUA_TTABLE);
  i++;  /* next value */
  lua_pushinteger(L, i);
  lua_rawgeti(L, 1, i);
  return (lua_isnil(L, -1)) ? 0 : 2;
}


static int luaB_ipairs (lua_State *L) {
  luaL_checktype(L, 1, LUA_TTABLE);
  lua_pushvalue(L, lua_upvalueindex(1));  /* return generator, */
  lua_pushvalue(L, 1);  /* state, */
  lua_pushinteger(L, 0);  /* and initial value */
  return 3;
}


static int load_aux (lua_State *L, int status) {
  if (status == 0)  /* OK? */
    return 1;
  else {
    lua_pushnil(L);
    lua_insert(L, -2);  /* put before error message */
    return 2;  /* return nil plus error message */
  }
}


static int luaB_loadstring (lua_State *L) {
  size_t l;
  const char *s = luaL_checklstring(L, 1, &l);
  const char *chunkname = luaL_optstring(L, 2, s);
  return load_aux(L, luaL_loadbuffer(L, s, l, chunkname));
}


static int luaB_loadfile (lua_State *L) {
  const char *fname = luaL_optstring(L, 1, NULL);
  return load_aux(L, luaL_loadfile(L, fname));
}


/*
** Reader for generic `load' function: `lua_load' uses the
** stack for internal stuff, so the reader cannot change the
** stack top. Instead, it keeps its resulting string in a
** reserved slot inside the stack.
*/
static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
  (void)ud;  /* to avoid warnings */
  luaL_checkstack(L, 2, "too many nested functions");
  lua_pushvalue(L, 1);  /* get function */
  lua_call(L, 0, 1);  /* call it */
  if (lua_isnil(L, -1)) {
    *size = 0;
    return NULL;
  }
  else if (lua_isstring(L, -1)) {
    lua_replace(L, 3);  /* save string in a reserved stack slot */
    return lua_tolstring(L, 3, size);
  }
  else luaL_error(L, "reader function must return a string");
  return NULL;  /* to avoid warnings */
}


static int luaB_load (lua_State *L) {
  int status;
  const char *cname = luaL_optstring(L, 2, "=(load)");
  luaL_checktype(L, 1, LUA_TFUNCTION);
  lua_settop(L, 3);  /* function, eventual name, plus one reserved slot */
  status = lua_load(L, generic_reader, NULL, cname);
  return load_aux(L, status);
}


static int luaB_dofile (lua_State *L) {
  const char *fname = luaL_optstring(L, 1, NULL);
  int n = lua_gettop(L);
  if (luaL_loadfile(L, fname) != 0) lua_error(L);
  lua_call(L, 0, LUA_MULTRET);
  return lua_gettop(L) - n;
}


static int luaB_assert (lua_State *L) {
  luaL_checkany(L, 1);
  if (!lua_toboolean(L, 1))
    return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!"));
  return lua_gettop(L);
}


static int luaB_unpack (lua_State *L) {
  int i, e, n;
  luaL_checktype(L, 1, LUA_TTABLE);
  i = luaL_optint(L, 2, 1);
  e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1));
  if (i > e) return 0;  /* empty range */
  n = e - i + 1;  /* number of elements */
  if (n <= 0 || !lua_checkstack(L, n))  /* n <= 0 means arith. overflow */
    return luaL_error(L, "too many results to unpack");
  lua_rawgeti(L, 1, i);  /* push arg[i] (avoiding overflow problems) */
  while (i++ < e)  /* push arg[i + 1...e] */
    lua_rawgeti(L, 1, i);
  return n;
}


static int luaB_select (lua_State *L) {
  int n = lua_gettop(L);
  if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
    lua_pushinteger(L, n-1);
    return 1;
  }
  else {
    int i = luaL_checkint(L, 1);
    if (i < 0) i = n + i;
    else if (i > n) i = n;
    luaL_argcheck(L, 1 <= i, 1, "index out of range");
    return n - i;
  }
}


static int luaB_pcall (lua_State *L) {
  int status;
  luaL_checkany(L, 1);
  status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0);
  lua_pushboolean(L, (status == 0));
  lua_insert(L, 1);
  return lua_gettop(L);  /* return status + all results */
}


static int luaB_xpcall (lua_State *L) {
  int status;
  luaL_checkany(L, 2);
  lua_settop(L, 2);
  lua_insert(L, 1);  /* put error function under function to be called */
  status = lua_pcall(L, 0, LUA_MULTRET, 1);
  lua_pushboolean(L, (status == 0));
  lua_replace(L, 1);
  return lua_gettop(L);  /* return status + all results */
}


static int luaB_tostring (lua_State *L) {
  luaL_checkany(L, 1);
  if (luaL_callmeta(L, 1, "__tostring"))  /* is there a metafield? */
    return 1;  /* use its value */
  switch (lua_type(L, 1)) {
    case LUA_TNUMBER:
      lua_pushstring(L, lua_tostring(L, 1));
      break;
    case LUA_TSTRING:
      lua_pushvalue(L, 1);
      break;
    case LUA_TBOOLEAN:
      lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false"));
      break;
    case LUA_TNIL:
      lua_pushliteral(L, "nil");
      break;
    default:
      lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1));
      break;
  }
  return 1;
}


static int luaB_newproxy (lua_State *L) {
  lua_settop(L, 1);
  lua_newuserdata(L, 0);  /* create proxy */
  if (lua_toboolean(L, 1) == 0)
    return 1;  /* no metatable */
  else if (lua_isboolean(L, 1)) {
    lua_newtable(L);  /* create a new metatable `m' ... */
    lua_pushvalue(L, -1);  /* ... and mark `m' as a valid metatable */
    lua_pushboolean(L, 1);
    lua_rawset(L, lua_upvalueindex(1));  /* weaktable[m] = true */
  }
  else {
    int validproxy = 0;  /* to check if weaktable[metatable(u)] == true */
    if (lua_getmetatable(L, 1)) {
      lua_rawget(L, lua_upvalueindex(1));
      validproxy = lua_toboolean(L, -1);
      lua_pop(L, 1);  /* remove value */
    }
    luaL_argcheck(L, validproxy, 1, "boolean or proxy expected");
    lua_getmetatable(L, 1);  /* metatable is valid; get it */
  }
  lua_setmetatable(L, 2);
  return 1;
}


static const luaL_Reg base_funcs[] = {
  {"assert", luaB_assert},
  {"collectgarbage", luaB_collectgarbage},
  {"dofile", luaB_dofile},
  {"error", luaB_error},
  {"gcinfo", luaB_gcinfo},
  {"getfenv", luaB_getfenv},
  {"getmetatable", luaB_getmetatable},
  {"loadfile", luaB_loadfile},
  {"load", luaB_load},
  {"loadstring", luaB_loadstring},
  {"next", luaB_next},
  {"pcall", luaB_pcall},
#if 0
  {"print", luaB_print},
#endif
  {"rawequal", luaB_rawequal},
  {"rawget", luaB_rawget},
  {"rawset", luaB_rawset},
  {"select", luaB_select},
  {"setfenv", luaB_setfenv},
  {"setmetatable", luaB_setmetatable},
  {"tonumber", luaB_tonumber},
  {"tostring", luaB_tostring},
  {"type", luaB_type},
  {"unpack", luaB_unpack},
  {"xpcall", luaB_xpcall},
  {NULL, NULL}
};


/*
** {======================================================
** Coroutine library
** =======================================================
*/

#define CO_RUN	0	/* running */
#define CO_SUS	1	/* suspended */
#define CO_NOR	2	/* 'normal' (it resumed another coroutine) */
#define CO_DEAD	3

static const char *const statnames[] =
    {"running", "suspended", "normal", "dead"};

static int costatus (lua_State *L, lua_State *co) {
  if (L == co) return CO_RUN;
  switch (lua_status(co)) {
    case LUA_YIELD:
      return CO_SUS;
    case 0: {
      lua_Debug ar;
      if (lua_getstack(co, 0, &ar) > 0)  /* does it have frames? */
        return CO_NOR;  /* it is running */
      else if (lua_gettop(co) == 0)
          return CO_DEAD;
      else
        return CO_SUS;  /* initial state */
    }
    default:  /* some error occured */
      return CO_DEAD;
  }
}


static int luaB_costatus (lua_State *L) {
  lua_State *co = lua_tothread(L, 1);
  luaL_argcheck(L, co, 1, "coroutine expected");
  lua_pushstring(L, statnames[costatus(L, co)]);
  return 1;
}


static int auxresume (lua_State *L, lua_State *co, int narg) {
  int status = costatus(L, co);
  if (!lua_checkstack(co, narg))
    luaL_error(L, "too many arguments to resume");
  if (status != CO_SUS) {
    lua_pushfstring(L, "cannot resume %s coroutine", statnames[status]);
    return -1;  /* error flag */
  }
  lua_xmove(L, co, narg);
  lua_setlevel(L, co);
  status = lua_resume(co, narg);
  if (status == 0 || status == LUA_YIELD) {
    int nres = lua_gettop(co);
    if (!lua_checkstack(L, nres + 1))
      luaL_error(L, "too many results to resume");
    lua_xmove(co, L, nres);  /* move yielded values */
    return nres;
  }
  else {
    lua_xmove(co, L, 1);  /* move error message */
    return -1;  /* error flag */
  }
}