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