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