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