FORM  4.2
tables.c
Go to the documentation of this file.
1 
6 /* #[ License : */
7 /*
8  * Copyright (C) 1984-2017 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  int dict = AO.CurrentDictionary;
804  AO.CurrentDictionary = 0;
805  sum = i + T->numind;
806 /*
807  See also commentary below
808 */
809  AO.DollarInOutBuffer = 1;
810  AO.PrintType = 1;
811  ss = AO.DollarOutBuffer;
812  *ss = 0;
813  AO.OutInBuffer = 1;
814 #if ( TABLEEXTENSION == 2 )
815  expr = cbuf[T->bufnum].rhs[T->tablepointers[sum]];
816 #else
817  expr = cbuf[T->tablepointers[sum+1]].rhs[T->tablepointers[sum]];
818 #endif
819  lbrac = 0; first = 0;
820  while ( *expr ) {
821  if ( WriteTerm(expr,&lbrac,first,PRINTON,0) ) {
822  error = 1; break;
823  }
824  expr += *expr;
825  }
826  AO.OutInBuffer = 0;
827  AddObject(d,basenumber,(char *)es,(char *)(AO.DollarOutBuffer));
828  *s++ = c;
829  AO.CurrentDictionary = dict;
830  }
831  }
832  else {
833 /*
834  Now we have to start looping through all defined elements of this table.
835  We have to construct the arguments in text format.
836 */
837  for ( i = 0; i < T->totind; i++ ) {
838 #if ( TABLEEXTENSION == 2 )
839  if ( !T->sparse && T->tablepointers[i] < 0 ) continue;
840 #else
841  if ( !T->sparse && T->tablepointers[TABLEEXTENSION*i] < 0 ) continue;
842 #endif
843  sum = i * ( T->numind + TABLEEXTENSION );
844  t = elementstring;
845  for ( j = 0; j < T->numind; j++, sum++ ) {
846  if ( j > 0 ) *t++ = ',';
847  num = T->tablepointers[sum];
848  t = NumCopy(num,t);
849  if ( ( t - elementstring ) >= ELEMENTSIZE ) {
850  MesPrint("&Table element specification takes more than %ld characters and cannot be handled",
851  (MLONG)ELEMENTSIZE);
852  goto tableabort;
853  }
854  }
855  if ( ExistsObject(d,basenumber,(char *)elementstring) ) { continue; }
856 /*
857  We have the number in basenumber and the element in elementstring.
858  Now we need the rhs. We can use the code from WriteDollarToBuffer.
859  Main complication: in the table compiler buffer there can be
860  brackets. The dollars do not have those......
861 */
862  AO.DollarInOutBuffer = 1;
863  AO.PrintType = 1;
864  ss = AO.DollarOutBuffer;
865  *ss = 0;
866  AO.OutInBuffer = 1;
867 #if ( TABLEEXTENSION == 2 )
868  expr = cbuf[T->bufnum].rhs[T->tablepointers[sum]];
869 #else
870  expr = cbuf[T->tablepointers[sum+1]].rhs[T->tablepointers[sum]];
871 #endif
872  lbrac = 0; first = 0;
873  while ( *expr ) {
874  if ( WriteTerm(expr,&lbrac,first,PRINTON,0) ) {
875  error = 1; break;
876  }
877  expr += *expr;
878  }
879  AO.OutInBuffer = 0;
880  AddObject(d,basenumber,(char *)elementstring,(char *)(AO.DollarOutBuffer));
881  }
882  }
883  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
884  }
885  if ( WriteIniInfo(d) ) goto tableabort;
886  M_free(AO.DollarOutBuffer,"DollarOutBuffer");
887  AO.DollarOutBuffer = 0;
888  AO.DollarOutSizeBuffer = 0;
889  return(error);
890 tableabort:;
891  M_free(AO.DollarOutBuffer,"DollarOutBuffer");
892  AO.DollarOutBuffer = 0;
893  AO.DollarOutSizeBuffer = 0;
894  AO.OutInBuffer = 0;
895  return(1);
896 }
897 
898 /*
899  #] CoTBaddto :
900  #[ CoTBenter :
901 
902  Loads the elements of the tables specified into memory and sends them
903  one by one to the compiler as Fill statements.
904 */
905 
906 int CoTBenter(UBYTE *s)
907 {
908  DBASE *d;
909  MLONG basenumber;
910  UBYTE *arguments, *rhs, *buffer, *t, *u, c, *tablename;
911  LONG size;
912  int i, j, error = 0, error1 = 0, printall = 0;
913  TABLES T = 0;
914  WORD type, funnum;
915  int dict = AO.CurrentDictionary;
916  AO.CurrentDictionary = 0;
917  if ( ( d = FindTB(tablebasename) ) == 0 ) {
918  MesPrint("&No open tablebase with the name %s",tablebasename);
919  error = -1;
920  goto Endofall;
921  }
922  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
923  if ( *s == '!' ) { printall = 1; s++; }
924  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
925  if ( *s ) {
926  while ( *s ) {
927  tablename = s;
928  if ( ( s = SkipAName(s) ) == 0 ) { error = 1; goto Endofall; }
929  c = *s; *s = 0;
930  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
931  || ( T = functions[funnum].tabl ) == 0 ) {
932  MesPrint("&%s should be a previously declared table",tablename);
933  basenumber = 0;
934  }
935  else if ( T->sparse == 0 ) {
936  MesPrint("&%s should be a sparse table",tablename);
937  basenumber = 0;
938  }
939  else { basenumber = GetTableName(d,(char *)tablename); }
940  if ( T->spare == 0 ) { SpareTable(T); }
941  if ( basenumber > 0 ) {
942  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
943  for ( j = 0; j < NUMOBJECTS; j++ ) {
944  if ( basenumber != d->iblocks[i]->objects[j].tablenumber )
945  continue;
946  arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
947  rhs = (UBYTE *)ReadObject(d,basenumber,(char *)arguments);
948  if ( printall ) {
949  if ( rhs ) {
950  MesPrint("%s(%s) = %s",tablename,arguments,rhs);
951  }
952  else {
953  MesPrint("%s(%s) = 0",tablename,arguments);
954  }
955  }
956  if ( rhs ) {
957  u = rhs; while ( *u ) u++;
958  size = u-rhs;
959  u = arguments; while ( *u ) u++;
960  size += u-arguments;
961  u = tablename; while ( *u ) u++;
962  size += u-tablename;
963  size += 6;
964  buffer = (UBYTE *)Malloc1(size,"TableBase copy");
965  t = tablename; u = buffer;
966  while ( *t ) *u++ = *t++;
967  *u++ = '(';
968  t = arguments;
969  while ( *t ) *u++ = *t++;
970  *u++ = ')'; *u++ = '=';
971  t = rhs;
972  while ( *t ) *u++ = *t++;
973  if ( t == rhs ) *u++ = '0';
974  *u++ = 0; *u = 0;
975  M_free(rhs,"rhs in TBenter");
976 
977  error1 = CoFill(buffer);
978 
979  if ( error1 < 0 ) goto Endofall;
980  if ( error1 != 0 ) error = error1;
981  M_free(buffer,"TableBase copy");
982  }
983  }
984  }
985  }
986  *s = c;
987  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
988  }
989  }
990  else {
991  s = (UBYTE *)(d->tablenames); basenumber = 0;
992  while ( *s ) {
993  basenumber++;
994  tablename = s; while ( *s ) s++; s++;
995  while ( *s ) s++; s++;
996  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
997  || ( T = functions[funnum].tabl ) == 0 ) {
998  MesPrint("&%s should be a previously declared table",tablename);
999  }
1000  else if ( T->sparse == 0 ) {
1001  MesPrint("&%s should be a sparse table",tablename);
1002  }
1003  if ( T->spare == 0 ) { SpareTable(T); }
1004  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1005  for ( j = 0; j < NUMOBJECTS; j++ ) {
1006  if ( d->iblocks[i]->objects[j].tablenumber == basenumber ) {
1007  arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
1008  rhs = (UBYTE *)ReadObject(d,basenumber,(char *)arguments);
1009  if ( printall ) {
1010  if ( rhs ) {
1011  MesPrint("%s%s = %s",tablename,arguments,rhs);
1012  }
1013  else {
1014  MesPrint("%s%s = 0",tablename,arguments);
1015  }
1016  }
1017  if ( rhs ) {
1018  u = rhs; while ( *u ) u++;
1019  size = u-rhs;
1020  u = arguments; while ( *u ) u++;
1021  size += u-arguments;
1022  u = tablename; while ( *u ) u++;
1023  size += u-tablename;
1024  size += 6;
1025  buffer = (UBYTE *)Malloc1(size,"TableBase copy");
1026  t = tablename; u = buffer;
1027  while ( *t ) *u++ = *t++;
1028  *u++ = '(';
1029  t = arguments;
1030  while ( *t ) *u++ = *t++;
1031  *u++ = ')'; *u++ = '=';
1032  t = rhs;
1033  while ( *t ) *u++ = *t++;
1034  if ( t == rhs ) *u++ = '0';
1035  *u++ = 0; *u = 0;
1036  M_free(rhs,"rhs in TBenter");
1037 
1038  error1 = CoFill(buffer);
1039 
1040  if ( error1 < 0 ) goto Endofall;
1041  if ( error1 != 0 ) error = error1;
1042  M_free(buffer,"TableBase copy");
1043  }
1044  }
1045  }
1046  }
1047  }
1048  }
1049 Endofall:;
1050  AO.CurrentDictionary = dict;
1051  return(error);
1052 }
1053 
1054 /*
1055  #] CoTBenter :
1056  #[ CoTestUse :
1057 
1058  Possibly to be followed by names of tables.
1059  We make an array of TABLES structs to be tested in AC.usedtables.
1060  Note: only sparse tables are allowed.
1061  No arguments means all tables.
1062 */
1063 
1064 int CoTestUse(UBYTE *s)
1065 {
1066  GETIDENTITY
1067  UBYTE *tablename, c;
1068  WORD type, funnum, *w;
1069  TABLES T;
1070  int error = 0;
1071  w = AT.WorkPointer;
1072  *w++ = TYPETESTUSE; *w++ = 2;
1073  while ( *s ) {
1074  tablename = s;
1075  if ( ( s = SkipAName(s) ) == 0 ) return(1);
1076  c = *s; *s = 0;
1077  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1078  || ( T = functions[funnum].tabl ) == 0 ) {
1079  MesPrint("&%s should be a previously declared table",tablename);
1080  error = 1;
1081  }
1082  else if ( T->sparse == 0 ) {
1083  MesPrint("&%s should be a sparse table",tablename);
1084  error = 1;
1085  }
1086  *w++ = funnum + FUNCTION;
1087  *s = c;
1088  while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
1089  }
1090  AT.WorkPointer[1] = w - AT.WorkPointer;
1091 /*
1092  if ( AT.WorkPointer[1] > 2 ) {
1093  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1094  }
1095 */
1096  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1097  return(error);
1098 }
1099 
1100 /*
1101  #] CoTestUse :
1102  #[ CheckTableDeclarations :
1103 
1104  Checks that all tables in a tablebase have identical properties to
1105  possible previous declarations. If they have not been declared
1106  before, they are declared here.
1107 */
1108 
1109 int CheckTableDeclarations(DBASE *d)
1110 {
1111  WORD type, funnum;
1112  UBYTE *s, *ss, *t, *command = 0;
1113  int k, error = 0, error1, i;
1114  TABLES T;
1115  LONG commandsize = 0;
1116 
1117  s = (UBYTE *)(d->tablenames);
1118  for ( k = 0; k < d->topnumber; k++ ) {
1119  if ( GetVar(s,&type,&funnum,ANYTYPE,NOAUTO) == NAMENOTFOUND ) {
1120 /*
1121  We have to declare the table
1122 */
1123  ss = s; i = 0; while ( *ss ) { ss++; i++; } /* name */
1124  ss++; while ( *ss ) { ss++; i++; } /* tail */
1125  if ( commandsize == 0 ) {
1126  commandsize = i + 15;
1127  if ( commandsize < 100 ) commandsize = 100;
1128  }
1129  if ( (i+11) > commandsize ) {
1130  if ( command ) { M_free(command,"table command"); command = 0; }
1131  commandsize = i+10;
1132  }
1133  if ( command == 0 ) {
1134  command = (UBYTE *)Malloc1(commandsize,"table command");
1135  }
1136  t = command; ss = tablebase; while ( *ss ) *t++ = *ss++;
1137  *t++ = ','; while ( *s ) *t++ = *s++;
1138  s++; while ( *s ) *t++ = *s++;
1139  *t++ = ')'; *t = 0; s++;
1140  error1 = DoTable(command,1);
1141  if ( error1 ) error = error1;
1142  }
1143  else if ( ( type != CFUNCTION )
1144  || ( ( T = functions[funnum].tabl ) == 0 )
1145  || ( T->sparse == 0 ) ) {
1146  MesPrint("&%s has been declared previously, but not as a sparse table.",s);
1147  error = 1;
1148  while ( *s ) s++; s++; while ( *s ) s++; s++;
1149  }
1150  else {
1151 /*
1152  Test dimension and argtail. There should be an exact match.
1153  We are not going to rename arguments when reading the elements.
1154 */
1155  ss = s;
1156  while ( *s ) s++; s++;
1157  if ( StrCmp(s,T->argtail) ) {
1158  MesPrint("&Declaration of table %s in %s different from previous declaration",ss,d->name);
1159  error = 1;
1160  }
1161  while ( *s ) s++; s++;
1162  }
1163  }
1164  if ( command ) { M_free(command,"table command"); }
1165  return(error);
1166 }
1167 
1168 /*
1169  #] CheckTableDeclarations :
1170  #[ CoTBload :
1171 
1172  Loads the table stubbs of the specified tables in the indicated
1173  tablebase. Syntax:
1174  TableBase "tablebasename.tbl" load [tablename(s)];
1175  If no tables are specified all tables are taken.
1176 */
1177 
1178 int CoTBload(UBYTE *ss)
1179 {
1180  DBASE *d;
1181  UBYTE *s, *name, *t, *r, *command, *arguments, *tail;
1182  LONG commandsize;
1183  int num, cs, es, ns, ts, i, j, error = 0, error1;
1184  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1185  MesPrint("&No open tablebase with the name %s",tablebasename);
1186  return(-1);
1187  }
1188  commandsize = 120;
1189  command = (UBYTE *)Malloc1(commandsize,"Fill command");
1190  AC.vetofilling = 1;
1191  if ( *ss ) {
1192  while ( *ss == ',' || *ss == ' ' || *ss == '\t' ) ss++;
1193  while ( *ss ) {
1194  name = ss; ss = SkipAName(ss); *ss = 0;
1195  s = (UBYTE *)(d->tablenames);
1196  num = 0; ns = 0;
1197  while ( *s ) {
1198  num++;
1199  if ( StrCmp(s,name) ) {
1200  while ( *s ) s++; s++; while ( *s ) s++; s++; num++;
1201  continue;
1202  }
1203  name = s; while ( *s ) s++; ns = s-name; s++;
1204  tail = s; while ( *s ) s++; ts = s-tail; s++;
1205  tail++; while ( FG.cTable[*tail] == 1 ) tail++;
1206 /*
1207  Go through all elements
1208 */
1209  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1210  for ( j = 0; j < NUMOBJECTS; j++ ) {
1211  if ( d->iblocks[i]->objects[j].tablenumber == num ) {
1212  t = arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
1213  while ( *t ) t++; es = t - arguments;
1214  cs = 2*es + 2*ns + ts + 10;
1215  if ( cs > commandsize ) {
1216  commandsize = 2*cs;
1217  if ( command ) M_free(command,"Fill command");
1218  command = (UBYTE *)Malloc1(commandsize,"Fill command");
1219  }
1220  r = command; t = name; while ( *t ) *r++ = *t++;
1221  *r++ = '('; t = arguments; while ( *t ) *r++ = *t++;
1222  *r++ = ')'; *r++ = '='; *r++ = 't'; *r++ = 'b'; *r++ = 'l';
1223  *r++ = '_'; *r++ = '('; t = name; while ( *t ) *r++ = *t++;
1224  *r++ = ','; t = arguments; while ( *t ) *r++ = *t++;
1225  t = tail; while ( *t ) {
1226  if ( *t == '?' && r[-1] != ',' ) {
1227  t++;
1228  if ( FG.cTable[*t] == 0 || *t == '$' || *t == '[' ) {
1229  t = SkipAName(t);
1230  if ( *t == '[' ) {
1231  SKIPBRA1(t);
1232  }
1233  }
1234  else if ( *t == '{' ) {
1235  SKIPBRA2(t);
1236  }
1237  else if ( *t ) { *r++ = *t++; continue; }
1238  }
1239  else *r++ = *t++;
1240  }
1241  *r++ = ')'; *r = 0;
1242 /*
1243  Still to do: replacemode or no replacemode?
1244 */
1245  AC.vetotablebasefill = 1;
1246  error1 = CoFill(command);
1247  AC.vetotablebasefill = 0;
1248  if ( error1 < 0 ) goto finishup;
1249  if ( error1 != 0 ) error = error1;
1250  }
1251  }
1252  }
1253  break;
1254  }
1255  while ( *ss == ',' || *ss == ' ' || *ss == '\t' ) ss++;
1256  }
1257  }
1258  else { /* do all of them */
1259  s = (UBYTE *)(d->tablenames);
1260  num = 0; ns = 0;
1261  while ( *s ) {
1262  num++;
1263  name = s; while ( *s ) s++; ns = s-name; s++;
1264  tail = s; while ( *s ) s++; ts = s-tail; s++;
1265  tail++; while ( FG.cTable[*tail] == 1 ) tail++;
1266 /*
1267  Go through all elements
1268 */
1269  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1270  for ( j = 0; j < NUMOBJECTS; j++ ) {
1271  if ( d->iblocks[i]->objects[j].tablenumber == num ) {
1272  t = arguments = (UBYTE *)(d->iblocks[i]->objects[j].element);
1273  while ( *t ) t++; es = t - arguments;
1274  cs = 2*es + 2*ns + ts + 10;
1275  if ( cs > commandsize ) {
1276  commandsize = 2*cs;
1277  if ( command ) M_free(command,"Fill command");
1278  command = (UBYTE *)Malloc1(commandsize,"Fill command");
1279  }
1280  r = command; t = name; while ( *t ) *r++ = *t++;
1281  *r++ = '('; t = arguments; while ( *t ) *r++ = *t++;
1282  *r++ = ')'; *r++ = '='; *r++ = 't'; *r++ = 'b'; *r++ = 'l';
1283  *r++ = '_'; *r++ = '('; t = name; while ( *t ) *r++ = *t++;
1284  *r++ = ','; t = arguments; while ( *t ) *r++ = *t++;
1285  t = tail; while ( *t ) {
1286  if ( *t == '?' && r[-1] != ',' ) {
1287  t++;
1288  if ( FG.cTable[*t] == 0 || *t == '$' || *t == '[' ) {
1289  t = SkipAName(t);
1290  if ( *t == '[' ) {
1291  SKIPBRA1(t);
1292  }
1293  }
1294  else if ( *t == '{' ) {
1295  SKIPBRA2(t);
1296  }
1297  else if ( *t ) { *r++ = *t++; continue; }
1298  }
1299  else *r++ = *t++;
1300  }
1301  *r++ = ')'; *r = 0;
1302 /*
1303  Still to do: replacemode or no replacemode?
1304 */
1305  AC.vetotablebasefill = 1;
1306  error1 = CoFill(command);
1307  AC.vetotablebasefill = 0;
1308  if ( error1 < 0 ) goto finishup;
1309  if ( error1 != 0 ) error = error1;
1310  }
1311  }
1312  }
1313  }
1314  }
1315 finishup:;
1316  AC.vetofilling = 0;
1317  if ( command ) M_free(command,"Fill command");
1318  return(error);
1319 }
1320 
1321 /*
1322  #] CoTBload :
1323  #[ TestUse :
1324 
1325  Look for tbl_(tablename,arguments)
1326  if tablename is encountered, check first whether the element is in
1327  use already. If not, check in the tables in AC.usedtables.
1328  If the element is not there, add it to AC.usedtables.
1329 
1330 
1331  We need the arguments of TestUse to see for which tables it is to be done
1332 */
1333 
1334 WORD TestUse(WORD *term, WORD level)
1335 {
1336  WORD *tstop, *t, *m, *tstart, tabnum;
1337  WORD *funs, numfuns, error = 0;
1338  TABLES T;
1339  LONG i;
1340  CBUF *C = cbuf+AM.rbufnum;
1341  int isp;
1342 
1343  numfuns = C->lhs[level][1] - 2;
1344  funs = C->lhs[level] + 2;
1345  GETSTOP(term,tstop);
1346  t = term+1;
1347  while ( t < tstop ) {
1348  if ( *t != TABLESTUB ) { t += t[1]; continue; }
1349  tstart = t;
1350  m = t + FUNHEAD;
1351  t += t[1];
1352  if ( *m >= -FUNCTION ) continue;
1353  tabnum = -*m;
1354  if ( ( T = functions[tabnum-FUNCTION].tabl ) == 0 ) continue;
1355  if ( T->sparse == 0 ) continue;
1356 /*
1357  Check whether we have to test this one
1358 */
1359  if ( numfuns > 0 ) {
1360  for ( i = 0; i < numfuns; i++ ) {
1361  if ( tabnum == funs[i] ) break;
1362  }
1363  if ( i >= numfuns && numfuns > 0 ) continue;
1364  }
1365 /*
1366  Test whether the element has been defined already.
1367  If not, mark it as used.
1368  Note: we only allow sparse tables (for now)
1369 */
1370  m++;
1371  for ( i = 0; i < T->numind; i++, m += 2 ) {
1372  if ( m >= t || *m != -SNUMBER ) break;
1373  }
1374  if ( ( i == T->numind ) &&
1375  ( ( isp = FindTableTree(T,tstart+FUNHEAD+1,2) ) >= 0 ) ) {
1376  if ( ( T->tablepointers[isp+T->numind+4] & ELEMENTLOADED ) == 0 ) {
1377  T->tablepointers[isp+T->numind+4] |= ELEMENTUSED;
1378  }
1379  }
1380  else {
1381  MesPrint("TestUse: Encountered a table element inside tbl_ that does not correspond to a tablebase element");
1382  error = -1;
1383  }
1384  }
1385  return(error);
1386 }
1387 
1388 /*
1389  #] TestUse :
1390  #[ CoTBaudit :
1391 */
1392 
1393 int CoTBaudit(UBYTE *s)
1394 {
1395  DBASE *d;
1396  UBYTE *name, *tail;
1397  int i, j, error = 0, num;
1398 
1399  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1400  MesPrint("&No open tablebase with the name %s",tablebasename);
1401  return(-1);
1402  }
1403  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1404  while ( *s ) {
1405 /*
1406  Get the options here
1407  They will mainly involve the sorting of the output.
1408 */
1409  s++;
1410  }
1411  s = (UBYTE *)(d->tablenames); num = 0;
1412  while ( *s ) {
1413  num++;
1414  name = s; while ( *s ) s++; s++;
1415  tail = s; while ( *s ) s++; s++;
1416  MesPrint("Table,sparse,%s%s)",name,tail);
1417  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1418  for ( j = 0; j < NUMOBJECTS; j++ ) {
1419  if ( d->iblocks[i]->objects[j].tablenumber == num ) {
1420  MesPrint(" %s(%s)",name,d->iblocks[i]->objects[j].element);
1421  }
1422  }
1423  }
1424  }
1425  return(error);
1426 }
1427 
1428 /*
1429  #] CoTBaudit :
1430  #[ CoTBon :
1431 */
1432 
1433 int CoTBon(UBYTE *s)
1434 {
1435  DBASE *d;
1436  UBYTE *ss, c;
1437  int error = 0;
1438  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1439  MesPrint("&No open tablebase with the name %s",tablebasename);
1440  return(-1);
1441  }
1442  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1443  while ( *s ) {
1444  ss = SkipAName(s);
1445  c = *ss; *ss = 0;
1446  if ( StrICmp(s,(UBYTE *)("compress")) == 0 ) {
1447  d->mode &= ~NOCOMPRESS;
1448  }
1449  else {
1450  MesPrint("&subkey %s not defined in TableBase On statement");
1451  error = 1;
1452  }
1453  *ss = c; s = ss;
1454  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1455  }
1456  return(error);
1457 }
1458 
1459 /*
1460  #] CoTBon :
1461  #[ CoTBoff :
1462 */
1463 
1464 int CoTBoff(UBYTE *s)
1465 {
1466  DBASE *d;
1467  UBYTE *ss, c;
1468  int error = 0;
1469  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1470  MesPrint("&No open tablebase with the name %s",tablebasename);
1471  return(-1);
1472  }
1473  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1474  while ( *s ) {
1475  ss = SkipAName(s);
1476  c = *ss; *ss = 0;
1477  if ( StrICmp(s,(UBYTE *)("compress")) == 0 ) {
1478  d->mode |= NOCOMPRESS;
1479  }
1480  else {
1481  MesPrint("&subkey %s not defined in TableBase Off statement");
1482  error = 1;
1483  }
1484  *ss = c; s = ss;
1485  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1486  }
1487  return(error);
1488 }
1489 
1490 /*
1491  #] CoTBoff :
1492  #[ CoTBcleanup :
1493 */
1494 
1495 int CoTBcleanup(UBYTE *s)
1496 {
1497  DUMMYUSE(s);
1498  MesPrint("&TableBase Cleanup statement not yet implemented");
1499  return(1);
1500 }
1501 
1502 /*
1503  #] CoTBcleanup :
1504  #[ CoTBreplace :
1505 */
1506 
1507 int CoTBreplace(UBYTE *s)
1508 {
1509  DUMMYUSE(s);
1510  MesPrint("&TableBase Replace statement not yet implemented");
1511  return(1);
1512 }
1513 
1514 /*
1515  #] CoTBreplace :
1516  #[ CoTBuse :
1517 
1518  Here the actual table use as determined in TestUse causes the needed
1519  table elements to be loaded
1520 */
1521 
1522 int CoTBuse(UBYTE *s)
1523 {
1524  GETIDENTITY
1525  DBASE *d;
1526  MLONG basenumber;
1527  UBYTE *arguments, *rhs, *buffer, *t, *u, c, *tablename, *p;
1528  LONG size, sum, x;
1529  int i, j, error = 0, error1 = 0, k;
1530  TABLES T = 0;
1531  WORD type, funnum, mode, *w;
1532  if ( ( d = FindTB(tablebasename) ) == 0 ) {
1533  MesPrint("&No open tablebase with the name %s",tablebasename);
1534  return(-1);
1535  }
1536  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1537  if ( *s ) {
1538  while ( *s ) {
1539  tablename = s;
1540  if ( ( s = SkipAName(s) ) == 0 ) return(1);
1541  c = *s; *s = 0;
1542  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1543  || ( T = functions[funnum].tabl ) == 0 ) {
1544  MesPrint("&%s should be a previously declared table",tablename);
1545  basenumber = 0;
1546  }
1547  else if ( T->sparse == 0 ) {
1548  MesPrint("&%s should be a sparse table",tablename);
1549  basenumber = 0;
1550  }
1551  else { basenumber = GetTableName(d,(char *)tablename); }
1552 /* if ( T->spare == 0 ) { SpareTable(T); } */
1553  if ( basenumber > 0 ) {
1554  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1555  for ( j = 0; j < NUMOBJECTS; j++ ) {
1556  if ( d->iblocks[i]->objects[j].tablenumber != basenumber ) continue;
1557  arguments = p = (UBYTE *)(d->iblocks[i]->objects[j].element);
1558 /*
1559  Now translate the arguments and see whether we need
1560  this one....
1561 */
1562  for ( k = 0, w = AT.WorkPointer; k < T->numind; k++ ) {
1563  ParseSignedNumber(x,p);
1564  *w++ = x; p++;
1565  }
1566  sum = FindTableTree(T,AT.WorkPointer,1);
1567  if ( sum < 0 ) {
1568  MesPrint("Table %s in tablebase %s has not been loaded properly"
1569  ,tablename,tablebasename);
1570  error = 1;
1571  continue;
1572  }
1573  sum += T->numind + 4;
1574  mode = T->tablepointers[sum];
1575  if ( ( mode & ELEMENTLOADED ) == ELEMENTLOADED ) {
1576  T->tablepointers[sum] &= ~ELEMENTUSED;
1577  continue;
1578  }
1579  if ( ( mode & ELEMENTUSED ) == 0 ) continue;
1580 /*
1581  We need this one!
1582 */
1583  rhs = (UBYTE *)ReadijObject(d,i,j,(char *)arguments);
1584  if ( rhs ) {
1585  u = rhs; while ( *u ) u++;
1586  size = u-rhs;
1587  u = arguments; while ( *u ) u++;
1588  size += u-arguments;
1589  u = tablename; while ( *u ) u++;
1590  size += u-tablename;
1591  size += 6;
1592  buffer = (UBYTE *)Malloc1(size,"TableBase copy");
1593  t = tablename; u = buffer;
1594  while ( *t ) *u++ = *t++;
1595  *u++ = '(';
1596  t = arguments;
1597  while ( *t ) *u++ = *t++;
1598  *u++ = ')'; *u++ = '=';
1599  t = rhs;
1600  while ( *t ) *u++ = *t++;
1601  if ( t == rhs ) { *u++ = '0'; }
1602  *u++ = 0; *u = 0;
1603  M_free(rhs,"rhs in TBuse xxx");
1604 
1605  error1 = CoFill(buffer);
1606 
1607  if ( error1 < 0 ) { return(error); }
1608  if ( error1 != 0 ) error = error1;
1609  M_free(buffer,"TableBase copy");
1610  }
1611  T->tablepointers[sum] &= ~ELEMENTUSED;
1612  T->tablepointers[sum] |= ELEMENTLOADED;
1613  }
1614  }
1615  }
1616  *s = c;
1617  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1618  }
1619  }
1620  else {
1621  s = (UBYTE *)(d->tablenames); basenumber = 0;
1622  while ( *s ) {
1623  basenumber++;
1624  tablename = s; while ( *s ) s++; s++;
1625  while ( *s ) s++; s++;
1626  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1627  || ( T = functions[funnum].tabl ) == 0 ) {
1628  MesPrint("&%s should be a previously declared table",tablename);
1629  }
1630  else if ( T->sparse == 0 ) {
1631  MesPrint("&%s should be a sparse table",tablename);
1632  }
1633  if ( T->spare && T->mode == 0 ) {
1634  MesPrint("In table %s we have a problem with stubb orders in CoTBuse",tablename);
1635  error = -1;
1636  }
1637 /* if ( T->spare == 0 ) { SpareTable(T); } */
1638  for ( i = 0; i < d->info.numberofindexblocks; i++ ) {
1639  for ( j = 0; j < NUMOBJECTS; j++ ) {
1640  if ( d->iblocks[i]->objects[j].tablenumber == basenumber ) {
1641  arguments = p = (UBYTE *)(d->iblocks[i]->objects[j].element);
1642 /*
1643  Now translate the arguments and see whether we need
1644  this one....
1645 */
1646  for ( k = 0, w = AT.WorkPointer; k < T->numind; k++ ) {
1647  ParseSignedNumber(x,p);
1648  *w++ = x; p++;
1649  }
1650  sum = FindTableTree(T,AT.WorkPointer,1);
1651  if ( sum < 0 ) {
1652  MesPrint("Table %s in tablebase %s has not been loaded properly"
1653  ,tablename,tablebasename);
1654  error = 1;
1655  continue;
1656  }
1657  sum += T->numind + 4;
1658  mode = T->tablepointers[sum];
1659  if ( ( mode & ELEMENTLOADED ) == ELEMENTLOADED ) {
1660  T->tablepointers[sum] &= ~ELEMENTUSED;
1661  continue;
1662  }
1663  if ( ( mode & ELEMENTUSED ) == 0 ) continue;
1664 /*
1665  We need this one!
1666 */
1667  rhs = (UBYTE *)ReadijObject(d,i,j,(char *)arguments);
1668  if ( rhs ) {
1669  u = rhs; while ( *u ) u++;
1670  size = u-rhs;
1671  u = arguments; while ( *u ) u++;
1672  size += u-arguments;
1673  u = tablename; while ( *u ) u++;
1674  size += u-tablename;
1675  size += 6;
1676  buffer = (UBYTE *)Malloc1(size,"TableBase copy");
1677  t = tablename; u = buffer;
1678  while ( *t ) *u++ = *t++;
1679  *u++ = '(';
1680  t = arguments;
1681  while ( *t ) *u++ = *t++;
1682  *u++ = ')'; *u++ = '=';
1683 
1684  t = rhs;
1685  while ( *t ) *u++ = *t++;
1686  if ( t == rhs ) { *u++ = '0'; }
1687  *u++ = 0; *u = 0;
1688  M_free(rhs,"rhs in TBuse");
1689 
1690  error1 = CoFill(buffer);
1691 
1692  if ( error1 < 0 ) { return(error); }
1693  if ( error1 != 0 ) error = error1;
1694  M_free(buffer,"TableBase copy");
1695  }
1696  T->tablepointers[sum] &= ~ELEMENTUSED;
1697  T->tablepointers[sum] |= ELEMENTLOADED;
1698  }
1699  }
1700  }
1701  }
1702  }
1703  return(error);
1704 }
1705 
1706 /*
1707  #] CoTBuse :
1708  #[ CoApply :
1709 
1710  Possibly to be followed by names of tables.
1711 */
1712 
1713 int CoApply(UBYTE *s)
1714 {
1715  GETIDENTITY
1716  UBYTE *tablename, c;
1717  WORD type, funnum, *w;
1718  TABLES T;
1719  LONG maxtogo = MAXPOSITIVE;
1720  int error = 0;
1721  w = AT.WorkPointer;
1722  if ( FG.cTable[*s] == 1 ) {
1723  maxtogo = 0;
1724  while ( FG.cTable[*s] == 1 ) {
1725  maxtogo = maxtogo*10 + (*s-'0');
1726  s++;
1727  }
1728  while ( *s == ',' ) s++;
1729  if ( maxtogo > MAXPOSITIVE || maxtogo < 0 ) maxtogo = MAXPOSITIVE;
1730  }
1731  *w++ = TYPEAPPLY; *w++ = 3; *w++ = maxtogo;
1732  while ( *s ) {
1733  tablename = s;
1734  if ( ( s = SkipAName(s) ) == 0 ) return(1);
1735  c = *s; *s = 0;
1736  if ( ( GetVar(tablename,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1737  || ( T = functions[funnum].tabl ) == 0 ) {
1738  MesPrint("&%s should be a previously declared table",tablename);
1739  error = 1;
1740  }
1741  else if ( T->sparse == 0 ) {
1742  MesPrint("&%s should be a sparse table",tablename);
1743  error = 1;
1744  }
1745  *w++ = funnum + FUNCTION;
1746  *s = c;
1747  while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
1748  }
1749  AT.WorkPointer[1] = w - AT.WorkPointer;
1750 /*
1751  if ( AT.WorkPointer[1] > 2 ) {
1752  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1753  }
1754 */
1755  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1756 /*
1757  AT.WorkPointer[0] = TYPEAPPLYRESET;
1758  AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1759 */
1760  return(error);
1761 }
1762 
1763 /*
1764  #] CoApply :
1765  #[ CoTBhelp :
1766 */
1767 
1768 char *helptb[] = {
1769  "The TableBase statement is used as follows:"
1770  ,"TableBase \"file.tbl\" keyword subkey(s)"
1771  ," in which we have"
1772  ,"Keyword Subkey(s) Action"
1773  ,"open Opens file.tbl for R/W"
1774  ,"create Creates file.tbl for R/W. Old contents are lost"
1775  ,"load Loads all stubs of all tables"
1776  ,"load tablename(s) Loads all stubs the tables mentioned"
1777  ,"enter Loads all stubs and rhs of all tables"
1778  ,"enter tablename(s) Loads all stubs and rhs of the tables mentioned"
1779  ,"audit Prints list of contents"
1780 /* ,"replace tablename saves a table (with overwrite)" */
1781 /* ,"replace tableelement saves a table element (with overwrite)" */
1782 /* ,"cleanup makes tables contingent" */
1783  ,"addto tablename adds all elements if not yet there"
1784  ,"addto tableelement adds element if not yet there"
1785 /* ,"delete tablename removes table from tablebase" */
1786 /* ,"delete tableelement removes element from tablebase" */
1787  ,"on compress elements are stored in gzip format (default)"
1788  ,"off compress elements are stored in uncompressed format"
1789  ,"use compiles all needed elements"
1790  ,"use tablename(s) compiles all needed elements of these tables"
1791  ,""
1792  ,"Related commands are:"
1793  ,"testuse marks which tbl_ elements occur for all tables"
1794  ,"testuse tablename(s) marks which tbl_ elements occur for given tables"
1795  ,"apply replaces tbl_ if rhs available"
1796  ,"apply tablename(s) replaces tbl_ for given tables if rhs available"
1797  ,""
1798  };
1799 
1800 int CoTBhelp(UBYTE *s)
1801 {
1802  int i, ii = sizeof(helptb)/sizeof(char *);
1803  DUMMYUSE(s);
1804  for ( i = 0; i < ii; i++ ) MesPrint("%s",helptb[i]);
1805  return(0);
1806 }
1807 
1808 /*
1809  #] CoTBhelp :
1810  #[ ReWorkT :
1811 
1812  Replaces the STUBBS of the functions in the list.
1813  This gains one space. Hence we have to be very careful
1814 */
1815 
1816 VOID ReWorkT(WORD *term, WORD *funs, WORD numfuns)
1817 {
1818  WORD *tstop, *tend, *m, *t, *tt, *mm, *mmm, *r, *rr;
1819  int i, j;
1820  tend = term + *term; tstop = tend - ABS(tend[-1]);
1821  m = t = term+1;
1822  while ( t < tstop ) {
1823  if ( *t == TABLESTUB ) {
1824  for ( i = 0; i < numfuns; i++ ) {
1825  if ( -t[FUNHEAD] == funs[i] ) break;
1826  }
1827  if ( numfuns == 0 || i < numfuns ) { /* Hit */
1828  i = t[1] - 1;
1829  *m++ = -t[FUNHEAD]; *m++ = i; t += 2; i -= FUNHEAD;
1830  if ( m < t ) { for ( j = 0; j < FUNHEAD-2; j++ ) *m++ = *t++; }
1831  else { m += FUNHEAD-2; t += FUNHEAD-2; }
1832  t++;
1833  while ( i-- > 0 ) { *m++ = *t++; }
1834  tt = t; mm = m;
1835  if ( mm < tt ) {
1836  while ( tt < tend ) *mm++ = *tt++;
1837  *term = mm - term;
1838  tend = term + *term; tstop = tend - ABS(tend[-1]);
1839  t = m;
1840  }
1841  }
1842  else { goto inc; }
1843  }
1844  else if ( *t >= FUNCTION ) {
1845  tt = t + t[1];
1846  mm = m;
1847  for ( j = 0; j < FUNHEAD; j++ ) {
1848  if ( m == t ) { m++; t++; }
1849  else *m++ = *t++;
1850  }
1851  while ( t < tt ) {
1852  if ( *t <= -FUNCTION ) {
1853  if ( m == t ) { m++; t++; }
1854  else *m++ = *t++;
1855  }
1856  else if ( *t < 0 ) {
1857  if ( m == t ) { m += 2; t += 2; }
1858  else { *m++ = *t++; *m++ = *t++; }
1859  }
1860  else {
1861  rr = t + *t; mmm = m;
1862  for ( j = 0; j < ARGHEAD; j++ ) {
1863  if ( m == t ) { m++; t++; }
1864  else *m++ = *t++;
1865  }
1866  while ( t < rr ) {
1867  r = t + *t;
1868  ReWorkT(t,funs,numfuns);
1869  j = *t;
1870  if ( m == t ) { m += j; t += j; }
1871  else { while ( j-- >= 0 ) *m++ = *t++; }
1872  t = r;
1873  }
1874  *mmm = m-mmm;
1875  }
1876  }
1877  mm[1] = m - mm;
1878  t = tt;
1879  }
1880  else {
1881 inc: j = t[1];
1882  if ( m < t ) { while ( j-- >= 0 ) *m++ = *t++; }
1883  else { m += j; t += j; }
1884  }
1885  }
1886  if ( m < t ) {
1887  while ( t < tend ) *m++ = *t++;
1888  *term = m - term;
1889  }
1890 }
1891 
1892 /*
1893  #] ReWorkT :
1894  #[ Apply :
1895 */
1896 
1897 WORD Apply(WORD *term, WORD level)
1898 {
1899  WORD *funs, numfuns;
1900  TABLES T;
1901  int i, j;
1902  CBUF *C = cbuf+AM.rbufnum;
1903 /*
1904  Point the tables in the proper direction
1905 */
1906  numfuns = C->lhs[level][1] - 2;
1907  funs = C->lhs[level] + 2;
1908  if ( numfuns > 0 ) {
1909  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
1910  if ( ( T = functions[i].tabl ) != 0 ) {
1911  for ( j = 0; j < numfuns; j++ ) {
1912  if ( i == (funs[j]-FUNCTION) && T->spare ) {
1913  FlipTable(&(functions[i]),0);
1914  break;
1915  }
1916  }
1917  }
1918  }
1919  }
1920  else {
1921  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
1922  if ( ( T = functions[i].tabl ) != 0 ) {
1923  if ( T->spare ) FlipTable(&(functions[i]),0);
1924  }
1925  }
1926  }
1927 /*
1928  Now the replacements everywhere of
1929  id tbl_(table,?a) = table(?a);
1930  Actually, this has to be done recursively.
1931  Note that we actually gain one space.
1932 */
1933  ReWorkT(term,funs,numfuns);
1934  return(0);
1935 }
1936 
1937 /*
1938  #] Apply :
1939  #[ ApplyExec :
1940 
1941  Replaces occurrences of tbl_(table,indices,pattern) by the proper
1942  rhs of table(indices,pattern). It does this up to maxtogo times
1943  in the given term. It starts with the occurrences inside the
1944  arguments of functions. If necessary it finishes at groundlevel.
1945  An infite number of tries is indicates by maxtogo = 2^15-1 or 2^31-1.
1946  The occurrences are replaced by subexpressions. This allows TestSub
1947  to finish the job properly.
1948 
1949  The main trick here is T = T->spare which turns to the proper rhs.
1950 
1951  The return value is the number of substitutions that can still be made
1952  based on maxtogo. Hence, if the returnvalue is different from maxtogo
1953  there was a substitution.
1954 */
1955 
1956 int ApplyExec(WORD *term, int maxtogo, WORD level)
1957 {
1958  GETIDENTITY
1959  WORD rhsnumber, *Tpattern, *funs, numfuns, funnum;
1960  WORD ii, *t, *t1, *w, *p, *m, *m1, *u, *r, tbufnum, csize, wilds;
1961  NESTING NN;
1962  int i, j, isp, stilltogo;
1963  CBUF *C;
1964  TABLES T;
1965 /*
1966  Startup. We need NestPoin for when we have to replace something deep down.
1967 */
1968  t = term;
1969  m = t + *t;
1970  csize = ABS(m[-1]);
1971  m -= csize;
1972  AT.NestPoin->termsize = t;
1973  if ( AT.NestPoin == AT.Nest ) AN.EndNest = t + *t;
1974  t++;
1975 /*
1976  First we look inside function arguments. Also when clean!
1977 */
1978  while ( t < m ) {
1979  if ( *t < FUNCTION ) { t += t[1]; continue; }
1980  if ( functions[*t-FUNCTION].spec > 0 ) { t += t[1]; continue; }
1981  AT.NestPoin->funsize = t;
1982  r = t + t[1];
1983  t += FUNHEAD;
1984  while ( t < r ) {
1985  if ( *t < 0 ) { NEXTARG(t); continue; }
1986  AT.NestPoin->argsize = t1 = t;
1987  u = t + *t;
1988  t += ARGHEAD;
1989  AT.NestPoin++;
1990  while ( t < u ) {
1991 /*
1992  Now we loop over the terms inside a function argument
1993  This defines a recursion and we have to call ApplyExec again.
1994  The real problem is when we catch something and we have
1995  to insert a subexpression pointer. This may use more or
1996  less space and the whole term has to be readjusted.
1997  This is why we have the NestPoin variables. They tell us
1998  where the sizes of the term, the function and the arguments
1999  are sitting, and also where the dirty flags are.
2000  This readjusting is of course done in the groundlevel code.
2001  Here we worry abound the maxtogo count.
2002 */
2003  stilltogo = ApplyExec(t,maxtogo,level);
2004  if ( stilltogo != maxtogo ) {
2005  if ( stilltogo <= 0 ) {
2006  AT.NestPoin--;
2007  return(stilltogo);
2008  }
2009  maxtogo = stilltogo;
2010  u = t1 + *t1;
2011  m = term + *term - csize;
2012  }
2013  t += *t;
2014  }
2015  AT.NestPoin--;
2016  }
2017  }
2018 /*
2019  Now we look at the ground level
2020 */
2021  C = cbuf+AM.rbufnum;
2022  t = term + 1;
2023  while ( t < m ) {
2024  if ( *t != TABLESTUB ) { t += t[1]; continue; }
2025  funnum = -t[FUNHEAD];
2026  if ( ( funnum < FUNCTION )
2027  || ( funnum >= FUNCTION+WILDOFFSET )
2028  || ( ( T = functions[funnum-FUNCTION].tabl ) == 0 )
2029  || ( T->sparse == 0 )
2030  || ( T->spare == 0 ) ) { t += t[1]; continue; }
2031  numfuns = C->lhs[level][1] - 3;
2032  funs = C->lhs[level] + 3;
2033  if ( numfuns > 0 ) {
2034  for ( i = 0; i < numfuns; i++ ) {
2035  if ( funs[i] == funnum ) break;
2036  }
2037  if ( i >= numfuns ) { t += t[1]; continue; }
2038  }
2039  r = t + t[1];
2040  AT.NestPoin->funsize = t + 1;
2041  t1 = t;
2042  t += FUNHEAD + 1;
2043 /*
2044  Test whether the table catches
2045  Test 1: index arguments and range. isp will be the number
2046  of the element in the table.
2047 */
2048  T = T->spare;
2049 #ifdef WITHPTHREADS
2050  Tpattern = T->pattern[identity];
2051 #else
2052  Tpattern = T->pattern;
2053 #endif
2054  p = Tpattern+FUNHEAD+1;
2055  for ( i = 0; i < T->numind; i++, t += 2 ) {
2056  if ( *t != -SNUMBER ) break;
2057  }
2058  if ( i < T->numind ) { t = r; continue; }
2059  isp = FindTableTree(T,t1+FUNHEAD+1,2);
2060  if ( isp < 0 ) { t = r; continue; }
2061  rhsnumber = T->tablepointers[isp+T->numind];
2062 #if ( TABLEEXTENSION == 2 )
2063  tbufnum = T->bufnum;
2064 #else
2065  tbufnum = T->tablepointers[isp+T->numind+1];
2066 #endif
2067  t = t1+FUNHEAD+2;
2068  ii = T->numind;
2069  while ( --ii >= 0 ) {
2070  *p = *t; t += 2; p += 2;
2071  }
2072 /*
2073  If there are more arguments we have to do some
2074  pattern matching. This should be easy. We addapted the
2075  pattern, so that the array indices match already.
2076 */
2077 #ifdef WITHPTHREADS
2078  AN.FullProto = T->prototype[identity];
2079 #else
2080  AN.FullProto = T->prototype;
2081 #endif
2082  AN.WildValue = AN.FullProto + SUBEXPSIZE;
2083  AN.WildStop = AN.FullProto+AN.FullProto[1];
2084  ClearWild(BHEAD0);
2085  AN.RepFunNum = 0;
2086  AN.RepFunList = AN.EndNest;
2087  AT.WorkPointer = (WORD *)(((UBYTE *)(AN.EndNest)) + AM.MaxTer/2);
2088 /*
2089  The RepFunList is after the term but not very relevant.
2090  We need because MatchFunction uses it
2091 */
2092  if ( AT.WorkPointer + t1[1] >= AT.WorkTop ) { MesWork(); }
2093  wilds = 0;
2094  w = AT.WorkPointer;
2095  *w++ = -t1[FUNHEAD];
2096  *w++ = t1[1] - 1;
2097  for ( i = 2; i < FUNHEAD; i++ ) *w++ = t1[i];
2098  t = t1 + FUNHEAD+1;
2099  while ( t < r ) *w++ = *t++;
2100  t = AT.WorkPointer;
2101  AT.WorkPointer = w;
2102  if ( MatchFunction(BHEAD Tpattern,t,&wilds) > 0 ) {
2103 /*
2104  Here we caught one. Now we should worry about:
2105  1: inserting the subexpression pointer with its wildcards
2106  2: NestPoin because we may not be at the lowest level
2107  The function starts at t1.
2108 */
2109 #ifdef WITHPTHREADS
2110  m1 = T->prototype[identity];
2111 #else
2112  m1 = T->prototype;
2113 #endif
2114  m1[2] = rhsnumber;
2115  m1[4] = tbufnum;
2116  t = t1;
2117  j = t[1];
2118  i = m1[1];
2119  if ( j > i ) {
2120  j = i - j;
2121  NCOPY(t,m1,i);
2122  m1 = AN.EndNest;
2123  while ( r < m1 ) *t++ = *r++;
2124  AN.EndNest = t;
2125  *term += j;
2126  NN = AT.NestPoin;
2127  while ( NN > AT.Nest ) {
2128  NN--;
2129  NN->termsize[0] += j;
2130  NN->funsize[1] += j;
2131  NN->argsize[0] += j;
2132  NN->funsize[2] |= DIRTYFLAG;
2133  NN->argsize[1] |= DIRTYFLAG;
2134  }
2135  m += j;
2136  }
2137  else if ( j < i ) {
2138  j = i-j;
2139  t = AN.EndNest;
2140  while ( t >= r ) { t[j] = *t; t--; }
2141  t = t1;
2142  NCOPY(t,m1,i);
2143  AN.EndNest += j;
2144  *term += j;
2145  NN = AT.NestPoin;
2146  while ( NN > AT.Nest ) {
2147  NN--;
2148  NN->termsize[0] += j;
2149  NN->funsize[1] += j;
2150  NN->argsize[0] += j;
2151  NN->funsize[2] |= DIRTYFLAG;
2152  NN->argsize[1] |= DIRTYFLAG;
2153  }
2154  m += j;
2155  }
2156  else {
2157  NCOPY(t,m1,j);
2158  }
2159  r = t1 + t1[1];
2160  maxtogo--;
2161  if ( maxtogo <= 0 ) return(maxtogo);
2162  }
2163  t = r;
2164  }
2165  return(maxtogo);
2166 }
2167 
2168 /*
2169  #] ApplyExec :
2170  #[ ApplyReset :
2171 */
2172 
2173 WORD ApplyReset(WORD level)
2174 {
2175  WORD *funs, numfuns;
2176  TABLES T;
2177  int i, j;
2178  CBUF *C = cbuf+AM.rbufnum;
2179 
2180  numfuns = C->lhs[level][1] - 2;
2181  funs = C->lhs[level] + 2;
2182  if ( numfuns > 0 ) {
2183  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
2184  if ( ( T = functions[i].tabl ) != 0 ) {
2185  for ( j = 0; j < numfuns; j++ ) {
2186  if ( i == (funs[j]-FUNCTION) && T->spare ) {
2187  FlipTable(&(functions[i]),1);
2188  break;
2189  }
2190  }
2191  }
2192  }
2193  }
2194  else {
2195  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
2196  if ( ( T = functions[i].tabl ) != 0 ) {
2197  if ( T->spare ) FlipTable(&(functions[i]),1);
2198  }
2199  }
2200  }
2201  return(0);
2202 }
2203 
2204 /*
2205  #] ApplyReset :
2206  #[ TableReset :
2207 */
2208 
2209 WORD TableReset()
2210 {
2211  TABLES T;
2212  int i;
2213 
2214  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
2215  if ( ( T = functions[i].tabl ) != 0 && T->spare && T->mode == 0 ) {
2216  functions[i].tabl = T->spare;
2217  }
2218  }
2219  return(0);
2220 }
2221 
2222 /*
2223  #] TableReset :
2224  #[ LoadTableElement :
2225 ?????
2226 int LoadTableElement(DBASE *d, TABLE *T, WORD num)
2227 {
2228 }
2229 
2230  #] LoadTableElement :
2231  #[ ReleaseTB :
2232 
2233  Releases all TableBases
2234 */
2235 
2236 int ReleaseTB()
2237 {
2238  DBASE *d;
2239  int i;
2240  for ( i = NumTableBases - 1; i >= 0; i-- ) {
2241  d = tablebases+i;
2242  fclose(d->handle);
2243  FreeTableBase(d);
2244  }
2245  return(0);
2246 }
2247 
2248 /*
2249  #] ReleaseTB :
2250 */
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
int inicbufs(VOID)
Definition: comtool.c:47
WORD ** lhs
Definition: structs.h:925
int numind
Definition: structs.h:358
WORD mini
Definition: structs.h:295
Definition: structs.h:921
Definition: structs.h:281
int AddNtoL(int n, WORD *array)
Definition: comtool.c:288
TABLES tabl
Definition: structs.h:464
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:3034
LONG mdefined
Definition: structs.h:356
int rootnum
Definition: structs.h:363
WORD * flags
Definition: structs.h:347
struct TaBlEs * TABLES