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