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