15701338753

Committed 17 Jun 2025 07:49AM UTC coverage: 50.382% (-0.004%) from 50.386%

Build # 15701338753

Build Type

Pull #662

github

Committed by

web-flow

Commit Message

Merge f1f68c050 into 207386593

Pull Request Pull Request #662: Cleanup: change VOID into void

Run Details

178 of 245 new or added lines in 34 files covered. (72.65%)

2 existing lines in 1 file now uncovered.

41784 of 82935 relevant lines covered (50.38%)

2640008.85 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

23.98

/sources/tables.c

/** @file tables.c
 * 
 *  Contains all functions that deal with the table bases on the 'FORM level'
 *  The low level database routines are in minos.c
 */
/* #[ License : */
/*
 *   Copyright (C) 1984-2023 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 :
*/

WORD 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
*/

WORD TestUse(WORD *term, WORD level)
{
        WORD *tstop, *t, *m, *tstart, tabnum;
        WORD *funs, numfuns, 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 :
*/

WORD 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);
        return(0);
}

/*
          #] 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 :
*/

WORD 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);
                        }
                }
        }
        return(0);
}

/*
          #] ApplyReset : 
          #[ TableReset :
*/

WORD 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;
                }
        }
        return(0);
}

/*
          #] 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 : 
*/

form-dev / form / 15701338753

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous