void
invert_number(void)
{
unsigned int *a, *b;
save();
p1 = pop();
if (iszero(p1))
stop("divide by zero");
if (isdouble(p1)) {
push_double(1 / p1->u.d);
restore();
return;
}
a = mcopy(p1->u.q.a);
b = mcopy(p1->u.q.b);
MSIGN(b) = MSIGN(a);
MSIGN(a) = 1;
p1 = alloc();
p1->k = NUM;
p1->u.q.a = b;
p1->u.q.b = a;
push(p1);
restore();
}
//***********************************************************************
// set $EXTRACT
//
short DSetextract(u_char *tmp, cstring *cptr, mvar *var,
int i1, int i2) // Set $EXTRACT()
{ cstring *vptr; // where the variable goes
short s; // for the functions
int i; // a handy int
if (i1 < 1) i1 = 1; // ensure i1 positive
if (i1 > i2) return 0; // ignore that, it's junk
if (i2 > MAX_STR_LEN) return -ERRM75; // complain if too long
vptr = (cstring *) tmp; // where it goes
s = Dget1(vptr->buf, var); // get current value
if (s < 0) return s; // die on error
vptr->len = s; // save the size
for (i = s; i < i1; vptr->buf[i++] = ' '); // ensure enough spaces
if (s <= i2) // if no trailing left
{ s = mcopy(cptr->buf, &vptr->buf[i1 - 1], cptr->len); // copy it in
if (s < 0) return s; // check for overflow
vptr->len = i1 - 1 + cptr->len; // the new length
if (var->uci == UCI_IS_LOCALVAR)
return ST_Set(var, vptr); // set it back and return
return DB_Set(var, vptr); // set it back and return
}
if ((i2 - i1 + 1) != cptr->len) // not an exact fit?
{ s = mcopy(&vptr->buf[i2], // move tail from here
&vptr->buf[i1 - 1 + cptr->len], // to here
vptr->len - i2 + 2); // this many bytes
if (s < 0) return s; // check overflow
}
bcopy(cptr->buf, &vptr->buf[i1 - 1], cptr->len); // can't use mcopy() here
vptr->len = vptr->len - (i2 - i1 + 1) + cptr->len;
if (var->uci == UCI_IS_LOCALVAR)
return ST_Set(var, vptr); // set it back and return
return DB_Set(var, vptr); // set it back and return
}
void
negate_number(void)
{
save();
p1 = pop();
if (iszero(p1)) {
push(p1);
restore();
return;
}
switch (p1->k) {
case NUM:
p2 = alloc();
p2->k = NUM;
p2->u.q.a = mcopy(p1->u.q.a);
p2->u.q.b = mcopy(p1->u.q.b);
MSIGN(p2->u.q.a) *= -1;
push(p2);
break;
case DOUBLE:
push_double(-p1->u.d);
break;
default:
stop("bug caught in mp_negate_number");
break;
}
restore();
}
FN minvert(MINT *a, MINT *b, MINT *c)
{ MINT x, y, z, w, Anew, Aold;
int i = 0;
static MINT one;
static int oneinit = 1;
if (oneinit) {
oneinit = 0;
MSET(1,&one);
}
MINIT(&x);
MINIT(&y);
MINIT(&z);
MINIT(&w);
MINIT(&Aold);
MSET (1,&Anew);
mcopy(b, &x);
mcopy(a, &y);
/*
* Loop invariant:
*
* y = -1^i * Anew * a mod b
*/
while(mtest(&y) != 0)
{ mdiv(&x, &y, &w, &z);
mcopy(&Anew, &x);
mmult(&w, &Anew, &Anew);
madd(&Anew, &Aold, &Anew);
mmove(&x, &Aold);
mmove(&y, &x);
mmove(&z, &y);
i++;
}
if (mcmp(&one,&x)) {
mcopy(&one,c);
} else {
mmove(&Aold, c);
if( (i&01) == 0) msub(b, c, c);
}
MFREE(&x);
MFREE(&y);
MFREE(&z);
MFREE(&w);
MFREE(&Aold);
MFREE(&Anew);
}
short DB_GetLen( mvar *var, int lock, u_char *buf) // length of node
{ short s; // for returns
int sav; // save curr_lock
if ((lock == -1) && (buf == NULL)) // just unlock?
{ if (curr_lock) // if locked
{ SemOp( SEM_GLOBAL, -curr_lock); // unlock it
}
return 0; // exit
}
sav = curr_lock; // save this
s = Copy2local(var); // get local copy
curr_lock = sav; // restore current lock
if (s < 0) // check for error
{ if (curr_lock) // if locked
{ SemOp( SEM_GLOBAL, -curr_lock); // release global lock
}
return s; // and return
}
s = Get_data(0); // attempt to get it
if (s < 0) // check for error
{ if (curr_lock) // if locked
{ SemOp( SEM_GLOBAL, -curr_lock); // release global lock
}
return s; // and return
}
if (buf != NULL) // want data?
{ s = mcopy(record->buf, buf, record->len); // copy the data
}
if ((lock != 1) && (curr_lock)) // preserve lock?
{ SemOp( SEM_GLOBAL, -curr_lock); // no - release it
}
return s; // and exit
}
unsigned int *
mpow(unsigned int *a, unsigned int n)
{
unsigned int *aa, *t;
a = mcopy(a);
aa = mint(1);
for (;;) {
if (n & 1) {
t = mmul(aa, a);
mfree(aa);
aa = t;
}
n >>= 1;
if (n == 0)
break;
t = mmul(a, a);
mfree(a);
a = t;
}
mfree(a);
return aa;
}
int
readp( /* get human-readable primitive */
PRIMITIVE *p,
FILE *fp
)
{
char inbuf[MAXARGS];
register int c, nargs;
int tmp;
if (fp == NULL) fp = stdin;
restart:
if ((c = getc(fp)) == EOF) { /* used to be fatal */
mcopy((char *)p, (char *)&peof, sizeof(PRIMITIVE));
return(0);
}
if (c == CDELIM) { /* skip user comment */
fgets(inbuf, MAXARGS, fp);
goto restart;
} else if (c == '\n') /* skip empty line */
goto restart;
if (!iscom(c))
error(USER, "bad command in readp");
p->com = c;
fscanf(fp, "%o", &tmp);
p->arg0 = tmp & 0377;
if (isglob(c))
p->xy[XMN] = p->xy[YMN] = p->xy[XMX] = p->xy[YMX] = -1;
else if (fscanf(fp, "%d %d %d %d", &p->xy[XMN], &p->xy[YMN],
&p->xy[XMX], &p->xy[YMX]) != 4)
error(USER, "missing extent in readp");
while ((c = getc(fp)) != EOF && c != '\n' && c != ADELIM);
nargs = 0;
if (c == ADELIM)
while ((c = getc(fp)) != EOF && c != '\n' && nargs < MAXARGS-1)
inbuf[nargs++] = c;
if (nargs >= MAXARGS)
error(USER, "too many arguments in readp");
if (nargs) {
inbuf[nargs] = '\0';
p->args = savestr(inbuf);
}
else
p->args = NULL;
return(p->com != PEOF);
}
char *
mstr(unsigned int *a)
{
int k, n, r, sign;
char c;
if (str == NULL) {
str = (char *) malloc(1000);
len = 1000;
}
// estimate string size
n = 10 * MLENGTH(a) + 2;
if (n > len) {
free(str);
str = (char *) malloc(n);
len = n;
}
sign = MSIGN(a);
a = mcopy(a);
k = len - 1;
str[k] = 0;
for (;;) {
k -= 9;
r = divby1billion(a);
c = str[k + 9];
sprintf(str + k, "%09d", r);
str[k + 9] = c;
if (MZERO(a))
break;
}
// remove leading zeroes
while (str[k] == '0')
k++;
if (str[k] == 0)
k--;
// sign
if (sign == -1) {
k--;
str[k] = '-';
}
mfree(a);
return str + k;
}
int main(){
char s[100],t[100];
int m;
gets(s);
scanf("%d",&m);
mcopy(s, t, m);
system("pause");
}
int exhaustive_scrabble_test(const char* filename)
{
long result = errors_counter();
// note that dictsize*keys*3 tests are performed
size_t DICTSIZE = 10000, KEYS = 10;
typedef std::vector<std::string> Dictionary;
extern size_t fill_dictionary(const char*, Dictionary&, size_t, size_t = 0);
Dictionary dictionary;
size_t longest_in_file = fill_dictionary(filename, dictionary, DICTSIZE);
std::random_shuffle(dictionary.begin(), dictionary.end());
ScrabbleTst names;
Dictionary::iterator dit;
for (dit = dictionary.begin(); dit != dictionary.end(); dit += 4) {
const std::string& name(*dit);
names[name] = name.c_str();
}
int skip = dictionary.size() / KEYS;
for(dit = dictionary.begin() + skip; dit != dictionary.end(); dit += skip)
{
std::string name(*dit);
std::sort(name.begin(), name.end());
for (int jokercount = 0; jokercount < 3; ++jokercount) {
ScrabbleTst::search_results_list matchresults = names.create_search_results();
names.combinatorial_search(name, std::back_inserter(matchresults), jokercount);
//if (matchresults.size() == 0)
// std::cout << "couldn't find " << name << '\n';
BOOST_CHECK(matchresults.size() != 0);
ScrabbleTst matches;
ScrabbleTst matchcount;
size_t prevsize = 0;
for (size_t i = 0; i != matchresults.size(); ++i) {
std::string mcopy(matchresults[i].key());
matchcount[mcopy] = mcopy.c_str();
if (matchcount.size() > prevsize) {
BOOST_CHECK(check_scrabble_found(name, mcopy, jokercount));
++prevsize;
}
else {
std::cout << "scrabble found duplicate " << mcopy << "\n";
}
std::sort(mcopy.begin(), mcopy.end());
matches[mcopy] = mcopy.c_str();
}
// check for duplicates
scrabble_findcount += matchresults.size();
scrabble_duplicates += matchresults.size() - matchcount.size();
BOOST_CHECK(matchcount.size() == matchresults.size());
BOOST_CHECK(check_scrabble_missed(names, matches, jokercount));
}
}
//std::cout << "scrabble duplicate matches " << scrabble_duplicates << " of " << scrabble_findcount << "\n";
return errors_counter() - result;
}
void
mcopy(
std::pair<T*, T*> const& d,
std::pair<T*, T*> const& s,
stride_type d_stride_0,
stride_type d_stride_1,
stride_type s_stride_0,
stride_type s_stride_1,
length_type size_0,
length_type size_1)
{
mcopy(d.first, s.first,
d_stride_0, d_stride_1,
s_stride_0, s_stride_1,
size_0, size_1);
mcopy(d.second, s.second,
d_stride_0, d_stride_1,
s_stride_0, s_stride_1,
size_0, size_1);
}
static void exec(DstBlock& dst, SrcBlock const& src, col2_type, col2_type)
{
vsip::impl::Ext_data<DstBlock> d_ext(dst, vsip::impl::SYNC_OUT);
vsip::impl::Ext_data<SrcBlock> s_ext(src, vsip::impl::SYNC_IN);
mcopy(
d_ext.data(), s_ext.data(),
d_ext.stride(1), d_ext.stride(0),
s_ext.stride(1), s_ext.stride(0),
d_ext.size(1), d_ext.size(0));
}
short DB_QueryD(mvar *var, u_char *buf) // get next key
{ short s; // for returns
// int i; // a handy int
s = Copy2local(var); // get local copy
if (s < 0)
{ return s; // exit on error
}
s = Get_data(0); // try to find that
if ((s < 0) && (s != -ERRM7)) // check for errors
{ if (curr_lock) // if locked
{ SemOp( SEM_GLOBAL, -curr_lock); // release global lock
}
return s; // and return the error
}
if ((level == 0) && (s == -ERRM7)) // if no such global
{ buf[0] = '\0'; // null terminate ret
if (curr_lock) // if locked
{ SemOp( SEM_GLOBAL, -curr_lock); // release global lock
}
return -(ERRMLAST+ERRZ55); // and return
}
if ((s < 0) && (db_var.slen)) // If we had a "real"
{ Index--; // <UNDEF> last time
} // back up Index
s = Locate_next(); // point at next
if (s < 0) // not found or error
{ if (curr_lock) // if locked
{ SemOp( SEM_GLOBAL, -curr_lock); // release global lock
}
if (s == -ERRM7) // if no more
{ s = -(ERRMLAST+ERRZ55); // say 'at end'
}
return s; // done
}
// for (i = 10; i <= Index; i++) // scan to current
// { chunk = (cstring *) &iidx[idx[i]]; // point at the chunk
// bcopy(&chunk->buf[2], &keybuf[chunk->buf[0]+1],
// chunk->buf[1]); // update the key
// keybuf[0] = chunk->buf[0] + chunk->buf[1]; // and the size
// }
bcopy(&keybuf[1], var->key, (int) keybuf[0]); // copy in the key
var->slen = keybuf[0]; // update the length
s = mcopy(record->buf, buf, record->len); // copy the data
if (curr_lock) // if locked
{ SemOp( SEM_GLOBAL, -curr_lock); // release global lock
}
return s; // return the count
}
bool Anchor::ray(float o[4],float d[4],float m[4][4]) {
bool test=false;
unsigned int f=0;
float mori[4][4];
for(f=0;f<this->countChildren;f++) {
mcopy(m,mori);
(this->children[f]->ray(o,d,mori)?test=true:test=test); // nada inteligente
}
this->cast=test;
return(test);
}
int
mprime(unsigned int *n)
{
int i, k;
unsigned int *q;
// 1?
if (MLENGTH(n) == 1 && n[0] == 1)
return 0;
// 2?
if (MLENGTH(n) == 1 && n[0] == 2)
return 1;
// even?
if ((n[0] & 1) == 0)
return 0;
// n = 1 + (2 ^ k) q
q = mcopy(n);
k = 0;
do {
mshiftright(q);
k++;
} while ((q[0] & 1) == 0);
// try 25 times
for (i = 0; i < 25; i++)
if (mprimef(n, q, k) == 0)
break;
mfree(q);
if (i < 25)
return 0;
else
return 1;
}
bool Inline::ray(float o[4],float d[4],float m[4][4]) {
bool test=false;
float mori[4][4];
mcopy(m,mori);
#ifdef DEBUG1
cout << "m " << m[0][0] << " " << m[0][1] << " " << m[0][2] << " " << m[0][3] << endl;
cout << " " << m[1][0] << " " << m[1][1] << " " << m[1][2] << " " << m[1][3] << endl;
cout << " " << m[2][0] << " " << m[2][1] << " " << m[2][2] << " " << m[2][3] << endl;
cout << " " << m[3][0] << " " << m[3][1] << " " << m[3][2] << " " << m[3][3] << endl << endl;
#endif
(this->ixb->ray(o,d,mori)?test=true:test=test); // nada inteligente
return(test);
}
short DB_Get(mvar *var, u_char *buf) // get global data
{ short s; // for returns
s = Copy2local(var); // get local copy
if (s < 0)
{ return s; // exit on error
}
systab->vol[volnum-1]->stats.dbget++; // update stats
s = Get_data(0); // attempt to get it
if (s >= 0) // if worked
{ if (bcmp("$GLOBAL\0", &db_var.name.var_cu[0], 8) == 0) // if ^$G
{ s = itocstring(buf, *(u_int *) record); // block number
}
else
{ s = mcopy(record->buf, buf, record->len); // copy the data
}
}
if (curr_lock) // if locked
{ SemOp( SEM_GLOBAL, -curr_lock); // release global lock
}
return s; // return the count
}
int main(int argc, char const *argv[])
{
int len;
int max;
char line[MAXLINE];
char longest[MAXLINE];
max = 0;
while((len = mgetline(line, MAXLINE)) > 0){
if(len > max){
max = len;
mcopy(longest, line);
}
}
if(max > 0)
printf("%s", longest);
return 0;
}
//***********************************************************************
// $VIEW(channel#,location[,size[,value]])
//
short Dview(u_char *ret_buffer, int chan, int loc,
int size, cstring *value)
{ int i; // a handy int
u_char *vb; // view buffer address
if (chan > -1) return -(ERRMLAST+ERRZ63); // must be negative for now
chan = (-chan) - 1; // negate it and 0 base
if (partab.jobtab->view[chan] == NULL) // got a block
return -(ERRMLAST+ERRZ63); // no - die
vb = (u_char *) partab.jobtab->view[chan]->mem; // get block mem address
if ((loc < 0) ||
(size < 1) ||
((loc + size) > systab->vol[chan]->vollab->block_size))
return -(ERRMLAST+ERRZ63); // out of range - die
vb = vb + loc; // offset to locn
if (value == NULL) // a read?
{ if (size == 1)
return itocstring(ret_buffer, *vb); // one byte
if (size == 2)
return itocstring(ret_buffer, *((u_short *) vb)); // two bytes
if (size == 4)
return itocstring(ret_buffer, *((u_int *) vb)); // four bytes
return mcopy(vb, ret_buffer, size); // return the string
}
ret_buffer[0] = '\0'; // null terminate
if ((size == 1) || (size == 2) || (size == 4)) // int type?
{ i = cstringtoi(value); // make int of it
if (size == 1) *vb = (u_char) i;
else if (size == 2) *((u_short *) vb) = (u_short) i;
else *((u_int *) vb) = i; // set some int type
}
else
{ if (size != value->len) return -(ERRMLAST+ERRZ63); // junk
bcopy(value->buf, vb, size); // copy whatever
}
return 0; // return OK
}
msqrt(MINT *a, MINT *b, MINT *r)
{ MINT x,y,z;
register alen,j;
MINIT(&x); MINIT(&y); MINIT(&z);
alen = a->len;
if (alen<0) mpfatal("msqrt: neg arg");
if (alen==0) {
mset(0,b);
mset(0,r);
return(0);
}
if(alen & 01) x.len = (1+alen)/2;
else x.len = 1 + alen/2;
valloc(x.val,x.len);
for (j=x.len; (--j)>=0;) x.val[j]=0;
if (alen & 01) x.val[x.len-1]=0400;
else x.val[x.len-1]=1;
for (;;) {
mdiv(a,&x,&y,&z);
madd(&x,&y,&y);
mshiftr(&y,1);
if (mcmp(&x,&y) <= 0) break;
mmove(&y,&x);
}
mcopy(&x,&y);
mmult(&x,&x,&x);
msub(a,&x,r);
MFREE(&x);
MMOVEFREE(&y,b);
MFREE(&z);
return(r->len);
}
void
mp_denominator(void)
{
save();
p1 = pop();
if (p1->k != NUM) {
push(one);
restore();
return;
}
p2 = alloc();
p2->k = NUM;
p2->u.q.a = mcopy(p1->u.q.b);
p2->u.q.b = mint(1);
push(p2);
restore();
}
short Dstack1x(u_char *ret_buffer, int level, int job)
{ int i; // a usefull int
ret_buffer[0] = '\0'; // null terminate
if (level < -1) return 0; // junk
i = systab->jobtab[job].cur_do; // default
if (systab->jobtab[job].error_frame > systab->jobtab[job].cur_do)
i = systab->jobtab[job].error_frame; // ensure we have the error bit
if (level > i) return 0; // nothing there
if (level == -1)
return itocstring(ret_buffer, i); // return the number
if (level == 0)
{ if (systab->jobtab[job].dostk[0].type == TYPE_JOB)
return mcopy((u_char *) "JOB", ret_buffer, 3); // for a JOB command
return mcopy((u_char *) "RUN", ret_buffer, 3); // normal run
}
if (level == systab->jobtab[job].error_frame) level = STM1_FRAME; // err frame
i = systab->jobtab[job].dostk[level].type & 127; // get the type
if (i == TYPE_RUN) return mcopy((u_char *) "BREAK", ret_buffer, 5);
if (i == TYPE_DO) return mcopy((u_char *) "DO", ret_buffer, 2);
if (i == TYPE_EXTRINSIC) return mcopy((u_char *) "$$", ret_buffer, 2);
if (i == TYPE_XECUTE) return mcopy((u_char *) "XECUTE", ret_buffer, 6);
ret_buffer[0] = '\0';
return 0; // else nothing
}
/*******************************************************************
Subroutine to compute the inverse matrix and determinant
matrix *cov: the pointer to the covariance matrix
matrix *inv_cov: the pointer to the inverse covariance matrix
matrix *cov_mat: the pointer to the approximate covariance matrix
when singular. If unsingular, it equals to cov
double *det_cov: the pointer to determinant
return value: '1' - successfully exit
'0' - exit with waring/error
*******************************************************************/
int veCov(matrix *cov, matrix *inv_cov, matrix *cov_mat,
double *det_cov)
{
int i, j;
matrix eigvec_re;
matrix eigvec_im;
vector eigval_re;
vector eigval_im;
int *eig_order;
int eig_info;
int num_v; // the number of eigenvalue
int rank_c;
double sum_v;
double factor = 0.02;
double ass_value;
double min_real;
mnew(&eigvec_re, cov->m, cov->n);
mnew(&eigvec_im, cov->m, cov->n);
vnew(&eigval_re, cov->n);
vnew(&eigval_im, cov->n);
eig_order = new int[cov->n];
// the eigenvector and eigenvalue of covariance matrix
eig_info = eig(cov, &eigvec_re, &eigvec_im, &eigval_re, &eigval_im);
//vprint(&eigval_re);
//vprint(&eigval_im);
if (!eig_info) {
printf(" The eigenvalue computation failed! \n");
return 0;
//....
}
// the rank of covariance matrix
num_v = cov->n;
/*rank_c = num_v;
for (i=0; i<num_v; i++) {
if ((fabs(*(eigval_re.pr+i)) < ZEROTHRESH) && (fabs(*(eigval_im.pr+i)) < ZEROTHRESH)) {
rank_c--;
}
}
printf("rank = %d", rank_c);*/
rank_c = rank(cov, TOLERANCE);
// compute the inverse and determinate
if (rank_c == num_v) { // nonsingular
inv(cov, inv_cov);
mcopy(cov, cov_mat);
*det_cov = det(cov);
} else { // singular
min_real = pow(10, (((double)-250) / ((double) cov->m)));
/*for (i=0; i<num_v; i++) {
if ((*(eigval_re.pr+i) < ZEROTHRESH) || (*(eigval_im.pr+i) != 0)) {
*(eigval_re.pr+i) = 0; // ???? keep the real part of complex or not
*(eigval_im.pr+i) = 0;
}
}
sort(&eigval_re, eig_order, 'd'); */
for (i=0; i<num_v; i++) {
// when negtive real eigenvalue, change to absolute value
// to ensure all the real eigenvalues are positive
if ((eigval_re.pr[i] < 0) && (eigval_im.pr[i] == 0)) {
eigval_re.pr[i] *= -1;
// the i-th column of eigenvector should also be changed the sign
for (j=0; j<(eigvec_re.m); j++) {
eigvec_re.pr[j*(eigvec_re.n)+i] *= -1;
}
}
}
//vprint(&eigval_re);
//vprint(&eigval_im);
// sort real eigenvalues descendingly, put complex ones at the end
sorteig(&eigval_re, &eigval_im, eig_order);
for (i=rank_c; i<num_v; i++) {
*(eigval_re.pr+i) = 0;
*(eigval_im.pr+i) = 0;
}
//vprint(&eigval_re);
//vprint(&eigval_im);
sum_v = vsum(&eigval_re);
ass_value = factor * sum_v / (num_v - rank_c);
if (ass_value < (0.5 * (*(eigval_re.pr+rank_c)) * (1 - factor))) {
if (ass_value > min_real) {
for (i=rank_c; i<num_v; i++) {
*(eigval_re.pr+i) = ass_value;
}
for (i=0; i<rank_c; i++) {
*(eigval_re.pr+i) *= 1 - factor;
}
} else {
for (i=rank_c; i<num_v; i++) {
*(eigval_re.pr+i) = min_real;
}
}
} else {
ass_value = 0.5 * (*(eigval_re.pr+rank_c)) * (1 - factor);
if (ass_value > min_real) {
for (i=rank_c; i<num_v; i++) {
*(eigval_re.pr+i) = ass_value;
}
for (i=0; i<rank_c; i++) {
*(eigval_re.pr+i) = *(eigval_re.pr+i) - ass_value * (num_v - rank_c) * (*(eigval_re.pr+i)) / sum_v;
}
} else {
for (i=rank_c; i<num_v; i++) {
*(eigval_re.pr+i) = min_real;
}
}
}
//vprint(&eigval_re);
//vprint(&eigval_im);
matrix eigvec_re_sorted;
matrix eigvec_re_sorted_t;
mnew(&eigvec_re_sorted, num_v, num_v);
mnew(&eigvec_re_sorted_t, num_v, num_v);
sortcols(eig_order, &eigvec_re, &eigvec_re_sorted);
transpose(&eigvec_re_sorted, &eigvec_re_sorted_t);
matrix inv_eig_vl_s;
mnew(&inv_eig_vl_s, num_v, num_v);
for (i=1; i<num_v; i++) {
*(inv_eig_vl_s.pr + i*num_v + i) = 1 / (*(eigval_re.pr+i));
}
matrix tmp;
mnew(&tmp, num_v, num_v);
mmMul(&eigvec_re_sorted, &inv_eig_vl_s, &tmp);
mmMul(&tmp, &eigvec_re_sorted_t, inv_cov);
matrix diag_eigval;
mnew(&diag_eigval, num_v, num_v);
for (i=0; i<num_v; i++) {
*(diag_eigval.pr + i*num_v + i) = *(eigval_re.pr+i);
}
mmMul(&eigvec_re_sorted, &diag_eigval, &tmp);
mmMul(&tmp, &eigvec_re_sorted_t, cov_mat);
*det_cov = 1;
for (i=0; i<num_v; i++) {
*det_cov = (*det_cov) * (*(eigval_re.pr+i));
}
mdelete(&inv_eig_vl_s);
mdelete(&eigvec_re_sorted);
mdelete(&eigvec_re_sorted_t);
mdelete(&tmp);
mdelete(&diag_eigval);
}
#ifdef _DEBUG
printf("rank = %d \n", rank_c);
printf("\n det_cov = %e \n", *det_cov);
printf("inv_cov = \n");
mprint(inv_cov);
printf("cov_mat = \n");
mprint(cov_mat);
#endif
mdelete(&eigvec_re);
mdelete(&eigvec_im);
vdelete(&eigval_re);
vdelete(&eigval_im);
delete []eig_order;
return 1;
}
void tex::handle_right_brace ()
{
scal d;
int f;
ptr p;
ptr q;
switch (cur_group)
{
case SIMPLE_GROUP:
unsave();
break;
case BOTTOM_LEVEL:
print_err("Too many }'s");
help_close_group();
error();
break;
case SEMI_SIMPLE_GROUP:
case MATH_SHIFT_GROUP:
case MATH_LEFT_GROUP:
extra_right_brace();
break;
case HBOX_GROUP:
package(0);
break;
case ADJUSTED_HBOX_GROUP:
tex::adjust_tail = tex::adjust_head;
package(0);
break;
case VBOX_GROUP:
end_graf();
package(0);
break;
case VTOP_GROUP:
end_graf();
package(VTOP_CODE);
break;
case INSERT_GROUP:
end_graf();
q = split_top_skip;
add_glue_ref(q);
d = split_max_depth;
f = floating_penalty;
unsave();
decr(save_ptr);
p = vpack(link(head), 0, ADDITIONAL);
pop_nest();
if (saved(0) < 255) {
tail_append(new_node(INS_NODE_SIZE));
type(tail) = INS_NODE;
subtype(tail) = saved(0);
ins_height(tail) = box_height(p) + box_depth(p);
ins_ptr(tail) = list_ptr(p);
split_top_ptr(tail) = q;
ins_depth(tail) = d;
float_cost(tail) = f;
} else {
tail_append(new_node(SMALL_NODE_SIZE));
type(tail) = ADJUST_NODE;
subtype(tail) = 0;
adjust_ptr(tail) = list_ptr(p);
delete_glue_ref(q);
}
free_node(p, BOX_NODE_SIZE);
if (nest_ptr == nest)
build_page();
break;
case OUTPUT_GROUP:
if (loc != null
|| (token_type != OUTPUT_TEXT && token_type != BACKED_UP)) {
print_err("Unbalanced output routine");
help_output_balance();
error();
do get_token();
while (loc != null);
}
end_token_list();
end_graf();
unsave();
output_active = FALSE;
insert_penalties = 0;
if (box(255) != null) {
print_err("Output routine didn't use all of ");
print_esc("box255");
help_output();
box_error(255);
}
if (tail != head) {
link(page_tail) = link(head);
page_tail = tail;
}
if (link(page_head) != null) {
if (link(contrib_head) == null)
contrib_tail = page_tail;
link(page_tail) = link(contrib_head);
link(contrib_head) = link(page_head);
link(page_head) = null;
page_tail = page_head;
}
pop_nest();
build_page();
break;
case DISC_GROUP:
build_discretionary();
break;
case ALIGN_GROUP:
back_input();
cur_tok = sym2tok(FROZEN_CR);
print_err("Missing ");
print_esc("cr");
print(" inserted");
help_align_cr();
ins_error();
break;
case NO_ALIGN_GROUP:
end_graf();
unsave();
align_peek();
break;
case VCENTER_GROUP:
end_graf();
unsave();
save_ptr -= 2;
p = vpackage(link(head), saved(1), saved(0), MAX_DIMEN);
pop_nest();
tail_append(new_noad());
type(tail) = VCENTER_NOAD;
math_type(nucleus(tail)) = SUB_BOX;
info(nucleus(tail)) = p;
break;
case MATH_CHOICE_GROUP:
build_choices();
break;
case MATH_GROUP:
unsave();
decr(save_ptr);
math_type(saved(0)) = SUB_MLIST;
p = fin_mlist(null);
math_link(saved(0)) = p;
if (p != null) {
if (link(p) == null) {
if (type(p) == ORD_NOAD) {
if (math_type(subscr(p)) == EMPTY
&& math_type(supscr(p)) == EMPTY) {
mcopy(saved(0), nucleus(p));
free_node(p, NOAD_SIZE);
}
} else if (type(p) == ACCENT_NOAD
&& saved(0) == nucleus(tail)
&& type(tail) == ORD_NOAD) {
q = head;
while (link(q) != tail)
q = link(q);
link(q) = p;
free_node(tail, NOAD_SIZE);
tail = p;
}
}
}
break;
default:
confusion("rightbrace");
break;
}
}
//***********************************************************************
// set $PIECE
//
short DSetpiece(u_char *tmp, cstring *cptr, mvar *var,
cstring *dptr, int i1, int i2) // Set $PIECE()
{ cstring *vptr; // where the variable goes
short s; // for the functions
int beg = 0; // start copy from
int end; // copy to
int pce = 1; // current piece
int f; // found flag
int j; // for delim scan
int np; // number of pieces
if (i1 < 1) i1 = 1; // ensure i1 positive
if (i1 > i2) return 0; // ignore that, it's junk
vptr = (cstring *) tmp; // where it goes
s = Dget1(vptr->buf, var); // get current value
if (s < 0) return s; // die on error
vptr->len = s; // save the size
if (dptr->len == 0) // null delimiter ?
{ s = mcopy(cptr->buf, &vptr->buf[vptr->len], cptr->len); // copy at end
if (s < 0) return s; // die on error
vptr->len = vptr->len + cptr->len; // the new length
if (var->uci == UCI_IS_LOCALVAR)
return ST_Set(var, vptr); // set it back and return
return DB_Set(var, vptr); // set it back and return
}
np = Dlength2x(vptr, dptr); // get number of pieces
if (np < i1) // current < = start
{ f = i1 - np; // delimiters required
for (j = 0; j < f; j++) // for each required delimiter
{ s = mcopy(dptr->buf, &vptr->buf[vptr->len], dptr->len); // copy 1 delim
if (s < 0) return s; // check for overflow
if ((vptr->len+s)>MAX_STR_LEN) return -ERRM75;
vptr->len += s; // add to length
}
s = mcopy(cptr->buf, &vptr->buf[vptr->len], cptr->len); // copy in source
vptr->len += s; // add to length
if (var->uci == UCI_IS_LOCALVAR)
return ST_Set(var, vptr); // set it back and return
return DB_Set(var, vptr); // set it back and return
}
for (end = 0; end < vptr->len; end++) // scan expr
{ if (vptr->buf[end] == dptr->buf[0]) // if first char matches
{ f = 1; // set found flag
for (j = 1; j < dptr->len; j++) // scan rest of delimiter
{ if (vptr->buf[end+j] != dptr->buf[j]) // if we have a mismatch
{ f = 0; // clear found flag
break; // and quit
}
} // end delim scan
if (f == 1) // just quit the if on fail
{ if (pce == i2) // if this is last piece
{ end--; // point at last reqd char
break; // and quit for loop
} // end last piece processing
pce++; // increment current piece
end = end + dptr->len - 1; // point at last char of delim
if (pce == i1) beg = end + 1; // if this is the first pce
} // end found code
} // end of got match
} // end of expr scan
if (np == i1) // replace last piece
{ s = mcopy(cptr->buf, &vptr->buf[beg], cptr->len); // copy it
vptr->len = beg + cptr->len; // fixup length
if (var->uci == UCI_IS_LOCALVAR)
return ST_Set(var, vptr); // set it back and return
return DB_Set(var, vptr); // set it back and return
}
if (end >= vptr->len) end = vptr->len - 1; // don't point past end
i1 = beg; // start of cut
i2 = end; // end of cut
if ((i2 - i1 + 1) != cptr->len) // not an exact fit?
{ s = mcopy(&vptr->buf[i2 + 1], // move tail from here
&vptr->buf[i1 + cptr->len], // to here
vptr->len - i2 + 2); // this many bytes
if (s < 0) return s; // check overflow
}
if (cptr->len)
bcopy(cptr->buf, &vptr->buf[i1], cptr->len); // can't use mcopy() here
vptr->len = vptr->len - (i2 - i1 + 1) + cptr->len;
if (var->uci == UCI_IS_LOCALVAR)
return ST_Set(var, vptr); // set it back and return
return DB_Set(var, vptr); // set it back and return
}
//***********************************************************************
// $TEXT(entryref)
//
// the entire string "entryref" is passed in one variable, eval it here
//
short Dtext(u_char *ret_buffer, cstring *str) // $TEXT()
{ int i = 0; // a handy int
int j = 0; // and another
u_char slen; // saved length
short s; // for functions
int off = 1; // line offset
u_char rou[4+MAX_NAME_BYTES]; // routine name
u_char tag[4+MAX_NAME_BYTES]; // the tag
cstring *cr; // the rou
cstring *ct; // and the tag
ret_buffer[0] = '\0'; // JIC
ct = (cstring *) &tag[0]; // use it this way
cr = (cstring *) &rou[0]; // ditto
ct->len = 0; // assume no tag
cr->len = 0; // no routine for now
if (bcmp("+0\0", str->buf, 3) == 0) // $T(+0) ?
{ for (i = 0; i < MAX_NAME_BYTES; i++) // copy rou name
{ if (!partab.jobtab->dostk[partab.jobtab->cur_do].rounam.var_cu[i])
break; // quit when done
ret_buffer[i] =
partab.jobtab->dostk[partab.jobtab->cur_do].rounam.var_cu[i]; // copy
}
ret_buffer[i] = '\0'; // null terminate
return (short) i; // and exit
}
if ((str->buf[i] != '+') && (str->buf[i] != '^')) // is there a tag
{ while (j < MAX_NAME_BYTES)
{ if ((i == 0) && (str->buf[i] == '%')) // leading %
{ ct->buf[j++] = str->buf[i++]; // copy it
continue; // and go for more
}
if (isalnum(str->buf[i]) == 0) break; // done
ct->buf[j++] = str->buf[i++]; // copy it
}
ct->buf[j] = '\0'; // null terminate tag
ct->len = j; // save the length
off = 0; // change offset to zero
while ((str->buf[i] != '+') &&
(str->buf[i] != '^') &&
(str->buf[i] != '\0')) i++; // skip to + ^ or null
} // end tag processing
if (str->buf[i] == '+') // if we have a plus
{ off = 0; // clear offset
i++; // skip the +
while (isdigit(str->buf[i]) != 0) // for all digits
off = (off * 10) + (str->buf[i++] - '0'); // extract the offset
} // end offset stuf
if ((str->buf[i] != '^') && (str->buf[i] != '\0'))
return -(ERRMLAST + ERRZ12); // complain
j = 0; // clear rou ptr
if (str->buf[i] == '^') // routine name
{ i++; // skip the ^
while (j < MAX_NAME_BYTES)
{ if ((j == 0) && (str->buf[i] == '%')) // leading %
{ cr->buf[j++] = str->buf[i++]; // copy it
continue; // and go for more
}
if (isalnum(str->buf[i]) == 0) break; // done
cr->buf[j++] = str->buf[i++]; // copy it
}
cr->buf[j] = '\0'; // null terminate rou
cr->len = j; // save the length
}
else // we need the current routine
{ for (j = 0; j < MAX_NAME_BYTES; j++)
if ((cr->buf[j] =
partab.jobtab->dostk[partab.jobtab->cur_do].rounam.var_cu[j])
== '\0') break; // copy till done
cr->buf[j] = '\0'; // null terminate rou
cr->len = j; // save the length
}
if (cr->len == 0) return 0; // no routine supplied -> null
if ((ct->len == 0) && (!off)) // just the name reqd?
return mcopy(cr->buf, ret_buffer, cr->len); // return the name
X_set("$ROUTINE", &partab.src_var.name.var_cu[0], 8); // setup for DB_Get
partab.src_var.volset = partab.jobtab->rvol; // vol
partab.src_var.uci = partab.jobtab->ruci; // uci
if (cr->buf[0] == '%') // manager routine?
partab.src_var.uci = 1; // point there
partab.src_var.slen = 0; // init key size
s = UTIL_Key_Build(cr, &partab.src_var.key[0]); // first key
if (s < 0) return s; // die on error
slen = s; // save key size
if (ct->len == 0) // no tag?
{ ct->len = itocstring(ct->buf, off); // cstring off
s = UTIL_Key_Build(ct,
&partab.src_var.key[slen]); // next key
if (s < 0) return s; // die on error
partab.src_var.slen = s + slen; // save key size
s = DB_Get(&partab.src_var, ret_buffer); // get it
if (s < 0)
{ ret_buffer[0] = '\0'; // nothing
s = 0; // zero length
}
return s; // and return it
}
for (j = 1; ; j++) // need to read all lines
{ cr->len = itocstring(cr->buf, j); // cstring j
s = UTIL_Key_Build(cr,
&partab.src_var.key[slen]); // next key
if (s < 0) return s; // die on error
partab.src_var.slen = s + slen; // save key size
s = DB_Get(&partab.src_var, ret_buffer); // get it
if (s < 0)
{ ret_buffer[0] = '\0'; // nothing
return 0; // zero length
}
for (i = 0; i < ct->len; i++) // check the tag
if (ret_buffer[i] != ct->buf[i]) break; // quit if different
if (i < ct->len) continue; // go for next if no match
if ((ret_buffer[i] != ' ') && // must be space
(ret_buffer[i] != '(') && // or (
(ret_buffer[i] != '\0')) continue; // or null
if (off == 0) return s; // no offset - all done
j = j + off; // add the offset
cr->len = itocstring(cr->buf, j); // cstring j
s = UTIL_Key_Build(cr,
&partab.src_var.key[slen]); // next key
if (s < 0) return s; // die on error
partab.src_var.slen = s + slen; // save key size
s = DB_Get(&partab.src_var, ret_buffer); // get it
if (s < 0)
{ ret_buffer[0] = '\0'; // nothing
s = 0; // zero length
}
return s; // done
}
}
static int
mprimef(unsigned int *n, unsigned int *q, int k)
{
int i, j;
unsigned int *t, *x, *y;
// generate x
t = mcopy(n);
while (1) {
for (i = 0; i < MLENGTH(t); i++)
t[i] = rand();
x = mmod(t, n);
if (!MZERO(x) && !MEQUAL(x, 1))
break;
mfree(x);
}
mfree(t);
// exponentiate
y = mmodpow(x, q, n);
// done?
if (MEQUAL(y, 1)) {
mfree(x);
mfree(y);
return 1;
}
j = 0;
while (1) {
// y = n - 1?
t = msub(n, y);
if (MEQUAL(t, 1)) {
mfree(t);
mfree(x);
mfree(y);
return 1;
}
mfree(t);
if (++j == k) {
mfree(x);
mfree(y);
return 0;
}
// y = (y ^ 2) mod n
t = mmul(y, y);
mfree(y);
y = mmod(t, n);
mfree(t);
// y = 1?
if (MEQUAL(y, 1)) {
mfree(x);
mfree(y);
return 0;
}
}
}
/*******************************************************************
Subroutine to do the EM algorithm
matrix *D: the pointer to the matrix data
matrix *mean0_x: the pointer to a matrix containing the initial Means of clusters
vector *w0: the pointer to a vector containing the initial mixing proportion of clusters
double vv: the value for initializing the Covariance matrix of clusters
double error: the error threshold
vector *Zjk_up: the pointer to a vector containing Posterior probabilities of the up-level
cluster samples
matrix *mean1_x: the pointer to a matrix containing the Means of clusters in t-space
vector *w0_t: the pointer to a vector containing the mixing proportions of the identified
clusters in t-space
matrix *cov_mat: the pointer to a group of matrixs containing the Covariance
matrix of clusters in t-space
matrix *Zjk: the pointer to a matrix containing Posterior probabilities of all samples
belonging to all the sub-level clusters, each column is for one cluster.
return value: '1' - successfully exit
'0' - exit with waring/error
*******************************************************************/
int veSubEM(matrix *D, matrix *mean0_x, vector *w0, double vv, double error, vector *Zjk_up, //input
matrix *mean1_x, vector *w0_t, matrix *cov_mat, matrix *Zjk) //output
{
int k0, kc, n, p;
int i, j, k, u, s;
matrix *Var0;
matrix Gxn;
vector Fx;
matrix MUK;
matrix MU1;
int zeroFx_num = 1;
//double error = 0.01;
double err = error + (double)1;
vector Zjk_temp;
n = D->m;
p = D->n;
k0 = mean0_x->m;
kc = mean0_x->n;
Var0 = new matrix[k0];
for(i=0; i<k0; i++) {
mnew(Var0+i, p, p);
}
mnew(&Gxn, n, k0);
vnew(&Fx, n);
vnew(&Zjk_temp, n);
mnew(&MUK, k0, p);
mcopy(mean0_x, &MUK);
mnew(&MU1, k0, p);
vector D_j;
vector Zjk_k;
double sum_tmp = 0;
matrix Ck;
vector D_i;
vector MUK_k;
vector cen_D_i;
matrix mtmp;
vector vtmp;
vnew(&D_j, n);
vnew(&Zjk_k, n);
mnew(&Ck, p, p);
vnew(&D_i, p);
vnew(&MUK_k, p);
vnew(&cen_D_i, p);
mnew(&mtmp, p, p);
vnew(&vtmp, n);
//Initializing the parameters of mixture of Gaussians
//Initinalize the covariance matrix
//Use EM algorithm to perform the local training.
//Test intialization of covarinace matrix
//printf("Testing covariance matrix initialization... \n");
while (zeroFx_num != 0) {
for(i=0; i<k0; i++) {
meye(Var0+i);
for (j=0; j<p; j++) {
*((Var0+i)->pr+j*p+j) = vv;
}
}
veModel(D, mean0_x, Var0, w0, &Gxn, &Fx);
//printf("\n Gxn = :\n");
//mprint(&Gxn);
//printf("\n Fx = :\n");
//vprint(&Fx);
zeroFx_num = 0;
for (i=0; i<n; i++) {
if (*(Fx.pr+i) == 0) {
zeroFx_num++;
}
}
vv *= 2;
}
vones(&Zjk_temp);
//printf("\n EM in t-space starts ... \n");
//printf("\n Data = \n");
//mprint(D);
int l = 0;
while (err > error) {
#ifdef _DEBUG
printf(" \n...... in EM loop %d ......\n", ++l);
printf("\n L%d: w0 = \n", l);
vprint(w0);
printf("\n L%d: MUK = \n", l);
mprint(&MUK);
printf("\n L%d: Var0 = \n", l);
for(i=0; i<k0; i++) {
mprint(Var0+i);
printf("\n");
}
printf("\n L%d: Zjk = \n", l);
mprint(Zjk);
#endif
veModel(D, &MUK, Var0, w0, &Gxn, &Fx);
#ifdef _DEBUG
printf("\n L%d: Gxn = \n", l);
mprint(&Gxn);
printf("\n L%d: Fx = \n", l);
vprint(&Fx);
#endif
for (k=0; k<k0; k++) {
u = k*p;
double zz = 0;
double zz_up = 0;
for (i=0; i<n; i++) {
*(Zjk->pr+i*k0+k) = (*(w0->pr+k)) * Zjk_up->pr[i] * (*(Gxn.pr+i*k0+k)) / (*(Fx.pr+i));
zz += *(Zjk->pr+i*k0+k);
zz_up += Zjk_up->pr[i];
}
*(w0->pr+k) = zz/zz_up;
for (j=0; j<p; j++) {
getcolvec(D, j, &D_j);
getcolvec(Zjk, k, &Zjk_k);
sum_tmp = 0;
for (i=0; i<n; i++) {
sum_tmp += (*(Zjk_k.pr+i)) * (*(D_j.pr+i));
}
*(MU1.pr+u+j) = sum_tmp / zz;
}
mzero(&Ck);
for (i=0; i<n; i++) {
getrowvec(D, i, &D_i);
getrowvec(&MUK, k, &MUK_k);
for (j=0; j<p; j++) {
*(cen_D_i.pr+j) = *(D_i.pr+j) - *(MUK_k.pr+j);
}
vvMul(&cen_D_i, &cen_D_i, &mtmp);
for (j=0; j<p; j++) {
for (s=0; s<p; s++) {
*(Ck.pr+j*p+s) += (*(Zjk->pr+i*k0+k)) * (*(mtmp.pr+j*p+s));
}
}
}
for (j=0; j<p; j++) {
for (s=0; s<p; s++) {
*(Var0[k].pr+j*p+s) = (*(Ck.pr+j*p+s)) / zz;
}
}
} // for (k...
mcopy(&MU1, &MUK);
for (i=0; i<n; i++) {
*(vtmp.pr+i) = fabs(*(Zjk_k.pr+i) - *(Zjk_temp.pr+i));
}
err = vmean(&vtmp);
vcopy(&Zjk_k, &Zjk_temp);
} // while
vcopy(w0, w0_t);
mcopy(&MUK, mean1_x);
for(i=0; i<k0; i++) {
mcopy(Var0+i, cov_mat+i);
}
for(i=0; i<k0; i++) {
mdelete(Var0+i);
}
mdelete(&Gxn);
vdelete(&Fx);
vdelete(&Zjk_temp);
mdelete(&MUK);
mdelete(&MU1);
vdelete(&D_j);
vdelete(&Zjk_k);
mdelete(&Ck);
vdelete(&D_i);
vdelete(&MUK_k);
vdelete(&cen_D_i);
mdelete(&mtmp);
vdelete(&vtmp);
return 1;
}
unsigned int *
mgcd(unsigned int *u, unsigned int *v)
{
int i, k, n;
unsigned int *t;
if (MZERO(u)) {
t = mcopy(v);
MSIGN(t) = 1;
return t;
}
if (MZERO(v)) {
t = mcopy(u);
MSIGN(t) = 1;
return t;
}
u = mcopy(u);
v = mcopy(v);
MSIGN(u) = 1;
MSIGN(v) = 1;
k = 0;
while ((u[0] & 1) == 0 && (v[0] & 1) == 0) {
mshiftright(u);
mshiftright(v);
k++;
}
if (u[0] & 1) {
t = mcopy(v);
MSIGN(t) *= -1;
} else
t = mcopy(u);
while (1) {
while ((t[0] & 1) == 0)
mshiftright(t);
if (MSIGN(t) == 1) {
mfree(u);
u = mcopy(t);
} else {
mfree(v);
v = mcopy(t);
MSIGN(v) *= -1;
}
mfree(t);
t = msub(u, v);
if (MZERO(t)) {
mfree(t);
mfree(v);
n = (k / 32) + 1;
v = mnew(n);
MSIGN(v) = 1;
MLENGTH(v) = n;
for (i = 0; i < n; i++)
v[i] = 0;
mp_set_bit(v, k);
t = mmul(u, v);
mfree(u);
mfree(v);
return t;
}
}
}
short Dstack2x(u_char *ret_buffer, int level, cstring *code, int job)
{ int arg2 = 0; // arg 2 1 = ECODE
// 2 = MCODE
// 3 = PLACE
var_u *rounam; // routine name
int line; // line number
int i; // a handy int
u_char *p; // a handy pointer
mvar *var; // for ^$R()
u_char temp[3*MAX_NAME_BYTES]; // ditto
cstring *cptr; // ditto
short s; // ditto
ret_buffer[0] = '\0'; // null terminate
if (level < 0) return 0; // junk
i = systab->jobtab[job].cur_do; // default
if (systab->jobtab[job].error_frame > systab->jobtab[job].cur_do)
i = systab->jobtab[job].error_frame; // ensure we have the error bit
if (level > i) return 0; // nothing there
if (strncasecmp((const char *) code->buf, "ecode\0", 6) == 0) arg2 = 1;
else if (strncasecmp((const char *) code->buf, "mcode\0", 6) == 0) arg2 = 2;
else if (strncasecmp((const char *) code->buf, "place\0", 6) == 0) arg2 = 3;
else return (-(ERRZ50+ERRMLAST)); // junk
if (arg2 == 1) // "ECODE"
{ ret_buffer[0] = '\0'; // assume nothing
if (job != (partab.jobtab - systab->jobtab)) return (0); // can't find
var = (mvar *) ret_buffer; // use same space for mvar
X_set("$ECODE\0\0", &var->name.var_cu[0], 8);// copy in $ECODE
var->volset = 0;
var->uci = UCI_IS_LOCALVAR;
cptr = (cstring *) temp; // some spare space
cptr->len = itocstring(cptr->buf, level); // setup for subscript
var->slen = UTIL_Key_Build(cptr, &var->key[0]);
s = ST_Get(var, ret_buffer); // get and return
if (s == -ERRM6) s = 0; // allow for not there
return s;
}
if ((level == systab->jobtab[job].error_frame) &&
(level)) level = STM1_FRAME; // err frame adjust
if ((((systab->jobtab[job].dostk[level].type & 127) == TYPE_XECUTE) ||
((systab->jobtab[job].dostk[level].type & 127) == TYPE_RUN) ||
((systab->jobtab[job].dostk[level].type & 127) == TYPE_JOB)) &&
//(systab->jobtab[job].dostk[level].rounam.var_qu == 0))
(X_Empty(systab->jobtab[job].dostk[level].rounam.var_xu)))
{ if (arg2 == 2) // "MCODE"
{ ret_buffer[0] = '\0'; // JIC
if (systab->jobtab[job].cur_do < level) return 0; // no can do
if (job != (partab.jobtab - systab->jobtab)) return (0); // can't find
p = (u_char *)systab->jobtab[job].dostk[level].routine;
if (p == NULL) return 0; // nothing there
for (i = 0; ((ret_buffer[i] = p[i])); i++); // copy it
return i; // return the count
}
return mcopy((u_char *) "XECUTE", ret_buffer, 6); // "PLACE"
}
rounam = &(systab->jobtab[job].dostk[level].rounam); // point at routine name
line = systab->jobtab[job].dostk[level].line_num; // get line number
if (arg2 == 2) // "MCODE"
{ var = (mvar *) ret_buffer; // use same space for mvar
X_set("$ROUTINE", &var->name.var_cu[0], 8); // copy in $ROUTINE
var->volset = systab->jobtab[job].rvol; // vol number
var->uci = systab->jobtab[job].ruci; // uci number
if (rounam->var_cu[0] == '%') var->uci = 1; // check for a percent rou
cptr = (cstring *) temp; // some spare space
for (i = 0; i < MAX_NAME_BYTES; i++) // copy name
{ if (rounam->var_cu[i] == 0) break; // quit when done
cptr->buf[i] = rounam->var_cu[i]; // copy
}
cptr->buf[i] = '\0'; // null terminate
cptr->len = i; // save the length
s = UTIL_Key_Build(cptr, &var->key[0]); // make a key from it
if (s < 0) return s; // die on error
var->slen = (u_char) s; // save the length
cptr->len = itocstring(cptr->buf, line); // make a string from int
s = UTIL_Key_Build(cptr, &var->key[var->slen]); // make a key from it
if (s < 0) return s; // die on error
var->slen = (u_char) s + var->slen; // save the length
s = Dget1(ret_buffer, var); // get data
if (s < 0) s = 0; // ignore errors
ret_buffer[s] = '\0'; // null terminate
return s; // and return
}
i = 0; // the start
ret_buffer[i++] = '+'; // add plus
i = i + itocstring(&ret_buffer[i], line); // add the line number
ret_buffer[i++] = '^'; // the name indicator
for (arg2 = 0; arg2 < MAX_NAME_BYTES; arg2++) // copy name
if ((ret_buffer[i++] = rounam->var_cu[arg2]) == 0) break;
if (ret_buffer[i-1] == '\0') i--; // back up over null
ret_buffer[i] = '\0'; // null terminate
return i; // return length
}