FORM  4.3
dict.c
Go to the documentation of this file.
1 
18 /* #[ License : */
19 /*
20  * Copyright (C) 1984-2022 J.A.M. Vermaseren
21  * When using this file you are requested to refer to the publication
22  * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
23  * This is considered a matter of courtesy as the development was paid
24  * for by FOM the Dutch physics granting agency and we would like to
25  * be able to track its scientific use to convince FOM of its value
26  * for the community.
27  *
28  * This file is part of FORM.
29  *
30  * FORM is free software: you can redistribute it and/or modify it under the
31  * terms of the GNU General Public License as published by the Free Software
32  * Foundation, either version 3 of the License, or (at your option) any later
33  * version.
34  *
35  * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
36  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
37  * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
38  * details.
39  *
40  * You should have received a copy of the GNU General Public License along
41  * with FORM. If not, see <http://www.gnu.org/licenses/>.
42  */
43 /* #] License : */
44 /*
45  #[ Includes : ratio.c
46 
47  Data setup:
48  AO.Dictionaries Array of pointers to DICTIONARY
49  AO.NumDictionaries
50  AO.SizeDictionaries
51  AO.CurrentDictionary
52  AO.CurDictNumbers
53  AO.CurDictVariables
54  AO.CurDictSpecials
55  AP.OpenDictionary
56 */
57 
58 #include "form3.h"
59 
60 /*
61  #] Includes :
62  #[ TransformRational:
63 
64  Tries to transform the rational number a according to the rules of
65  the current dictionary. Whatever cannot be translated goes to the
66  regular output.
67  Options for AO.CurDictNumbers are:
68  DICT_ALLNUMBERS, DICT_RATIONALONLY, DICT_INTEGERONLY, DICT_NONUMBERS
69 */
70 
71 VOID TransformRational(UWORD *a, WORD na)
72 {
73  DICTIONARY *dict;
74  WORD i, j, nb, i1, i2; UWORD *b;
75  if ( AO.CurrentDictionary <= 0 ) goto NoAction;
76  dict = AO.Dictionaries[AO.CurrentDictionary-1];
77  if ( na < 0 ) na = -na;
78  switch ( AO.CurDictNumbers ) {
79  case DICT_NONUMBERS:
80  goto NoAction;
81  case DICT_INTEGERONLY:
82  if ( a[na] != 1 ) goto NoAction;
83  if ( na > 1 ) {
84  for ( i = 1; i < na; i++ ) {
85  if ( a[na+i] != 0 ) goto NoAction;
86  }
87  }
88 Numeratoronly:;
89  for ( i = dict->numelements-1; i >= 0; i-- ) {
90  if ( dict->elements[i]->type == DICT_INTEGERNUMBER ) {
91  if ( dict->elements[i]->size == na ) {
92  for ( j = 0; j < na; j++ ) {
93  if ( (UWORD)(dict->elements[i]->lhs[j]) != a[j] ) break;
94  }
95  if ( j == na ) { /* Got it */
96  TokenToLine((UBYTE *)(dict->elements[i]->rhs));
97  return;
98  }
99  }
100  }
101  }
102  goto NotFound;
103  case DICT_RATIONALONLY:
104  nb = 2*na;
105  for ( i = dict->numelements-1; i >= 0; i-- ) {
106  if ( dict->elements[i]->type == DICT_RATIONALNUMBER ) {
107  if ( dict->elements[i]->size == nb+2 ) {
108  for ( j = 0; j < nb; j++ ) {
109  if ( (UWORD)(dict->elements[i]->lhs[j+1]) != a[j] ) break;
110  }
111  if ( j == nb ) { /* Got it */
112  TokenToLine((UBYTE *)(dict->elements[i]->rhs));
113  return;
114  }
115  }
116  }
117  }
118  goto NotFound;
119  case DICT_ALLNUMBERS:
120 /*
121  First fish for rationals
122 */
123  nb = 2*na;
124  for ( i = dict->numelements-1; i >= 0; i-- ) {
125  if ( dict->elements[i]->type == DICT_RATIONALNUMBER ) {
126  if ( dict->elements[i]->size == nb+2 ) {
127  for ( j = 0; j < nb; j++ ) {
128  if ( (UWORD)(dict->elements[i]->lhs[j+1]) != a[j] ) break;
129  }
130  if ( j == nb ) { /* Got it */
131  TokenToLine((UBYTE *)(dict->elements[i]->rhs));
132  return;
133  }
134  }
135  }
136  }
137 /*
138  Now look for element[j1]/element[j2]
139 */
140  nb = na; b = a+na;
141  while ( b[nb-1] == 0 ) nb--;
142  if ( nb == 1 && b[0] == 1 ) goto Numeratoronly;
143  while ( a[na-1] == 0 ) na--;
144  for ( i1 = dict->numelements-1; i1 >= 0; i1-- ) {
145  if ( dict->elements[i1]->type == DICT_INTEGERNUMBER ) {
146  if ( dict->elements[i1]->size == na ) {
147  for ( j = 0; j < na; j++ ) {
148  if ( (UWORD)(dict->elements[i1]->lhs[j]) != a[j] ) break;
149  }
150  if ( j == na ) break;
151  }
152  }
153  }
154  for ( i2 = dict->numelements-1; i2 >= 0; i2-- ) {
155  if ( dict->elements[i2]->type == DICT_INTEGERNUMBER ) {
156  if ( dict->elements[i2]->size == nb ) {
157  for ( j = 0; j < nb; j++ ) {
158  if ( (UWORD)(dict->elements[i2]->lhs[j]) != b[j] ) break;
159  }
160  if ( j == nb ) break;
161  }
162  }
163  }
164  if ( i1 < 0 ) {
165  if ( i2 < 0 ) goto NotFound;
166  else { /* number/replacement[i2] */
167  LongToLine(a,na);
168  if ( na > 1 || ( AO.DoubleFlag & 4 ) == 4 ) {
169  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
170  || AC.OutputMode == CMODE ) {
171  if ( ( AO.DoubleFlag & 2 ) == 2 ) { AddToLine((UBYTE *)".Q0/"); }
172  else if ( ( AO.DoubleFlag & 1 ) == 1 ) { AddToLine((UBYTE *)".D0/"); }
173  else { AddToLine((UBYTE *)"/"); }
174  }
175  }
176  else AddToLine((UBYTE *)("/"));
177  TokenToLine((UBYTE *)(dict->elements[i2]->rhs));
178  }
179  }
180  else if ( i2 < 0 ) { /* replacement[i1]/number */
181  TokenToLine((UBYTE *)(dict->elements[i1]->rhs));
182  AddToLine((UBYTE *)("/"));
183  LongToLine((UWORD *)(b),nb);
184  if ( nb > 1 || ( AO.DoubleFlag & 4 ) == 4 ) {
185  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
186  || AC.OutputMode == CMODE ) {
187  if ( ( AO.DoubleFlag & 2 ) == 2 ) { AddToLine((UBYTE *)".Q0"); }
188  else if ( ( AO.DoubleFlag & 1 ) == 1 ) { AddToLine((UBYTE *)".D0"); }
189  }
190  }
191  }
192  else { /* replacement[i1]/replacement[i2] */
193  TokenToLine((UBYTE *)(dict->elements[i1]->rhs));
194  AddToLine((UBYTE *)("/"));
195  TokenToLine((UBYTE *)(dict->elements[i2]->rhs));
196  }
197  break;
198  default:
199  MesPrint("Illegal code in TransformRational: %d",AO.CurDictNumbers);
200  Terminate(-1);
201  }
202  return;
203 NotFound:
204  if ( na != 1 || a[1] != 1 ) {
205  if ( AO.CurDictNumberWarning ) {
206  MesPrint(">>>>>>>>Could not translate coefficient with dictionary %s<<<<<<<<<<<<",dict->name);
207  } }
208 NoAction:
209  RatToLine(a,na);
210  return;
211 }
212 
213 /*
214  #] TransformRational:
215  #[ IsMultiplySign:
216 */
217 
218 UBYTE *IsMultiplySign(VOID)
219 {
220  DICTIONARY *dict;
221  int i;
222  if ( AO.CurrentDictionary <= 0 ) return(0);
223  dict = AO.Dictionaries[AO.CurrentDictionary-1];
224  if ( dict->characters == 0 ) return(0);
225  for ( i = dict->numelements-1; i >= 0; i-- ) {
226  if ( ( dict->elements[i]->type == DICT_SPECIALCHARACTER )
227  && ( dict->elements[i]->lhs[0] == (WORD)('*') ) )
228  return((UBYTE *)(dict->elements[i]->rhs));
229  }
230  return(0);
231 }
232 
233 /*
234  #] IsMultiplySign:
235  #[ IsExponentSign:
236 */
237 
238 UBYTE *IsExponentSign(VOID)
239 {
240  DICTIONARY *dict;
241  int i;
242  if ( AO.CurrentDictionary <= 0 ) return(0);
243  dict = AO.Dictionaries[AO.CurrentDictionary-1];
244  if ( dict->characters == 0 ) return(0);
245  for ( i = dict->numelements-1; i >= 0; i-- ) {
246  if ( ( dict->elements[i]->type == DICT_SPECIALCHARACTER )
247  && ( dict->elements[i]->lhs[0] == (WORD)('^') ) )
248  return((UBYTE *)(dict->elements[i]->rhs));
249  }
250  return(0);
251 }
252 
253 /*
254  #] IsExponentSign:
255  #[ FindSymbol :
256 */
257 
258 UBYTE *FindSymbol(WORD num)
259 {
260  if ( AO.CurrentDictionary > 0 ) {
261  DICTIONARY *dict = AO.Dictionaries[AO.CurrentDictionary-1];
262  int i;
263  if ( dict->variables > 0 && AO.CurDictVariables == DICT_DOVARIABLES ) {
264  for ( i = dict->numelements-1; i >= 0; i-- ) {
265  if ( dict->elements[i]->type == DICT_SYMBOL &&
266  dict->elements[i]->lhs[0] == num )
267  return((UBYTE *)(dict->elements[i]->rhs));
268  }
269  }
270  }
271  return(VARNAME(symbols,num));
272 }
273 
274 /*
275  #] FindSymbol :
276  #[ FindVector :
277 */
278 
279 UBYTE *FindVector(WORD num)
280 {
281  if ( AO.CurrentDictionary > 0 ) {
282  DICTIONARY *dict = AO.Dictionaries[AO.CurrentDictionary-1];
283  int i;
284  if ( dict->variables > 0 && AO.CurDictVariables == DICT_DOVARIABLES ) {
285  for ( i = dict->numelements-1; i >= 0; i-- ) {
286  if ( dict->elements[i]->type == DICT_VECTOR &&
287  dict->elements[i]->lhs[0] == num )
288  return((UBYTE *)(dict->elements[i]->rhs));
289  }
290  }
291  }
292  num -= AM.OffsetVector;
293  return(VARNAME(vectors,num));
294 }
295 
296 /*
297  #] FindVector :
298  #[ FindIndex :
299 */
300 
301 UBYTE *FindIndex(WORD num)
302 {
303  if ( AO.CurrentDictionary > 0 ) {
304  DICTIONARY *dict = AO.Dictionaries[AO.CurrentDictionary-1];
305  int i;
306  if ( dict->variables > 0 && AO.CurDictVariables == DICT_DOVARIABLES ) {
307  for ( i = dict->numelements-1; i >= 0; i-- ) {
308  if ( dict->elements[i]->type == DICT_INDEX &&
309  dict->elements[i]->lhs[0] == num )
310  return((UBYTE *)(dict->elements[i]->rhs));
311  }
312  }
313  }
314  num -= AM.OffsetIndex;
315  return(VARNAME(indices,num));
316 }
317 
318 /*
319  #] FindIndex :
320  #[ FindFunction :
321 */
322 
323 UBYTE *FindFunction(WORD num)
324 {
325  if ( AO.CurrentDictionary > 0 ) {
326  DICTIONARY *dict = AO.Dictionaries[AO.CurrentDictionary-1];
327  int i;
328  if ( dict->variables > 0 && AO.CurDictVariables == DICT_DOVARIABLES ) {
329  for ( i = dict->numelements-1; i >= 0; i-- ) {
330  if ( dict->elements[i]->type == DICT_FUNCTION &&
331  dict->elements[i]->lhs[0] == num )
332  return((UBYTE *)(dict->elements[i]->rhs));
333  }
334  }
335  }
336  num -= FUNCTION;
337  return(VARNAME(functions,num));
338 }
339 
340 /*
341  #] FindFunction :
342  #[ FindFunWithArgs :
343 */
344 
345 UBYTE *FindFunWithArgs(WORD *t)
346 {
347  if ( AO.CurrentDictionary > 0 ) {
348  DICTIONARY *dict = AO.Dictionaries[AO.CurrentDictionary-1];
349  int i, j;
350  if ( dict->funwith > 0
351  && AO.CurDictFunWithArgs == DICT_DOFUNWITHARGS ) {
352  for ( i = dict->numelements-1; i >= 0; i-- ) {
353  if ( dict->elements[i]->type == DICT_FUNCTION_WITH_ARGUMENTS &&
354  (WORD)(dict->elements[i]->lhs[0]) == t[0] &&
355  (WORD)(dict->elements[i]->lhs[1]) == t[1] ) {
356  for ( j = 2; j < t[1]; j++ ) {
357  if ( (WORD)(dict->elements[i]->lhs[j]) != t[j] ) break;
358  }
359  if ( j >= t[1] ) return((UBYTE *)(dict->elements[i]->rhs));
360  }
361  }
362  }
363  }
364  return(0);
365 }
366 
367 /*
368  #] FindFunWithArgs :
369  #[ FindExtraSymbol :
370 
371  The extra symbol is constructed in the WorkSpace. This way we do not
372  have to worry about Malloc and freeing the object later.
373  The input value num is already the number of the extra symbol.
374  We do NOT need num = MAXVARIABLES-num;
375 */
376 
377 UBYTE *FindExtraSymbol(WORD num)
378 {
379  GETIDENTITY;
380  UBYTE *out = (UBYTE *)(AT.WorkPointer);
381  *out = 0;
382  if ( AO.CurrentDictionary > 0 ) {
383  DICTIONARY *dict = AO.Dictionaries[AO.CurrentDictionary-1];
384  int i;
385  if ( dict->ranges > 0 && AO.CurDictVariables == DICT_DOVARIABLES ) {
386  for ( i = dict->numelements-1; i >= 0; i-- ) {
387  if ( dict->elements[i]->type == DICT_RANGE
388  && num >= dict->elements[i]->lhs[0]
389  && num <= dict->elements[i]->lhs[1] ) {
390 /*
391  Now we have to translate the rhs
392  %# gives the number
393  %@ gives the number as its position in the range
394 */
395  UBYTE *r = (UBYTE *)(dict->elements[i]->rhs);
396  while ( *r ) {
397  if ( *r == (UBYTE)'%' && ( r[1] == (UBYTE)'#'
398  || r[1] == (UBYTE)'@' ) ) {
399  if ( r[1] == (UBYTE)'#' ) {
400  out = NumCopy(num,out);
401  }
402  else {
403  out = NumCopy(num-dict->elements[i]->lhs[0]+1,out);
404  }
405  r += 2;
406  }
407  else {
408  *out++ = *r++;
409  }
410  }
411  *out = 0;
412  return((UBYTE *)(AT.WorkPointer));
413  }
414  }
415  }
416  }
417 
418  out = StrCopy((UBYTE *)AC.extrasym,out);
419  if ( AC.extrasymbols == 0 ) {
420  out = NumCopy(num,out);
421  out = StrCopy((UBYTE *)"_",out);
422  }
423  else if ( AC.extrasymbols == 1 ) {
424  out = AddArrayIndex(num,out);
425  }
426  return((UBYTE *)(AT.WorkPointer));
427 }
428 
429 /*
430  #] FindExtraSymbol :
431  #[ FindDictionary :
432 */
433 
434 int FindDictionary(UBYTE *name)
435 {
436  int i;
437  for ( i = 0; i < AO.NumDictionaries; i++ ) {
438  if ( StrCmp(AO.Dictionaries[i]->name,name) == 0 )
439  return(i+1);
440  }
441  return(0);
442 }
443 
444 /*
445  #] FindDictionary :
446  #[ AddDictionary :
447 */
448 
449 int AddDictionary(UBYTE *name)
450 {
451  DICTIONARY *dict;
452 /*
453  First make space for the pointer in the list.
454 */
455  if ( AO.NumDictionaries >= AO.SizeDictionaries-1 ) {
456  DICTIONARY **d;
457  int i;
458  if ( AO.SizeDictionaries <= 0 ) AO.SizeDictionaries = 10;
459  else AO.SizeDictionaries = 2*AO.SizeDictionaries;
460  d = (DICTIONARY **)Malloc1(AO.SizeDictionaries*sizeof(DICTIONARY *),"Dictionaries");
461  for ( i = 0; i < AO.NumDictionaries; i++ ) d[i] = AO.Dictionaries[i];
462  if ( AO.Dictionaries != 0 ) M_free(AO.Dictionaries,"Dictionaries");
463  AO.Dictionaries = d;
464  }
465 /*
466  Now create an empty dictionary.
467 */
468  dict = (DICTIONARY *)Malloc1(sizeof(DICTIONARY),"Dictionary");
469  AO.Dictionaries[AO.NumDictionaries++] = dict;
470  dict->elements = 0;
471  dict->name = strDup1(name,"DictionaryName");
472  dict->sizeelements = 0;
473  dict->numelements = 0;
474  dict->numbers = 0;
475  dict->variables = 0;
476  dict->characters = 0;
477  dict->funwith = 0;
478  dict->gnumelements = 0;
479  dict->ranges = 0;
480 
481  return(AO.NumDictionaries);
482 }
483 
484 /*
485  #] AddDictionary :
486  #[ AddToDictionary :
487 
488  To be called from #add left:right
489 */
490 
491 int AddToDictionary(DICTIONARY *dict,UBYTE *left,UBYTE *right)
492 {
493  GETIDENTITY
494  CBUF *C = cbuf+AC.cbufnum;
495  WORD *w = AT.WorkPointer;
496  WORD *OldWork = AT.WorkPointer;
497  WORD *s, oldnumrhs = C->numrhs, oldnumlhs = C->numlhs;
498  WORD *ow, *ww, *mm, oldEside, *where = 0, type, number, range[3];
499  LONG oldcpointer;
500  int error = 0, sizelhs, sizerhs, i, retcode;
501  UBYTE *r;
502  DICTIONARY_ELEMENT *new;
503  WORD power = (WORD)('^'), times = (WORD)('*');
504  if ( ( left[0] == '^' && left[1] == 0 )
505  || ( left[0] == '*' && left[1] == '*' && left[2] == 0 ) ) {
506  type = DICT_SPECIALCHARACTER;
507  number = 1;
508  where = &power;
509  goto TestDouble;
510  }
511  else if ( left[0] == '*' && left[1] == 0 ) {
512  type = DICT_SPECIALCHARACTER;
513  number = 1;
514  where = &times;
515  goto TestDouble;
516  }
517  else if ( left[0] == '(' ) { /* range of extra symbols */
518  WORD x1 = 0, x2 = 0;
519  r = left+1;
520  while ( FG.cTable[*r] == 1 ) x1 = 10*x1 + *r++ - '0';
521  if ( *r == ',' ) {
522  r++;
523  while ( FG.cTable[*r] == 1 ) x2 = 10*x2 + *r++ - '0';
524  }
525  else x2 = x1;
526  number = 2;
527  if ( *r != ')' ) {
528  MesPrint("&Illegal range specification in LHS of %#add instruction.");
529  return(1);
530  }
531  type = DICT_RANGE;
532  if ( x1 <= 0 || x2 <= 0 || x1 > x2 ) {
533  MesPrint("&Illegal range in LHS of %#add instruction.");
534  return(1);
535  }
536  range[0] = x1;
537  range[1] = x2;
538  range[2] = 0;
539  where = range;
540  goto TestDouble;
541  }
542 /*
543  Translate the left part. Determine type.
544  We follow the code in CoIdExpression and then veto what we do not like.
545  Just make sure to pop what needs to be popped in the compiler buffer.
546 */
547  AC.ProtoType = w;
548  *w++ = SUBEXPRESSION;
549  *w++ = SUBEXPSIZE;
550  *w++ = C->numrhs+1;
551  *w++ = 1;
552  *w++ = AC.cbufnum;
553  FILLSUB(w)
554  AC.WildC = w;
555  AC.NwildC = 0;
556  AT.WorkPointer = s = w + 4*AM.MaxWildcards + 8;
557 /*
558  Now read the LHS
559 */
560  oldcpointer = AddLHS(AC.cbufnum) - C->Buffer;
561 
562  if ( ( retcode = CompileAlgebra(left,LHSIDE,AC.ProtoType) ) < 0 ) { error = 1; }
563  else AC.ProtoType[2] = retcode;
564  AT.WorkPointer = s;
565  if ( AC.NwildC && SortWild(w,AC.NwildC) ) error = 1;
566 
567  OldWork[1] = AC.WildC-OldWork;
568  w = AC.WildC;
569  AT.WorkPointer = w;
570  s = C->rhs[C->numrhs];
571 /*
572  We have the expression in the compiler buffers.
573  The main level is at lhs[numlhs]
574  The partial lhs (including ProtoType) is in OldWork (in WorkSpace)
575  We need to load the result at w after the prototype
576  Because these sort routines don't use the WorkSpace
577  there should not be a conflict
578 */
579  if ( !error && *s == 0 ) {
580 IllLeft:MesPrint("&Illegal LHS in dictionary");
581  AC.lhdollarflag = 0;
582  return(1);
583  }
584  if ( !error && *(s+*s) != 0 ) {
585  MesPrint("&LHS in dictionary should be one term only");
586  return(1);
587  }
588  if ( error == 0 ) {
589  if ( NewSort(BHEAD0) || NewSort(BHEAD0) ) {
590  if ( !error ) error = 1;
591  return(error);
592  }
593  AN.RepPoint = AT.RepCount + 1;
594  ow = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
595  mm = s; ww = ow; i = *mm;
596  while ( --i >= 0 ) *ww++ = *mm++; AT.WorkPointer = ww;
597  AC.lhdollarflag = 0; oldEside = AR.Eside; AR.Eside = LHSIDE;
598  AR.Cnumlhs = C->numlhs;
599  if ( Generator(BHEAD ow,C->numlhs) ) {
600  AR.Eside = oldEside;
601  LowerSortLevel(); LowerSortLevel(); goto IllLeft;
602  }
603  AR.Eside = oldEside;
604  AT.WorkPointer = w;
605  if ( EndSort(BHEAD w,0) < 0 ) { LowerSortLevel(); goto IllLeft; }
606  if ( *w == 0 || *(w+*w) != 0 ) {
607  MesPrint("&LHS must be one term");
608  AC.lhdollarflag = 0;
609  return(1);
610  }
611  LowerSortLevel();
612  }
613  AT.WorkPointer = w + *w;
614  AC.DumNum = 0;
615 /*
616  Everything is now after OldWork. We can pop the compilerbuffer.
617  Next test for illegal things like a coefficient
618  At this point we have:
619  w = the term of the LHS
620 */
621  C->Pointer = C->Buffer + oldcpointer;
622  C->numrhs = oldnumrhs;
623  C->numlhs = oldnumlhs;
624  AC.lhdollarflag = 0;
625 /*
626  Test for undesirables.
627  1: wildcards
628  2: sign
629  3: more than one term
630  4: composite terms
631 */
632  if ( AC.ProtoType[1] != SUBEXPSIZE ) {
633  MesPrint("& Currently no wildcards allowed in dictionaries.");
634  return(1);
635  }
636  if ( w[w[0]-1] < 0 ) {
637  MesPrint("& Currently no sign allowed in dictionaries.");
638  return(1);
639  }
640  if ( w[w[0]] != 0 ) {
641  MesPrint("& More than one term in dictionary element.");
642  return(1);
643  }
644  if ( w[0] == w[w[0]-1]+1 ) { /* Only coefficient */
645  WORD *numer, *denom;
646  WORD nsize, dsize;
647  nsize = dsize = (w[w[0]-1]-1)/2;
648  numer = w+1;
649  denom = numer+nsize;
650  while ( numer[nsize-1] == 0 ) nsize--;
651  while ( denom[dsize-1] == 0 ) dsize--;
652  if ( dsize == 1 && denom[0] == 1 ) {
653  type = DICT_INTEGERNUMBER;
654  number = nsize;
655  where = numer;
656  }
657  else {
658  type = DICT_RATIONALNUMBER;
659  number = w[0];
660  where = w;
661  }
662  }
663  else {
664  s = w + w[0]-1;
665  if ( s[0] != 3 || s[-1] != 1 || s[-2] != 1 ) {
666 Compositeness:;
667  MesPrint("& Currently no composite objects allowed in dictionaries.");
668  return(1);
669  }
670  if ( w[0] != w[2]+4 ) goto Compositeness;
671  s = w+1;
672  switch ( *s ) {
673  case SYMBOL:
674  if ( s[1] != 4 || s[3] != 1 ) goto Compositeness;
675  type = DICT_SYMBOL;
676  number = 1;
677  where = s+2;
678  break;
679  case INDEX:
680  if ( s[1] != 3 ) goto Compositeness;
681  if ( s[2] < 0 ) type = DICT_VECTOR;
682  else type = DICT_INDEX;
683  number = 1;
684  where = s+2;
685  break;
686  default:
687  if ( *s < FUNCTION ) {
688  MesPrint("& Illegal object in dictionary.");
689  return(1);
690  }
691  if ( s[1] == FUNHEAD ) {
692  type = DICT_FUNCTION;
693  number = 1;
694  where = s;
695  break;
696  }
697  else {
698  type = DICT_FUNCTION_WITH_ARGUMENTS;
699  number = s[1];
700  where = s;
701  }
702  break;
703  }
704  }
705 TestDouble:;
706 /*
707  Create a new element
708 */
709  if ( dict->numelements >= dict->sizeelements ) {
710  DICTIONARY_ELEMENT **d;
711  if ( dict->sizeelements <= 0 ) dict->sizeelements = 10;
712  else dict->sizeelements *= 2;
713  d = (DICTIONARY_ELEMENT **)Malloc1(
714  sizeof(DICTIONARY_ELEMENT *)*dict->sizeelements,"Dictionary elements");
715  for ( i = 0; i < dict->numelements; i++ )
716  d[i] = dict->elements[i];
717  if ( dict->elements ) M_free(dict->elements,"Dictionary elements");
718  dict->elements = d;
719  }
720  sizelhs = number+1;
721  sizerhs = 1; r = right; while ( *r++ ) sizerhs++;
722  sizerhs = (sizerhs+sizeof(WORD)-1)/sizeof(WORD)+1;
723  new = (DICTIONARY_ELEMENT *)Malloc1(sizeof(DICTIONARY_ELEMENT)
724  +sizeof(WORD)*(sizelhs+sizerhs),"Dictionary element");
725  new->lhs = (WORD *)(new+1);
726  new->rhs = new->lhs+sizelhs;
727  new->type = type;
728  new->size = number;
729  for ( i = 0; i < number; i++ ) new->lhs[i] = where[i];
730  new->lhs[i] = 0;
731  r = (UBYTE *)(new->rhs);
732  while ( *right ) {
733  if ( *right == '\\' && ( right[1] == '`' || right[1] == '\'' ) ) right++;
734  *r++ = *right++;
735  }
736  *r = 0;
737 
738  dict->elements[dict->numelements++] = new;
739 
740  switch ( type ) {
741  case DICT_INTEGERNUMBER:
742  case DICT_RATIONALNUMBER:
743  dict->numbers++; break;
744  case DICT_SYMBOL:
745  case DICT_VECTOR:
746  case DICT_INDEX:
747  case DICT_FUNCTION:
748  dict->variables++; break;
749  case DICT_FUNCTION_WITH_ARGUMENTS:
750  dict->funwith++; break;
751  case DICT_SPECIALCHARACTER:
752  dict->characters++; break;
753  case DICT_RANGE:
754  dict->ranges++; break;
755  }
756 
757  AT.WorkPointer = OldWork;
758  return(0);
759 }
760 
761 /*
762  #] AddToDictionary :
763  #[ UseDictionary :
764 */
765 
766 int UseDictionary(UBYTE *name,UBYTE *options)
767 {
768  int i;
769  for ( i = 0; i < AO.NumDictionaries; i++ ) {
770  if ( StrCmp(AO.Dictionaries[i]->name,name) == 0 ) {
771  AO.CurrentDictionary = i+1;
772  if ( SetDictionaryOptions(options) < 0 ) {
773  AO.CurrentDictionary = 0;
774  return(-1);
775  }
776  else { /* Now test whether what is requested is really there? */
777  return(0);
778  }
779  }
780  }
781  MesPrint("@There is no dictionary with the name %s",name);
782  exit(-1);
783 }
784 
785 /*
786  #] UseDictionary :
787  #[ SetDictionaryOptions :
788 */
789 
790 int SetDictionaryOptions(UBYTE *options)
791 {
792  UBYTE *opt, *s, c;
793  int retval = 0;
794  s = options;
795  AO.CurDictNumbers = DICT_ALLNUMBERS;
796  AO.CurDictVariables = DICT_DOVARIABLES;
797  AO.CurDictSpecials = DICT_DOSPECIALS;
798  AO.CurDictFunWithArgs = DICT_DOFUNWITHARGS;
799  AO.CurDictNumberWarning = 0;
800  AO.CurDictNotInFunctions= 0;
801  AO.CurDictInDollars = DICT_NOTINDOLLARS;
802  while ( *s ) {
803  opt = s;
804  while ( *s && *s != ',' && *s != ' ' ) s++;
805  c = *s; *s = 0;
806  if ( opt[0] == '$' && opt[1] == 0 ) {
807  AO.CurDictInDollars = DICT_INDOLLARS;
808  }
809  else if ( StrICmp(opt,(UBYTE *)"nonumbers") == 0 ) {
810  AO.CurDictNumbers = DICT_NONUMBERS;
811  }
812  else if ( StrICmp(opt,(UBYTE *)"integersonly") == 0 ) {
813  AO.CurDictNumbers = DICT_INTEGERONLY;
814  }
815  else if ( StrICmp(opt,(UBYTE *)"rationalsonly") == 0 ) {
816  AO.CurDictNumbers = DICT_RATIONALONLY;
817  }
818  else if ( StrICmp(opt,(UBYTE *)"allnumbers") == 0 ) {
819  AO.CurDictNumbers = DICT_ALLNUMBERS;
820  }
821  else if ( StrICmp(opt,(UBYTE *)"novariables") == 0 ) {
822  AO.CurDictVariables = DICT_NOVARIABLES;
823  }
824  else if ( StrICmp(opt,(UBYTE *)"numbersonly") == 0 ) {
825  AO.CurDictNumbers = DICT_ALLNUMBERS;
826  AO.CurDictVariables = DICT_NOVARIABLES;
827  AO.CurDictSpecials = DICT_NOSPECIALS;
828  AO.CurDictFunWithArgs = DICT_NOFUNWITHARGS;
829  }
830  else if ( StrICmp(opt,(UBYTE *)"variablesonly") == 0 ) {
831  AO.CurDictNumbers = DICT_NONUMBERS;
832  AO.CurDictVariables = DICT_DOVARIABLES;
833  AO.CurDictSpecials = DICT_NOSPECIALS;
834  AO.CurDictFunWithArgs = DICT_NOFUNWITHARGS;
835  }
836  else if ( StrICmp(opt,(UBYTE *)"nospecials") == 0 ) {
837  AO.CurDictSpecials = DICT_NOSPECIALS;
838  }
839  else if ( StrICmp(opt,(UBYTE *)"specialsonly") == 0 ) {
840  AO.CurDictNumbers = DICT_NONUMBERS;
841  AO.CurDictVariables = DICT_NOVARIABLES;
842  AO.CurDictSpecials = DICT_DOSPECIALS;
843  AO.CurDictFunWithArgs = DICT_NOFUNWITHARGS;
844  }
845  else if ( StrICmp(opt,(UBYTE *)"nofunwithargs") == 0 ) {
846  AO.CurDictFunWithArgs = DICT_NOFUNWITHARGS;
847  }
848  else if ( StrICmp(opt,(UBYTE *)"funwithargsonly") == 0 ) {
849  AO.CurDictNumbers = DICT_NONUMBERS;
850  AO.CurDictVariables = DICT_NOVARIABLES;
851  AO.CurDictSpecials = DICT_NOSPECIALS;
852  AO.CurDictFunWithArgs = DICT_DOFUNWITHARGS;
853  }
854  else if ( StrICmp(opt,(UBYTE *)"warnings") == 0
855  || StrICmp(opt,(UBYTE *)"warning") == 0 ) {
856  AO.CurDictNumberWarning = 1;
857  }
858  else if ( StrICmp(opt,(UBYTE *)"nowarnings") == 0
859  || StrICmp(opt,(UBYTE *)"nowarning") == 0 ) {
860  AO.CurDictNumberWarning = 0;
861  }
862  else if ( StrICmp(opt,(UBYTE *)"infunctions") == 0 ) {
863  AO.CurDictNotInFunctions= 0;
864  }
865  else if ( StrICmp(opt,(UBYTE *)"notinfunctions") == 0 ) {
866  AO.CurDictNotInFunctions= 1;
867  }
868  else {
869  MesPrint("@ Unrecognized option in %#SetDictionary: %s",opt);
870  retval = -1;
871  }
872  *s = c;
873  if ( c == ',' ) s++;
874  }
875  return(retval);
876 }
877 
878 /*
879  #] SetDictionaryOptions :
880  #[ UnSetDictionary :
881 */
882 
883 void UnSetDictionary(VOID)
884 {
885  AO.CurrentDictionary = 0;
886  AO.CurDictNumbers = -1;
887  AO.CurDictVariables = -1;
888  AO.CurDictSpecials = -1;
889  AO.CurDictFunWithArgs = -1;
890  AO.CurDictFunWithArgs = -1;
891  AO.CurDictNumberWarning = -1;
892  AO.CurDictNotInFunctions= -1;
893 }
894 
895 /*
896  #] UnSetDictionary :
897  #[ RemoveDictionary :
898 
899  Mostly needed for .clear
900 */
901 
902 void RemoveDictionary(DICTIONARY *dict)
903 {
904  int i;
905  if ( dict == 0 ) return;
906  for ( i = 0; i < AO.NumDictionaries; i++ ) {
907  if ( AO.Dictionaries[i] == dict ) {
908  for (i++; i < AO.NumDictionaries; i++ ) {
909  AO.Dictionaries[i-1] = AO.Dictionaries[i];
910  }
911  AO.NumDictionaries--;
912  goto removeit;
913  }
914  }
915  MesPrint("@ Dictionary not found in RemoveDictionary");
916  exit(-1);
917 removeit:;
918  for ( i = 0; i < dict->numelements; i++ )
919  M_free(dict->elements[i],"Dictionary element");
920  for ( i = 0; i < dict->numelements; i++ ) dict->elements[i] = 0;
921  if ( dict->elements ) M_free(dict->elements,"Dictionary elements");
922  if ( dict->name ) {
923  M_free(dict->name,"DictionaryName");
924  dict->name = 0;
925  }
926  dict->sizeelements = 0;
927  dict->numelements = 0;
928  dict->numbers = 0;
929  dict->variables = 0;
930  dict->characters = 0;
931  dict->funwith = 0;
932  dict->gnumelements = 0;
933  dict->ranges = 0;
934 }
935 
936 /*
937  #] RemoveDictionary :
938  #[ ShrinkDictionary :
939 
940  To be called after a .store to restore the dictionary to the state
941  it had at the last .global
942  We do not make the elements array shorter.
943 */
944 
945 void ShrinkDictionary(DICTIONARY *dict)
946 {
947  while ( dict->numelements > dict->gnumelements ) {
948  dict->numelements--;
949  M_free(dict->elements[dict->numelements],"Dictionary element");
950  dict->elements[dict->numelements] = 0;
951  }
952 }
953 
954 /*
955  #] ShrinkDictionary :
956  #[ DoPreOpenDictionary :
957 */
958 
959 int DoPreOpenDictionary(UBYTE *s)
960 {
961  UBYTE *name;
962  int dict;
963  if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
964  if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
965  while ( *s == ' ' ) s++;
966 
967  name = s; s = SkipAName(s);
968  if ( *s != 0 && *s != ';' ) {
969  MesPrint("@proper syntax is #opendictionary name");
970  return(-1);
971  }
972  *s = 0;
973 
974  if ( AP.OpenDictionary > 0 ) {
975  MesPrint("@you cannot nest #opendictionary instructions");
976  MesPrint("@dictionary %s is open already",
977  AO.Dictionaries[AP.OpenDictionary-1]->name);
978  return(-1);
979  }
980  if ( AO.CurrentDictionary > 0 ) {
981  MesPrint("@before opening a dictionary you have to first close the selected dictionary");
982  return(-1);
983  }
984 /*
985  Do we have this dictionary already?
986 */
987  dict = FindDictionary(name);
988  if ( dict == 0 ) dict = AddDictionary(name);
989  AP.OpenDictionary = dict;
990  return(0);
991 }
992 
993 /*
994  #] DoPreOpenDictionary :
995  #[ DoPreCloseDictionary :
996 */
997 
998 int DoPreCloseDictionary(UBYTE *s)
999 {
1000  if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
1001  if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
1002  while ( *s == ' ' ) s++;
1003 
1004  if ( AP.OpenDictionary == 0 && AO.CurrentDictionary == 0 ) {
1005  MesPrint("@you have neither an open, nor a selected dictionary");
1006  return(-1);
1007  }
1008 
1009  AP.OpenDictionary = 0;
1010  AO.CurrentDictionary = 0;
1011 
1012  AO.CurDictNotInFunctions = 0;
1013 
1014  return(0);
1015 }
1016 
1017 /*
1018  #] DoPreCloseDictionary :
1019  #[ DoPreUseDictionary :
1020 */
1021 
1022 int DoPreUseDictionary(UBYTE *s)
1023 {
1024  UBYTE *options, c, *ss, *sss, *name;
1025  if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
1026  if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
1027  while ( *s == ' ' ) s++;
1028 
1029  if ( AP.OpenDictionary > 0 ) {
1030  MesPrint("@before selecting a dictionary you have to first close the open dictionary");
1031  return(-1);
1032  }
1033 
1034  name = s; s = SkipAName(s);
1035  ss = s; while ( *s && *s != '(' ) s++;
1036  c = *ss; *ss = 0;
1037  if ( c == 0 ) {
1038  options = ss;
1039  }
1040  else {
1041  options = s+1; SKIPBRA3(s)
1042  if ( *s != ')' ) {
1043  MesPrint("@Irregular end of %#UseDictionary instruction");
1044  return(-1);
1045  }
1046  sss = s;
1047  s++; while ( *s == ' ' || *s == '\t' || *s == ';' ) s++;
1048  *sss = 0;
1049  if ( *s ) {
1050  MesPrint("@Irregular end of %#UseDictionary instruction");
1051  return(-1);
1052  }
1053  }
1054  return(UseDictionary(name,options));
1055 }
1056 
1057 /*
1058  #] DoPreUseDictionary :
1059  #[ DoPreAdd :
1060 
1061  Syntax:
1062  #add left :right
1063  #add left : "right"
1064  Adds to the currently open dictionary
1065 */
1066 
1067 int DoPreAdd(UBYTE *s)
1068 {
1069  UBYTE *left, *right;
1070 
1071  if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
1072  if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
1073  while ( *s == ' ' ) s++;
1074 
1075  if ( AP.OpenDictionary == 0 ) {
1076  MesPrint("@there is no open dictionary to add to");
1077  return(-1);
1078  }
1079 /*
1080  Scan to the : and mark the left and right parts.
1081 */
1082  left = s;
1083  while ( *s && *s != ':' ) {
1084  if ( *s == '[' ) { SKIPBRA1(s) s++; }
1085  else if ( *s == '{' ) { SKIPBRA2(s) s++; }
1086  else if ( *s == '(' ) { SKIPBRA3(s) s++; }
1087  else if ( *s == ']' || *s == '}' || *s == ')' ) {
1088  MesPrint("@unmatched brackets in #add instruction");
1089  return(-1);
1090  }
1091  else s++;
1092  }
1093  if ( *s == 0 ) {
1094  MesPrint("@Missing : in #add instruction");
1095  return(-1);
1096  }
1097  *s++ = 0;
1098  right = s;
1099  while ( *s == ' ' || *s == '\t' ) s++;
1100  if ( *s == '"' && s[1] ) {
1101  right = s+1;
1102  s = s+2;
1103  while ( *s ) s++;
1104  while ( s[-1] != '"' ) s--;
1105  if ( s <= right ) {
1106  MesPrint("@Irregular use of double quotes in #add instruction");
1107  return(-1);
1108  }
1109  s[-1] = 0;
1110  }
1111  return(AddToDictionary(AO.Dictionaries[AP.OpenDictionary-1],left,right));
1112 }
1113 
1114 /*
1115  #] DoPreAdd :
1116  #[ DictToBytes :
1117 */
1118 
1119 LONG DictToBytes(DICTIONARY *dict,UBYTE *buf)
1120 {
1121  int numelements = dict->numelements, sizeelement, i, j, x;
1122  UBYTE *s1, *s2 = buf;
1123  DICTIONARY_ELEMENT *e;
1124 /*
1125  First copy the struct
1126 */
1127  s1 = (UBYTE *)dict; j = sizeof(DICTIONARY);
1128  NCOPY(s2,s1,j)
1129 /*
1130  Now the elements. Put a size indicator in front of each of them.
1131 */
1132  for ( i = 0; i < numelements; i++ ) {
1133  e = dict->elements[i];
1134  sizeelement = sizeof(DICTIONARY_ELEMENT)+(e->size+1)*sizeof(WORD);
1135  s1 = (UBYTE *)e->rhs; x = 0;
1136  while ( *s1 ) { s1++; x++; }
1137  x /= sizeof(WORD);
1138  sizeelement += (x+1) * sizeof(WORD);
1139  s1 = (UBYTE *)(&sizeelement); j = sizeof(WORD); NCOPY(s2,s1,j)
1140  s1 = (UBYTE *)e; j = sizeof(DICTIONARY_ELEMENT); NCOPY(s2,s1,j)
1141  s1 = (UBYTE *)e->lhs; j = (e->size+1)*(sizeof(WORD)); NCOPY(s2,s1,j)
1142  s1 = (UBYTE *)e->rhs; j = (x+1)*(sizeof(WORD)); NCOPY(s2,s1,j)
1143  }
1144  return(s2-buf);
1145 }
1146 
1147 /*
1148  #] DictToBytes :
1149  #[ DictFromBytes :
1150 */
1151 
1152 DICTIONARY *DictFromBytes(UBYTE *buf)
1153 {
1154  DICTIONARY *dict = Malloc1(sizeof(DICTIONARY),"Dictionary");
1155  UBYTE *s1, *s2;
1156  int i, j, sizeelement;
1157  DICTIONARY_ELEMENT *e;
1158 /*
1159  First read the dictionary itself
1160 */
1161  s1 = buf;
1162  s2 = (UBYTE *)dict; j = sizeof(DICTIONARY); NCOPY(s2,s1,j)
1163 /*
1164  Allocate the elements array:
1165 */
1166  dict->elements = (DICTIONARY_ELEMENT **)Malloc1(
1167  sizeof(DICTIONARY_ELEMENT *)*dict->sizeelements,"dictionary elements");
1168  for ( i = 0; i < dict->numelements; i++ ) {
1169  s2 = (UBYTE *)(&sizeelement); j = sizeof(WORD); NCOPY(s2,s1,j)
1170  e = (DICTIONARY_ELEMENT *)Malloc1(sizeelement*sizeof(UBYTE),"dictionary element");
1171  dict->elements[i] = e;
1172  j = sizeelement; s2 = (UBYTE *)e; NCOPY(s2,s1,j)
1173  e->lhs = (WORD *)(e+1);
1174  e->rhs = e->lhs + e->size+1;
1175  }
1176  return(dict);
1177 }
1178 
1179 /*
1180  #] DictFromBytes :
1181 */
Definition: structs.h:938
WORD SortWild(WORD *, WORD)
Definition: sort.c:4552
WORD * AddLHS(int num)
Definition: comtool.c:188
VOID LowerSortLevel()
Definition: sort.c:4727
WORD NewSort(PHEAD0)
Definition: sort.c:592
WORD Generator(PHEAD WORD *, WORD)
Definition: proces.c:3101
LONG EndSort(PHEAD WORD *, int)
Definition: sort.c:682