自学教程：C++ xlgafixnum函数代码示例

LVAL xseispackch(V){  int nm, n, matz, ierr;  LVAL ar, ai, w, zr, zi, fv1, fv2, fm1;  double *dar, *dai, *dw, *dzr, *dzi, *dfv1, *dfv2, *dfm1;  nm = getfixnum(xlgafixnum());  n = getfixnum(xlgafixnum());  ar = xlgetarg();  ai = xlgetarg();  w = xlgetarg();  matz = getfixnum(xlgafixnum());  zr = xlgetarg();  zi = xlgetarg();  fv1 = xlgetarg();  fv2 = xlgetarg();  fm1 = xlgetarg();  xllastarg();    checkldim(nm, n);  dar = getlinalgdvec(0, nm * n, ar);  dai = getlinalgdvec(0, nm * n, ai);  dw = getlinalgdvec(0, n, w);  dzr = (matz != 0) ? getlinalgdvec(0, nm * n, zr) : NULL;  dzi = (matz != 0) ? getlinalgdvec(0, nm * n, zi) : NULL;  dfv1 = getlinalgdvec(0, n, fv1);  dfv2 = getlinalgdvec(0, n, fv2);  dfm1 = getlinalgdvec(0, 2 * n, fm1);  eispack_ch(nm, n, dar, dai, dw, matz, dzr, dzi, dfv1, dfv2, dfm1, &ierr);  return (ierr == 0) ? NIL : cvfixnum((FIXTYPE) ierr);}

LVAL xsbasekernelsmooth(V){  LVAL x, y, xs, ys, targ;  int n, ns, error, ktype;  double *dx, *dy, *dxs, *dys, width;  n = getfixnum(xlgafixnum());  x = xlgetarg();  y = xlgetarg();  ns = getfixnum(xlgafixnum());  xs = xlgetarg();  ys = xlgetarg();  width = makefloat(xlgetarg());  targ = xlgasymbol();  xllastarg();  dx = getlinalgdvec(0, n, x);  dy = null(y) ? NULL : getlinalgdvec(0, n, y);  dxs = getlinalgdvec(0, ns, xs);  dys = getlinalgdvec(0, ns, ys);  switch (getstring(getpname(targ))[0]) {  case 'U': ktype = 'U'; break;  case 'T': ktype = 'T'; break;  case 'G': ktype = 'G'; break;  default:  ktype = 'B'; break;  }  error = kernel_smooth(dx, dy, n, width, NULL, NULL, dxs, dys, ns, ktype);  return error ? s_true : NIL;}

LVAL xseispackrs(V){  int nm, n, matz, ierr;  LVAL a, w, z, fv1, fv2;  double *da, *dw, *dz, *dfv1, *dfv2;  nm = getfixnum(xlgafixnum());  n = getfixnum(xlgafixnum());  a = xlgetarg();  w = xlgetarg();  matz = getfixnum(xlgafixnum());  z = xlgetarg();  fv1 = xlgetarg();  fv2 = xlgetarg();  xllastarg();    checkldim(nm, n);  da = getlinalgdvec(0, nm * n, a);  dw = getlinalgdvec(0, n, w);  dz = (matz != 0) ? getlinalgdvec(0, nm * n, z) : NULL;  dfv1 = getlinalgdvec(0, n, fv1);  dfv2 = getlinalgdvec(0, n, fv2);    eispack_rs(nm, n, da, dw, matz, dz, dfv1, dfv2, &ierr);  return (ierr == 0) ? NIL : cvfixnum((FIXTYPE) ierr);}

LVAL xslpzgedi(V){  LVAL a, ipvt, det, work;  dcomplex *da, *ddet, *dwork;  int lda, offa, n, *dipvt, job, i, ilda;  a = xlgetarg();  offa = getfixnum(xlgafixnum());  lda = getfixnum(xlgafixnum());  n = getfixnum(xlgafixnum());  ipvt = xlgetarg();  det = xlgetarg();  work = xlgetarg();  job = getfixnum(xlgafixnum());  xllastarg();  checkldim(lda, n);  da = getlinalgzvec(offa, lda * n, a);  dipvt = getlinalgivec(0, n, ipvt);  ddet = (job / 10 != 0) ? getlinalgzvec(0, 2, det) : NULL;  dwork = getlinalgzvec(0, n, work);  if (job % 10 != 0)    for (i = 0, ilda = 0; i < n; i++, ilda += lda)      if (da[ilda + i].r == 0.0 && da[ilda + i].i == 0.0)	xlfail("matrix is (numerically) singular");  linpack_zgedi(da, lda, n, dipvt, ddet, dwork, job);  return NIL;}

LVAL xslpzgesl(V){  LVAL a, ipvt, b;  dcomplex *da, *db;  int lda, offa, n, *dipvt, job, i, ilda;  a = xlgetarg();  offa = getfixnum(xlgafixnum());  lda = getfixnum(xlgafixnum());  n = getfixnum(xlgafixnum());  ipvt = xlgetarg();  b = xlgetarg();  job = getfixnum(xlgafixnum());  xllastarg();  checkldim(lda, n);  da = getlinalgzvec(offa, lda * n, a);  dipvt = getlinalgivec(0, n, ipvt);  db = getlinalgzvec(0, n, b);  for (i = 0, ilda = 0; i < n; i++, ilda += lda)    if (da[ilda + i].r == 0.0 && da[ilda + i].i == 0.0)      xlfail("matrix is (numerically) singular");  linpack_zgesl(da, lda, n, dipvt, db, job);  return NIL;}

LVAL xlc_snd_save(void){    LVAL arg1 = xlgetarg();    long arg2 = getfixnum(xlgafixnum());    unsigned char * arg3 = getstring(xlgastring());    long arg4 = getfixnum(xlgafixnum());    long arg5 = getfixnum(xlgafixnum());    long arg6 = getfixnum(xlgafixnum());    long arg7 = getfixnum(xlgafixnum());    double arg8 = 0.0;    long arg9 = 0;    double arg10 = 0.0;    LVAL arg11 = xlgetarg();    double result;    xllastarg();    result = sound_save(arg1, arg2, arg3, arg4, arg5, arg6, arg7, &arg8, &arg9, &arg10, arg11);    {	LVAL *next = &getvalue(RSLT_sym);	*next = cons(NIL, NIL);	car(*next) = cvflonum(arg8);	next = &cdr(*next);	*next = cons(NIL, NIL);	car(*next) = cvfixnum(arg9);	next = &cdr(*next);	*next = cons(NIL, NIL);	car(*next) = cvflonum(arg10);    }    return cvflonum(result);}

LVAL xsbaselowess(V) {  LVAL x, y, ys, rw, res;  double *dx, *dy, *dys, *drw, *dres;  int n, nsteps, error;  double f, delta;  x = xlgetarg();  y = xlgetarg();  n = getfixnum(xlgafixnum());  f = makefloat(xlgetarg());  nsteps = getfixnum(xlgafixnum());  delta = makefloat(xlgetarg());  ys = xlgetarg();  rw = xlgetarg();  res = xlgetarg();  xllastarg();  dx = getlinalgdvec(0, n, x);  dy = getlinalgdvec(0, n, y);   dys = getlinalgdvec(0, n, ys);  drw = getlinalgdvec(0, n, rw);  dres = getlinalgdvec(0, n, res);  error = lowess(dx, dy, n, f, nsteps, delta, dys, drw, dres);  return error ? s_true : NIL;}

LVAL iview_hist_mark_points_in_rect(V){  int  i, n, in_rect;  PointState point_state;  IVIEW_WINDOW w;  int left, top, width, height;  LVAL object, hdata;    gethistargs(&w, &object, &hdata);  left = getfixnum(xlgafixnum());  top = getfixnum(xlgafixnum());  width = getfixnum(xlgafixnum());  height = getfixnum(xlgafixnum());  if (IVIEW_WINDOW_NULL(w)) return(NIL);    n = IViewNumPoints(w);  for (i = 0; i < n; i++) {    point_state = IViewPointState(w, i);    if (! IViewPointMasked(w, i) && point_state != pointInvisible) {      in_rect = sect_point_rect(hdata, i, left, top, width, height);      IViewSetPointMark(w, i, in_rect);    }  }  return(NIL);}

LVAL xsbasespline(V){  LVAL x, y, xs, ys, work;  double *dx, *dy, *dxs, *dys, *dwork;  int n, ns, error;  n = getfixnum(xlgafixnum());  x = xlgetarg();  y = xlgetarg();  ns = getfixnum(xlgafixnum());  xs = xlgetarg();  ys = xlgetarg();  work = xlgetarg();  xllastarg();  dx = getlinalgdvec(0, n, x);  dy = getlinalgdvec(0, n, y);  dxs = getlinalgdvec(0, ns, xs);  dys = getlinalgdvec(0, ns, ys);  dwork = getlinalgdvec(0, 2 * n, work);  error = fit_spline(n, dx, dy, ns, dxs, dys, dwork);  return error ? s_true : NIL;}

/* SHLIB-INIT funtab &optional (version -1) (oldest version) */LVAL xshlibinit(){  LVAL subr, val, sym;  xlshlib_modinfo_t *info = getnpaddr(xlganatptr());  FUNDEF *p = info->funs;  FIXCONSTDEF *pfix = info->fixconsts;  FLOCONSTDEF *pflo = info->floconsts;  STRCONSTDEF *pstr = info->strconsts;  struct version_info defversion;  defversion.current = moreargs()?getfixnum(xlgafixnum()):-1;  defversion.oldest = moreargs()?getfixnum(xlgafixnum()):defversion.current;  xllastarg();  if (! check_version(&defsysversion, &(info->sysversion)))    xlfail("shared library not compatible with current system");  if (defversion.current >= 0 &&      ! check_version(&defversion, &(info->modversion)))    xlfail("module not compatible with requested version");  xlsave1(val);  val = NIL;  if (p != NULL)    for (val = NIL; (p->fd_subr) != (LVAL(*)(void)) NULL; p++) {      subr = cvsubr(p->fd_subr, p->fd_type & TYPEFIELD, 0);      setmulvalp(subr, (p->fd_type & (TYPEFIELD + 1)) ? TRUE : FALSE);      val = cons(subr, val);      if (p->fd_name != NULL) {        sym = xlenter(p->fd_name);        setfunction(sym, subr);      }    }  if (pfix != NULL)    for (; pfix->name != NULL; pfix++) {      sym = xlenter(pfix->name);      defconstant(sym, cvfixnum(pfix->val));    }  if (pflo != NULL)    for (; pflo->name != NULL; pflo++) {      sym = xlenter(pflo->name);      defconstant(sym, cvflonum(pflo->val));    }  if (pstr != NULL)    for (; pstr->name != NULL; pstr++) {      sym = xlenter(pstr->name);      defconstant(sym, cvstring(pstr->val));    }  if (info->sysversion.current >= MAKEVERSION(0,1)) {    ULONGCONSTDEF *pulong = info->ulongconsts;    if (pulong != NULL)      for (; pulong->name != NULL; pulong++) {        sym = xlenter(pulong->name);        defconstant(sym, ulong2lisp(pulong->val));      }  }  xlpop();  return xlnreverse(val);}

LVAL xlc_snd_fetch_array(void){    sound_type arg1 = getsound(xlgasound());    long arg2 = getfixnum(xlgafixnum());    long arg3 = getfixnum(xlgafixnum());    LVAL result;    xllastarg();    result = snd_fetch_array(arg1, arg2, arg3);    return (result);}

LVAL xlc_snd_avg(void){    sound_type arg1 = getsound(xlgasound());    long arg2 = getfixnum(xlgafixnum());    long arg3 = getfixnum(xlgafixnum());    long arg4 = getfixnum(xlgafixnum());    sound_type result;    xllastarg();    result = snd_avg(arg1, arg2, arg3, arg4);    return cvsound(result);}

LVAL xlc_snd_fft(void){    sound_type arg1 = getsound(xlgasound());    long arg2 = getfixnum(xlgafixnum());    long arg3 = getfixnum(xlgafixnum());    LVAL arg4 = xlgetarg();    LVAL result;    xllastarg();    result = snd_fft(arg1, arg2, arg3, arg4);    return (result);}

LVAL xlc_seq_insert_macctrl(void){    seq_type arg1 = getseq(xlgaseq());    long arg2 = getfixnum(xlgafixnum());    long arg3 = getfixnum(xlgafixnum());    long arg4 = getfixnum(xlgafixnum());    long arg5 = getfixnum(xlgafixnum());    long arg6 = getfixnum(xlgafixnum());    xllastarg();    insert_macctrl(arg1, arg2, arg3, arg4, arg5, arg6);    return NIL;}

LVAL xssweepinplace(V){  int rows, cols, k;  double *a, tol;  rows = getfixnum(xlgafixnum());  cols = getfixnum(xlgafixnum());  getsweepdata(rows * cols, &a);  k = getfixnum(xlgafixnum());  tol = makefloat(xlgetarg());  return sweepinplace(rows, cols, a, k, tol) ? s_true : NIL;}

LVAL xlc_snd_phasevocoder(void){    sound_type arg1 = getsound(xlgasound());    sound_type arg2 = getsound(xlgasound());    long arg3 = getfixnum(xlgafixnum());    long arg4 = getfixnum(xlgafixnum());    long arg5 = getfixnum(xlgafixnum());    sound_type result;    xllastarg();    result = snd_phasevocoder(arg1, arg2, arg3, arg4, arg5);    return cvsound(result);}

LVAL xsgen2linalg(V){  LVAL x, type;  int m, n, trans;  x = xlgetarg();  m = getfixnum(xlgafixnum());  n = getfixnum(xlgafixnum());  type = xlgetarg();  trans = moreargs() ? ! null(xlgetarg()) : FALSE;  xllastarg();  return gen2linalg(x, m, n, type, trans);}

LVAL iview_std_mark_points_in_rect(V){  IVIEW_WINDOW w;  int left, top, width, height;  w = (IVIEW_WINDOW) get_iview_address(xlgaobject());  left = getfixnum(xlgafixnum());  top = getfixnum(xlgafixnum());  width = getfixnum(xlgafixnum());  height = getfixnum(xlgafixnum());  xllastarg();    IViewStdMarkPointsInRect(w, left, top, width, height);  return(NIL);}

LVAL xstransposeinto(V){  LVAL x, y;  int m, n;  x = xlgetarg();  m = getfixnum(xlgafixnum());  n = getfixnum(xlgafixnum());  y = xlgetarg();  xllastarg();  transposeinto(x, m, n, y);  return y;}

/* xmkstrinput - make a string input stream */LVAL xmkstrinput(void){    int start,end,len,i;    unsigned char *str;    LVAL string,val;    /* protect the return value */    xlsave1(val);        /* get the string and length */    string = xlgastring();    str = getstring(string);    len = getslength(string) - 1;    /* get the starting offset */    if (moreargs()) {        val = xlgafixnum();        start = (int)getfixnum(val);    }    else start = 0;    /* get the ending offset */    if (moreargs()) {        val = xlgafixnum();        end = (int)getfixnum(val);    }    else end = len;    xllastarg();    /* check the bounds */    if (start < 0 || start > len)        xlerror("string index out of bounds",cvfixnum((FIXTYPE)start));    if (end < 0 || end > len)        xlerror("string index out of bounds",cvfixnum((FIXTYPE)end));    /* make the stream */    val = newustream();    /* copy the substring into the stream */    for (i = start; i < end; ++i)        xlputc(val,str[i]);    /* restore the stack */    xlpop();    /* return the new stream */    return (val);}

/* xpoke - poke a value into memory */LVAL xpoke(void){    LVAL val;    int *adr;    /* get the address and the new value */    val = xlgafixnum(); adr = (int *)getfixnum(val);    val = xlgafixnum();    xllastarg();    /* store the new value */    *adr = (int)getfixnum(val);    /* return the new value */    return (val);}

LVAL xssample(V){  LVAL x, result, temp, elem;  int n, N, replace, i, j;    x = xlgaseq();  n = getfixnum(xlgafixnum());  N = seqlen(x);  replace = (moreargs()) ? (xlgetarg() != NIL) : FALSE;  xllastarg();  if (! replace && n > N) n = N;  xlstkcheck(4);  xlprotect(x);  xlsave(result);  xlsave(elem);  xlsave(temp);  x = (listp(x)) ? coerce_to_tvec(x, s_true) : copyvector(x);  result = NIL;  if (N > 0 && n > 0) {    for (i = 0; i < n; i++) {      j = (replace) ? osrand(N) : i + osrand(N - i);      elem = gettvecelement(x, j);      result = cons(elem, result);      if (! replace) {           /* swap elements i and j */        temp = gettvecelement(x, i);        settvecelement(x, i, elem);        settvecelement(x, j, temp);      }    }  }  xlpopn(4);  return(result);}

/* xintchar - convert a character to an integer */LVAL xintchar(void){    LVAL arg;    arg = xlgafixnum();    xllastarg();    return (cvchar((int)getfixnum(arg)));}

LVAL xsmenu_popup(V){  LVAL menu, window;  int left, top, item;    menu = xsgetmenu();  left = getfixnum(xlgafixnum());  top = getfixnum(xlgafixnum());  window = (moreargs()) ? xlgaobject() : NIL;  xllastarg();    send_message(menu, sk_update);  item = StMObPopup(menu, left, top, window);  if (item > 0) send_message1(menu, sk_select, item);  return(cvfixnum((FIXTYPE) item));}

/* Built in BASE-MAKE-SWEEP-MATRIX function */LVAL xsbasemkswpmat(V){  int n, p;  double *x, *y, *w, *sm, *xmean;    n = getfixnum(xlgafixnum());  p = getfixnum(xlgafixnum());  getsweepdata(n * p, &x);  getsweepdata(n, &y);  getsweepdata(n, &w);  getsweepdata((p + 2) * (p + 2), &sm);  getsweepdata(p, &xmean);  xllastarg();  mkswpmat(n, p, x, y, w, sm, xmean);  return NIL;}

LVAL xlc_block_watch(void){    long arg1 = getfixnum(xlgafixnum());    xllastarg();    block_watch(arg1);    return NIL;}

/* xdigitchar - built-in function 'digit-char' */LVAL xdigitchar(void){    LVAL arg;    int n;    arg = xlgafixnum(); n = getfixnum(arg);    xllastarg();    return (n >= 0 && n <= 9 ? cvchar(n + '0') : NIL);}

/* xcodechar - built-in function 'code-char' */LVAL xcodechar(void){    LVAL arg;    int ch;    arg = xlgafixnum(); ch = getfixnum(arg);    xllastarg();    return (ch >= 0 && ch <= 127 ? cvchar(ch) : NIL);}

LVAL iview_std_adjust_points_in_rect(V){  IVIEW_WINDOW w;  int left, top, width, height;  PointState state;    w = (IVIEW_WINDOW) get_iview_address(xlgaobject());  left = getfixnum(xlgafixnum());  top = getfixnum(xlgafixnum());  width = getfixnum(xlgafixnum());  height = getfixnum(xlgafixnum());  state = decode_point_state(xlgetarg());  xllastarg();    IViewStdAdjustPointsInRect(w, left, top, width, height, state);  return(NIL);}

LVAL xlc_snd_print(void){    LVAL arg1 = xlgetarg();    long arg2 = getfixnum(xlgafixnum());    xllastarg();    sound_print(arg1, arg2);    return NIL;}