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