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