FORM v5.0.1-33-gdf7fc94
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/* INTERNAL_ERROR_EXCL_START */
1501 MesPrint("!>Illegal function argument while writing");
1502 goto CleanUp;
1503/* INTERNAL_ERROR_EXCL_STOP */
1504 }
1505 TokenToLine(buffer);
1506CleanUp:
1507 lowestlevel = oldlowestlevel;
1508 return;
1509}
1510
1511/*
1512 #] WriteArgument :
1513 #[ WriteSubTerm : WORD WriteSubTerm(sterm,first)
1514
1515 Writes a single subterm field to the output line.
1516 There is a recursion for functions.
1517
1518
1519#define NUMSPECS 8
1520UBYTE *specfunnames[NUMSPECS] = {
1521 (UBYTE *)"fac" , (UBYTE *)"nargs", (UBYTE *)"binom"
1522 , (UBYTE *)"sign", (UBYTE *)"mod", (UBYTE *)"min", (UBYTE *)"max"
1523 , (UBYTE *)"invfac" };
1524*/
1525
1526int WriteSubTerm(WORD *sterm, WORD first)
1527{
1528 UBYTE buffer[80];
1529 UBYTE *Out, closepar[2] = { (UBYTE)')', 0};
1530 WORD *stopper, *t, *tt, i, j, po = 0;
1531 int oldoutsidefun;
1532 stopper = sterm + sterm[1];
1533 t = sterm + 2;
1534 switch ( *sterm ) {
1535 case SYMBOL :
1536 while ( t < stopper ) {
1537 if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1538 FiniLine();
1539 if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1540 else IniLine(3);
1541 if ( first ) TokenToLine((UBYTE *)" ");
1542 }
1543 if ( !first ) MultiplyToLine();
1544 if ( AC.OutputMode == CMODE && t[1] != 1 ) {
1545 if ( AC.Cnumpows >= t[1] && t[1] > 0 ) {
1546 po = t[1];
1547 Out = StrCopy((UBYTE *)"POW",buffer);
1548 Out = NumCopy(po,Out);
1549 Out = StrCopy((UBYTE *)"(",Out);
1550 TokenToLine(buffer);
1551 }
1552 else {
1553 TokenToLine((UBYTE *)"pow(");
1554 }
1555 }
1556 if ( *t < NumSymbols ) {
1557 Out = StrCopy(FindSymbol(*t),buffer); t++;
1558/* Out = StrCopy(VARNAME(symbols,*t),buffer); t++; */
1559 }
1560 else {
1561/*
1562 see also routine PrintSubtermList.
1563*/
1564 Out = StrCopy(FindExtraSymbol(MAXVARIABLES-*t),buffer);
1565/*
1566 Out = StrCopy((UBYTE *)AC.extrasym,buffer);
1567 if ( AC.extrasymbols == 0 ) {
1568 Out = NumCopy((MAXVARIABLES-*t),Out);
1569 Out = StrCopy((UBYTE *)"_",Out);
1570 }
1571 else if ( AC.extrasymbols == 1 ) {
1572 Out = AddArrayIndex((MAXVARIABLES-*t),Out);
1573 }
1574*/
1575/*
1576 else if ( AC.extrasymbols == 2 ) {
1577 Out = NumCopy((MAXVARIABLES-*t),Out);
1578 }
1579*/
1580 t++;
1581 }
1582 if ( AC.OutputMode == CMODE && po > 1
1583 && AC.Cnumpows >= po ) {
1584 Out = StrCopy((UBYTE *)")",Out);
1585 po = 0;
1586 }
1587 else if ( *t != 1 ) WrtPower(Out,*t);
1588 TokenToLine(buffer);
1589 t++;
1590 first = 0;
1591 }
1592 break;
1593 case VECTOR :
1594 while ( t < stopper ) {
1595 if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1596 FiniLine();
1597 if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1598 else IniLine(3);
1599 if ( first ) TokenToLine((UBYTE *)" ");
1600 }
1601 if ( !first ) MultiplyToLine();
1602
1603 Out = StrCopy(FindVector(*t),buffer);
1604/* Out = StrCopy(VARNAME(vectors,*t - AM.OffsetVector),buffer); */
1605 t++;
1606 if ( AC.OutputMode == MATHEMATICAMODE ) *Out++ = '[';
1607 else *Out++ = '(';
1608 if ( *t >= AM.OffsetIndex ) {
1609 i = *t++;
1610 if ( i >= AM.IndDum ) {
1611 i -= AM.IndDum;
1612 *Out++ = 'N';
1613 Out = NumCopy(i,Out);
1614 *Out++ = '_';
1615 *Out++ = '?';
1616 *Out = 0;
1617 }
1618 else
1619 Out = StrCopy(FindIndex(i),Out);
1620/* Out = StrCopy(VARNAME(indices,i - AM.OffsetIndex),Out); */
1621 }
1622 else if ( *t == FUNNYVEC ) { *Out++ = '?'; *Out = 0; }
1623 else {
1624 Out = NumCopy(*t++,Out);
1625 }
1626 if ( AC.OutputMode == MATHEMATICAMODE ) *Out++ = ']';
1627 else *Out++ = ')';
1628 *Out = 0;
1629 TokenToLine(buffer);
1630 first = 0;
1631 }
1632 break;
1633 case INDEX :
1634 while ( t < stopper ) {
1635 if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1636 FiniLine();
1637 if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1638 else IniLine(3);
1639 if ( first ) TokenToLine((UBYTE *)" ");
1640 }
1641 if ( !first ) MultiplyToLine();
1642 if ( *t >= 0 ) {
1643 if ( *t < AM.OffsetIndex ) {
1644 TalToLine((UWORD)(*t++));
1645 }
1646 else {
1647 i = *t++;
1648 if ( i >= AM.IndDum ) {
1649 i -= AM.IndDum;
1650 Out = buffer;
1651 *Out++ = 'N';
1652 Out = NumCopy(i,Out);
1653 *Out++ = '_';
1654 *Out++ = '?';
1655 *Out = 0;
1656 }
1657 else {
1658 i -= AM.OffsetIndex;
1659 Out = StrCopy(FindIndex(i%WILDOFFSET+AM.OffsetIndex),buffer);
1660/* Out = StrCopy(VARNAME(indices,i%WILDOFFSET),buffer); */
1661 if ( i >= WILDOFFSET ) { *Out++ = '?'; *Out = 0; }
1662 }
1663 TokenToLine(buffer);
1664 }
1665 }
1666 else {
1667 TokenToLine(FindVector(*t)); t++;
1668/* TokenToLine(VARNAME(vectors,*t - AM.OffsetVector)); t++; */
1669 }
1670 first = 0;
1671 }
1672 break;
1673 case DOLLAREXPRESSION:
1674 {
1675 DOLLARS d = Dollars + sterm[2];
1676 Out = StrCopy((UBYTE *)"$",buffer);
1677 Out = StrCopy(AC.dollarnames->namebuffer+d->name,Out);
1678 if ( sterm[3] != 1 ) WrtPower(Out,sterm[3]);
1679 TokenToLine(buffer);
1680 }
1681 first = 0;
1682 break;
1683 case DELTA :
1684 while ( t < stopper ) {
1685 if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1686 FiniLine();
1687 if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1688 else IniLine(3);
1689 if ( first ) TokenToLine((UBYTE *)" ");
1690 }
1691 if ( !first ) MultiplyToLine();
1692 Out = StrCopy((UBYTE *)"d_(",buffer);
1693 if ( *t >= AM.OffsetIndex ) {
1694 if ( *t < AM.IndDum ) {
1695 Out = StrCopy(FindIndex(*t),Out);
1696/* Out = StrCopy(VARNAME(indices,*t - AM.OffsetIndex),Out); */
1697 t++;
1698 }
1699 else {
1700 *Out++ = 'N';
1701 Out = NumCopy( *t++ - AM.IndDum, Out);
1702 *Out++ = '_';
1703 *Out++ = '?';
1704 *Out = 0;
1705 }
1706 }
1707 else if ( *t == FUNNYVEC ) { *Out++ = '?'; *Out = 0; }
1708 else {
1709 Out = NumCopy(*t++,Out);
1710 }
1711 *Out++ = ',';
1712 if ( *t >= AM.OffsetIndex ) {
1713 if ( *t < AM.IndDum ) {
1714 Out = StrCopy(FindIndex(*t),Out);
1715/* Out = StrCopy(VARNAME(indices,*t - AM.OffsetIndex),Out); */
1716 t++;
1717 }
1718 else {
1719 *Out++ = 'N';
1720 Out = NumCopy(*t++ - AM.IndDum,Out);
1721 *Out++ = '_';
1722 *Out++ = '?';
1723 }
1724 }
1725 else {
1726 Out = NumCopy(*t++,Out);
1727 }
1728 *Out++ = ')';
1729 *Out = 0;
1730 TokenToLine(buffer);
1731 first = 0;
1732 }
1733 break;
1734 case DOTPRODUCT :
1735 while ( t < stopper ) {
1736 if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1737 FiniLine();
1738 if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1739 else IniLine(3);
1740 if ( first ) TokenToLine((UBYTE *)" ");
1741 }
1742 if ( !first ) MultiplyToLine();
1743 if ( AC.OutputMode == CMODE && t[2] != 1 )
1744 TokenToLine((UBYTE *)"pow(");
1745 if ( AC.OutputMode == MATHEMATICAMODE )
1746 TokenToLine((UBYTE *)"(");
1747 Out = StrCopy(FindVector(*t),buffer);
1748/* Out = StrCopy(VARNAME(vectors,*t - AM.OffsetVector),buffer); */
1749 t++;
1750 if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
1751 || AC.OutputMode == CMODE )
1752 *Out++ = AO.FortDotChar;
1753 else *Out++ = '.';
1754 Out = StrCopy(FindVector(*t),Out);
1755/* Out = StrCopy(VARNAME(vectors,*t - AM.OffsetVector),Out); */
1756 if ( AC.OutputMode == MATHEMATICAMODE ) {
1757 *Out++ = ')';
1758 *Out = 0;
1759 }
1760 t++;
1761 if ( *t != 1 ) WrtPower(Out,*t);
1762 t++;
1763 TokenToLine(buffer);
1764 first = 0;
1765 }
1766 break;
1767 case EXPONENT :
1768#if FUNHEAD != 2
1769 t += FUNHEAD - 2;
1770#endif
1771 if ( !first ) MultiplyToLine();
1772 if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)"pow(");
1773 else TokenToLine((UBYTE *)"(");
1774 WriteArgument(t);
1775 if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
1776 || AC.OutputMode == REDUCEMODE )
1777 TokenToLine((UBYTE *)")**(");
1778 else if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)",");
1779 else {
1780 UBYTE *Out1 = IsExponentSign();
1781 if ( Out1 ) {
1782 TokenToLine((UBYTE *)")");
1783 TokenToLine(Out1);
1784 TokenToLine((UBYTE *)"(");
1785 }
1786 else TokenToLine((UBYTE *)")^(");
1787 }
1788 NEXTARG(t)
1789 WriteArgument(t);
1790 TokenToLine((UBYTE *)")");
1791 break;
1792 case DENOMINATOR :
1793#if FUNHEAD != 2
1794 t += FUNHEAD - 2;
1795#endif
1796 if ( first ) TokenToLine((UBYTE *)"1/(");
1797 else TokenToLine((UBYTE *)"/(");
1798 WriteArgument(t);
1799 TokenToLine((UBYTE *)")");
1800 break;
1801 case SUBEXPRESSION:
1802 if ( !first ) MultiplyToLine();
1803 TokenToLine((UBYTE *)"(");
1804 t = cbuf[sterm[4]].rhs[sterm[2]];
1805 tt = t;
1806 while ( *tt ) tt += *tt;
1807 oldoutsidefun = AC.outsidefun; AC.outsidefun = 0;
1808 if ( *t ) {
1809 WriteExpression(t,(LONG)(tt-t));
1810 }
1811 else {
1812 TokenToLine((UBYTE *)"0");
1813 }
1814 AC.outsidefun = oldoutsidefun;
1815 TokenToLine((UBYTE *)")");
1816 if ( sterm[3] != 1 ) {
1817 UBYTE *Out1 = IsExponentSign();
1818 if ( Out1 ) TokenToLine(Out1);
1819 else TokenToLine((UBYTE *)"^");
1820 Out = buffer;
1821 NumCopy(sterm[3],Out);
1822 TokenToLine(buffer);
1823 }
1824 break;
1825 default :
1826 if ( lowestlevel && ( ( AO.PrintType & PRINTALL ) != 0 ) ) {
1827 FiniLine();
1828 if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1829 else IniLine(3);
1830 if ( first ) TokenToLine((UBYTE *)" ");
1831 }
1832 if ( *sterm < FUNCTION ) {
1833/* INTERNAL_ERROR_EXCL_START */
1834 return(MesPrint("!>Illegal subterm while writing"));
1835/* INTERNAL_ERROR_EXCL_STOP */
1836 }
1837 if ( !first ) MultiplyToLine();
1838 first = 1;
1839 { UBYTE *tmp;
1840 if ( ( tmp = FindFunWithArgs(sterm) ) != 0 ) {
1841 TokenToLine(tmp);
1842 break;
1843 }
1844 }
1845 t += FUNHEAD-2;
1846
1847 if ( *sterm == GAMMA && t[-FUNHEAD+1] == FUNHEAD+1 ) {
1848 TokenToLine((UBYTE *)"gi_(");
1849 }
1850 else {
1851 if ( *sterm != DUMFUN ) {
1852 Out = StrCopy(FindFunction(*sterm),buffer);
1853/* Out = StrCopy(VARNAME(functions,*sterm - FUNCTION),buffer); */
1854 }
1855 else { Out = buffer; *Out = 0; }
1856 if ( t >= stopper ) {
1857 TokenToLine(buffer);
1858 break;
1859 }
1860 if ( AC.OutputMode == MATHEMATICAMODE ) { *Out++ = '['; closepar[0] = (UBYTE)']'; }
1861 else { *Out++ = '('; }
1862 *Out = 0;
1863 TokenToLine(buffer);
1864 }
1865 i = functions[*sterm - FUNCTION].spec;
1866 if ( i >= TENSORFUNCTION ) {
1867 int curdict = AO.CurrentDictionary;
1868 if ( AO.CurrentDictionary && AO.CurDictNotInFunctions > 0 )
1869 AO.CurrentDictionary = 0;
1870 t = sterm + FUNHEAD;
1871 while ( t < stopper ) {
1872 if ( !first ) TokenToLine((UBYTE *)",");
1873 else first = 0;
1874 j = *t++;
1875 if ( j >= 0 ) {
1876 if ( j < AM.OffsetIndex ) TalToLine((UWORD)(j));
1877 else if ( j < AM.IndDum ) {
1878 i = j - AM.OffsetIndex;
1879 Out = StrCopy(FindIndex(i%WILDOFFSET+AM.OffsetIndex),buffer);
1880/* Out = StrCopy(VARNAME(indices,i%WILDOFFSET),buffer); */
1881 if ( i >= WILDOFFSET ) { *Out++ = '?'; *Out = 0; }
1882 TokenToLine(buffer);
1883 }
1884 else {
1885 Out = buffer;
1886 *Out++ = 'N';
1887 Out = NumCopy(j - AM.IndDum,Out);
1888 *Out++ = '_';
1889 *Out++ = '?';
1890 *Out = 0;
1891 TokenToLine(buffer);
1892 }
1893 }
1894 else if ( j == FUNNYVEC ) { TokenToLine((UBYTE *)"?"); }
1895 else if ( j > -WILDOFFSET ) {
1896 Out = buffer;
1897 Out = NumCopy((UWORD)(-j + 4),Out);
1898 *Out++ = '_';
1899 *Out = 0;
1900 TokenToLine(buffer);
1901 }
1902 else {
1903 TokenToLine(FindVector(j));
1904/* TokenToLine(VARNAME(vectors,j - AM.OffsetVector)); */
1905 }
1906 }
1907 AO.CurrentDictionary = curdict;
1908 }
1909 else {
1910 int curdict = AO.CurrentDictionary;
1911 if ( AO.CurrentDictionary && AO.CurDictNotInFunctions > 0 )
1912 AO.CurrentDictionary = 0;
1913 while ( t < stopper ) {
1914 if ( !first ) TokenToLine((UBYTE *)",");
1915 WriteArgument(t);
1916 NEXTARG(t)
1917 first = 0;
1918 }
1919 AO.CurrentDictionary = curdict;
1920 }
1921 TokenToLine(closepar);
1922 closepar[0] = (UBYTE)')';
1923 break;
1924 }
1925 return(0);
1926}
1927
1928/*
1929 #] WriteSubTerm :
1930 #[ WriteInnerTerm : WORD WriteInnerTerm(term,first)
1931
1932 Writes the contents of term to the output.
1933 Only the part that is inside parentheses is written.
1934
1935*/
1936
1937int WriteInnerTerm(WORD *term, WORD first)
1938{
1939 WORD *t, *s, *s1, *s2, n, i, pow;
1940#ifdef WITHFLOAT
1941 int FloatChars = 0;
1942 GETIDENTITY
1943#endif
1944 t = term;
1945 s = t+1;
1946 GETCOEF(t,n);
1947 while ( s < t ) {
1948 if ( *s == HAAKJE ) break;
1949 s += s[1];
1950 }
1951 if ( s < t ) { s += s[1]; }
1952 else { s = term+1; }
1953
1954 if ( n < 0 || !first ) {
1955 if ( n > 0 ) { TOKENTOLINE(" + ","+") }
1956 else if ( n < 0 ) { n = -n; TOKENTOLINE(" - ","-") }
1957 }
1958 if ( AC.modpowers ) {
1959 if ( n == 1 && *t == 1 && t > s ) first = 1;
1960 else if ( ABS(AC.ncmod) == 1 ) {
1961 UBYTE *Out1 = IsExponentSign();
1962 LongToLine((UWORD *)AC.powmod,AC.npowmod);
1963 if ( Out1 ) TokenToLine(Out1);
1964 else TokenToLine((UBYTE *)"^");
1965 TalToLine(AC.modpowers[(LONG)((UWORD)*t)]);
1966 first = 0;
1967 }
1968 else {
1969 LONG jj;
1970 UBYTE *Out1 = IsExponentSign();
1971 LongToLine((UWORD *)AC.powmod,AC.npowmod);
1972 if ( Out1 ) TokenToLine(Out1);
1973 else TokenToLine((UBYTE *)"^");
1974 jj = (UWORD)*t;
1975 if ( n == 2 ) jj += ((LONG)t[1])<<BITSINWORD;
1976 if ( AC.modpowers[jj+1] == 0 ) {
1977 TalToLine(AC.modpowers[jj]);
1978 }
1979 else {
1980 LongToLine(AC.modpowers+jj,2);
1981 }
1982 first = 0;
1983 }
1984 }
1985 else if ( n != 1 || *t != 1 || t[1] != 1 || t <= s ) {
1986 if ( lowestlevel && ( ( AO.PrintType & PRINTONEFUNCTION ) != 0 ) ) {
1987 FiniLine();
1988 if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
1989 else IniLine(3);
1990 }
1991 if ( AO.CurrentDictionary > 0 ) TransformRational((UWORD *)t,n);
1992 else RatToLine((UWORD *)t,n);
1993 first = 0;
1994 }
1995#ifdef WITHFLOAT
1996/*
1997 Check whether there is a 'proper' float_ function and no raw mode.
1998 If so, print as float.
1999 Raw mode is indicated as AO.FloatPrec < 0.
2000 AO.FloatPrec == 0 indicated as many digits as the precision allows.
2001*/
2002 else if ( AO.FloatPrec >= 0 && AT.aux_ != 0 ) {
2003 WORD *ss = s;
2004 while ( ss < t ) {
2005 if ( *ss == FLOATFUN ) {
2006 if ( ( FloatChars = PrintFloat(ss,AO.FloatPrec) ) != 0 ) {
2007 TokenToLine(AO.floatspace);
2008 if ( AC.IsFortran90 == ISFORTRAN90 && AC.Fortran90Kind ) {
2009 AddToLine(AC.Fortran90Kind);
2010 }
2011 first = 0;
2012 }
2013 break;
2014 }
2015 ss += ss[1];
2016 }
2017 if ( ss >= t ) first = 1;
2018 }
2019#endif
2020 else first = 1;
2021 while ( s < t ) {
2022 if ( lowestlevel && ( (AO.PrintType & (PRINTONEFUNCTION | PRINTALL)) == PRINTONEFUNCTION ) ) {
2023 FiniLine();
2024 if ( AC.OutputSpaces == NOSPACEFORMAT ) IniLine(1);
2025 else IniLine(3);
2026 }
2027
2028/*
2029 #[ NEWGAMMA :
2030*/
2031#ifdef NEWGAMMA
2032 if ( *s == GAMMA ) { /* String them up */
2033 WORD *tt,*ss;
2034 ss = AT.WorkPointer;
2035 *ss++ = GAMMA;
2036 *ss++ = s[1];
2037 FILLFUN(ss)
2038 *ss++ = s[FUNHEAD];
2039 tt = s + FUNHEAD + 1;
2040 n = s[1] - FUNHEAD-1;
2041 do {
2042 while ( --n >= 0 ) *ss++ = *tt++;
2043 tt = s + s[1];
2044 while ( *tt == GAMMA && tt[FUNHEAD] == s[FUNHEAD] && tt < t ) {
2045 s = tt;
2046 tt += FUNHEAD + 1;
2047 n = s[1] - FUNHEAD-1;
2048 if ( n > 0 ) break;
2049 }
2050 } while ( n > 0 );
2051 tt = AT.WorkPointer;
2052 AT.WorkPointer = ss;
2053 tt[1] = WORDDIF(ss,tt);
2054 if ( WriteSubTerm(tt,first) ) {
2055 MesCall("WriteInnerTerm");
2056 SETERROR(-1)
2057 }
2058 AT.WorkPointer = tt;
2059 }
2060 else
2061#endif
2062/*
2063 #] NEWGAMMA :
2064*/
2065#ifdef WITHFLOAT
2066 if ( *s == FLOATFUN && AO.FloatPrec >= 0 && AT.aux_ != 0 ) {
2067 }
2068 else
2069#endif
2070 {
2071 if ( *s >= FUNCTION && AC.funpowers > 0
2072 && functions[*s-FUNCTION].spec == 0 && ( AC.funpowers == ALLFUNPOWERS ||
2073 ( AC.funpowers == COMFUNPOWERS && functions[*s-FUNCTION].commute == 0 ) ) ) {
2074 pow = 1;
2075 for(;;) {
2076 s1 = s; s2 = s + s[1]; i = s[1];
2077 if ( s2 < t ) {
2078 while ( --i >= 0 && *s1 == *s2 ) { s1++; s2++; }
2079 if ( i < 0 ) {
2080 pow++; s = s+s[1];
2081 }
2082 else break;
2083 }
2084 else break;
2085 }
2086 if ( pow > 1 ) {
2087 if ( AC.OutputMode == CMODE ) {
2088 if ( !first ) MultiplyToLine();
2089 TokenToLine((UBYTE *)"pow(");
2090 first = 1;
2091 }
2092 if ( WriteSubTerm(s,first) ) {
2093 MesCall("WriteInnerTerm");
2094 SETERROR(-1)
2095 }
2096 if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE
2097 || AC.OutputMode == REDUCEMODE ) { TokenToLine((UBYTE *)"**"); }
2098 else if ( AC.OutputMode == CMODE ) { TokenToLine((UBYTE *)","); }
2099 else {
2100 UBYTE *Out1 = IsExponentSign();
2101 if ( Out1 ) TokenToLine(Out1);
2102 else TokenToLine((UBYTE *)"^");
2103 }
2104 TalToLine(pow);
2105 if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)")");
2106 }
2107 else if ( WriteSubTerm(s,first) ) {
2108 MesCall("WriteInnerTerm");
2109 SETERROR(-1)
2110 }
2111 }
2112 else if ( WriteSubTerm(s,first) ) {
2113 MesCall("WriteInnerTerm");
2114 SETERROR(-1)
2115 }
2116 }
2117 first = 0;
2118 s += s[1];
2119 }
2120 return(0);
2121}
2122
2123/*
2124 #] WriteInnerTerm :
2125 #[ WriteTerm : WORD WriteTerm(term,lbrac,first,prtf,br)
2126
2127 Writes a term to output. It tests the bracket information first.
2128 If there are no brackets or the bracket is the same all is passed
2129 to WriteInnerTerm. If there are brackets and the bracket is not
2130 the same as for the predecessor the old bracket is closed and
2131 a new one is opened.
2132 br indicates whether we are in a subexpression, barring zeroing
2133 AO.IsBracket
2134
2135*/
2136
2137int WriteTerm(WORD *term, WORD *lbrac, WORD first, WORD prtf, WORD br)
2138{
2139 WORD *t, *stopper, *b, n;
2140 int oldIsFortran90 = AC.IsFortran90, i;
2141 if ( *lbrac >= 0 ) {
2142 t = term + 1;
2143 stopper = (term + *term - 1);
2144 stopper -= ABS(*stopper) - 1;
2145 while ( t < stopper ) {
2146 if ( *t == HAAKJE ) {
2147 stopper = t;
2148 t = term+1;
2149 if ( *lbrac == ( n = WORDDIF(stopper,t) ) ) {
2150 b = AO.bracket + 1;
2151 t = term + 1;
2152 while ( n > 0 && ( *b++ == *t++ ) ) { n--; }
2153 if ( n <= 0 && ( ( AM.FortranCont <= 0 || AO.InFbrack < AM.FortranCont )
2154 || ( lowestlevel == 0 ) ) ) {
2155/*
2156 We continue inside a bracket.
2157*/
2158 AO.IsBracket = 1;
2159 if ( ( prtf & PRINTCONTENTS ) != 0 ) {
2160 AO.NumInBrack++;
2161 }
2162 else {
2163 if ( WriteInnerTerm(term,0) ) goto WrtTmes;
2164 if ( ( AO.PrintType & PRINTONETERM ) != 0 ) {
2165 FiniLine();
2166 TokenToLine((UBYTE *)" ");
2167 }
2168 }
2169 return(0);
2170 }
2171 t = term + 1;
2172 n = WORDDIF(stopper,t);
2173 }
2174/*
2175 Close the bracket
2176*/
2177 if ( *lbrac ) {
2178 if ( ( prtf & PRINTCONTENTS ) ) PrtTerms();
2179 TOKENTOLINE(" )",")")
2180 if ( AC.OutputMode == CMODE && AO.FactorMode == 0 )
2181 TokenToLine((UBYTE *)";");
2182 else if ( AO.FactorMode && ( n == 0 ) ) {
2183/*
2184 This should not happen.
2185*/
2186 return(0);
2187 }
2188 AC.IsFortran90 = ISNOTFORTRAN90;
2189 FiniLine();
2190 AC.IsFortran90 = oldIsFortran90;
2191 if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE
2192 && AC.OutputSpaces == NORMALFORMAT
2193 && AO.FactorMode == 0 ) FiniLine();
2194 }
2195 else {
2196 if ( AC.OutputMode == CMODE && AO.FactorMode == 0 )
2197 TokenToLine((UBYTE *)";");
2198 if ( AO.FortFirst == 0 ) {
2199 if ( !first ) {
2200 AC.IsFortran90 = ISNOTFORTRAN90;
2201 FiniLine();
2202 AC.IsFortran90 = oldIsFortran90;
2203 }
2204 }
2205 }
2206 if ( AO.FactorMode == 0 ) {
2207 if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2208 && !first ) {
2209 WORD oldmode = AC.OutputMode;
2210 AC.OutputMode = 0;
2211 IniLine(0);
2212 AC.OutputMode = oldmode;
2213 AO.OutSkip = 7;
2214
2215 if ( AO.FortFirst == 0 ) {
2216 TokenToLine(AO.CurBufWrt);
2217 TOKENTOLINE(" = ","=")
2218 TokenToLine(AO.CurBufWrt);
2219 }
2220 else {
2221 AO.FortFirst = 0;
2222 TokenToLine(AO.CurBufWrt);
2223 TOKENTOLINE(" = ","=")
2224 }
2225 }
2226 else if ( AC.OutputMode == CMODE && !first ) {
2227 IniLine(0);
2228 if ( AO.FortFirst == 0 ) {
2229 TokenToLine(AO.CurBufWrt);
2230 TOKENTOLINE(" += ","+=")
2231 }
2232 else {
2233 AO.FortFirst = 0;
2234 TokenToLine(AO.CurBufWrt);
2235 TOKENTOLINE(" = ","=")
2236 }
2237 }
2238 else if ( startinline == 0 ) {
2239 IniLine(0);
2240 }
2241 AO.InFbrack = 0;
2242 if ( ( *lbrac = n ) > 0 ) {
2243 b = AO.bracket;
2244 *b++ = n + 4;
2245 while ( --n >= 0 ) *b++ = *t++;
2246 *b++ = 1; *b++ = 1; *b = 3;
2247 AO.IsBracket = 0;
2248 if ( WriteInnerTerm(AO.bracket,0) ) {
2249 /* Error message */
2250 WORD i;
2251WrtTmes: t = term;
2252 AO.OutSkip = 3;
2253 FiniLine();
2254 i = *t;
2255 while ( --i >= 0 ) { TalToLine((UWORD)(*t++));
2256 if ( AC.OutputSpaces == NORMALFORMAT )
2257 TokenToLine((UBYTE *)" "); }
2258 AO.OutSkip = 0;
2259 FiniLine();
2260 MesCall("WriteTerm");
2261 SETERROR(-1)
2262 }
2263 TOKENTOLINE(" * ( ","*(")
2264 AO.NumInBrack = 0;
2265 AO.IsBracket = 1;
2266 if ( ( prtf & PRINTONETERM ) != 0 ) {
2267 first = 0;
2268 FiniLine();
2269 TokenToLine((UBYTE *)" ");
2270 }
2271 else first = 1;
2272 }
2273 else {
2274 AO.IsBracket = 0;
2275 first = 0;
2276 }
2277 }
2278 else {
2279/*
2280 Here is the code that writes the glue between two factors.
2281 We should not forget factors that are zero!
2282*/
2283 if ( ( *lbrac = n ) > 0 ) {
2284 b = AO.bracket;
2285 *b++ = n + 4;
2286 while ( --n >= 0 ) *b++ = *t++;
2287 *b++ = 1; *b++ = 1; *b = 3;
2288 for ( i = AO.FactorNum+1; i < AO.bracket[4]; i++ ) {
2289 if ( first ) {
2290 TOKENTOLINE(" ( 0 )"," (0)")
2291 first = 0;
2292 }
2293 else {
2294 TOKENTOLINE(" * ( 0 )","*(0)")
2295 }
2296 FiniLine();
2297 IniLine(0);
2298 }
2299 AO.FactorNum = AO.bracket[4];
2300 }
2301 else {
2302 AO.NumInBrack = 0;
2303 return(0);
2304 }
2305 if ( first == 0 ) { TOKENTOLINE(" * ( ","*(") }
2306 else { TOKENTOLINE(" ( "," (") }
2307 AO.NumInBrack = 0;
2308 first = 1;
2309 }
2310 if ( ( prtf & PRINTCONTENTS ) != 0 ) AO.NumInBrack++;
2311 else if ( WriteInnerTerm(term,first) ) goto WrtTmes;
2312 if ( ( AO.PrintType & PRINTONETERM ) != 0 ) {
2313 FiniLine();
2314 TokenToLine((UBYTE *)" ");
2315 }
2316 return(0);
2317 }
2318 else t += t[1];
2319 }
2320 if ( *lbrac > 0 ) {
2321 if ( ( prtf & PRINTCONTENTS ) != 0 ) PrtTerms();
2322 TokenToLine((UBYTE *)" )");
2323 if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)";");
2324 if ( AO.FortFirst == 0 ) {
2325 AC.IsFortran90 = ISNOTFORTRAN90;
2326 FiniLine();
2327 AC.IsFortran90 = oldIsFortran90;
2328 }
2329 if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE
2330 && AC.OutputSpaces == NORMALFORMAT ) FiniLine();
2331 if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2332 && !first ) {
2333 WORD oldmode = AC.OutputMode;
2334 AC.OutputMode = 0;
2335 IniLine(0);
2336 AC.OutputMode = oldmode;
2337 AO.OutSkip = 7;
2338 if ( AO.FortFirst == 0 ) {
2339 TokenToLine(AO.CurBufWrt);
2340 TOKENTOLINE(" = ","=")
2341 TokenToLine(AO.CurBufWrt);
2342 }
2343 else {
2344 AO.FortFirst = 0;
2345 TokenToLine(AO.CurBufWrt);
2346 TOKENTOLINE(" = ","=")
2347 }
2348/*
2349 TokenToLine(AO.CurBufWrt);
2350 TOKENTOLINE(" = ","=")
2351 if ( AO.FortFirst == 0 )
2352 TokenToLine(AO.CurBufWrt);
2353 else AO.FortFirst = 0;
2354*/
2355 }
2356 else if ( AC.OutputMode == CMODE && !first ) {
2357 IniLine(0);
2358 if ( AO.FortFirst == 0 ) {
2359 TokenToLine(AO.CurBufWrt);
2360 TOKENTOLINE(" += ","+=")
2361 }
2362 else {
2363 AO.FortFirst = 0;
2364 TokenToLine(AO.CurBufWrt);
2365 TOKENTOLINE(" = ","=")
2366 }
2367/*
2368 TokenToLine(AO.CurBufWrt);
2369 if ( AO.FortFirst == 0 ) { TOKENTOLINE(" += ","+=") }
2370 else {
2371 TOKENTOLINE(" = ","=")
2372 AO.FortFirst = 0;
2373 }
2374*/
2375 }
2376 else IniLine(0);
2377 *lbrac = 0;
2378 first = 1;
2379 }
2380 }
2381 if ( !br ) AO.IsBracket = 0;
2382 if ( ( AM.FortranCont > 0 && AO.InFbrack >= AM.FortranCont ) && lowestlevel ) {
2383 if ( AC.OutputMode == CMODE ) TokenToLine((UBYTE *)";");
2384 if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2385 && !first ) {
2386 WORD oldmode = AC.OutputMode;
2387 if ( AO.FortFirst == 0 ) {
2388 AC.IsFortran90 = ISNOTFORTRAN90;
2389 FiniLine();
2390 AC.IsFortran90 = oldIsFortran90;
2391 AC.OutputMode = 0;
2392 IniLine(0);
2393 AC.OutputMode = oldmode;
2394 AO.OutSkip = 7;
2395 TokenToLine(AO.CurBufWrt);
2396 TOKENTOLINE(" = ","=")
2397 TokenToLine(AO.CurBufWrt);
2398 }
2399 else {
2400 AO.FortFirst = 0;
2401/*
2402 TokenToLine(AO.CurBufWrt);
2403 TOKENTOLINE(" = ","=")
2404*/
2405 }
2406/*
2407 TokenToLine(AO.CurBufWrt);
2408 TOKENTOLINE(" = ","=")
2409 if ( AO.FortFirst == 0 )
2410 TokenToLine(AO.CurBufWrt);
2411 else AO.FortFirst = 0;
2412*/
2413 }
2414 else if ( AC.OutputMode == CMODE && !first ) {
2415 FiniLine();
2416 IniLine(0);
2417 if ( AO.FortFirst == 0 ) {
2418 TokenToLine(AO.CurBufWrt);
2419 TOKENTOLINE(" += ","+=")
2420 }
2421 else {
2422 AO.FortFirst = 0;
2423 TokenToLine(AO.CurBufWrt);
2424 TOKENTOLINE(" = ","=")
2425 }
2426/*
2427 TokenToLine(AO.CurBufWrt);
2428 if ( AO.FortFirst == 0 ) { TOKENTOLINE(" += ","+=") }
2429 else {
2430 TOKENTOLINE(" = ","=")
2431 AO.FortFirst = 0;
2432 }
2433*/
2434 }
2435 else {
2436 FiniLine();
2437 IniLine(0);
2438 }
2439 AO.InFbrack = 0;
2440 }
2441 if ( WriteInnerTerm(term,first) ) goto WrtTmes;
2442 if ( ( AO.PrintType & PRINTONETERM ) != 0 ) {
2443 FiniLine();
2444 IniLine(0);
2445 }
2446 return(0);
2447}
2448
2449/*
2450 #] WriteTerm :
2451 #[ WriteExpression : WORD WriteExpression(terms,ltot)
2452
2453 Writes a subexpression to output.
2454 The subexpression is in terms and contains ltot words.
2455 This is only used for function arguments.
2456
2457*/
2458
2459int WriteExpression(WORD *terms, LONG ltot)
2460{
2461 WORD *stopper;
2462 WORD first, btot;
2463 WORD OldIsBracket = AO.IsBracket, OldPrintType = AO.PrintType;
2464 if ( !AC.outsidefun ) { AO.PrintType &= ~PRINTONETERM; first = 1; }
2465 else first = 0;
2466 stopper = terms + ltot;
2467 btot = -1;
2468 while ( terms < stopper ) {
2469 AO.IsBracket = OldIsBracket;
2470 if ( WriteTerm(terms,&btot,first,0,1) ) {
2471 MesCall("WriteExpression");
2472 SETERROR(-1)
2473 }
2474 first = 0;
2475 terms += *terms;
2476 }
2477/* AO.IsBracket = 0; */
2478 AO.IsBracket = OldIsBracket;
2479 AO.PrintType = OldPrintType;
2480 return(0);
2481}
2482
2483/*
2484 #] WriteExpression :
2485 #[ WriteAll : WORD WriteAll()
2486
2487 Writes all expressions that should be written
2488*/
2489
2490int WriteAll(void)
2491{
2492 GETIDENTITY
2493 WORD lbrac, first;
2494 WORD *t, *stopper, n, prtf;
2495 int oldIsFortran90 = AC.IsFortran90, i;
2496 POSITION pos;
2497 FILEHANDLE *f;
2498 EXPRESSIONS e;
2499 if ( AM.exitflag ) return(0);
2500#ifdef WITHMPI
2501 if ( PF.me != MASTER ) {
2502 /*
2503 * For the slaves, we need to call Optimize() the same number of times
2504 * as the master. The first argument doesn't have any important role.
2505 */
2506 for ( n = 0; n < NumExpressions; n++ ) {
2507 e = &Expressions[n];
2508 if ( (!e->printflag) & PRINTON ) continue;
2509 switch ( e->status ) {
2510 case LOCALEXPRESSION:
2511 case GLOBALEXPRESSION:
2512 case UNHIDELEXPRESSION:
2513 case UNHIDEGEXPRESSION:
2514 break;
2515 default:
2516 continue;
2517 }
2518 e->printflag = 0;
2519 PutPreVar(AM.oldnumextrasymbols, GetPreVar((UBYTE *)"EXTRASYMBOLS_", 0), 0, 1);
2520 if ( AO.OptimizationLevel > 0 ) {
2521 if ( Optimize(0, 1) ) return(-1);
2522 }
2523 }
2524 return(0);
2525 }
2526#endif
2527 SeekScratch(AR.outfile,&pos);
2528 if ( ResetScratch() ) {
2529 MesCall("WriteAll");
2530 SETERROR(-1)
2531 }
2532 AO.termbuf = AT.WorkPointer;
2533 AO.bracket = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
2534 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer*2);
2535 AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
2536 AT.WorkPointer += 2*AC.LineLength;
2537 *(AR.CompressBuffer) = 0;
2538 first = 0;
2539 for ( n = 0; n < NumExpressions; n++ ) {
2540 if ( ( Expressions[n].printflag & PRINTON ) != 0 ) { first = 1; break; }
2541 }
2542 if ( !first ) goto EndWrite;
2543 AO.IsBracket = 0;
2544 AO.OutSkip = 3;
2545 AR.DeferFlag = 0;
2546 while ( GetTerm(BHEAD AO.termbuf) ) {
2547 t = AO.termbuf + 1;
2548 e = Expressions + AO.termbuf[3];
2549 n = e->status;
2550 if ( ( n == LOCALEXPRESSION || n == GLOBALEXPRESSION
2551 || n == UNHIDELEXPRESSION || n == UNHIDEGEXPRESSION ) &&
2552 ( ( prtf = e->printflag ) & PRINTON ) != 0 ) {
2553 e->printflag = 0;
2554 AO.NumInBrack = 0;
2555 PutPreVar(AM.oldnumextrasymbols,
2556 GetPreVar((UBYTE *)"EXTRASYMBOLS_",0),0,1);
2557 if ( ( prtf & PRINTLFILE ) != 0 ) {
2558 if ( AC.LogHandle < 0 ) prtf &= ~PRINTLFILE;
2559 }
2560 AO.PrintType = prtf;
2561/*
2562 if ( AC.OutputMode == VORTRANMODE ) {
2563 UBYTE *oldOutFill = AO.OutFill, *oldOutputLine = AO.OutputLine;
2564 AO.OutSkip = 6;
2565 if ( Optimize(AO.termbuf[3], 1) ) goto AboWrite;
2566 AO.OutSkip = 3;
2567 AO.OutFill = oldOutFill; AO.OutputLine = oldOutputLine;
2568 FiniLine();
2569 continue;
2570 }
2571 else
2572*/
2573 if ( AO.OptimizationLevel > 0 ) {
2574 UBYTE *oldOutFill = AO.OutFill, *oldOutputLine = AO.OutputLine;
2575 AO.OutSkip = 6;
2576 if ( Optimize(AO.termbuf[3], 1) ) goto AboWrite;
2577 AO.OutSkip = 3;
2578 AO.OutFill = oldOutFill; AO.OutputLine = oldOutputLine;
2579 FiniLine();
2580 continue;
2581 }
2582 if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2583 AO.OutSkip = 6;
2584 FiniLine();
2585 AO.CurBufWrt = EXPRNAME(AO.termbuf[3]);
2586 TokenToLine(AO.CurBufWrt);
2587 stopper = t + t[1];
2588 t += SUBEXPSIZE;
2589 if ( t < stopper ) {
2590 TokenToLine((UBYTE *)"(");
2591 first = 1;
2592 while ( t < stopper ) {
2593 n = *t;
2594 if ( !first ) TokenToLine((UBYTE *)",");
2595 switch ( n ) {
2596 case SYMTOSYM :
2597 TokenToLine(FindSymbol(t[2]));
2598/* TokenToLine(VARNAME(symbols,t[2])); */
2599 break;
2600 case VECTOVEC :
2601 TokenToLine(FindVector(t[2]));
2602/* TokenToLine(VARNAME(vectors,t[2] - AM.OffsetVector)); */
2603 break;
2604 case INDTOIND :
2605 TokenToLine(FindIndex(t[2]));
2606/* TokenToLine(VARNAME(indices,t[2] - AM.OffsetIndex)); */
2607 break;
2608 default :
2609 TokenToLine(FindFunction(t[2]));
2610/* TokenToLine(VARNAME(functions,t[2] - FUNCTION)); */
2611 break;
2612 }
2613 t += t[1];
2614 first = 0;
2615 }
2616 TokenToLine((UBYTE *)")");
2617 }
2618 TOKENTOLINE(" =","=");
2619 if ( AC.OutputMode == MATHEMATICAMODE ) {
2620 TOKENTOLINE(" (","(");
2621 }
2622 lbrac = 0;
2623 AO.InFbrack = 0;
2624 if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2625 AO.FortFirst = 1;
2626 else
2627 AO.FortFirst = 0;
2628 first = 1;
2629 if ( ( e->vflags & ISFACTORIZED ) != 0 ) {
2630 AO.FactorMode = 1+e->numfactors;
2631 AO.FactorNum = 0; /* Which factor are we doing. For factors that are zero */
2632 }
2633 else {
2634 AO.FactorMode = 0;
2635 }
2636 while ( GetTerm(BHEAD AO.termbuf) ) {
2637 WORD *m;
2638 GETSTOP(AO.termbuf,m);
2639 if ( ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2640 && ( ( prtf & PRINTONETERM ) != 0 ) ) {}
2641 else {
2642 if ( first ) {
2643 FiniLine();
2644 IniLine(0);
2645 }
2646 }
2647 if ( ( prtf & PRINTONETERM ) != 0 ) first = 0;
2648 if ( WriteTerm(AO.termbuf,&lbrac,first,prtf,0) )
2649 goto AboWrite;
2650 first = 0;
2651 }
2652 if ( AO.FactorMode ) {
2653 if ( first ) { AO.FactorNum = 1; TOKENTOLINE(" ( 0 )"," (0)") }
2654 else TOKENTOLINE(" )",")");
2655 for ( i = AO.FactorNum+1; i <= e->numfactors; i++ ) {
2656 FiniLine();
2657 IniLine(0);
2658 TOKENTOLINE(" * ( 0 )","*(0)");
2659 }
2660 AO.FactorNum = e->numfactors;
2661 if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE )
2662 TokenToLine((UBYTE *)";");
2663 }
2664 else if ( AO.FactorMode == 0 || first ) {
2665 if ( first ) { TOKENTOLINE(" 0","0") }
2666 else if ( lbrac ) {
2667 if ( ( prtf & PRINTCONTENTS ) != 0 ) PrtTerms();
2668 TOKENTOLINE(" )",")")
2669 }
2670 else if ( ( prtf & PRINTCONTENTS ) != 0 ) {
2671 TOKENTOLINE(" + 1 * ( ","+1*(")
2672 PrtTerms();
2673 TOKENTOLINE(" )",")")
2674 }
2675 if ( AC.OutputMode == MATHEMATICAMODE ) {
2676 TokenToLine((UBYTE *)")");
2677 }
2678 if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE )
2679 TokenToLine((UBYTE *)";");
2680 }
2681 AO.OutSkip = 3;
2682 AC.IsFortran90 = ISNOTFORTRAN90;
2683 FiniLine();
2684 AC.IsFortran90 = oldIsFortran90;
2685 AO.FactorMode = 0;
2686 }
2687 else {
2688 do { } while ( GetTerm(BHEAD AO.termbuf) );
2689 }
2690 }
2691 if ( AC.OutputSpaces == NORMALFORMAT ) FiniLine();
2692EndWrite:
2693 if ( AR.infile->handle >= 0 ) {
2694 SeekFile(AR.infile->handle,&(AR.infile->filesize),SEEK_SET);
2695 }
2696 AO.IsBracket = 0;
2697 AT.WorkPointer = AO.termbuf;
2698 SetScratch(AR.infile,&pos);
2699 f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2700 return(0);
2701AboWrite:
2702 SetScratch(AR.infile,&pos);
2703 f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2704 MesCall("WriteAll");
2705 Terminate(-1);
2706 return(-1);
2707}
2708
2709/*
2710 #] WriteAll :
2711 #[ WriteOne : WORD WriteOne(name,alreadyinline)
2712
2713 Writes one expression from the preprocessor
2714*/
2715
2716int WriteOne(UBYTE *name, int alreadyinline, int nosemi, WORD plus)
2717{
2718 GETIDENTITY
2719 WORD number;
2720 WORD lbrac, first;
2721 POSITION pos;
2722 FILEHANDLE *f;
2723 WORD prf;
2724
2725 if ( GetName(AC.exprnames,name,&number,NOAUTO) != CEXPRESSION ) {
2726 MesPrint("@%s is not an expression",name);
2727 return(-1);
2728 }
2729 switch ( Expressions[number].status ) {
2730 case HIDDENLEXPRESSION:
2731 case HIDDENGEXPRESSION:
2732 case HIDELEXPRESSION:
2733 case HIDEGEXPRESSION:
2734 case UNHIDELEXPRESSION:
2735 case UNHIDEGEXPRESSION:
2736/*
2737 case DROPHLEXPRESSION:
2738 case DROPHGEXPRESSION:
2739*/
2740 AR.GetFile = 2;
2741 break;
2742 case LOCALEXPRESSION:
2743 case GLOBALEXPRESSION:
2744 case SKIPLEXPRESSION:
2745 case SKIPGEXPRESSION:
2746/*
2747 case DROPLEXPRESSION:
2748 case DROPGEXPRESSION:
2749*/
2750 AR.GetFile = 0;
2751 break;
2752 default:
2753 MesPrint("@expressions %s is not active. It cannot be written",name);
2754 return(-1);
2755 }
2756 SeekScratch(AR.outfile,&pos);
2757
2758 f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2759/*
2760 if ( ResetScratch() ) {
2761 MesCall("WriteOne");
2762 SETERROR(-1)
2763 }
2764*/
2765 if ( AR.GetFile == 2 ) f = AR.hidefile;
2766 else f = AR.infile;
2767 prf = Expressions[number].printflag;
2768 if ( plus ) prf |= PRINTONETERM;
2769/*
2770 Now position the file
2771*/
2772 if ( f->handle >= 0 ) {
2773 SetScratch(f,&(Expressions[number].onfile));
2774 }
2775 else {
2776 f->POfill = (WORD *)((UBYTE *)(f->PObuffer)
2777 + BASEPOSITION(Expressions[number].onfile));
2778 }
2779 AO.termbuf = AT.WorkPointer;
2780 AO.bracket = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
2781 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer*2);
2782
2783 AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
2784 AT.WorkPointer += 2*AC.LineLength;
2785 *(AR.CompressBuffer) = 0;
2786
2787 AO.IsBracket = 0;
2788 AO.OutSkip = 3;
2789 AR.DeferFlag = 0;
2790
2791 if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE )
2792 AO.OutSkip = 6;
2793 if ( GetTerm(BHEAD AO.termbuf) <= 0 ) {
2794/* INTERNAL_ERROR_EXCL_START */
2795 MesPrint("!>ReadError in expression %s",name);
2796 goto AboWrite;
2797/* INTERNAL_ERROR_EXCL_STOP */
2798 }
2799/*
2800 PutPreVar(AM.oldnumextrasymbols,
2801 GetPreVar((UBYTE *)"EXTRASYMBOLS_",0),0,1);
2802*/
2803 /*
2804 * Currently WriteOne() is called only from writeToChannel() with setting
2805 * AO.OptimizationLevel = 0, which means Optimize() is never called here.
2806 * So we don't need to think about how to ensure that the master and the
2807 * slaves call Optimize() at the same time. (TU 26 Jul 2013)
2808 */
2809 if ( AO.OptimizationLevel > 0 ) {
2810 AO.OutSkip = 6;
2811 if ( Optimize(AO.termbuf[3], 1) ) goto AboWrite;
2812 AO.OutSkip = 3;
2813 FiniLine();
2814 }
2815 else {
2816 lbrac = 0;
2817 AO.InFbrack = 0;
2818 AO.FortFirst = 0;
2819 first = 1;
2820 while ( GetTerm(BHEAD AO.termbuf) ) {
2821 WORD *m;
2822 GETSTOP(AO.termbuf,m);
2823 if ( first ) {
2824 IniLine(0);
2825 startinline = alreadyinline;
2826 AO.OutFill = AO.OutputLine + startinline;
2827 if ( WriteTerm(AO.termbuf,&lbrac,first,0,0) )
2828 goto AboWrite;
2829 first = 0;
2830 }
2831 else {
2832 if ( ( prf & PRINTONETERM ) != 0 ) first = 1;
2833 if ( first ) {
2834 FiniLine();
2835 IniLine(0);
2836 }
2837 first = 0;
2838 if ( WriteTerm(AO.termbuf,&lbrac,first,0,0) )
2839 goto AboWrite;
2840 }
2841 }
2842 if ( first ) {
2843 IniLine(0);
2844 startinline = alreadyinline;
2845 AO.OutFill = AO.OutputLine + startinline;
2846 TOKENTOLINE(" 0","0");
2847 }
2848 else if ( lbrac ) {
2849 TOKENTOLINE(" )",")");
2850 }
2851 if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE
2852 && nosemi == 0 ) TokenToLine((UBYTE *)";");
2853 AO.OutSkip = 3;
2854 if ( AC.OutputSpaces == NORMALFORMAT && nosemi == 0 ) {
2855 FiniLine();
2856 }
2857 else {
2858 noextralinefeed = 1;
2859 FiniLine();
2860 noextralinefeed = 0;
2861 }
2862 }
2863 AO.IsBracket = 0;
2864 AT.WorkPointer = AO.termbuf;
2865 SetScratch(f,&pos);
2866 f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2867 AO.InFbrack = 0;
2868 return(0);
2869AboWrite:
2870 SetScratch(AR.infile,&pos);
2871 f->POposition = pos;
2872 f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
2873 MesCall("WriteOne");
2874 Terminate(-1);
2875 return(-1);
2876}
2877
2878/*
2879 #] WriteOne :
2880 #] schryf-Writes :
2881*/
Optimize
int Optimize(WORD, int)
Definition optimize.cc:4641
TimeCPU
LONG TimeCPU(WORD)
Definition tools.c:3499
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