FORM  4.1
sch.c
Go to the documentation of this file.
1 
6 /* #[ License : */
7 /*
8  * Copyright (C) 1984-2013 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 : sch.c
34 */
35 
36 #include "form3.h"
37 
38 #ifdef ANSI
39 #include <stdarg.h>
40 #else
41 #ifdef mBSD
42 #include <varargs.h>
43 #else
44 #ifdef VMS
45 #include <varargs.h>
46 #else
47 typedef UBYTE *va_list;
48 #define va_dcl int va_alist;
49 #define va_start(list) list = (UBYTE *) &va_alist
50 #define va_end(list)
51 #define va_arg(list,mode) (((mode *)(list += sizeof(mode)))[-1])
52 #endif
53 #endif
54 #endif
55 
56 static int startinline = 0;
57 static char fcontchar = '&';
58 static int noextralinefeed = 0;
59 static int lowestlevel = 1;
60 
61 /*
62  #] Includes :
63  #[ schryf-Utilities :
64  #[ StrCopy : UBYTE *StrCopy(from,to)
65 */
66 
67 UBYTE *StrCopy(UBYTE *from, UBYTE *to)
68 {
69  while( ( *to++ = *from++ ) != 0 );
70  return(to-1);
71 }
72 
73 /*
74  #] StrCopy :
75  #[ AddToLine : VOID AddToLine(s)
76 
77  Puts the characters of s in the outputline. If the line becomes
78  filled it is written.
79 
80 */
81 
82 VOID AddToLine(UBYTE *s)
83 {
84  UBYTE *Out;
85  LONG num;
86  int i;
87  if ( AO.OutInBuffer ) { AddToDollarBuffer(s); return; }
88  Out = AO.OutFill;
89  while ( *s ) {
90  if ( Out >= AO.OutStop ) {
91  if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
92  *Out++ = fcontchar;
93  }
94 #ifdef WITHRETURN
95  *Out++ = CARRIAGERETURN;
96 #endif
97  *Out++ = LINEFEED;
98  AO.FortFirst = 0;
99  num = Out - AO.OutputLine;
100 
101  if ( AC.LogHandle >= 0 ) {
102  if ( WriteFile(AC.LogHandle,AO.OutputLine+startinline
103  ,num-startinline) != (num-startinline) ) {
104 /*
105  We cannot write to an otherwise open log file.
106  The disk could be full of course.
107 */
108 #ifdef DEBUGGER
109  if ( BUG.logfileflag == 0 ) {
110  fprintf(stderr,"Panic: Cannot write to log file! Disk full?\n");
111  BUG.logfileflag = 1;
112  }
113  BUG.eflag = 1; BUG.printflag = 1;
114 #else
115  Terminate(-1);
116 #endif
117  }
118  }
119 
120  if ( ( AO.PrintType & PRINTLFILE ) == 0 ) {
121 #ifdef WITHRETURN
122  if ( num > 1 && AO.OutputLine[num-2] == CARRIAGERETURN ) {
123  AO.OutputLine[num-2] = LINEFEED;
124  num--;
125  }
126 #endif
127  if ( WriteFile(AM.StdOut,AO.OutputLine+startinline
128  ,num-startinline) != (num-startinline) ) {
129 #ifdef DEBUGGER
130  if ( BUG.stdoutflag == 0 ) {
131  fprintf(stderr,"Panic: Cannot write to standard output!\n");
132  BUG.stdoutflag = 1;
133  }
134  BUG.eflag = 1; BUG.printflag = 1;
135 #else
136  Terminate(-1);
137 #endif
138  }
139  }
140  /* thomasr 23/04/09: A continuation line has been started.
141  * In Fortran90 we do not want a space after the initial
142  * '&' character otherwise we might end up with something
143  * like:
144  * ... 2.&
145  * & 0 ...
146  */
147  startinline = 0;
148  for ( i = 0; i < AO.OutSkip; i++ ) AO.OutputLine[i] = ' ';
149  Out = AO.OutputLine + AO.OutSkip;
150  if ( ( AC.OutputMode == FORTRANMODE
151  || AC.OutputMode == PFORTRANMODE ) && AO.OutSkip == 7 ) {
152  /* thomasr 23/04/09: fix leading blank in fortran90 mode */
153  if(AC.IsFortran90 == ISFORTRAN90) {
154  Out[-1] = fcontchar;
155  }
156  else {
157  Out[-2] = fcontchar;
158  Out[-1] = ' ';
159  }
160  }
161  if ( AO.IsBracket ) { *Out++ = ' ';
162  if ( AC.OutputSpaces == NORMALFORMAT ) {
163  *Out++ = ' '; *Out++ = ' '; }
164  }
165  *Out = '\0';
166  if ( AC.OutputMode == FORTRANMODE
167  || ( AC.OutputMode == CMODE && AO.FactorMode == 0 )
168  || AC.OutputMode == PFORTRANMODE )
169  AO.InFbrack++;
170  }
171  *Out++ = *s++;
172  }
173  *Out = '\0';
174  AO.OutFill = Out;
175 }
176 
177 /*
178  #] AddToLine :
179  #[ FiniLine : VOID FiniLine()
180 */
181 
182 VOID FiniLine()
183 {
184  UBYTE *Out;
185  WORD i;
186  LONG num;
187  if ( AO.OutInBuffer ) return;
188  Out = AO.OutFill;
189  while ( Out > AO.OutputLine ) {
190  if ( Out[-1] == ' ' ) Out--;
191  else break;
192  }
193  i = (WORD)(Out-AO.OutputLine);
194  if ( noextralinefeed == 0 ) {
195  if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90
196  && Out > AO.OutputLine ) {
197 /*
198  *Out++ = fcontchar;
199 */
200  }
201 #ifdef WITHRETURN
202  *Out++ = CARRIAGERETURN;
203 #endif
204  *Out++ = LINEFEED;
205  AO.FortFirst = 0;
206  }
207  num = Out - AO.OutputLine;
208 
209  if ( AC.LogHandle >= 0 ) {
210  if ( WriteFile(AC.LogHandle,AO.OutputLine+startinline
211  ,num-startinline) != (num-startinline) ) {
212 #ifdef DEBUGGER
213  if ( BUG.logfileflag == 0 ) {
214  fprintf(stderr,"Panic: Cannot write to log file! Disk full?\n");
215  BUG.logfileflag = 1;
216  }
217  BUG.eflag = 1; BUG.printflag = 1;
218 #else
219  Terminate(-1);
220 #endif
221  }
222  }
223 
224  if ( ( AO.PrintType & PRINTLFILE ) == 0 ) {
225 #ifdef WITHRETURN
226  if ( num > 1 && AO.OutputLine[num-2] == CARRIAGERETURN ) {
227  AO.OutputLine[num-2] = LINEFEED;
228  num--;
229  }
230 #endif
231  if ( WriteFile(AM.StdOut,AO.OutputLine+startinline,
232  num-startinline) != (num-startinline) ) {
233 #ifdef DEBUGGER
234  if ( BUG.stdoutflag == 0 ) {
235  fprintf(stderr,"Panic: Cannot write to standard output!\n");
236  BUG.stdoutflag = 1;
237  }
238  BUG.eflag = 1; BUG.printflag = 1;
239 #else
240  Terminate(-1);
241 #endif
242  }
243  }
244  startinline = 0;
245  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
246  || ( AC.OutputMode == CMODE && AO.FactorMode == 0 ) ) AO.InFbrack++;
247  Out = AO.OutputLine;
248  AO.OutStop = Out + AC.LineLength;
249  i = AO.OutSkip;
250  while ( --i >= 0 ) *Out++ = ' ';
251  if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
252  && AO.OutSkip == 7 ) {
253  Out[-2] = fcontchar;
254  Out[-1] = ' ';
255  }
256  AO.OutFill = Out;
257 }
258 
259 /*
260  #] FiniLine :
261  #[ IniLine : VOID IniLine(extrablank)
262 
263  Initializes the output line for the type of output
264 
265 */
266 
267 VOID IniLine(WORD extrablank)
268 {
269  UBYTE *Out;
270  Out = AO.OutputLine;
271  AO.OutStop = Out + AC.LineLength;
272  *Out++ = ' ';
273  *Out++ = ' ';
274  *Out++ = ' ';
275  *Out++ = ' ';
276  *Out++ = ' ';
277  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE ) {
278  *Out++ = fcontchar;
279  AO.OutSkip = 7;
280  }
281  else
282  AO.OutSkip = 6;
283  *Out++ = ' ';
284  while ( extrablank > 0 ) {
285  *Out++ = ' ';
286  extrablank--;
287  }
288  AO.OutFill = Out;
289 }
290 
291 /*
292  #] IniLine :
293  #[ LongToLine : VOID LongToLine(a,na)
294 
295  Puts a Long integer in the output line. If it is only a single
296  word long it is put in the line as a single token.
297  The sign of a is ignored.
298 
299 */
300 
301 static UBYTE *LLscratch = 0;
302 
303 VOID LongToLine(UWORD *a, WORD na)
304 {
305  UBYTE *OutScratch;
306  if ( LLscratch == 0 ) {
307  LLscratch = (UBYTE *)Malloc1(4*(AM.MaxTal*sizeof(WORD)+2)*sizeof(UBYTE),"LongToLine");
308  }
309  OutScratch = LLscratch;
310  if ( na < 0 ) na = -na;
311  if ( na > 1 ) {
312  PrtLong(a,na,OutScratch);
313  if ( AO.NoSpacesInNumbers || AC.OutputMode == REDUCEMODE ) {
314  AO.BlockSpaces = 1;
315  TokenToLine(OutScratch);
316  AO.BlockSpaces = 0;
317  }
318  else {
319  TokenToLine(OutScratch);
320  }
321  }
322  else if ( !na ) TokenToLine((UBYTE *)"0");
323  else TalToLine(*a);
324 }
325 
326 /*
327  #] LongToLine :
328  #[ RatToLine : VOID RatToLine(a,na)
329 
330  Puts a rational number in the output line. The sign is ignored.
331 
332 */
333 
334 static UBYTE *RLscratch = 0;
335 static UWORD *RLscratE = 0;
336 
337 VOID RatToLine(UWORD *a, WORD na)
338 {
339  GETIDENTITY
340  WORD adenom, anumer;
341  if ( na < 0 ) na = -na;
342  if ( AC.OutNumberType == RATIONALMODE ) {
343 /*
344  We need some special provisions for the various Fortran modes.
345  In PFORTRAN we use
346  one if denom = numerator = 1
347  integer if denom = 1
348  (one/integer) if numerator = 1
349  ((one*integer)/integer) in the general case
350 */
351  if ( AC.OutputMode == PFORTRANMODE ) {
352  UnPack(a,na,&adenom,&anumer);
353  if ( na == 1 && a[0] == 1 && a[1] == 1 ) {
354  AddToLine((UBYTE *)"one");
355  return;
356  }
357  if ( adenom == 1 && a[na] == 1 ) {
358  LongToLine(a,anumer);
359  if ( anumer > 1 ) { AddToLine((UBYTE *)".D0"); }
360  }
361  else if ( anumer == 1 && a[0] == 1 ) {
362  a += na;
363  AddToLine((UBYTE *)"(one/");
364  LongToLine(a,adenom);
365  if ( adenom > 1 ) { AddToLine((UBYTE *)".D0"); }
366  AddToLine((UBYTE *)")");
367  }
368  else {
369  if ( anumer > 1 || adenom > 1 ) {
370  LongToLine(a,anumer);
371  if ( anumer > 1 ) { AddToLine((UBYTE *)".D0"); }
372  a += na;
373  AddToLine((UBYTE *)"/");
374  LongToLine(a,adenom);
375  if ( adenom > 1 ) { AddToLine((UBYTE *)".D0"); }
376  }
377  else {
378  AddToLine((UBYTE *)"((one*");
379  LongToLine(a,anumer);
380  a += na;
381  AddToLine((UBYTE *)")/");
382  LongToLine(a,adenom);
383  AddToLine((UBYTE *)")");
384  }
385  }
386  }
387  else {
388  UnPack(a,na,&adenom,&anumer);
389  LongToLine(a,anumer);
390  a += na;
391  if ( anumer && !( adenom == 1 && *a == 1 ) ) {
392  if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
393  if ( AC.Fortran90Kind ) {
394  AddToLine(AC.Fortran90Kind);
395  AddToLine((UBYTE *)"/");
396  }
397  else {
398  AddToLine((UBYTE *)"./");
399  }
400  }
401  else if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == CMODE ) {
402  if ( AO.DoubleFlag ) { AddToLine((UBYTE *)".D0/"); }
403  else { AddToLine((UBYTE *)"./"); }
404  }
405  else AddToLine((UBYTE *)"/");
406  LongToLine(a,adenom);
407  if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
408  if ( AC.Fortran90Kind ) {
409  AddToLine(AC.Fortran90Kind);
410  }
411  else {
412  AddToLine((UBYTE *)".");
413  }
414  }
415  else if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == CMODE ) {
416  if ( AO.DoubleFlag ) { AddToLine((UBYTE *)".D0"); }
417  else { AddToLine((UBYTE *)"."); }
418  }
419  }
420  else if ( anumer > 1 && ( AC.OutputMode == FORTRANMODE
421  || AC.OutputMode == CMODE ) ) {
422  if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
423  if ( AC.Fortran90Kind ) {
424  AddToLine(AC.Fortran90Kind);
425  }
426  else {
427  AddToLine((UBYTE *)".");
428  }
429  }
430  else if ( AO.DoubleFlag ) { AddToLine((UBYTE *)".D0"); }
431  else { AddToLine((UBYTE *)"."); }
432  }
433  else if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
434  if ( AC.Fortran90Kind ) {
435  AddToLine(AC.Fortran90Kind);
436  }
437  else {
438  AddToLine((UBYTE *)".");
439  }
440  }
441  else if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == CMODE )
442  && AO.DoubleFlag ) {
443  AddToLine((UBYTE *)".D0");
444  }
445  }
446  }
447  else {
448 /*
449  This is the float mode
450 */
451  UBYTE *OutScratch;
452  WORD exponent = 0, i, ndig, newl;
453  UWORD *c, *den, b = 10, dig[10];
454  UBYTE *o, *out, cc;
455 /*
456  First we have to adjust the numerator and denominator
457 */
458  if ( RLscratch == 0 ) {
459  RLscratch = (UBYTE *)Malloc1(4*(AM.MaxTal+2)*sizeof(UBYTE),"RatToLine");
460  RLscratE = (UWORD *)Malloc1(2*(AM.MaxTal+2)*sizeof(UWORD),"RatToLine");
461  }
462  out = OutScratch = RLscratch;
463  c = RLscratE; for ( i = 0; i < 2*na; i++ ) c[i] = a[i];
464  UnPack(c,na,&adenom,&anumer);
465  while ( BigLong(c,anumer,c+na,adenom) >= 0 ) {
466  Divvy(BHEAD c,&na,&b,1);
467  UnPack(c,na,&adenom,&anumer);
468  exponent++;
469  }
470  while ( BigLong(c,anumer,c+na,adenom) < 0 ) {
471  Mully(BHEAD c,&na,&b,1);
472  UnPack(c,na,&adenom,&anumer);
473  exponent--;
474  }
475 /*
476  Now division will give a number between 1 and 9
477 */
478  den = c + na; i = 1;
479  DivLong(c,anumer,den,adenom,dig,&ndig,c,&newl);
480  *out++ = (UBYTE)(dig[0]+'0'); *out++ = '.';
481  while ( newl && i < AC.OutNumberType ) {
482  Pack(c,&newl,den,adenom);
483  Mully(BHEAD c,&newl,&b,1);
484  na = newl;
485  UnPack(c,na,&adenom,&anumer);
486  den = c + na;
487  DivLong(c,anumer,den,adenom,dig,&ndig,c,&newl);
488  if ( ndig == 0 ) *out++ = '0';
489  else *out++ = (UBYTE)(dig[0]+'0');
490  i++;
491  }
492  *out++ = 'E';
493  if ( exponent < 0 ) { exponent = -exponent; *out++ = '-'; }
494  else { *out++ = '+'; }
495  o = out;
496  do {
497  *out++ = (UBYTE)((exponent % 10)+'0');
498  exponent /= 10;
499  } while ( exponent );
500  *out = 0; out--;
501  while ( o < out ) { cc = *o; *o = *out; *out = cc; o++; out--; }
502  TokenToLine(OutScratch);
503  }
504 }
505 
506 /*
507  #] RatToLine :
508  #[ TalToLine : VOID TalToLine(x)
509 
510  Writes the unsigned number x to the output as a single token.
511  Par indicates the number of leading blanks in the line.
512  This parameter is needed here for the WriteLists routine.
513 
514 */
515 
516 VOID TalToLine(UWORD x)
517 {
518  UBYTE t[BITSINWORD/3+1];
519  UBYTE *s;
520  WORD i = 0, j;
521  s = t;
522  do { *s++ = (UBYTE)((x % 10)+'0'); i++; } while ( ( x /= 10 ) != 0 );
523  *s-- = '\0';
524  j = ( i - 1 ) >> 1;
525  while ( j >= 0 ) {
526  i = t[j]; t[j] = s[-j]; s[-j] = (UBYTE)i; j--;
527  }
528  TokenToLine(t);
529 }
530 
531 /*
532  #] TalToLine :
533  #[ TokenToLine : VOID TokenToLine(s)
534 
535  Puts s in the output buffer. If it doesn't fit the buffer is
536  flushed first. This routine keeps tokens as one unit.
537  Par indicates the number of leading blanks in the line.
538  This parameter is needed here for the WriteLists routine.
539 
540  Remark (27-oct-2007): i and j must be longer than WORD!
541  It can happen that a number is so long that it has more than 2^15 or 2^31
542  digits!
543 */
544 
545 VOID TokenToLine(UBYTE *s)
546 {
547  UBYTE *t, *Out;
548  LONG num, i = 0, j;
549  if ( AO.OutInBuffer ) { AddToDollarBuffer(s); return; }
550  t = s; Out = AO.OutFill;
551  while ( *t++ ) i++;
552  while ( i > 0 ) {
553  if ( ( Out + i ) >= AO.OutStop && ( ( i < ((AC.LineLength-AO.OutSkip)>>1) )
554  || ( (AO.OutStop-Out) < (i>>2) ) ) ) {
555  if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
556  *Out++ = fcontchar;
557  }
558 #ifdef WITHRETURN
559  *Out++ = CARRIAGERETURN;
560 #endif
561  *Out++ = LINEFEED;
562  AO.FortFirst = 0;
563  num = Out - AO.OutputLine;
564  if ( AC.LogHandle >= 0 ) {
565  if ( WriteFile(AC.LogHandle,AO.OutputLine+startinline,
566  num-startinline) != (num-startinline) ) {
567 #ifdef DEBUGGER
568  if ( BUG.logfileflag == 0 ) {
569  fprintf(stderr,"Panic: Cannot write to log file! Disk full?\n");
570  BUG.logfileflag = 1;
571  }
572  BUG.eflag = 1; BUG.printflag = 1;
573 #else
574  Terminate(-1);
575 #endif
576  }
577  }
578  if ( ( AO.PrintType & PRINTLFILE ) == 0 ) {
579 #ifdef WITHRETURN
580  if ( num > 1 && AO.OutputLine[num-2] == CARRIAGERETURN ) {
581  AO.OutputLine[num-2] = LINEFEED;
582  num--;
583  }
584 #endif
585  if ( WriteFile(AM.StdOut,AO.OutputLine+startinline,
586  num-startinline) != (num-startinline) ) {
587 #ifdef DEBUGGER
588  if ( BUG.stdoutflag == 0 ) {
589  fprintf(stderr,"Panic: Cannot write to standard output!\n");
590  BUG.stdoutflag = 1;
591  }
592  BUG.eflag = 1; BUG.printflag = 1;
593 #else
594  Terminate(-1);
595 #endif
596  }
597  }
598  startinline = 0;
599  Out = AO.OutputLine;
600  if ( AO.BlockSpaces == 0 ) {
601  for ( j = 0; j < AO.OutSkip; j++ ) { *Out++ = ' '; }
602  if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE ) ) {
603  if ( AO.OutSkip == 7 ) {
604  Out[-2] = fcontchar;
605  Out[-1] = ' ';
606  }
607  }
608  }
609 /*
610  Out = AO.OutputLine + AO.OutSkip;
611  if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
612  && AO.OutSkip == 7 ) {
613  Out[-2] = fcontchar;
614  Out[-1] = ' ';
615  }
616  else {
617  for ( j = 0; j < AO.OutSkip; j++ ) { AO.OutputLine[j] = ' '; }
618  }
619 */
620  if ( AO.IsBracket ) { *Out++ = ' '; *Out++ = ' '; *Out++ = ' '; }
621  *Out = '\0';
622  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
623  || ( AC.OutputMode == CMODE && AO.FactorMode == 0 ) ) AO.InFbrack++;
624  }
625  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE ) {
626  /* Very long numbers */
627  if ( i > (WORD)(AO.OutStop-Out) ) j = (WORD)(AO.OutStop - Out);
628  else j = i;
629  i -= j;
630  NCOPYB(Out,s,j);
631  }
632  else {
633  if ( i > (WORD)(AO.OutStop-Out) ) j = (WORD)(AO.OutStop - Out - 1);
634  else j = i;
635  i -= j;
636  NCOPYB(Out,s,j);
637  if ( i > 0 ) *Out++ = '\\';
638  }
639  }
640  *Out = '\0';
641  AO.OutFill = Out;
642 }
643 
644 /*
645  #] TokenToLine :
646  #[ CodeToLine : VOID CodeToLine(name,number,mode)
647 
648  Writes a name and possibly its number to output as a single token.
649 
650 */
651 
652 UBYTE *CodeToLine(WORD number, UBYTE *Out)
653 {
654  Out = StrCopy((UBYTE *)"(",Out);
655  Out = NumCopy(number,Out);
656  Out = StrCopy((UBYTE *)")",Out);
657  return(Out);
658 }
659 
660 /*
661  #] CodeToLine :
662  #[ AddArrayIndex :
663 */
664 
665 UBYTE *AddArrayIndex(WORD num,UBYTE *out)
666 {
667  if ( AC.OutputMode == CMODE ) {
668  out = StrCopy((UBYTE *)"[",out);
669  out = NumCopy(num,out);
670  out = StrCopy((UBYTE *)"]",out);
671  }
672  else {
673  out = StrCopy((UBYTE *)"(",out);
674  out = NumCopy(num,out);
675  out = StrCopy((UBYTE *)")",out);
676  }
677  return(out);
678 }
679 
680 /*
681  #] AddArrayIndex :
682  #[ PrtTerms : VOID PrtTerms()
683 */
684 
685 VOID PrtTerms()
686 {
687  UWORD a[2];
688  WORD na;
689  a[0] = (UWORD)AO.NumInBrack;
690  a[1] = (UWORD)(AO.NumInBrack >> BITSINWORD);
691  if ( a[1] ) na = 2;
692  else na = 1;
693  TokenToLine((UBYTE *)" ");
694  LongToLine(a,na);
695  if ( a[0] == 1 && na == 1 ) {
696  TokenToLine((UBYTE *)" term");
697  }
698  else TokenToLine((UBYTE *)" terms");
699  AO.NumInBrack = 0;
700 }
701 
702 /*
703  #] PrtTerms :
704  #[ WrtPower :
705 */
706 
707 UBYTE *WrtPower(UBYTE *Out, WORD Power)
708 {
709  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
710  || AC.OutputMode == REDUCEMODE ) {
711  *Out++ = '*'; *Out++ = '*';
712  }
713  else if ( AC.OutputMode == CMODE ) *Out++ = ',';
714  else *Out++ = '^';
715  if ( Power >= 0 ) {
716  if ( Power < 2*MAXPOWER )
717  Out = NumCopy(Power,Out);
718  else
719  Out = StrCopy(VARNAME(symbols,(LONG)Power-2*MAXPOWER),Out);
720  if ( AC.OutputMode == CMODE ) *Out++ = ')';
721  *Out = 0;
722  }
723  else {
724  if ( ( AC.OutputMode >= FORTRANMODE || AC.OutputMode >= PFORTRANMODE )
725  && AC.OutputMode != CMODE )
726  *Out++ = '(';
727  *Out++ = '-';
728  if ( Power > -2*MAXPOWER )
729  Out = NumCopy(-Power,Out);
730  else
731  Out = StrCopy(VARNAME(symbols,(LONG)(-Power)-2*MAXPOWER),Out);
732  if ( AC.OutputMode >= FORTRANMODE || AC.OutputMode >= PFORTRANMODE ) *Out++ = ')';
733  *Out = 0;
734  }
735  return(Out);
736 }
737 
738 /*
739  #] WrtPower :
740  #[ PrintTime :
741 */
742 
743 void PrintTime()
744 {
745  LONG millitime = TimeCPU(1);
746  WORD timepart = (WORD)(millitime%1000);
747  millitime /= 1000;
748  timepart /= 10;
749  MesPrint("Time = %7l.%2i sec",millitime,timepart);
750 }
751 
752 /*
753  #] PrintTime :
754  #] schryf-Utilities :
755  #[ schryf-Writes :
756  #[ WriteLists : VOID WriteLists()
757 
758  Writes the namelists. If mode > 0 also the internal codes are given.
759 
760 */
761 
762 static UBYTE *symname[] = {
763  (UBYTE *)"(cyclic)",(UBYTE *)"(reversecyclic)"
764  ,(UBYTE *)"(symmetric)",(UBYTE *)"(antisymmetric)" };
765 static UBYTE *rsymname[] = {
766  (UBYTE *)"(-cyclic)",(UBYTE *)"(-reversecyclic)"
767  ,(UBYTE *)"(-symmetric)",(UBYTE *)"(-antisymmetric)" };
768 
769 VOID WriteLists()
770 {
771  GETIDENTITY
772  WORD i, j, k, *skip;
773  int first, startvalue;
774  UBYTE *OutScr, *Out;
775  EXPRESSIONS e;
776  CBUF *C = cbuf+AC.cbufnum;
777  skip = &AO.OutSkip;
778  *skip = 0;
779  AO.OutputLine = AO.OutFill = (UBYTE *)AT.WorkPointer;
780  FiniLine();
781  OutScr = (UBYTE *)AT.WorkPointer + ( TOLONG(AT.WorkTop) - TOLONG(AT.WorkPointer) ) /2;
782  if ( AC.CodesFlag || AC.NamesFlag > 1 ) startvalue = 0;
783  else startvalue = FIRSTUSERSYMBOL;
784  if ( ( j = NumSymbols ) > startvalue ) {
785  TokenToLine((UBYTE *)" Symbols");
786  *skip = 3;
787  FiniLine();
788  for ( i = startvalue; i < j; i++ ) {
789  if ( i >= BUILTINSYMBOLS && i < FIRSTUSERSYMBOL ) continue;
790  Out = StrCopy(VARNAME(symbols,i),OutScr);
791  if ( symbols[i].minpower > -MAXPOWER || symbols[i].maxpower < MAXPOWER ) {
792  Out = StrCopy((UBYTE *)"(",Out);
793  if ( symbols[i].minpower > -MAXPOWER )
794  Out = NumCopy(symbols[i].minpower,Out);
795  Out = StrCopy((UBYTE *)":",Out);
796  if ( symbols[i].maxpower < MAXPOWER )
797  Out = NumCopy(symbols[i].maxpower,Out);
798  Out = StrCopy((UBYTE *)")",Out);
799  }
800  if ( ( symbols[i].complex & VARTYPEIMAGINARY ) == VARTYPEIMAGINARY ) {
801  Out = StrCopy((UBYTE *)"#i",Out);
802  }
803  else if ( ( symbols[i].complex & VARTYPECOMPLEX ) == VARTYPECOMPLEX ) {
804  Out = StrCopy((UBYTE *)"#c",Out);
805  }
806  else if ( ( symbols[i].complex & VARTYPEROOTOFUNITY ) == VARTYPEROOTOFUNITY ) {
807  Out = StrCopy((UBYTE *)"#",Out);
808  if ( ( symbols[i].complex & VARTYPEMINUS ) == VARTYPEMINUS ) {
809  Out = StrCopy((UBYTE *)"-",Out);
810  }
811  else {
812  Out = StrCopy((UBYTE *)"+",Out);
813  }
814  Out = NumCopy(symbols[i].maxpower,Out);
815  }
816  if ( AC.CodesFlag ) Out = CodeToLine(i,Out);
817  if ( ( symbols[i].complex & VARTYPECOMPLEX ) == VARTYPECOMPLEX ) i++;
818  StrCopy((UBYTE *)" ",Out);
819  TokenToLine(OutScr);
820  }
821  *skip = 0;
822  FiniLine();
823  }
824  if ( AC.CodesFlag || AC.NamesFlag > 1 ) startvalue = 0;
825  else startvalue = BUILTININDICES;
826  if ( ( j = NumIndices ) > startvalue ) {
827  TokenToLine((UBYTE *)" Indices");
828  *skip = 3;
829  FiniLine();
830  for ( i = startvalue; i < j; i++ ) {
831  Out = StrCopy(VARNAME(indices,i),OutScr);
832  if ( indices[i].dimension >= 0 ) {
833  if ( indices[i].dimension != AC.lDefDim ) {
834  Out = StrCopy((UBYTE *)"=",Out);
835  Out = NumCopy(indices[i].dimension,Out);
836  }
837  }
838  else if ( indices[i].dimension < 0 ) {
839  Out = StrCopy((UBYTE *)"=",Out);
840  Out = StrCopy(VARNAME(symbols,-indices[i].dimension),Out);
841  if ( indices[i].nmin4 < -NMIN4SHIFT ) {
842  Out = StrCopy((UBYTE *)":",Out);
843  Out = StrCopy(VARNAME(symbols,-indices[i].nmin4-NMIN4SHIFT),Out);
844  }
845  }
846  if ( AC.CodesFlag ) Out = CodeToLine(i+AM.OffsetIndex,Out);
847  StrCopy((UBYTE *)" ",Out);
848  TokenToLine(OutScr);
849  }
850  *skip = 0;
851  FiniLine();
852  }
853  if ( AC.CodesFlag || AC.NamesFlag > 1 ) startvalue = 0;
854  else startvalue = BUILTINVECTORS;
855  if ( ( j = NumVectors ) > startvalue ) {
856  TokenToLine((UBYTE *)" Vectors");
857  *skip = 3;
858  FiniLine();
859  for ( i = startvalue; i < j; i++ ) {
860  Out = StrCopy(VARNAME(vectors,i),OutScr);
861  if ( AC.CodesFlag ) Out = CodeToLine(i+AM.OffsetVector,Out);
862  StrCopy((UBYTE *)" ",Out);
863  TokenToLine(OutScr);
864  }
865  *skip = 0;
866  FiniLine();
867  }
868 
869  if ( AC.CodesFlag || AC.NamesFlag > 1 ) startvalue = 0;
870  else startvalue = AM.NumFixedFunctions;
871  for ( k = 0; k < 2; k++ ) {
872  first = 1;
873  j = NumFunctions;
874  for ( i = startvalue; i < j; i++ ) {
875  if ( i > MAXBUILTINFUNCTION-FUNCTION
876  && i < FIRSTUSERFUNCTION-FUNCTION ) continue;
877  if ( ( k == 0 && functions[i].commute )
878  || ( k != 0 && !functions[i].commute ) ) {
879  if ( first ) {
880  TokenToLine((UBYTE *)(FG.FunNam[k]));
881  *skip = 3;
882  FiniLine();
883  first = 0;
884  }
885  Out = StrCopy(VARNAME(functions,i),OutScr);
886  if ( ( functions[i].complex & VARTYPEIMAGINARY ) == VARTYPEIMAGINARY ) {
887  Out = StrCopy((UBYTE *)"#i",Out);
888  }
889  else if ( ( functions[i].complex & VARTYPECOMPLEX ) == VARTYPECOMPLEX ) {
890  Out = StrCopy((UBYTE *)"#c",Out);
891  }
892  if ( functions[i].spec >= TENSORFUNCTION ) {
893  Out = StrCopy((UBYTE *)"(Tensor)",Out);
894  }
895  if ( functions[i].symmetric > 0 ) {
896  if ( ( functions[i].symmetric & REVERSEORDER ) != 0 ) {
897  Out = StrCopy((UBYTE *)(rsymname[(functions[i].symmetric & ~REVERSEORDER)-1]),Out);
898  }
899  else {
900  Out = StrCopy((UBYTE *)(symname[functions[i].symmetric-1]),Out);
901  }
902  }
903  if ( AC.CodesFlag ) Out = CodeToLine(i+FUNCTION,Out);
904  if ( ( functions[i].complex & VARTYPECOMPLEX ) == VARTYPECOMPLEX ) i++;
905  StrCopy((UBYTE *)" ",Out);
906  TokenToLine(OutScr);
907  }
908  }
909  *skip = 0;
910  if ( first == 0 ) FiniLine();
911  }
912  if ( AC.CodesFlag || AC.NamesFlag > 1 ) startvalue = 0;
913  else startvalue = AM.NumFixedSets;
914  if ( ( j = AC.SetList.num ) > startvalue ) {
915  WORD element, LastElement, type, number;
916  TokenToLine((UBYTE *)" Sets");
917  for ( i = startvalue; i < j; i++ ) {
918  *skip = 3;
919  FiniLine();
920  if ( Sets[i].name < 0 ) {
921  Out = StrCopy((UBYTE *)"{}",OutScr);
922  }
923  else {
924  Out = StrCopy(VARNAME(Sets,i),OutScr);
925  }
926  if ( AC.CodesFlag ) Out = CodeToLine(i,Out);
927  StrCopy((UBYTE *)":",Out);
928  TokenToLine(OutScr);
929  if ( i < AM.NumFixedSets ) {
930  TokenToLine((UBYTE *)" ");
931  TokenToLine((UBYTE *)fixedsets[i].description);
932  }
933  else if ( Sets[i].type == CRANGE ) {
934  int iflag = 0;
935  if ( Sets[i].first == 3*MAXPOWER ) {
936  }
937  else if ( Sets[i].first >= MAXPOWER ) {
938  TokenToLine((UBYTE *)"<=");
939  NumCopy(Sets[i].first-2*MAXPOWER,OutScr);
940  TokenToLine(OutScr);
941  iflag = 1;
942  }
943  else {
944  TokenToLine((UBYTE *)"<");
945  NumCopy(Sets[i].first,OutScr);
946  TokenToLine(OutScr);
947  iflag = 1;
948  }
949  if ( Sets[i].last == -3*MAXPOWER ) {
950  }
951  else if ( Sets[i].last <= -MAXPOWER ) {
952  if ( iflag ) TokenToLine((UBYTE *)",");
953  TokenToLine((UBYTE *)">=");
954  NumCopy(Sets[i].last+2*MAXPOWER,OutScr);
955  TokenToLine(OutScr);
956  }
957  else {
958  if ( iflag ) TokenToLine((UBYTE *)",");
959  TokenToLine((UBYTE *)">");
960  NumCopy(Sets[i].last,OutScr);
961  TokenToLine(OutScr);
962  }
963  }
964  else {
965  element = Sets[i].first;
966  LastElement = Sets[i].last;
967  type = Sets[i].type;
968  do {
969  TokenToLine((UBYTE *)" ");
970  number = SetElements[element++];
971  switch ( type ) {
972  case CSYMBOL:
973  if ( number < 0 ) {
974  StrCopy(VARNAME(symbols,-number),OutScr);
975  StrCopy((UBYTE *)"?",Out);
976  TokenToLine(OutScr);
977  }
978  else if ( number < MAXPOWER )
979  TokenToLine(VARNAME(symbols,number));
980  else {
981  NumCopy(number-2*MAXPOWER,OutScr);
982  TokenToLine(OutScr);
983  }
984  break;
985  case CINDEX:
986  if ( number >= AM.IndDum ) {
987  Out = StrCopy((UBYTE *)"N",OutScr);
988  Out = NumCopy(number-(AM.IndDum),Out);
989  StrCopy((UBYTE *)"_?",Out);
990  TokenToLine(OutScr);
991  }
992  else if ( number >= AM.OffsetIndex + (WORD)WILDMASK ) {
993  Out = StrCopy(VARNAME(indices,number
994  -AM.OffsetIndex-WILDMASK),OutScr);
995  StrCopy((UBYTE *)"?",Out);
996  TokenToLine(OutScr);
997  }
998  else if ( number >= AM.OffsetIndex ) {
999  TokenToLine(VARNAME(indices,number-AM.OffsetIndex));
1000  }
1001  else {
1002  NumCopy(number,OutScr);
1003  TokenToLine(OutScr);
1004  }
1005  break;
1006  case CVECTOR:
1007  if ( number >= AM.OffsetVector + WILDOFFSET ) {
1008  Out = StrCopy(VARNAME(vectors,number
1009  -AM.OffsetVector-WILDOFFSET),OutScr);
1010  StrCopy((UBYTE *)"?",Out);
1011  TokenToLine(OutScr);
1012  }
1013  else
1014  TokenToLine(VARNAME(vectors,number-AM.OffsetVector));
1015  break;
1016  case CFUNCTION:
1017  if ( number >= FUNCTION + (WORD)WILDMASK ) {
1018  Out = StrCopy(VARNAME(functions,number
1019  -FUNCTION-WILDMASK),OutScr);
1020  StrCopy((UBYTE *)"?",Out);
1021  TokenToLine(OutScr);
1022  }
1023  TokenToLine(VARNAME(functions,number-FUNCTION));
1024  break;
1025  default:
1026  NumCopy(number,OutScr);
1027  TokenToLine(OutScr);
1028  break;
1029  }
1030  } while ( element < LastElement );
1031  }
1032  }
1033  *skip = 0;
1034  FiniLine();
1035  }
1036  if ( AS.ExecMode ) {
1037  e = Expressions;
1038  j = NumExpressions;
1039  first = 1;
1040  for ( i = 0; i < j; i++, e++ ) {
1041  if ( e->status >= 0 ) {
1042  if ( first ) {
1043  TokenToLine((UBYTE *)" Expressions");
1044  *skip = 3;
1045  FiniLine();
1046  first = 0;
1047  }
1048  Out = StrCopy(AC.exprnames->namebuffer+e->name,OutScr);
1049  Out = StrCopy((UBYTE *)(FG.ExprStat[e->status]),Out);
1050  if ( AC.CodesFlag ) Out = CodeToLine(i,Out);
1051  StrCopy((UBYTE *)" ",Out);
1052  TokenToLine(OutScr);
1053  }
1054  }
1055  if ( !first ) {
1056  *skip = 0;
1057  FiniLine();
1058  }
1059  }
1060  e = Expressions;
1061  j = NumExpressions;
1062  first = 1;
1063  for ( i = 0; i < j; i++ ) {
1064  if ( e->printflag && ( e->status == LOCALEXPRESSION ||
1065  e->status == GLOBALEXPRESSION || e->status == UNHIDELEXPRESSION
1066  || e->status == UNHIDEGEXPRESSION ) ) {
1067  if ( first ) {
1068  TokenToLine((UBYTE *)" Expressions to be printed");
1069  *skip = 3;
1070  FiniLine();
1071  first = 0;
1072  }
1073  Out = StrCopy(AC.exprnames->namebuffer+e->name,OutScr);
1074  StrCopy((UBYTE *)" ",Out);
1075  TokenToLine(OutScr);
1076  }
1077  e++;
1078  }
1079  if ( !first ) {
1080  *skip = 0;
1081  FiniLine();
1082  }
1083 
1084  if ( AC.CodesFlag || AC.NamesFlag > 1 ) startvalue = 0;
1085  else startvalue = BUILTINDOLLARS;
1086  if ( ( j = NumDollars ) > startvalue ) {
1087  TokenToLine((UBYTE *)" Dollar variables");
1088  *skip = 3;
1089  FiniLine();
1090  for ( i = startvalue; i < j; i++ ) {
1091  Out = StrCopy((UBYTE *)"$", OutScr);
1092  Out = StrCopy(DOLLARNAME(Dollars, i), Out);
1093  if ( AC.CodesFlag ) Out = CodeToLine(i, Out);
1094  StrCopy((UBYTE *)" ", Out);
1095  TokenToLine(OutScr);
1096  }
1097  *skip = 0;
1098  FiniLine();
1099  }
1100 
1101  if ( ( j = NumPotModdollars ) > 0 ) {
1102  TokenToLine((UBYTE *)" Dollar variables to be modified");
1103  *skip = 3;
1104  FiniLine();
1105  for ( i = 0; i < j; i++ ) {
1106  Out = StrCopy((UBYTE *)"$", OutScr);
1107  Out = StrCopy(DOLLARNAME(Dollars, PotModdollars[i]), Out);
1108  for ( k = 0; k < NumModOptdollars; k++ )
1109  if ( ModOptdollars[k].number == PotModdollars[i] ) break;
1110  if ( k < NumModOptdollars ) {
1111  switch ( ModOptdollars[k].type ) {
1112  case MODSUM:
1113  Out = StrCopy((UBYTE *)"(sum)", Out);
1114  break;
1115  case MODMAX:
1116  Out = StrCopy((UBYTE *)"(maximum)", Out);
1117  break;
1118  case MODMIN:
1119  Out = StrCopy((UBYTE *)"(minimum)", Out);
1120  break;
1121  case MODLOCAL:
1122  Out = StrCopy((UBYTE *)"(local)", Out);
1123  break;
1124  default:
1125  Out = StrCopy((UBYTE *)"(?)", Out);
1126  break;
1127  }
1128  }
1129  StrCopy((UBYTE *)" ", Out);
1130  TokenToLine(OutScr);
1131  }
1132  *skip = 0;
1133  FiniLine();
1134  }
1135 
1136  if ( AC.ncmod != 0 ) {
1137  TokenToLine((UBYTE *)"All arithmetic is modulus ");
1138  LongToLine((UWORD *)AC.cmod,ABS(AC.ncmod));
1139  if ( AC.ncmod > 0 ) TokenToLine((UBYTE *)" with powerreduction");
1140  else TokenToLine((UBYTE *)" without powerreduction");
1141  if ( ( AC.modmode & POSNEG ) != 0 ) TokenToLine((UBYTE *)" centered around 0");
1142  else TokenToLine((UBYTE *)" positive numbers only");
1143  FiniLine();
1144  }
1145  if ( AC.lDefDim != 4 ) {
1146  TokenToLine((UBYTE *)"The default dimension is ");
1147  if ( AC.lDefDim >= 0 ) {
1148  NumCopy(AC.lDefDim,OutScr);
1149  TokenToLine(OutScr);
1150  }
1151  else {
1152  TokenToLine(VARNAME(symbols,-AC.lDefDim));
1153  if ( AC.lDefDim4 != -NMIN4SHIFT ) {
1154  TokenToLine((UBYTE *)":");
1155  if ( AC.lDefDim4 >= -NMIN4SHIFT ) {
1156  NumCopy(AC.lDefDim4,OutScr);
1157  TokenToLine(OutScr);
1158  }
1159  else {
1160  TokenToLine(VARNAME(symbols,-AC.lDefDim4-NMIN4SHIFT));
1161  }
1162  }
1163  }
1164  FiniLine();
1165  }
1166  if ( AC.lUnitTrace != 4 ) {
1167  TokenToLine((UBYTE *)"The trace of the unit matrix is ");
1168  if ( AC.lUnitTrace >= 0 ) {
1169  NumCopy(AC.lUnitTrace,OutScr);
1170  TokenToLine(OutScr);
1171  }
1172  else {
1173  TokenToLine(VARNAME(symbols,-AC.lUnitTrace));
1174  }
1175  FiniLine();
1176  }
1177  if ( AC.CodesFlag ) {
1178  if ( C->numlhs > 0 ) {
1179  TokenToLine((UBYTE *)" Left Hand Sides:");
1180  AO.OutSkip = 3;
1181  for ( i = 1; i <= C->numlhs; i++ ) {
1182  FiniLine();
1183  skip = C->lhs[i];
1184  j = skip[1];
1185  while ( --j >= 0 ) { TalToLine((UWORD)(*skip++)); TokenToLine((UBYTE *)" "); }
1186  }
1187  AO.OutSkip = 0;
1188  FiniLine();
1189  }
1190  if ( C->numrhs > 0 ) {
1191  TokenToLine((UBYTE *)" Right Hand Sides:");
1192  AO.OutSkip = 3;
1193  for ( i = 1; i <= C->numrhs; i++ ) {
1194  FiniLine();
1195  skip = C->rhs[i];
1196  while ( ( j = skip[0] ) != 0 ) {
1197  while ( --j >= 0 ) { TalToLine((UWORD)(*skip++)); TokenToLine((UBYTE *)" "); }
1198  }
1199  FiniLine();
1200  }
1201  AO.OutSkip = 0;
1202  FiniLine();
1203  }
1204  }
1205 }
1206 
1207 /*
1208  #] WriteLists :
1209  #[ WriteArgument : VOID WriteArgument(WORD *t)
1210 
1211  Write a single argument field. The general field goes to
1212  WriteExpression and the fast field is dealt with here.
1213 */
1214 
1215 VOID WriteArgument(WORD *t)
1216 {
1217  UBYTE buffer[180];
1218  UBYTE *Out;
1219  WORD i;
1220  int oldoutsidefun, oldlowestlevel = lowestlevel;
1221  lowestlevel = 0;
1222  if ( *t > 0 ) {
1223  oldoutsidefun = AC.outsidefun; AC.outsidefun = 0;
1224  WriteExpression(t+ARGHEAD,(LONG)(*t-ARGHEAD));
1225  AC.outsidefun = oldoutsidefun;
1226  goto CleanUp;
1227  }
1228  Out = buffer;
1229  if ( *t == -SNUMBER) {
1230  NumCopy(t[1],Out);
1231  }
1232  else if ( *t == -SYMBOL ) {
1233  if ( t[1] >= MAXVARIABLES-cbuf[AM.sbufnum].numrhs ) {
1234  Out = StrCopy((UBYTE *)AC.extrasym,Out);
1235  if ( AC.extrasymbols == 0 ) {
1236  Out = NumCopy((MAXVARIABLES-t[1]),Out);
1237  Out = StrCopy((UBYTE *)"_",Out);
1238  }
1239  else if ( AC.extrasymbols == 1 ) {
1240  Out = AddArrayIndex((MAXVARIABLES-t[1]),Out);
1241  }
1242 /*
1243  else if ( AC.extrasymbols == 2 ) {
1244  Out = NumCopy((MAXVARIABLES-t[1]),Out);
1245  }
1246 */
1247  }
1248  else {
1249  StrCopy(VARNAME(symbols,t[1]),Out);
1250  }
1251  }
1252  else if ( *t == -VECTOR ) {
1253  if ( t[1] == FUNNYVEC ) { *Out++ = '?'; *Out = 0; }
1254  else
1255  StrCopy(VARNAME(vectors,t[1] - AM.OffsetVector),Out);
1256  }
1257  else if ( *t == -MINVECTOR ) {
1258  *Out++ = '-';
1259  StrCopy(VARNAME(vectors,t[1] - AM.OffsetVector),Out);
1260  }
1261  else if ( *t == -INDEX ) {
1262  if ( t[1] >= 0 ) {
1263  if ( t[1] < AM.OffsetIndex ) { NumCopy(t[1],Out); }
1264  else {
1265  i = t[1];
1266  if ( i >= AM.IndDum ) {
1267  i -= AM.IndDum;
1268  *Out++ = 'N';
1269  Out = NumCopy(i,Out);
1270  *Out++ = '_';
1271  *Out++ = '?';
1272  *Out = 0;
1273  }
1274  else {
1275  i -= AM.OffsetIndex;
1276  Out = StrCopy(VARNAME(indices,i%WILDOFFSET),Out);
1277  if ( i >= WILDOFFSET ) { *Out++ = '?'; *Out = 0; }
1278  }
1279  }
1280  }
1281  else if ( t[1] == FUNNYVEC ) { *Out++ = '?'; *Out = 0; }
1282  else
1283  StrCopy(VARNAME(vectors,t[1] - AM.OffsetVector),Out);
1284  }
1285  else if ( *t == -DOLLAREXPRESSION ) {
1286  DOLLARS d = Dollars + t[1];
1287  *Out++ = '$';
1288  StrCopy(AC.dollarnames->namebuffer+d->name,Out);
1289  }
1290  else if ( *t == -EXPRESSION ) {
1291  StrCopy(EXPRNAME(t[1]),Out);
1292  }
1293  else if ( *t <= -FUNCTION ) {
1294  StrCopy(VARNAME(functions,-*t-FUNCTION),Out);
1295  }
1296  else {
1297  MesPrint("Illegal function argument while writing");
1298  goto CleanUp;
1299  }
1300  TokenToLine(buffer);
1301 CleanUp:
1302  lowestlevel = oldlowestlevel;
1303  return;
1304 }
1305 
1306 /*
1307  #] WriteArgument :
1308  #[ WriteSubTerm : WORD WriteSubTerm(sterm,first)
1309 
1310  Writes a single subterm field to the output line.
1311  There is a recursion for functions.
1312 
1313 
1314 #define NUMSPECS 8
1315 UBYTE *specfunnames[NUMSPECS] = {
1316  (UBYTE *)"fac" , (UBYTE *)"nargs", (UBYTE *)"binom"
1317  , (UBYTE *)"sign", (UBYTE *)"mod", (UBYTE *)"min", (UBYTE *)"max"
1318  , (UBYTE *)"invfac" };
1319 */
1320 
1321 WORD WriteSubTerm(WORD *sterm, WORD first)
1322 {
1323  UBYTE buffer[80];
1324  UBYTE *Out, closepar[2] = { (UBYTE)')', 0};
1325  WORD *stopper, *t, *tt, i, j, po = 0;
1326  int oldoutsidefun;
1327  stopper = sterm + sterm[1];
1328  t = sterm + 2;
1329  switch ( *sterm ) {
1330  case SYMBOL :
1331  while ( t < stopper ) {
1332  if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1333  FiniLine();
1334  if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1335  else IniLine(3);
1336  if ( first ) TokenToLine((UBYTE *)" ");
1337  }
1338  if ( !first ) TokenToLine((UBYTE *)"*");
1339  if ( AC.OutputMode == CMODE && t[1] != 1 ) {
1340  if ( AC.Cnumpows >= t[1] && t[1] > 0 ) {
1341  po = t[1];
1342  Out = StrCopy((UBYTE *)"POW",buffer);
1343  Out = NumCopy(po,Out);
1344  Out = StrCopy((UBYTE *)"(",Out);
1345  TokenToLine(buffer);
1346  }
1347  else {
1348  TokenToLine((UBYTE *)"pow(");
1349  }
1350  }
1351  if ( *t < NumSymbols ) {
1352  Out = StrCopy(VARNAME(symbols,*t),buffer); t++;
1353  }
1354  else {
1355 /*
1356  see also routine PrintSubtermList.
1357 */
1358  Out = StrCopy((UBYTE *)AC.extrasym,buffer);
1359  if ( AC.extrasymbols == 0 ) {
1360  Out = NumCopy((MAXVARIABLES-*t),Out);
1361  Out = StrCopy((UBYTE *)"_",Out);
1362  }
1363  else if ( AC.extrasymbols == 1 ) {
1364  Out = AddArrayIndex((MAXVARIABLES-*t),Out);
1365  }
1366 /*
1367  else if ( AC.extrasymbols == 2 ) {
1368  Out = NumCopy((MAXVARIABLES-*t),Out);
1369  }
1370 */
1371  t++;
1372  }
1373  if ( AC.OutputMode == CMODE && po > 1
1374  && AC.Cnumpows >= po ) {
1375  Out = StrCopy((UBYTE *)")",Out);
1376  po = 0;
1377  }
1378  else if ( *t != 1 ) WrtPower(Out,*t);
1379  TokenToLine(buffer);
1380  t++;
1381  first = 0;
1382  }
1383  break;
1384  case VECTOR :
1385  while ( t < stopper ) {
1386  if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1387  FiniLine();
1388  if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1389  else IniLine(3);
1390  if ( first ) TokenToLine((UBYTE *)" ");
1391  }
1392  if ( !first ) TokenToLine((UBYTE *)"*");
1393 
1394  Out = StrCopy(VARNAME(vectors,*t - AM.OffsetVector),buffer);
1395  t++;
1396  if ( AC.OutputMode == MATHEMATICAMODE ) *Out++ = '[';
1397  else *Out++ = '(';
1398  if ( *t >= AM.OffsetIndex ) {
1399  i = *t++;
1400  if ( i >= AM.IndDum ) {
1401  i -= AM.IndDum;
1402  *Out++ = 'N';
1403  Out = NumCopy(i,Out);
1404  *Out++ = '_';
1405  *Out++ = '?';
1406  *Out = 0;
1407  }
1408  else
1409  Out = StrCopy(VARNAME(indices,i - AM.OffsetIndex),Out);
1410  }
1411  else if ( *t == FUNNYVEC ) { *Out++ = '?'; *Out = 0; }
1412  else {
1413  Out = NumCopy(*t++,Out);
1414  }
1415  if ( AC.OutputMode == MATHEMATICAMODE ) *Out++ = ']';
1416  else *Out++ = ')';
1417  *Out = 0;
1418  TokenToLine(buffer);
1419  first = 0;
1420  }
1421  break;
1422  case INDEX :
1423  while ( t < stopper ) {
1424  if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1425  FiniLine();
1426  if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1427  else IniLine(3);
1428  if ( first ) TokenToLine((UBYTE *)" ");
1429  }
1430  if ( !first ) TokenToLine((UBYTE *)"*");
1431  if ( *t >= 0 ) {
1432  if ( *t < AM.OffsetIndex ) {
1433  TalToLine((UWORD)(*t++));
1434  }
1435  else {
1436  i = *t++;
1437  if ( i >= AM.IndDum ) {
1438  i -= AM.IndDum;
1439  Out = buffer;
1440  *Out++ = 'N';
1441  Out = NumCopy(i,Out);
1442  *Out++ = '_';
1443  *Out++ = '?';
1444  *Out = 0;
1445  }
1446  else {
1447  i -= AM.OffsetIndex;
1448  Out = StrCopy(VARNAME(indices,i%WILDOFFSET),buffer);
1449  if ( i >= WILDOFFSET ) { *Out++ = '?'; *Out = 0; }
1450  }
1451  TokenToLine(buffer);
1452  }
1453  }
1454  else {
1455  TokenToLine(VARNAME(vectors,*t - AM.OffsetVector)); t++;
1456  }
1457  first = 0;
1458  }
1459  break;
1460  case DOLLAREXPRESSION:
1461  {
1462  DOLLARS d = Dollars + sterm[2];
1463  Out = StrCopy((UBYTE *)"$",buffer);
1464  Out = StrCopy(AC.dollarnames->namebuffer+d->name,Out);
1465  if ( sterm[3] != 1 ) WrtPower(Out,sterm[3]);
1466  TokenToLine(buffer);
1467  }
1468  first = 0;
1469  break;
1470  case DELTA :
1471  while ( t < stopper ) {
1472  if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1473  FiniLine();
1474  if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1475  else IniLine(3);
1476  if ( first ) TokenToLine((UBYTE *)" ");
1477  }
1478  if ( !first ) TokenToLine((UBYTE *)"*");
1479  Out = StrCopy((UBYTE *)"d_(",buffer);
1480  if ( *t >= AM.OffsetIndex ) {
1481  if ( *t < AM.IndDum ) {
1482  Out = StrCopy(VARNAME(indices,*t - AM.OffsetIndex),Out);
1483  t++;
1484  }
1485  else {
1486  *Out++ = 'N';
1487  Out = NumCopy( *t++ - AM.IndDum, Out);
1488  *Out++ = '_';
1489  *Out++ = '?';
1490  *Out = 0;
1491  }
1492  }
1493  else if ( *t == FUNNYVEC ) { *Out++ = '?'; *Out = 0; }
1494  else {
1495  Out = NumCopy(*t++,Out);
1496  }
1497  *Out++ = ',';
1498  if ( *t >= AM.OffsetIndex ) {
1499  if ( *t < AM.IndDum ) {
1500  Out = StrCopy(VARNAME(indices,*t - AM.OffsetIndex),Out);
1501  t++;
1502  }
1503  else {
1504  *Out++ = 'N';
1505  Out = NumCopy(*t++ - AM.IndDum,Out);
1506  *Out++ = '_';
1507  *Out++ = '?';
1508  }
1509  }
1510  else {
1511  Out = NumCopy(*t++,Out);
1512  }
1513  *Out++ = ')';
1514  *Out = 0;
1515  TokenToLine(buffer);
1516  first = 0;
1517  }
1518  break;
1519  case DOTPRODUCT :
1520  while ( t < stopper ) {
1521  if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1522  FiniLine();
1523  if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1524  else IniLine(3);
1525  if ( first ) TokenToLine((UBYTE *)" ");
1526  }
1527  if ( !first ) TokenToLine((UBYTE *)"*");
1528  if ( AC.OutputMode == CMODE && t[2] != 1 )
1529  TokenToLine((UBYTE *)"pow(");
1530  Out = StrCopy(VARNAME(vectors,*t - AM.OffsetVector),buffer);
1531  t++;
1532  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
1533  || AC.OutputMode == CMODE )
1534  *Out++ = AO.FortDotChar;
1535  else *Out++ = '.';
1536  Out = StrCopy(VARNAME(vectors,*t - AM.OffsetVector),Out);
1537  t++;
1538  if ( *t != 1 ) WrtPower(Out,*t);
1539  t++;
1540  TokenToLine(buffer);
1541  first = 0;
1542  }
1543  break;
1544  case EXPONENT :
1545 #if FUNHEAD != 2
1546  t += FUNHEAD - 2;
1547 #endif
1548  if ( !first ) TokenToLine((UBYTE *)"*");
1549  if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)"pow(");
1550  else TokenToLine((UBYTE *)"(");
1551  WriteArgument(t);
1552  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
1553  || AC.OutputMode == REDUCEMODE )
1554  TokenToLine((UBYTE *)")**(");
1555  else if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)",");
1556  else TokenToLine((UBYTE *)")^(");
1557  NEXTARG(t)
1558  WriteArgument(t);
1559  TokenToLine((UBYTE *)")");
1560  break;
1561  case DENOMINATOR :
1562 #if FUNHEAD != 2
1563  t += FUNHEAD - 2;
1564 #endif
1565  if ( first ) TokenToLine((UBYTE *)"1/(");
1566  else TokenToLine((UBYTE *)"/(");
1567  WriteArgument(t);
1568  TokenToLine((UBYTE *)")");
1569  break;
1570  case SUBEXPRESSION:
1571  if ( !first ) TokenToLine((UBYTE *)"*");
1572  TokenToLine((UBYTE *)"(");
1573  t = cbuf[sterm[4]].rhs[sterm[2]];
1574  tt = t;
1575  while ( *tt ) tt += *tt;
1576  oldoutsidefun = AC.outsidefun; AC.outsidefun = 0;
1577  if ( *t ) {
1578  WriteExpression(t,(LONG)(tt-t));
1579  }
1580  else {
1581  TokenToLine((UBYTE *)"0");
1582  }
1583  AC.outsidefun = oldoutsidefun;
1584  TokenToLine((UBYTE *)")");
1585  if ( sterm[3] != 1 ) {
1586  TokenToLine((UBYTE *)"^");
1587  Out = buffer;
1588  NumCopy(sterm[3],Out);
1589  TokenToLine(buffer);
1590  }
1591  break;
1592  default :
1593  if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1594  FiniLine();
1595  if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1596  else IniLine(3);
1597  if ( first ) TokenToLine((UBYTE *)" ");
1598  }
1599  if ( *sterm < FUNCTION ) {
1600  return(MesPrint("Illegal subterm while writing"));
1601  }
1602  if ( !first ) TokenToLine((UBYTE *)"*");
1603  t += FUNHEAD-2;
1604 
1605  if ( *sterm == GAMMA && t[-FUNHEAD+1] == FUNHEAD+1 ) {
1606  TokenToLine((UBYTE *)"gi_(");
1607  }
1608  else {
1609  if ( *sterm != DUMFUN ) {
1610  Out = StrCopy(VARNAME(functions,*sterm - FUNCTION),buffer);
1611  }
1612  else { Out = buffer; *Out = 0; }
1613  if ( t >= stopper ) {
1614  TokenToLine(buffer);
1615  break;
1616  }
1617  if ( AC.OutputMode == MATHEMATICAMODE ) { *Out++ = '['; closepar[0] = (UBYTE)']'; }
1618  else { *Out++ = '('; }
1619  *Out = 0;
1620  TokenToLine(buffer);
1621  }
1622  first = 1;
1623  i = functions[*sterm - FUNCTION].spec;
1624  if ( i >= TENSORFUNCTION ) {
1625  t = sterm + FUNHEAD;
1626  while ( t < stopper ) {
1627  if ( !first ) TokenToLine((UBYTE *)",");
1628  else first = 0;
1629  j = *t++;
1630  if ( j >= 0 ) {
1631  if ( j < AM.OffsetIndex ) TalToLine((UWORD)(j));
1632  else if ( j < AM.IndDum ) {
1633  i = j - AM.OffsetIndex;
1634  Out = StrCopy(VARNAME(indices,i%WILDOFFSET),buffer);
1635  if ( i >= WILDOFFSET ) { *Out++ = '?'; *Out = 0; }
1636  TokenToLine(buffer);
1637  }
1638  else {
1639  Out = buffer;
1640  *Out++ = 'N';
1641  Out = NumCopy(j - AM.IndDum,Out);
1642  *Out++ = '_';
1643  *Out++ = '?';
1644  *Out = 0;
1645  TokenToLine(buffer);
1646  }
1647  }
1648  else if ( j == FUNNYVEC ) { TokenToLine((UBYTE *)"?"); }
1649  else if ( j > -WILDOFFSET ) {
1650  Out = buffer;
1651  Out = NumCopy((UWORD)(-j + 4),Out);
1652  *Out++ = '_';
1653  *Out = 0;
1654  TokenToLine(buffer);
1655  }
1656  else {
1657  TokenToLine(VARNAME(vectors,j - AM.OffsetVector));
1658  }
1659  }
1660  }
1661  else {
1662  while ( t < stopper ) {
1663  if ( !first ) TokenToLine((UBYTE *)",");
1664  WriteArgument(t);
1665  NEXTARG(t)
1666  first = 0;
1667  }
1668  }
1669  TokenToLine(closepar);
1670  closepar[0] = (UBYTE)')';
1671  break;
1672  }
1673  return(0);
1674 }
1675 
1676 /*
1677  #] WriteSubTerm :
1678  #[ WriteInnerTerm : WORD WriteInnerTerm(term,first)
1679 
1680  Writes the contents of term to the output.
1681  Only the part that is inside parentheses is written.
1682 
1683 */
1684 
1685 WORD WriteInnerTerm(WORD *term, WORD first)
1686 {
1687  WORD *t, *s, *s1, *s2, n, i, pow;
1688  t = term;
1689  s = t+1;
1690  GETCOEF(t,n);
1691  while ( s < t ) {
1692  if ( *s == HAAKJE ) break;
1693  s += s[1];
1694  }
1695  if ( s < t ) { s += s[1]; }
1696  else { s = term+1; }
1697 
1698  if ( n < 0 || !first ) {
1699  if ( n > 0 ) { TOKENTOLINE(" + ","+") }
1700  else if ( n < 0 ) { n = -n; TOKENTOLINE(" - ","-") }
1701  }
1702  if ( AC.modpowers ) {
1703  if ( n == 1 && *t == 1 && t > s ) first = 1;
1704  else if ( ABS(AC.ncmod) == 1 ) {
1705  LongToLine((UWORD *)AC.powmod,AC.npowmod);
1706  TokenToLine((UBYTE *)"^");
1707  TalToLine(AC.modpowers[(LONG)((UWORD)*t)]);
1708  first = 0;
1709  }
1710  else {
1711  LONG jj;
1712  LongToLine((UWORD *)AC.powmod,AC.npowmod);
1713  TokenToLine((UBYTE *)"^");
1714  jj = (UWORD)*t;
1715  if ( n == 2 ) jj += ((LONG)t[1])<<BITSINWORD;
1716  if ( AC.modpowers[jj+1] == 0 ) {
1717  TalToLine(AC.modpowers[jj]);
1718  }
1719  else {
1720  LongToLine(AC.modpowers+jj,2);
1721  }
1722  first = 0;
1723  }
1724  }
1725  else if ( n != 1 || *t != 1 || t[1] != 1 || t <= s ) {
1726  if ( lowestlevel && ( ( AO.PrintType & PRINTONEFUNCTION ) != 0 ) ) {
1727  FiniLine();
1728  if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1729  else IniLine(3);
1730  }
1731  RatToLine((UWORD *)t,n); first = 0;
1732  }
1733  else first = 1;
1734  while ( s < t ) {
1735  if ( lowestlevel && ( (AO.PrintType & (PRINTONEFUNCTION | PRINTALL)) == PRINTONEFUNCTION ) ) {
1736  FiniLine();
1737  if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1738  else IniLine(3);
1739  }
1740 
1741 /*
1742  #[ NEWGAMMA :
1743 */
1744 #ifdef NEWGAMMA
1745  if ( *s == GAMMA ) { /* String them up */
1746  WORD *tt,*ss;
1747  ss = AT.WorkPointer;
1748  *ss++ = GAMMA;
1749  *ss++ = s[1];
1750  FILLFUN(ss)
1751  *ss++ = s[FUNHEAD];
1752  tt = s + FUNHEAD + 1;
1753  n = s[1] - FUNHEAD-1;
1754  do {
1755  while ( --n >= 0 ) *ss++ = *tt++;
1756  tt = s + s[1];
1757  while ( *tt == GAMMA && tt[FUNHEAD] == s[FUNHEAD] && tt < t ) {
1758  s = tt;
1759  tt += FUNHEAD + 1;
1760  n = s[1] - FUNHEAD-1;
1761  if ( n > 0 ) break;
1762  }
1763  } while ( n > 0 );
1764  tt = AT.WorkPointer;
1765  AT.WorkPointer = ss;
1766  tt[1] = WORDDIF(ss,tt);
1767  if ( WriteSubTerm(tt,first) ) {
1768  MesCall("WriteInnerTerm");
1769  SETERROR(-1)
1770  }
1771  AT.WorkPointer = tt;
1772  }
1773  else
1774 #endif
1775 /*
1776  #] NEWGAMMA :
1777 */
1778  {
1779  if ( *s >= FUNCTION && AC.funpowers > 0
1780  && functions[*s-FUNCTION].spec == 0 && ( AC.funpowers == ALLFUNPOWERS ||
1781  ( AC.funpowers == COMFUNPOWERS && functions[*s-FUNCTION].commute == 0 ) ) ) {
1782  pow = 1;
1783  for(;;) {
1784  s1 = s; s2 = s + s[1]; i = s[1];
1785  if ( s2 < t ) {
1786  while ( --i >= 0 && *s1 == *s2 ) { s1++; s2++; }
1787  if ( i < 0 ) {
1788  pow++; s = s+s[1];
1789  }
1790  else break;
1791  }
1792  else break;
1793  }
1794  if ( pow > 1 ) {
1795  if ( AC.OutputMode == CMODE ) {
1796  if ( !first ) TokenToLine((UBYTE *)"*");
1797  TokenToLine((UBYTE *)"pow(");
1798  first = 1;
1799  }
1800  if ( WriteSubTerm(s,first) ) {
1801  MesCall("WriteInnerTerm");
1802  SETERROR(-1)
1803  }
1804  if ( AC.OutputMode == FORTRANMODE
1805  || AC.OutputMode == PFORTRANMODE ) { TokenToLine((UBYTE *)"**"); }
1806  else if ( AC.OutputMode == CMODE ) { TokenToLine((UBYTE *)","); }
1807  else { TokenToLine((UBYTE *)"^"); }
1808  TalToLine(pow);
1809  if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)")");
1810  }
1811  else if ( WriteSubTerm(s,first) ) {
1812  MesCall("WriteInnerTerm");
1813  SETERROR(-1)
1814  }
1815  }
1816  else if ( WriteSubTerm(s,first) ) {
1817  MesCall("WriteInnerTerm");
1818  SETERROR(-1)
1819  }
1820  }
1821  first = 0;
1822  s += s[1];
1823  }
1824  return(0);
1825 }
1826 
1827 /*
1828  #] WriteInnerTerm :
1829  #[ WriteTerm : WORD WriteTerm(term,lbrac,first,prtf,br)
1830 
1831  Writes a term to output. It tests the bracket information first.
1832  If there are no brackets or the bracket is the same all is passed
1833  to WriteInnerTerm. If there are brackets and the bracket is not
1834  the same as for the predecessor the old bracket is closed and
1835  a new one is opened.
1836  br indicates whether we are in a subexpression, barring zeroing
1837  AO.IsBracket
1838 
1839 */
1840 
1841 WORD WriteTerm(WORD *term, WORD *lbrac, WORD first, WORD prtf, WORD br)
1842 {
1843  WORD *t, *stopper, *b, n;
1844  int oldIsFortran90 = AC.IsFortran90, i;
1845  if ( *lbrac >= 0 ) {
1846  t = term + 1;
1847  stopper = (term + *term - 1);
1848  stopper -= ABS(*stopper) - 1;
1849  while ( t < stopper ) {
1850  if ( *t == HAAKJE ) {
1851  stopper = t;
1852  t = term+1;
1853  if ( *lbrac == ( n = WORDDIF(stopper,t) ) ) {
1854  b = AO.bracket + 1;
1855  t = term + 1;
1856  while ( n > 0 && ( *b++ == *t++ ) ) { n--; }
1857  if ( n <= 0 && ( ( AO.InFbrack < AM.FortranCont )
1858  || ( lowestlevel == 0 ) ) ) {
1859 /*
1860  We continue inside a bracket.
1861 */
1862  AO.IsBracket = 1;
1863  if ( ( prtf & PRINTCONTENTS ) != 0 ) {
1864  AO.NumInBrack++;
1865  }
1866  else {
1867  if ( WriteInnerTerm(term,0) ) goto WrtTmes;
1868  if ( ( AO.PrintType & PRINTONETERM ) != 0 ) {
1869  FiniLine();
1870  TokenToLine((UBYTE *)" ");
1871  }
1872  }
1873  return(0);
1874  }
1875  t = term + 1;
1876  n = WORDDIF(stopper,t);
1877  }
1878 /*
1879  Close the bracket
1880 */
1881  if ( *lbrac ) {
1882  if ( ( prtf & PRINTCONTENTS ) ) PrtTerms();
1883  TOKENTOLINE(" )",")")
1884  if ( AC.OutputMode == CMODE && AO.FactorMode == 0 )
1885  TokenToLine((UBYTE *)";");
1886  else if ( AO.FactorMode && ( n == 0 ) ) {
1887 /*
1888  This should not happen.
1889 */
1890  return(0);
1891  }
1892  AC.IsFortran90 = ISNOTFORTRAN90;
1893  FiniLine();
1894  AC.IsFortran90 = oldIsFortran90;
1895  if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE
1896  && AC.OutputSpaces == NORMALFORMAT
1897  && AO.FactorMode == 0 ) FiniLine();
1898  }
1899  else {
1900  if ( AC.OutputMode == CMODE && AO.FactorMode == 0 )
1901  TokenToLine((UBYTE *)";");
1902  if ( AO.FortFirst == 0 ) {
1903  if ( !first ) {
1904  AC.IsFortran90 = ISNOTFORTRAN90;
1905  FiniLine();
1906  AC.IsFortran90 = oldIsFortran90;
1907  }
1908  }
1909  }
1910  if ( AO.FactorMode == 0 ) {
1911  if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
1912  && !first ) {
1913  WORD oldmode = AC.OutputMode;
1914  AC.OutputMode = 0;
1915  IniLine(0);
1916  AC.OutputMode = oldmode;
1917  AO.OutSkip = 7;
1918 
1919  if ( AO.FortFirst == 0 ) {
1920  TokenToLine(AO.CurBufWrt);
1921  TOKENTOLINE(" = ","=")
1922  TokenToLine(AO.CurBufWrt);
1923  }
1924  else {
1925  AO.FortFirst = 0;
1926  TokenToLine(AO.CurBufWrt);
1927  TOKENTOLINE(" = ","=")
1928  }
1929  }
1930  else if ( AC.OutputMode == CMODE && !first ) {
1931  IniLine(0);
1932  if ( AO.FortFirst == 0 ) {
1933  TokenToLine(AO.CurBufWrt);
1934  TOKENTOLINE(" += ","+=")
1935  }
1936  else {
1937  AO.FortFirst = 0;
1938  TokenToLine(AO.CurBufWrt);
1939  TOKENTOLINE(" = ","=")
1940  }
1941  }
1942  else if ( startinline == 0 ) {
1943  IniLine(0);
1944  }
1945  AO.InFbrack = 0;
1946  if ( ( *lbrac = n ) > 0 ) {
1947  b = AO.bracket;
1948  *b++ = n + 4;
1949  while ( --n >= 0 ) *b++ = *t++;
1950  *b++ = 1; *b++ = 1; *b = 3;
1951  AO.IsBracket = 0;
1952  if ( WriteInnerTerm(AO.bracket,0) ) {
1953  /* Error message */
1954  WORD i;
1955 WrtTmes: t = term;
1956  AO.OutSkip = 3;
1957  FiniLine();
1958  i = *t;
1959  while ( --i >= 0 ) { TalToLine((UWORD)(*t++));
1960  if ( AC.OutputSpaces == NORMALFORMAT )
1961  TokenToLine((UBYTE *)" "); }
1962  AO.OutSkip = 0;
1963  FiniLine();
1964  MesCall("WriteTerm");
1965  SETERROR(-1)
1966  }
1967  TOKENTOLINE(" * ( ","*(")
1968  AO.NumInBrack = 0;
1969  AO.IsBracket = 1;
1970  if ( ( prtf & PRINTONETERM ) != 0 ) {
1971  first = 0;
1972  FiniLine();
1973  TokenToLine((UBYTE *)" ");
1974  }
1975  else first = 1;
1976  }
1977  else {
1978  AO.IsBracket = 0;
1979  first = 0;
1980  }
1981  }
1982  else {
1983 /*
1984  Here is the code that writes the glue between two factors.
1985  We should not forget factors that are zero!
1986 */
1987  if ( ( *lbrac = n ) > 0 ) {
1988  b = AO.bracket;
1989  *b++ = n + 4;
1990  while ( --n >= 0 ) *b++ = *t++;
1991  *b++ = 1; *b++ = 1; *b = 3;
1992  for ( i = AO.FactorNum+1; i < AO.bracket[4]; i++ ) {
1993  if ( first ) {
1994  TOKENTOLINE(" ( 0 )"," (0)")
1995  first = 0;
1996  }
1997  else {
1998  TOKENTOLINE(" * ( 0 )","*(0)")
1999  }
2000  FiniLine();
2001  IniLine(0);
2002  }
2003  AO.FactorNum = AO.bracket[4];
2004  }
2005  else {
2006  AO.NumInBrack = 0;
2007  return(0);
2008  }
2009  if ( first == 0 ) { TOKENTOLINE(" * ( ","*(") }
2010  else { TOKENTOLINE(" ( "," (") }
2011  AO.NumInBrack = 0;
2012  first = 1;
2013  }
2014  if ( ( prtf & PRINTCONTENTS ) != 0 ) AO.NumInBrack++;
2015  else if ( WriteInnerTerm(term,first) ) goto WrtTmes;
2016  if ( ( AO.PrintType & PRINTONETERM ) != 0 ) {
2017  FiniLine();
2018  TokenToLine((UBYTE *)" ");
2019  }
2020  return(0);
2021  }
2022  else t += t[1];
2023  }
2024  if ( *lbrac > 0 ) {
2025  if ( ( prtf & PRINTCONTENTS ) != 0 ) PrtTerms();
2026  TokenToLine((UBYTE *)" )");
2027  if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)";");
2028  if ( AO.FortFirst == 0 ) {
2029  AC.IsFortran90 = ISNOTFORTRAN90;
2030  FiniLine();
2031  AC.IsFortran90 = oldIsFortran90;
2032  }
2033  if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE
2034  && AC.OutputSpaces == NORMALFORMAT ) FiniLine();
2035  if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2036  && !first ) {
2037  WORD oldmode = AC.OutputMode;
2038  AC.OutputMode = 0;
2039  IniLine(0);
2040  AC.OutputMode = oldmode;
2041  AO.OutSkip = 7;
2042  if ( AO.FortFirst == 0 ) {
2043  TokenToLine(AO.CurBufWrt);
2044  TOKENTOLINE(" = ","=")
2045  TokenToLine(AO.CurBufWrt);
2046  }
2047  else {
2048  AO.FortFirst = 0;
2049  TokenToLine(AO.CurBufWrt);
2050  TOKENTOLINE(" = ","=")
2051  }
2052 /*
2053  TokenToLine(AO.CurBufWrt);
2054  TOKENTOLINE(" = ","=")
2055  if ( AO.FortFirst == 0 )
2056  TokenToLine(AO.CurBufWrt);
2057  else AO.FortFirst = 0;
2058 */
2059  }
2060  else if ( AC.OutputMode == CMODE && !first ) {
2061  IniLine(0);
2062  if ( AO.FortFirst == 0 ) {
2063  TokenToLine(AO.CurBufWrt);
2064  TOKENTOLINE(" += ","+=")
2065  }
2066  else {
2067  AO.FortFirst = 0;
2068  TokenToLine(AO.CurBufWrt);
2069  TOKENTOLINE(" = ","=")
2070  }
2071 /*
2072  TokenToLine(AO.CurBufWrt);
2073  if ( AO.FortFirst == 0 ) { TOKENTOLINE(" += ","+=") }
2074  else {
2075  TOKENTOLINE(" = ","=")
2076  AO.FortFirst = 0;
2077  }
2078 */
2079  }
2080  else IniLine(0);
2081  *lbrac = 0;
2082  first = 1;
2083  }
2084  }
2085  if ( !br ) AO.IsBracket = 0;
2086  if ( ( AO.InFbrack >= AM.FortranCont ) && lowestlevel ) {
2087  if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)";");
2088  if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2089  && !first ) {
2090  WORD oldmode = AC.OutputMode;
2091  if ( AO.FortFirst == 0 ) {
2092  AC.IsFortran90 = ISNOTFORTRAN90;
2093  FiniLine();
2094  AC.IsFortran90 = oldIsFortran90;
2095  AC.OutputMode = 0;
2096  IniLine(0);
2097  AC.OutputMode = oldmode;
2098  AO.OutSkip = 7;
2099  TokenToLine(AO.CurBufWrt);
2100  TOKENTOLINE(" = ","=")
2101  TokenToLine(AO.CurBufWrt);
2102  }
2103  else {
2104  AO.FortFirst = 0;
2105 /*
2106  TokenToLine(AO.CurBufWrt);
2107  TOKENTOLINE(" = ","=")
2108 */
2109  }
2110 /*
2111  TokenToLine(AO.CurBufWrt);
2112  TOKENTOLINE(" = ","=")
2113  if ( AO.FortFirst == 0 )
2114  TokenToLine(AO.CurBufWrt);
2115  else AO.FortFirst = 0;
2116 */
2117  }
2118  else if ( AC.OutputMode == CMODE && !first ) {
2119  FiniLine();
2120  IniLine(0);
2121  if ( AO.FortFirst == 0 ) {
2122  TokenToLine(AO.CurBufWrt);
2123  TOKENTOLINE(" += ","+=")
2124  }
2125  else {
2126  AO.FortFirst = 0;
2127  TokenToLine(AO.CurBufWrt);
2128  TOKENTOLINE(" = ","=")
2129  }
2130 /*
2131  TokenToLine(AO.CurBufWrt);
2132  if ( AO.FortFirst == 0 ) { TOKENTOLINE(" += ","+=") }
2133  else {
2134  TOKENTOLINE(" = ","=")
2135  AO.FortFirst = 0;
2136  }
2137 */
2138  }
2139  else {
2140  FiniLine();
2141  IniLine(0);
2142  }
2143  AO.InFbrack = 0;
2144  }
2145  if ( WriteInnerTerm(term,first) ) goto WrtTmes;
2146  if ( ( AO.PrintType & PRINTONETERM ) != 0 ) {
2147  FiniLine();
2148  IniLine(0);
2149  }
2150  return(0);
2151 }
2152 
2153 /*
2154  #] WriteTerm :
2155  #[ WriteExpression : WORD WriteExpression(terms,ltot)
2156 
2157  Writes a subexpression to output.
2158  The subexpression is in terms and contains ltot words.
2159  This is only used for function arguments.
2160 
2161 */
2162 
2163 WORD WriteExpression(WORD *terms, LONG ltot)
2164 {
2165  WORD *stopper;
2166  WORD first, btot;
2167  WORD OldIsBracket = AO.IsBracket, OldPrintType = AO.PrintType;
2168  if ( !AC.outsidefun ) { AO.PrintType &= ~PRINTONETERM; first = 1; }
2169  else first = 0;
2170  stopper = terms + ltot;
2171  btot = -1;
2172  while ( terms < stopper ) {
2173  AO.IsBracket = OldIsBracket;
2174  if ( WriteTerm(terms,&btot,first,0,1) ) {
2175  MesCall("WriteExpression");
2176  SETERROR(-1)
2177  }
2178  first = 0;
2179  terms += *terms;
2180  }
2181 /* AO.IsBracket = 0; */
2182  AO.IsBracket = OldIsBracket;
2183  AO.PrintType = OldPrintType;
2184  return(0);
2185 }
2186 
2187 /*
2188  #] WriteExpression :
2189  #[ WriteAll : WORD WriteAll()
2190 
2191  Writes all expressions that should be written
2192 */
2193 
2194 WORD WriteAll()
2195 {
2196  GETIDENTITY
2197  WORD lbrac, first;
2198  WORD *t, *stopper, n, prtf;
2199  int oldIsFortran90 = AC.IsFortran90, i;
2200  POSITION pos;
2201  FILEHANDLE *f;
2202  EXPRESSIONS e;
2203  if ( AM.exitflag ) return(0);
2204 #ifdef WITHMPI
2205  if ( PF.me != MASTER ) {
2206  /*
2207  * For the slaves, we need to call Optimize() the same number of times
2208  * as the master. The first argument doesn't have any important role.
2209  */
2210  for ( n = 0; n < NumExpressions; n++ ) {
2211  e = &Expressions[n];
2212  if ( !e->printflag & PRINTON ) continue;
2213  switch ( e->status ) {
2214  case LOCALEXPRESSION:
2215  case GLOBALEXPRESSION:
2216  case UNHIDELEXPRESSION:
2217  case UNHIDEGEXPRESSION:
2218  break;
2219  default:
2220  continue;
2221  }
2222  e->printflag = 0;
2223  PutPreVar(AM.oldnumextrasymbols, GetPreVar((UBYTE *)"EXTRASYMBOLS_", 0), 0, 1);
2224  if ( AO.OptimizationLevel > 0 ) {
2225  if ( Optimize(0, 1) ) return(-1);
2226  }
2227  }
2228  return(0);
2229  }
2230 #endif
2231  SeekScratch(AR.outfile,&pos);
2232  if ( ResetScratch() ) {
2233  MesCall("WriteAll");
2234  SETERROR(-1)
2235  }
2236  AO.termbuf = AT.WorkPointer;
2237  AO.bracket = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
2238  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer*2);
2239  AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
2240  AT.WorkPointer += 2*AC.LineLength;
2241  *(AR.CompressBuffer) = 0;
2242  first = 0;
2243  for ( n = 0; n < NumExpressions; n++ ) {
2244  if ( ( Expressions[n].printflag & PRINTON ) != 0 ) { first = 1; break; }
2245  }
2246  if ( !first ) goto EndWrite;
2247  AO.IsBracket = 0;
2248  AO.OutSkip = 3;
2249  AR.DeferFlag = 0;
2250  while ( GetTerm(BHEAD AO.termbuf) ) {
2251  t = AO.termbuf + 1;
2252  e = Expressions + AO.termbuf[3];
2253  n = e->status;
2254  if ( ( n == LOCALEXPRESSION || n == GLOBALEXPRESSION
2255  || n == UNHIDELEXPRESSION || n == UNHIDEGEXPRESSION ) &&
2256  ( ( prtf = e->printflag ) & PRINTON ) != 0 ) {
2257  e->printflag = 0;
2258  AO.NumInBrack = 0;
2259  PutPreVar(AM.oldnumextrasymbols,
2260  GetPreVar((UBYTE *)"EXTRASYMBOLS_",0),0,1);
2261  if ( ( prtf & PRINTLFILE ) != 0 ) {
2262  if ( AC.LogHandle < 0 ) prtf &= ~PRINTLFILE;
2263  }
2264  AO.PrintType = prtf;
2265 /*
2266  if ( AC.OutputMode == VORTRANMODE ) {
2267  UBYTE *oldOutFill = AO.OutFill, *oldOutputLine = AO.OutputLine;
2268  AO.OutSkip = 6;
2269  if ( Optimize(AO.termbuf[3], 1) ) goto AboWrite;
2270  AO.OutSkip = 3;
2271  AO.OutFill = oldOutFill; AO.OutputLine = oldOutputLine;
2272  FiniLine();
2273  continue;
2274  }
2275  else
2276 */
2277  if ( AO.OptimizationLevel > 0 ) {
2278  UBYTE *oldOutFill = AO.OutFill, *oldOutputLine = AO.OutputLine;
2279  AO.OutSkip = 6;
2280  if ( Optimize(AO.termbuf[3], 1) ) goto AboWrite;
2281  AO.OutSkip = 3;
2282  AO.OutFill = oldOutFill; AO.OutputLine = oldOutputLine;
2283  FiniLine();
2284  continue;
2285  }
2286  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2287  AO.OutSkip = 6;
2288  FiniLine();
2289  AO.CurBufWrt = EXPRNAME(AO.termbuf[3]);
2290  TokenToLine(AO.CurBufWrt);
2291  stopper = t + t[1];
2292  t += SUBEXPSIZE;
2293  if ( t < stopper ) {
2294  TokenToLine((UBYTE *)"(");
2295  first = 1;
2296  while ( t < stopper ) {
2297  n = *t;
2298  if ( !first ) TokenToLine((UBYTE *)",");
2299  switch ( n ) {
2300  case SYMTOSYM :
2301  TokenToLine(VARNAME(symbols,t[2]));
2302  break;
2303  case VECTOVEC :
2304  TokenToLine(VARNAME(vectors,t[2] - AM.OffsetVector));
2305  break;
2306  case INDTOIND :
2307  TokenToLine(VARNAME(indices,t[2] - AM.OffsetIndex));
2308  break;
2309  default :
2310  TokenToLine(VARNAME(functions,t[2] - FUNCTION));
2311  break;
2312  }
2313  t += t[1];
2314  first = 0;
2315  }
2316  TokenToLine((UBYTE *)")");
2317  }
2318  TOKENTOLINE(" =","=");
2319  lbrac = 0;
2320  AO.InFbrack = 0;
2321  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2322  AO.FortFirst = 1;
2323  else
2324  AO.FortFirst = 0;
2325  first = 1;
2326  if ( ( e->vflags & ISFACTORIZED ) != 0 ) {
2327  AO.FactorMode = 1+e->numfactors;
2328  AO.FactorNum = 0; /* Which factor are we doing. For factors that are zero */
2329  }
2330  else {
2331  AO.FactorMode = 0;
2332  }
2333  while ( GetTerm(BHEAD AO.termbuf) ) {
2334  WORD *m;
2335  GETSTOP(AO.termbuf,m);
2336  if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2337  && ( ( prtf & PRINTONETERM ) != 0 ) ) {}
2338  else {
2339  if ( first ) {
2340  FiniLine();
2341  IniLine(0);
2342  }
2343  }
2344  if ( ( prtf & PRINTONETERM ) != 0 ) first = 0;
2345  if ( WriteTerm(AO.termbuf,&lbrac,first,prtf,0) )
2346  goto AboWrite;
2347  first = 0;
2348  }
2349  if ( AO.FactorMode ) {
2350  if ( first ) { AO.FactorNum = 1; TOKENTOLINE(" ( 0 )"," (0)") }
2351  else TOKENTOLINE(" )",")");
2352  for ( i = AO.FactorNum+1; i <= e->numfactors; i++ ) {
2353  FiniLine();
2354  IniLine(0);
2355  TOKENTOLINE(" * ( 0 )","*(0)");
2356  }
2357  AO.FactorNum = e->numfactors;
2358  if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE )
2359  TokenToLine((UBYTE *)";");
2360  }
2361  else if ( AO.FactorMode == 0 || first ) {
2362  if ( first ) { TOKENTOLINE(" 0","0") }
2363  else if ( lbrac ) {
2364  if ( ( prtf & PRINTCONTENTS ) != 0 ) PrtTerms();
2365  TOKENTOLINE(" )",")")
2366  }
2367  else if ( ( prtf & PRINTCONTENTS ) != 0 ) {
2368  TOKENTOLINE(" + 1 * ( ","+1*(")
2369  PrtTerms();
2370  TOKENTOLINE(" )",")")
2371  }
2372  if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE )
2373  TokenToLine((UBYTE *)";");
2374  }
2375  AO.OutSkip = 3;
2376  AC.IsFortran90 = ISNOTFORTRAN90;
2377  FiniLine();
2378  AC.IsFortran90 = oldIsFortran90;
2379  AO.FactorMode = 0;
2380  }
2381  else {
2382  do { } while ( GetTerm(BHEAD AO.termbuf) );
2383  }
2384  }
2385  if ( AC.OutputSpaces == NORMALFORMAT ) FiniLine();
2386 EndWrite:
2387  if ( AR.infile->handle >= 0 ) {
2388  SeekFile(AR.infile->handle,&(AR.infile->filesize),SEEK_SET);
2389  }
2390  AO.IsBracket = 0;
2391  AT.WorkPointer = AO.termbuf;
2392  SetScratch(AR.infile,&pos);
2393  f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2394  return(0);
2395 AboWrite:
2396  SetScratch(AR.infile,&pos);
2397  f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2398  MesCall("WriteAll");
2399  Terminate(-1);
2400  return(-1);
2401 }
2402 
2403 /*
2404  #] WriteAll :
2405  #[ WriteOne : WORD WriteOne(name,alreadyinline)
2406 
2407  Writes one expression from the preprocessor
2408 */
2409 
2410 WORD WriteOne(UBYTE *name, int alreadyinline, int nosemi)
2411 {
2412  GETIDENTITY
2413  WORD number;
2414  WORD lbrac, first;
2415  POSITION pos;
2416  FILEHANDLE *f;
2417 
2418  if ( GetName(AC.exprnames,name,&number,NOAUTO) != CEXPRESSION ) {
2419  MesPrint("@%s is not an expression",name);
2420  return(-1);
2421  }
2422  switch ( Expressions[number].status ) {
2423  case HIDDENLEXPRESSION:
2424  case HIDDENGEXPRESSION:
2425  case HIDELEXPRESSION:
2426  case HIDEGEXPRESSION:
2427  case UNHIDELEXPRESSION:
2428  case UNHIDEGEXPRESSION:
2429 /*
2430  case DROPHLEXPRESSION:
2431  case DROPHGEXPRESSION:
2432 */
2433  AR.GetFile = 2;
2434  break;
2435  case LOCALEXPRESSION:
2436  case GLOBALEXPRESSION:
2437  case SKIPLEXPRESSION:
2438  case SKIPGEXPRESSION:
2439 /*
2440  case DROPLEXPRESSION:
2441  case DROPGEXPRESSION:
2442 */
2443  AR.GetFile = 0;
2444  break;
2445  default:
2446  MesPrint("@expressions %s is not active. It cannot be written",name);
2447  return(-1);
2448  }
2449  SeekScratch(AR.outfile,&pos);
2450 
2451  f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2452 /*
2453  if ( ResetScratch() ) {
2454  MesCall("WriteOne");
2455  SETERROR(-1)
2456  }
2457 */
2458  if ( AR.GetFile == 2 ) f = AR.hidefile;
2459  else f = AR.infile;
2460 /*
2461  Now position the file
2462 */
2463  if ( f->handle >= 0 ) {
2464  SetScratch(f,&(Expressions[number].onfile));
2465  }
2466  else {
2467  f->POfill = (WORD *)((UBYTE *)(f->PObuffer)
2468  + BASEPOSITION(Expressions[number].onfile));
2469  }
2470  AO.termbuf = AT.WorkPointer;
2471  AO.bracket = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
2472  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer*2);
2473 
2474  AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
2475  AT.WorkPointer += 2*AC.LineLength;
2476  *(AR.CompressBuffer) = 0;
2477 
2478  AO.IsBracket = 0;
2479  AO.OutSkip = 3;
2480  AR.DeferFlag = 0;
2481 
2482  if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2483  AO.OutSkip = 6;
2484  if ( GetTerm(BHEAD AO.termbuf) <= 0 ) {
2485  MesPrint("@ReadError in expression %s",name);
2486  goto AboWrite;
2487  }
2488 /*
2489  PutPreVar(AM.oldnumextrasymbols,
2490  GetPreVar((UBYTE *)"EXTRASYMBOLS_",0),0,1);
2491 */
2492  /*
2493  * Currently WriteOne() is called only from writeToChannel() with setting
2494  * AO.OptimizationLevel = 0, which means Optimize() is never called here.
2495  * So we don't need to think about how to ensure that the master and the
2496  * slaves call Optimize() at the same time. (TU 26 Jul 2013)
2497  */
2498  if ( AO.OptimizationLevel > 0 ) {
2499  AO.OutSkip = 6;
2500  if ( Optimize(AO.termbuf[3], 1) ) goto AboWrite;
2501  AO.OutSkip = 3;
2502  FiniLine();
2503  }
2504  else {
2505  lbrac = 0;
2506  AO.InFbrack = 0;
2507  AO.FortFirst = 0;
2508  first = 1;
2509  while ( GetTerm(BHEAD AO.termbuf) ) {
2510  WORD *m;
2511  GETSTOP(AO.termbuf,m);
2512  if ( first ) {
2513  IniLine(0);
2514  startinline = alreadyinline;
2515  AO.OutFill = AO.OutputLine + startinline;
2516  }
2517  if ( WriteTerm(AO.termbuf,&lbrac,first,0,0) )
2518  goto AboWrite;
2519  first = 0;
2520  }
2521  if ( first ) {
2522  IniLine(0);
2523  startinline = alreadyinline;
2524  AO.OutFill = AO.OutputLine + startinline;
2525  TOKENTOLINE(" 0","0");
2526  }
2527  else if ( lbrac ) {
2528  TOKENTOLINE(" )",")");
2529  }
2530  if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE
2531  && nosemi == 0 ) TokenToLine((UBYTE *)";");
2532  AO.OutSkip = 3;
2533  if ( AC.OutputSpaces == NORMALFORMAT && nosemi == 0 ) {
2534  FiniLine();
2535  }
2536  else {
2537  noextralinefeed = 1;
2538  FiniLine();
2539  noextralinefeed = 0;
2540  }
2541  }
2542  AO.IsBracket = 0;
2543  AT.WorkPointer = AO.termbuf;
2544  SetScratch(f,&pos);
2545  f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2546  AO.InFbrack = 0;
2547  return(0);
2548 AboWrite:
2549  SetScratch(AR.infile,&pos);
2550  f->POposition = pos;
2551  f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2552  MesCall("WriteOne");
2553  Terminate(-1);
2554  return(-1);
2555 }
2556 
2557 /*
2558  #] WriteOne :
2559  #] schryf-Writes :
2560 */
2561 
2562 
2563 
int PutPreVar(UBYTE *, UBYTE *, UBYTE *, int)
Definition: pre.c:549
Definition: structs.h:618
WORD ** lhs
Definition: structs.h:912
Definition: structs.h:908
WORD ** rhs
Definition: structs.h:913
int handle
Definition: structs.h:646