FORM  4.1
message.c
Go to the documentation of this file.
1 
9 /* #[ License : */
10 /*
11  * Copyright (C) 1984-2013 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 || d->factors == 0 ) goto dollarzero;
454  num = EvalDoLoopArg(BHEAD AN.listinprint+2,-1);
455  if ( num == 0 ) {
456  value[0] = 4; value[1] = d->nfactors; value[2] = 1; value[3] = 3; value[4] = 0;
457  term = value; goto printterms;
458  }
459  if ( num == 1 && d->nfactors == 1 ) {
460  term = d->where;
461  if ( *term == 0 ) goto dollarzero;
462  goto printterms;
463  }
464  if ( num > d->nfactors ) {
465  MesPrint("\nFactor number for dollar is too large.");
466  Terminate(-1);
467  }
468  term = d->factors[num-1].where;
469  if ( term == 0 ) {
470  if ( d->factors[num-1].value < 0 ) {
471  value[0] = 4; value[1] = -d->factors[num-1].value; value[2] = 1; value[3] = -3; value[4] = 0;
472  }
473  else {
474  value[0] = 4; value[1] = d->factors[num-1].value; value[2] = 1; value[3] = 3; value[4] = 0;
475  }
476  term = value;
477  }
478  goto printterms;
479  }
480  if ( d->type == DOLTERMS || d->type == DOLNUMBER ) {
481  term = d->where;
482 printterms: first = 1;
483  do {
484  if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
485  AO.IsBracket = 0;
486  AO.OutSkip = 1;
487  AC.OutputMode = 0;
488  AO.OutFill = AO.OutputLine;
489  AO.OutStop = AO.OutputLine + AC.LineLength;
490  *t = 0;
491  AddToLine((UBYTE *)Out);
492  if ( WriteInnerTerm(term,first) ) {
493 #ifdef WITHPTHREADS
494  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
495 #endif
496  Terminate(-1);
497  }
498  first = 0;
499  t = Out;
500  u = (char *)AO.OutputLine;
501  *(AO.OutFill) = 0;
502  while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
503  *t = 0;
504  AO.OutSkip = oldskip;
505  AC.OutputMode = oldmode;
506  AO.IsBracket = oldbracket;
507  AC.LineLength = oldlength;
508  AO.OutStop = oldStop;
509  term += *term;
510  } while ( *term );
511  AO.OutSkip = oldskip;
512  }
513  else if ( d->type == DOLSUBTERM ) {
514  tt = d->where;
515 dosubterm: if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
516  AO.IsBracket = 0;
517  AO.OutSkip = 1;
518  AC.OutputMode = 0;
519  AO.OutFill = AO.OutputLine;
520  AO.OutStop = AO.OutputLine + AC.LineLength;
521  *t = 0;
522  AddToLine((UBYTE *)Out);
523  if ( WriteSubTerm(tt,1) ) {
524 #ifdef WITHPTHREADS
525  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
526 #endif
527  Terminate(-1);
528  }
529  t = Out;
530  u = (char *)AO.OutputLine;
531  *(AO.OutFill) = 0;
532  while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
533  *t = 0;
534  AO.OutSkip = oldskip;
535  AC.OutputMode = oldmode;
536  AO.IsBracket = oldbracket;
537  AC.LineLength = oldlength;
538  AO.OutStop = oldStop;
539  }
540  else if ( d->type == DOLUNDEFINED ) {
541  *t++ = '*'; *t++ = '*'; *t++ = '*'; *t = 0;
542  }
543  else if ( d->type == DOLZERO ) {
544 dollarzero: *t++ = '0'; *t = 0;
545  }
546  else if ( d->type == DOLINDEX ) {
547  tt = indsubterm; *tt = INDEX;
548  tt[1] = 3; tt[2] = d->index;
549  goto dosubterm;
550  }
551  else if ( d->type == DOLARGUMENT ) {
552  if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
553  AO.IsBracket = 0;
554  AO.OutSkip = 1;
555  AC.OutputMode = 0;
556  AO.OutFill = AO.OutputLine;
557  AO.OutStop = AO.OutputLine + AC.LineLength;
558  *t = 0;
559  AddToLine((UBYTE *)Out);
560  WriteArgument(d->where);
561  t = Out;
562  u = (char *)AO.OutputLine;
563  *(AO.OutFill) = 0;
564  while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
565  *t = 0;
566  AO.OutSkip = oldskip;
567  AC.OutputMode = oldmode;
568  AO.IsBracket = oldbracket;
569  AC.LineLength = oldlength;
570  AO.OutStop = oldStop;
571  }
572  else if ( d->type == DOLWILDARGS ) {
573  tt = d->where;
574  if ( *tt == 0 ) { tt++;
575  while ( *tt ) {
576  if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
577  AO.IsBracket = 0;
578  AO.OutSkip = 1;
579  AC.OutputMode = 0;
580  AO.OutFill = AO.OutputLine;
581  AO.OutStop = AO.OutputLine + AC.LineLength;
582  *t = 0;
583  AddToLine((UBYTE *)Out);
584  WriteArgument(tt);
585  NEXTARG(tt);
586  if ( *tt ) TokenToLine((UBYTE *)",");
587  t = Out;
588  u = (char *)AO.OutputLine;
589  *(AO.OutFill) = 0;
590  while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
591  *t = 0;
592  AO.OutSkip = oldskip;
593  AC.OutputMode = oldmode;
594  AO.IsBracket = oldbracket;
595  AC.LineLength = oldlength;
596  AO.OutStop = oldStop;
597  }
598  }
599  else if ( *tt > 0 ) { /* Tensor arguments */
600  i = *tt++;
601  while ( --i >= 0 ) {
602  indsubterm[0] = INDEX;
603  indsubterm[1] = 3;
604  indsubterm[2] = *tt++;
605  if ( AC.LineLength > MAXLINELENGTH ) AC.LineLength = MAXLINELENGTH;
606  AO.IsBracket = 0;
607  AO.OutSkip = 1;
608  AC.OutputMode = 0;
609  AO.OutFill = AO.OutputLine;
610  AO.OutStop = AO.OutputLine + AC.LineLength;
611  *t = 0;
612  AddToLine((UBYTE *)Out);
613  if ( WriteSubTerm(indsubterm,1) ) Terminate(-1);
614  if ( i > 0 ) TokenToLine((UBYTE *)",");
615  t = Out;
616  u = (char *)AO.OutputLine;
617  *(AO.OutFill) = 0;
618  while ( u < (char *)(AO.OutFill) ) *t++ = *u++;
619  *t = 0;
620  AO.OutSkip = oldskip;
621  AC.OutputMode = oldmode;
622  AO.IsBracket = oldbracket;
623  AC.LineLength = oldlength;
624  AO.OutStop = oldStop;
625  }
626  }
627  }
628 #ifdef WITHPTHREADS
629  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
630 #endif
631  AN.listinprint += 2;
632  while ( AN.listinprint[0] == DOLLAREXPR2 ) AN.listinprint += 2;
633  }
634 /*
635  #] dollars :
636 */
637  }
638 #ifdef WITHPTHREADS
639  else if ( *s == 'W' ) { /* number of the thread with time */
640  LONG millitime;
641  WORD timepart;
642  t = (char *)NumCopy(identity,(UBYTE *)t);
643  millitime = TimeCPU(1);
644  timepart = (WORD)(millitime%1000);
645  millitime /= 1000;
646  timepart /= 10;
647  *t++ = '('; *t = 0;
648  t = (char *)LongCopy(millitime,(char *)t);
649  *t++ = '.'; *t = 0;
650  t = (char *)NumCopy(timepart,(UBYTE *)t);
651  *t++ = ')'; *t = 0;
652  if ( t >= stopper ) {
653  num = t - Out;
654  WriteString(ERROROUT,(UBYTE *)Out,num);
655  num = 0; t = Out;
656  }
657  }
658  else if ( *s == 'w' ) { /* number of the thread */
659  t = (char *)NumCopy(identity,(UBYTE *)t);
660  }
661 #elif defined(WITHMPI)
662  else if ( *s == 'W' ) { /* number of the thread with time */
663  LONG millitime;
664  WORD timepart;
665  t = (char *)NumCopy(PF.me,(UBYTE *)t);
666  millitime = TimeCPU(1);
667  timepart = (WORD)(millitime%1000);
668  millitime /= 1000;
669  timepart /= 10;
670  *t++ = '('; *t = 0;
671  t = (char *)LongCopy(millitime,(char *)t);
672  *t++ = '.'; *t = 0;
673  t = (char *)NumCopy(timepart,(UBYTE *)t);
674  *t++ = ')'; *t = 0;
675  if ( t >= stopper ) {
676  num = t - Out;
677  WriteString(ERROROUT,(UBYTE *)Out,num);
678  num = 0; t = Out;
679  }
680  }
681  else if ( *s == 'w' ) { /* number of the thread */
682  t = (char *)NumCopy(PF.me,(UBYTE *)t);
683  }
684 #else
685  else if ( *s == 'w' ) { }
686  else if ( *s == 'W' ) { }
687 #endif
688  else if ( FG.cTable[(int)*s] == 1 ) {
689  x = *s++ - '0';
690  while ( FG.cTable[(int)*s] == 1 )
691  x = 10 * x + *s++ - '0';
692 
693  if ( *s == 'l' || *s == 'd' ) {
694  if ( *s == 'l' ) { y = va_arg(ap,LONG); }
695  else { y = va_arg(ap,int); }
696  if ( y < 0 ) { y = -y; w = 1; }
697  else w = 0;
698  u = t + x;
699  do { *--u = y%10+'0'; y /= 10; } while ( y && u > t );
700  if ( w && u > t ) *--u = '-';
701  while ( --u >= t ) *u = ' ';
702  t += x;
703  }
704  else if ( *s == 's' ) {
705  u = va_arg(ap,char *);
706  i = 0;
707  while ( *u ) { i++; u++; }
708  if ( i > x ) i = x;
709  while ( x > i ) { *t++ = ' '; x--; }
710  t += x;
711  while ( --i >= 0 ) { *--t = *--u; }
712  t += x;
713  }
714  else if ( *s == 'p' ) {
715  POSITION *pp;
716 /*#ifdef __GLIBC_HAVE_LONG_LONG */
717  off_t ly;
718 /*
719 #else
720  LONG ly;
721 #endif
722 */
723  pp = va_arg(ap,POSITION *);
724  ly = BASEPOSITION(*pp);
725  u = t + x;
726  do { *--u = ly%10+'0'; ly /= 10; } while ( ly && u > t );
727  while ( --u >= t ) *u = ' ';
728  t += x;
729  }
730  else if ( *s == 'i' ) {
731  w = va_arg(ap, int);
732  u = t + x;
733  do { *--u = (char)(w%10+'0'); w /= 10; } while ( u > t );
734  t += x;
735  }
736  else {
737  w = va_arg(ap, int);
738  u = t + x;
739  do { *--u = (char )(w%10+'0'); w /= 10; } while ( w && u > t );
740  while ( --u >= t ) *u = ' ';
741  t += x;
742  }
743  }
744  else if ( *s == 'x' ) {
745  char ccc;
746  y = va_arg(ap, LONG);
747  i = 2*sizeof(LONG);
748  while ( --i > 0 ) {
749  ccc = ( y >> (i*4) ) & 0xF;
750  if ( ccc ) break;
751  }
752  do {
753  ccc = ( y >> (i*4) ) & 0xF;
754  *t++ = hex[(int)ccc];
755  } while ( --i >= 0 );
756  }
757  else if ( *s == '#' ) *t++ = *s;
758  else if ( *s == '%' ) *t++ = *s;
759  else if ( *s == 0 ) { *t++ = 0; break; }
760  else if ( *s == '&' ) {
761  *t++ = *s;
762  }
763  else {
764  *t++ = '%';
765  s--;
766  }
767  s++;
768  }
769  }
770  num = t - Out;
771  WriteString(ERROROUT,(UBYTE *)Out,num);
772  va_end(ap);
773  if ( specialerror == 1 ) {
774  MesPrint("!!!Wrong object in Print statement!!!");
775  MesPrint("!!!Object encountered is of a different type as in the format specifier");
776  }
777  AO.OutputLine = oldoutfill;
778  /*[19apr2004 mt]:*/
779  WriteFile=OldWrite;
780  /*:[19apr2004 mt]*/
781  return(-1);
782 }
783 
784 /*
785  #] MesPrint :
786  #[ Warning :
787 */
788 
789 VOID Warning(char *s)
790 {
791  iswarning = 1;
792  if ( AC.WarnFlag ) MesPrint("&Warning: %s",s);
793  iswarning = 0;
794 }
795 
796 /*
797  #] Warning :
798  #[ HighWarning :
799 */
800 
801 VOID HighWarning(char *s)
802 {
803  iswarning = 1;
804  if ( AC.WarnFlag >= 2 ) MesPrint("&Warning: %s",s);
805  iswarning = 0;
806 }
807 
808 /*
809  #] HighWarning :
810  #[ MesCall :
811 */
812 
813 int MesCall(char *s)
814 {
815  return(MesPrint((char *)"Called from %s",s));
816 }
817 
818 /*
819  #] MesCall :
820  #[ MesCerr :
821 */
822 
823 WORD MesCerr(char *s, UBYTE *t)
824 {
825  UBYTE *u, c;
826  WORD i = 11;
827  u = t;
828  while ( *u && --i >= 0 ) u--;
829  u++;
830  c = *++t;
831  *t = 0;
832  MesPrint("&Illegal %s: %s",s,u);
833  *t = c;
834  return(-1);
835 }
836 
837 /*
838  #] MesCerr :
839  #[ MesComp :
840 */
841 
842 WORD MesComp(char *s, UBYTE *p, UBYTE *q)
843 {
844  UBYTE c;
845  c = *++q; *q = 0;
846  MesPrint("&%s: %s",s,p);
847  *q = c;
848  return(-1);
849 }
850 
851 /*
852  #] MesComp :
853  #[ PrintTerm :
854 */
855 
856 VOID PrintTerm(WORD *term, char *where)
857 {
858  UBYTE OutBuf[140];
859  WORD *t, x;
860  int i;
861  AO.OutFill = AO.OutputLine = OutBuf;
862  t = term;
863  AO.OutSkip = 3;
864  FiniLine();
865  TokenToLine((UBYTE *)where);
866  TokenToLine((UBYTE *)": ");
867  i = *t;
868  while ( --i >= 0 ) {
869  x = *t++;
870  if ( x < 0 ) {
871  x = -x;
872  TokenToLine((UBYTE *)"-");
873  }
874  TalToLine((UWORD)(x));
875  TokenToLine((UBYTE *)" ");
876  }
877  AO.OutSkip = 0;
878  FiniLine();
879 }
880 
881 /*
882  #] PrintTerm :
883  #[ PrintTermC :
884 */
885 
886 VOID PrintTermC(WORD *term, char *where)
887 {
888  UBYTE OutBuf[140];
889  WORD *t, x;
890  int i;
891  if ( *term >= 0 ) {
892  PrintTerm(term,where);
893  return;
894  }
895  AO.OutFill = AO.OutputLine = OutBuf;
896  t = term;
897  AO.OutSkip = 3;
898  FiniLine();
899  TokenToLine((UBYTE *)where);
900  TokenToLine((UBYTE *)": ");
901  i = t[1]+2;
902  while ( --i >= 0 ) {
903  x = *t++;
904  if ( x < 0 ) {
905  x = -x;
906  TokenToLine((UBYTE *)"-");
907  }
908  TalToLine((UWORD)(x));
909  TokenToLine((UBYTE *)" ");
910  }
911  AO.OutSkip = 0;
912  FiniLine();
913 }
914 
915 /*
916  #] PrintTermC :
917  #[ PrintSubTerm :
918 */
919 
920 VOID PrintSubTerm(WORD *term, char *where)
921 {
922  UBYTE OutBuf[140];
923  WORD *t;
924  int i;
925  AO.OutFill = AO.OutputLine = OutBuf;
926  t = term;
927  AO.OutSkip = 3;
928  FiniLine();
929  TokenToLine((UBYTE *)where);
930  TokenToLine((UBYTE *)": ");
931  i = t[1];
932  while ( --i >= 0 ) { TalToLine((UWORD)(*t++)); TokenToLine((UBYTE *)" "); }
933  AO.OutSkip = 0;
934  FiniLine();
935 }
936 
937 /*
938  #] PrintSubTerm :
939  #[ PrintWords :
940 */
941 
942 VOID PrintWords(WORD *buffer, LONG number)
943 {
944  UBYTE OutBuf[140];
945  WORD *t;
946  AO.OutFill = AO.OutputLine = OutBuf;
947  t = buffer;
948  AO.OutSkip = 3;
949  FiniLine();
950  while ( --number >= 0 ) { TalToLine((UWORD)(*t++)); TokenToLine((UBYTE *)" "); }
951  AO.OutSkip = 0;
952  FiniLine();
953 }
954 
955 /*
956  #] PrintWords :
957  #] exit :
958 */
LONG PF_WriteFileToFile(int handle, UBYTE *buffer, LONG size)
Definition: parallel.c:4375
WORD EvalDoLoopArg(PHEAD WORD *, WORD)
Definition: dollar.c:2491