FORM 4.3
tables.c
Go to the documentation of this file.
1
6/* #[ License : */
7/*
8 * Copyright (C) 1984-2022 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"; */
64static UBYTE *tablebase = (UBYTE *)"tablebase";
65
66/*
67 #] Includes :
68 #[ ClearTableTree :
69*/
70
71void 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
102int 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);
174balance:;
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
263void 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
288int 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
326WORD 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*/
558static 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
573static UBYTE *tablebasename = 0;
574
575int 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 }
587proper:;
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
619int 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
642int 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
682DBASE *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
704int 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
720int 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
738int 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);
890tableabort:;
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
906int 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 }
1050Endofall:;
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
1065int 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
1110int 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
1184int 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 }
1327finishup:;
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
1346WORD 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
1405int 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
1445int 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
1476int 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
1507int 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
1519int 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
1534int 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
1728int 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
1783char *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
1815int 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
1831VOID 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 {
1896inc: 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
1912WORD 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
1971int 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
2188WORD 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
2224WORD 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?????
2241int LoadTableElement(DBASE *d, TABLE *T, WORD num)
2242{
2243}
2244
2245 #] LoadTableElement :
2246 #[ ReleaseTB :
2247
2248 Releases all TableBases
2249*/
2250
2251int 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*/
int AddNtoL(int n, WORD *array)
Definition comtool.c:288
int inicbufs(VOID)
Definition comtool.c:47
WORD Generator(PHEAD WORD *, WORD)
Definition proces.c:3101
WORD ** lhs
Definition structs.h:942
TABLES tabl
Definition structs.h:476
WORD mini
Definition structs.h:307
WORD size
Definition structs.h:309
WORD * pattern
Definition structs.h:356
WORD * buffers
Definition structs.h:364
struct TaBlEs * spare
Definition structs.h:363
WORD * tablepointers
Definition structs.h:350
UBYTE * argtail
Definition structs.h:361
int numtree
Definition structs.h:374
COMPTREE * boomlijst
Definition structs.h:360
LONG reserved
Definition structs.h:366
WORD buffersfill
Definition structs.h:379
int MaxTreeSize
Definition structs.h:376
int strict
Definition structs.h:372
WORD bufferssize
Definition structs.h:378
WORD * flags
Definition structs.h:359
WORD * prototype
Definition structs.h:355
WORD mode
Definition structs.h:381
LONG mdefined
Definition structs.h:368
MINMAX * mm
Definition structs.h:358
int rootnum
Definition structs.h:375
WORD bufnum
Definition structs.h:377
int bounds
Definition structs.h:371
int numind
Definition structs.h:370
LONG totind
Definition structs.h:365
int sparse
Definition structs.h:373
LONG defined
Definition structs.h:367
WORD tablenum
Definition structs.h:380
Definition minos.h:120
struct TaBlEs * TABLES
int blnce
Definition structs.h:298
int right
Definition structs.h:296
int parent
Definition structs.h:294
int value
Definition structs.h:297
int left
Definition structs.h:295
int usage
Definition structs.h:299