tables.c

Go to the documentation of this file.

 
/* #[ License : */
/*
 *   Copyright (C) 1984-2026 J.A.M. Vermaseren
 *   When using this file you are requested to refer to the publication
 *   J.A.M.Vermaseren "New features of FORM" math-ph/0010025
 *   This is considered a matter of courtesy as the development was paid
 *   for by FOM the Dutch physics granting agency and we would like to
 *   be able to track its scientific use to convince FOM of its value
 *   for the community.
 *
 *   This file is part of FORM.
 *
 *   FORM 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 3 of the License, or (at your option) any later
 *   version.
 *
 *   FORM 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 FORM.  If not, see <http://www.gnu.org/licenses/>.
 */
/* #] License : */ 
/*
    #[ Includes :
 
    File contains the routines for the tree structure of sparse tables
    We insert elements by
    InsTableTree(T,tp) with T the TABLES element and tp the pointer
        to the indices.
    We look for elements with
    FindTableTree(T,tp,inc) with T the TABLES element, tp the pointer to the
        indices or the function arguments and inc tells which of these options.
    The tree is cleared with ClearTableTree(T) and we rebuild the tree
    after a .store in which we lost a part of the table with
    RedoTableTree(T,newsize)
 
    In T->tablepointers we have the lists of indices for each element.
    Additionally for each element there is an extension. There are
    TABLEEXTENSION WORDs reserved for that. The old system had two words
    One for the element in the rhs of the compile buffer and one for
    an additional rhs in case the original would be overwritten by a new
    definition, but the old was fixed by .global and hence it should be possible
    to restore it.
    New use (new = 24-sep-2001)
        rhs1,numCompBuffer1,rhs2,numCompBuffer2,usage
    Hence TABLEEXTENSION will be 5. Note that for 64 bits the use of the
    compiler buffer is overdoing it a bit, but it would be too complicated
    to try to give it special code.
*/
 
#include "form3.h"
#include "minos.h"
#include "comtool.h"
 
/* static UBYTE *sparse = (UBYTE *)"sparse"; */
static UBYTE *tablebase = (UBYTE *)"tablebase";
 
/*
    #] Includes : 
    #[ ClearTableTree :
*/
 
void ClearTableTree(TABLES T)
{
    COMPTREE *root;
    if ( T->boomlijst == 0 ) {
        T->MaxTreeSize = 125;
        T->boomlijst = (COMPTREE *)Malloc1(T->MaxTreeSize*sizeof(COMPTREE),
                "ClearTableTree");
    }
    root = T->boomlijst;
    T->numtree = 0;
    T->rootnum = 0;
    root->left = -1;        
    root->right = -1;
    root->parent = -1;
    root->blnce = 0;
    root->value = -1;
    root->usage = 0;
}
 
/*
    #] ClearTableTree : 
    #[ InsTableTree :
 
    int InsTableTree(TABLES T,WORD *,arglist)
        Searches for the element specified by the list of arguments.
        If found, it returns -(the offset in T->tablepointers)
        If not found, it will allocate a new element, balance the tree if
        necessary and return the number of the element in the boomlijst
        This number is always > 0, because we start from 1.
*/
 
int InsTableTree(TABLES T, WORD *tp)
{
    COMPTREE *boomlijst, *q, *p, *s;
    WORD *v1, *v2, *v3, xstop;
    int ip, iq, is;
    if ( T->numtree + 1 >= T->MaxTreeSize ) {
        if ( T->MaxTreeSize == 0 ) ClearTableTree(T);
        else {
            is = T->MaxTreeSize * 2;
            s  = (COMPTREE *)Malloc1(is*sizeof(COMPTREE),"InsTableTree");
            for ( ip = 0; ip < T->MaxTreeSize; ip++ ) { s[ip] = T->boomlijst[ip]; }
            if ( T->boomlijst ) M_free(T->boomlijst,"InsTableTree");
            T->boomlijst = s;
            T->MaxTreeSize = is;
        }
    }
    boomlijst = T->boomlijst;
    q = boomlijst + T->rootnum;
    if ( q->right == -1 ) { /* First element */
        T->numtree++;
        s = boomlijst+T->numtree;
        q->right = T->numtree;
        s->parent = T->rootnum;
        s->left = s->right = -1;
        s->blnce = 0;
        s->value = tp - T->tablepointers;
        s->usage = 0;
        return(T->numtree);
    }
    ip = q->right;
    if ( T->numind >= 0 ) xstop = T->numind;
    else xstop = *tp + 1;
    while ( ip >= 0 ) {
        p = boomlijst + ip;
        v1 = T->tablepointers + p->value;
        v2 = tp; v3 = tp + xstop;
        while ( *v1 == *v2 && v2 < v3 ) { v1++; v2++; }
        if ( v2 >= v3 ) return(-p->value);
        if ( *v1 > *v2 ) {
            iq = p->right;
            if ( iq >= 0 ) { ip = iq; }
            else {
                T->numtree++;
                is = T->numtree; 
                p->right = is;
                s = boomlijst + is;
                s->parent = ip; s->left = s->right = -1;
                s->blnce = 0;   s->value = tp - T->tablepointers;
                s->usage = 0;
                p->blnce++;
                if ( p->blnce == 0 ) return(T->numtree);
                goto balance;
            }
        }
        else if ( *v1 < *v2 ) {
            iq = p->left;
            if ( iq >= 0 ) { ip = iq; }
            else {
                T->numtree++;
                is = T->numtree;
                s = boomlijst+is;
                p->left = is;
                s->parent = ip; s->left = s->right = -1;
                s->blnce = 0;   s->value = tp - T->tablepointers;
                s->usage = 0;
                p->blnce--;
                if ( p->blnce == 0 ) return(T->numtree);
                goto balance;
            }
        }
    }
    MesPrint("Serious problems in InsTableTree!\n");
    Terminate(-1);
    return(0);
balance:;
    for (;;) {
        p = boomlijst + ip;
        iq = p->parent;
        if ( iq == T->rootnum ) break;
        q = boomlijst + iq;
        if ( ip == q->left ) q->blnce--;
        else                 q->blnce++;
        if ( q->blnce == 0 ) break;
        if ( q->blnce == -2 ) {
            if ( p->blnce == -1 ) { /* single rotation */
                q->left = p->right;
                p->right = iq;
                p->parent = q->parent;
                q->parent = ip;
                if ( boomlijst[p->parent].left == iq ) boomlijst[p->parent].left = ip;
                else                                   boomlijst[p->parent].right = ip;
                if ( q->left >= 0 ) boomlijst[q->left].parent = iq;
                q->blnce = p->blnce = 0;
            }
            else {  /* double rotation */
                s = boomlijst + is;
                q->left = s->right;
                p->right = s->left;
                s->right = iq;
                s->left = ip;
                if ( p->right >= 0 ) boomlijst[p->right].parent = ip;
                if ( q->left >= 0 ) boomlijst[q->left].parent = iq;
                s->parent = q->parent;
                q->parent = is;
                p->parent = is;
                if ( boomlijst[s->parent].left == iq )
                       boomlijst[s->parent].left = is;
                else   boomlijst[s->parent].right = is;
                if ( s->blnce > 0 ) { q->blnce = s->blnce = 0; p->blnce = -1; }
                else if ( s->blnce < 0 ) { p->blnce = s->blnce = 0; q->blnce = 1; }
                else { p->blnce = s->blnce = q->blnce = 0; }
            }
            break;
        }
        else if ( q->blnce == 2 ) {
            if ( p->blnce == 1 ) {  /* single rotation */
                q->right = p->left;
                p->left = iq;
                p->parent = q->parent;
                q->parent = ip;
                if ( boomlijst[p->parent].left == iq ) boomlijst[p->parent].left = ip;
                else                                   boomlijst[p->parent].right = ip;
                if ( q->right >= 0 ) boomlijst[q->right].parent = iq;
                q->blnce = p->blnce = 0;
            }
            else {  /* double rotation */
                s = boomlijst + is;
                q->right = s->left;
                p->left = s->right;
                s->left = iq;
                s->right = ip;
                if ( p->left >= 0 ) boomlijst[p->left].parent = ip;
                if ( q->right >= 0 ) boomlijst[q->right].parent = iq;
                s->parent = q->parent;
                q->parent = is;
                p->parent = is;
                if ( boomlijst[s->parent].left == iq ) boomlijst[s->parent].left = is;
                else                                   boomlijst[s->parent].right = is;
                if ( s->blnce < 0 ) { q->blnce = s->blnce = 0; p->blnce = 1; }
                else if ( s->blnce > 0 ) { p->blnce = s->blnce = 0; q->blnce = -1; }
                else { p->blnce = s->blnce = q->blnce = 0; }
            }
            break;
        }
        is = ip; ip = iq;
    }
    return(T->numtree);
}
 
/*
    #] InsTableTree : 
    #[ RedoTableTree :
 
    To be used when a sparse table is trimmed due to a .store
    We rebuild the tree. In the future one could try to become faster
    at the cost of quite some complexity.
    We need to keep the first 'size' elements in the boomlijst.
    Kill all others and reconstruct the tree with the original ordering.
    This is very complicated! Because .store will either keep the whole
    table or remove the whole table we should not come here often.
    Hence we choose the slow solution for now.
*/
 
void RedoTableTree(TABLES T, int newsize)
{
    WORD *tp;
    int i;
    ClearTableTree(T);
    for ( i = 0, tp = T->tablepointers; i < newsize; i++ ) {
        InsTableTree(T,tp);
        tp += ABS(T->numind)+TABLEEXTENSION;
    }
}
 
/*
    #] RedoTableTree : 
    #[ FindTableTree :
 
    int FindTableTree(TABLES T,WORD *,arglist,int,inc)
        Searches for the element specified by the list of arguments.
        If found, it returns the offset in T->tablepointers
        If not found, it will return -1
        The list here is from the list of function arguments. Hence it
        has pairs of numbers -SNUMBER,index
        Actually inc says how many numbers there are and the above case is 
        for inc = 2. For inc = 1 we have just a list of indices.
*/
 
int FindTableTree(TABLES T, WORD *tp, int inc)
{
    COMPTREE *boomlijst = T->boomlijst, *q = boomlijst + T->rootnum, *p;
    WORD *v1, *v2, *v3, xstop;
    int ip, iq;
    if ( q->right == -1 ) return(-1);
    ip = q->right;
    if ( inc > 1 ) tp += inc-1;
    if ( T->numind >= 0 ) xstop = T->numind;
    else {  /* We have to read the number of arguments first */
        if ( *tp <= 0 ) return(-1); /* Cannot be! */
        xstop = *tp+1;
    }
    while ( ip >= 0 ) {
        p = boomlijst + ip;
        v1 = T->tablepointers + p->value;
        v2 = tp; v3 = v1 + xstop;
        while ( *v1 == *v2 && v1 < v3 ) { v1++; v2 += inc; }
        if ( v1 == v3 ) {
            p->usage++;
            return(p->value);
        }
        if ( *v1 > *v2 ) {
            iq = p->right;
            if ( iq >= 0 ) { ip = iq; }
            else return(-1);
        }
        else if ( *v1 < *v2 ) {
            iq = p->left;
            if ( iq >= 0 ) { ip = iq; }
            else return(-1);
        }
    }
    MesPrint("Serious problems in FindTableTree\n");
    Terminate(-1);
    return(-1);
}
 
/*
    #] FindTableTree : 
    #[ DoTableExpansion :
*/
 
int DoTableExpansion(WORD *term, WORD level)
{
    GETIDENTITY
    WORD *t, *tstop, *stopper, *termout, *m, *mm, *tp, *r, xx;
    WORD numsubexp, numbuf;
    TABLES T = 0;
    int i, j, num;
    AN.TeInFun = AR.TePos = 0;
    tstop = term + *term;
    stopper = tstop - ABS(tstop[-1]);
    t = term+1;
    while ( t < stopper ) {
        if ( *t != TABLEFUNCTION ) { t += t[1]; continue; }
        if ( t[FUNHEAD] > -FUNCTION ) { t += t[1]; continue; }
        T = functions[-t[FUNHEAD]-FUNCTION].tabl;
        if ( T == 0 ) { t += t[1]; continue; }
        if ( T->spare ) T = T->spare;
        if ( t[1] == FUNHEAD+2 && t[FUNHEAD+1] <= -FUNCTION ) break;
        if ( t[1] < FUNHEAD+1+2*ABS(T->numind) ) { t += t[1]; continue; }
        for ( i = 0; i < ABS(T->numind); i++ ) {
            if ( t[FUNHEAD+1+2*i] != -SYMBOL ) break;
        }
        if ( i >= ABS(T->numind) ) break;
        t += t[1];
    }
    if ( t >= stopper ) {
        MesPrint("Internal error: Missing table_ function");
        Terminate(-1);
    }
/*
    Table in T. Now collect the numbers of the symbols;
*/
    termout = AT.WorkPointer;
    if ( T->sparse ) {
        for ( i = 0; i < T->totind; i++ ) {
/*
            Loop over all table elements
*/
            m = termout + 1; mm = term + 1;
            while ( mm < t ) *m++ = *mm++;
            r = m;
            if ( t[1] == FUNHEAD+2 && t[FUNHEAD+1] <= -FUNCTION ) {
                *m++ = -t[FUNHEAD+1];
                tp = T->tablepointers + (ABS(T->numind)+TABLEEXTENSION)*i;
                if ( T->numind < 0 ) {
                    xx = tp[0]+1;
                    *m++ = FUNHEAD+xx*2;
                    for ( j = 2; j < FUNHEAD; j++ ) *m++ = 0;
                    for ( j = 0; j < xx; j++ ) {
                        *m++ = -SNUMBER; *m++ = *tp++;
                    }
                }
                else {
                    *m++ = FUNHEAD+T->numind*2;
                    for ( j = 2; j < FUNHEAD; j++ ) *m++ = 0;
                    for ( j = 0; j < T->numind; j++ ) {
                        *m++ = -SNUMBER; *m++ = *tp++;
                    }
                }
            }
            else if ( T->numind < 0 ) {
                tp = T->tablepointers + (ABS(T->numind)+TABLEEXTENSION)*i;
                xx = tp[0]+1;
                *m++ = SYMBOL; *m++ = 2+xx*2; mm = t + FUNHEAD+1;
                for ( j = 0; j < xx; j++, mm += 2, tp++ ) {
                    if ( *tp != 0 ) { *m++ = mm[1]; *m++ = *tp; }
                }
                r[1] = m-r;
                if ( r[1] == 2 ) m = r;
            }
            else {
                *m++ = SYMBOL; *m++ = 2+T->numind*2; mm = t + FUNHEAD+1;
                tp = T->tablepointers + (T->numind+TABLEEXTENSION)*i;
                for ( j = 0; j < T->numind; j++, mm += 2, tp++ ) {
                    if ( *tp != 0 ) { *m++ = mm[1]; *m++ = *tp; }
                }
                r[1] = m-r;
                if ( r[1] == 2 ) m = r;
            }
/*
            The next code replaces this old code
 
            *m++ = SUBEXPRESSION;
            *m++ = SUBEXPSIZE;
            *m++ = *tp;
            *m++ = 1;
            *m++ = T->bufnum;
            FILLSUB(m);
            mm = t + t[1];
 
            We had forgotten to take the parameters into account.
            Hence the subexpression prototype for wildcards was missed
            Now we slow things down a little bit, but we do not run
            any risks. There is still one problem. We have not checked
            that the prototype matches.
*/
            tp = T->tablepointers + (ABS(T->numind)+TABLEEXTENSION)*i
                    +ABS(T->numind);
            numsubexp = tp[0]; numbuf = tp[1];
            r = m;
#ifdef WITHPTHREADS
            tp = T->prototype[identity];
#else
            tp = T->prototype;
#endif
            for ( j = 0; j < tp[1]; j++ ) *m++ = tp[j];
            r[2] = numsubexp; r[4] = numbuf;
/*
            r = m;
            tp = T->tablepointers + (ABS(T->numind)+TABLEEXTENSION)*i;
            *m++ = -t[FUNHEAD];
            if ( T->numind < 0 ) {
                xx = tp[0]+1;
                *m++ = t[1] - xx - T->numind - 1;
            }
            else {
                xx = T->numind;
                *m++ = t[1] - 1;
            }
            for ( j = 2; j < FUNHEAD; j++ ) *m++ = t[j];
            for ( j = 0; j < xx; j++ ) {
                *m++ = -SNUMBER; *m++ = *tp++;
            }
            tp = t + FUNHEAD + 1 + 2*T->numind;
            mm = t + t[1];
            while ( tp < mm ) *m++ = *tp++;
            r[1] = m-r;
*/
/*
            From now on is old code
*/
            mm = t + t[1];
            while ( mm < tstop ) *m++ = *mm++;
            *termout = m - termout;
            AT.WorkPointer = m;
            if ( Generator(BHEAD termout,level) ) {
                MesCall("DoTableExpand");
                return(-1);
            }
            AT.WorkPointer = termout;
        }
    }
    else {
        for ( i = 0; i < T->totind; i++ ) {
#if TABLEEXTENSION == 2
            if ( T->tablepointers[i] < 0 ) continue;
#else
            if ( T->tablepointers[TABLEEXTENSION*i] < 0 ) continue;
#endif
            m = termout + 1; mm = term + 1;
            while ( mm < t ) *m++ = *mm++;
            r = m;
            if ( t[1] == FUNHEAD+2 && t[FUNHEAD+1] <= -FUNCTION ) {
                *m++ = -t[FUNHEAD+1];
                *m++ = FUNHEAD+T->numind*2;
                for ( j = 2; j < FUNHEAD; j++ ) *m++ = 0;
                tp = T->tablepointers + (T->numind+TABLEEXTENSION)*i;
                for ( j = 0; j < T->numind; j++ ) {
                    if ( j > 0 ) {
                        num = T->mm[j].mini + ( i % T->mm[j-1].size ) / T->mm[j].size;
                    }
                    else {
                        num = T->mm[j].mini + i / T->mm[j].size;
                    }
                    *m++ = -SNUMBER; *m++ = num;
                }
            }
            else {
                *m++ = SYMBOL; *m++ = 2+T->numind*2; mm = t + FUNHEAD+1;
                for ( j = 0; j < T->numind; j++, mm += 2 ) {
                    if ( j > 0 ) {
                        num = T->mm[j].mini + ( i % T->mm[j-1].size ) / T->mm[j].size;
                    }
                    else {
                        num = T->mm[j].mini + i / T->mm[j].size;
                    }
                    if ( num != 0 ) { *m++ = mm[1]; *m++ = num; }
                }
                r[1] = m-r;
                if ( r[1] == 2 ) m = r;
            }
/*
            The next code replaces this old code
 
            *m++ = SUBEXPRESSION;
            *m++ = SUBEXPSIZE;
            *m++ = *tp;
            *m++ = 1;
            *m++ = T->bufnum;
            FILLSUB(m);
            mm = t + t[1];
 
            We had forgotten to take the parameters into account.
            Hence the subexpression prototype for wildcards was missed
            Now we slow things down a little bit, but we do not run
            any risks. There is still one problem. We have not checked
            that the prototype matches.
*/
            r = m;
            *m++ = -t[FUNHEAD];
            *m++ = t[1] - 1;
            for ( j = 2; j < FUNHEAD; j++ ) *m++ = t[j];
            for ( j = 0; j < T->numind; j++ ) {
                if ( j > 0 ) {
                    num = T->mm[j].mini + ( i % T->mm[j-1].size ) / T->mm[j].size;
                }
                else {
                    num = T->mm[j].mini + i / T->mm[j].size;
                }
                *m++ = -SNUMBER; *m++ = num;
            }
            tp = t + FUNHEAD + 1 + 2*T->numind;
            mm = t + t[1];
            while ( tp < mm ) *m++ = *tp++;
            r[1] = m - r;
/*
            From now on is old code
*/
            while ( mm < tstop ) *m++ = *mm++;
            *termout = m - termout;
            AT.WorkPointer = m;
            if ( Generator(BHEAD termout,level) ) {
                MesCall("DoTableExpand");
                return(-1);
            }
        }
    }
    return(0);
}
 
/*
    #] DoTableExpansion : 
    #[ TableBase :
 
    File with all the database related things.
    We have the routines for the generic database command
    TableBase,options;
    TB,options;
    Options are:
        Open "File.tbl";                   Open for R/W
        Open "File.tbl", readonly;         Open for R
        Create "File.tbl";                 Create for write
        Load "File.tbl", tablename;        Loads stubs of table
        Load "File.tbl";                   Loads stubs of all tables
        Enter "File.tbl", tablename;       Loads whole table
        Enter "File.tbl";                  Loads all tables
        Audit "File.tbl", options;         Print list of contents
        Replace "File.tbl", tablename;     Saves a table (with overwrite)
        Replace "File.tbl", table element; Saves a table element   ,,
        Cleanup "File.tbl";                Makes tables contingent
        AddTo "File.tbl" tablename;        Add if not yet there.
        AddTo "File.tbl" table element;    Add if not yet there.
        Delete "File.tbl" tablename;
        Delete "File.tbl" table element;
 
        On/Off substitute;
        On/Off compress "File.tbl";
    id tbl_(f?,?a) = f(?a);
    When a tbl_ is used, automatically the corresponding element is compiled
    at the start of the next module.
    if TB,On,substitute [tablename], use of table RHS (if loaded)
    if TB,Off,substitute [tablename], use of tbl_(table,...);
 
 
    Still needed: Something like OverLoad to allow loading parts of a table
    from more than one file. Date stamps needed? In that case we need a touch
    command as well.
 
    If we put all our diagrams inside, we have to go outside the concept
    of tables.
 
    #] TableBase : 
    #[ CoTableBase :
 
    To be followed by ,subkey
*/
static KEYWORD tboptions[] = {
     {"addto",           (TFUN)CoTBaddto,      0,    PARTEST}
    ,{"audit",           (TFUN)CoTBaudit,      0,    PARTEST}
    ,{"cleanup",         (TFUN)CoTBcleanup,    0,    PARTEST}
    ,{"create",          (TFUN)CoTBcreate,     0,    PARTEST}
    ,{"enter",           (TFUN)CoTBenter,      0,    PARTEST}
    ,{"help",            (TFUN)CoTBhelp,       0,    PARTEST}
    ,{"load",            (TFUN)CoTBload,       0,    PARTEST}
    ,{"off",             (TFUN)CoTBoff,        0,    PARTEST}
    ,{"on",              (TFUN)CoTBon,         0,    PARTEST}
    ,{"open",            (TFUN)CoTBopen,       0,    PARTEST}
    ,{"replace",         (TFUN)CoTBreplace,    0,    PARTEST}
    ,{"use",             (TFUN)CoTBuse,        0,    PARTEST}
};
 
static UBYTE *tablebasename = 0;
 
int CoTableBase(UBYTE *s)
{
    UBYTE *option, c, *t;
    int i,optlistsize = sizeof(tboptions)/sizeof(KEYWORD), error = 0;
    while ( *s == ' ' ) s++;
    if ( *s != '"' ) {
        if ( ( tolower(*s) == 'h' ) && ( tolower(s[1]) == 'e' )
         && ( tolower(s[2]) == 'l' ) && ( tolower(s[3]) == 'p' )
         && ( FG.cTable[s[4]] > 1 ) ) {
            CoTBhelp(s);
            return(0);
        }
proper:;
        MesPrint("&Proper syntax: TableBase \"filename\" options");
        return(1);
    }
    s++; tablebasename = s;
    while ( *s && *s != '"' ) s++;
    if ( *s != '"' ) goto proper;
    t = s; s++; *t = 0;
    while ( *s == ' ' || *s == '\t' || *s == ',' ) s++;
    option = s;
    while ( FG.cTable[*s] == 0 ) s++;
    c = *s; *s = 0;
    for ( i = 0; i < optlistsize; i++ ) {
        if ( StrICmp(option,(UBYTE *)(tboptions[i].name)) == 0 ) {
            *s = c;
            while ( *s == ',' ) s++;
            error = (tboptions[i].func)(s);
            *t = '"';
            return(error);
        }
    }
    MesPrint("&Unrecognized option %s in TableBase statement",option);
    return(1);
}
 
/*
    #] CoTableBase : 
    #[ FlipTable :
 
    Flips the table between use as 'stub' and regular use
*/
 
int FlipTable(FUNCTIONS f, int type)
{
    TABLES T, TT;
    T = f->tabl;
    if ( ( TT = T->spare ) == 0 ) {
        MesPrint("Error: trying to change mode on a table that has no tablebase");
        return(-1);
    }
    if ( TT->mode == type ) f->tabl = TT;
    return(0);
}
 
/*
    #] FlipTable : 
    #[ SpareTable :
 
    Creates a spare element for a table. This is used in the table bases.
    It is a (thus far) empty copy of the TT table.
    By using FlipTable we can switch between them and alter which version of
    a table we will be using. Note that this also causes some extra work in the
    ResetVariables and the Globalize routines.
*/
 
int SpareTable(TABLES TT)
{
    TABLES T;
    T = (TABLES)Malloc1(sizeof(struct TaBlEs),"table");
    T->defined = T->mdefined = 0; T->sparse = TT->sparse; T->mm = 0; T->flags = 0;
    T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
    T->boomlijst = 0;
    T->strict = TT->strict;
    T->bounds = TT->bounds;
    T->bufnum = inicbufs();
    T->argtail = TT->argtail;
    T->spare = TT;
    T->bufferssize = 8;
    T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"SpareTable buffers");
    T->buffersfill = 0;
    T->buffers[T->buffersfill++] = T->bufnum;
    T->mode = 0;
    T->numind = TT->numind;
    T->totind = 0;
    T->prototype = TT->prototype;
    T->pattern = TT->pattern;
    T->tablepointers = 0;
    T->reserved = 0;
    T->tablenum = 0;
    T->numdummies = 0;
    T->mm = (MINMAX *)Malloc1(ABS(T->numind)*sizeof(MINMAX),"table dimensions");
    T->flags = (WORD *)Malloc1(ABS(T->numind)*sizeof(WORD),"table flags");
    ClearTableTree(T);
    TT->spare = T;
    TT->mode = 1;
    return(0);
}
 
/*
    #] SpareTable : 
    #[ FindTB :
 
    Looks for a tablebase with the given name in the active tablebases.
*/
 
DBASE *FindTB(UBYTE *name)
{
    DBASE *d;
    int i;
    for ( i = 0; i < NumTableBases; i++ ) {
        d = tablebases+i;
        if ( d->name && ( StrCmp(name,(UBYTE *)(d->name)) == 0 ) ) { return(d); }
    }
    return(0);
}
 
/*
    #] FindTB : 
    #[ CoTBcreate :
 
    Creates a new tablebase.
    Error is when there is already an active tablebase by this name.
    If a file with the given name exists already, but it does not correspond
    to an active table base, its contents will be lost.
    Note that tablebasename is a static variable, defined in CoTableBase
*/
 
int CoTBcreate(UBYTE *s)
{
    DUMMYUSE(s);
    if ( FindTB(tablebasename) != 0 ) {
        MesPrint("&There is already an open TableBase with the name %s",tablebasename);
        return(-1);
    }
    NewDbase((char *)tablebasename,0);
    return(0);
}
 
/*
    #] CoTBcreate : 
    #[ CoTBopen :
*/
 
int CoTBopen(UBYTE *s)
{
    DBASE *d;
    MLONG rw = 1;
 
    SkipSpaces(&s);
    
    if ( *s ) {
        if ( ConsumeOption(&s,"readonly") != 0 ) {
            rw = 0;
        } else {
            MesPrint("&Invalid option for TableBase open: %s, ignoring", s);
        }
    }
    
    if ( ( d = FindTB(tablebasename) ) != 0 ) {
        MesPrint("&There is already an open TableBase with the name %s",tablebasename);
        return(-1);
    }
    d = GetDbase((char *)tablebasename, rw);
    if ( CheckTableDeclarations(d) ) return(-1);
    return(0);
}
 
/*
    #] CoTBopen : 
    #[ CoTBaddto :
*/
 
int CoTBaddto(UBYTE *s)
{
    GETIDENTITY
    DBASE *d;
    UBYTE *tablename, c, *t, elementstring[ELEMENTSIZE+20], *ss, *es;
    WORD type, funnum, lbrac, first, num, *expr, *w;
    TABLES T = 0;
    MLONG basenumber;
    LONG x;
    int i, j, error = 0, sum;
    if ( ( d = FindTB(tablebasename) ) == 0 ) {
        MesPrint("&No open tablebase with the name %s",tablebasename);
        return(-1);
    }
    
    if ( ( d->rwmode ) == 0 ) {
        MesPrint("&Tablebase with the name %s opened in read only mode",tablebasename);
        return(-1);
    }
    AO.DollarOutSizeBuffer = 32;
    AO.DollarOutBuffer = (UBYTE *)Malloc1(AO.DollarOutSizeBuffer,
                            "TableOutBuffer");
/*
    Now loop through the names and start adding
*/
    while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    while ( *s ) {
        tablename = s;
        if ( ( s = SkipAName(s) ) == 0 ) goto tableabort;
        c = *s; *s = 0;
        if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
            || ( T = functions[funnum].tabl ) == 0 ) {
            MesPrint("&%s should be a previously declared table",tablename);
            *s = c; goto tableabort;
        }
        if ( T->sparse == 0 ) {
            MesPrint("&%s should be a sparse table",tablename);
            *s = c; goto tableabort;
        }
        basenumber = AddTableName(d,(char *)tablename,T);
        if ( T->spare && ( T->mode ==  1 ) ) T = T->spare;
        if ( basenumber < 0 ) basenumber = -basenumber;
        else if ( basenumber == 0 ) { *s = c; goto tableabort; }
        *s = c;
        if ( *s == '(' ) { /* Addition of single element */
            s++; es = s;
            for ( i = 0, w = AT.WorkPointer; i < ABS(T->numind); i++ ) {
              ParseSignedNumber(x,s);
              if ( FG.cTable[s[-1]] != 1 || ( *s != ',' && *s != ')' ) ) {
                MesPrint("&Table arguments in TableBase addto statement should be numbers");
                return(1);
              }
              *w++ = x;
              if ( *s == ')' ) break;
              s++;
            }
            if ( *s != ')' || i < ( ABS(T->numind) - 1 ) ) {
              MesPrint("&Incorrect number of table arguments in TableBase addto statement. Should be %d"
                ,ABS(T->numind));
              error = 1;
            }
            c = *s; *s = 0;
            i = FindTableTree(T,AT.WorkPointer,1);
            if ( i < 0 ) {
                MesPrint("&Element %s has not been defined",es);
                error = 1;
                *s++ = c;
            }
            else if ( ExistsObject(d,basenumber,(char *)es) ) {}
            else {
              int dict = AO.CurrentDictionary;
              AO.CurrentDictionary = 0;
              sum = i + ABS(T->numind);
/*
              See also commentary below
*/
              AO.DollarInOutBuffer = 1;
              AO.PrintType = 1;
              ss = AO.DollarOutBuffer;
              *ss = 0;
              AO.OutInBuffer = 1;
#if ( TABLEEXTENSION == 2 )
              expr = cbuf[T->bufnum].rhs[T->tablepointers[sum]];
#else
              expr = cbuf[T->tablepointers[sum+1]].rhs[T->tablepointers[sum]];
#endif
              lbrac = 0; first = 0;
              while ( *expr ) {
                if ( WriteTerm(expr,&lbrac,first,PRINTON,0) ) {
                        error = 1; break;
                }
                expr += *expr;
              }
              AO.OutInBuffer = 0;
              AddObject(d,basenumber,(char *)es,(char *)(AO.DollarOutBuffer));
              *s++ = c;
              AO.CurrentDictionary = dict;
            }
        }
        else {
/*
        Now we have to start looping through all defined elements of this table.
        We have to construct the arguments in text format.
*/
          for ( i = 0; i < T->totind; i++ ) {
#if ( TABLEEXTENSION == 2 )
            if ( !T->sparse && T->tablepointers[i] < 0 ) continue;
#else
            if ( !T->sparse && T->tablepointers[TABLEEXTENSION*i] < 0 ) continue;
#endif
            sum = i * ( ABS(T->numind) + TABLEEXTENSION );
            t = elementstring;
            for ( j = 0; j < ABS(T->numind); j++, sum++ ) {
                if ( j > 0 ) *t++ = ',';
                num = T->tablepointers[sum];
                t = NumCopy(num,t);
                if ( ( t - elementstring ) >= ELEMENTSIZE ) {
                    MesPrint("&Table element specification takes more than %ld characters and cannot be handled",
                        (MLONG)ELEMENTSIZE);
                    goto tableabort;
                }
            }
            if ( ExistsObject(d,basenumber,(char *)elementstring) ) { continue; }
/*
            We have the number in basenumber and the element in elementstring.
            Now we need the rhs. We can use the code from WriteDollarToBuffer.
            Main complication: in the table compiler buffer there can be
            brackets. The dollars do not have those......
*/
            AO.DollarInOutBuffer = 1;
            AO.PrintType = 1;
            ss = AO.DollarOutBuffer;
            *ss = 0;
            AO.OutInBuffer = 1;
#if ( TABLEEXTENSION == 2 )
            expr = cbuf[T->bufnum].rhs[T->tablepointers[sum]];
#else
            expr = cbuf[T->tablepointers[sum+1]].rhs[T->tablepointers[sum]];
#endif
            lbrac = 0; first = 0;
            while ( *expr ) {
                if ( WriteTerm(expr,&lbrac,first,PRINTON,0) ) {
                    error = 1; break;
                }
                expr += *expr;
            }
            AO.OutInBuffer = 0;
            AddObject(d,basenumber,(char *)elementstring,(char *)(AO.DollarOutBuffer));
          }
        }
        while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    }
    if ( WriteIniInfo(d) ) goto tableabort;
    M_free(AO.DollarOutBuffer,"DollarOutBuffer");
    AO.DollarOutBuffer = 0;
    AO.DollarOutSizeBuffer = 0;
    return(error);  
tableabort:;
    M_free(AO.DollarOutBuffer,"DollarOutBuffer");
    AO.DollarOutBuffer = 0;
    AO.DollarOutSizeBuffer = 0;
    AO.OutInBuffer = 0;
    return(1);
}
 
/*
    #] CoTBaddto : 
    #[ CoTBenter :
 
    Loads the elements of the tables specified into memory and sends them
    one by one to the compiler as Fill statements.
*/
 
int CoTBenter(UBYTE *s)
{
    DBASE *d;
    MLONG basenumber;
    UBYTE *arguments, *rhs, *buffer, *t, *u, c, *tablename;
    LONG size;
    int i, j, error = 0, error1 = 0, printall = 0;
    TABLES T = 0;
    WORD type, funnum;
    int dict = AO.CurrentDictionary;
    AO.CurrentDictionary = 0;
    if ( ( d = FindTB(tablebasename) ) == 0 ) {
        MesPrint("&No open tablebase with the name %s, check for existence of file or try readonly mode when opening.",tablebasename);
        error = -1;
        goto Endofall;
    }
    while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    if ( *s == '!' ) { printall = 1; s++; }
    while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    if ( *s ) {
      while ( *s ) {
        tablename = s;
        if ( ( s = SkipAName(s) ) == 0 ) { error = 1; goto Endofall; }
        c = *s; *s = 0;
        if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
            || ( T = functions[funnum].tabl ) == 0 ) {
            MesPrint("&%s should be a previously declared table",tablename);
            basenumber = 0;
        }
        else if ( T->sparse == 0 ) {
            MesPrint("&%s should be a sparse table",tablename);
            basenumber = 0;
        }
        else { basenumber = GetTableName(d,(char *)tablename); }
        if ( T->spare == 0 ) { SpareTable(T); }
        if ( basenumber > 0 ) {
            for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
                for ( j = 0; j < NUMOBJECTS; j++ ) {
                    if ( basenumber != d->iblocks[i]->objects[j].tablenumber )
                        continue;
                    arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
                    rhs = (UBYTE *)ReadObject(d,basenumber,(char *)arguments);
                    if ( printall ) {
                        if ( rhs ) {
                            MesPrint("%s(%s) = %s",tablename,arguments,rhs);
                        }
                        else {
                            MesPrint("%s(%s) = 0",tablename,arguments);
                        }
                    }
                    if ( rhs ) {
                        u = rhs; while ( *u ) u++;
                        size = u-rhs;
                        u = arguments; while ( *u ) u++;
                        size += u-arguments;
                        u = tablename; while ( *u ) u++;
                        size += u-tablename;
                        size += 6;
                        buffer  = (UBYTE *)Malloc1(size,"TableBase copy");
                        t = tablename; u = buffer;
                        while ( *t ) *u++ = *t++;
                        *u++ = '(';
                        t = arguments;
                        while ( *t ) *u++ = *t++;
                        *u++ = ')'; *u++ = '=';
                        t = rhs;
                        while ( *t ) *u++ = *t++;
                        if ( t == rhs ) *u++ = '0';
                        *u++ = 0; *u = 0;
                        M_free(rhs,"rhs in TBenter");
 
                        error1 = CoFill(buffer);
 
                        if ( error1 < 0 ) goto Endofall;
                        if ( error1 != 0 ) error = error1;
                        M_free(buffer,"TableBase copy");
                    }
                }
            }
        }
        *s = c;
        while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
      }
    }
    else {
      s = (UBYTE *)(d->tablenames); basenumber = 0;
      while ( *s ) {
        basenumber++;
        tablename = s; while ( *s ) s++; s++;
        while ( *s ) s++;
        s++;
        if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
            || ( T = functions[funnum].tabl ) == 0 ) {
            MesPrint("&%s should be a previously declared table",tablename);
        }
        else if ( T->sparse == 0 ) {
            MesPrint("&%s should be a sparse table",tablename);
        }
        if ( T->spare == 0 ) { SpareTable(T); }
        for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
            for ( j = 0; j < NUMOBJECTS; j++ ) {
                if ( d->iblocks[i]->objects[j].tablenumber == basenumber ) {
                    arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
                    rhs = (UBYTE *)ReadObject(d,basenumber,(char *)arguments);
                    if ( printall ) {
                        if ( rhs ) {
                            MesPrint("%s%s = %s",tablename,arguments,rhs);
                        }
                        else {
                            MesPrint("%s%s = 0",tablename,arguments);
                        }
                    }
                    if ( rhs ) {
                        u = rhs; while ( *u ) u++;
                        size = u-rhs;
                        u = arguments; while ( *u ) u++;
                        size += u-arguments;
                        u = tablename; while ( *u ) u++;
                        size += u-tablename;
                        size += 6;
                        buffer  = (UBYTE *)Malloc1(size,"TableBase copy");
                        t = tablename; u = buffer;
                        while ( *t ) *u++ = *t++;
                        *u++ = '(';
                        t = arguments;
                        while ( *t ) *u++ = *t++;
                        *u++ = ')'; *u++ = '=';
                        t = rhs;
                        while ( *t ) *u++ = *t++;
                        if ( t == rhs ) *u++ = '0';
                        *u++ = 0; *u = 0;
                        M_free(rhs,"rhs in TBenter");
 
                        error1 = CoFill(buffer);
 
                        if ( error1 < 0 ) goto Endofall;
                        if ( error1 != 0 ) error = error1;
                        M_free(buffer,"TableBase copy");
                    }
                }
            }
        }
      }
    }
Endofall:;
    AO.CurrentDictionary = dict;
    return(error);
}
 
/*
    #] CoTBenter : 
    #[ CoTestUse :
 
    Possibly to be followed by names of tables.
    We make an array of TABLES structs to be tested in AC.usedtables.
    Note: only sparse tables are allowed.
    No arguments means all tables.
*/
 
int CoTestUse(UBYTE *s)
{
    GETIDENTITY
    UBYTE *tablename, c;
    WORD type, funnum, *w;
    TABLES T;
    int error = 0;
    w = AT.WorkPointer;
    *w++ = TYPETESTUSE; *w++ = 2;
    while ( *s ) {
        tablename = s;
        if ( ( s = SkipAName(s) ) == 0 ) return(1);
        c = *s; *s = 0;
        if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
            || ( T = functions[funnum].tabl ) == 0 ) {
            MesPrint("&%s should be a previously declared table",tablename);
            error = 1;
        }
        else if ( T->sparse == 0 ) {
            MesPrint("&%s should be a sparse table",tablename);
            error = 1;
        }
        *w++ = funnum + FUNCTION;
        *s = c;
        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
    }
    AT.WorkPointer[1] = w - AT.WorkPointer;
/*
    if ( AT.WorkPointer[1] > 2 ) {
        AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
    }
*/
    AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
    return(error);
}
 
/*
    #] CoTestUse : 
    #[ CheckTableDeclarations :
 
        Checks that all tables in a tablebase  have identical properties to
        possible previous declarations. If they have not been declared
        before, they are declared here.
*/
 
int CheckTableDeclarations(DBASE *d)
{
    WORD type, funnum;
    UBYTE *s, *ss, *t, *command = 0;
    int k, error = 0, error1, i;
    TABLES T;
    LONG commandsize = 0;
 
    s = (UBYTE *)(d->tablenames);
    for ( k = 0; k < d->topnumber; k++ ) {
        if ( GetVar(s,&type,&funnum,ANYTYPE,NOAUTO) == NAMENOTFOUND ) {
/*
            We have to declare the table
*/
            ss = s; i = 0; while ( *ss ) { ss++; i++; } /* name */
            ss++; while ( *ss ) { ss++; i++; } /* tail */
            if ( commandsize == 0 ) {
                commandsize = i + 15;
                if ( commandsize < 100 ) commandsize = 100;
            }
            if ( (i+11) > commandsize ) {
                if ( command ) { M_free(command,"table command"); command = 0; }
                commandsize = i+10;
            }
            if ( command == 0 ) {
                command = (UBYTE *)Malloc1(commandsize,"table command");
            }
            t = command; ss = tablebase; while ( *ss ) *t++ = *ss++;
            *t++ = ','; while ( *s ) *t++ = *s++;
            s++; while ( *s ) *t++ = *s++;
            *t++ = ')'; *t = 0; s++;
            error1 = DoTable(command,1);
            if ( error1 ) error = error1;
        }
        else if ( ( type != CFUNCTION )
             || ( ( T = functions[funnum].tabl ) == 0 )
             || ( T->sparse == 0 ) ) {
            MesPrint("&%s has been declared previously, but not as a sparse table.",s);
            error = 1;
            while ( *s ) s++;
            s++;
            while ( *s ) s++;
            s++;
        }
        else {
/*
            Test dimension and argtail. There should be an exact match.
            We are not going to rename arguments when reading the elements.
*/
            ss = s;
            while ( *s ) s++;
            s++;
            if ( StrCmp(s,T->argtail) ) {
                MesPrint("&Declaration of table %s in %s different from previous declaration",ss,d->name);
                error = 1;
            }
            while ( *s ) s++;
            s++;
        }
    }
    if ( command ) { M_free(command,"table command"); }
    return(error);
}
 
/*
    #] CheckTableDeclarations : 
    #[ CoTBload :
 
        Loads the table stubbs of the specified tables in the indicated
        tablebase. Syntax:
        TableBase "tablebasename.tbl" load [tablename(s)];
        If no tables are specified all tables are taken.
*/
 
int CoTBload(UBYTE *ss)
{
    DBASE *d;
    UBYTE *s, *name, *t, *r, *command, *arguments, *tail;
    LONG commandsize;
    int num, cs, es, ns, ts, i, j, error = 0, error1;
    if ( ( d = FindTB(tablebasename) ) == 0 ) {
        MesPrint("&No open tablebase with the name %s",tablebasename);
        return(-1);
    }
    commandsize = 120;
    command = (UBYTE *)Malloc1(commandsize,"Fill command");
    AC.vetofilling = 1;
    if ( *ss ) {
      while ( *ss == ',' || *ss == ' ' || *ss == '\t' ) ss++;
      while ( *ss ) {
        name = ss; ss = SkipAName(ss); *ss = 0;
        s = (UBYTE *)(d->tablenames);
        num = 0; ns = 0;
        while ( *s ) {
            num++;
            if ( StrCmp(s,name) ) {
                while ( *s ) s++;
                s++; 
                while ( *s ) s++;
                s++;
                num++;
                continue;
            }
            name = s; while ( *s ) s++; ns = s-name; s++;
            tail = s; while ( *s ) s++; ts = s-tail; s++;
            tail++; while ( FG.cTable[*tail] == 1 ) tail++;
/*
            Go through all elements
*/
            for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
                for ( j = 0; j < NUMOBJECTS; j++ ) {
                    if ( d->iblocks[i]->objects[j].tablenumber == num ) {
                        t = arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
                        while ( *t ) t++;
                        es = t - arguments;
                        cs = 2*es + 2*ns + ts + 10;
                        if ( cs > commandsize ) {
                            commandsize = 2*cs;
                            if ( command ) M_free(command,"Fill command");
                            command = (UBYTE *)Malloc1(commandsize,"Fill command");
                        }
                        r = command; t = name; while ( *t ) *r++ = *t++;
                        *r++ = '('; t = arguments; while ( *t ) *r++ = *t++;
                        *r++ = ')'; *r++ = '='; *r++ = 't'; *r++ = 'b'; *r++ = 'l';
                        *r++ = '_'; *r++ = '('; t = name; while ( *t ) *r++ = *t++;
                        *r++ = ','; t = arguments; while ( *t ) *r++ = *t++;
                        t = tail; while ( *t ) {
                            if ( *t == '?' && r[-1] != ',' ) {
                                t++;
                                if ( FG.cTable[*t] == 0 || *t == '$' || *t == '[' ) {
                                    t = SkipAName(t);
                                    if ( *t == '[' ) {
                                        SKIPBRA1(t);
                                    }
                                }
                                else if ( *t == '{' ) {
                                    SKIPBRA2(t);
                                }
                                else if ( *t ) { *r++ = *t++; continue; }
                            }
                            else *r++ = *t++;
                        }
                        *r++ = ')'; *r = 0;
/*
                        Still to do: replacemode or no replacemode?
*/
                        AC.vetotablebasefill = 1;
                        error1 = CoFill(command);
                        AC.vetotablebasefill = 0;
                        if ( error1 < 0 ) goto finishup;
                        if ( error1 != 0 ) error = error1;
                    }
                }
            }
            break;
        }
        while ( *ss == ',' || *ss == ' ' || *ss == '\t' ) ss++;
      }
    }
    else {  /* do all of them */
        s = (UBYTE *)(d->tablenames);
        num = 0; ns = 0;
        while ( *s ) {
            num++;
            name = s; while ( *s ) s++; ns = s-name; s++;
            tail = s; while ( *s ) s++; ts = s-tail; s++;
            tail++; while ( FG.cTable[*tail] == 1 ) tail++;
/*
            Go through all elements
*/
            for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
                for ( j = 0; j < NUMOBJECTS; j++ ) {
                    if ( d->iblocks[i]->objects[j].tablenumber == num ) {
                        t = arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
                        while ( *t ) t++;
                        es = t - arguments;
                        cs = 2*es + 2*ns + ts + 10;
                        if ( cs > commandsize ) {
                            commandsize = 2*cs;
                            if ( command ) M_free(command,"Fill command");
                            command = (UBYTE *)Malloc1(commandsize,"Fill command");
                        }
                        r = command; t = name; while ( *t ) *r++ = *t++;
                        *r++ = '('; t = arguments; while ( *t ) *r++ = *t++;
                        *r++ = ')'; *r++ = '='; *r++ = 't'; *r++ = 'b'; *r++ = 'l';
                        *r++ = '_'; *r++ = '('; t = name; while ( *t ) *r++ = *t++;
                        *r++ = ','; t = arguments; while ( *t ) *r++ = *t++;
                        t = tail; while ( *t ) {
                            if ( *t == '?' && r[-1] != ',' ) {
                                t++;
                                if ( FG.cTable[*t] == 0 || *t == '$' || *t == '[' ) {
                                    t = SkipAName(t);
                                    if ( *t == '[' ) {
                                        SKIPBRA1(t);
                                    }
                                }
                                else if ( *t == '{' ) {
                                    SKIPBRA2(t);
                                }
                                else if ( *t ) { *r++ = *t++; continue; }
                            }
                            else *r++ = *t++;
                        }
                        *r++ = ')'; *r = 0;
/*
                        Still to do: replacemode or no replacemode?
*/
                        AC.vetotablebasefill = 1;
                        error1 = CoFill(command);
                        AC.vetotablebasefill = 0;
                        if ( error1 < 0 ) goto finishup;
                        if ( error1 != 0 ) error = error1;
                    }
                }
            }
        }
    }
finishup:;
    AC.vetofilling = 0;
    if ( command ) M_free(command,"Fill command");
    return(error);
}
 
/*
    #] CoTBload : 
    #[ TestUse :
 
    Look for tbl_(tablename,arguments)
    if tablename is encountered, check first whether the element is in
    use already. If not, check in the tables in AC.usedtables.
    If the element is not there, add it to AC.usedtables.
 
 
    We need the arguments of TestUse to see for which tables it is to be done
*/
 
int TestUse(WORD *term, WORD level)
{
    WORD *tstop, *t, *m, *tstart, tabnum;
    WORD *funs, numfuns;
    int error = 0;
    TABLES T;
    LONG i;
    CBUF *C = cbuf+AM.rbufnum;
    int isp;
 
    numfuns = C->lhs[level][1] - 2;
    funs = C->lhs[level] + 2;
    GETSTOP(term,tstop);
    t = term+1;
    while ( t < tstop ) {
        if ( *t != TABLESTUB ) { t += t[1]; continue; }
        tstart = t;
        m = t + FUNHEAD;
        t += t[1];
        if ( *m >= -FUNCTION ) continue;
        tabnum = -*m;
        if ( ( T = functions[tabnum-FUNCTION].tabl ) == 0 ) continue;
        if ( T->sparse == 0 ) continue;
/*
        Check whether we have to test this one
*/
        if ( numfuns > 0 ) {
            for ( i = 0; i < numfuns; i++ ) {
                if ( tabnum == funs[i] ) break;
            }
            if ( i >= numfuns && numfuns > 0 ) continue;
        }
/*
        Test whether the element has been defined already.
            If not, mark it as used.
        Note: we only allow sparse tables (for now)
*/
        m++;
        for ( i = 0; i < ABS(T->numind); i++, m += 2 ) {
            if ( m >= t || *m != -SNUMBER ) break;
        }
        if ( ( i == ABS(T->numind) ) &&
         ( ( isp = FindTableTree(T,tstart+FUNHEAD+1,2) ) >= 0 ) ) {
            if ( ( T->tablepointers[isp+ABS(T->numind)+4] & ELEMENTLOADED ) == 0 ) {
                    T->tablepointers[isp+ABS(T->numind)+4] |= ELEMENTUSED;
            }
        }
        else {
            MesPrint("TestUse: Encountered a table element inside tbl_ that does not correspond to a tablebase element");
            error = -1;
        }
    }
    return(error);
}
 
/*
    #] TestUse : 
    #[ CoTBaudit :
*/
 
int CoTBaudit(UBYTE *s)
{
    DBASE *d;
    UBYTE *name, *tail;
    int i, j, error = 0, num;
 
    if ( ( d = FindTB(tablebasename) ) == 0 ) {
        MesPrint("&No open tablebase with the name %s",tablebasename);
        return(-1);
    }
    while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    while ( *s ) {
/*
        Get the options here
        They will mainly involve the sorting of the output.
*/
        s++;
    }
    s = (UBYTE *)(d->tablenames); num = 0;
    while ( *s ) {
        num++;
        name = s; while ( *s ) s++; s++;
        tail = s; while ( *s ) s++; s++;
        MesPrint("Table,sparse,%s%s)",name,tail);
        for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
            for ( j = 0; j < NUMOBJECTS; j++ ) {
                if ( d->iblocks[i]->objects[j].tablenumber == num ) {
                    MesPrint("    %s(%s)",name,d->iblocks[i]->objects[j].element);
                }
            }
        }
    }
    return(error);
}
 
/*
    #] CoTBaudit : 
    #[ CoTBon :
*/
 
int CoTBon(UBYTE *s)
{
    DBASE *d;
    UBYTE *ss, c;
    int error = 0;
    if ( ( d = FindTB(tablebasename) ) == 0 ) {
        MesPrint("&No open tablebase with the name %s",tablebasename);
        return(-1);
    }
    while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    while ( *s ) {
        ss = SkipAName(s);
        c = *ss; *ss = 0;
        if ( StrICmp(s,(UBYTE *)("compress")) == 0 ) {
            d->mode &= ~NOCOMPRESS;
        }
        else {
            MesPrint("&subkey %s not defined in TableBase On statement");
            error = 1;
        }
        *ss = c; s = ss;
        while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    }
    return(error);
}
 
/*
    #] CoTBon : 
    #[ CoTBoff :
*/
 
int CoTBoff(UBYTE *s)
{
    DBASE *d;
    UBYTE *ss, c;
    int error = 0;
    if ( ( d = FindTB(tablebasename) ) == 0 ) {
        MesPrint("&No open tablebase with the name %s",tablebasename);
        return(-1);
    }
    while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    while ( *s ) {
        ss = SkipAName(s);
        c = *ss; *ss = 0;
        if ( StrICmp(s,(UBYTE *)("compress")) == 0 ) {
            d->mode |= NOCOMPRESS;
        }
        else {
            MesPrint("&subkey %s not defined in TableBase Off statement");
            error = 1;
        }
        *ss = c; s = ss;
        while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    }
    return(error);
}
 
/*
    #] CoTBoff : 
    #[ CoTBcleanup :
*/
 
int CoTBcleanup(UBYTE *s)
{
    DUMMYUSE(s);
    MesPrint("&TableBase Cleanup statement not yet implemented");
    return(1);
}
 
/*
    #] CoTBcleanup : 
    #[ CoTBreplace :
*/
 
int CoTBreplace(UBYTE *s)
{
    DUMMYUSE(s);
    MesPrint("&TableBase Replace statement not yet implemented");
    return(1);
}
 
/*
    #] CoTBreplace : 
    #[ CoTBuse :
 
    Here the actual table use as determined in TestUse causes the needed
    table elements to be loaded
*/
 
int CoTBuse(UBYTE *s)
{
    GETIDENTITY
    DBASE *d;
    MLONG basenumber;
    UBYTE *arguments, *rhs, *buffer, *t, *u, c, *tablename, *p;
    LONG size, sum, x;
    int i, j, error = 0, error1 = 0, k;
    TABLES T = 0;
    WORD type, funnum, mode, *w;
    if ( ( d = FindTB(tablebasename) ) == 0 ) {
        MesPrint("&No open tablebase with the name %s",tablebasename);
        return(-1);
    }
    while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
    if ( *s ) {
      while ( *s ) {
        tablename = s;
        if ( ( s = SkipAName(s) ) == 0 ) return(1);
        c = *s; *s = 0;
        if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
            || ( T = functions[funnum].tabl ) == 0 ) {
            MesPrint("&%s should be a previously declared table",tablename);
            basenumber = 0;
        }
        else if ( T->sparse == 0 ) {
            MesPrint("&%s should be a sparse table",tablename);
            basenumber = 0;
        }
        else { basenumber = GetTableName(d,(char *)tablename); }
/*      if ( T->spare == 0 ) { SpareTable(T); } */
        if ( basenumber > 0 ) {
            for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
                for ( j = 0; j < NUMOBJECTS; j++ ) {
                    if ( d->iblocks[i]->objects[j].tablenumber != basenumber ) continue;
                    arguments = p = (UBYTE *)(d->iblocks[i]->objects[j].element);
/*
                    Now translate the arguments and see whether we need
                    this one....
*/
                    for ( k = 0, w = AT.WorkPointer; k < ABS(T->numind); k++ ) {
                        ParseSignedNumber(x,p);
                        *w++ = x; p++;
                    }
                    sum = FindTableTree(T,AT.WorkPointer,1);
                    if ( sum < 0 ) {
                        MesPrint("Table %s in tablebase %s has not been loaded properly"
                                ,tablename,tablebasename);
                        error = 1;
                        continue;
                    }
                    sum += ABS(T->numind) + 4;
                    mode = T->tablepointers[sum];
                    if ( ( mode & ELEMENTLOADED ) == ELEMENTLOADED ) {
                        T->tablepointers[sum] &= ~ELEMENTUSED;
                        continue;
                    }
                    if ( ( mode & ELEMENTUSED ) == 0 ) continue;
/*
                    We need this one!
*/
                    rhs = (UBYTE *)ReadijObject(d,i,j,(char *)arguments);
                    if ( rhs ) {
                        u = rhs; while ( *u ) u++;
                        size = u-rhs;
                        u = arguments; while ( *u ) u++;
                        size += u-arguments;
                        u = tablename; while ( *u ) u++;
                        size += u-tablename;
                        size += 6;
                        buffer  = (UBYTE *)Malloc1(size,"TableBase copy");
                        t = tablename; u = buffer;
                        while ( *t ) *u++ = *t++;
                        *u++ = '(';
                        t = arguments;
                        while ( *t ) *u++ = *t++;
                        *u++ = ')'; *u++ = '=';
                        t = rhs;
                        while ( *t ) *u++ = *t++;
                        if ( t == rhs ) { *u++ = '0'; }
                        *u++ = 0; *u = 0;
                        M_free(rhs,"rhs in TBuse xxx");
 
                        error1 = CoFill(buffer);
 
                        if ( error1 < 0 ) { return(error); }
                        if ( error1 != 0 ) error = error1;
                        M_free(buffer,"TableBase copy");
                    }
                    T->tablepointers[sum] &= ~ELEMENTUSED;
                    T->tablepointers[sum] |= ELEMENTLOADED;
                }
            }
        }
        *s = c;
        while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
      }
    }
    else {
      s = (UBYTE *)(d->tablenames); basenumber = 0;
      while ( *s ) {
        basenumber++;
        tablename = s;
        while ( *s ) s++;
        s++;
        while ( *s ) s++;
        s++;
        if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
            || ( T = functions[funnum].tabl ) == 0 ) {
            MesPrint("&%s should be a previously declared table",tablename);
        }
        else if ( T->sparse == 0 ) {
            MesPrint("&%s should be a sparse table",tablename);
        }
    if ( T->spare && T->mode == 0 ) {
        MesPrint("In table %s we have a problem with stubb orders in CoTBuse",tablename);
        error = -1;
    }
/*      if ( T->spare == 0 ) { SpareTable(T); } */
        for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
            for ( j = 0; j < NUMOBJECTS; j++ ) {
                if ( d->iblocks[i]->objects[j].tablenumber == basenumber ) {
                    arguments = p = (UBYTE *)(d->iblocks[i]->objects[j].element);
/*
                    Now translate the arguments and see whether we need
                    this one....
*/
                    for ( k = 0, w = AT.WorkPointer; k < ABS(T->numind); k++ ) {
                        ParseSignedNumber(x,p);
                        *w++ = x; p++;
                    }
                    sum = FindTableTree(T,AT.WorkPointer,1);
                    if ( sum < 0 ) {
                        MesPrint("Table %s in tablebase %s has not been loaded properly"
                                ,tablename,tablebasename);
                        error = 1;
                        continue;
                    }
                    sum += ABS(T->numind) + 4;
                    mode = T->tablepointers[sum];
                    if ( ( mode & ELEMENTLOADED ) == ELEMENTLOADED ) {
                        T->tablepointers[sum] &= ~ELEMENTUSED;
                        continue;
                    }
                    if ( ( mode & ELEMENTUSED ) == 0 ) continue;
/*
                    We need this one!
*/
                    rhs = (UBYTE *)ReadijObject(d,i,j,(char *)arguments);
                    if ( rhs ) {
                        u = rhs; while ( *u ) u++;
                        size = u-rhs;
                        u = arguments; while ( *u ) u++;
                        size += u-arguments;
                        u = tablename; while ( *u ) u++;
                        size += u-tablename;
                        size += 6;
                        buffer  = (UBYTE *)Malloc1(size,"TableBase copy");
                        t = tablename; u = buffer;
                        while ( *t ) *u++ = *t++;
                        *u++ = '(';
                        t = arguments;
                        while ( *t ) *u++ = *t++;
                        *u++ = ')'; *u++ = '=';
 
                        t = rhs;
                        while ( *t ) *u++ = *t++;
                        if ( t == rhs ) { *u++ = '0'; }
                        *u++ = 0; *u = 0;
                        M_free(rhs,"rhs in TBuse");
 
                        error1 = CoFill(buffer);
 
                        if ( error1 < 0 ) { return(error); }
                        if ( error1 != 0 ) error = error1;
                        M_free(buffer,"TableBase copy");
                    }
                    T->tablepointers[sum] &= ~ELEMENTUSED;
                    T->tablepointers[sum] |= ELEMENTLOADED;
                }
            }
        }
      }
    }
    return(error);
}
 
/*
    #] CoTBuse : 
    #[ CoApply :
 
    Possibly to be followed by names of tables.
*/
 
int CoApply(UBYTE *s)
{
    GETIDENTITY
    UBYTE *tablename, c;
    WORD type, funnum, *w;
    TABLES T;
    LONG maxtogo = MAXPOSITIVE;
    int error = 0;
    w = AT.WorkPointer;
    if ( FG.cTable[*s] == 1 ) {
        maxtogo = 0;
        while ( FG.cTable[*s] == 1 ) {
            maxtogo = maxtogo*10 + (*s-'0');
            s++;
        }
        while ( *s == ',' ) s++;
        if ( maxtogo > MAXPOSITIVE || maxtogo < 0 ) maxtogo = MAXPOSITIVE;
    }
    *w++ = TYPEAPPLY; *w++ = 3; *w++ = maxtogo;
    while ( *s ) {
        tablename = s;
        if ( ( s = SkipAName(s) ) == 0 ) return(1);
        c = *s; *s = 0;
        if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
            || ( T = functions[funnum].tabl ) == 0 ) {
            MesPrint("&%s should be a previously declared table",tablename);
            error = 1;
        }
        else if ( T->sparse == 0 ) {
            MesPrint("&%s should be a sparse table",tablename);
            error = 1;
        }
        *w++ = funnum + FUNCTION;
        *s = c;
        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
    }
    AT.WorkPointer[1] = w - AT.WorkPointer;
/*
    if ( AT.WorkPointer[1] > 2 ) {
        AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
    }
*/
    AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
/*
    AT.WorkPointer[0] = TYPEAPPLYRESET;
    AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
*/
    return(error);
}
 
/*
    #] CoApply : 
    #[ CoTBhelp :
*/
 
char *helptb[] = {
     "The TableBase statement is used as follows:"
    ,"TableBase \"file.tbl\" keyword subkey(s)"
    ,"    in which we have"
    ,"Keyword   Subkey(s)   Action"
    ,"open                 Opens file.tbl for R/W"
    ,"create               Creates file.tbl for R/W. Old contents are lost"
    ,"load                 Loads all stubs of all tables"
    ,"load    tablename(s) Loads all stubs the tables mentioned"
    ,"enter                Loads all stubs and rhs of all tables"
    ,"enter   tablename(s) Loads all stubs and rhs of the tables mentioned"
    ,"audit                Prints list of contents"
/*  ,"replace tablename    saves a table (with overwrite)" */
/*  ,"replace tableelement saves a table element (with overwrite)" */
/*  ,"cleanup              makes tables contingent" */
    ,"addto   tablename    adds all elements if not yet there"
    ,"addto   tableelement adds element if not yet there"
/*  ,"delete  tablename    removes table from tablebase" */
/*  ,"delete  tableelement removes element from tablebase" */
    ,"on      compress     elements are stored in gzip format (default)"
    ,"off     compress     elements are stored in uncompressed format"
    ,"use                  compiles all needed elements"
    ,"use     tablename(s) compiles all needed elements of these tables"
    ,""
    ,"Related commands are:"
    ,"testuse              marks which tbl_ elements occur for all tables"
    ,"testuse tablename(s) marks which tbl_ elements occur for given tables"
    ,"apply                replaces tbl_ if rhs available"
    ,"apply   tablename(s) replaces tbl_ for given tables if rhs available"
    ,""
        };
 
int CoTBhelp(UBYTE *s)
{
    int i, ii = sizeof(helptb)/sizeof(char *);
    DUMMYUSE(s);
    for ( i = 0; i < ii; i++ ) MesPrint("%s",helptb[i]);
    return(0);
}
 
/*
    #] CoTBhelp : 
    #[ ReWorkT :
 
    Replaces the STUBBS of the functions in the list.
    This gains one space. Hence we have to be very careful
*/
 
void ReWorkT(WORD *term, WORD *funs, WORD numfuns)
{
    WORD *tstop, *tend, *m, *t, *tt, *mm, *mmm, *r, *rr;
    int i, j;
    tend = term + *term; tstop = tend - ABS(tend[-1]);
    m = t = term+1;
    while ( t < tstop ) {
        if ( *t == TABLESTUB ) {
            for ( i = 0; i < numfuns; i++ ) {
                if ( -t[FUNHEAD] == funs[i] ) break;
            }
            if ( numfuns == 0 || i < numfuns ) { /* Hit */
                i = t[1] - 1;
                *m++ = -t[FUNHEAD]; *m++ = i; t += 2; i -= FUNHEAD;
                if ( m < t ) { for ( j = 0; j < FUNHEAD-2; j++ ) *m++ = *t++; }
                else { m += FUNHEAD-2; t += FUNHEAD-2; }
                t++;
                while ( i-- > 0 ) { *m++ = *t++; }
                tt = t; mm = m;
                if ( mm < tt ) {
                    while ( tt < tend ) *mm++ = *tt++;
                    *term = mm - term;
                    tend = term + *term; tstop = tend - ABS(tend[-1]);
                    t = m;
                }
            }
            else { goto inc; }
        }
        else if ( *t >= FUNCTION ) {
            tt = t + t[1];
            mm = m;
            for ( j = 0; j < FUNHEAD; j++ ) {
                if ( m == t ) { m++; t++; }
                else *m++ = *t++;
            }
            while ( t < tt ) {
                if ( *t <= -FUNCTION ) {
                    if ( m == t ) { m++; t++; }
                    else *m++ = *t++;
                }
                else if ( *t < 0 ) {
                    if ( m == t ) { m += 2; t += 2; }
                    else { *m++ = *t++; *m++ = *t++; }
                }
                else {
                    rr = t + *t; mmm = m;
                    for ( j = 0; j < ARGHEAD; j++ ) {
                        if ( m == t ) { m++; t++; }
                        else *m++ = *t++;
                    }
                    while ( t < rr ) {
                        r = t + *t;
                        ReWorkT(t,funs,numfuns);
                        j = *t;
                        if ( m == t ) { m += j; t += j; }
                        else { while ( j-- >= 0 ) *m++ = *t++; }
                        t = r;
                    }
                    *mmm = m-mmm;
                }
            }
            mm[1] = m - mm;
            t = tt;
        }
        else {
inc:        j = t[1];
            if ( m < t ) { while ( j-- >= 0 ) *m++ = *t++; }
            else { m += j; t += j; }
        }
    }
    if ( m < t ) {
        while ( t < tend ) *m++ = *t++;
        *term = m - term;
    }
}
 
/*
    #] ReWorkT : 
    #[ Apply :
*/
 
void Apply(WORD *term, WORD level)
{
    WORD *funs, numfuns;
    TABLES T;
    int i, j;
    CBUF *C = cbuf+AM.rbufnum;
/*
    Point the tables in the proper direction
*/
    numfuns = C->lhs[level][1] - 2;
    funs = C->lhs[level] + 2;
    if ( numfuns > 0 ) {
        for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
            if ( ( T = functions[i].tabl ) != 0 ) {
                for ( j = 0; j < numfuns; j++ ) {
                    if ( i == (funs[j]-FUNCTION) && T->spare ) {
                        FlipTable(&(functions[i]),0);
                        break;
                    }
                }
            }
        }
    }
    else {
        for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
            if ( ( T = functions[i].tabl ) != 0 ) {
                if ( T->spare ) FlipTable(&(functions[i]),0);
            }
        }
    }
/*
    Now the replacements everywhere of
        id tbl_(table,?a) = table(?a);
    Actually, this has to be done recursively.
    Note that we actually gain one space. 
*/
    ReWorkT(term,funs,numfuns);
}
 
/*
    #] Apply : 
    #[ ApplyExec :
 
    Replaces occurrences of tbl_(table,indices,pattern) by the proper
    rhs of table(indices,pattern). It does this up to maxtogo times
    in the given term. It starts with the occurrences inside the
    arguments of functions. If necessary it finishes at groundlevel.
    An infinite number of tries is indicated by maxtogo = 2^15-1 or 2^31-1.
    The occurrences are replaced by subexpressions. This allows TestSub
    to finish the job properly.
 
    The main trick here is T = T->spare which turns to the proper rhs.
 
    The return value is the number of substitutions that can still be made
    based on maxtogo. Hence, if the returnvalue is different from maxtogo
    there was a substitution.
*/
 
int ApplyExec(WORD *term, int maxtogo, WORD level)
{
    GETIDENTITY
    WORD rhsnumber, *Tpattern, *funs, numfuns, funnum;
    WORD ii, *t, *t1, *w, *p, *m, *m1, *u, *r, tbufnum, csize, wilds;
    NESTING NN;
    int i, j, isp, stilltogo;
    CBUF *C;
    TABLES T;
/*
    Startup. We need NestPoin for when we have to replace something deep down.
*/
    t = term;
    m = t + *t;
    csize = ABS(m[-1]);
    m -= csize;
    AT.NestPoin->termsize = t;
    if ( AT.NestPoin == AT.Nest ) AN.EndNest = t + *t;
    t++;
/*
    First we look inside function arguments. Also when clean!
*/
    while ( t < m ) {
        if ( *t < FUNCTION ) { t += t[1]; continue; }
        if ( functions[*t-FUNCTION].spec > 0 ) { t += t[1]; continue; }
        AT.NestPoin->funsize = t;
        r = t + t[1];
        t += FUNHEAD;
        while ( t < r ) {
            if ( *t < 0 ) { NEXTARG(t); continue; }
            AT.NestPoin->argsize = t1 = t;
            u = t + *t;
            t += ARGHEAD;
            AT.NestPoin++;
            while ( t < u ) {
/*
                Now we loop over the terms inside a function argument
                This defines a recursion and we have to call ApplyExec again.
                The real problem is when we catch something and we have
                to insert a subexpression pointer. This may use more or
                less space and the whole term has to be readjusted.
                This is why we have the NestPoin variables. They tell us
                where the sizes of the term, the function and the arguments
                are sitting, and also where the dirty flags are.
                This readjusting is of course done in the groundlevel code.
                Here we worry abound the maxtogo count.
*/
                stilltogo = ApplyExec(t,maxtogo,level);
                if ( stilltogo != maxtogo ) {
                    if ( stilltogo <= 0 ) {
                        AT.NestPoin--;
                        return(stilltogo);
                    }
                    maxtogo = stilltogo;
                    u = t1 + *t1;
                    m = term + *term - csize;
                }
                t += *t;
            }
            AT.NestPoin--;
        }
    }
/*
    Now we look at the ground level
*/
    C = cbuf+AM.rbufnum;
    t = term + 1;
    while ( t < m ) {
        if ( *t != TABLESTUB ) { t += t[1]; continue; }
        funnum = -t[FUNHEAD];
        if ( ( funnum < FUNCTION )
          || ( funnum >= FUNCTION+WILDOFFSET )
          || ( ( T = functions[funnum-FUNCTION].tabl ) == 0 )
          || ( T->sparse == 0 )
          || ( T->spare == 0 ) ) { t += t[1]; continue; }
        numfuns = C->lhs[level][1] - 3;
        funs = C->lhs[level] + 3;
        if ( numfuns > 0 ) {
            for ( i = 0; i < numfuns; i++ ) {
                if ( funs[i] == funnum ) break;
            }
            if ( i >= numfuns ) { t += t[1]; continue; }
        }
        r = t + t[1];
        AT.NestPoin->funsize = t + 1;
        t1 = t;
        t += FUNHEAD + 1;
/*
        Test whether the table catches
        Test 1: index arguments and range. isp will be the number
            of the element in the table.
*/
        T = T->spare;
#ifdef WITHPTHREADS
        Tpattern = T->pattern[identity];
#else
        Tpattern = T->pattern;
#endif
        p = Tpattern+FUNHEAD+1;
        for ( i = 0; i < ABS(T->numind); i++, t += 2 ) {
            if ( *t != -SNUMBER ) break;
        }
        if ( i < ABS(T->numind) ) { t = r; continue; }
        isp = FindTableTree(T,t1+FUNHEAD+1,2);
        if ( isp < 0 ) { t = r; continue; }
        rhsnumber = T->tablepointers[isp+ABS(T->numind)];
#if ( TABLEEXTENSION == 2 )
        tbufnum = T->bufnum;
#else
        tbufnum = T->tablepointers[isp+ABS(T->numind)+1];
#endif
        t = t1+FUNHEAD+2;
        ii = ABS(T->numind);
        while ( --ii >= 0 ) {
            *p = *t; t += 2; p += 2;
        }
/*
        If there are more arguments we have to do some
        pattern matching. This should be easy. We adapted the
        pattern, so that the array indices match already.
*/
#ifdef WITHPTHREADS
        AN.FullProto = T->prototype[identity];
#else
        AN.FullProto = T->prototype;
#endif
        AN.WildValue = AN.FullProto + SUBEXPSIZE;
        AN.WildStop = AN.FullProto+AN.FullProto[1];
        ClearWild(BHEAD0);
        AN.RepFunNum = 0;
        AN.RepFunList = AN.EndNest;
        AT.WorkPointer = (WORD *)(((UBYTE *)(AN.EndNest)) + AM.MaxTer/2);
/*
        The RepFunList is after the term but not very relevant.
        We need because MatchFunction uses it
*/
        if ( AT.WorkPointer + t1[1] >= AT.WorkTop ) { MesWork(); }
        wilds = 0;
        w = AT.WorkPointer;
        *w++ = -t1[FUNHEAD];
        *w++ = t1[1] - 1;
        for ( i = 2; i < FUNHEAD; i++ ) *w++ = t1[i];
        t = t1 + FUNHEAD+1;
        while ( t < r ) *w++ = *t++;
        t = AT.WorkPointer;
        AT.WorkPointer = w;
        if ( MatchFunction(BHEAD Tpattern,t,&wilds) > 0 ) {
/*
            Here we caught one. Now we should worry about:
            1: inserting the subexpression pointer with its wildcards
            2: NestPoin because we may not be at the lowest level
            The function starts at t1.
*/
#ifdef WITHPTHREADS
            m1 = T->prototype[identity];
#else
            m1 = T->prototype;
#endif
            m1[2] = rhsnumber;
            m1[4] = tbufnum;
            t = t1;
            j = t[1];
            i = m1[1];
            if ( j > i ) {
                j = i - j;
                NCOPY(t,m1,i);
                m1 = AN.EndNest;
                while ( r < m1 ) *t++ = *r++;
                AN.EndNest = t;
                *term += j;
                NN = AT.NestPoin;
                while ( NN > AT.Nest ) {
                    NN--;
                    NN->termsize[0] += j;
                    NN->funsize[1] += j;
                    NN->argsize[0] += j;
                    NN->funsize[2] |= DIRTYFLAG;
                    NN->argsize[1] |= DIRTYFLAG;
                }
                m += j;
            }
            else if ( j < i ) {
                j = i-j;
                t = AN.EndNest;
                while ( t >= r ) { t[j] = *t; t--; }
                t = t1;
                NCOPY(t,m1,i);
                AN.EndNest += j;
                *term += j;
                NN = AT.NestPoin;
                while ( NN > AT.Nest ) {
                    NN--;
                    NN->termsize[0] += j;
                    NN->funsize[1] += j;
                    NN->argsize[0] += j;
                    NN->funsize[2] |= DIRTYFLAG;
                    NN->argsize[1] |= DIRTYFLAG;
                }
                m += j;
            }
            else {
                NCOPY(t,m1,j);
            }
            r = t1 + t1[1];
            maxtogo--;
            if ( maxtogo <= 0 ) return(maxtogo);
        }
        t = r;
    }
    return(maxtogo);
}
 
/*
    #] ApplyExec : 
    #[ ApplyReset :
*/
 
void ApplyReset(WORD level)
{
    WORD *funs, numfuns;
    TABLES T;
    int i, j;
    CBUF *C = cbuf+AM.rbufnum;
 
    numfuns = C->lhs[level][1] - 2;
    funs = C->lhs[level] + 2;
    if ( numfuns > 0 ) {
        for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
            if ( ( T = functions[i].tabl ) != 0 ) {
                for ( j = 0; j < numfuns; j++ ) {
                    if ( i == (funs[j]-FUNCTION) && T->spare ) {
                        FlipTable(&(functions[i]),1);
                        break;
                    }
                }
            }
        }
    }
    else {
        for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
            if ( ( T = functions[i].tabl ) != 0 ) {
                if ( T->spare ) FlipTable(&(functions[i]),1);
            }
        }
    }
}
 
/*
    #] ApplyReset : 
    #[ TableReset :
*/
 
void TableReset(void)
{
    TABLES T;
    int i;
 
    for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
        if ( ( T = functions[i].tabl ) != 0 && T->spare && T->mode == 0 ) {
            functions[i].tabl = T->spare;
        }
    }
}
 
/*
    #] TableReset : 
    #[ LoadTableElement :
?????
int LoadTableElement(DBASE *d, TABLE *T, WORD num)
{
}
 
    #] LoadTableElement : 
    #[ ReleaseTB :
 
    Releases all TableBases
*/
 
int ReleaseTB(void)
{
    DBASE *d;
    int i;
    for ( i = NumTableBases - 1; i >= 0; i-- ) {
        d = tablebases+i;
        fclose(d->handle);
        FreeTableBase(d);
    }
    return(0);
}
 
/*
    #] ReleaseTB : 
*/