FORM  4.2.1
message.c
Go to the documentation of this file.
1 
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 
56 VOID Error0(char *s)
57 {
58  MesPrint("=== %s",s);
59  Terminate(-1);
60 }
61 
62 /*
63  #] Error0 :
64  #[ Error1 :
65 */
66 
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 
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 
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
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 
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 
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 
814 int MesCall(char *s)
815 {
816  return(MesPrint((char *)"Called from %s",s));
817 }
818 
819 /*
820  #] MesCall :
821  #[ MesCerr :
822 */
823 
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 
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 
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 
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 
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 
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 
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 */
LONG PF_WriteFileToFile(int handle, UBYTE *buffer, LONG size)
Definition: parallel.c:4371
LONG TimeCPU(WORD)
Definition: tools.c:3478
WORD EvalDoLoopArg(PHEAD WORD *, WORD)
Definition: dollar.c:2646