FORM  4.1
tables.c
Go to the documentation of this file.
1 
6 /* #[ License : */
7 /*
8  * Copyright (C) 1984-2013 J.A.M. Vermaseren
9  * When using this file you are requested to refer to the publication
10  * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
11  * This is considered a matter of courtesy as the development was paid
12  * for by FOM the Dutch physics granting agency and we would like to
13  * be able to track its scientific use to convince FOM of its value
14  * for the community.
15  *
16  * This file is part of FORM.
17  *
18  * FORM is free software: you can redistribute it and/or modify it under the
19  * terms of the GNU General Public License as published by the Free Software
20  * Foundation, either version 3 of the License, or (at your option) any later
21  * version.
22  *
23  * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
24  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
25  * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
26  * details.
27  *
28  * You should have received a copy of the GNU General Public License along
29  * with FORM. If not, see <http://www.gnu.org/licenses/>.
30  */
31 /* #] License : */
32 /*
33  #[ Includes :
34 
35  File contains the routines for the tree structure of sparse tables
36  We insert elements by
37  InsTableTree(T,tp) with T the TABLES element and tp the pointer
38  to the indices.
39  We look for elements with
40  FindTableTree(T,tp,inc) with T the TABLES element, tp the pointer to the
41  indices or the function arguments and inc tells which of these options.
42  The tree is cleared with ClearTableTree(T) and we rebuild the tree
43  after a .store in which we lost a part of the table with
44  RedoTableTree(T,newsize)
45 
46  In T->tablepointers we have the lists of indices for each element.
47  Additionally for each element there is an extension. There are
48  TABLEEXTENSION WORDs reserved for that. The old system had two words
49  One for the element in the rhs of the compile buffer and one for
50  an additional rhs in case the original would be overwritten by a new
51  definition, but the old was fixed by .global and hence it should be possible
52  to restore it.
53  New use (new = 24-sep-2001)
54  rhs1,numCompBuffer1,rhs2,numCompBuffer2,usage
55  Hence TABLEEXTENSION will be 5. Note that for 64 bits the use of the
56  compiler buffer is overdoing it a bit, but it would be too complicated
57  to try to give it special code.
58 */
59 
60 #include "form3.h"
61 #include "minos.h"
62 
63 /* static UBYTE *sparse = (UBYTE *)"sparse"; */
64 static UBYTE *tablebase = (UBYTE *)"tablebase";
65 
66 /*
67  #] Includes :
68  #[ ClearTableTree :
69 */
70 
71 void ClearTableTree(TABLES T)
72 {
73  COMPTREE *root;
74  if ( T->boomlijst == 0 ) {
75  T->MaxTreeSize = 125;
76  T->boomlijst = (COMPTREE *)Malloc1(T->MaxTreeSize*sizeof(COMPTREE),
77  "ClearTableTree");
78  }
79  root = T->boomlijst;
80  T->numtree = 0;
81  T->rootnum = 0;
82  root->left = -1;
83  root->right = -1;
84  root->parent = -1;
85  root->blnce = 0;
86  root->value = -1;
87  root->usage = 0;
88 }
89 
90 /*
91  #] ClearTableTree :
92  #[ InsTableTree :
93 
94  int InsTableTree(TABLES T,WORD *,arglist)
95  Searches for the element specified by the list of arguments.
96  If found, it returns -(the offset in T->tablepointers)
97  If not found, it will allocate a new element, balance the tree if
98  necessary and return the number of the element in the boomlijst
99  This number is always > 0, because we start from 1.
100 */
101 
102 int InsTableTree(TABLES T, WORD *tp)
103 {
104  COMPTREE *boomlijst, *q, *p, *s;
105  WORD *v1, *v2, *v3;
106  int ip, iq, is;
107  if ( T->numtree + 1 >= T->MaxTreeSize ) {
108  if ( T->MaxTreeSize == 0 ) ClearTableTree(T);
109  else {
110  is = T->MaxTreeSize * 2;
111  s = (COMPTREE *)Malloc1(is*sizeof(COMPTREE),"InsTableTree");
112  for ( ip = 0; ip < T->MaxTreeSize; ip++ ) { s[ip] = T->boomlijst[ip]; }
113  if ( T->boomlijst ) M_free(T->boomlijst,"InsTableTree");
114  T->boomlijst = s;
115  T->MaxTreeSize = is;
116  }
117  }
118  boomlijst = T->boomlijst;
119  q = boomlijst + T->rootnum;
120  if ( q->right == -1 ) { /* First element */
121  T->numtree++;
122  s = boomlijst+T->numtree;
123  q->right = T->numtree;
124  s->parent = T->rootnum;
125  s->left = s->right = -1;
126  s->blnce = 0;
127  s->value = tp - T->tablepointers;
128  s->usage = 0;
129  return(T->numtree);
130  }
131  ip = q->right;
132  while ( ip >= 0 ) {
133  p = boomlijst + ip;
134  v1 = T->tablepointers + p->value;
135  v2 = tp; v3 = tp + T->numind;
136  while ( *v1 == *v2 && v2 < v3 ) { v1++; v2++; }
137  if ( v2 >= v3 ) return(-p->value);
138  if ( *v1 > *v2 ) {
139  iq = p->right;
140  if ( iq >= 0 ) { ip = iq; }
141  else {
142  T->numtree++;
143  is = T->numtree;
144  p->right = is;
145  s = boomlijst + is;
146  s->parent = ip; s->left = s->right = -1;
147  s->blnce = 0; s->value = tp - T->tablepointers;
148  s->usage = 0;
149  p->blnce++;
150  if ( p->blnce == 0 ) return(T->numtree);
151  goto balance;
152  }
153  }
154  else if ( *v1 < *v2 ) {
155  iq = p->left;
156  if ( iq >= 0 ) { ip = iq; }
157  else {
158  T->numtree++;
159  is = T->numtree;
160  s = boomlijst+is;
161  p->left = is;
162  s->parent = ip; s->left = s->right = -1;
163  s->blnce = 0; s->value = tp - T->tablepointers;
164  s->usage = 0;
165  p->blnce--;
166  if ( p->blnce == 0 ) return(T->numtree);
167  goto balance;
168  }
169  }
170  }
171  MesPrint("Serious problems in InsTableTree!\n");
172  Terminate(-1);
173  return(0);
174 balance:;
175  for (;;) {
176  p = boomlijst + ip;
177  iq = p->parent;
178  if ( iq == T->rootnum ) break;
179  q = boomlijst + iq;
180  if ( ip == q->left ) q->blnce--;
181  else q->blnce++;
182  if ( q->blnce == 0 ) break;
183  if ( q->blnce == -2 ) {
184  if ( p->blnce == -1 ) { /* single rotation */
185  q->left = p->right;
186  p->right = iq;
187  p->parent = q->parent;
188  q->parent = ip;
189  if ( boomlijst[p->parent].left == iq ) boomlijst[p->parent].left = ip;
190  else boomlijst[p->parent].right = ip;
191  if ( q->left >= 0 ) boomlijst[q->left].parent = iq;
192  q->blnce = p->blnce = 0;
193  }
194  else { /* double rotation */
195  s = boomlijst + is;
196  q->left = s->right;
197  p->right = s->left;
198  s->right = iq;
199  s->left = ip;
200  if ( p->right >= 0 ) boomlijst[p->right].parent = ip;
201  if ( q->left >= 0 ) boomlijst[q->left].parent = iq;
202  s->parent = q->parent;
203  q->parent = is;
204  p->parent = is;
205  if ( boomlijst[s->parent].left == iq )
206  boomlijst[s->parent].left = is;
207  else boomlijst[s->parent].right = is;
208  if ( s->blnce > 0 ) { q->blnce = s->blnce = 0; p->blnce = -1; }
209  else if ( s->blnce < 0 ) { p->blnce = s->blnce = 0; q->blnce = 1; }
210  else { p->blnce = s->blnce = q->blnce = 0; }
211  }
212  break;
213  }
214  else if ( q->blnce == 2 ) {
215  if ( p->blnce == 1 ) { /* single rotation */
216  q->right = p->left;
217  p->left = iq;
218  p->parent = q->parent;
219  q->parent = ip;
220  if ( boomlijst[p->parent].left == iq ) boomlijst[p->parent].left = ip;
221  else boomlijst[p->parent].right = ip;
222  if ( q->right >= 0 ) boomlijst[q->right].parent = iq;
223  q->blnce = p->blnce = 0;
224  }
225  else { /* double rotation */
226  s = boomlijst + is;
227  q->right = s->left;
228  p->left = s->right;
229  s->left = iq;
230  s->right = ip;
231  if ( p->left >= 0 ) boomlijst[p->left].parent = ip;
232  if ( q->right >= 0 ) boomlijst[q->right].parent = iq;
233  s->parent = q->parent;
234  q->parent = is;
235  p->parent = is;
236  if ( boomlijst[s->parent].left == iq ) boomlijst[s->parent].left = is;
237  else boomlijst[s->parent].right = is;
238  if ( s->blnce < 0 ) { q->blnce = s->blnce = 0; p->blnce = 1; }
239  else if ( s->blnce > 0 ) { p->blnce = s->blnce = 0; q->blnce = -1; }
240  else { p->blnce = s->blnce = q->blnce = 0; }
241  }
242  break;
243  }
244  is = ip; ip = iq;
245  }
246  return(T->numtree);
247 }
248 
249 /*
250  #] InsTableTree :
251  #[ RedoTableTree :
252 
253  To be used when a sparse table is trimmed due to a .store
254  We rebuild the tree. In the future one could try to become faster
255  at the cost of quite some complexity.
256  We need to keep the first 'size' elements in the boomlijst.
257  Kill all others and reconstruct the tree with the original ordering.
258  This is very complicated! Because .store will either keep the whole
259  table or remove the whole table we should not come here often.
260  Hence we choose the slow solution for now.
261 */
262 
263 void RedoTableTree(TABLES T, int newsize)
264 {
265  WORD *tp;
266  int i;
267  ClearTableTree(T);
268  for ( i = 0, tp = T->tablepointers; i < newsize; i++ ) {
269  InsTableTree(T,tp);
270  tp += T->numind+TABLEEXTENSION;
271  }
272 }
273 
274 /*
275  #] RedoTableTree :
276  #[ FindTableTree :
277 
278  int FindTableTree(TABLES T,WORD *,arglist,int,inc)
279  Searches for the element specified by the list of arguments.
280  If found, it returns the offset in T->tablepointers
281  If not found, it will return -1
282  The list here is from the list of function arguments. Hence it
283  has pairs of numbers -SNUMBER,index
284  Actually inc says how many numbers there are and the above case is
285  for inc = 2. For inc = 1 we have just a list of indices.
286 */
287 
288 int FindTableTree(TABLES T, WORD *tp, int inc)
289 {
290  COMPTREE *boomlijst = T->boomlijst, *q = boomlijst + T->rootnum, *p;
291  WORD *v1, *v2, *v3;
292  int ip, iq;
293  if ( q->right == -1 ) return(-1);
294  ip = q->right;
295  if ( inc > 1 ) tp += inc-1;
296  while ( ip >= 0 ) {
297  p = boomlijst + ip;
298  v1 = T->tablepointers + p->value;
299  v2 = tp; v3 = v1 + T->numind;
300  while ( *v1 == *v2 && v1 < v3 ) { v1++; v2 += inc; }
301  if ( v1 == v3 ) {
302  p->usage++;
303  return(p->value);
304  }
305  if ( *v1 > *v2 ) {
306  iq = p->right;
307  if ( iq >= 0 ) { ip = iq; }
308  else return(-1);
309  }
310  else if ( *v1 < *v2 ) {
311  iq = p->left;
312  if ( iq >= 0 ) { ip = iq; }
313  else return(-1);
314  }
315  }
316  MesPrint("Serious problems in FindTableTree\n");
317  Terminate(-1);
318  return(-1);
319 }
320 
321 /*
322  #] FindTableTree :
323  #[ DoTableExpansion :
324 */
325 
326 WORD DoTableExpansion(WORD *term, WORD level)
327 {
328  GETIDENTITY
329  WORD *t, *tstop, *stopper, *termout, *m, *mm, *tp, *r;
330  TABLES T = 0;
331  int i, j, num;
332  AN.TeInFun = AR.TePos = 0;
333  tstop = term + *term;
334  stopper = tstop - ABS(tstop[-1]);
335  t = term+1;
336  while ( t < stopper ) {
337  if ( *t != TABLEFUNCTION ) { t += t[1]; continue; }
338  if ( t[FUNHEAD] > -FUNCTION ) { t += t[1]; continue; }
339  T = functions[-t[FUNHEAD]-FUNCTION].tabl;
340  if ( T == 0 ) { t += t[1]; continue; }
341  if ( T->spare ) T = T->spare;
342  if ( t[1] == FUNHEAD+2 && t[FUNHEAD+1] <= -FUNCTION ) break;
343  if ( t[1] < FUNHEAD+1+2*T->numind ) { t += t[1]; continue; }
344  for ( i = 0; i < T->numind; i++ ) {
345  if ( t[FUNHEAD+1+2*i] != -SYMBOL ) break;
346  }
347  if ( i >= T->numind ) break;
348  t += t[1];
349  }
350  if ( t >= stopper ) {
351  MesPrint("Internal error: Missing table_ function");
352  Terminate(-1);
353  }
354 /*
355  Table in T. Now collect the numbers of the symbols;
356 */
357  termout = AT.WorkPointer;
358  if ( T->sparse ) {
359  for ( i = 0; i < T->totind; i++ ) {
360 /*
361  Loop over all table elements
362 */
363  m = termout + 1; mm = term + 1;
364  while ( mm < t ) *m++ = *mm++;
365  r = m;
366  if ( t[1] == FUNHEAD+2 && t[FUNHEAD+1] <= -FUNCTION ) {
367  *m++ = -t[FUNHEAD+1];
368  *m++ = FUNHEAD+T->numind*2;
369  for ( j = 2; j < FUNHEAD; j++ ) *m++ = 0;
370  tp = T->tablepointers + (T->numind+TABLEEXTENSION)*i;
371  for ( j = 0; j < T->numind; j++ ) {
372  *m++ = -SNUMBER; *m++ = *tp++;
373  }
374  }
375  else {
376  *m++ = SYMBOL; *m++ = 2+T->numind*2; mm = t + FUNHEAD+1;
377  tp = T->tablepointers + (T->numind+TABLEEXTENSION)*i;
378  for ( j = 0; j < T->numind; j++, mm += 2, tp++ ) {
379  if ( *tp != 0 ) { *m++ = mm[1]; *m++ = *tp; }
380  }
381  r[1] = m-r;
382  if ( r[1] == 2 ) m = r;
383  }
384 /*
385  The next code replaces this old code
386 
387  *m++ = SUBEXPRESSION;
388  *m++ = SUBEXPSIZE;
389  *m++ = *tp;
390  *m++ = 1;
391  *m++ = T->bufnum;
392  FILLSUB(m);
393  mm = t + t[1];
394 
395  We had forgotten to take the parameters into account.
396  Hence the subexpression prototype for wildcards was missed
397  Now we slow things down a little bit, but we do not run
398  any risks. There is still one problem. We have not checked
399  that the prototype matches.
400 */
401  r = m;
402  *m++ = -t[FUNHEAD];
403  *m++ = t[1] - 1;
404  for ( j = 2; j < FUNHEAD; j++ ) *m++ = t[j];
405  tp = T->tablepointers + (T->numind+TABLEEXTENSION)*i;
406  for ( j = 0; j < T->numind; j++ ) {
407  *m++ = -SNUMBER; *m++ = *tp++;
408  }
409  tp = t + FUNHEAD + 1 + 2*T->numind;
410  mm = t + t[1];
411  while ( tp < mm ) *m++ = *tp++;
412  r[1] = m-r;
413 /*
414  From now on is old code
415 */
416  while ( mm < tstop ) *m++ = *mm++;
417  *termout = m - termout;
418  AT.WorkPointer = m;
419  if ( Generator(BHEAD termout,level) ) {
420  MesCall("DoTableExpand");
421  return(-1);
422  }
423  }
424  }
425  else {
426  for ( i = 0; i < T->totind; i++ ) {
427 #if TABLEEXTENSION == 2
428  if ( T->tablepointers[i] < 0 ) continue;
429 #else
430  if ( T->tablepointers[TABLEEXTENSION*i] < 0 ) continue;
431 #endif
432  m = termout + 1; mm = term + 1;
433  while ( mm < t ) *m++ = *mm++;
434  r = m;
435  if ( t[1] == FUNHEAD+2 && t[FUNHEAD+1] <= -FUNCTION ) {
436  *m++ = -t[FUNHEAD+1];
437  *m++ = FUNHEAD+T->numind*2;
438  for ( j = 2; j < FUNHEAD; j++ ) *m++ = 0;
439  tp = T->tablepointers + (T->numind+TABLEEXTENSION)*i;
440  for ( j = 0; j < T->numind; j++ ) {
441  if ( j > 0 ) {
442  num = T->mm[j].mini + ( i % T->mm[j-1].size ) / T->mm[j].size;
443  }
444  else {
445  num = T->mm[j].mini + i / T->mm[j].size;
446  }
447  *m++ = -SNUMBER; *m++ = num;
448  }
449  }
450  else {
451  *m++ = SYMBOL; *m++ = 2+T->numind*2; mm = t + FUNHEAD+1;
452  for ( j = 0; j < T->numind; j++, mm += 2 ) {
453  if ( j > 0 ) {
454  num = T->mm[j].mini + ( i % T->mm[j-1].size ) / T->mm[j].size;
455  }
456  else {
457  num = T->mm[j].mini + i / T->mm[j].size;
458  }
459  if ( num != 0 ) { *m++ = mm[1]; *m++ = num; }
460  }
461  r[1] = m-r;
462  if ( r[1] == 2 ) m = r;
463  }
464 /*
465  The next code replaces this old code
466 
467  *m++ = SUBEXPRESSION;
468  *m++ = SUBEXPSIZE;
469  *m++ = *tp;
470  *m++ = 1;
471  *m++ = T->bufnum;
472  FILLSUB(m);
473  mm = t + t[1];
474 
475  We had forgotten to take the parameters into account.
476  Hence the subexpression prototype for wildcards was missed
477  Now we slow things down a little bit, but we do not run
478  any risks. There is still one problem. We have not checked
479  that the prototype matches.
480 */
481  r = m;
482  *m++ = -t[FUNHEAD];
483  *m++ = t[1] - 1;
484  for ( j = 2; j < FUNHEAD; j++ ) *m++ = t[j];
485  for ( j = 0; j < T->numind; j++ ) {
486  if ( j > 0 ) {
487  num = T->mm[j].mini + ( i % T->mm[j-1].size ) / T->mm[j].size;
488  }
489  else {
490  num = T->mm[j].mini + i / T->mm[j].size;
491  }
492  *m++ = -SNUMBER; *m++ = num;
493  }
494  tp = t + FUNHEAD + 1 + 2*T->numind;
495  mm = t + t[1];
496  while ( tp < mm ) *m++ = *tp++;
497  r[1] = m - r;
498 /*
499  From now on is old code
500 */
501  while ( mm < tstop ) *m++ = *mm++;
502  *termout = m - termout;
503  AT.WorkPointer = m;
504  if ( Generator(BHEAD termout,level) ) {
505  MesCall("DoTableExpand");
506  return(-1);
507  }
508  }
509  }
510  return(0);
511 }
512 
513 /*
514  #] DoTableExpansion :
515  #[ TableBase :
516 
517  File with all the database related things.
518  We have the routines for the generic database command
519  TableBase,options;
520  TB,options;
521  Options are:
522  Open "File.tbl"; Open for R/W
523  Create "File.tbl"; Create for write
524  Load "File.tbl", tablename; Loads stubs of table
525  Load "File.tbl"; Loads stubs of all tables
526  Enter "File.tbl", tablename; Loads whole table
527  Enter "File.tbl"; Loads all tables
528  Audit "File.tbl", options; Print list of contents
529  Replace "File.tbl", tablename; Saves a table (with overwrite)
530  Replace "File.tbl", table element; Saves a table element ,,
531  Cleanup "File.tbl"; Makes tables contingent
532  AddTo "File.tbl" tablename; Add if not yet there.
533  AddTo "File.tbl" table element; Add if not yet there.
534  Delete "File.tbl" tablename;
535  Delete "File.tbl" table element;
536 
537  On/Off substitute;
538  On/Off compress "File.tbl";
539  id tbl_(f?,?a) = f(?a);
540  When a tbl_ is used, automatically the corresponding element is compiled
541  at the start of the next module.
542  if TB,On,substitue [tablename], use of table RHS (if loaded)
543  if TB,Off,substitue [tablename], use of tbl_(table,...);
544 
545 
546  Still needed: Something like OverLoad to allow loading parts of a table
547  from more than one file. Date stamps needed? In that case we need a touch
548  command as well.
549 
550  If we put all our diagrams inside, we have to go outside the concept
551  of tables.
552 
553  #] TableBase :
554  #[ CoTableBase :
555 
556  To be followed by ,subkey
557 */
558 static KEYWORD tboptions[] = {
559  {"addto", (TFUN)CoTBaddto, 0, PARTEST}
560  ,{"audit", (TFUN)CoTBaudit, 0, PARTEST}
561  ,{"cleanup", (TFUN)CoTBcleanup, 0, PARTEST}
562  ,{"create", (TFUN)CoTBcreate, 0, PARTEST}
563  ,{"enter", (TFUN)CoTBenter, 0, PARTEST}
564  ,{"help", (TFUN)CoTBhelp, 0, PARTEST}
565  ,{"load", (TFUN)CoTBload, 0, PARTEST}
566  ,{"off", (TFUN)CoTBoff, 0, PARTEST}
567  ,{"on", (TFUN)CoTBon, 0, PARTEST}
568  ,{"open", (TFUN)CoTBopen, 0, PARTEST}
569  ,{"replace", (TFUN)CoTBreplace, 0, PARTEST}
570  ,{"use", (TFUN)CoTBuse, 0, PARTEST}
571 };
572 
573 static UBYTE *tablebasename = 0;
574 
575 int CoTableBase(UBYTE *s)
576 {
577  UBYTE *option, c, *t;
578  int i,optlistsize = sizeof(tboptions)/sizeof(KEYWORD), error = 0;
579  while ( *s == ' ' ) s++;
580  if ( *s != '"' ) {
581  if ( ( tolower(*s) == 'h' ) && ( tolower(s[1]) == 'e' )
582  && ( tolower(s[2]) == 'l' ) && ( tolower(s[3]) == 'p' )
583  && ( FG.cTable[s[4]] > 1 ) ) {
584  CoTBhelp(s);
585  return(0);
586  }
587 proper:;
588  MesPrint("&Proper syntax: TableBase \"filename\" options");
589  return(1);
590  }
591  s++; tablebasename = s;
592  while ( *s && *s != '"' ) s++;
593  if ( *s != '"' ) goto proper;
594  t = s; s++; *t = 0;
595  while ( *s == ' ' || *s == '\t' || *s == ',' ) s++;
596  option = s;
597  while ( FG.cTable[*s] == 0 ) s++;
598  c = *s; *s = 0;
599  for ( i = 0; i < optlistsize; i++ ) {
600  if ( StrICmp(option,(UBYTE *)(tboptions[i].name)) == 0 ) {
601  *s = c;
602  while ( *s == ',' ) s++;
603  error = (tboptions[i].func)(s);
604  *t = '"';
605  return(error);
606  }
607  }
608  MesPrint("&Unrecognized option %s in TableBase statement",option);
609  return(1);
610 }
611 
612 /*
613  #] CoTableBase :
614  #[ FlipTable :
615 
616  Flips the table between use as 'stub' and regular use
617 */
618 
619 int FlipTable(FUNCTIONS f, int type)
620 {
621  TABLES T, TT;
622  T = f->tabl;
623  if ( ( TT = T->spare ) == 0 ) {
624  MesPrint("Error: trying to change mode on a table that has no tablebase");
625  return(-1);
626  }
627  if ( TT->mode == type ) f->tabl = TT;
628  return(0);
629 }
630 
631 /*
632  #] FlipTable :
633  #[ SpareTable :
634 
635  Creates a spare element for a table. This is used in the table bases.
636  It is a (thus far) empty copy of the TT table.
637  By using FlipTable we can switch between them and alter which version of
638  a table we will be using. Note that this also causes some extra work in the
639  ResetVariables and the Globalize routines.
640 */
641 
642 int SpareTable(TABLES TT)
643 {
644  TABLES T;
645  T = (TABLES)Malloc1(sizeof(struct TaBlEs),"table");
646  T->defined = T->mdefined = 0; T->sparse = TT->sparse; T->mm = 0; T->flags = 0;
647  T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
648  T->boomlijst = 0;
649  T->strict = TT->strict;
650  T->bounds = TT->bounds;
651  T->bufnum = inicbufs();
652  T->argtail = TT->argtail;
653  T->spare = TT;
654  T->bufferssize = 8;
655  T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"SpareTable buffers");
656  T->buffersfill = 0;
657  T->buffers[T->buffersfill++] = T->bufnum;
658  T->mode = 0;
659  T->numind = TT->numind;
660  T->totind = 0;
661  T->prototype = TT->prototype;
662  T->pattern = TT->pattern;
663  T->tablepointers = 0;
664  T->reserved = 0;
665  T->tablenum = 0;
666  T->numdummies = 0;
667  T->mm = (MINMAX *)Malloc1(T->numind*sizeof(MINMAX),"table dimensions");
668  T->flags = (WORD *)Malloc1(T->numind*sizeof(WORD),"table flags");
669  ClearTableTree(T);
670  TT->spare = T;
671  TT->mode = 1;
672  return(0);
673 }
674 
675 /*
676  #] SpareTable :
677  #[ FindTB :
678 
679  Looks for a tablebase with the given name in the active tablebases.
680 */
681 
682 DBASE *FindTB(UBYTE *name)
683 {
684  DBASE *d;
685  int i;
686  for ( i = 0; i < NumTableBases; i++ ) {
687  d = tablebases+i;
688  if ( d->name && ( StrCmp(name,(UBYTE *)(d->name)) == 0 ) ) { return(d); }
689  }
690  return(0);
691 }
692 
693 /*
694  #] FindTB :
695  #[ CoTBcreate :
696 
697  Creates a new tablebase.
698  Error is when there is already an active tablebase by this name.
699  If a file with the given name exists already, but it does not correspond
700  to an active table base, its contents will be lost.
701  Note that tablebasename is a static variable, defined in CoTableBase
702 */
703 
704 int CoTBcreate(UBYTE *s)
705 {
706  DUMMYUSE(s);
707  if ( FindTB(tablebasename) != 0 ) {
708  MesPrint("&There is already an open TableBase with the name %s",tablebasename);
709  return(-1);
710  }
711  NewDbase((char *)tablebasename,0);
712  return(0);
713 }
714 
715 /*
716  #] CoTBcreate :
717  #[ CoTBopen :
718 */
719 
720 int CoTBopen(UBYTE *s)
721 {
722  DBASE *d;
723  DUMMYUSE(s);
724  if ( ( d = FindTB(tablebasename) ) != 0 ) {
725  MesPrint("&There is already an open TableBase with the name %s",tablebasename);
726  return(-1);
727  }
728  d = GetDbase((char *)tablebasename);
729  if ( CheckTableDeclarations(d) ) return(-1);
730  return(0);
731 }
732 
733 /*
734  #] CoTBopen :
735  #[ CoTBaddto :
736 */
737 
738 int CoTBaddto(UBYTE *s)
739 {
740  GETIDENTITY
741  DBASE *d;
742  UBYTE *tablename, c, *t, elementstring[ELEMENTSIZE+20], *ss, *es;
743  WORD type, funnum, lbrac, first, num, *expr, *w;
744  TABLES T = 0;
745  MLONG basenumber;
746  LONG x;
747  int i, j, error = 0, sum;
748  if ( ( d = FindTB(tablebasename) ) == 0 ) {
749  MesPrint("&No open tablebase with the name %s",tablebasename);
750  return(-1);
751  }
752  AO.DollarOutSizeBuffer = 32;
753  AO.DollarOutBuffer = (UBYTE *)Malloc1(AO.DollarOutSizeBuffer,
754  "TableOutBuffer");
755 /*
756  Now loop through the names and start adding
757 */
758  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
759  while ( *s ) {
760  tablename = s;
761  if ( ( s = SkipAName(s) ) == 0 ) goto tableabort;
762  c = *s; *s = 0;
763  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
764  || ( T = functions[funnum].tabl ) == 0 ) {
765  MesPrint("&%s should be a previously declared table",tablename);
766  *s = c; goto tableabort;
767  }
768  if ( T->sparse == 0 ) {
769  MesPrint("&%s should be a sparse table",tablename);
770  *s = c; goto tableabort;
771  }
772  basenumber = AddTableName(d,(char *)tablename,T);
773  if ( T->spare && ( T->mode == 1 ) ) T = T->spare;
774  if ( basenumber < 0 ) basenumber = -basenumber;
775  else if ( basenumber == 0 ) { *s = c; goto tableabort; }
776  *s = c;
777  if ( *s == '(' ) { /* Addition of single element */
778  s++; es = s;
779  for ( i = 0, w = AT.WorkPointer; i < T->numind; i++ ) {
780  ParseSignedNumber(x,s);
781  if ( FG.cTable[s[-1]] != 1 || ( *s != ',' && *s != ')' ) ) {
782  MesPrint("&Table arguments in TableBase addto statement should be numbers");
783  return(1);
784  }
785  *w++ = x;
786  if ( *s == ')' ) break;
787  s++;
788  }
789  if ( *s != ')' || i < ( T->numind - 1 ) ) {
790  MesPrint("&Incorrect number of table arguments in TableBase addto statement. Should be %d"
791  ,T->numind);
792  error = 1;
793  }
794  c = *s; *s = 0;
795  i = FindTableTree(T,AT.WorkPointer,1);
796  if ( i < 0 ) {
797  MesPrint("&Element %s has not been defined",es);
798  error = 1;
799  *s++ = c;
800  }
801  else if ( ExistsObject(d,basenumber,(char *)es) ) {}
802  else {
803  sum = i + T->numind;
804 /*
805  See also commentary below
806 */
807  AO.DollarInOutBuffer = 1;
808  AO.PrintType = 1;
809  ss = AO.DollarOutBuffer;
810  *ss = 0;
811  AO.OutInBuffer = 1;
812 #if ( TABLEEXTENSION == 2 )
813  expr = cbuf[T->bufnum].rhs[T->tablepointers[sum]];
814 #else
815  expr = cbuf[T->tablepointers[sum+1]].rhs[T->tablepointers[sum]];
816 #endif
817  lbrac = 0; first = 0;
818  while ( *expr ) {
819  if ( WriteTerm(expr,&lbrac,first,PRINTON,0) ) {
820  error = 1; break;
821  }
822  expr += *expr;
823  }
824  AO.OutInBuffer = 0;
825  AddObject(d,basenumber,(char *)es,(char *)(AO.DollarOutBuffer));
826  *s++ = c;
827  }
828  }
829  else {
830 /*
831  Now we have to start looping through all defined elements of this table.
832  We have to construct the arguments in text format.
833 */
834  for ( i = 0; i < T->totind; i++ ) {
835 #if ( TABLEEXTENSION == 2 )
836  if ( !T->sparse && T->tablepointers[i] < 0 ) continue;
837 #else
838  if ( !T->sparse && T->tablepointers[TABLEEXTENSION*i] < 0 ) continue;
839 #endif
840  sum = i * ( T->numind + TABLEEXTENSION );
841  t = elementstring;
842  for ( j = 0; j < T->numind; j++, sum++ ) {
843  if ( j > 0 ) *t++ = ',';
844  num = T->tablepointers[sum];
845  t = NumCopy(num,t);
846  if ( ( t - elementstring ) >= ELEMENTSIZE ) {
847  MesPrint("&Table element specification takes more than %ld characters and cannot be handled",
848  (MLONG)ELEMENTSIZE);
849  goto tableabort;
850  }
851  }
852  if ( ExistsObject(d,basenumber,(char *)elementstring) ) { continue; }
853 /*
854  We have the number in basenumber and the element in elementstring.
855  Now we need the rhs. We can use the code from WriteDollarToBuffer.
856  Main complication: in the table compiler buffer there can be
857  brackets. The dollars do not have those......
858 */
859  AO.DollarInOutBuffer = 1;
860  AO.PrintType = 1;
861  ss = AO.DollarOutBuffer;
862  *ss = 0;
863  AO.OutInBuffer = 1;
864 #if ( TABLEEXTENSION == 2 )
865  expr = cbuf[T->bufnum].rhs[T->tablepointers[sum]];
866 #else
867  expr = cbuf[T->tablepointers[sum+1]].rhs[T->tablepointers[sum]];
868 #endif
869  lbrac = 0; first = 0;
870  while ( *expr ) {
871  if ( WriteTerm(expr,&lbrac,first,PRINTON,0) ) {
872  error = 1; break;
873  }
874  expr += *expr;
875  }
876  AO.OutInBuffer = 0;
877  AddObject(d,basenumber,(char *)elementstring,(char *)(AO.DollarOutBuffer));
878  }
879  }
880  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
881  }
882  if ( WriteIniInfo(d) ) goto tableabort;
883  M_free(AO.DollarOutBuffer,"DollarOutBuffer");
884  AO.DollarOutBuffer = 0;
885  AO.DollarOutSizeBuffer = 0;
886  return(error);
887 tableabort:;
888  M_free(AO.DollarOutBuffer,"DollarOutBuffer");
889  AO.DollarOutBuffer = 0;
890  AO.DollarOutSizeBuffer = 0;
891  AO.OutInBuffer = 0;
892  return(1);
893 }
894 
895 /*
896  #] CoTBaddto :
897  #[ CoTBenter :
898 
899  Loads the elements of the tables specified into memory and sends them
900  one by one to the compiler as Fill statements.
901 */
902 
903 int CoTBenter(UBYTE *s)
904 {
905  DBASE *d;
906  MLONG basenumber;
907  UBYTE *arguments, *rhs, *buffer, *t, *u, c, *tablename;
908  LONG size;
909  int i, j, error = 0, error1 = 0, printall = 0;
910  TABLES T = 0;
911  WORD type, funnum;
912  if ( ( d = FindTB(tablebasename) ) == 0 ) {
913  MesPrint("&No open tablebase with the name %s",tablebasename);
914  return(-1);
915  }
916  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
917  if ( *s == '!' ) { printall = 1; s++; }
918  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
919  if ( *s ) {
920  while ( *s ) {
921  tablename = s;
922  if ( ( s = SkipAName(s) ) == 0 ) return(1);
923  c = *s; *s = 0;
924  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
925  || ( T = functions[funnum].tabl ) == 0 ) {
926  MesPrint("&%s should be a previously declared table",tablename);
927  basenumber = 0;
928  }
929  else if ( T->sparse == 0 ) {
930  MesPrint("&%s should be a sparse table",tablename);
931  basenumber = 0;
932  }
933  else { basenumber = GetTableName(d,(char *)tablename); }
934  if ( T->spare == 0 ) { SpareTable(T); }
935  if ( basenumber > 0 ) {
936  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
937  for ( j = 0; j < NUMOBJECTS; j++ ) {
938  if ( basenumber != d->iblocks[i]->objects[j].tablenumber )
939  continue;
940  arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
941  rhs = (UBYTE *)ReadObject(d,basenumber,(char *)arguments);
942  if ( printall ) {
943  if ( rhs ) {
944  MesPrint("%s(%s) = %s",tablename,arguments,rhs);
945  }
946  else {
947  MesPrint("%s(%s) = 0",tablename,arguments);
948  }
949  }
950  if ( rhs ) {
951  u = rhs; while ( *u ) u++;
952  size = u-rhs;
953  u = arguments; while ( *u ) u++;
954  size += u-arguments;
955  u = tablename; while ( *u ) u++;
956  size += u-tablename;
957  size += 6;
958  buffer = (UBYTE *)Malloc1(size,"TableBase copy");
959  t = tablename; u = buffer;
960  while ( *t ) *u++ = *t++;
961  *u++ = '(';
962  t = arguments;
963  while ( *t ) *u++ = *t++;
964  *u++ = ')'; *u++ = '=';
965  t = rhs;
966  while ( *t ) *u++ = *t++;
967  if ( t == rhs ) *u++ = '0';
968  *u++ = 0; *u = 0;
969  M_free(rhs,"rhs in TBenter");
970 
971  error1 = CoFill(buffer);
972 
973  if ( error1 < 0 ) { return(error); }
974  if ( error1 != 0 ) error = error1;
975  M_free(buffer,"TableBase copy");
976  }
977  }
978  }
979  }
980  *s = c;
981  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
982  }
983  }
984  else {
985  s = (UBYTE *)(d->tablenames); basenumber = 0;
986  while ( *s ) {
987  basenumber++;
988  tablename = s; while ( *s ) s++; s++;
989  while ( *s ) s++; s++;
990  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
991  || ( T = functions[funnum].tabl ) == 0 ) {
992  MesPrint("&%s should be a previously declared table",tablename);
993  }
994  else if ( T->sparse == 0 ) {
995  MesPrint("&%s should be a sparse table",tablename);
996  }
997  if ( T->spare == 0 ) { SpareTable(T); }
998  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
999  for ( j = 0; j < NUMOBJECTS; j++ ) {
1000  if ( d->iblocks[i]->objects[j].tablenumber == basenumber ) {
1001  arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
1002  rhs = (UBYTE *)ReadObject(d,basenumber,(char *)arguments);
1003  if ( printall ) {
1004  if ( rhs ) {
1005  MesPrint("%s%s = %s",tablename,arguments,rhs);
1006  }
1007  else {
1008  MesPrint("%s%s = 0",tablename,arguments);
1009  }
1010  }
1011  if ( rhs ) {
1012  u = rhs; while ( *u ) u++;
1013  size = u-rhs;
1014  u = arguments; while ( *u ) u++;
1015  size += u-arguments;
1016  u = tablename; while ( *u ) u++;
1017  size += u-tablename;
1018  size += 6;
1019  buffer = (UBYTE *)Malloc1(size,"TableBase copy");
1020  t = tablename; u = buffer;
1021  while ( *t ) *u++ = *t++;
1022  *u++ = '(';
1023  t = arguments;
1024  while ( *t ) *u++ = *t++;
1025  *u++ = ')'; *u++ = '=';
1026  t = rhs;
1027  while ( *t ) *u++ = *t++;
1028  if ( t == rhs ) *u++ = '0';
1029  *u++ = 0; *u = 0;
1030  M_free(rhs,"rhs in TBenter");
1031 
1032  error1 = CoFill(buffer);
1033 
1034  if ( error1 < 0 ) { return(error); }
1035  if ( error1 != 0 ) error = error1;
1036  M_free(buffer,"TableBase copy");
1037  }
1038  }
1039  }
1040  }
1041  }
1042  }
1043  return(error);
1044 }
1045 
1046 /*
1047  #] CoTBenter :
1048  #[ CoTestUse :
1049 
1050  Possibly to be followed by names of tables.
1051  We make an array of TABLES structs to be tested in AC.usedtables.
1052  Note: only sparse tables are allowed.
1053  No arguments means all tables.
1054 */
1055 
1056 int CoTestUse(UBYTE *s)
1057 {
1058  GETIDENTITY
1059  UBYTE *tablename, c;
1060  WORD type, funnum, *w;
1061  TABLES T;
1062  int error = 0;
1063  w = AT.WorkPointer;
1064  *w++ = TYPETESTUSE; *w++ = 2;
1065  while ( *s ) {
1066  tablename = s;
1067  if ( ( s = SkipAName(s) ) == 0 ) return(1);
1068  c = *s; *s = 0;
1069  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1070  || ( T = functions[funnum].tabl ) == 0 ) {
1071  MesPrint("&%s should be a previously declared table",tablename);
1072  error = 1;
1073  }
1074  else if ( T->sparse == 0 ) {
1075  MesPrint("&%s should be a sparse table",tablename);
1076  error = 1;
1077  }
1078  *w++ = funnum + FUNCTION;
1079  *s = c;
1080  while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
1081  }
1082  AT.WorkPointer[1] = w - AT.WorkPointer;
1083 /*
1084  if ( AT.WorkPointer[1] > 2 ) {
1085  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1086  }
1087 */
1088  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1089  return(error);
1090 }
1091 
1092 /*
1093  #] CoTestUse :
1094  #[ CheckTableDeclarations :
1095 
1096  Checks that all tables in a tablebase have identical properties to
1097  possible previous declarations. If they have not been declared
1098  before, they are declared here.
1099 */
1100 
1101 int CheckTableDeclarations(DBASE *d)
1102 {
1103  WORD type, funnum;
1104  UBYTE *s, *ss, *t, *command = 0;
1105  int k, error = 0, error1, i;
1106  TABLES T;
1107  LONG commandsize = 0;
1108 
1109  s = (UBYTE *)(d->tablenames);
1110  for ( k = 0; k < d->topnumber; k++ ) {
1111  if ( GetVar(s,&type,&funnum,ANYTYPE,NOAUTO) == NAMENOTFOUND ) {
1112 /*
1113  We have to declare the table
1114 */
1115  ss = s; i = 0; while ( *ss ) { ss++; i++; } /* name */
1116  ss++; while ( *ss ) { ss++; i++; } /* tail */
1117  if ( commandsize == 0 ) {
1118  commandsize = i + 15;
1119  if ( commandsize < 100 ) commandsize = 100;
1120  }
1121  if ( (i+11) > commandsize ) {
1122  if ( command ) { M_free(command,"table command"); command = 0; }
1123  commandsize = i+10;
1124  }
1125  if ( command == 0 ) {
1126  command = (UBYTE *)Malloc1(commandsize,"table command");
1127  }
1128  t = command; ss = tablebase; while ( *ss ) *t++ = *ss++;
1129  *t++ = ','; while ( *s ) *t++ = *s++;
1130  s++; while ( *s ) *t++ = *s++;
1131  *t++ = ')'; *t = 0; s++;
1132  error1 = DoTable(command,1);
1133  if ( error1 ) error = error1;
1134  }
1135  else if ( ( type != CFUNCTION )
1136  || ( ( T = functions[funnum].tabl ) == 0 )
1137  || ( T->sparse == 0 ) ) {
1138  MesPrint("&%s has been declared previously, but not as a sparse table.",s);
1139  error = 1;
1140  while ( *s ) s++; s++; while ( *s ) s++; s++;
1141  }
1142  else {
1143 /*
1144  Test dimension and argtail. There should be an exact match.
1145  We are not going to rename arguments when reading the elements.
1146 */
1147  ss = s;
1148  while ( *s ) s++; s++;
1149  if ( StrCmp(s,T->argtail) ) {
1150  MesPrint("&Declaration of table %s in %s different from previous declaration",ss,d->name);
1151  error = 1;
1152  }
1153  while ( *s ) s++; s++;
1154  }
1155  }
1156  if ( command ) { M_free(command,"table command"); }
1157  return(error);
1158 }
1159 
1160 /*
1161  #] CheckTableDeclarations :
1162  #[ CoTBload :
1163 
1164  Loads the table stubbs of the specified tables in the indicated
1165  tablebase. Syntax:
1166  TableBase "tablebasename.tbl" load [tablename(s)];
1167  If no tables are specified all tables are taken.
1168 */
1169 
1170 int CoTBload(UBYTE *ss)
1171 {
1172  DBASE *d;
1173  UBYTE *s, *name, *t, *r, *command, *arguments, *tail;
1174  LONG commandsize;
1175  int num, cs, es, ns, ts, i, j, error = 0, error1;
1176  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1177  MesPrint("&No open tablebase with the name %s",tablebasename);
1178  return(-1);
1179  }
1180  commandsize = 120;
1181  command = (UBYTE *)Malloc1(commandsize,"Fill command");
1182  AC.vetofilling = 1;
1183  if ( *ss ) {
1184  while ( *ss == ',' || *ss == ' ' || *ss == '\t' ) ss++;
1185  while ( *ss ) {
1186  name = ss; ss = SkipAName(ss); *ss = 0;
1187  s = (UBYTE *)(d->tablenames);
1188  num = 0; ns = 0;
1189  while ( *s ) {
1190  num++;
1191  if ( StrCmp(s,name) ) {
1192  while ( *s ) s++; s++; while ( *s ) s++; s++; num++;
1193  continue;
1194  }
1195  name = s; while ( *s ) s++; ns = s-name; s++;
1196  tail = s; while ( *s ) s++; ts = s-tail; s++;
1197  tail++; while ( FG.cTable[*tail] == 1 ) tail++;
1198 /*
1199  Go through all elements
1200 */
1201  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1202  for ( j = 0; j < NUMOBJECTS; j++ ) {
1203  if ( d->iblocks[i]->objects[j].tablenumber == num ) {
1204  t = arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
1205  while ( *t ) t++; es = t - arguments;
1206  cs = 2*es + 2*ns + ts + 10;
1207  if ( cs > commandsize ) {
1208  commandsize = 2*cs;
1209  if ( command ) M_free(command,"Fill command");
1210  command = (UBYTE *)Malloc1(commandsize,"Fill command");
1211  }
1212  r = command; t = name; while ( *t ) *r++ = *t++;
1213  *r++ = '('; t = arguments; while ( *t ) *r++ = *t++;
1214  *r++ = ')'; *r++ = '='; *r++ = 't'; *r++ = 'b'; *r++ = 'l';
1215  *r++ = '_'; *r++ = '('; t = name; while ( *t ) *r++ = *t++;
1216  *r++ = ','; t = arguments; while ( *t ) *r++ = *t++;
1217  t = tail; while ( *t ) {
1218  if ( *t == '?' && r[-1] != ',' ) {
1219  t++;
1220  if ( FG.cTable[*t] == 0 || *t == '$' || *t == '[' ) {
1221  t = SkipAName(t);
1222  if ( *t == '[' ) {
1223  SKIPBRA1(t);
1224  }
1225  }
1226  else if ( *t == '{' ) {
1227  SKIPBRA2(t);
1228  }
1229  else if ( *t ) { *r++ = *t++; continue; }
1230  }
1231  else *r++ = *t++;
1232  }
1233  *r++ = ')'; *r = 0;
1234 /*
1235  Still to do: replacemode or no replacemode?
1236 */
1237  AC.vetotablebasefill = 1;
1238  error1 = CoFill(command);
1239  AC.vetotablebasefill = 0;
1240  if ( error1 < 0 ) goto finishup;
1241  if ( error1 != 0 ) error = error1;
1242  }
1243  }
1244  }
1245  break;
1246  }
1247  while ( *ss == ',' || *ss == ' ' || *ss == '\t' ) ss++;
1248  }
1249  }
1250  else { /* do all of them */
1251  s = (UBYTE *)(d->tablenames);
1252  num = 0; ns = 0;
1253  while ( *s ) {
1254  num++;
1255  name = s; while ( *s ) s++; ns = s-name; s++;
1256  tail = s; while ( *s ) s++; ts = s-tail; s++;
1257  tail++; while ( FG.cTable[*tail] == 1 ) tail++;
1258 /*
1259  Go through all elements
1260 */
1261  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1262  for ( j = 0; j < NUMOBJECTS; j++ ) {
1263  if ( d->iblocks[i]->objects[j].tablenumber == num ) {
1264  t = arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
1265  while ( *t ) t++; es = t - arguments;
1266  cs = 2*es + 2*ns + ts + 10;
1267  if ( cs > commandsize ) {
1268  commandsize = 2*cs;
1269  if ( command ) M_free(command,"Fill command");
1270  command = (UBYTE *)Malloc1(commandsize,"Fill command");
1271  }
1272  r = command; t = name; while ( *t ) *r++ = *t++;
1273  *r++ = '('; t = arguments; while ( *t ) *r++ = *t++;
1274  *r++ = ')'; *r++ = '='; *r++ = 't'; *r++ = 'b'; *r++ = 'l';
1275  *r++ = '_'; *r++ = '('; t = name; while ( *t ) *r++ = *t++;
1276  *r++ = ','; t = arguments; while ( *t ) *r++ = *t++;
1277  t = tail; while ( *t ) {
1278  if ( *t == '?' && r[-1] != ',' ) {
1279  t++;
1280  if ( FG.cTable[*t] == 0 || *t == '$' || *t == '[' ) {
1281  t = SkipAName(t);
1282  if ( *t == '[' ) {
1283  SKIPBRA1(t);
1284  }
1285  }
1286  else if ( *t == '{' ) {
1287  SKIPBRA2(t);
1288  }
1289  else if ( *t ) { *r++ = *t++; continue; }
1290  }
1291  else *r++ = *t++;
1292  }
1293  *r++ = ')'; *r = 0;
1294 /*
1295  Still to do: replacemode or no replacemode?
1296 */
1297  AC.vetotablebasefill = 1;
1298  error1 = CoFill(command);
1299  AC.vetotablebasefill = 0;
1300  if ( error1 < 0 ) goto finishup;
1301  if ( error1 != 0 ) error = error1;
1302  }
1303  }
1304  }
1305  }
1306  }
1307 finishup:;
1308  AC.vetofilling = 0;
1309  if ( command ) M_free(command,"Fill command");
1310  return(error);
1311 }
1312 
1313 /*
1314  #] CoTBload :
1315  #[ TestUse :
1316 
1317  Look for tbl_(tablename,arguments)
1318  if tablename is encountered, check first whether the element is in
1319  use already. If not, check in the tables in AC.usedtables.
1320  If the element is not there, add it to AC.usedtables.
1321 
1322 
1323  We need the arguments of TestUse to see for which tables it is to be done
1324 */
1325 
1326 WORD TestUse(WORD *term, WORD level)
1327 {
1328  WORD *tstop, *t, *m, *tstart, tabnum;
1329  WORD *funs, numfuns, error = 0;
1330  TABLES T;
1331  LONG i;
1332  CBUF *C = cbuf+AM.rbufnum;
1333  int isp;
1334 
1335  numfuns = C->lhs[level][1] - 2;
1336  funs = C->lhs[level] + 2;
1337  GETSTOP(term,tstop);
1338  t = term+1;
1339  while ( t < tstop ) {
1340  if ( *t != TABLESTUB ) { t += t[1]; continue; }
1341  tstart = t;
1342  m = t + FUNHEAD;
1343  t += t[1];
1344  if ( *m >= -FUNCTION ) continue;
1345  tabnum = -*m;
1346  if ( ( T = functions[tabnum-FUNCTION].tabl ) == 0 ) continue;
1347  if ( T->sparse == 0 ) continue;
1348 /*
1349  Check whether we have to test this one
1350 */
1351  if ( numfuns > 0 ) {
1352  for ( i = 0; i < numfuns; i++ ) {
1353  if ( tabnum == funs[i] ) break;
1354  }
1355  if ( i >= numfuns && numfuns > 0 ) continue;
1356  }
1357 /*
1358  Test whether the element has been defined already.
1359  If not, mark it as used.
1360  Note: we only allow sparse tables (for now)
1361 */
1362  m++;
1363  for ( i = 0; i < T->numind; i++, m += 2 ) {
1364  if ( m >= t || *m != -SNUMBER ) break;
1365  }
1366  if ( ( i == T->numind ) &&
1367  ( ( isp = FindTableTree(T,tstart+FUNHEAD+1,2) ) >= 0 ) ) {
1368  if ( ( T->tablepointers[isp+T->numind+4] & ELEMENTLOADED ) == 0 ) {
1369  T->tablepointers[isp+T->numind+4] |= ELEMENTUSED;
1370  }
1371  }
1372  else {
1373  MesPrint("TestUse: Encountered a table element inside tbl_ that does not correspond to a tablebase element");
1374  error = -1;
1375  }
1376  }
1377  return(error);
1378 }
1379 
1380 /*
1381  #] TestUse :
1382  #[ CoTBaudit :
1383 */
1384 
1385 int CoTBaudit(UBYTE *s)
1386 {
1387  DBASE *d;
1388  UBYTE *name, *tail;
1389  int i, j, error = 0, num;
1390 
1391  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1392  MesPrint("&No open tablebase with the name %s",tablebasename);
1393  return(-1);
1394  }
1395  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1396  while ( *s ) {
1397 /*
1398  Get the options here
1399  They will mainly involve the sorting of the output.
1400 */
1401  s++;
1402  }
1403  s = (UBYTE *)(d->tablenames); num = 0;
1404  while ( *s ) {
1405  num++;
1406  name = s; while ( *s ) s++; s++;
1407  tail = s; while ( *s ) s++; s++;
1408  MesPrint("Table,sparse,%s%s)",name,tail);
1409  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1410  for ( j = 0; j < NUMOBJECTS; j++ ) {
1411  if ( d->iblocks[i]->objects[j].tablenumber == num ) {
1412  MesPrint(" %s(%s)",name,d->iblocks[i]->objects[j].element);
1413  }
1414  }
1415  }
1416  }
1417  return(error);
1418 }
1419 
1420 /*
1421  #] CoTBaudit :
1422  #[ CoTBon :
1423 */
1424 
1425 int CoTBon(UBYTE *s)
1426 {
1427  DBASE *d;
1428  UBYTE *ss, c;
1429  int error = 0;
1430  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1431  MesPrint("&No open tablebase with the name %s",tablebasename);
1432  return(-1);
1433  }
1434  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1435  while ( *s ) {
1436  ss = SkipAName(s);
1437  c = *ss; *ss = 0;
1438  if ( StrICmp(s,(UBYTE *)("compress")) == 0 ) {
1439  d->mode &= ~NOCOMPRESS;
1440  }
1441  else {
1442  MesPrint("&subkey %s not defined in TableBase On statement");
1443  error = 1;
1444  }
1445  *ss = c; s = ss;
1446  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1447  }
1448  return(error);
1449 }
1450 
1451 /*
1452  #] CoTBon :
1453  #[ CoTBoff :
1454 */
1455 
1456 int CoTBoff(UBYTE *s)
1457 {
1458  DBASE *d;
1459  UBYTE *ss, c;
1460  int error = 0;
1461  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1462  MesPrint("&No open tablebase with the name %s",tablebasename);
1463  return(-1);
1464  }
1465  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1466  while ( *s ) {
1467  ss = SkipAName(s);
1468  c = *ss; *ss = 0;
1469  if ( StrICmp(s,(UBYTE *)("compress")) == 0 ) {
1470  d->mode |= NOCOMPRESS;
1471  }
1472  else {
1473  MesPrint("&subkey %s not defined in TableBase Off statement");
1474  error = 1;
1475  }
1476  *ss = c; s = ss;
1477  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1478  }
1479  return(error);
1480 }
1481 
1482 /*
1483  #] CoTBoff :
1484  #[ CoTBcleanup :
1485 */
1486 
1487 int CoTBcleanup(UBYTE *s)
1488 {
1489  DUMMYUSE(s);
1490  MesPrint("&TableBase Cleanup statement not yet implemented");
1491  return(1);
1492 }
1493 
1494 /*
1495  #] CoTBcleanup :
1496  #[ CoTBreplace :
1497 */
1498 
1499 int CoTBreplace(UBYTE *s)
1500 {
1501  DUMMYUSE(s);
1502  MesPrint("&TableBase Replace statement not yet implemented");
1503  return(1);
1504 }
1505 
1506 /*
1507  #] CoTBreplace :
1508  #[ CoTBuse :
1509 
1510  Here the actual table use as determined in TestUse causes the needed
1511  table elements to be loaded
1512 */
1513 
1514 int CoTBuse(UBYTE *s)
1515 {
1516  GETIDENTITY
1517  DBASE *d;
1518  MLONG basenumber;
1519  UBYTE *arguments, *rhs, *buffer, *t, *u, c, *tablename, *p;
1520  LONG size, sum, x;
1521  int i, j, error = 0, error1 = 0, k;
1522  TABLES T = 0;
1523  WORD type, funnum, mode, *w;
1524  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1525  MesPrint("&No open tablebase with the name %s",tablebasename);
1526  return(-1);
1527  }
1528  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1529  if ( *s ) {
1530  while ( *s ) {
1531  tablename = s;
1532  if ( ( s = SkipAName(s) ) == 0 ) return(1);
1533  c = *s; *s = 0;
1534  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1535  || ( T = functions[funnum].tabl ) == 0 ) {
1536  MesPrint("&%s should be a previously declared table",tablename);
1537  basenumber = 0;
1538  }
1539  else if ( T->sparse == 0 ) {
1540  MesPrint("&%s should be a sparse table",tablename);
1541  basenumber = 0;
1542  }
1543  else { basenumber = GetTableName(d,(char *)tablename); }
1544 /* if ( T->spare == 0 ) { SpareTable(T); } */
1545  if ( basenumber > 0 ) {
1546  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1547  for ( j = 0; j < NUMOBJECTS; j++ ) {
1548  if ( d->iblocks[i]->objects[j].tablenumber != basenumber ) continue;
1549  arguments = p = (UBYTE *)(d->iblocks[i]->objects[j].element);
1550 /*
1551  Now translate the arguments and see whether we need
1552  this one....
1553 */
1554  for ( k = 0, w = AT.WorkPointer; k < T->numind; k++ ) {
1555  ParseSignedNumber(x,p);
1556  *w++ = x; p++;
1557  }
1558  sum = FindTableTree(T,AT.WorkPointer,1);
1559  if ( sum < 0 ) {
1560  MesPrint("Table %s in tablebase %s has not been loaded properly"
1561  ,tablename,tablebasename);
1562  error = 1;
1563  continue;
1564  }
1565  sum += T->numind + 4;
1566  mode = T->tablepointers[sum];
1567  if ( ( mode & ELEMENTLOADED ) == ELEMENTLOADED ) {
1568  T->tablepointers[sum] &= ~ELEMENTUSED;
1569  continue;
1570  }
1571  if ( ( mode & ELEMENTUSED ) == 0 ) continue;
1572 /*
1573  We need this one!
1574 */
1575  rhs = (UBYTE *)ReadijObject(d,i,j,(char *)arguments);
1576  if ( rhs ) {
1577  u = rhs; while ( *u ) u++;
1578  size = u-rhs;
1579  u = arguments; while ( *u ) u++;
1580  size += u-arguments;
1581  u = tablename; while ( *u ) u++;
1582  size += u-tablename;
1583  size += 6;
1584  buffer = (UBYTE *)Malloc1(size,"TableBase copy");
1585  t = tablename; u = buffer;
1586  while ( *t ) *u++ = *t++;
1587  *u++ = '(';
1588  t = arguments;
1589  while ( *t ) *u++ = *t++;
1590  *u++ = ')'; *u++ = '=';
1591  t = rhs;
1592  while ( *t ) *u++ = *t++;
1593  if ( t == rhs ) { *u++ = '0'; }
1594  *u++ = 0; *u = 0;
1595  M_free(rhs,"rhs in TBuse xxx");
1596 
1597  error1 = CoFill(buffer);
1598 
1599  if ( error1 < 0 ) { return(error); }
1600  if ( error1 != 0 ) error = error1;
1601  M_free(buffer,"TableBase copy");
1602  }
1603  T->tablepointers[sum] &= ~ELEMENTUSED;
1604  T->tablepointers[sum] |= ELEMENTLOADED;
1605  }
1606  }
1607  }
1608  *s = c;
1609  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1610  }
1611  }
1612  else {
1613  s = (UBYTE *)(d->tablenames); basenumber = 0;
1614  while ( *s ) {
1615  basenumber++;
1616  tablename = s; while ( *s ) s++; s++;
1617  while ( *s ) s++; s++;
1618  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1619  || ( T = functions[funnum].tabl ) == 0 ) {
1620  MesPrint("&%s should be a previously declared table",tablename);
1621  }
1622  else if ( T->sparse == 0 ) {
1623  MesPrint("&%s should be a sparse table",tablename);
1624  }
1625  if ( T->spare && T->mode == 0 ) {
1626  MesPrint("In table %s we have a problem with stubb orders in CoTBuse",tablename);
1627  error = -1;
1628  }
1629 /* if ( T->spare == 0 ) { SpareTable(T); } */
1630  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1631  for ( j = 0; j < NUMOBJECTS; j++ ) {
1632  if ( d->iblocks[i]->objects[j].tablenumber == basenumber ) {
1633  arguments = p = (UBYTE *)(d->iblocks[i]->objects[j].element);
1634 /*
1635  Now translate the arguments and see whether we need
1636  this one....
1637 */
1638  for ( k = 0, w = AT.WorkPointer; k < T->numind; k++ ) {
1639  ParseSignedNumber(x,p);
1640  *w++ = x; p++;
1641  }
1642  sum = FindTableTree(T,AT.WorkPointer,1);
1643  if ( sum < 0 ) {
1644  MesPrint("Table %s in tablebase %s has not been loaded properly"
1645  ,tablename,tablebasename);
1646  error = 1;
1647  continue;
1648  }
1649  sum += T->numind + 4;
1650  mode = T->tablepointers[sum];
1651  if ( ( mode & ELEMENTLOADED ) == ELEMENTLOADED ) {
1652  T->tablepointers[sum] &= ~ELEMENTUSED;
1653  continue;
1654  }
1655  if ( ( mode & ELEMENTUSED ) == 0 ) continue;
1656 /*
1657  We need this one!
1658 */
1659  rhs = (UBYTE *)ReadijObject(d,i,j,(char *)arguments);
1660  if ( rhs ) {
1661  u = rhs; while ( *u ) u++;
1662  size = u-rhs;
1663  u = arguments; while ( *u ) u++;
1664  size += u-arguments;
1665  u = tablename; while ( *u ) u++;
1666  size += u-tablename;
1667  size += 6;
1668  buffer = (UBYTE *)Malloc1(size,"TableBase copy");
1669  t = tablename; u = buffer;
1670  while ( *t ) *u++ = *t++;
1671  *u++ = '(';
1672  t = arguments;
1673  while ( *t ) *u++ = *t++;
1674  *u++ = ')'; *u++ = '=';
1675 
1676  t = rhs;
1677  while ( *t ) *u++ = *t++;
1678  if ( t == rhs ) { *u++ = '0'; }
1679  *u++ = 0; *u = 0;
1680  M_free(rhs,"rhs in TBuse");
1681 
1682  error1 = CoFill(buffer);
1683 
1684  if ( error1 < 0 ) { return(error); }
1685  if ( error1 != 0 ) error = error1;
1686  M_free(buffer,"TableBase copy");
1687  }
1688  T->tablepointers[sum] &= ~ELEMENTUSED;
1689  T->tablepointers[sum] |= ELEMENTLOADED;
1690  }
1691  }
1692  }
1693  }
1694  }
1695  return(error);
1696 }
1697 
1698 /*
1699  #] CoTBuse :
1700  #[ CoApply :
1701 
1702  Possibly to be followed by names of tables.
1703 */
1704 
1705 int CoApply(UBYTE *s)
1706 {
1707  GETIDENTITY
1708  UBYTE *tablename, c;
1709  WORD type, funnum, *w;
1710  TABLES T;
1711  LONG maxtogo = MAXPOSITIVE;
1712  int error = 0;
1713  w = AT.WorkPointer;
1714  if ( FG.cTable[*s] == 1 ) {
1715  maxtogo = 0;
1716  while ( FG.cTable[*s] == 1 ) {
1717  maxtogo = maxtogo*10 + (*s-'0');
1718  s++;
1719  }
1720  while ( *s == ',' ) s++;
1721  if ( maxtogo > MAXPOSITIVE || maxtogo < 0 ) maxtogo = MAXPOSITIVE;
1722  }
1723  *w++ = TYPEAPPLY; *w++ = 3; *w++ = maxtogo;
1724  while ( *s ) {
1725  tablename = s;
1726  if ( ( s = SkipAName(s) ) == 0 ) return(1);
1727  c = *s; *s = 0;
1728  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1729  || ( T = functions[funnum].tabl ) == 0 ) {
1730  MesPrint("&%s should be a previously declared table",tablename);
1731  error = 1;
1732  }
1733  else if ( T->sparse == 0 ) {
1734  MesPrint("&%s should be a sparse table",tablename);
1735  error = 1;
1736  }
1737  *w++ = funnum + FUNCTION;
1738  *s = c;
1739  while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
1740  }
1741  AT.WorkPointer[1] = w - AT.WorkPointer;
1742 /*
1743  if ( AT.WorkPointer[1] > 2 ) {
1744  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1745  }
1746 */
1747  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1748 /*
1749  AT.WorkPointer[0] = TYPEAPPLYRESET;
1750  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1751 */
1752  return(error);
1753 }
1754 
1755 /*
1756  #] CoApply :
1757  #[ CoTBhelp :
1758 */
1759 
1760 char *helptb[] = {
1761  "The TableBase statement is used as follows:"
1762  ,"TableBase \"file.tbl\" keyword subkey(s)"
1763  ," in which we have"
1764  ,"Keyword Subkey(s) Action"
1765  ,"open Opens file.tbl for R/W"
1766  ,"create Creates file.tbl for R/W. Old contents are lost"
1767  ,"load Loads all stubs of all tables"
1768  ,"load tablename(s) Loads all stubs the tables mentioned"
1769  ,"enter Loads all stubs and rhs of all tables"
1770  ,"enter tablename(s) Loads all stubs and rhs of the tables mentioned"
1771  ,"audit Prints list of contents"
1772 /* ,"replace tablename saves a table (with overwrite)" */
1773 /* ,"replace tableelement saves a table element (with overwrite)" */
1774 /* ,"cleanup makes tables contingent" */
1775  ,"addto tablename adds all elements if not yet there"
1776  ,"addto tableelement adds element if not yet there"
1777 /* ,"delete tablename removes table from tablebase" */
1778 /* ,"delete tableelement removes element from tablebase" */
1779  ,"on compress elements are stored in gzip format (default)"
1780  ,"off compress elements are stored in uncompressed format"
1781  ,"use compiles all needed elements"
1782  ,"use tablename(s) compiles all needed elements of these tables"
1783  ,""
1784  ,"Related commands are:"
1785  ,"testuse marks which tbl_ elements occur for all tables"
1786  ,"testuse tablename(s) marks which tbl_ elements occur for given tables"
1787  ,"apply replaces tbl_ if rhs available"
1788  ,"apply tablename(s) replaces tbl_ for given tables if rhs available"
1789  ,""
1790  };
1791 
1792 int CoTBhelp(UBYTE *s)
1793 {
1794  int i, ii = sizeof(helptb)/sizeof(char *);
1795  DUMMYUSE(s);
1796  for ( i = 0; i < ii; i++ ) MesPrint("%s",helptb[i]);
1797  return(0);
1798 }
1799 
1800 /*
1801  #] CoTBhelp :
1802  #[ ReWorkT :
1803 
1804  Replaces the STUBBS of the functions in the list.
1805  This gains one space. Hence we have to be very careful
1806 */
1807 
1808 VOID ReWorkT(WORD *term, WORD *funs, WORD numfuns)
1809 {
1810  WORD *tstop, *tend, *m, *t, *tt, *mm, *mmm, *r, *rr;
1811  int i, j;
1812  tend = term + *term; tstop = tend - ABS(tend[-1]);
1813  m = t = term+1;
1814  while ( t < tstop ) {
1815  if ( *t == TABLESTUB ) {
1816  for ( i = 0; i < numfuns; i++ ) {
1817  if ( -t[FUNHEAD] == funs[i] ) break;
1818  }
1819  if ( numfuns == 0 || i < numfuns ) { /* Hit */
1820  i = t[1] - 1;
1821  *m++ = -t[FUNHEAD]; *m++ = i; t += 2; i -= FUNHEAD;
1822  if ( m < t ) { for ( j = 0; j < FUNHEAD-2; j++ ) *m++ = *t++; }
1823  else { m += FUNHEAD-2; t += FUNHEAD-2; }
1824  t++;
1825  while ( i-- > 0 ) { *m++ = *t++; }
1826  tt = t; mm = m;
1827  if ( mm < tt ) {
1828  while ( tt < tend ) *mm++ = *tt++;
1829  *term = mm - term;
1830  tend = term + *term; tstop = tend - ABS(tend[-1]);
1831  t = m;
1832  }
1833  }
1834  else { goto inc; }
1835  }
1836  else if ( *t >= FUNCTION ) {
1837  tt = t + t[1];
1838  mm = m;
1839  for ( j = 0; j < FUNHEAD; j++ ) {
1840  if ( m == t ) { m++; t++; }
1841  else *m++ = *t++;
1842  }
1843  while ( t < tt ) {
1844  if ( *t <= -FUNCTION ) {
1845  if ( m == t ) { m++; t++; }
1846  else *m++ = *t++;
1847  }
1848  else if ( *t < 0 ) {
1849  if ( m == t ) { m += 2; t += 2; }
1850  else { *m++ = *t++; *m++ = *t++; }
1851  }
1852  else {
1853  rr = t + *t; mmm = m;
1854  for ( j = 0; j < ARGHEAD; j++ ) {
1855  if ( m == t ) { m++; t++; }
1856  else *m++ = *t++;
1857  }
1858  while ( t < rr ) {
1859  r = t + *t;
1860  ReWorkT(t,funs,numfuns);
1861  j = *t;
1862  if ( m == t ) { m += j; t += j; }
1863  else { while ( j-- >= 0 ) *m++ = *t++; }
1864  t = r;
1865  }
1866  *mmm = m-mmm;
1867  }
1868  }
1869  mm[1] = m - mm;
1870  t = tt;
1871  }
1872  else {
1873 inc: j = t[1];
1874  if ( m < t ) { while ( j-- >= 0 ) *m++ = *t++; }
1875  else { m += j; t += j; }
1876  }
1877  }
1878  if ( m < t ) {
1879  while ( t < tend ) *m++ = *t++;
1880  *term = m - term;
1881  }
1882 }
1883 
1884 /*
1885  #] ReWorkT :
1886  #[ Apply :
1887 */
1888 
1889 WORD Apply(WORD *term, WORD level)
1890 {
1891  WORD *funs, numfuns;
1892  TABLES T;
1893  int i, j;
1894  CBUF *C = cbuf+AM.rbufnum;
1895 /*
1896  Point the tables in the proper direction
1897 */
1898  numfuns = C->lhs[level][1] - 2;
1899  funs = C->lhs[level] + 2;
1900  if ( numfuns > 0 ) {
1901  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
1902  if ( ( T = functions[i].tabl ) != 0 ) {
1903  for ( j = 0; j < numfuns; j++ ) {
1904  if ( i == (funs[j]-FUNCTION) && T->spare ) {
1905  FlipTable(&(functions[i]),0);
1906  break;
1907  }
1908  }
1909  }
1910  }
1911  }
1912  else {
1913  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
1914  if ( ( T = functions[i].tabl ) != 0 ) {
1915  if ( T->spare ) FlipTable(&(functions[i]),0);
1916  }
1917  }
1918  }
1919 /*
1920  Now the replacements everywhere of
1921  id tbl_(table,?a) = table(?a);
1922  Actually, this has to be done recursively.
1923  Note that we actually gain one space.
1924 */
1925  ReWorkT(term,funs,numfuns);
1926  return(0);
1927 }
1928 
1929 /*
1930  #] Apply :
1931  #[ ApplyExec :
1932 
1933  Replaces occurrences of tbl_(table,indices,pattern) by the proper
1934  rhs of table(indices,pattern). It does this up to maxtogo times
1935  in the given term. It starts with the occurrences inside the
1936  arguments of functions. If necessary it finishes at groundlevel.
1937  An infite number of tries is indicates by maxtogo = 2^15-1 or 2^31-1.
1938  The occurrences are replaced by subexpressions. This allows TestSub
1939  to finish the job properly.
1940 
1941  The main trick here is T = T->spare which turns to the proper rhs.
1942 
1943  The return value is the number of substitutions that can still be made
1944  based on maxtogo. Hence, if the returnvalue is different from maxtogo
1945  there was a substitution.
1946 */
1947 
1948 int ApplyExec(WORD *term, int maxtogo, WORD level)
1949 {
1950  GETIDENTITY
1951  WORD rhsnumber, *Tpattern, *funs, numfuns, funnum;
1952  WORD ii, *t, *t1, *w, *p, *m, *m1, *u, *r, tbufnum, csize, wilds;
1953  NESTING NN;
1954  int i, j, isp, stilltogo;
1955  CBUF *C;
1956  TABLES T;
1957 /*
1958  Startup. We need NestPoin for when we have to replace something deep down.
1959 */
1960  t = term;
1961  m = t + *t;
1962  csize = ABS(m[-1]);
1963  m -= csize;
1964  AT.NestPoin->termsize = t;
1965  if ( AT.NestPoin == AT.Nest ) AN.EndNest = t + *t;
1966  t++;
1967 /*
1968  First we look inside function arguments. Also when clean!
1969 */
1970  while ( t < m ) {
1971  if ( *t < FUNCTION ) { t += t[1]; continue; }
1972  if ( functions[*t-FUNCTION].spec > 0 ) { t += t[1]; continue; }
1973  AT.NestPoin->funsize = t;
1974  r = t + t[1];
1975  t += FUNHEAD;
1976  while ( t < r ) {
1977  if ( *t < 0 ) { NEXTARG(t); continue; }
1978  AT.NestPoin->argsize = t1 = t;
1979  u = t + *t;
1980  t += ARGHEAD;
1981  AT.NestPoin++;
1982  while ( t < u ) {
1983 /*
1984  Now we loop over the terms inside a function argument
1985  This defines a recursion and we have to call ApplyExec again.
1986  The real problem is when we catch something and we have
1987  to insert a subexpression pointer. This may use more or
1988  less space and the whole term has to be readjusted.
1989  This is why we have the NestPoin variables. They tell us
1990  where the sizes of the term, the function and the arguments
1991  are sitting, and also where the dirty flags are.
1992  This readjusting is of course done in the groundlevel code.
1993  Here we worry abound the maxtogo count.
1994 */
1995  stilltogo = ApplyExec(t,maxtogo,level);
1996  if ( stilltogo != maxtogo ) {
1997  if ( stilltogo <= 0 ) {
1998  AT.NestPoin--;
1999  return(stilltogo);
2000  }
2001  maxtogo = stilltogo;
2002  u = t1 + *t1;
2003  m = term + *term - csize;
2004  }
2005  t += *t;
2006  }
2007  AT.NestPoin--;
2008  }
2009  }
2010 /*
2011  Now we look at the ground level
2012 */
2013  C = cbuf+AM.rbufnum;
2014  t = term + 1;
2015  while ( t < m ) {
2016  if ( *t != TABLESTUB ) { t += t[1]; continue; }
2017  funnum = -t[FUNHEAD];
2018  if ( ( funnum < FUNCTION )
2019  || ( funnum >= FUNCTION+WILDOFFSET )
2020  || ( ( T = functions[funnum-FUNCTION].tabl ) == 0 )
2021  || ( T->sparse == 0 )
2022  || ( T->spare == 0 ) ) { t += t[1]; continue; }
2023  numfuns = C->lhs[level][1] - 3;
2024  funs = C->lhs[level] + 3;
2025  if ( numfuns > 0 ) {
2026  for ( i = 0; i < numfuns; i++ ) {
2027  if ( funs[i] == funnum ) break;
2028  }
2029  if ( i >= numfuns ) { t += t[1]; continue; }
2030  }
2031  r = t + t[1];
2032  AT.NestPoin->funsize = t + 1;
2033  t1 = t;
2034  t += FUNHEAD + 1;
2035 /*
2036  Test whether the table catches
2037  Test 1: index arguments and range. isp will be the number
2038  of the element in the table.
2039 */
2040  T = T->spare;
2041 #ifdef WITHPTHREADS
2042  Tpattern = T->pattern[identity];
2043 #else
2044  Tpattern = T->pattern;
2045 #endif
2046  p = Tpattern+FUNHEAD+1;
2047  for ( i = 0; i < T->numind; i++, t += 2 ) {
2048  if ( *t != -SNUMBER ) break;
2049  }
2050  if ( i < T->numind ) { t = r; continue; }
2051  isp = FindTableTree(T,t1+FUNHEAD+1,2);
2052  if ( isp < 0 ) { t = r; continue; }
2053  rhsnumber = T->tablepointers[isp+T->numind];
2054 #if ( TABLEEXTENSION == 2 )
2055  tbufnum = T->bufnum;
2056 #else
2057  tbufnum = T->tablepointers[isp+T->numind+1];
2058 #endif
2059  t = t1+FUNHEAD+2;
2060  ii = T->numind;
2061  while ( --ii >= 0 ) {
2062  *p = *t; t += 2; p += 2;
2063  }
2064 /*
2065  If there are more arguments we have to do some
2066  pattern matching. This should be easy. We addapted the
2067  pattern, so that the array indices match already.
2068 */
2069 #ifdef WITHPTHREADS
2070  AN.FullProto = T->prototype[identity];
2071 #else
2072  AN.FullProto = T->prototype;
2073 #endif
2074  AN.WildValue = AN.FullProto + SUBEXPSIZE;
2075  AN.WildStop = AN.FullProto+AN.FullProto[1];
2076  ClearWild(BHEAD0);
2077  AN.RepFunNum = 0;
2078  AN.RepFunList = AN.EndNest;
2079  AT.WorkPointer = (WORD *)(((UBYTE *)(AN.EndNest)) + AM.MaxTer/2);
2080 /*
2081  The RepFunList is after the term but not very relevant.
2082  We need because MatchFunction uses it
2083 */
2084  if ( AT.WorkPointer + t1[1] >= AT.WorkTop ) { MesWork(); }
2085  wilds = 0;
2086  w = AT.WorkPointer;
2087  *w++ = -t1[FUNHEAD];
2088  *w++ = t1[1] - 1;
2089  for ( i = 2; i < FUNHEAD; i++ ) *w++ = t1[i];
2090  t = t1 + FUNHEAD+1;
2091  while ( t < r ) *w++ = *t++;
2092  t = AT.WorkPointer;
2093  AT.WorkPointer = w;
2094  if ( MatchFunction(BHEAD Tpattern,t,&wilds) > 0 ) {
2095 /*
2096  Here we caught one. Now we should worry about:
2097  1: inserting the subexpression pointer with its wildcards
2098  2: NestPoin because we may not be at the lowest level
2099  The function starts at t1.
2100 */
2101 #ifdef WITHPTHREADS
2102  m1 = T->prototype[identity];
2103 #else
2104  m1 = T->prototype;
2105 #endif
2106  m1[2] = rhsnumber;
2107  m1[4] = tbufnum;
2108  t = t1;
2109  j = t[1];
2110  i = m1[1];
2111  if ( j > i ) {
2112  j = i - j;
2113  NCOPY(t,m1,i);
2114  m1 = AN.EndNest;
2115  while ( r < m1 ) *t++ = *r++;
2116  AN.EndNest = t;
2117  *term += j;
2118  NN = AT.NestPoin;
2119  while ( NN > AT.Nest ) {
2120  NN--;
2121  NN->termsize[0] += j;
2122  NN->funsize[1] += j;
2123  NN->argsize[0] += j;
2124  NN->funsize[2] |= DIRTYFLAG;
2125  NN->argsize[1] |= DIRTYFLAG;
2126  }
2127  m += j;
2128  }
2129  else if ( j < i ) {
2130  j = i-j;
2131  t = AN.EndNest;
2132  while ( t >= r ) { t[j] = *t; t--; }
2133  t = t1;
2134  NCOPY(t,m1,i);
2135  AN.EndNest += j;
2136  *term += j;
2137  NN = AT.NestPoin;
2138  while ( NN > AT.Nest ) {
2139  NN--;
2140  NN->termsize[0] += j;
2141  NN->funsize[1] += j;
2142  NN->argsize[0] += j;
2143  NN->funsize[2] |= DIRTYFLAG;
2144  NN->argsize[1] |= DIRTYFLAG;
2145  }
2146  m += j;
2147  }
2148  else {
2149  NCOPY(t,m1,j);
2150  }
2151  r = t1 + t1[1];
2152  maxtogo--;
2153  if ( maxtogo <= 0 ) return(maxtogo);
2154  }
2155  t = r;
2156  }
2157  return(maxtogo);
2158 }
2159 
2160 /*
2161  #] ApplyExec :
2162  #[ ApplyReset :
2163 */
2164 
2165 WORD ApplyReset(WORD level)
2166 {
2167  WORD *funs, numfuns;
2168  TABLES T;
2169  int i, j;
2170  CBUF *C = cbuf+AM.rbufnum;
2171 
2172  numfuns = C->lhs[level][1] - 2;
2173  funs = C->lhs[level] + 2;
2174  if ( numfuns > 0 ) {
2175  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
2176  if ( ( T = functions[i].tabl ) != 0 ) {
2177  for ( j = 0; j < numfuns; j++ ) {
2178  if ( i == (funs[j]-FUNCTION) && T->spare ) {
2179  FlipTable(&(functions[i]),1);
2180  break;
2181  }
2182  }
2183  }
2184  }
2185  }
2186  else {
2187  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
2188  if ( ( T = functions[i].tabl ) != 0 ) {
2189  if ( T->spare ) FlipTable(&(functions[i]),1);
2190  }
2191  }
2192  }
2193  return(0);
2194 }
2195 
2196 /*
2197  #] ApplyReset :
2198  #[ TableReset :
2199 */
2200 
2201 WORD TableReset()
2202 {
2203  TABLES T;
2204  int i;
2205 
2206  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
2207  if ( ( T = functions[i].tabl ) != 0 && T->spare && T->mode == 0 ) {
2208  functions[i].tabl = T->spare;
2209  }
2210  }
2211  return(0);
2212 }
2213 
2214 /*
2215  #] TableReset :
2216  #[ LoadTableElement :
2217 ?????
2218 int LoadTableElement(DBASE *d, TABLE *T, WORD num)
2219 {
2220 }
2221 
2222  #] LoadTableElement :
2223  #[ ReleaseTB :
2224 
2225  Releases all TableBases
2226 */
2227 
2228 int ReleaseTB()
2229 {
2230  DBASE *d;
2231  int i;
2232  for ( i = NumTableBases - 1; i >= 0; i-- ) {
2233  d = tablebases+i;
2234  fclose(d->handle);
2235  FreeTableBase(d);
2236  }
2237  return(0);
2238 }
2239 
2240 /*
2241  #] ReleaseTB :
2242 */
WORD bufferssize
Definition: structs.h:366
WORD * buffers
Definition: structs.h:352
int value
Definition: structs.h:285
LONG reserved
Definition: structs.h:354
LONG totind
Definition: structs.h:353
int numtree
Definition: structs.h:362
int parent
Definition: structs.h:282
int right
Definition: structs.h:284
WORD size
Definition: structs.h:297
WORD * pattern
Definition: structs.h:344
int left
Definition: structs.h:283
int sparse
Definition: structs.h:361
struct TaBlEs * spare
Definition: structs.h:351
int strict
Definition: structs.h:360
WORD mode
Definition: structs.h:369
WORD ** lhs
Definition: structs.h:912
int numind
Definition: structs.h:358
WORD mini
Definition: structs.h:295
Definition: structs.h:908
Definition: structs.h:281
TABLES tabl
Definition: structs.h:462
int usage
Definition: structs.h:287
int blnce
Definition: structs.h:286
WORD * tablepointers
Definition: structs.h:338
UBYTE * argtail
Definition: structs.h:349
WORD tablenum
Definition: structs.h:368
int MaxTreeSize
Definition: structs.h:364
WORD bufnum
Definition: structs.h:365
WORD buffersfill
Definition: structs.h:367
LONG defined
Definition: structs.h:355
MINMAX * mm
Definition: structs.h:346
Definition: minos.h:120
COMPTREE * boomlijst
Definition: structs.h:348
WORD * prototype
Definition: structs.h:343
int bounds
Definition: structs.h:359
WORD Generator(PHEAD WORD *, WORD)
Definition: proces.c:2865
LONG mdefined
Definition: structs.h:356
int rootnum
Definition: structs.h:363
WORD * flags
Definition: structs.h:347
struct TaBlEs * TABLES