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