1 /** @file message.c
2 *
3 * Contains the routines that write messages.
4 * This includes the very important routine MesPrint which is the
5 * FORM equivalent of printf but then with escape sequences that are
6 * relevant for symbolic manipulation.
7 * The FORM statement Print "...." is passed almost literally to MesPrint.
8 */
9 /* #[ License : */
10 /*
11 * Copyright (C) 1984-2017 J.A.M. Vermaseren
12 * When using this file you are requested to refer to the publication
13 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
14 * This is considered a matter of courtesy as the development was paid
15 * for by FOM the Dutch physics granting agency and we would like to
16 * be able to track its scientific use to convince FOM of its value
17 * for the community.
18 *
19 * This file is part of FORM.
20 *
21 * FORM is free software: you can redistribute it and/or modify it under the
22 * terms of the GNU General Public License as published by the Free Software
23 * Foundation, either version 3 of the License, or (at your option) any later
24 * version.
25 *
26 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
27 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
28 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
29 * details.
30 *
31 * You should have received a copy of the GNU General Public License along
32 * with FORM. If not, see <http://www.gnu.org/licenses/>.
33 */
34 /* #] License : */
35 /*
36 #[ Includes :
37
38 The static variables for the messages can remain as such also for
39 the parallel version as messages are to be locked to avoid problems
40 with simultaneous messages.
41 */
42
43 #include "form3.h"
44
45 static int iswarning = 0;
46
47 static char hex[] = {'0','1','2','3','4','5','6','7','8','9',
48 'A','B','C','D','E','F'};
49
50 /*
51 #] Includes :
52 #[ exit :
53 #[ Error0 :
54 */
55
Error0(char * s)56 VOID Error0(char *s)
57 {
58 MesPrint("=== %s",s);
59 Terminate(-1);
60 }
61
62 /*
63 #] Error0 :
64 #[ Error1 :
65 */
66
Error1(char * s,UBYTE * t)67 VOID Error1(char *s, UBYTE *t)
68 {
69 MesPrint("@%s %s",s,t);
70 Terminate(-1);
71 }
72
73 /*
74 #] Error1 :
75 #[ Error2 :
76 */
77
Error2(char * s1,char * s2,UBYTE * t)78 VOID Error2(char *s1, char *s2, UBYTE *t)
79 {
80 MesPrint("@%s%s %s",s1,s2,t);
81 Terminate(-1);
82 }
83
84 /*
85 #] Error2 :
86 #[ MesWork :
87 */
88
MesWork()89 int MesWork()
90 {
91 MesPrint("=== Workspace overflow. %l bytes is not enough.",AM.WorkSize);
92 MesPrint("=== Change parameter WorkSpace in %s",setupfilename);
93 Terminate(-1);
94 return(-1);
95 }
96
97 /*
98 #] MesWork :
99 #[ MesPrint :
100
101 Kind of a printf function for simple messages.
102 The main concern is getting the arguments in a portable way.
103 Note: many compilers have errors when sizeof(WORD) < sizeof(int)
104 %a array of size n WORDs (two parameters, first is int, second WORD *)
105 %b array of size n UBYTEs (two parameters, first is int, second UBYTE *)
106 %C array of size n chars (two parameters, first is int, second char *)
107 %d word;
108 %l long;
109 %L long long *;
110 %s string;
111 %#i unsigned word filled
112 %#d word positioned
113 %#l long word positioned.
114 %#L long long word * positioned.
115 %#s string positioned.
116 %#p position in file.
117 %r The current term in raw format (internal representation)
118 %t The current term (AN.currentTerm)
119 %T The current term (AN.currentTerm) with its sign
120 %w Number of the thread(worker)
121 %$ The next $ in AN.listinprint
122 %x hexadecimal. Takes 8 places. Mainly for debugging.
123 %% %
124 %# #
125 # " ==> "
126 @ " ==> " Preprocessor error
127 & ' --> ' Regular compiler error
128 Each call is terminated with a new line.
129 Put a % at the end of the string to suppress the new line.
130
131 New feature (7-dec-2011): The & will only work when we do not block it
132 from the execution of the print statement because we need the & also for
133 the tabulator in the print "" statement.
134 */
135
136 int
137 #ifdef ANSI
MesPrint(const char * fmt,...)138 MesPrint(const char *fmt, ... )
139 #else
140 MesPrint(va_alist)
141 va_dcl
142 #endif
143 {
144 GETIDENTITY
145 char Out[MAXLINELENGTH+14], *stopper, *t, *s, *u, c, *carray;
146 UBYTE extrabuffer[MAXLINELENGTH+14];
147 int w, x, i, specialerror = 0;
148 LONG num, y;
149 WORD *array;
150 UBYTE *oldoutfill = AO.OutputLine, *barray;
151 /*[19apr2004 mt]:*/
152 LONG (*OldWrite)(int handle, UBYTE *buffer, LONG size) = WriteFile;
153 /*:[19apr2004 mt]*/
154 va_list ap;
155 #ifdef ANSI
156 va_start(ap,fmt);
157 s = (char *)fmt;
158 #else
159 va_start(ap);
160 s = va_arg(ap,char *);
161 #endif
162 #ifdef WITHMPI
163 /*
164 * On slaves, if AS.printflag is
165 * = 0 : print nothing.
166 * > 0 : synchronized output. All text will be sent to the master
167 * in the next MUNLOCK().
168 * < 0 : normal output.
169 */
170 if ( PF.me != MASTER && AS.printflag == 0 ) return(0);
171 if ( PF.me == MASTER || AS.printflag < 0 )
172 #endif
173 FLUSHCONSOLE;
174 /*
175 * MesPrints() never prints a message to an external channel even if
176 * WriteFile is set to &WriteToExternalChannel.
177 */
178 #ifdef WITHMPI
179 WriteFile = PF.me == MASTER || AS.printflag > 0 ? &PF_WriteFileToFile : &WriteFileToFile;
180 #else
181 WriteFile = &WriteFileToFile;
182 #endif
183 AO.OutputLine = extrabuffer;
184 t = Out;
185 stopper = Out + AC.LineLength;
186 while ( *s ) {
187 if ( ( ( *s == '&' && AO.ErrorBlock == 0 ) || *s == '@' || *s == '#' ) && AC.CurrentStream != 0 ) {
188 u = (char *)AC.CurrentStream->name;
189 while ( *u ) {
190 *t++ = *u++;
191 if ( t >= stopper ) {
192 num = t - Out;
193 WriteString(ERROROUT,(UBYTE *)Out,num);
194 num = 0; t = Out;
195 }
196 }
197 *t++ = ' ';
198 if ( t+20 >= stopper ) {
199 num = t - Out;
200 WriteString(ERROROUT,(UBYTE *)Out,num);
201 num = 0; t = Out;
202 }
203 *t++ = 'L'; *t++ = 'i'; *t++ = 'n'; *t++ = 'e'; *t++ = ' ';
204 if ( *s == '&' ) y = AC.CurrentStream->prevline;
205 else y = AC.CurrentStream->linenumber;
206 t = LongCopy(y,t);
207 if ( !iswarning && ( *s == '&' || *s == '@' ) ) {
208 for ( i = 0; i < NumDoLoops; i++ ) DoLoops[i].errorsinloop = 1;
209 }
210 }
211 if ( ( *s == '&' && AO.ErrorBlock == 0 ) ) {
212 *t++ = ' '; *t++ = '-'; *t++ = '-'; *t++ = '>'; *t++ = ' '; s++;
213 }
214 else if ( *s == '@' || *s == '#' ) {
215 *t++ = ' '; *t++ = '='; *t++ = '='; *t++ = '>'; *t++ = ' '; s++;
216 }
217 /*
218 else if ( *s == '&' && AO.ErrorBlock == 1 ) {
219
220 }
221 */
222 else if ( *s != '%' ) {
223 *t++ = *s++;
224 if ( t >= stopper ) {
225 num = t - Out;
226 WriteString(ERROROUT,(UBYTE *)Out,num);
227 num = 0; t = Out;
228 }
229 }
230 else {
231 s++;
232 if ( *s == 'd' ) {
233 if ( ( w = va_arg(ap, int) ) < 0 ) { *t++ = '-'; w = -w; }
234 t = (char *)NumCopy(w,(UBYTE *)t);
235 }
236 else if ( *s == 'l' ) {
237 if ( ( y = va_arg(ap, LONG) ) < 0 ) { *t++ = '-'; y = -y; }
238 t = LongCopy(y,t);
239 }
240 /* #ifdef __GLIBC_HAVE_LONG_LONG */
241 else if ( *s == 'p' ) {
242 POSITION *pp;
243 off_t ly;
244 pp = va_arg(ap, POSITION *);
245 ly = BASEPOSITION(*pp);
246 if ( ly < 0 ) { *t++ = '-'; ly = -ly; }
247 /*----change 10-feb-2003 did not have & */
248 t = LongLongCopy(&(ly),t);
249 }
250 /* #endif */
251 else if ( *s == 'c' ) {
252 c = (char)(va_arg(ap, int));
253 *t++ = c; *t = 0;
254 }
255 else if ( *s == 'a' ) {
256 w = va_arg(ap, int);
257 array = va_arg(ap,WORD *);
258 while ( w > 0 ) {
259 t = (char *)NumCopy(*array,(UBYTE *)t);
260 if ( t >= stopper ) {
261 num = t - Out;
262 WriteString(ERROROUT,(UBYTE *)Out,num);
263 t = Out;
264 *t++ = ' ';
265 }
266 *t++ = ' ';
267 w--; array++;
268 }
269 }
270 else if ( *s == 'b' ) {
271 w = va_arg(ap, int);
272 barray = va_arg(ap,UBYTE *);
273 while ( w > 0 ) {
274 *t++ = hex[((*barray)>>4)&0xF];
275 *t++ = hex[(*barray)&0xF];
276 *t = 0;
277 if ( t >= stopper ) {
278 num = t - Out;
279 WriteString(ERROROUT,(UBYTE *)Out,num);
280 t = Out;
281 *t++ = ' ';
282 }
283 *t++ = ' ';
284 w--; barray++;
285 }
286 }
287 else if ( *s == 'C' ) {
288 w = va_arg(ap, int);
289 carray = va_arg(ap,char *);
290 while ( w > 0 ) {
291 if ( *carray < 32 ) *t++ = '^';
292 else *t++ = *carray;
293 *t = 0;
294 if ( t >= stopper ) {
295 num = t - Out;
296 WriteString(ERROROUT,(UBYTE *)Out,num);
297 t = Out;
298 *t++ = ' ';
299 }
300 w--; carray++;
301 }
302 }
303 else if ( *s == 'I' ) {
304 int *iarray;
305 w = va_arg(ap, int);
306 iarray = va_arg(ap,int *);
307 while ( w > 0 ) {
308 t = (char *)LongCopy((LONG)(*iarray),(char *)t);
309 if ( t >= stopper ) {
310 num = t - Out;
311 WriteString(ERROROUT,(UBYTE *)Out,num);
312 t = Out;
313 *t++ = ' ';
314 }
315 *t++ = ' ';
316 w--; array++;
317 }
318 }
319 else if ( *s == 'E' ) {
320 LONG *larray;
321 w = va_arg(ap, int);
322 larray = va_arg(ap,LONG *);
323 while ( w > 0 ) {
324 t = (char *)LongCopy(*larray,(char *)t);
325 if ( t >= stopper ) {
326 num = t - Out;
327 WriteString(ERROROUT,(UBYTE *)Out,num);
328 t = Out;
329 *t++ = ' ';
330 }
331 *t++ = ' ';
332 w--; array++;
333 }
334 }
335 else if ( *s == 's' ) {
336 u = va_arg(ap,char *);
337 while ( *u ) {
338 if ( t >= stopper ) {
339 num = t - Out;
340 WriteString(ERROROUT,(UBYTE *)Out,num);
341 t = Out;
342 }
343 *t++ = *u++;
344 }
345 *t = 0;
346 }
347 else if ( *s == 't' || *s == 'T' ) {
348 WORD oldskip = AO.OutSkip, noleadsign;
349 WORD oldmode = AC.OutputMode;
350 WORD oldbracket = AO.IsBracket;
351 WORD oldlength = AC.LineLength;
352 UBYTE *oldStop = AO.OutStop;
353 if ( AN.currentTerm ) {
354 if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
355 AO.IsBracket = 0;
356 AO.OutSkip = 1;
357 AC.OutputMode = 0;
358 AO.OutFill = AO.OutputLine;
359 AO.OutStop = AO.OutputLine + AC.LineLength;
360 *t = 0;
361 AddToLine((UBYTE *)Out);
362 if ( *s == 'T' ) noleadsign = 1;
363 else noleadsign = 0;
364 if ( WriteInnerTerm(AN.currentTerm,noleadsign) ) Terminate(-1);
365 t = Out;
366 u = (char *)AO.OutputLine;
367 *(AO.OutFill) = 0;
368 while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
369 *t = 0;
370 AO.OutSkip = oldskip;
371 AC.OutputMode = oldmode;
372 AO.IsBracket = oldbracket;
373 AC.LineLength = oldlength;
374 AO.OutStop = oldStop;
375 }
376 }
377 else if ( *s == 'r' ) {
378 WORD oldskip = AO.OutSkip;
379 WORD oldmode = AC.OutputMode;
380 WORD oldbracket = AO.IsBracket;
381 WORD oldlength = AC.LineLength;
382 UBYTE *oldStop = AO.OutStop;
383 if ( AN.currentTerm ) {
384 WORD *tt = AN.currentTerm;
385 if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
386 AO.IsBracket = 0;
387 AO.OutSkip = 1;
388 AC.OutputMode = 0;
389 AO.OutFill = AO.OutputLine;
390 AO.OutStop = AO.OutputLine + AC.LineLength;
391 *t = 0;
392 i = *tt;
393 while ( --i >= 0 ) {
394 t = (char *)NumCopy(*tt,(UBYTE *)t);
395 tt++;
396 if ( t >= stopper ) {
397 num = t - Out;
398 WriteString(ERROROUT,(UBYTE *)Out,num);
399 num = 0; t = Out;
400 }
401 *t++ = ' '; *t++ = ' ';
402 }
403 *t = 0;
404 AO.OutSkip = oldskip;
405 AC.OutputMode = oldmode;
406 AO.IsBracket = oldbracket;
407 AC.LineLength = oldlength;
408 AO.OutStop = oldStop;
409 }
410 }
411 else if ( *s == '$' ) {
412 /*
413 #[ dollars :
414 */
415 WORD oldskip = AO.OutSkip;
416 WORD oldmode = AC.OutputMode;
417 WORD oldbracket = AO.IsBracket;
418 WORD oldlength = AC.LineLength;
419 UBYTE *oldStop = AO.OutStop;
420 WORD *term, indsubterm[3], *tt;
421 WORD value[5], first, num;
422 if ( *AN.listinprint != DOLLAREXPRESSION ) {
423 specialerror = 1;
424 }
425 else {
426 DOLLARS d = Dollars + AN.listinprint[1];
427 #ifdef WITHPTHREADS
428 int nummodopt, dtype;
429 dtype = -1;
430 if ( AS.MultiThreaded ) {
431 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
432 if ( AN.listinprint[1] == ModOptdollars[nummodopt].number ) break;
433 }
434 if ( nummodopt < NumModOptdollars ) {
435 dtype = ModOptdollars[nummodopt].type;
436 if ( dtype == MODLOCAL ) {
437 d = ModOptdollars[nummodopt].dstruct+AT.identity;
438 }
439 else {
440 LOCK(d->pthreadslockread);
441 }
442 }
443 }
444 #endif
445 AO.IsBracket = 0;
446 AO.OutSkip = 0;
447 AC.OutputMode = 0;
448 AO.OutFill = AO.OutputLine;
449 AO.OutStop = AO.OutputLine + AC.LineLength;
450 *t = 0;
451 AddToLine((UBYTE *)Out);
452 if ( d->nfactors >= 1 && AN.listinprint[2] == DOLLAREXPR2 ) {
453 if ( d->type == 0 ||
454 ( d->factors == 0 && d->nfactors != 1 ) ) goto dollarzero;
455 num = EvalDoLoopArg(BHEAD AN.listinprint+2,-1);
456 if ( num == 0 ) {
457 value[0] = 4; value[1] = d->nfactors; value[2] = 1; value[3] = 3; value[4] = 0;
458 term = value; goto printterms;
459 }
460 if ( num == 1 && d->nfactors == 1 ) {
461 term = d->where;
462 if ( *term == 0 ) goto dollarzero;
463 goto printterms;
464 }
465 if ( num > d->nfactors ) {
466 MesPrint("\nFactor number for dollar is too large.");
467 Terminate(-1);
468 }
469 term = d->factors[num-1].where;
470 if ( term == 0 ) {
471 if ( d->factors[num-1].value < 0 ) {
472 value[0] = 4; value[1] = -d->factors[num-1].value; value[2] = 1; value[3] = -3; value[4] = 0;
473 }
474 else {
475 value[0] = 4; value[1] = d->factors[num-1].value; value[2] = 1; value[3] = 3; value[4] = 0;
476 }
477 term = value;
478 }
479 goto printterms;
480 }
481 if ( d->type == DOLTERMS || d->type == DOLNUMBER ) {
482 term = d->where;
483 printterms: first = 1;
484 do {
485 if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
486 AO.IsBracket = 0;
487 AO.OutSkip = 1;
488 AC.OutputMode = 0;
489 AO.OutFill = AO.OutputLine;
490 AO.OutStop = AO.OutputLine + AC.LineLength;
491 *t = 0;
492 AddToLine((UBYTE *)Out);
493 if ( WriteInnerTerm(term,first) ) {
494 #ifdef WITHPTHREADS
495 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
496 #endif
497 Terminate(-1);
498 }
499 first = 0;
500 t = Out;
501 u = (char *)AO.OutputLine;
502 *(AO.OutFill) = 0;
503 while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
504 *t = 0;
505 AO.OutSkip = oldskip;
506 AC.OutputMode = oldmode;
507 AO.IsBracket = oldbracket;
508 AC.LineLength = oldlength;
509 AO.OutStop = oldStop;
510 term += *term;
511 } while ( *term );
512 AO.OutSkip = oldskip;
513 }
514 else if ( d->type == DOLSUBTERM ) {
515 tt = d->where;
516 dosubterm: if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
517 AO.IsBracket = 0;
518 AO.OutSkip = 1;
519 AC.OutputMode = 0;
520 AO.OutFill = AO.OutputLine;
521 AO.OutStop = AO.OutputLine + AC.LineLength;
522 *t = 0;
523 AddToLine((UBYTE *)Out);
524 if ( WriteSubTerm(tt,1) ) {
525 #ifdef WITHPTHREADS
526 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
527 #endif
528 Terminate(-1);
529 }
530 t = Out;
531 u = (char *)AO.OutputLine;
532 *(AO.OutFill) = 0;
533 while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
534 *t = 0;
535 AO.OutSkip = oldskip;
536 AC.OutputMode = oldmode;
537 AO.IsBracket = oldbracket;
538 AC.LineLength = oldlength;
539 AO.OutStop = oldStop;
540 }
541 else if ( d->type == DOLUNDEFINED ) {
542 *t++ = '*'; *t++ = '*'; *t++ = '*'; *t = 0;
543 }
544 else if ( d->type == DOLZERO ) {
545 dollarzero: *t++ = '0'; *t = 0;
546 }
547 else if ( d->type == DOLINDEX ) {
548 tt = indsubterm; *tt = INDEX;
549 tt[1] = 3; tt[2] = d->index;
550 goto dosubterm;
551 }
552 else if ( d->type == DOLARGUMENT ) {
553 if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
554 AO.IsBracket = 0;
555 AO.OutSkip = 1;
556 AC.OutputMode = 0;
557 AO.OutFill = AO.OutputLine;
558 AO.OutStop = AO.OutputLine + AC.LineLength;
559 *t = 0;
560 AddToLine((UBYTE *)Out);
561 WriteArgument(d->where);
562 t = Out;
563 u = (char *)AO.OutputLine;
564 *(AO.OutFill) = 0;
565 while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
566 *t = 0;
567 AO.OutSkip = oldskip;
568 AC.OutputMode = oldmode;
569 AO.IsBracket = oldbracket;
570 AC.LineLength = oldlength;
571 AO.OutStop = oldStop;
572 }
573 else if ( d->type == DOLWILDARGS ) {
574 tt = d->where;
575 if ( *tt == 0 ) { tt++;
576 while ( *tt ) {
577 if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
578 AO.IsBracket = 0;
579 AO.OutSkip = 1;
580 AC.OutputMode = 0;
581 AO.OutFill = AO.OutputLine;
582 AO.OutStop = AO.OutputLine + AC.LineLength;
583 *t = 0;
584 AddToLine((UBYTE *)Out);
585 WriteArgument(tt);
586 NEXTARG(tt);
587 if ( *tt ) TokenToLine((UBYTE *)",");
588 t = Out;
589 u = (char *)AO.OutputLine;
590 *(AO.OutFill) = 0;
591 while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
592 *t = 0;
593 AO.OutSkip = oldskip;
594 AC.OutputMode = oldmode;
595 AO.IsBracket = oldbracket;
596 AC.LineLength = oldlength;
597 AO.OutStop = oldStop;
598 }
599 }
600 else if ( *tt > 0 ) { /* Tensor arguments */
601 i = *tt++;
602 while ( --i >= 0 ) {
603 indsubterm[0] = INDEX;
604 indsubterm[1] = 3;
605 indsubterm[2] = *tt++;
606 if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
607 AO.IsBracket = 0;
608 AO.OutSkip = 1;
609 AC.OutputMode = 0;
610 AO.OutFill = AO.OutputLine;
611 AO.OutStop = AO.OutputLine + AC.LineLength;
612 *t = 0;
613 AddToLine((UBYTE *)Out);
614 if ( WriteSubTerm(indsubterm,1) ) Terminate(-1);
615 if ( i > 0 ) TokenToLine((UBYTE *)",");
616 t = Out;
617 u = (char *)AO.OutputLine;
618 *(AO.OutFill) = 0;
619 while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
620 *t = 0;
621 AO.OutSkip = oldskip;
622 AC.OutputMode = oldmode;
623 AO.IsBracket = oldbracket;
624 AC.LineLength = oldlength;
625 AO.OutStop = oldStop;
626 }
627 }
628 }
629 #ifdef WITHPTHREADS
630 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
631 #endif
632 AN.listinprint += 2;
633 while ( AN.listinprint[0] == DOLLAREXPR2 ) AN.listinprint += 2;
634 }
635 /*
636 #] dollars :
637 */
638 }
639 #ifdef WITHPTHREADS
640 else if ( *s == 'W' ) { /* number of the thread with time */
641 LONG millitime;
642 WORD timepart;
643 t = (char *)NumCopy(identity,(UBYTE *)t);
644 millitime = TimeCPU(1);
645 timepart = (WORD)(millitime%1000);
646 millitime /= 1000;
647 timepart /= 10;
648 *t++ = '('; *t = 0;
649 t = (char *)LongCopy(millitime,(char *)t);
650 *t++ = '.'; *t = 0;
651 t = (char *)NumCopy(timepart,(UBYTE *)t);
652 *t++ = ')'; *t = 0;
653 if ( t >= stopper ) {
654 num = t - Out;
655 WriteString(ERROROUT,(UBYTE *)Out,num);
656 num = 0; t = Out;
657 }
658 }
659 else if ( *s == 'w' ) { /* number of the thread */
660 t = (char *)NumCopy(identity,(UBYTE *)t);
661 }
662 #elif defined(WITHMPI)
663 else if ( *s == 'W' ) { /* number of the thread with time */
664 LONG millitime;
665 WORD timepart;
666 t = (char *)NumCopy(PF.me,(UBYTE *)t);
667 millitime = TimeCPU(1);
668 timepart = (WORD)(millitime%1000);
669 millitime /= 1000;
670 timepart /= 10;
671 *t++ = '('; *t = 0;
672 t = (char *)LongCopy(millitime,(char *)t);
673 *t++ = '.'; *t = 0;
674 t = (char *)NumCopy(timepart,(UBYTE *)t);
675 *t++ = ')'; *t = 0;
676 if ( t >= stopper ) {
677 num = t - Out;
678 WriteString(ERROROUT,(UBYTE *)Out,num);
679 num = 0; t = Out;
680 }
681 }
682 else if ( *s == 'w' ) { /* number of the thread */
683 t = (char *)NumCopy(PF.me,(UBYTE *)t);
684 }
685 #else
686 else if ( *s == 'w' ) { }
687 else if ( *s == 'W' ) { }
688 #endif
689 else if ( FG.cTable[(int)*s] == 1 ) {
690 x = *s++ - '0';
691 while ( FG.cTable[(int)*s] == 1 )
692 x = 10 * x + *s++ - '0';
693
694 if ( *s == 'l' || *s == 'd' ) {
695 if ( *s == 'l' ) { y = va_arg(ap,LONG); }
696 else { y = va_arg(ap,int); }
697 if ( y < 0 ) { y = -y; w = 1; }
698 else w = 0;
699 u = t + x;
700 do { *--u = y%10+'0'; y /= 10; } while ( y && u > t );
701 if ( w && u > t ) *--u = '-';
702 while ( --u >= t ) *u = ' ';
703 t += x;
704 }
705 else if ( *s == 's' ) {
706 u = va_arg(ap,char *);
707 i = 0;
708 while ( *u ) { i++; u++; }
709 if ( i > x ) i = x;
710 while ( x > i ) { *t++ = ' '; x--; }
711 t += x;
712 while ( --i >= 0 ) { *--t = *--u; }
713 t += x;
714 }
715 else if ( *s == 'p' ) {
716 POSITION *pp;
717 /*#ifdef __GLIBC_HAVE_LONG_LONG */
718 off_t ly;
719 /*
720 #else
721 LONG ly;
722 #endif
723 */
724 pp = va_arg(ap,POSITION *);
725 ly = BASEPOSITION(*pp);
726 u = t + x;
727 do { *--u = ly%10+'0'; ly /= 10; } while ( ly && u > t );
728 while ( --u >= t ) *u = ' ';
729 t += x;
730 }
731 else if ( *s == 'i' ) {
732 w = va_arg(ap, int);
733 u = t + x;
734 do { *--u = (char)(w%10+'0'); w /= 10; } while ( u > t );
735 t += x;
736 }
737 else {
738 w = va_arg(ap, int);
739 u = t + x;
740 do { *--u = (char )(w%10+'0'); w /= 10; } while ( w && u > t );
741 while ( --u >= t ) *u = ' ';
742 t += x;
743 }
744 }
745 else if ( *s == 'x' ) {
746 char ccc;
747 y = va_arg(ap, LONG);
748 i = 2*sizeof(LONG);
749 while ( --i > 0 ) {
750 ccc = ( y >> (i*4) ) & 0xF;
751 if ( ccc ) break;
752 }
753 do {
754 ccc = ( y >> (i*4) ) & 0xF;
755 *t++ = hex[(int)ccc];
756 } while ( --i >= 0 );
757 }
758 else if ( *s == '#' ) *t++ = *s;
759 else if ( *s == '%' ) *t++ = *s;
760 else if ( *s == 0 ) { *t++ = 0; break; }
761 else if ( *s == '&' ) {
762 *t++ = *s;
763 }
764 else {
765 *t++ = '%';
766 s--;
767 }
768 s++;
769 }
770 }
771 num = t - Out;
772 WriteString(ERROROUT,(UBYTE *)Out,num);
773 va_end(ap);
774 if ( specialerror == 1 ) {
775 MesPrint("!!!Wrong object in Print statement!!!");
776 MesPrint("!!!Object encountered is of a different type as in the format specifier");
777 }
778 AO.OutputLine = oldoutfill;
779 /*[19apr2004 mt]:*/
780 WriteFile=OldWrite;
781 /*:[19apr2004 mt]*/
782 return(-1);
783 }
784
785 /*
786 #] MesPrint :
787 #[ Warning :
788 */
789
Warning(char * s)790 VOID Warning(char *s)
791 {
792 iswarning = 1;
793 if ( AC.WarnFlag ) MesPrint("&Warning: %s",s);
794 iswarning = 0;
795 }
796
797 /*
798 #] Warning :
799 #[ HighWarning :
800 */
801
HighWarning(char * s)802 VOID HighWarning(char *s)
803 {
804 iswarning = 1;
805 if ( AC.WarnFlag >= 2 ) MesPrint("&Warning: %s",s);
806 iswarning = 0;
807 }
808
809 /*
810 #] HighWarning :
811 #[ MesCall :
812 */
813
MesCall(char * s)814 int MesCall(char *s)
815 {
816 return(MesPrint((char *)"Called from %s",s));
817 }
818
819 /*
820 #] MesCall :
821 #[ MesCerr :
822 */
823
MesCerr(char * s,UBYTE * t)824 WORD MesCerr(char *s, UBYTE *t)
825 {
826 UBYTE *u, c;
827 WORD i = 11;
828 u = t;
829 while ( *u && --i >= 0 ) u--;
830 u++;
831 c = *++t;
832 *t = 0;
833 MesPrint("&Illegal %s: %s",s,u);
834 *t = c;
835 return(-1);
836 }
837
838 /*
839 #] MesCerr :
840 #[ MesComp :
841 */
842
MesComp(char * s,UBYTE * p,UBYTE * q)843 WORD MesComp(char *s, UBYTE *p, UBYTE *q)
844 {
845 UBYTE c;
846 c = *++q; *q = 0;
847 MesPrint("&%s: %s",s,p);
848 *q = c;
849 return(-1);
850 }
851
852 /*
853 #] MesComp :
854 #[ PrintTerm :
855 */
856
PrintTerm(WORD * term,char * where)857 VOID PrintTerm(WORD *term, char *where)
858 {
859 UBYTE OutBuf[140];
860 WORD *t, x;
861 int i;
862 AO.OutFill = AO.OutputLine = OutBuf;
863 t = term;
864 AO.OutSkip = 3;
865 FiniLine();
866 TokenToLine((UBYTE *)where);
867 TokenToLine((UBYTE *)": ");
868 i = *t;
869 while ( --i >= 0 ) {
870 x = *t++;
871 if ( x < 0 ) {
872 x = -x;
873 TokenToLine((UBYTE *)"-");
874 }
875 TalToLine((UWORD)(x));
876 TokenToLine((UBYTE *)" ");
877 }
878 AO.OutSkip = 0;
879 FiniLine();
880 }
881
882 /*
883 #] PrintTerm :
884 #[ PrintTermC :
885 */
886
PrintTermC(WORD * term,char * where)887 VOID PrintTermC(WORD *term, char *where)
888 {
889 UBYTE OutBuf[140];
890 WORD *t, x;
891 int i;
892 if ( *term >= 0 ) {
893 PrintTerm(term,where);
894 return;
895 }
896 AO.OutFill = AO.OutputLine = OutBuf;
897 t = term;
898 AO.OutSkip = 3;
899 FiniLine();
900 TokenToLine((UBYTE *)where);
901 TokenToLine((UBYTE *)": ");
902 i = t[1]+2;
903 while ( --i >= 0 ) {
904 x = *t++;
905 if ( x < 0 ) {
906 x = -x;
907 TokenToLine((UBYTE *)"-");
908 }
909 TalToLine((UWORD)(x));
910 TokenToLine((UBYTE *)" ");
911 }
912 AO.OutSkip = 0;
913 FiniLine();
914 }
915
916 /*
917 #] PrintTermC :
918 #[ PrintSubTerm :
919 */
920
PrintSubTerm(WORD * term,char * where)921 VOID PrintSubTerm(WORD *term, char *where)
922 {
923 UBYTE OutBuf[140];
924 WORD *t;
925 int i;
926 AO.OutFill = AO.OutputLine = OutBuf;
927 t = term;
928 AO.OutSkip = 3;
929 FiniLine();
930 TokenToLine((UBYTE *)where);
931 TokenToLine((UBYTE *)": ");
932 i = t[1];
933 while ( --i >= 0 ) { TalToLine((UWORD)(*t++)); TokenToLine((UBYTE *)" "); }
934 AO.OutSkip = 0;
935 FiniLine();
936 }
937
938 /*
939 #] PrintSubTerm :
940 #[ PrintWords :
941 */
942
PrintWords(WORD * buffer,LONG number)943 VOID PrintWords(WORD *buffer, LONG number)
944 {
945 UBYTE OutBuf[140];
946 WORD *t;
947 AO.OutFill = AO.OutputLine = OutBuf;
948 t = buffer;
949 AO.OutSkip = 3;
950 FiniLine();
951 while ( --number >= 0 ) { TalToLine((UWORD)(*t++)); TokenToLine((UBYTE *)" "); }
952 AO.OutSkip = 0;
953 FiniLine();
954 }
955
956 /*
957 #] PrintWords :
958 #[ PrintSeq :
959 */
960
PrintSeq(WORD * a,char * text)961 void PrintSeq(WORD *a,char *text)
962 {
963 MesPrint(" %s:",text);
964 while ( *a ) {
965 MesPrint(" %a",a[0],a);
966 a += *a;
967 }
968 }
969
970 /*
971 #] PrintSeq :
972 #] exit :
973 */
974