FORM  4.3
tools.c
Go to the documentation of this file.
1 
11 /* #[ License : */
12 /*
13  * Copyright (C) 1984-2022 J.A.M. Vermaseren
14  * When using this file you are requested to refer to the publication
15  * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
16  * This is considered a matter of courtesy as the development was paid
17  * for by FOM the Dutch physics granting agency and we would like to
18  * be able to track its scientific use to convince FOM of its value
19  * for the community.
20  *
21  * This file is part of FORM.
22  *
23  * FORM is free software: you can redistribute it and/or modify it under the
24  * terms of the GNU General Public License as published by the Free Software
25  * Foundation, either version 3 of the License, or (at your option) any later
26  * version.
27  *
28  * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
29  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
30  * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
31  * details.
32  *
33  * You should have received a copy of the GNU General Public License along
34  * with FORM. If not, see <http://www.gnu.org/licenses/>.
35  */
36 /* #] License : */
37 /*
38  #[ Includes :
39  Note: TERMMALLOCDEBUG tests part of the TermMalloc and NumberMalloc
40  system. To work properly it needs MEMORYMACROS in declare.h
41  not to be defined to make sure that all calls will be diverted
42  to the routines here.
43 #define TERMMALLOCDEBUG
44 #define FILLVALUE 126
45 #define MALLOCDEBUGOUTPUT
46 #define MALLOCDEBUG 1
47 */
48 #ifndef FILLVALUE
49  #define FILLVALUE 0
50 #endif
51 
52 /*
53  The enhanced malloc debugger, see comments in the beginning of the
54  file mallocprotect.h
55  MALLOCPROTECT == -1 -- protect left side, used block is left-aligned.
56  MALLOCPROTECT == 0 -- protect both sides, used block is left-aligned;
57  MALLOCPROTECT == 1 -- protect both sides, used block is right-aligned;
58  ATTENTION! The macro MALLOCPROTECT must be defined
59  BEFORE #include mallocprotect.h
60 #define MALLOCPROTECT 1
61 */
62 
63 #include "form3.h"
64 
65 FILES **filelist;
66 int numinfilelist = 0;
67 int filelistsize = 0;
68 #ifdef MALLOCDEBUG
69 #define BANNER (4*sizeof(LONG))
70 void *malloclist[60000];
71 LONG mallocsizes[60000];
72 char *mallocstrings[60000];
73 int nummalloclist = 0;
74 #endif
75 
76 #ifdef GPP
77 extern "C" getdtablesize();
78 #endif
79 
80 #ifdef WITHSTATS
81 LONG numwrites = 0;
82 LONG numreads = 0;
83 LONG numseeks = 0;
84 LONG nummallocs = 0;
85 LONG numfrees = 0;
86 #endif
87 
88 #ifdef MALLOCPROTECT
89 #ifdef TRAPSIGNALS
90 #error "MALLOCPROTECT": undefine "TRAPSIGNALS" in unix.h first!
91 #endif
92 #include "mallocprotect.h"
93 
94 #ifdef M_alloc
95 #undef M_alloc
96 #endif
97 
98 #define M_alloc mprotectMalloc
99 
100 #endif
101 
102 #ifdef TERMMALLOCDEBUG
103 WORD **DebugHeap1, **DebugHeap2;
104 #endif
105 
106 /*
107  #] Includes :
108  #[ Streams :
109  #[ LoadInputFile :
110 */
111 
112 UBYTE *LoadInputFile(UBYTE *filename, int type)
113 {
114  int handle;
115  LONG filesize;
116  UBYTE *buffer, *name = filename;
117  POSITION scrpos;
118  handle = LocateFile(&name,type);
119  if ( handle < 0 ) return(0);
120  PUTZERO(scrpos);
121  SeekFile(handle,&scrpos,SEEK_END);
122  TELLFILE(handle,&scrpos);
123  filesize = BASEPOSITION(scrpos);
124  PUTZERO(scrpos);
125  SeekFile(handle,&scrpos,SEEK_SET);
126  buffer = (UBYTE *)Malloc1(filesize+2,"LoadInputFile");
127  if ( ReadFile(handle,buffer,filesize) != filesize ) {
128  Error1("Read error for file ",name);
129  M_free(buffer,"LoadInputFile");
130  if ( name != filename ) M_free(name,"FromLoadInputFile");
131  CloseFile(handle);
132  return(0);
133  }
134  CloseFile(handle);
135  if ( type == PROCEDUREFILE || type == SETUPFILE ) {
136  buffer[filesize] = '\n';
137  buffer[filesize+1] = 0;
138  }
139  else {
140  buffer[filesize] = 0;
141  }
142  if ( name != filename ) M_free(name,"FromLoadInputFile");
143  return(buffer);
144 }
145 
146 /*
147  #] LoadInputFile :
148  #[ ReadFromStream :
149 */
150 
151 UBYTE ReadFromStream(STREAM *stream)
152 {
153  UBYTE c;
154  POSITION scrpos;
155 #ifdef WITHPIPE
156  if ( stream->type == PIPESTREAM ) {
157 #ifndef WITHMPI
158  FILE *f;
159  int cc;
160  RWLOCKR(AM.handlelock);
161  f = (FILE *)(filelist[stream->handle]);
162  UNRWLOCK(AM.handlelock);
163  cc = getc(f);
164  if ( cc == EOF ) return(ENDOFSTREAM);
165  c = (UBYTE)cc;
166 #else
167  if ( stream->pointer >= stream->top ) {
168  /* The master reads the pipe and broadcasts it to the slaves. */
169  LONG len;
170  if ( PF.me == MASTER ) {
171  FILE *f;
172  UBYTE *p, *end;
173  RWLOCKR(AM.handlelock);
174  f = (FILE *)filelist[stream->handle];
175  UNRWLOCK(AM.handlelock);
176  p = stream->buffer;
177  end = stream->buffer + stream->buffersize;
178  while ( p < end ) {
179  int cc = getc(f);
180  if ( cc == EOF ) {
181  break;
182  }
183  *p++ = (UBYTE)cc;
184  }
185  len = p - stream->buffer;
186  PF_BroadcastNumber(len);
187  }
188  else {
189  len = PF_BroadcastNumber(0);
190  }
191  if ( len > 0 ) {
192  PF_Bcast(stream->buffer, len);
193  }
194  stream->pointer = stream->buffer;
195  stream->inbuffer = len;
196  stream->top = stream->buffer + stream->inbuffer;
197  if ( stream->pointer == stream->top ) return ENDOFSTREAM;
198  }
199  c = (UBYTE)*stream->pointer++;
200 #endif
201  if ( stream->eqnum == 1 ) { stream->eqnum = 0; stream->linenumber++; }
202  if ( c == LINEFEED ) stream->eqnum = 1;
203  return(c);
204  }
205 #endif
206 /*[14apr2004 mt]:*/
207 #ifdef WITHEXTERNALCHANNEL
208  if ( stream->type == EXTERNALCHANNELSTREAM ) {
209  int cc;
210  cc = getcFromExtChannel();
211  /*[18may20006 mt]:*/
212  /*if ( cc == EOF ) return(ENDOFSTREAM);*/
213  if ( cc < 0 ){
214  if( cc == EOF )
215  return(ENDOFSTREAM);
216  else{
217  Error0("No current external channel");
218  Terminate(-1);
219  }
220  }/*if ( cc < 0 )*/
221  /*:[18may20006 mt]*/
222  c = (UBYTE)cc;
223  if ( stream->eqnum == 1 ) { stream->eqnum = 0; stream->linenumber++; }
224  if ( c == LINEFEED ) stream->eqnum = 1;
225  return(c);
226  }
227 #endif /*ifdef WITHEXTERNALCHANNEL*/
228 /*:[14apr2004 mt]*/
229  if ( stream->type == INPUTSTREAM ) {
230  if ( stream->pointer < stream->top ) {
231  c = *stream->pointer++;
232  }
233  else {
234  if ( ReadFile(stream->handle,&c,1) != 1 ) {
235  return(ENDOFSTREAM);
236  }
237  if ( stream->fileposition == 0 ) {
238  if ( !stream->buffer ) {
239  stream->buffersize = 32;
240  stream->buffer = (UBYTE *)Malloc1(stream->buffersize,"input stream buffer");
241  stream->pointer = stream->top = stream->buffer;
242  }
243  else {
244  if ( stream->top - stream->buffer >= stream->buffersize ) {
245  LONG oldsize = stream->buffersize;
246  DoubleBuffer((void**)&stream->buffer,(void**)&stream->top,sizeof(UBYTE),"double input stream buffer");
247  stream->buffersize = stream->top - stream->buffer;
248  stream->pointer = stream->top = stream->buffer + oldsize;
249  }
250  }
251  *stream->pointer = c;
252  stream->pointer = ++stream->top;
253  stream->inbuffer++;
254  }
255  }
256  if ( stream->eqnum == 1 ) { stream->eqnum = 0; stream->linenumber++; }
257  if ( c == LINEFEED ) stream->eqnum = 1;
258  return(c);
259  }
260  if ( stream->pointer >= stream->top ) {
261  if ( stream->type != FILESTREAM ) return(ENDOFSTREAM);
262  if ( stream->fileposition != stream->bufferposition+stream->inbuffer ) {
263  stream->fileposition = stream->bufferposition+stream->inbuffer;
264  SETBASEPOSITION(scrpos,stream->fileposition);
265  SeekFile(stream->handle,&scrpos,SEEK_SET);
266  }
267  stream->bufferposition = stream->fileposition;
268  stream->inbuffer = ReadFile(stream->handle,
269  stream->buffer,stream->buffersize);
270  if ( stream->inbuffer <= 0 ) return(ENDOFSTREAM);
271  stream->top = stream->buffer + stream->inbuffer;
272  stream->pointer = stream->buffer;
273  stream->fileposition = stream->bufferposition + stream->inbuffer;
274  }
275  if ( stream->eqnum == 1 ) { stream->eqnum = 0; stream->linenumber++; }
276  c = *(stream->pointer)++;
277  if ( c == LINEFEED ) stream->eqnum = 1;
278  return(c);
279 }
280 
281 /*
282  #] ReadFromStream :
283  #[ GetFromStream :
284 */
285 
286 UBYTE GetFromStream(STREAM *stream)
287 {
288  UBYTE c1, c2;
289  if ( stream->isnextchar > 0 ) {
290  return(stream->nextchar[--stream->isnextchar]);
291  }
292  c1 = ReadFromStream(stream);
293  if ( c1 == LINEFEED || c1 == CARRIAGERETURN ) {
294  c2 = ReadFromStream(stream);
295  if ( c2 == c1 || ( c2 != LINEFEED && c2 != CARRIAGERETURN ) ) {
296  stream->isnextchar = 1;
297  stream->nextchar[0] = c2;
298  }
299  return(LINEFEED);
300  }
301  else return(c1);
302 }
303 
304 /*
305  #] GetFromStream :
306  #[ LookInStream :
307 */
308 
309 UBYTE LookInStream(STREAM *stream)
310 {
311  UBYTE c = GetFromStream(stream);
312  UngetFromStream(stream,c);
313  return(c);
314 }
315 
316 /*
317  #] LookInStream :
318  #[ OpenStream :
319 */
320 
321 STREAM *OpenStream(UBYTE *name, int type, int prevarmode, int raiselow)
322 {
323  STREAM *stream;
324  UBYTE *rhsofvariable, *s, *newname, c;
325  POSITION scrpos;
326  int handle, num;
327  LONG filesize;
328  switch ( type ) {
329  case REVERSEFILESTREAM:
330  case FILESTREAM:
331 /*
332  Notice that FILESTREAM is only used for text files:
333  The #include files and the main input file (.frm)
334  Hence we do not worry about files longer than 2 Gbytes.
335 */
336  newname = name;
337  handle = LocateFile(&newname,-1);
338  if ( handle < 0 ) return(0);
339  PUTZERO(scrpos);
340  SeekFile(handle,&scrpos,SEEK_END);
341  TELLFILE(handle,&scrpos);
342  filesize = BASEPOSITION(scrpos);
343  PUTZERO(scrpos);
344  SeekFile(handle,&scrpos,SEEK_SET);
345  if ( filesize > AM.MaxStreamSize && type == FILESTREAM )
346  filesize = AM.MaxStreamSize;
347  stream = CreateStream((UBYTE *)"filestream");
348 /*
349  The extra +1 in the Malloc1 is potentially needed in ReverseStatements!
350 */
351  stream->buffer = (UBYTE *)Malloc1(filesize+1,"name of input stream");
352  stream->inbuffer = ReadFile(handle,stream->buffer,filesize);
353  if ( type == REVERSEFILESTREAM ) {
354  if ( ReverseStatements(stream) ) {
355  M_free(stream->buffer,"name of input stream");
356  return(0);
357  }
358  }
359  stream->top = stream->buffer + stream->inbuffer;
360  stream->pointer = stream->buffer;
361  stream->handle = handle;
362  stream->buffersize = filesize;
363  stream->fileposition = stream->inbuffer;
364  if ( newname != name ) stream->name = newname;
365  else if ( name ) stream->name = strDup1(name,"name of input stream");
366  else
367  stream->name = 0;
368  stream->prevline = stream->linenumber = 1;
369  stream->eqnum = 0;
370  break;
371  case PREVARSTREAM:
372  if ( ( rhsofvariable = GetPreVar(name,WITHERROR) ) == 0 ) return(0);
373  stream = CreateStream((UBYTE *)"var-stream");
374  stream->buffer = stream->pointer = s = rhsofvariable;
375  while ( *s ) s++;
376  stream->top = s;
377  stream->inbuffer = s - stream->buffer;
378  stream->name = AC.CurrentStream->name;
379  stream->linenumber = AC.CurrentStream->linenumber;
380  stream->prevline = AC.CurrentStream->prevline;
381  stream->eqnum = AC.CurrentStream->eqnum;
382  stream->pname = strDup1(name,"stream->pname");
383  stream->olddelay = AP.AllowDelay;
384  s = stream->pname; while ( *s ) s++;
385  while ( s[-1] == '+' || s[-1] == '-' ) s--;
386  *s = 0;
387  UnsetAllowDelay();
388  break;
389  case DOLLARSTREAM:
390  if ( ( num = GetDollar(name) ) < 0 ) {
391  WORD numfac = 0;
392 /*
393  Here we have to test first whether we have $x[1], $x[0]
394  or just an undefined $x.
395 */
396  s = name; while ( *s && *s != '[' ) s++;
397  if ( *s == 0 ) return(0);
398  c = *s; *s = 0;
399  if ( ( num = GetDollar(name) ) < 0 ) return(0);
400  *s = c;
401  s++;
402  if ( *s == 0 || FG.cTable[*s] != 1 || *s == ']' ) {
403  MesPrint("@Illegal factor number for dollar variable");
404  return(0);
405  }
406  while ( *s && FG.cTable[*s] == 1 ) {
407  numfac = 10*numfac+*s++-'0';
408  }
409  if ( *s != ']' || s[1] != 0 ) {
410  MesPrint("@Illegal factor number for $ variable");
411  return(0);
412  }
413  stream = CreateStream((UBYTE *)"dollar-stream");
414  stream->buffer = stream->pointer = s = WriteDollarFactorToBuffer(num,numfac,1);
415  }
416  else {
417  stream = CreateStream((UBYTE *)"dollar-stream");
418  stream->buffer = stream->pointer = s = WriteDollarToBuffer(num,1);
419  }
420  while ( *s ) s++;
421  stream->top = s;
422  stream->inbuffer = s - stream->buffer;
423  stream->name = AC.CurrentStream->name;
424  stream->linenumber = AC.CurrentStream->linenumber;
425  stream->prevline= AC.CurrentStream->prevline;
426  stream->eqnum = AC.CurrentStream->eqnum;
427  stream->pname = strDup1(name,"stream->pname");
428  s = stream->pname; while ( *s ) s++;
429  while ( s[-1] == '+' || s[-1] == '-' ) s--;
430  *s = 0;
431  /* We 'stole' the buffer. Later we can free it. */
432  AO.DollarOutSizeBuffer = 0;
433  AO.DollarOutBuffer = 0;
434  AO.DollarInOutBuffer = 0;
435  break;
436  case PREREADSTREAM:
437  case PREREADSTREAM2:
438  case PREREADSTREAM3:
439  case PRECALCSTREAM:
440  stream = CreateStream((UBYTE *)"calculator");
441  stream->buffer = stream->pointer = s = name;
442  while ( *s ) s++;
443  stream->top = s;
444  stream->inbuffer = s - stream->buffer;
445  stream->name = AC.CurrentStream->name;
446  stream->linenumber = AC.CurrentStream->linenumber;
447  stream->prevline = AC.CurrentStream->prevline;
448  stream->eqnum = 0;
449  break;
450 #ifdef WITHPIPE
451  case PIPESTREAM:
452  stream = CreateStream((UBYTE *)"pipe");
453 #ifndef WITHMPI
454  {
455  FILE *f;
456  if ( ( f = popen((char *)name,"r") ) == 0 ) {
457  Error0("@Cannot create pipe");
458  }
459  stream->handle = CreateHandle();
460  RWLOCKW(AM.handlelock);
461  filelist[stream->handle] = (FILES *)f;
462  UNRWLOCK(AM.handlelock);
463  }
464  stream->buffer = stream->top = 0;
465  stream->inbuffer = 0;
466 #else
467  {
468  /* Only the master opens the pipe. */
469  FILE *f;
470  if ( PF.me == MASTER ) {
471  f = popen((char *)name, "r");
472  PF_BroadcastNumber(f == 0);
473  if ( f == 0 ) Error0("@Cannot create pipe");
474  }
475  else {
476  if ( PF_BroadcastNumber(0) ) Error0("@Cannot create pipe");
477  f = (FILE *)123; /* dummy */
478  }
479  stream->handle = CreateHandle();
480  RWLOCKW(AM.handlelock);
481  filelist[stream->handle] = (FILES *)f;
482  UNRWLOCK(AM.handlelock);
483  }
484  /* stream->buffer as a send/receive buffer. */
485  stream->buffersize = AM.MaxStreamSize;
486  stream->buffer = (UBYTE *)Malloc1(stream->buffersize, "pipe buffer");
487  stream->inbuffer = 0;
488  stream->top = stream->buffer;
489  stream->pointer = stream->buffer;
490 #endif
491  stream->name = strDup1((UBYTE *)"pipe","pipe");
492  stream->prevline = stream->linenumber = 1;
493  stream->eqnum = 0;
494  break;
495 #endif
496 /*[14apr2004 mt]:*/
497 #ifdef WITHEXTERNALCHANNEL
498  case EXTERNALCHANNELSTREAM:
499  {/*Block*/
500  int n, *tmpn;
501  if( (n=getCurrentExternalChannel()) == 0 )
502  Error0("@No current extrenal channel");
503  stream = CreateStream((UBYTE *)"externalchannel");
504  stream->handle = CreateHandle();
505  tmpn = (int *)Malloc1(sizeof(int),"external channel handle");
506  *tmpn = n;
507  RWLOCKW(AM.handlelock);
508  filelist[stream->handle] = (FILES *)tmpn;
509  UNRWLOCK(AM.handlelock);
510  }/*Block*/
511  stream->buffer = stream->top = 0;
512  stream->inbuffer = 0;
513  stream->name = strDup1((UBYTE *)"externalchannel","externalchannel");
514  stream->prevline = stream->linenumber = 1;
515  stream->eqnum = 0;
516  break;
517 #endif /*ifdef WITHEXTERNALCHANNEL*/
518 /*:[14apr2004 mt]*/
519  case INPUTSTREAM:
520  /*
521  * Assume that "name" stores a file descriptor (UNIX) or a FILE
522  * pointer (Windows). We don't close it automatically on closing
523  * the INPUTSTREAM stream (e.g., for stdin).
524  */
525  stream = CreateStream((UBYTE *)"input stream");
526  stream->handle = CreateHandle();
527  {
528  FILES *f = (FILES *)Malloc1(sizeof(int),"input stream handle");
529  /* NOTE: in both cases name=0 indicates stdin. */
530 #ifdef UNIX
531  f->descriptor = (int)(ssize_t)name;
532 #else
533  f = name ? (FILES *)name : stdin;
534 #endif
535  RWLOCKW(AM.handlelock);
536  filelist[stream->handle] = f;
537  UNRWLOCK(AM.handlelock);
538  }
539  stream->buffer = stream->pointer = stream->top = 0;
540  stream->inbuffer = 0;
541  stream->name = strDup1((UBYTE *)(name ? "INPUT" : "STDIN"),"input stream name");
542  stream->prevline = stream->linenumber = 1;
543  stream->eqnum = 0;
544  /*
545  * fileposition == -1: default
546  * fileposition == 0: cache the input
547  * See also: ReadFromStream, TryFileSetups
548  */
549  stream->fileposition = -1;
550  break;
551  default:
552  return(0);
553  }
554  stream->bufferposition = 0;
555  stream->isnextchar = 0;
556  stream->type = type;
557  stream->previousNoShowInput = AC.NoShowInput;
558  stream->afterwards = raiselow;
559  if ( AC.CurrentStream ) stream->previous = AC.CurrentStream - AC.Streams;
560  else stream->previous = -1;
561  stream->FoldName = 0;
562  if ( prevarmode == 0 ) stream->prevars = -1;
563  else if ( prevarmode > 0 ) stream->prevars = NumPre;
564  else if ( prevarmode < 0 ) stream->prevars = -prevarmode-1;
565  AC.CurrentStream = stream;
566  if ( type == PREREADSTREAM || type == PREREADSTREAM3 || type == PRECALCSTREAM
567  || type == DOLLARSTREAM ) AC.NoShowInput = 1;
568  return(stream);
569 }
570 
571 /*
572  #] OpenStream :
573  #[ LocateFile :
574 */
575 
576 int LocateFile(UBYTE **name, int type)
577 {
578  int handle, namesize, i;
579  UBYTE *s, *to, *u1, *u2, *newname, *indir;
580  handle = OpenFile((char *)(*name));
581  if ( handle >= 0 ) return(handle);
582  if ( type == SETUPFILE && AM.SetupFile ) {
583  handle = OpenFile((char *)(AM.SetupFile));
584  if ( handle >= 0 ) return(handle);
585  MesPrint("Could not open setup file %s",(char *)(AM.SetupFile));
586  }
587  namesize = 4; s = *name;
588  while ( *s ) { s++; namesize++; }
589  if ( type == SETUPFILE ) indir = AM.SetupDir;
590  else indir = AM.IncDir;
591  if ( indir ) {
592 
593  s = indir; i = 0;
594  while ( *s ) { s++; i++; }
595  newname = (UBYTE *)Malloc1(namesize+i,"LocateFile");
596  s = indir; to = newname;
597  while ( *s ) *to++ = *s++;
598  if ( to > newname && to[-1] != SEPARATOR ) *to++ = SEPARATOR;
599  s = *name;
600  while ( *s ) *to++ = *s++;
601  *to = 0;
602  handle = OpenFile((char *)newname);
603  if ( handle >= 0 ) {
604  *name = newname;
605  return(handle);
606  }
607  M_free(newname,"LocateFile, incdir/file");
608  }
609  if ( type == SETUPFILE ) {
610  handle = OpenFile(setupfilename);
611  if ( handle >= 0 ) return(handle);
612  s = (UBYTE *)getenv("FORMSETUP");
613  if ( s ) {
614  handle = OpenFile((char *)s);
615  if ( handle >= 0 ) return(handle);
616  MesPrint("Could not open setup file %s",s);
617  }
618  }
619  if ( type != SETUPFILE && AM.Path ) {
620  u1 = AM.Path;
621  while ( *u1 ) {
622  u2 = u1; i = 0;
623 #ifdef WINDOWS
624  while ( *u1 && *u1 != ';' ) {
625  u1++; i++;
626  }
627 #else
628  while ( *u1 && *u1 != ':' ) {
629  if ( *u1 == '\\' ) u1++;
630  u1++; i++;
631  }
632 #endif
633  newname = (UBYTE *)Malloc1(namesize+i,"LocateFile");
634  s = u2; to = newname;
635  while ( s < u1 ) {
636 #ifndef WINDOWS
637  if ( *s == '\\' ) s++;
638 #endif
639  *to++ = *s++;
640  }
641  if ( to > newname && to[-1] != SEPARATOR ) *to++ = SEPARATOR;
642  s = *name;
643  while ( *s ) *to++ = *s++;
644  *to = 0;
645  handle = OpenFile((char *)newname);
646  if ( handle >= 0 ) {
647  *name = newname;
648  return(handle);
649  }
650  M_free(newname,"LocateFile Path/file");
651  if ( *u1 ) u1++;
652  }
653  }
654  if ( type != SETUPFILE ) Error1("LocateFile: Cannot find file",*name);
655  return(-1);
656 }
657 
658 /*
659  #] LocateFile :
660  #[ CloseStream :
661 */
662 
663 STREAM *CloseStream(STREAM *stream)
664 {
665  int newstr = stream->previous, sgn;
666  UBYTE *t, numbuf[24];
667  LONG x;
668  if ( stream->FoldName ) {
669  M_free(stream->FoldName,"stream->FoldName");
670  stream->FoldName = 0;
671  }
672  if ( stream->type == FILESTREAM || stream->type == REVERSEFILESTREAM ) {
673  CloseFile(stream->handle);
674  if ( stream->buffer != 0 ) M_free(stream->buffer,"name of input stream");
675  stream->buffer = 0;
676  }
677 #ifdef WITHPIPE
678  else if ( stream->type == PIPESTREAM ) {
679  RWLOCKW(AM.handlelock);
680 #ifdef WITHMPI
681  if ( PF.me == MASTER )
682 #endif
683  pclose((FILE *)(filelist[stream->handle]));
684  filelist[stream->handle] = 0;
685  numinfilelist--;
686  UNRWLOCK(AM.handlelock);
687 #ifdef WITHMPI
688  if ( stream->buffer != 0 ) {
689  M_free(stream->buffer, "pipe buffer");
690  stream->buffer = 0;
691  }
692 #endif
693  }
694 #endif
695 /*[14apr2004 mt]:*/
696 #ifdef WITHEXTERNALCHANNEL
697  else if ( stream->type == EXTERNALCHANNELSTREAM ) {
698  int *tmpn;
699  RWLOCKW(AM.handlelock);
700  tmpn = (int *)(filelist[stream->handle]);
701  filelist[stream->handle] = 0;
702  numinfilelist--;
703  UNRWLOCK(AM.handlelock);
704  M_free(tmpn,"external channel handle");
705  }
706 #endif /*ifdef WITHEXTERNALCHANNEL*/
707 /*:[14apr2004 mt]*/
708  else if ( stream->type == INPUTSTREAM ) {
709  FILES *f;
710  RWLOCKW(AM.handlelock);
711  f = filelist[stream->handle];
712  filelist[stream->handle] = 0;
713  numinfilelist--;
714  UNRWLOCK(AM.handlelock);
715  M_free(f,"input stream handle");
716  }
717  else if ( stream->type == PREVARSTREAM && (
718  stream->afterwards == PRERAISEAFTER || stream->afterwards == PRELOWERAFTER ) ) {
719  t = stream->buffer; x = 0; sgn = 1;
720  while ( *t == '-' || *t == '+' ) {
721  if ( *t == '-' ) sgn = -sgn;
722  t++;
723  }
724  if ( FG.cTable[*t] == 1 ) {
725  while ( *t && FG.cTable[*t] == 1 ) x = 10*x + *t++ - '0';
726  if ( *t == 0 ) {
727  if ( stream->afterwards == PRERAISEAFTER ) x = sgn*x + 1;
728  else x = sgn*x - 1;
729  NumToStr(numbuf,x);
730  PutPreVar(stream->pname,numbuf,0,1);
731  }
732  }
733  }
734  else if ( stream->type == DOLLARSTREAM && (
735  stream->afterwards == PRERAISEAFTER || stream->afterwards == PRELOWERAFTER ) ) {
736  if ( stream->afterwards == PRERAISEAFTER ) x = 1;
737  else x = -1;
738  DollarRaiseLow(stream->pname,x);
739  }
740  else if ( stream->type == PRECALCSTREAM || stream->type == DOLLARSTREAM ) {
741  if ( stream->buffer ) M_free(stream->buffer,"stream->buffer");
742  stream->buffer = 0;
743  }
744  if ( stream->name && stream->type != PREVARSTREAM
745  && stream->type != PREREADSTREAM && stream->type != PREREADSTREAM2 && stream->type != PREREADSTREAM3
746  && stream->type != PRECALCSTREAM && stream->type != DOLLARSTREAM ) {
747  M_free(stream->name,"stream->name");
748  }
749  stream->name = 0;
750 /* if ( stream->type != FILESTREAM ) */
751  AC.NoShowInput = stream->previousNoShowInput;
752  stream->buffer = 0; /* To make sure we will not reuse it */
753  stream->pointer = 0;
754 /*
755  Look whether we have to pop preprocessor variables.
756 */
757  if ( stream->prevars >= 0 ) {
758  while ( NumPre > stream->prevars ) {
759  NumPre--;
760  M_free(PreVar[NumPre].name,"PreVar[NumPre].name");
761  PreVar[NumPre].name = PreVar[NumPre].value = 0;
762  }
763  }
764  if ( stream->type == PREVARSTREAM ) {
765  AP.AllowDelay = stream->olddelay;
766  ClearMacro(stream->pname);
767  M_free(stream->pname,"stream->pname");
768  }
769  else if ( stream->type == DOLLARSTREAM ) {
770  M_free(stream->pname,"stream->pname");
771  }
772  AC.NumStreams--;
773  if ( newstr >= 0 ) return(AC.Streams + newstr);
774  else return(0);
775 }
776 
777 /*
778  #] CloseStream :
779  #[ CreateStream :
780 */
781 
782 STREAM *CreateStream(UBYTE *where)
783 {
784  STREAM *newstreams;
785  int numnewstreams,i;
786  int offset;
787  if ( AC.NumStreams >= AC.MaxNumStreams ) {
788  if ( AC.MaxNumStreams == 0 ) numnewstreams = 10;
789  else numnewstreams = 2*AC.MaxNumStreams;
790  newstreams = (STREAM *)Malloc1(sizeof(STREAM)*(numnewstreams+1),"CreateStream");
791  if ( AC.MaxNumStreams > 0 ) {
792  offset = AC.CurrentStream - AC.Streams;
793  for ( i = 0; i < AC.MaxNumStreams; i++ ) {
794  newstreams[i] = AC.Streams[i];
795  }
796  AC.CurrentStream = newstreams + offset;
797  }
798  else newstreams[0].previous = -1;
799  AC.MaxNumStreams = numnewstreams;
800  if ( AC.Streams ) M_free(AC.Streams,(char *)where);
801  AC.Streams = newstreams;
802  }
803  newstreams = AC.Streams+AC.NumStreams++;
804  newstreams->name = 0;
805  return(newstreams);
806 }
807 
808 /*
809  #] CreateStream :
810  #[ GetStreamPosition :
811 */
812 
813 LONG GetStreamPosition(STREAM *stream)
814 {
815  return(stream->bufferposition + ((LONG)stream->pointer-(LONG)stream->buffer));
816 }
817 
818 /*
819  #] GetStreamPosition :
820  #[ PositionStream :
821 */
822 
823 VOID PositionStream(STREAM *stream, LONG position)
824 {
825  POSITION scrpos;
826  if ( position >= stream->bufferposition
827  && position < stream->bufferposition + stream->inbuffer ) {
828  stream->pointer = stream->buffer + (position-stream->bufferposition);
829  }
830  else if ( stream->type == FILESTREAM ) {
831  SETBASEPOSITION(scrpos,position);
832  SeekFile(stream->handle,&scrpos,SEEK_SET);
833  stream->inbuffer = ReadFile(stream->handle,stream->buffer,stream->buffersize);
834  stream->pointer = stream->buffer;
835  stream->top = stream->buffer + stream->inbuffer;
836  stream->bufferposition = position;
837  stream->fileposition = position + stream->inbuffer;
838  stream->isnextchar = 0;
839  }
840  else {
841  Error0("Illegal position for stream");
842  Terminate(-1);
843  }
844 }
845 
846 /*
847  #] PositionStream :
848  #[ ReverseStatements :
849 
850  Reverses the order of the statements in the buffer.
851  We allocate an extra buffer and copy a bit to and fro.
852  Note that there are some nasties that cannot be resolved.
853 */
854 
855 int ReverseStatements(STREAM *stream)
856 {
857  UBYTE *spare = (UBYTE *)Malloc1((stream->inbuffer+1)*sizeof(UBYTE),"Reverse copy");
858  UBYTE *top = stream->buffer + stream->inbuffer, *in, *s, *ss, *out;
859  out = spare+stream->inbuffer+1;
860  in = stream->buffer;
861  while ( in < top ) {
862  s = in;
863  if ( *s == AP.ComChar ) {
864 toeol:;
865  for(;;) {
866  if ( s == top ) { *--out = '\n'; break; }
867  if ( *s == '\\' ) {
868  s++;
869  if ( s >= top ) { /* This is an error! */
870 irrend: MesPrint("@Irregular end of reverse include file.");
871  return(1);
872  }
873  }
874  else if ( *s == '\n' ) {
875  s++; ss = s;
876  while ( ss > in ) *--out = *--ss;
877  in = s;
878  if ( out[0] == AP.ComChar && ss+6 < s && out[3] == '#' ) {
879 /*
880  For folds we have to exchange begin and end
881 */
882  if ( out[4] == '[' ) out[4] = ']';
883  else if ( out[4] == ']' ) out[4] = '[';
884  }
885  break;
886  }
887  s++;
888  }
889  continue;
890  }
891  while ( s < top && ( *s == ' ' || *s == '\t' ) ) s++;
892  if ( *s == '#' ) { /* preprocessor instruction */
893  goto toeol; /* read to end of line */
894  }
895  if ( *s == '.' ) { /* end-of-module instruction */
896  goto toeol; /* read to end of line */
897  }
898 /*
899  Here we have a regular statement. In principle we scan to ; and its \n
900  but there are special cases.
901  1: ; inside a string (in print "......;";)
902  2: multiple statements on one line.
903  3: ; + commentary after some blanks.
904  4: `var' can cause problems.....
905 */
906  while ( s < top ) {
907  if ( *s == ';' ) {
908  s++;
909  while ( s < top && ( *s == ' ' || *s == '\t' ) ) s++;
910  while ( s < top && *s == '\n' ) s++;
911  if ( s >= top && s[-1] != '\n' ) *s++ = '\n';
912  ss = s;
913  while ( ss > in ) *--out = *--ss;
914  in = s;
915  break;
916  }
917  else if ( *s == '"' ) {
918  s++;
919  while ( s < top ) {
920  if ( *s == '"' ) break;
921  if ( *s == '\\' ) { s++; }
922  s++;
923  }
924  if ( s >= top ) goto irrend;
925  }
926  else if ( *s == '\\' ) {
927  s++;
928  if ( s >= top ) goto irrend;
929  }
930  s++;
931  }
932  if ( in < top ) { /* Like blank lines at the end */
933  if ( s >= top && s[-1] != '\n' ) *s++ = '\n';
934  ss = s;
935  while ( ss > in ) *--out = *--ss;
936  in = s;
937  }
938  }
939  if ( out == spare ) stream->inbuffer++;
940  if ( out > spare+1 ) {
941  MesPrint("@Internal error in #reverseinclude instruction.");
942  return(1);
943  }
944  memcpy((void *)(stream->buffer),(void *)out,(size_t)(stream->inbuffer*sizeof(UBYTE)));
945  M_free(spare,"Reverse copy");
946  return(0);
947 }
948 
949 /*
950  #] ReverseStatements :
951  #] Streams :
952  #[ Files :
953  #[ StartFiles :
954 */
955 
956 VOID StartFiles()
957 {
958  int i = CreateHandle();
959  filelist[i] = Ustdout;
960  AM.StdOut = i;
961  AC.StoreHandle = -1;
962  AC.LogHandle = -1;
963 #ifndef WITHPTHREADS
964  AR.Fscr[0].handle = -1;
965  AR.Fscr[1].handle = -1;
966  AR.Fscr[2].handle = -1;
967  AR.FoStage4[0].handle = -1;
968  AR.FoStage4[1].handle = -1;
969  AR.infile = &(AR.Fscr[0]);
970  AR.outfile = &(AR.Fscr[1]);
971  AR.hidefile = &(AR.Fscr[2]);
972  AR.StoreData.Handle = -1;
973 #endif
974  AC.Streams = 0;
975  AC.MaxNumStreams = 0;
976 }
977 
978 /*
979  #] StartFiles :
980  #[ OpenFile :
981 */
982 
983 int OpenFile(char *name)
984 {
985  FILES *f;
986  int i;
987 
988  if ( ( f = Uopen(name,"rb") ) == 0 ) return(-1);
989 /* Usetbuf(f,0); */
990  i = CreateHandle();
991  RWLOCKW(AM.handlelock);
992  filelist[i] = f;
993  UNRWLOCK(AM.handlelock);
994  return(i);
995 }
996 
997 /*
998  #] OpenFile :
999  #[ OpenAddFile :
1000 */
1001 
1002 int OpenAddFile(char *name)
1003 {
1004  FILES *f;
1005  int i;
1006  POSITION scrpos;
1007  if ( ( f = Uopen(name,"a+b") ) == 0 ) return(-1);
1008 /* Usetbuf(f,0); */
1009  i = CreateHandle();
1010  RWLOCKW(AM.handlelock);
1011  filelist[i] = f;
1012  UNRWLOCK(AM.handlelock);
1013  TELLFILE(i,&scrpos);
1014  SeekFile(i,&scrpos,SEEK_SET);
1015  return(i);
1016 }
1017 
1018 /*
1019  #] OpenAddFile :
1020  #[ ReOpenFile :
1021 */
1022 
1023 int ReOpenFile(char *name)
1024 {
1025  FILES *f;
1026  int i;
1027  POSITION scrpos;
1028  if ( ( f = Uopen(name,"r+b") ) == 0 ) return(-1);
1029  i = CreateHandle();
1030  RWLOCKW(AM.handlelock);
1031  filelist[i] = f;
1032  UNRWLOCK(AM.handlelock);
1033  TELLFILE(i,&scrpos);
1034  SeekFile(i,&scrpos,SEEK_SET);
1035  return(i);
1036 }
1037 
1038 /*
1039  #] ReOpenFile :
1040  #[ CreateFile :
1041 */
1042 
1043 int CreateFile(char *name)
1044 {
1045  FILES *f;
1046  int i;
1047  if ( ( f = Uopen(name,"w+b") ) == 0 ) return(-1);
1048  i = CreateHandle();
1049  RWLOCKW(AM.handlelock);
1050  filelist[i] = f;
1051  UNRWLOCK(AM.handlelock);
1052  return(i);
1053 }
1054 
1055 /*
1056  #] CreateFile :
1057  #[ CreateLogFile :
1058 */
1059 
1060 int CreateLogFile(char *name)
1061 {
1062  FILES *f;
1063  int i;
1064  if ( ( f = Uopen(name,"w+b") ) == 0 ) return(-1);
1065  Usetbuf(f,0);
1066  i = CreateHandle();
1067  RWLOCKW(AM.handlelock);
1068  filelist[i] = f;
1069  UNRWLOCK(AM.handlelock);
1070  return(i);
1071 }
1072 
1073 /*
1074  #] CreateLogFile :
1075  #[ CloseFile :
1076 */
1077 
1078 VOID CloseFile(int handle)
1079 {
1080  if ( handle >= 0 ) {
1081  FILES *f; /* we need this variable to be thread-safe */
1082  RWLOCKW(AM.handlelock);
1083  f = filelist[handle];
1084  filelist[handle] = 0;
1085  numinfilelist--;
1086  UNRWLOCK(AM.handlelock);
1087  Uclose(f);
1088  }
1089 }
1090 
1091 /*
1092  #] CloseFile :
1093  #[ CopyFile :
1094 */
1095 
1101 int CopyFile(char *source, char *dest)
1102 {
1103  #define COPYFILEBUFSIZE 40960L
1104  FILE *in, *out;
1105  size_t countin, countout, sumcount;
1106  char *buffer = NULL;
1107 
1108  sumcount = (AM.S0->LargeSize+AM.S0->SmallEsize)*sizeof(WORD);
1109  if ( sumcount <= COPYFILEBUFSIZE ) {
1110  sumcount = COPYFILEBUFSIZE;
1111  buffer = (char*)Malloc1(sumcount, "file copy buffer");
1112  }
1113  else {
1114  buffer = (char *)(AM.S0->lBuffer);
1115  }
1116 
1117  in = fopen(source, "rb");
1118  if ( in == NULL ) {
1119  perror("CopyFile: ");
1120  return(1);
1121  }
1122  out = fopen(dest, "wb");
1123  if ( out == NULL ) {
1124  perror("CopyFile: ");
1125  return(2);
1126  }
1127 
1128  while ( !feof(in) ) {
1129  countin = fread(buffer, 1, sumcount, in);
1130  if ( countin != sumcount ) {
1131  if ( ferror(in) ) {
1132  perror("CopyFile: ");
1133  return(3);
1134  }
1135  }
1136  countout = fwrite(buffer, 1, countin, out);
1137  if ( countin != countout ) {
1138  perror("CopyFile: ");
1139  return(4);
1140  }
1141  }
1142 
1143  fclose(in);
1144  fclose(out);
1145  if ( sumcount <= COPYFILEBUFSIZE ) {
1146  M_free(buffer, "file copy buffer");
1147  }
1148  return(0);
1149 }
1150 
1151 /*
1152  #] CopyFile :
1153  #[ CreateHandle :
1154 
1155  We need a lock here.
1156  Problem: the same lock is needed inside Malloc1 and M_free which
1157  is used in DoubleList when we use MALLOCDEBUG
1158 
1159  Conclusion: MALLOCDEBUG will have to be a bit unsafe
1160 */
1161 
1162 int CreateHandle()
1163 {
1164  int i, j;
1165 #ifndef MALLOCDEBUG
1166  RWLOCKW(AM.handlelock);
1167 #endif
1168  if ( filelistsize == 0 ) {
1169  filelistsize = 10;
1170  filelist = (FILES **)Malloc1(sizeof(FILES *)*filelistsize,"file handle");
1171  for ( j = 0; j < filelistsize; j++ ) filelist[j] = 0;
1172  numinfilelist = 1;
1173  i = 0;
1174  }
1175  else if ( numinfilelist >= filelistsize ) {
1176  VOID **fl = (VOID **)filelist;
1177  i = filelistsize;
1178  if ( DoubleList((VOID ***)(&fl),&filelistsize,(int)sizeof(FILES *),
1179  "list of open files") != 0 ) Terminate(-1);
1180  filelist = (FILES **)fl;
1181  for ( j = i; j < filelistsize; j++ ) filelist[j] = 0;
1182  numinfilelist = i + 1;
1183  }
1184  else {
1185  i = filelistsize;
1186  for ( j = 0; j < filelistsize; j++ ) {
1187  if ( filelist[j] == 0 ) { i = j; break; }
1188  }
1189  numinfilelist++;
1190  }
1191  filelist[i] = (FILES *)(filelist); /* Just for now to not get into problems */
1192 /*
1193  The next code is not needed when we use open.
1194  It may be needed when we use fopen.
1195  fopen is used in minos.c without this central administration.
1196 */
1197  if ( numinfilelist > MAX_OPEN_FILES ) {
1198 #ifndef MALLOCDEBUG
1199  UNRWLOCK(AM.handlelock);
1200 #endif
1201  MesPrint("More than %d open files",MAX_OPEN_FILES);
1202  Error0("System limit. This limit is not due to FORM!");
1203  }
1204  else {
1205 #ifndef MALLOCDEBUG
1206  UNRWLOCK(AM.handlelock);
1207 #endif
1208  }
1209  return(i);
1210 }
1211 
1212 /*
1213  #] CreateHandle :
1214  #[ ReadFile :
1215 */
1216 
1217 LONG ReadFile(int handle, UBYTE *buffer, LONG size)
1218 {
1219  LONG inbuf = 0, r;
1220  FILES *f;
1221  char *b;
1222  b = (char *)buffer;
1223  for(;;) { /* Gotta do difficult because of VMS! */
1224  RWLOCKR(AM.handlelock);
1225  f = filelist[handle];
1226  UNRWLOCK(AM.handlelock);
1227 #ifdef WITHSTATS
1228  numreads++;
1229 #endif
1230  r = Uread(b,1,size,f);
1231  if ( r < 0 ) return(r);
1232  if ( r == 0 ) return(inbuf);
1233  inbuf += r;
1234  if ( r == size ) return(inbuf);
1235  if ( r > size ) return(-1);
1236  size -= r;
1237  b += r;
1238  }
1239 }
1240 
1241 /*
1242  #] ReadFile :
1243  #[ ReadPosFile :
1244 
1245  Gets words from a file(handle).
1246  First tries to get the information from the buffers.
1247  Reads a file at a position. Updates the position.
1248  Places a lock in the case of multithreading.
1249  Exists for multiple reading from the same file.
1250  size is the number of WORDs to read!!!!
1251 
1252  We may need some strategy in the caching. This routine is used from
1253  GetOneTerm only. The problem is when it reads brackets and the
1254  brackets are read backwards. This is very uneconomical because
1255  each time it may read a large buffer.
1256  On the other hand, reading piece by piece in GetOneTerm takes
1257  much overhead as well.
1258  Two strategies come to mind:
1259  1: keep things as they are but limit the size of the buffers.
1260  2: have the position of 'pos' at about 1/3 of the buffer.
1261  this is of course guess work.
1262  Currently we have implemented the first method by creating the
1263  setup parameter threadscratchsize with the default value 100K.
1264  In the test program much bigger values gave a slower program.
1265 */
1266 
1267 LONG ReadPosFile(PHEAD FILEHANDLE *fi, UBYTE *buffer, LONG size, POSITION *pos)
1268 {
1269  GETBIDENTITY
1270  LONG i, retval = 0;
1271  WORD *b = (WORD *)buffer, *t;
1272 
1273  if ( fi->handle < 0 ) {
1274  fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(*pos));
1275  t = fi->POfill;
1276  while ( size > 0 && fi->POfill < fi->POfull ) { *b++ = *t++; size--; }
1277  }
1278  else {
1279  if ( ISLESSPOS(*pos,fi->POposition) || ISGEPOSINC(*pos,fi->POposition,
1280  ((UBYTE *)(fi->POfull)-(UBYTE *)(fi->PObuffer))) ) {
1281 /*
1282  The start is not inside the buffer. Fill the buffer.
1283 */
1284 
1285  fi->POposition = *pos;
1286  LOCK(AS.inputslock);
1287  SeekFile(fi->handle,pos,SEEK_SET);
1288  retval = ReadFile(fi->handle,(UBYTE *)(fi->PObuffer),fi->POsize);
1289  UNLOCK(AS.inputslock);
1290  fi->POfull = fi->PObuffer+retval/sizeof(WORD);
1291  fi->POfill = fi->PObuffer;
1292  if ( fi != AR.hidefile ) AR.InInBuf = retval/sizeof(WORD);
1293  else AR.InHiBuf = retval/sizeof(WORD);
1294  }
1295  else {
1296  fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + DIFBASE(*pos,fi->POposition));
1297  }
1298  if ( fi->POfill + size <= fi->POfull ) {
1299  t = fi->POfill;
1300  while ( size > 0 ) { *b++ = *t++; size--; }
1301  }
1302  else {
1303  for (;;) {
1304  i = fi->POfull - fi->POfill; t = fi->POfill;
1305  if ( i > size ) i = size;
1306  size -= i;
1307  while ( --i >= 0 ) *b++ = *t++;
1308  if ( size == 0 ) break;
1309  ADDPOS(fi->POposition,(UBYTE *)(fi->POfull)-(UBYTE *)(fi->PObuffer));
1310  LOCK(AS.inputslock);
1311  SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
1312  retval = ReadFile(fi->handle,(UBYTE *)(fi->PObuffer),fi->POsize);
1313  UNLOCK(AS.inputslock);
1314  fi->POfull = fi->PObuffer+retval/sizeof(WORD);
1315  fi->POfill = fi->PObuffer;
1316  if ( fi != AR.hidefile ) AR.InInBuf = retval/sizeof(WORD);
1317  else AR.InHiBuf = retval/sizeof(WORD);
1318  if ( retval == 0 ) { t = fi->POfill; break; }
1319  }
1320  }
1321  }
1322  retval = (UBYTE *)b - buffer;
1323  fi->POfill = t;
1324  ADDPOS(*pos,retval);
1325  return(retval);
1326 }
1327 
1328 /*
1329  #] ReadPosFile :
1330  #[ WriteFile :
1331 */
1332 
1333 LONG WriteFileToFile(int handle, UBYTE *buffer, LONG size)
1334 {
1335  FILES *f;
1336  LONG retval, totalwritten = 0, stilltowrite;
1337  RWLOCKR(AM.handlelock);
1338  f = filelist[handle];
1339  UNRWLOCK(AM.handlelock);
1340  while ( totalwritten < size ) {
1341  stilltowrite = size - totalwritten;
1342 #ifdef WITHSTATS
1343  numwrites++;
1344 #endif
1345  retval = Uwrite((char *)buffer+totalwritten,1,stilltowrite,f);
1346  if ( retval < 0 ) return(retval);
1347  if ( retval == 0 ) return(totalwritten);
1348  totalwritten += retval;
1349  }
1350 /*
1351 if ( handle == AC.LogHandle || handle == ERROROUT ) FlushFile(handle);
1352 */
1353  return(totalwritten);
1354 }
1355 #ifndef WITHMPI
1356 /*[17nov2005]:*/
1357 WRITEFILE WriteFile = &WriteFileToFile;
1358 /*
1359 LONG (*WriteFile)(int handle, UBYTE *buffer, LONG size) = &WriteFileToFile;
1360 */
1361 /*:[17nov2005]*/
1362 #else
1363 WRITEFILE WriteFile = &PF_WriteFileToFile;
1364 #endif
1365 
1366 /*
1367  #] WriteFile :
1368  #[ SeekFile :
1369 */
1370 
1371 VOID SeekFile(int handle, POSITION *offset, int origin)
1372 {
1373  FILES *f;
1374  RWLOCKR(AM.handlelock);
1375  f = filelist[handle];
1376  UNRWLOCK(AM.handlelock);
1377 #ifdef WITHSTATS
1378  numseeks++;
1379 #endif
1380  if ( origin == SEEK_SET ) {
1381  Useek(f,BASEPOSITION(*offset),origin);
1382  SETBASEPOSITION(*offset,(Utell(f)));
1383  return;
1384  }
1385  else if ( origin == SEEK_END ) {
1386  Useek(f,0,origin);
1387  }
1388  SETBASEPOSITION(*offset,(Utell(f)));
1389 }
1390 
1391 /*
1392  #] SeekFile :
1393  #[ TellFile :
1394 */
1395 
1396 LONG TellFile(int handle)
1397 {
1398  POSITION pos;
1399  TELLFILE(handle,&pos);
1400 #ifdef WITHSTATS
1401  numseeks++;
1402 #endif
1403  return(BASEPOSITION(pos));
1404 }
1405 
1406 VOID TELLFILE(int handle, POSITION *position)
1407 {
1408  FILES *f;
1409  RWLOCKR(AM.handlelock);
1410  f = filelist[handle];
1411  UNRWLOCK(AM.handlelock);
1412  SETBASEPOSITION(*position,(Utell(f)));
1413 }
1414 
1415 /*
1416  #] TellFile :
1417  #[ FlushFile :
1418 */
1419 
1420 void FlushFile(int handle)
1421 {
1422  FILES *f;
1423  RWLOCKR(AM.handlelock);
1424  f = filelist[handle];
1425  UNRWLOCK(AM.handlelock);
1426  Uflush(f);
1427 }
1428 
1429 /*
1430  #] FlushFile :
1431  #[ GetPosFile :
1432 */
1433 
1434 int GetPosFile(int handle, fpos_t *pospointer)
1435 {
1436  FILES *f;
1437  RWLOCKR(AM.handlelock);
1438  f = filelist[handle];
1439  UNRWLOCK(AM.handlelock);
1440  return(Ugetpos(f,pospointer));
1441 }
1442 
1443 /*
1444  #] GetPosFile :
1445  #[ SetPosFile :
1446 */
1447 
1448 int SetPosFile(int handle, fpos_t *pospointer)
1449 {
1450  FILES *f;
1451  RWLOCKR(AM.handlelock);
1452  f = filelist[handle];
1453  UNRWLOCK(AM.handlelock);
1454  return(Usetpos(f,(fpos_t *)pospointer));
1455 }
1456 
1457 /*
1458  #] SetPosFile :
1459  #[ SynchFile :
1460 
1461  It may be that when we use many sort files at the same time there
1462  is a big traffic jam in the cache. This routine is experimental,
1463  just to see whether this improves the situation.
1464  It could also be that the internal disk of the Quad opteron norma
1465  is very slow.
1466 */
1467 
1468 VOID SynchFile(int handle)
1469 {
1470  FILES *f;
1471  if ( handle >= 0 ) {
1472  RWLOCKR(AM.handlelock);
1473  f = filelist[handle];
1474  UNRWLOCK(AM.handlelock);
1475  Usync(f);
1476  }
1477 }
1478 
1479 /*
1480  #] SynchFile :
1481  #[ TruncateFile :
1482 
1483  It may be that when we use many sort files at the same time there
1484  is a big traffic jam in the cache. This routine is experimental,
1485  just to see whether this improves the situation.
1486  It could also be that the internal disk of the Quad opteron norma
1487  is very slow.
1488 */
1489 
1490 VOID TruncateFile(int handle)
1491 {
1492  FILES *f;
1493  if ( handle >= 0 ) {
1494  RWLOCKR(AM.handlelock);
1495  f = filelist[handle];
1496  UNRWLOCK(AM.handlelock);
1497  Utruncate(f);
1498  }
1499 }
1500 
1501 /*
1502  #] TruncateFile :
1503  #[ GetChannel :
1504 
1505  Checks whether we have this file already. If so, we return its
1506  handle. If not and mode == 0, we open the file first and add it
1507  to the buffers.
1508 */
1509 
1510 int GetChannel(char *name,int mode)
1511 {
1512  CHANNEL *ch;
1513  int i;
1514  FILES *f;
1515  for ( i = 0; i < NumOutputChannels; i++ ) {
1516  if ( channels[i].name == 0 ) continue;
1517  if ( StrCmp((UBYTE *)name,(UBYTE *)(channels[i].name)) == 0 ) return(channels[i].handle);
1518  }
1519  if ( mode == 1 ) {
1520  MesPrint("&File %s in print statement is not open",name);
1521  MesPrint(" You should open it first with a #write or #append instruction");
1522  return(-1);
1523  }
1524  for ( i = 0; i < NumOutputChannels; i++ ) {
1525  if ( channels[i].name == 0 ) break;
1526  }
1527  if ( i < NumOutputChannels ) { ch = &(channels[i]); }
1528  else { ch = (CHANNEL *)FromList(&AC.ChannelList); }
1529  ch->name = (char *)strDup1((UBYTE *)name,"name of channel");
1530  ch->handle = CreateFile(name);
1531  RWLOCKR(AM.handlelock);
1532  f = filelist[ch->handle];
1533  UNRWLOCK(AM.handlelock);
1534  Usetbuf(f,0); /* We turn the buffer off!!!!!!*/
1535  return(ch->handle);
1536 }
1537 
1538 /*
1539  #] GetChannel :
1540  #[ GetAppendChannel :
1541 
1542  Checks whether we have this file already. If so, we return its
1543  handle. If not, we open the file first and add it to the buffers.
1544 */
1545 
1546 int GetAppendChannel(char *name)
1547 {
1548  CHANNEL *ch;
1549  int i;
1550  FILES *f;
1551  for ( i = 0; i < NumOutputChannels; i++ ) {
1552  if ( channels[i].name == 0 ) continue;
1553  if ( StrCmp((UBYTE *)name,(UBYTE *)(channels[i].name)) == 0 ) return(channels[i].handle);
1554  }
1555  for ( i = 0; i < NumOutputChannels; i++ ) {
1556  if ( channels[i].name == 0 ) break;
1557  }
1558  if ( i < NumOutputChannels ) { ch = &(channels[i]); }
1559  else { ch = (CHANNEL *)FromList(&AC.ChannelList); }
1560  ch->name = (char *)strDup1((UBYTE *)name,"name of channel");
1561  ch->handle = OpenAddFile(name);
1562  RWLOCKR(AM.handlelock);
1563  f = filelist[ch->handle];
1564  UNRWLOCK(AM.handlelock);
1565  Usetbuf(f,0); /* We turn the buffer off!!!!!!*/
1566  return(ch->handle);
1567 }
1568 
1569 /*
1570  #] GetAppendChannel :
1571  #[ CloseChannel :
1572 
1573  Checks whether we have this file already. If so, we close it.
1574 */
1575 
1576 int CloseChannel(char *name)
1577 {
1578  int i;
1579  for ( i = 0; i < NumOutputChannels; i++ ) {
1580  if ( channels[i].name == 0 ) continue;
1581  if ( channels[i].name[0] == 0 ) continue;
1582  if ( StrCmp((UBYTE *)name,(UBYTE *)(channels[i].name)) == 0 ) {
1583  CloseFile(channels[i].handle);
1584  M_free(channels[i].name,"CloseChannel");
1585  channels[i].name = 0;
1586  return(0);
1587  }
1588  }
1589  return(0);
1590 }
1591 
1592 /*
1593  #] CloseChannel :
1594  #[ UpdateMaxSize :
1595 
1596  Updates the maximum size of the combined input/output/hide scratch
1597  files, the sort files and the .str file.
1598  The result becomes only visible with either
1599  ON totalsize;
1600  #: totalsize ON;
1601  or the -T in the command tail.
1602 
1603  To be called, whenever a file is closed/removed or truncated to zero.
1604 
1605  We have no provisions yet for expressions that remain inside the
1606  small or large buffer during the sort. The space they use there is
1607  currently ignored.
1608 */
1609 
1610 void UpdateMaxSize()
1611 {
1612  POSITION position, sumsize;
1613  int i;
1614  FILEHANDLE *scr;
1615 #ifdef WITHMPI
1616  /* Currently, it works only on the master. The sort files on the slaves
1617  * are ignored. (TU 11 Oct 2011) */
1618  if ( PF.me != MASTER ) return;
1619 #endif
1620  PUTZERO(sumsize);
1621  if ( AM.PrintTotalSize ) {
1622 /*
1623  First the three scratch files
1624 */
1625 #ifdef WITHPTHREADS
1626  scr = AB[0]->R.Fscr;
1627 #else
1628  scr = AR.Fscr;
1629 #endif
1630  for ( i = 0; i <=2; i++ ) {
1631  if ( scr[i].handle < 0 ) {
1632  SETBASEPOSITION(position,(scr[i].POfull-scr[i].PObuffer)*sizeof(WORD));
1633  }
1634  else {
1635  position = scr[i].filesize;
1636  }
1637  ADD2POS(sumsize,position);
1638  }
1639 /*
1640  Now the sort file(s)
1641 */
1642 #ifdef WITHPTHREADS
1643  {
1644  int j;
1645  ALLPRIVATES *B;
1646  for ( j = 0; j < AM.totalnumberofthreads; j++ ) {
1647  B = AB[j];
1648  if ( AT.SS && AT.SS->file.handle >= 0 ) {
1649  position = AT.SS->file.filesize;
1650 /*
1651 MLOCK(ErrorMessageLock);
1652 MesPrint("%d: %10p",j,&(AT.SS->file.filesize));
1653 MUNLOCK(ErrorMessageLock);
1654 */
1655  ADD2POS(sumsize,position);
1656  }
1657  if ( AR.FoStage4[0].handle >= 0 ) {
1658  position = AR.FoStage4[0].filesize;
1659  ADD2POS(sumsize,position);
1660  }
1661  }
1662  }
1663 #else
1664  if ( AT.SS && AT.SS->file.handle >= 0 ) {
1665  position = AT.SS->file.filesize;
1666  ADD2POS(sumsize,position);
1667  }
1668  if ( AR.FoStage4[0].handle >= 0 ) {
1669  position = AR.FoStage4[0].filesize;
1670  ADD2POS(sumsize,position);
1671  }
1672 #endif
1673 /*
1674  And of course the str file.
1675 */
1676  ADD2POS(sumsize,AC.StoreFileSize);
1677 /*
1678  Finally the test whether it is bigger
1679 */
1680  if ( ISLESSPOS(AS.MaxExprSize,sumsize) ) {
1681 #ifdef WITHPTHREADS
1682  LOCK(AS.MaxExprSizeLock);
1683  if ( ISLESSPOS(AS.MaxExprSize,sumsize) ) AS.MaxExprSize = sumsize;
1684  UNLOCK(AS.MaxExprSizeLock);
1685 #else
1686  AS.MaxExprSize = sumsize;
1687 #endif
1688  }
1689  }
1690  return;
1691 }
1692 
1693 /*
1694  #] UpdateMaxSize :
1695  #] Files :
1696  #[ Strings :
1697  #[ StrCmp :
1698 */
1699 
1700 int StrCmp(UBYTE *s1, UBYTE *s2)
1701 {
1702  while ( *s1 && *s1 == *s2 ) { s1++; s2++; }
1703  return((int)*s1-(int)*s2);
1704 }
1705 
1706 /*
1707  #] StrCmp :
1708  #[ StrICmp :
1709 */
1710 
1711 int StrICmp(UBYTE *s1, UBYTE *s2)
1712 {
1713  while ( *s1 && tolower(*s1) == tolower(*s2) ) { s1++; s2++; }
1714  return((int)tolower(*s1)-(int)tolower(*s2));
1715 }
1716 
1717 /*
1718  #] StrICmp :
1719  #[ StrHICmp :
1720 */
1721 
1722 int StrHICmp(UBYTE *s1, UBYTE *s2)
1723 {
1724  while ( *s1 && tolower(*s1) == *s2 ) { s1++; s2++; }
1725  return((int)tolower(*s1)-(int)(*s2));
1726 }
1727 
1728 /*
1729  #] StrHICmp :
1730  #[ StrICont :
1731 */
1732 
1733 int StrICont(UBYTE *s1, UBYTE *s2)
1734 {
1735  while ( *s1 && tolower(*s1) == tolower(*s2) ) { s1++; s2++; }
1736  if ( *s1 == 0 ) return(0);
1737  return((int)tolower(*s1)-(int)tolower(*s2));
1738 }
1739 
1740 /*
1741  #] StrICont :
1742  #[ CmpArray :
1743 */
1744 
1745 int CmpArray(WORD *t1, WORD *t2, WORD n)
1746 {
1747  int i,x;
1748  for ( i = 0; i < n; i++ ) {
1749  if ( ( x = (int)(t1[i]-t2[i]) ) != 0 ) return(x);
1750  }
1751  return(0);
1752 }
1753 
1754 /*
1755  #] CmpArray :
1756  #[ ConWord :
1757 */
1758 
1759 int ConWord(UBYTE *s1, UBYTE *s2)
1760 {
1761  while ( *s1 && ( tolower(*s1) == tolower(*s2) ) ) { s1++; s2++; }
1762  if ( *s1 == 0 ) return(1);
1763  return(0);
1764 }
1765 
1766 /*
1767  #] ConWord :
1768  #[ StrLen :
1769 */
1770 
1771 int StrLen(UBYTE *s)
1772 {
1773  int i = 0;
1774  while ( *s ) { s++; i++; }
1775  return(i);
1776 }
1777 
1778 /*
1779  #] StrLen :
1780  #[ NumToStr :
1781 */
1782 
1783 VOID NumToStr(UBYTE *s, LONG x)
1784 {
1785  UBYTE *t, str[24];
1786  ULONG xx;
1787  t = str;
1788  if ( x < 0 ) { *s++ = '-'; xx = -x; }
1789  else xx = x;
1790  do {
1791  *t++ = xx % 10 + '0';
1792  xx /= 10;
1793  } while ( xx );
1794  while ( t > str ) *s++ = *--t;
1795  *s = 0;
1796 }
1797 
1798 /*
1799  #] NumToStr :
1800  #[ WriteString :
1801 
1802  Writes a characterstring to the various outputs.
1803  The action may depend on the flags involved.
1804  The type of output is given by type, the string by str and the
1805  number of characters in it by num
1806 */
1807 VOID WriteString(int type, UBYTE *str, int num)
1808 {
1809  int error = 0;
1810 
1811  if ( num > 0 && str[num-1] == 0 ) { num--; }
1812  else if ( num <= 0 || str[num-1] != LINEFEED ) {
1813  AddLineFeed(str,num);
1814  }
1815  /*[15apr2004 mt]:*/
1816  if(type == EXTERNALCHANNELOUT){
1817  if(WriteFile(0,str,num) != num) error = 1;
1818  }else
1819  /*:[15apr2004 mt]*/
1820  if ( AM.silent == 0 || type == ERROROUT ) {
1821  if ( type == INPUTOUT ) {
1822  if ( !AM.FileOnlyFlag && WriteFile(AM.StdOut,(UBYTE *)" ",4) != 4 ) error = 1;
1823  if ( AC.LogHandle >= 0 && WriteFile(AC.LogHandle,(UBYTE *)" ",4) != 4 ) error = 1;
1824  }
1825  if ( !AM.FileOnlyFlag && WriteFile(AM.StdOut,str,num) != num ) error = 1;
1826  if ( AC.LogHandle >= 0 && WriteFile(AC.LogHandle,str,num) != num ) error = 1;
1827  }
1828  if ( error ) Terminate(-1);
1829 }
1830 
1831 /*
1832  #] WriteString :
1833  #[ WriteUnfinString :
1834 
1835  Writes a characterstring to the various outputs.
1836  The action may depend on the flags involved.
1837  The type of output is given by type, the string by str and the
1838  number of characters in it by num
1839 */
1840 
1841 VOID WriteUnfinString(int type, UBYTE *str, int num)
1842 {
1843  int error = 0;
1844 
1845  /*[15apr2004 mt]:*/
1846  if(type == EXTERNALCHANNELOUT){
1847  if(WriteFile(0,str,num) != num) error = 1;
1848  }else
1849  /*:[15apr2004 mt]*/
1850  if ( AM.silent == 0 || type == ERROROUT ) {
1851  if ( type == INPUTOUT ) {
1852  if ( !AM.FileOnlyFlag && WriteFile(AM.StdOut,(UBYTE *)" ",4) != 4 ) error = 1;
1853  if ( AC.LogHandle >= 0 && WriteFile(AC.LogHandle,(UBYTE *)" ",4) != 4 ) error = 1;
1854  }
1855  if ( !AM.FileOnlyFlag && WriteFile(AM.StdOut,str,num) != num ) error = 1;
1856  if ( AC.LogHandle >= 0 && WriteFile(AC.LogHandle,str,num) != num ) error = 1;
1857  }
1858  if ( error ) Terminate(-1);
1859 }
1860 
1861 /*
1862  #] WriteUnfinString :
1863  #[ AddToString :
1864 */
1865 
1866 UBYTE *AddToString(UBYTE *outstring, UBYTE *extrastring, int par)
1867 {
1868  UBYTE *s = extrastring, *t, *newstring;
1869  int n, nn;
1870  while ( *s ) { s++; }
1871  n = s-extrastring;
1872  if ( outstring == 0 ) {
1873  s = extrastring;
1874  t = outstring = (UBYTE *)Malloc1(n+1,"AddToString");
1875  NCOPY(t,s,n)
1876  *t++ = 0;
1877  return(outstring);
1878  }
1879  else {
1880  t = outstring;
1881  while ( *t ) t++;
1882  nn = t - outstring;
1883  t = newstring = (UBYTE *)Malloc1(n+nn+2,"AddToString");
1884  s = outstring;
1885  NCOPY(t,s,nn)
1886  if ( par == 1 ) *t++ = ',';
1887  s = extrastring;
1888  NCOPY(t,s,n)
1889  *t = 0;
1890  M_free(outstring,"AddToString");
1891  return(newstring);
1892  }
1893 }
1894 
1895 /*
1896  #] AddToString :
1897  #[ strDup1 :
1898 
1899  string duplication with message passing for Malloc1, allowing
1900  this routine to give a more detailed error message if there
1901  is not enough memory.
1902 */
1903 
1904 UBYTE *strDup1(UBYTE *instring, char *ifwrong)
1905 {
1906  UBYTE *s = instring, *to;
1907  while ( *s ) s++;
1908  to = s = (UBYTE *)Malloc1((s-instring)+1,ifwrong);
1909  while ( *instring ) *to++ = *instring++;
1910  *to = 0;
1911  return(s);
1912 }
1913 
1914 /*
1915  #] strDup1 :
1916  #[ EndOfToken :
1917 */
1918 
1919 UBYTE *EndOfToken(UBYTE *s)
1920 {
1921  UBYTE c;
1922  while ( ( c = (UBYTE)(FG.cTable[*s]) ) == 0 || c == 1 ) s++;
1923  return(s);
1924 }
1925 
1926 /*
1927  #] EndOfToken :
1928  #[ ToToken :
1929 */
1930 
1931 UBYTE *ToToken(UBYTE *s)
1932 {
1933  UBYTE c;
1934  while ( *s && ( c = (UBYTE)(FG.cTable[*s]) ) != 0 && c != 1 ) s++;
1935  return(s);
1936 }
1937 
1938 /*
1939  #] ToToken :
1940  #[ SkipField :
1941 
1942  Skips from s to the end of a declaration field.
1943  par is the number of parentheses that still has to be closed.
1944 */
1945 
1946 UBYTE *SkipField(UBYTE *s, int level)
1947 {
1948  while ( *s ) {
1949  if ( *s == ',' && level == 0 ) return(s);
1950  if ( *s == '(' ) level++;
1951  else if ( *s == ')' ) { level--; if ( level < 0 ) level = 0; }
1952  else if ( *s == '[' ) {
1953  SKIPBRA1(s)
1954  }
1955  else if ( *s == '{' ) {
1956  SKIPBRA2(s)
1957  }
1958  s++;
1959  }
1960  return(s);
1961 }
1962 
1963 /*
1964  #] SkipField :
1965  #[ ReadSnum : WORD ReadSnum(p)
1966 
1967  Reads a number that should fit in a word.
1968  The number should be unsigned and a negative return value
1969  indicates an irregularity.
1970 
1971 */
1972 
1973 WORD ReadSnum(UBYTE **p)
1974 {
1975  LONG x = 0;
1976  UBYTE *s;
1977  s = *p;
1978  if ( FG.cTable[*s] == 1 ) {
1979  do {
1980  x = ( x << 3 ) + ( x << 1 ) + ( *s++ - '0' );
1981  if ( x > MAXPOSITIVE ) return(-1);
1982  } while ( FG.cTable[*s] == 1 );
1983  *p = s;
1984  return((WORD)x);
1985  }
1986  else return(-1);
1987 }
1988 
1989 /*
1990  #] ReadSnum :
1991  #[ NumCopy :
1992 
1993  Adds the decimal representation of a number to a string.
1994 
1995 */
1996 
1997 UBYTE *NumCopy(WORD y, UBYTE *to)
1998 {
1999  UBYTE *s;
2000  WORD i = 0, j;
2001  UWORD x;
2002  if ( y < 0 ) {
2003  *to++ = '-';
2004  }
2005  x = WordAbs(y);
2006  s = to;
2007  do { *s++ = (UBYTE)((x % 10)+'0'); i++; } while ( ( x /= 10 ) != 0 );
2008  *s-- = '\0';
2009  j = ( i - 1 ) >> 1;
2010  while ( j >= 0 ) {
2011  i = to[j]; to[j] = s[-j]; s[-j] = (UBYTE)i; j--;
2012  }
2013  return(s+1);
2014 }
2015 
2016 /*
2017  #] NumCopy :
2018  #[ LongCopy :
2019 
2020  Adds the decimal representation of a number to a string.
2021 
2022 */
2023 
2024 char *LongCopy(LONG y, char *to)
2025 {
2026  char *s;
2027  WORD i = 0, j;
2028  ULONG x;
2029  if ( y < 0 ) {
2030  *to++ = '-';
2031  }
2032  x = LongAbs(y);
2033  s = to;
2034  do { *s++ = (x % 10)+'0'; i++; } while ( ( x /= 10 ) != 0 );
2035  *s-- = '\0';
2036  j = ( i - 1 ) >> 1;
2037  while ( j >= 0 ) {
2038  i = to[j]; to[j] = s[-j]; s[-j] = (char)i; j--;
2039  }
2040  return(s+1);
2041 }
2042 
2043 /*
2044  #] LongCopy :
2045  #[ LongLongCopy :
2046 
2047  Adds the decimal representation of a number to a string.
2048  Bugfix feb 2003. y was not pointer!
2049 */
2050 
2051 char *LongLongCopy(off_t *y, char *to)
2052 {
2053  /*
2054  * This code fails to print the maximum negative value on systems with two's
2055  * complement. To fix this, we need the unsigned version of off_t with the
2056  * same size, but unfortunately it is undefined. On the other hand, if a
2057  * system is configured with a 64-bit off_t, in practice one never reaches
2058  * 2^63 ~ 10^18 as of 2016. If one really reach such a big number, then it
2059  * would be the time to move on a 128-bit off_t.
2060  */
2061  off_t x = *y;
2062  char *s;
2063  WORD i = 0, j;
2064  if ( x < 0 ) { x = -x; *to++ = '-'; }
2065  s = to;
2066  do { *s++ = (x % 10)+'0'; i++; } while ( ( x /= 10 ) != 0 );
2067  *s-- = '\0';
2068  j = ( i - 1 ) >> 1;
2069  while ( j >= 0 ) {
2070  i = to[j]; to[j] = s[-j]; s[-j] = (char)i; j--;
2071  }
2072  return(s+1);
2073 }
2074 
2075 /*
2076  #] LongLongCopy :
2077  #[ MakeDate :
2078 
2079  Routine produces a string with the date and time of the run
2080 */
2081 
2082 #ifdef ANSI
2083 #else
2084 #ifdef mBSD
2085 #else
2086 static char notime[] = "";
2087 #endif
2088 #endif
2089 
2090 UBYTE *MakeDate()
2091 {
2092 #ifdef ANSI
2093  time_t tp;
2094  time(&tp);
2095  return((UBYTE *)ctime(&tp));
2096 #else
2097 #ifdef mBSD
2098  time_t tp;
2099  time(&tp);
2100  return((UBYTE *)ctime(&tp));
2101 #else
2102  return((UBYTE *)notime);
2103 #endif
2104 #endif
2105 }
2106 
2107 /*
2108  #] MakeDate :
2109  #[ set_in :
2110  Returns 1 if ch is in set ; 0 if ch is not in set:
2111 */
2112 int set_in(UBYTE ch, set_of_char set)
2113 {
2114  set += ch/8;
2115  switch (ch % 8){
2116  case 0: return(set->bit_0);
2117  case 1: return(set->bit_1);
2118  case 2: return(set->bit_2);
2119  case 3: return(set->bit_3);
2120  case 4: return(set->bit_4);
2121  case 5: return(set->bit_5);
2122  case 6: return(set->bit_6);
2123  case 7: return(set->bit_7);
2124  }/*switch (ch % 8)*/
2125  return(-1);
2126 }/*set_in*/
2127 /*
2128  #] set_in :
2129  #[ set_set :
2130  sets ch into set; returns *set:
2131 */
2132 one_byte set_set(UBYTE ch, set_of_char set)
2133 {
2134  one_byte tmp=(one_byte)set;
2135  set += ch/8;
2136  switch (ch % 8){
2137  case 0: set->bit_0=1;break;
2138  case 1: set->bit_1=1;break;
2139  case 2: set->bit_2=1;break;
2140  case 3: set->bit_3=1;break;
2141  case 4: set->bit_4=1;break;
2142  case 5: set->bit_5=1;break;
2143  case 6: set->bit_6=1;break;
2144  case 7: set->bit_7=1;break;
2145  }
2146  return(tmp);
2147 }/*set_set*/
2148 /*
2149  #] set_set :
2150  #[ set_del :
2151  deletes ch from set; returns *set:
2152 */
2153 one_byte set_del(UBYTE ch, set_of_char set)
2154 {
2155  one_byte tmp=(one_byte)set;
2156  set += ch/8;
2157  switch (ch % 8){
2158  case 0: set->bit_0=0;break;
2159  case 1: set->bit_1=0;break;
2160  case 2: set->bit_2=0;break;
2161  case 3: set->bit_3=0;break;
2162  case 4: set->bit_4=0;break;
2163  case 5: set->bit_5=0;break;
2164  case 6: set->bit_6=0;break;
2165  case 7: set->bit_7=0;break;
2166  }
2167  return(tmp);
2168 }/*set_del*/
2169 /*
2170  #] set_del :
2171  #[ set_sub :
2172  returns *set = set1\set2. This function may be usd for initialising,
2173  set_sub(a,a,a) => now a is empty set :
2174 */
2175 one_byte set_sub(set_of_char set, set_of_char set1, set_of_char set2)
2176 {
2177  one_byte tmp=(one_byte)set;
2178  int i=0,j=0;
2179  while(j=0,i++<32)
2180  while(j<9)
2181  switch (j++){
2182  case 0: set->bit_0=(set1->bit_0&&(!set2->bit_0));break;
2183  case 1: set->bit_1=(set1->bit_1&&(!set2->bit_1));break;
2184  case 2: set->bit_2=(set1->bit_2&&(!set2->bit_2));break;
2185  case 3: set->bit_3=(set1->bit_3&&(!set2->bit_3));break;
2186  case 4: set->bit_4=(set1->bit_4&&(!set2->bit_4));break;
2187  case 5: set->bit_5=(set1->bit_5&&(!set2->bit_5));break;
2188  case 6: set->bit_6=(set1->bit_6&&(!set2->bit_6));break;
2189  case 7: set->bit_7=(set1->bit_7&&(!set2->bit_7));break;
2190  case 8: set++;set1++;set2++;
2191  };
2192  return(tmp);
2193 }/*set_sub*/
2194 /*
2195  #] set_sub :
2196  #] Strings :
2197  #[ Mixed :
2198  #[ iniTools :
2199 */
2200 
2201 VOID iniTools(VOID)
2202 {
2203 #ifdef MALLOCPROTECT
2204  if ( mprotectInit() ) exit(0);
2205 #endif
2206  return;
2207 }
2208 
2209 /*
2210  #] iniTools :
2211  #[ Malloc :
2212 
2213  Malloc routine with built in error checking.
2214  This saves lots of messages.
2215 */
2216 #ifdef MALLOCDEBUG
2217 char *dummymessage = "Malloc";
2218 INILOCK(MallocLock)
2219 #endif
2220 
2221 VOID *Malloc(LONG size)
2222 {
2223  VOID *mem;
2224 #ifdef MALLOCDEBUG
2225  char *t, *u;
2226  int i;
2227  LOCK(MallocLock);
2228 /* MLOCK(ErrorMessageLock); */
2229  if ( size == 0 ) {
2230  MesPrint("Asking for 0 bytes in Malloc");
2231  }
2232 #endif
2233  if ( ( size & 7 ) != 0 ) { size = size - ( size&7 ) + 8; }
2234 #ifdef MALLOCDEBUG
2235  size += 2*BANNER;
2236 #endif
2237  mem = (VOID *)M_alloc(size);
2238  if ( mem == 0 ) {
2239 #ifndef MALLOCDEBUG
2240  MLOCK(ErrorMessageLock);
2241 #endif
2242  Error0("No memory!");
2243 #ifndef MALLOCDEBUG
2244  MUNLOCK(ErrorMessageLock);
2245 #else
2246 /* MUNLOCK(ErrorMessageLock); */
2247 #endif
2248 #ifdef MALLOCDEBUG
2249  UNLOCK(MallocLock);
2250 #endif
2251  Terminate(-1);
2252  }
2253 #ifdef MALLOCDEBUG
2254  mallocsizes[nummalloclist] = size;
2255  mallocstrings[nummalloclist] = dummymessage;
2256  malloclist[nummalloclist++] = mem;
2257  if ( filelist ) MesPrint("Mem0 at 0x%x, %l bytes",mem,size);
2258  {
2259  int i = nummalloclist-1;
2260  while ( --i >= 0 ) {
2261  if ( (char *)mem < (((char *)malloclist[i]) + mallocsizes[i])
2262  && (char *)(malloclist[i]) < ((char *)mem + size) ) {
2263  if ( filelist ) MesPrint("This memory overlaps with the block at 0x%x"
2264  ,malloclist[i]);
2265  }
2266  }
2267  }
2268  t = (char *)mem;
2269  u = t + size;
2270  for ( i = 0; i < (int)BANNER; i++ ) { *t++ = FILLVALUE; *--u = FILLVALUE; }
2271  mem = (void *)t;
2272  {
2273  int j = nummalloclist-1, i;
2274  while ( --j >= 0 ) {
2275  t = (char *)(malloclist[j]);
2276  u = t + mallocsizes[j];
2277  for ( i = 0; i < (int)BANNER; i++ ) {
2278  u--;
2279  if ( *t != FILLVALUE || *u != FILLVALUE ) {
2280  MesPrint("Writing outside memory for %s",malloclist[i]);
2281 /* MUNLOCK(ErrorMessageLock); */
2282  UNLOCK(MallocLock);
2283  Terminate(-1);
2284  }
2285  t--;
2286  }
2287  }
2288  }
2289 /* MUNLOCK(ErrorMessageLock); */
2290  UNLOCK(MallocLock);
2291 #endif
2292  return(mem);
2293 }
2294 
2295 /*
2296  #] Malloc :
2297  #[ Malloc1 :
2298 
2299  Malloc with more detailed error message.
2300  Gives the user some idea of what is happening.
2301 */
2302 
2303 VOID *Malloc1(LONG size, const char *messageifwrong)
2304 {
2305  VOID *mem;
2306 #ifdef MALLOCDEBUG
2307  char *t, *u;
2308  int i;
2309  LOCK(MallocLock);
2310 /* MLOCK(ErrorMessageLock); */
2311  if ( size == 0 ) {
2312  MesPrint("%wAsking for 0 bytes in Malloc1");
2313  }
2314 #endif
2315 #ifdef WITHSTATS
2316  nummallocs++;
2317 #endif
2318  if ( ( size & 7 ) != 0 ) { size = size - ( size&7 ) + 8; }
2319 #ifdef MALLOCDEBUG
2320  size += 2*BANNER;
2321 #endif
2322  mem = (VOID *)M_alloc(size);
2323  if ( mem == 0 ) {
2324 #ifndef MALLOCDEBUG
2325  MLOCK(ErrorMessageLock);
2326 #endif
2327  Error1("No memory while allocating ",(UBYTE *)messageifwrong);
2328 #ifndef MALLOCDEBUG
2329  MUNLOCK(ErrorMessageLock);
2330 #else
2331 /* MUNLOCK(ErrorMessageLock); */
2332 #endif
2333 #ifdef MALLOCDEBUG
2334  UNLOCK(MallocLock);
2335 #endif
2336  Terminate(-1);
2337  }
2338 #ifdef MALLOCDEBUG
2339  mallocsizes[nummalloclist] = size;
2340  mallocstrings[nummalloclist] = (char *)messageifwrong;
2341  malloclist[nummalloclist++] = mem;
2342  if ( AC.MemDebugFlag && filelist ) MesPrint("%wMem1 at 0x%x: %l bytes. %s",mem,size,messageifwrong);
2343  {
2344  int i = nummalloclist-1;
2345  while ( --i >= 0 ) {
2346  if ( (char *)mem < (((char *)malloclist[i]) + mallocsizes[i])
2347  && (char *)(malloclist[i]) < ((char *)mem + size) ) {
2348  if ( filelist ) MesPrint("This memory overlaps with the block at 0x%x"
2349  ,malloclist[i]);
2350  }
2351  }
2352  }
2353 
2354 #ifdef MALLOCDEBUGOUTPUT
2355  printf ("Malloc1: %s, allocated %li bytes at %.8lx\n",messageifwrong,size,(unsigned long)mem);
2356  fflush (stdout);
2357 #endif
2358 
2359  t = (char *)mem;
2360  u = t + size;
2361  for ( i = 0; i < (int)BANNER; i++ ) { *t++ = FILLVALUE; *--u = FILLVALUE; }
2362  mem = (void *)t;
2363  M_check();
2364 /* MUNLOCK(ErrorMessageLock); */
2365  UNLOCK(MallocLock);
2366 #endif
2367 /*
2368  if ( size > 500000000L ) {
2369  MLOCK(ErrorMessageLock);
2370  MesPrint("Malloc1: %s, allocated %l bytes\n",messageifwrong,size);
2371  MUNLOCK(ErrorMessageLock);
2372  }
2373 */
2374  return(mem);
2375 }
2376 
2377 /*
2378  #] Malloc1 :
2379  #[ M_free :
2380 */
2381 
2382 void M_free(VOID *x, const char *where)
2383 {
2384 #ifdef MALLOCDEBUG
2385  char *t = (char *)x;
2386  int i, j, k;
2387  LONG size = 0;
2388  x = (void *)(((char *)x)-BANNER);
2389 /* MLOCK(ErrorMessageLock); */
2390  if ( AC.MemDebugFlag ) MesPrint("%wFreeing 0x%x: %s",x,where);
2391  LOCK(MallocLock);
2392  for ( i = nummalloclist-1; i >= 0; i-- ) {
2393  if ( x == malloclist[i] ) {
2394  size = mallocsizes[i];
2395  for ( j = i+1; j < nummalloclist; j++ ) {
2396  malloclist[j-1] = malloclist[j];
2397  mallocsizes[j-1] = mallocsizes[j];
2398  mallocstrings[j-1] = mallocstrings[j];
2399  }
2400  nummalloclist--;
2401  break;
2402  }
2403  }
2404  if ( i < 0 ) {
2405  unsigned int xx = ((ULONG)x);
2406  printf("Error returning non-allocated address: 0x%x from %s\n"
2407  ,xx,where);
2408 /* MUNLOCK(ErrorMessageLock); */
2409  UNLOCK(MallocLock);
2410  exit(-1);
2411  }
2412  else {
2413  for ( k = 0, j = 0; k < (int)BANNER; k++ ) {
2414  if ( *--t != FILLVALUE ) j++;
2415  }
2416  if ( j ) {
2417  LONG *tt = (LONG *)x;
2418  MesPrint("%w!!!!! Banner has been written in !!!!!: %x %x %x %x",
2419  tt[0],tt[1],tt[2],tt[3]);
2420  }
2421  t += size;
2422  for ( k = 0, j = 0; k < (int)BANNER; k++ ) {
2423  if ( *--t != FILLVALUE ) j++;
2424  }
2425  if ( j ) {
2426  LONG *tt = (LONG *)x;
2427  MesPrint("%w!!!!! Tail has been written in !!!!!: %x %x %x %x",
2428  tt[0],tt[1],tt[2],tt[3]);
2429  }
2430  M_check();
2431 /* MUNLOCK(ErrorMessageLock); */
2432  UNLOCK(MallocLock);
2433  }
2434 #else
2435  DUMMYUSE(where);
2436 #endif
2437 #ifdef WITHSTATS
2438  numfrees++;
2439 #endif
2440  if ( x ) {
2441 #ifdef MALLOCDEBUGOUTPUT
2442  printf ("M_free: %s, memory freed at %.8lx\n",where,(unsigned long)x);
2443  fflush(stdout);
2444 #endif
2445 
2446 #ifdef MALLOCPROTECT
2447  mprotectFree((void *)x);
2448 #else
2449  free(x);
2450 #endif
2451  }
2452 }
2453 
2454 /*
2455  #] M_free :
2456  #[ M_check :
2457 */
2458 
2459 #ifdef MALLOCDEBUG
2460 
2461 void M_check1() { MesPrint("Checking Malloc"); M_check(); }
2462 
2463 void M_check()
2464 {
2465  int i,j,k,error = 0;
2466  char *t;
2467  LONG *tt;
2468  for ( i = 0; i < nummalloclist; i++ ) {
2469  t = (char *)(malloclist[i]);
2470  for ( k = 0, j = 0; k < (int)BANNER; k++ ) {
2471  if ( *t++ != FILLVALUE ) j++;
2472  }
2473  if ( j ) {
2474  tt = (LONG *)(malloclist[i]);
2475  MesPrint("%w!!!!! Banner %d (%s) has been written in !!!!!: %x %x %x %x",
2476  i,mallocstrings[i],tt[0],tt[1],tt[2],tt[3]);
2477  tt[0] = tt[1] = tt[2] = tt[3] = 0;
2478  error = 1;
2479  }
2480  t = (char *)(malloclist[i]) + mallocsizes[i];
2481  for ( k = 0, j = 0; k < (int)BANNER; k++ ) {
2482  if ( *--t != FILLVALUE ) j++;
2483  }
2484  if ( j ) {
2485  tt = (LONG *)t;
2486  MesPrint("%w!!!!! Tail %d (%s) has been written in !!!!!: %x %x %x %x",
2487  i,mallocstrings[i],tt[0],tt[1],tt[2],tt[3]);
2488  tt[0] = tt[1] = tt[2] = tt[3] = 0;
2489  error = 1;
2490  }
2491  if ( ( mallocstrings[i][0] == ' ' ) || ( mallocstrings[i][0] == '#' ) ) {
2492  MesPrint("%w!!!!! Funny mallocstring");
2493  error = 1;
2494  }
2495  }
2496  if ( error ) {
2497  M_print();
2498 /* MUNLOCK(ErrorMessageLock); */
2499  UNLOCK(MallocLock);
2500  Terminate(-1);
2501  }
2502 }
2503 
2504 void M_print()
2505 {
2506  int i;
2507  MesPrint("We have the following memory allocations left:");
2508  for ( i = 0; i < nummalloclist; i++ ) {
2509  MesPrint("0x%x: %l bytes. number %d: '%s'",malloclist[i],mallocsizes[i],i,mallocstrings[i]);
2510  }
2511 }
2512 
2513 #else
2514 
2515 void M_check1() {}
2516 void M_print() {}
2517 
2518 #endif
2519 
2520 /*
2521  #] M_check :
2522  #[ TermMalloc :
2523 */
2546 #define TERMMEMSTARTNUM 16
2547 #define TERMEXTRAWORDS 10
2548 
2549 VOID TermMallocAddMemory(PHEAD0)
2550 {
2551  WORD *newbufs;
2552  int i, extra;
2553  if ( AT.TermMemMax == 0 ) extra = TERMMEMSTARTNUM;
2554  else extra = AT.TermMemMax;
2555  if ( AT.TermMemHeap ) M_free(AT.TermMemHeap,"TermMalloc");
2556  newbufs = (WORD *)Malloc1(extra*(AM.MaxTer+TERMEXTRAWORDS*sizeof(WORD)),"TermMalloc");
2557  AT.TermMemHeap = (WORD **)Malloc1((extra+AT.TermMemMax)*sizeof(WORD *),"TermMalloc");
2558  for ( i = 0; i < extra; i++ ) {
2559  AT.TermMemHeap[i] = newbufs + i*(AM.MaxTer/sizeof(WORD)+TERMEXTRAWORDS);
2560  }
2561 #ifdef TERMMALLOCDEBUG
2562  DebugHeap2 = (WORD **)Malloc1((extra+AT.TermMemMax)*sizeof(WORD *),"TermMalloc");
2563  for ( i = 0; i < AT.TermMemMax; i++ ) { DebugHeap2[i] = DebugHeap1[i]; }
2564  for ( i = 0; i < extra; i++ ) {
2565  DebugHeap2[i+AT.TermMemMax] = newbufs + i*(AM.MaxTer/sizeof(WORD)+TERMEXTRAWORDS);
2566  }
2567  if ( DebugHeap1 ) M_free(DebugHeap1,"TermMalloc");
2568  DebugHeap1 = DebugHeap2;
2569 #endif
2570  AT.TermMemTop = extra;
2571  AT.TermMemMax += extra;
2572 #ifdef TERMMALLOCDEBUG
2573  MesPrint("AT.TermMemMax is now %l",AT.TermMemMax);
2574 #endif
2575 }
2576 
2577 #ifndef MEMORYMACROS
2578 
2579 WORD *TermMalloc2(PHEAD char *text)
2580 {
2581  if ( AT.TermMemTop <= 0 ) TermMallocAddMemory(BHEAD0);
2582 
2583 #ifdef TERMMALLOCDEBUG
2584  MesPrint("TermMalloc: %s, %d",text,(AT.TermMemMax-AT.TermMemTop));
2585 #endif
2586 
2587 #ifdef MALLOCDEBUGOUTPUT
2588  MesPrint("TermMalloc: %s, %l/%l (%x)",text,AT.TermMemTop,AT.TermMemMax,AT.TermMemHeap[AT.TermMemTop-1]);
2589 #endif
2590 
2591  DUMMYUSE(text);
2592  return(AT.TermMemHeap[--AT.TermMemTop]);
2593 }
2594 
2595 VOID TermFree2(PHEAD WORD *TermMem, char *text)
2596 {
2597 #ifdef TERMMALLOCDEBUG
2598 
2599  int i;
2600 
2601  for ( i = 0; i < AT.TermMemMax; i++ ) {
2602  if ( TermMem == DebugHeap1[i] ) break;
2603  }
2604  if ( i >= AT.TermMemMax ) {
2605  MesPrint(" ERROR: TermFree called with an address not given by TermMalloc.");
2606  Terminate(-1);
2607  }
2608 #endif
2609  DUMMYUSE(text);
2610  AT.TermMemHeap[AT.TermMemTop++] = TermMem;
2611 
2612 #ifdef TERMMALLOCDEBUG
2613  MesPrint("TermFree: %s, %d",text,(AT.TermMemMax-AT.TermMemTop));
2614 #endif
2615 #ifdef MALLOCDEBUGOUTPUT
2616  MesPrint("TermFree: %s, %l/%l (%x)",text,AT.TermMemTop,AT.TermMemMax,TermMem);
2617 #endif
2618 }
2619 
2620 #endif
2621 
2622 /*
2623  #] TermMalloc :
2624  #[ NumberMalloc :
2625 */
2646 #define NUMBERMEMSTARTNUM 16
2647 #define NUMBEREXTRAWORDS 10L
2648 
2649 #ifdef TERMMALLOCDEBUG
2650 UWORD **DebugHeap3, **DebugHeap4;
2651 #endif
2652 
2653 VOID NumberMallocAddMemory(PHEAD0)
2654 {
2655  UWORD *newbufs;
2656  WORD extra;
2657  int i;
2658  if ( AT.NumberMemMax == 0 ) extra = NUMBERMEMSTARTNUM;
2659  else extra = AT.NumberMemMax;
2660  if ( AT.NumberMemHeap ) M_free(AT.NumberMemHeap,"NumberMalloc");
2661  newbufs = (UWORD *)Malloc1(extra*(AM.MaxTal+NUMBEREXTRAWORDS)*sizeof(UWORD),"NumberMalloc");
2662  AT.NumberMemHeap = (UWORD **)Malloc1((extra+AT.NumberMemMax)*sizeof(UWORD *),"NumberMalloc");
2663  for ( i = 0; i < extra; i++ ) {
2664  AT.NumberMemHeap[i] = newbufs + i*(LONG)(AM.MaxTal+NUMBEREXTRAWORDS);
2665  }
2666 #ifdef TERMMALLOCDEBUG
2667  DebugHeap4 = (UWORD **)Malloc1((extra+AT.NumberMemMax)*sizeof(WORD *),"NumberMalloc");
2668  for ( i = 0; i < AT.NumberMemMax; i++ ) { DebugHeap4[i] = DebugHeap3[i]; }
2669  for ( i = 0; i < extra; i++ ) {
2670  DebugHeap4[i+AT.NumberMemMax] = newbufs + i*(LONG)(AM.MaxTal+NUMBEREXTRAWORDS);
2671  }
2672  if ( DebugHeap3 ) M_free(DebugHeap3,"NumberMalloc");
2673  DebugHeap3 = DebugHeap4;
2674 #endif
2675  AT.NumberMemTop = extra;
2676  AT.NumberMemMax += extra;
2677 /*
2678 MesPrint("AT.NumberMemMax is now %l",AT.NumberMemMax);
2679 */
2680 }
2681 
2682 #ifndef MEMORYMACROS
2683 
2684 UWORD *NumberMalloc2(PHEAD char *text)
2685 {
2686  if ( AT.NumberMemTop <= 0 ) NumberMallocAddMemory(BHEAD text);
2687 
2688 #ifdef MALLOCDEBUGOUTPUT
2689  if ( (AT.NumberMemMax-AT.NumberMemTop) > 10 )
2690  MesPrint("NumberMalloc: %s, %l/%l (%x)",text,AT.NumberMemTop,AT.NumberMemMax,AT.NumberMemHeap[AT.NumberMemTop-1]);
2691 #endif
2692 
2693  DUMMYUSE(text);
2694  return(AT.NumberMemHeap[--AT.NumberMemTop]);
2695 }
2696 
2697 VOID NumberFree2(PHEAD UWORD *NumberMem, char *text)
2698 {
2699 #ifdef TERMMALLOCDEBUG
2700  int i;
2701  for ( i = 0; i < AT.NumberMemMax; i++ ) {
2702  if ( NumberMem == DebugHeap3[i] ) break;
2703  }
2704  if ( i >= AT.NumberMemMax ) {
2705  MesPrint(" ERROR: NumberFree called with an address not given by NumberMalloc.");
2706  Terminate(-1);
2707  }
2708 #endif
2709  DUMMYUSE(text);
2710  AT.NumberMemHeap[AT.NumberMemTop++] = NumberMem;
2711 
2712 #ifdef MALLOCDEBUGOUTPUT
2713  if ( (AT.NumberMemMax-AT.NumberMemTop) > 10 )
2714  MesPrint("NumberFree: %s, %l/%l (%x)",text,AT.NumberMemTop,AT.NumberMemMax,NumberMem);
2715 #endif
2716 }
2717 
2718 #endif
2719 
2720 /*
2721  #] NumberMalloc :
2722  #[ CacheNumberMalloc :
2723 
2724  Similar to NumberMalloc
2725  */
2726 
2727 VOID CacheNumberMallocAddMemory(PHEAD0)
2728 {
2729  UWORD *newbufs;
2730  WORD extra;
2731  int i;
2732  if ( AT.CacheNumberMemMax == 0 ) extra = NUMBERMEMSTARTNUM;
2733  else extra = AT.CacheNumberMemMax;
2734  if ( AT.CacheNumberMemHeap ) M_free(AT.CacheNumberMemHeap,"NumberMalloc");
2735  newbufs = (UWORD *)Malloc1(extra*(AM.MaxTal+NUMBEREXTRAWORDS)*sizeof(UWORD),"CacheNumberMalloc");
2736  AT.CacheNumberMemHeap = (UWORD **)Malloc1((extra+AT.NumberMemMax)*sizeof(UWORD *),"CacheNumberMalloc");
2737  for ( i = 0; i < extra; i++ ) {
2738  AT.CacheNumberMemHeap[i] = newbufs + i*(LONG)(AM.MaxTal+NUMBEREXTRAWORDS);
2739  }
2740  AT.CacheNumberMemTop = extra;
2741  AT.CacheNumberMemMax += extra;
2742 }
2743 
2744 #ifndef MEMORYMACROS
2745 
2746 UWORD *CacheNumberMalloc2(PHEAD char *text)
2747 {
2748  if ( AT.CacheNumberMemTop <= 0 ) CacheNumberMallocAddMemory(BHEAD0);
2749 
2750 #ifdef MALLOCDEBUGOUTPUT
2751  MesPrint("NumberMalloc: %s, %l/%l (%x)",text,AT.NumberMemTop,AT.NumberMemMax,AT.NumberMemHeap[AT.NumberMemTop-1]);
2752 #endif
2753 
2754  DUMMYUSE(text);
2755  return(AT.CacheNumberMemHeap[--AT.CacheNumberMemTop]);
2756 }
2757 
2758 VOID CacheNumberFree2(PHEAD UWORD *NumberMem, char *text)
2759 {
2760  DUMMYUSE(text);
2761  AT.CacheNumberMemHeap[AT.CacheNumberMemTop++] = NumberMem;
2762 
2763 #ifdef MALLOCDEBUGOUTPUT
2764  MesPrint("NumberFree: %s, %l/%l (%x)",text,AT.NumberMemTop,AT.NumberMemMax,NumberMem);
2765 #endif
2766 }
2767 
2768 #endif
2769 
2770 /*
2771  #] CacheNumberMalloc :
2772  #[ FromList :
2773 
2774  Returns the next object in a list.
2775  If the list has been exhausted we double it (like a realloc)
2776  If the list has not been initialized yet we start with 10 elements.
2777 */
2778 
2779 VOID *FromList(LIST *L)
2780 {
2781  void *newlist;
2782  int i, *old, *newL;
2783  if ( L->num >= L->maxnum || L->lijst == 0 ) {
2784  if ( L->maxnum == 0 ) L->maxnum = 12;
2785  else if ( L->lijst ) L->maxnum *= 2;
2786  newlist = Malloc1(L->maxnum * L->size,L->message);
2787  if ( L->lijst ) {
2788  i = ( L->num * L->size ) / sizeof(int);
2789  old = (int *)L->lijst; newL = (int *)newlist;
2790  while ( --i >= 0 ) *newL++ = *old++;
2791  if ( L->lijst ) M_free(L->lijst,"L->lijst FromList");
2792  }
2793  L->lijst = newlist;
2794  }
2795  return( ((char *)(L->lijst)) + L->size * (L->num)++ );
2796 }
2797 
2798 /*
2799  #] FromList :
2800  #[ From0List :
2801 
2802  Same as FromList, but we zero excess variables.
2803 */
2804 
2805 VOID *From0List(LIST *L)
2806 {
2807  void *newlist;
2808  int i, *old, *newL;
2809  if ( L->num >= L->maxnum || L->lijst == 0 ) {
2810  if ( L->maxnum == 0 ) L->maxnum = 12;
2811  else if ( L->lijst ) L->maxnum *= 2;
2812  newlist = Malloc1(L->maxnum * L->size,L->message);
2813  i = ( L->num * L->size ) / sizeof(int);
2814  old = (int *)(L->lijst); newL = (int *)newlist;
2815  while ( --i >= 0 ) *newL++ = *old++;
2816  i = ( L->maxnum - L->num ) / sizeof(int);
2817  while ( --i >= 0 ) *newL++ = 0;
2818  if ( L->lijst ) M_free(L->lijst,"L->lijst From0List");
2819  L->lijst = newlist;
2820  }
2821  return( ((char *)(L->lijst)) + L->size * (L->num)++ );
2822 }
2823 
2824 /*
2825  #] From0List :
2826  #[ FromVarList :
2827 
2828  Returns the next object in a list of variables.
2829  If the list has been exhausted we double it (like a realloc)
2830  If the list has not been initialized yet we start with 10 elements.
2831  We allow at most MAXVARIABLES elements!
2832 */
2833 
2834 VOID *FromVarList(LIST *L)
2835 {
2836  void *newlist;
2837  int i, *old, *newL;
2838  if ( L->num >= L->maxnum || L->lijst == 0 ) {
2839  if ( L->maxnum == 0 ) L->maxnum = 12;
2840  else if ( L->lijst ) {
2841  L->maxnum *= 2;
2842  if ( L == &(AP.DollarList) ) {
2843  if ( L->maxnum > MAXDOLLARVARIABLES ) L->maxnum = MAXDOLLARVARIABLES;
2844  if ( L->num >= MAXDOLLARVARIABLES ) {
2845  MesPrint("!!!More than %l objects in list of $-variables",
2846  MAXDOLLARVARIABLES);
2847  Terminate(-1);
2848  }
2849  }
2850  else {
2851  if ( L->maxnum > MAXVARIABLES ) L->maxnum = MAXVARIABLES;
2852  if ( L->num >= MAXVARIABLES ) {
2853  MesPrint("!!!More than %l objects in list of variables",
2854  MAXVARIABLES);
2855  Terminate(-1);
2856  }
2857  }
2858  }
2859  newlist = Malloc1(L->maxnum * L->size,L->message);
2860  if ( L->lijst ) {
2861  i = ( L->num * L->size ) / sizeof(int);
2862  old = (int *)(L->lijst); newL = (int *)newlist;
2863  while ( --i >= 0 ) *newL++ = *old++;
2864  if ( L->lijst ) M_free(L->lijst,"L->lijst from VarList");
2865  }
2866  L->lijst = newlist;
2867  }
2868  return( ((char *)(L->lijst)) + L->size * ((L->num)++) );
2869 }
2870 
2871 /*
2872  #] FromVarList :
2873  #[ DoubleList :
2874 */
2875 
2876 int DoubleList(VOID ***lijst, int *oldsize, int objectsize, char *nameoftype)
2877 {
2878  VOID **newlist;
2879  LONG i, newsize, fullsize;
2880  VOID **to, **from;
2881  static LONG maxlistsize = (LONG)(MAXPOSITIVE);
2882  if ( *lijst == 0 ) {
2883  if ( *oldsize > 0 ) newsize = *oldsize;
2884  else newsize = 100;
2885  }
2886  else newsize = *oldsize * 2;
2887  if ( newsize > maxlistsize ) {
2888  if ( *oldsize == maxlistsize ) {
2889  MesPrint("No memory for extra space in %s",nameoftype);
2890  return(-1);
2891  }
2892  newsize = maxlistsize;
2893  }
2894  fullsize = ( newsize * objectsize + sizeof(VOID *)-1 ) & (-sizeof(VOID *));
2895  newlist = (VOID **)Malloc1(fullsize,nameoftype);
2896  if ( *lijst ) { /* Now some punning. DANGEROUS CODE in principle */
2897  to = newlist; from = *lijst; i = (*oldsize * objectsize)/sizeof(VOID *);
2898 /*
2899 #ifdef MALLOCDEBUG
2900 if ( filelist ) MesPrint(" oldsize: %l, objectsize: %d, fullsize: %l"
2901  ,*oldsize,objectsize,fullsize);
2902 #endif
2903 */
2904  while ( --i >= 0 ) *to++ = *from++;
2905  }
2906  if ( *lijst ) M_free(*lijst,"DoubleLList");
2907  *lijst = newlist;
2908  *oldsize = newsize;
2909  return(0);
2910 /*
2911  int error;
2912  LONG lsize = *oldsize;
2913 
2914  maxlistsize = (LONG)(MAXPOSITIVE);
2915  error = DoubleLList(lijst,&lsize,objectsize,nameoftype);
2916  *oldsize = lsize;
2917  maxlistsize = (LONG)(MAXLONG);
2918 
2919  return(error);
2920 */
2921 }
2922 
2923 /*
2924  #] DoubleList :
2925  #[ DoubleLList :
2926 */
2927 
2928 int DoubleLList(VOID ***lijst, LONG *oldsize, int objectsize, char *nameoftype)
2929 {
2930  VOID **newlist;
2931  LONG i, newsize, fullsize;
2932  VOID **to, **from;
2933  static LONG maxlistsize = (LONG)(MAXLONG);
2934  if ( *lijst == 0 ) {
2935  if ( *oldsize > 0 ) newsize = *oldsize;
2936  else newsize = 100;
2937  }
2938  else newsize = *oldsize * 2;
2939  if ( newsize > maxlistsize ) {
2940  if ( *oldsize == maxlistsize ) {
2941  MesPrint("No memory for extra space in %s",nameoftype);
2942  return(-1);
2943  }
2944  newsize = maxlistsize;
2945  }
2946  fullsize = ( newsize * objectsize + sizeof(VOID *)-1 ) & (-sizeof(VOID *));
2947  newlist = (VOID **)Malloc1(fullsize,nameoftype);
2948  if ( *lijst ) { /* Now some punning. DANGEROUS CODE in principle */
2949  to = newlist; from = *lijst; i = (*oldsize * objectsize)/sizeof(VOID *);
2950 /*
2951 #ifdef MALLOCDEBUG
2952 if ( filelist ) MesPrint(" oldsize: %l, objectsize: %d, fullsize: %l"
2953  ,*oldsize,objectsize,fullsize);
2954 #endif
2955 */
2956  while ( --i >= 0 ) *to++ = *from++;
2957  }
2958  if ( *lijst ) M_free(*lijst,"DoubleLList");
2959  *lijst = newlist;
2960  *oldsize = newsize;
2961  return(0);
2962 }
2963 
2964 /*
2965  #] DoubleLList :
2966  #[ DoubleBuffer :
2967 */
2968 
2969 #define DODOUBLE(x) { x *s, *t, *u; if ( *start ) { \
2970  oldsize = *(x **)stop - *(x **)start; newsize = 2*oldsize; \
2971  t = u = (x *)Malloc1(newsize*sizeof(x),text); s = *(x **)start; \
2972  for ( i = 0; i < oldsize; i++ ) *t++ = *s++; M_free(*start,"double"); } \
2973  else { newsize = 100; u = (x *)Malloc1(newsize*sizeof(x),text); } \
2974  *start = (void *)u; *stop = (void *)(u+newsize); }
2975 
2976 void DoubleBuffer(void **start, void **stop, int size, char *text)
2977 {
2978  LONG oldsize, newsize, i;
2979  if ( size == sizeof(char) ) DODOUBLE(char)
2980  else if ( size == sizeof(short) ) DODOUBLE(short)
2981  else if ( size == sizeof(int) ) DODOUBLE(int)
2982  else if ( size == sizeof(LONG) ) DODOUBLE(LONG)
2983  else if ( size % sizeof(int) == 0 ) DODOUBLE(int)
2984  else {
2985  MesPrint("---Cannot handle doubling buffers of size %d",size);
2986  Terminate(-1);
2987  }
2988 }
2989 
2990 /*
2991  #] DoubleBuffer :
2992  #[ ExpandBuffer :
2993 */
2994 
2995 #define DOEXPAND(x) { x *newbuffer, *t, *m; \
2996  t = newbuffer = (x *)Malloc1((newsize+2)*type,"ExpandBuffer"); \
2997  if ( *buffer ) { m = (x *)*buffer; i = *oldsize; \
2998  while ( --i >= 0 ) *t++ = *m++; M_free(*buffer,"ExpandBuffer"); \
2999  } *buffer = newbuffer; *oldsize = newsize; }
3000 
3001 void ExpandBuffer(void **buffer, LONG *oldsize, int type)
3002 {
3003  LONG newsize, i;
3004  if ( *oldsize <= 0 ) { newsize = 100; }
3005  else newsize = 2*(*oldsize);
3006  if ( type == sizeof(char) ) DOEXPAND(char)
3007  else if ( type == sizeof(short) ) DOEXPAND(short)
3008  else if ( type == sizeof(int) ) DOEXPAND(int)
3009  else if ( type == sizeof(LONG) ) DOEXPAND(LONG)
3010  else if ( type == sizeof(POSITION) ) DOEXPAND(POSITION)
3011  else {
3012  MesPrint("---Cannot handle expanding buffers with objects of size %d",type);
3013  Terminate(-1);
3014  }
3015 }
3016 
3017 /*
3018  #] ExpandBuffer :
3019  #[ iexp :
3020 
3021  Raises the long integer y to the power p.
3022  Returnvalue is long, regardless of overflow.
3023 */
3024 
3025 LONG iexp(LONG x, int p)
3026 {
3027  int sign;
3028  ULONG y;
3029  ULONG ux;
3030  if ( x == 0 ) return(0);
3031  if ( p == 0 ) return(1);
3032  sign = x < 0 ? -1 : 1;
3033  if ( sign < 0 && ( p & 1 ) == 0 ) sign = 1;
3034  ux = LongAbs(x);
3035  if ( ux == 1 ) return(sign);
3036  if ( p < 0 ) return(0);
3037  y = 1;
3038  while ( p ) {
3039  if ( ( p & 1 ) != 0 ) y *= ux;
3040  p >>= 1;
3041  ux = ux*ux;
3042  }
3043  if ( sign < 0 ) y = -y;
3044  return ULongToLong(y);
3045 }
3046 
3047 /*
3048  #] iexp :
3049  #[ ToGeneral :
3050 
3051  Convert a fast argument to a general argument
3052  Input in r, output in m.
3053  If par == 0 we need the argument header also.
3054 */
3055 
3056 void ToGeneral(WORD *r, WORD *m, WORD par)
3057 {
3058  WORD *mm = m, j, k;
3059  if ( par ) m++;
3060  else { m[1] = 0; m += ARGHEAD + 1; }
3061  j = -*r++;
3062  k = 3;
3063 /* JV: Bugfix 1-feb-2016. Old code assumed FUNHEAD to be 2 */
3064  if ( j >= FUNCTION ) { *m++ = j; *m++ = FUNHEAD; FILLFUN(m) }
3065  else {
3066  switch ( j ) {
3067  case SYMBOL: *m++ = j; *m++ = 4; *m++ = *r++; *m++ = 1; break;
3068  case SNUMBER:
3069  if ( *r > 0 ) { *m++ = *r; *m++ = 1; *m++ = 3; }
3070  else if ( *r == 0 ) { m--; }
3071  else { *m++ = -*r; *m++ = 1; *m++ = -3; }
3072  goto MakeSize;
3073  case MINVECTOR:
3074  k = -k;
3075  /* fall through */
3076  case INDEX:
3077  case VECTOR:
3078  *m++ = INDEX; *m++ = 3; *m++ = *r++;
3079  break;
3080  }
3081  }
3082  *m++ = 1; *m++ = 1; *m++ = k;
3083 MakeSize:
3084  *mm = m-mm;
3085  if ( !par ) mm[ARGHEAD] = *mm-ARGHEAD;
3086 }
3087 
3088 /*
3089  #] ToGeneral :
3090  #[ ToFast :
3091 
3092  Checks whether an argument can be converted to fast notation
3093  If this can be done it does it.
3094  Important: m should be allowed to be equal to r!
3095  Return value is 1 if conversion took place.
3096  If there was conversion the answer is in m.
3097  If there was no conversion m hasn't been touched.
3098 */
3099 
3100 int ToFast(WORD *r, WORD *m)
3101 {
3102  WORD i;
3103  if ( *r == ARGHEAD ) { *m++ = -SNUMBER; *m++ = 0; return(1); }
3104  if ( *r != r[ARGHEAD]+ARGHEAD ) return(0); /* > 1 term */
3105  r += ARGHEAD;
3106  if ( *r == 4 ) {
3107  if ( r[2] != 1 || r[1] <= 0 ) return(0);
3108  *m++ = -SNUMBER; *m = ( r[3] < 0 ) ? -r[1] : r[1]; return(1);
3109  }
3110  i = *r - 1;
3111  if ( r[i-1] != 1 || r[i-2] != 1 ) return(0);
3112  if ( r[i] != 3 ) {
3113  if ( r[i] == -3 && r[2] == *r-4 && r[2] == 3 && r[1] == INDEX
3114  && r[3] < MINSPEC ) {}
3115  else return(0);
3116  }
3117  else if ( r[2] != *r - 4 ) return(0);
3118  r++;
3119  if ( *r >= FUNCTION ) {
3120  if ( r[1] <= FUNHEAD ) { *m++ = -*r; return(1); }
3121  }
3122  else if ( *r == SYMBOL ) {
3123  if ( r[1] == 4 && r[3] == 1 )
3124  { *m++ = -SYMBOL; *m++ = r[2]; return(1); }
3125  }
3126  else if ( *r == INDEX ) {
3127  if ( r[1] == 3 ) {
3128  if ( r[2] >= MINSPEC ) {
3129  if ( r[2] >= 0 && r[2] < AM.OffsetIndex ) *m++ = -SNUMBER;
3130  else *m++ = -INDEX;
3131  }
3132  else {
3133  if ( r[5] == -3 ) *m++ = -MINVECTOR;
3134  else *m++ = -VECTOR;
3135  }
3136  *m++ = r[2];
3137  return(1);
3138  }
3139  }
3140  return(0);
3141 }
3142 
3143 /*
3144  #] ToFast :
3145  #[ ToPolyFunGeneral :
3146 
3147  Routine forces a polyratfun into general notation if needed.
3148  If no action was needed, the return value is zero.
3149  A positive return value indicates how many arguments were converted.
3150  The new term overwrite the old.
3151 */
3152 
3153 WORD ToPolyFunGeneral(PHEAD WORD *term)
3154 {
3155  WORD *t = term+1, *tt, *to, *to1, *termout, *tstop, *tnext;
3156  WORD numarg, i, change = 0;
3157  tstop = term + *term; tstop -= ABS(tstop[-1]);
3158  termout = to = AT.WorkPointer;
3159  to++;
3160  while ( t < tstop ) { /* go through the subterms */
3161  if ( *t == AR.PolyFun ) {
3162  tt = t+FUNHEAD; tnext = t + t[1];
3163  numarg = 0;
3164  while ( tt < tnext ) { numarg++; NEXTARG(tt); }
3165  if ( numarg == 2 ) { /* this needs attention */
3166  tt = t + FUNHEAD;
3167  to1 = to;
3168  i = FUNHEAD; NCOPY(to,t,i);
3169  while ( tt < tnext ) { /* Do the arguments */
3170  if ( *tt > 0 ) {
3171  i = *tt; NCOPY(to,tt,i);
3172  }
3173  else if ( *tt == -SYMBOL ) {
3174  to1[1] += 6+ARGHEAD; to1[2] |= MUSTCLEANPRF; change++;
3175  *to++ = 8+ARGHEAD; *to++ = 0; FILLARG(to);
3176  *to++ = 8; *to++ = SYMBOL; *to++ = 4; *to++ = tt[1];
3177  *to++ = 1; *to++ = 1; *to++ = 1; *to++ = 3;
3178  tt += 2;
3179  }
3180  else if ( *tt == -SNUMBER ) {
3181  if ( tt[1] > 0 ) {
3182  to1[1] += 2+ARGHEAD; to1[2] |= MUSTCLEANPRF; change++;
3183  *to++ = 4+ARGHEAD; *to++ = 0; FILLARG(to);
3184  *to++ = 4; *to++ = tt[1]; *to++ = 1; *to++ = 3;
3185  tt += 2;
3186  }
3187  else if ( tt[1] < 0 ) {
3188  to1[1] += 2+ARGHEAD; to1[2] |= MUSTCLEANPRF; change++;
3189  *to++ = 4+ARGHEAD; *to++ = 0; FILLARG(to);
3190  *to++ = 4; *to++ = -tt[1]; *to++ = 1; *to++ = -3;
3191  tt += 2;
3192  }
3193  else {
3194  MLOCK(ErrorMessageLock);
3195  MesPrint("Internal error: Zero in PolyRatFun");
3196  MUNLOCK(ErrorMessageLock);
3197  Terminate(-1);
3198  }
3199  }
3200  }
3201  t = tnext;
3202  continue;
3203  }
3204  }
3205  i = t[1]; NCOPY(to,t,i)
3206  }
3207  if ( change ) {
3208  tt = term + *term;
3209  while ( t < tt ) *to++ = *t++;
3210  *termout = to - termout;
3211  t = term; i = *termout; tt = termout;
3212  NCOPY(t,tt,i)
3213  AT.WorkPointer = term + *term;
3214  }
3215  return(change);
3216 }
3217 
3218 /*
3219  #] ToPolyFunGeneral :
3220  #[ IsLikeVector :
3221 
3222  Routine determines whether a function argument is like a vector.
3223  Returnvalue: 1: is vector or index
3224  0: is not vector or index
3225  -1: may be an index
3226 */
3227 
3228 int IsLikeVector(WORD *arg)
3229 {
3230  WORD *sstop, *t, *tstop;
3231  if ( *arg < 0 ) {
3232  if ( *arg == -VECTOR || *arg == -INDEX ) return(1);
3233  if ( *arg == -SNUMBER && arg[1] >= 0 && arg[1] < AM.OffsetIndex )
3234  return(-1);
3235  return(0);
3236  }
3237  sstop = arg + *arg; arg += ARGHEAD;
3238  while ( arg < sstop ) {
3239  t = arg + *arg;
3240  tstop = t - ABS(t[-1]);
3241  arg++;
3242  while ( arg < tstop ) {
3243  if ( *arg == INDEX ) return(1);
3244  arg += arg[1];
3245  }
3246  arg = t;
3247  }
3248  return(0);
3249 }
3250 
3251 /*
3252  #] IsLikeVector :
3253  #[ AreArgsEqual :
3254 */
3255 
3256 int AreArgsEqual(WORD *arg1, WORD *arg2)
3257 {
3258  int i;
3259  if ( *arg2 != *arg1 ) return(0);
3260  if ( *arg1 > 0 ) {
3261  i = *arg1;
3262  while ( --i > 0 ) { if ( arg1[i] != arg2[i] ) return(0); }
3263  return(1);
3264  }
3265  else if ( *arg1 <= -FUNCTION ) return(1);
3266  else if ( arg1[1] == arg2[1] ) return(1);
3267  return(0);
3268 }
3269 
3270 /*
3271  #] AreArgsEqual :
3272  #[ CompareArgs :
3273 */
3274 
3275 int CompareArgs(WORD *arg1, WORD *arg2)
3276 {
3277  int i1,i2;
3278  if ( *arg1 > 0 ) {
3279  if ( *arg2 < 0 ) return(-1);
3280  i1 = *arg1-ARGHEAD; arg1 += ARGHEAD;
3281  i2 = *arg2-ARGHEAD; arg2 += ARGHEAD;
3282  while ( i1 > 0 && i2 > 0 ) {
3283  if ( *arg1 != *arg2 ) return((int)(*arg1)-(int)(*arg2));
3284  i1--; i2--; arg1++; arg2++;
3285  }
3286  return(i1-i2);
3287  }
3288  else if ( *arg2 > 0 ) return(1);
3289  else {
3290  if ( *arg1 != *arg2 ) {
3291  if ( *arg1 < *arg2 ) return(-1);
3292  else return(1);
3293  }
3294  if ( *arg1 <= -FUNCTION ) return(0);
3295  return((int)(arg1[1])-(int)(arg2[1]));
3296  }
3297 }
3298 
3299 /*
3300  #] CompareArgs :
3301  #[ CompArg :
3302 
3303  returns 1 if arg1 comes first, -1 if arg2 comes first, 0 if equal
3304 */
3305 
3306 int CompArg(WORD *s1, WORD *s2)
3307 {
3308  GETIDENTITY
3309  WORD *st1, *st2, x[7];
3310  int k;
3311  if ( *s1 < 0 ) {
3312  if ( *s2 < 0 ) {
3313  if ( *s1 <= -FUNCTION && *s2 <= -FUNCTION ) {
3314  if ( *s1 > *s2 ) return(-1);
3315  if ( *s1 < *s2 ) return(1);
3316  return(0);
3317  }
3318  if ( *s1 > *s2 ) return(1);
3319  if ( *s1 < *s2 ) return(-1);
3320  if ( *s1 <= -FUNCTION ) return(0);
3321  s1++; s2++;
3322  if ( *s1 > *s2 ) return(1);
3323  if ( *s1 < *s2 ) return(-1);
3324  return(0);
3325  }
3326  x[1] = AT.comsym[3];
3327  x[2] = AT.comnum[1];
3328  x[3] = AT.comnum[3];
3329  x[4] = AT.comind[3];
3330  x[5] = AT.comind[6];
3331  x[6] = AT.comfun[1];
3332  if ( *s1 == -SYMBOL ) {
3333  AT.comsym[3] = s1[1];
3334  st1 = AT.comsym+8; s1 = AT.comsym;
3335  }
3336  else if ( *s1 == -SNUMBER ) {
3337  if ( s1[1] < 0 ) {
3338  AT.comnum[1] = -s1[1]; AT.comnum[3] = -3;
3339  }
3340  else {
3341  AT.comnum[1] = s1[1]; AT.comnum[3] = 3;
3342  }
3343  st1 = AT.comnum+4;
3344  s1 = AT.comnum;
3345  }
3346  else if ( *s1 == -INDEX || *s1 == -VECTOR ) {
3347  AT.comind[3] = s1[1]; AT.comind[6] = 3;
3348  st1 = AT.comind+7; s1 = AT.comind;
3349  }
3350  else if ( *s1 == -MINVECTOR ) {
3351  AT.comind[3] = s1[1]; AT.comind[6] = -3;
3352  st1 = AT.comind+7; s1 = AT.comind;
3353  }
3354  else if ( *s1 <= -FUNCTION ) {
3355  AT.comfun[1] = -*s1;
3356  st1 = AT.comfun+FUNHEAD+4; s1 = AT.comfun;
3357  }
3358 /*
3359  Symmetrize during compilation of id statement when properorder
3360  needs this one. Code added 10-nov-2001
3361 */
3362  else if ( *s1 == -ARGWILD ) {
3363  return(-1);
3364  }
3365  else { goto argerror; }
3366  st2 = s2 + *s2; s2 += ARGHEAD;
3367  goto docompare;
3368  }
3369  else if ( *s2 < 0 ) {
3370  x[1] = AT.comsym[3];
3371  x[2] = AT.comnum[1];
3372  x[3] = AT.comnum[3];
3373  x[4] = AT.comind[3];
3374  x[5] = AT.comind[6];
3375  x[6] = AT.comfun[1];
3376  if ( *s2 == -SYMBOL ) {
3377  AT.comsym[3] = s2[1];
3378  st2 = AT.comsym+8; s2 = AT.comsym;
3379  }
3380  else if ( *s2 == -SNUMBER ) {
3381  if ( s2[1] < 0 ) {
3382  AT.comnum[1] = -s2[1]; AT.comnum[3] = -3;
3383  st2 = AT.comnum+4;
3384  }
3385  else if ( s2[1] == 0 ) {
3386  st2 = AT.comnum+4; s2 = st2;
3387  }
3388  else {
3389  AT.comnum[1] = s2[1]; AT.comnum[3] = 3;
3390  st2 = AT.comnum+4;
3391  }
3392  s2 = AT.comnum;
3393  }
3394  else if ( *s2 == -INDEX || *s2 == -VECTOR ) {
3395  AT.comind[3] = s2[1]; AT.comind[6] = 3;
3396  st2 = AT.comind+7; s2 = AT.comind;
3397  }
3398  else if ( *s2 == -MINVECTOR ) {
3399  AT.comind[3] = s2[1]; AT.comind[6] = -3;
3400  st2 = AT.comind+7; s2 = AT.comind;
3401  }
3402  else if ( *s2 <= -FUNCTION ) {
3403  AT.comfun[1] = -*s2;
3404  st2 = AT.comfun+FUNHEAD+4; s2 = AT.comfun;
3405  }
3406 /*
3407  Symmetrize during compilation of id statement when properorder
3408  needs this one. Code added 10-nov-2001
3409 */
3410  else if ( *s2 == -ARGWILD ) {
3411  return(1);
3412  }
3413  else { goto argerror; }
3414  st1 = s1 + *s1; s1 += ARGHEAD;
3415  goto docompare;
3416  }
3417  else {
3418  x[1] = AT.comsym[3];
3419  x[2] = AT.comnum[1];
3420  x[3] = AT.comnum[3];
3421  x[4] = AT.comind[3];
3422  x[5] = AT.comind[6];
3423  x[6] = AT.comfun[1];
3424  st1 = s1 + *s1; st2 = s2 + *s2;
3425  s1 += ARGHEAD; s2 += ARGHEAD;
3426 docompare:
3427  while ( s1 < st1 && s2 < st2 ) {
3428  if ( ( k = CompareTerms(s1,s2,(WORD)2) ) != 0 ) {
3429  AT.comsym[3] = x[1];
3430  AT.comnum[1] = x[2];
3431  AT.comnum[3] = x[3];
3432  AT.comind[3] = x[4];
3433  AT.comind[6] = x[5];
3434  AT.comfun[1] = x[6];
3435  return(-k);
3436  }
3437  s1 += *s1; s2 += *s2;
3438  }
3439  AT.comsym[3] = x[1];
3440  AT.comnum[1] = x[2];
3441  AT.comnum[3] = x[3];
3442  AT.comind[3] = x[4];
3443  AT.comind[6] = x[5];
3444  AT.comfun[1] = x[6];
3445  if ( s1 < st1 ) return(1);
3446  if ( s2 < st2 ) return(-1);
3447  }
3448  return(0);
3449 
3450 argerror:
3451  MesPrint("Illegal type of short function argument in Normalize");
3452  Terminate(-1); return(0);
3453 }
3454 
3455 /*
3456  #] CompArg :
3457  #[ TimeWallClock :
3458 */
3459 
3460 #ifdef HAVE_CLOCK_GETTIME
3461 #include <time.h> /* for clock_gettime() */
3462 #else
3463 #ifdef HAVE_GETTIMEOFDAY
3464 #include <sys/time.h> /* for gettimeofday() */
3465 #else
3466 #include <sys/timeb.h> /* for ftime() */
3467 #endif
3468 #endif
3469 
3476 LONG TimeWallClock(WORD par)
3477 {
3478  /*
3479  * NOTE: this function is not thread-safe. Operations on tp are not atomic.
3480  */
3481 
3482 #ifdef HAVE_CLOCK_GETTIME
3483  struct timespec ts;
3484  clock_gettime(CLOCK_MONOTONIC, &ts);
3485 
3486  if ( par ) {
3487  return(((LONG)(ts.tv_sec)-AM.OldSecTime)*100 +
3488  ((LONG)(ts.tv_nsec / 1000000)-AM.OldMilliTime)/10);
3489  }
3490  else {
3491  AM.OldSecTime = (LONG)(ts.tv_sec);
3492  AM.OldMilliTime = (LONG)(ts.tv_nsec / 1000000);
3493  return(0L);
3494  }
3495 #else
3496 #ifdef HAVE_GETTIMEOFDAY
3497  struct timeval t;
3498  LONG sec, msec;
3499  gettimeofday(&t, NULL);
3500  sec = (LONG)t.tv_sec;
3501  msec = (LONG)(t.tv_usec/1000);
3502  if ( par ) {
3503  return (sec-AM.OldSecTime)*100 + (msec-AM.OldMilliTime)/10;
3504  }
3505  else {
3506  AM.OldSecTime = sec;
3507  AM.OldMilliTime = msec;
3508  return(0L);
3509  }
3510 #else
3511  struct timeb tp;
3512  ftime(&tp);
3513 
3514  if ( par ) {
3515  return(((LONG)(tp.time)-AM.OldSecTime)*100 +
3516  ((LONG)(tp.millitm)-AM.OldMilliTime)/10);
3517  }
3518  else {
3519  AM.OldSecTime = (LONG)(tp.time);
3520  AM.OldMilliTime = (LONG)(tp.millitm);
3521  return(0L);
3522  }
3523 #endif
3524 #endif
3525 }
3526 
3527 /*
3528  #] TimeWallClock :
3529  #[ TimeChildren :
3530 */
3531 
3532 LONG TimeChildren(WORD par)
3533 {
3534  if ( par ) return(Timer(1)-AM.OldChildTime);
3535  AM.OldChildTime = Timer(1);
3536  return(0L);
3537 }
3538 
3539 /*
3540  #] TimeChildren :
3541  #[ TimeCPU :
3542 */
3543 
3550 LONG TimeCPU(WORD par)
3551 {
3552  GETIDENTITY
3553  if ( par ) return(Timer(0)-AR.OldTime);
3554  AR.OldTime = Timer(0);
3555  return(0L);
3556 }
3557 
3558 /*
3559  #] TimeCPU :
3560  #[ Timer :
3561 */
3562 #if defined(WINDOWS)
3563 
3564 LONG Timer(int par)
3565 {
3566 #ifndef WITHPTHREADS
3567  static int initialized = 0;
3568  static HANDLE hProcess;
3569  FILETIME ftCreate, ftExit, ftKernel, ftUser;
3570  DUMMYUSE(par);
3571 
3572  if ( !initialized ) {
3573  hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, GetCurrentProcessId());
3574  }
3575  if ( GetProcessTimes(hProcess, &ftCreate, &ftExit, &ftKernel, &ftUser) ) {
3576  PFILETIME pftKernel = &ftKernel; /* to avoid strict-aliasing rule warnings */
3577  PFILETIME pftUser = &ftUser;
3578  __int64 t = *(__int64 *)pftKernel + *(__int64 *)pftUser; /* in 100 nsec. */
3579  return (LONG)(t / 10000); /* in msec. */
3580  }
3581  return 0;
3582 #else
3583  LONG lResult = 0;
3584  HANDLE hThread;
3585  FILETIME ftCreate, ftExit, ftKernel, ftUser;
3586  DUMMYUSE(par);
3587 
3588  hThread = OpenThread(THREAD_QUERY_INFORMATION, FALSE, GetCurrentThreadId());
3589  if ( hThread ) {
3590  if ( GetThreadTimes(hThread, &ftCreate, &ftExit, &ftKernel, &ftUser) ) {
3591  PFILETIME pftKernel = &ftKernel; /* to avoid strict-aliasing rule warnings */
3592  PFILETIME pftUser = &ftUser;
3593  __int64 t = *(__int64 *)pftKernel + *(__int64 *)pftUser; /* in 100 nsec. */
3594  lResult = (LONG)(t / 10000); /* in msec. */
3595  }
3596  CloseHandle(hThread);
3597  }
3598  return lResult;
3599 #endif
3600 }
3601 
3602 #elif defined(UNIX)
3603 #include <sys/time.h>
3604 #include <sys/resource.h>
3605 #ifdef WITHPOSIXCLOCK
3606 #include <time.h>
3607 /*
3608  And include -lrt in the link statement (on blade02)
3609 */
3610 #endif
3611 
3612 LONG Timer(int par)
3613 {
3614 #ifdef WITHPOSIXCLOCK
3615 /*
3616  Only to be used in combination with WITHPTHREADS
3617  This clock seems to be supported by the standard.
3618  The getrusage clock returns according to the standard only the combined
3619  time of the whole process. But in older versions of Linux LinuxThreads
3620  is used which gives a separate id to each thread and individual timings.
3621  In NPTL we get, according to the standard, one combined timing.
3622  To get individual timings we need to use
3623  clock_gettime(CLOCK_THREAD_CPUTIME_ID, &timing)
3624  with timing of the time
3625  struct timespec {
3626  time_t tv_sec; Seconds.
3627  long tv_nsec; Nanoseconds.
3628  };
3629 
3630 */
3631  struct timespec t;
3632  if ( par == 0 ) {
3633  if ( clock_gettime(CLOCK_THREAD_CPUTIME_ID, &t) ) {
3634  MesPrint("Error in getting timing information");
3635  }
3636  return (LONG)t.tv_sec * 1000 + (LONG)t.tv_nsec / 1000000;
3637  }
3638  return(0);
3639 #else
3640  struct rusage rusage;
3641  if ( par == 1 ) {
3642  getrusage(RUSAGE_CHILDREN,&rusage);
3643  return(((LONG)(rusage.ru_utime.tv_sec)+(LONG)(rusage.ru_stime.tv_sec))*1000
3644  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3645  }
3646  else {
3647  getrusage(RUSAGE_SELF,&rusage);
3648  return(((LONG)(rusage.ru_utime.tv_sec)+(LONG)(rusage.ru_stime.tv_sec))*1000
3649  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3650  }
3651 #endif
3652 }
3653 
3654 #elif defined(SUN)
3655 #define _TIME_T_
3656 #include <sys/time.h>
3657 #include <sys/resource.h>
3658 
3659 LONG Timer(int par)
3660 {
3661  struct rusage rusage;
3662  if ( par == 1 ) {
3663  getrusage(RUSAGE_CHILDREN,&rusage);
3664  return(((LONG)(rusage.ru_utime.tv_sec)+(LONG)(rusage.ru_stime.tv_sec))*1000
3665  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3666  }
3667  else {
3668  getrusage(RUSAGE_SELF,&rusage);
3669  return(((LONG)(rusage.ru_utime.tv_sec)+(LONG)(rusage.ru_stime.tv_sec))*1000
3670  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3671  }
3672 }
3673 
3674 #elif defined(RS6K)
3675 #include <sys/time.h>
3676 #include <sys/resource.h>
3677 
3678 LONG Timer(int par)
3679 {
3680  struct rusage rusage;
3681  if ( par == 1 ) {
3682  getrusage(RUSAGE_CHILDREN,&rusage);
3683  return(((LONG)(rusage.ru_utime.tv_sec)+(LONG)(rusage.ru_stime.tv_sec))*1000
3684  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3685  }
3686  else {
3687  getrusage(RUSAGE_SELF,&rusage);
3688  return(((LONG)(rusage.ru_utime.tv_sec)+(LONG)(rusage.ru_stime.tv_sec))*1000
3689  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3690  }
3691 }
3692 
3693 #elif defined(ANSI)
3694 LONG Timer(int par)
3695 {
3696 #ifdef ALPHA
3697 /* clock_t t,tikken = clock(); */
3698 /* MesPrint("ALPHA-clock = %l",(LONG)tikken); */
3699 /* t = tikken % CLOCKS_PER_SEC; */
3700 /* tikken /= CLOCKS_PER_SEC; */
3701 /* tikken *= 1000; */
3702 /* tikken += (t*1000)/CLOCKS_PER_SEC; */
3703 /* return((LONG)tikken); */
3704 /* #define _TIME_T_ */
3705 #include <sys/time.h>
3706 #include <sys/resource.h>
3707  struct rusage rusage;
3708  if ( par == 1 ) {
3709  getrusage(RUSAGE_CHILDREN,&rusage);
3710  return(((LONG)(rusage.ru_utime.tv_sec)+(LONG)(rusage.ru_stime.tv_sec))*1000
3711  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3712  }
3713  else {
3714  getrusage(RUSAGE_SELF,&rusage);
3715  return(((LONG)(rusage.ru_utime.tv_sec)+(LONG)(rusage.ru_stime.tv_sec))*1000
3716  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3717  }
3718 #else
3719 #ifdef DEC_STATION
3720  clock_t tikken = clock();
3721  return((LONG)tikken/1000);
3722 #else
3723  clock_t t, tikken = clock();
3724  t = tikken % CLK_TCK;
3725  tikken /= CLK_TCK;
3726  tikken *= 1000;
3727  tikken += (t*1000)/CLK_TCK;
3728  return(tikken);
3729 #endif
3730 #endif
3731 }
3732 #elif defined(VMS)
3733 
3734 #include <time.h>
3735 void times(tbuffer_t *buffer);
3736 
3737 LONG
3738 Timer(int par)
3739 {
3740  tbuffer_t buffer;
3741  if ( par == 1 ) { return(0); }
3742  else {
3743  times(&buffer);
3744  return(buffer.proc_user_time * 10);
3745  }
3746 }
3747 
3748 #elif defined(mBSD)
3749 
3750 #ifdef MICROTIME
3751 /*
3752  There is only a CP time clock in microseconds here
3753  This can cause problems with AO.wrap around
3754 */
3755 #else
3756 #ifdef mBSD2
3757 #include <sys/types.h>
3758 #include <sys/times.h>
3759 #include <time.h>
3760 LONG pretime = 0;
3761 #else
3762 #define _TIME_T_
3763 #include <sys/time.h>
3764 #include <sys/resource.h>
3765 #endif
3766 #endif
3767 
3768 LONG Timer(int par)
3769 {
3770 #ifdef MICROTIME
3771  LONG t;
3772  if ( par == 1 ) { return(0); }
3773  t = clock();
3774  if ( ( AO.wrapnum & 1 ) != 0 ) t ^= 0x80000000;
3775  if ( t < 0 ) {
3776  t ^= 0x80000000;
3777  warpnum++;
3778  AO.wrap += 2147584;
3779  }
3780  return(AO.wrap+(t/1000));
3781 #else
3782 #ifdef mBSD2
3783  struct tms buffer;
3784  LONG ret;
3785  ULONG a1, a2, a3, a4;
3786  if ( par == 1 ) { return(0); }
3787  times(&buffer);
3788  a1 = (ULONG)buffer.tms_utime;
3789  a2 = a1 >> 16;
3790  a3 = a1 & 0xFFFFL;
3791  a3 *= 1000;
3792  a2 = 1000*a2 + (a3 >> 16);
3793  a3 &= 0xFFFFL;
3794  a4 = a2/CLK_TCK;
3795  a2 %= CLK_TCK;
3796  a3 += a2 << 16;
3797  ret = (LONG)((a4 << 16) + a3 / CLK_TCK);
3798 /* ret = ((LONG)buffer.tms_utime * 1000)/CLK_TCK; */
3799  return(ret);
3800 #else
3801 #ifdef REALTIME
3802  struct timeval tp;
3803  struct timezone tzp;
3804  if ( par == 1 ) { return(0); }
3805  gettimeofday(&tp,&tzp); */
3806  return(tp.tv_sec*1000+tp.tv_usec/1000);
3807 #else
3808  struct rusage rusage;
3809  if ( par == 1 ) {
3810  getrusage(RUSAGE_CHILDREN,&rusage);
3811  return((rusage.ru_utime.tv_sec+rusage.ru_stime.tv_sec)*1000
3812  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3813  }
3814  else {
3815  getrusage(RUSAGE_SELF,&rusage);
3816  return((rusage.ru_utime.tv_sec+rusage.ru_stime.tv_sec)*1000
3817  +(rusage.ru_utime.tv_usec/1000+rusage.ru_stime.tv_usec/1000));
3818  }
3819 #endif
3820 #endif
3821 #endif
3822 }
3823 
3824 #endif
3825 
3826 /*
3827  #] Timer :
3828  #[ Crash :
3829 
3830  Routine for debugging purposes
3831 */
3832 
3833 int Crash()
3834 {
3835  int retval;
3836 #ifdef DEBUGGING
3837  int *zero = 0;
3838  retval = *zero;
3839 #else
3840  retval = 0;
3841 #endif
3842  return(retval);
3843 }
3844 
3845 /*
3846  #] Crash :
3847  #[ TestTerm :
3848 */
3849 
3861 int TestTerm(WORD *term)
3862 {
3863  int errorcode = 0, coeffsize;
3864  WORD *t, *tt, *tstop, *endterm, *targ, *targstop, *funstop, *argterm;
3865  endterm = term + *term;
3866  coeffsize = ABS(endterm[-1]);
3867  if ( coeffsize >= *term ) {
3868  MLOCK(ErrorMessageLock);
3869  MesPrint("TestTerm: Internal inconsistency in term. Coefficient too big.");
3870  MUNLOCK(ErrorMessageLock);
3871  errorcode = 1;
3872  goto finish;
3873  }
3874  if ( ( coeffsize < 3 ) || ( ( coeffsize & 1 ) != 1 ) ) {
3875  MLOCK(ErrorMessageLock);
3876  MesPrint("TestTerm: Internal inconsistency in term. Wrong size coefficient.");
3877  MUNLOCK(ErrorMessageLock);
3878  errorcode = 2;
3879  goto finish;
3880  }
3881  t = term+1;
3882  tstop = endterm - coeffsize;
3883  while ( t < tstop ) {
3884  switch ( *t ) {
3885  case SYMBOL:
3886  case DOTPRODUCT:
3887  case INDEX:
3888  case VECTOR:
3889  case DELTA:
3890  case HAAKJE:
3891  break;
3892  case SNUMBER:
3893  case LNUMBER:
3894  MLOCK(ErrorMessageLock);
3895  MesPrint("TestTerm: Internal inconsistency in term. L or S number");
3896  MUNLOCK(ErrorMessageLock);
3897  errorcode = 3;
3898  goto finish;
3899  break;
3900  case EXPRESSION:
3901  case SUBEXPRESSION:
3902  case DOLLAREXPRESSION:
3903 /*
3904  MLOCK(ErrorMessageLock);
3905  MesPrint("TestTerm: Internal inconsistency in term. Expression survives.");
3906  MUNLOCK(ErrorMessageLock);
3907  errorcode = 4;
3908  goto finish;
3909 */
3910  break;
3911  case SETSET:
3912  case MINVECTOR:
3913  case SETEXP:
3914  case ARGFIELD:
3915  MLOCK(ErrorMessageLock);
3916  MesPrint("TestTerm: Internal inconsistency in term. Illegal subterm.");
3917  MUNLOCK(ErrorMessageLock);
3918  errorcode = 5;
3919  goto finish;
3920  break;
3921  case ARGWILD:
3922  break;
3923  default:
3924  if ( *t <= 0 ) {
3925  MLOCK(ErrorMessageLock);
3926  MesPrint("TestTerm: Internal inconsistency in term. Illegal subterm number.");
3927  MUNLOCK(ErrorMessageLock);
3928  errorcode = 6;
3929  goto finish;
3930  }
3931 /*
3932  This is a regular function.
3933 */
3934  if ( *t-FUNCTION >= NumFunctions ) {
3935  MLOCK(ErrorMessageLock);
3936  MesPrint("TestTerm: Internal inconsistency in term. Illegal function number");
3937  MUNLOCK(ErrorMessageLock);
3938  errorcode = 7;
3939  goto finish;
3940  }
3941  funstop = t + t[1];
3942  if ( funstop > tstop ) goto subtermsize;
3943  if ( t[2] != 0 ) {
3944  MLOCK(ErrorMessageLock);
3945  MesPrint("TestTerm: Internal inconsistency in term. Dirty flag nonzero.");
3946  MUNLOCK(ErrorMessageLock);
3947  errorcode = 8;
3948  goto finish;
3949  }
3950  targ = t + FUNHEAD;
3951  if ( targ > funstop ) {
3952  MLOCK(ErrorMessageLock);
3953  MesPrint("TestTerm: Internal inconsistency in term. Illegal function size.");
3954  MUNLOCK(ErrorMessageLock);
3955  errorcode = 9;
3956  goto finish;
3957  }
3958  if ( functions[*t-FUNCTION].spec >= TENSORFUNCTION ) {
3959  }
3960  else {
3961  while ( targ < funstop ) {
3962  if ( *targ < 0 ) {
3963  if ( *targ <= -(FUNCTION+NumFunctions) ) {
3964  MLOCK(ErrorMessageLock);
3965  MesPrint("TestTerm: Internal inconsistency in term. Illegal function number in argument.");
3966  MUNLOCK(ErrorMessageLock);
3967  errorcode = 10;
3968  goto finish;
3969  }
3970  if ( *targ <= -FUNCTION ) { targ++; }
3971  else {
3972  if ( ( *targ != -SYMBOL ) && ( *targ != -VECTOR )
3973  && ( *targ != -MINVECTOR )
3974  && ( *targ != -SNUMBER )
3975  && ( *targ != -ARGWILD )
3976  && ( *targ != -INDEX ) ) {
3977  MLOCK(ErrorMessageLock);
3978  MesPrint("TestTerm: Internal inconsistency in term. Illegal object in argument.");
3979  MUNLOCK(ErrorMessageLock);
3980  errorcode = 11;
3981  goto finish;
3982  }
3983  targ += 2;
3984  }
3985  }
3986  else if ( ( *targ < ARGHEAD ) || ( targ+*targ > funstop ) ) {
3987  MLOCK(ErrorMessageLock);
3988  MesPrint("TestTerm: Internal inconsistency in term. Illegal size of argument.");
3989  MUNLOCK(ErrorMessageLock);
3990  errorcode = 12;
3991  goto finish;
3992  }
3993  else if ( targ[1] != 0 ) {
3994  MLOCK(ErrorMessageLock);
3995  MesPrint("TestTerm: Internal inconsistency in term. Dirty flag in argument.");
3996  MUNLOCK(ErrorMessageLock);
3997  errorcode = 13;
3998  goto finish;
3999  }
4000  else {
4001  targstop = targ + *targ;
4002  argterm = targ + ARGHEAD;
4003  while ( argterm < targstop ) {
4004  if ( ( *argterm < 4 ) || ( argterm + *argterm > targstop ) ) {
4005  MLOCK(ErrorMessageLock);
4006  MesPrint("TestTerm: Internal inconsistency in term. Illegal termsize in argument.");
4007  MUNLOCK(ErrorMessageLock);
4008  errorcode = 14;
4009  goto finish;
4010  }
4011  if ( TestTerm(argterm) != 0 ) {
4012  MLOCK(ErrorMessageLock);
4013  MesPrint("TestTerm: Internal inconsistency in term. Called from TestTerm.");
4014  MUNLOCK(ErrorMessageLock);
4015  errorcode = 15;
4016  goto finish;
4017  }
4018  argterm += *argterm;
4019  }
4020  targ = targstop;
4021  }
4022  }
4023  }
4024  break;
4025  }
4026  tt = t + t[1];
4027  if ( tt > tstop ) {
4028 subtermsize:
4029  MLOCK(ErrorMessageLock);
4030  MesPrint("TestTerm: Internal inconsistency in term. Illegal subterm size.");
4031  MUNLOCK(ErrorMessageLock);
4032  errorcode = 100;
4033  goto finish;
4034  }
4035  t = tt;
4036  }
4037  return(errorcode);
4038 finish:
4039  return(errorcode);
4040 }
4041 
4042 /*
4043  #] TestTerm :
4044  #] Mixed :
4045 */
UBYTE * pointer
Definition: structs.h:692
char * name
Definition: structs.h:970
int PutPreVar(UBYTE *, UBYTE *, UBYTE *, int)
Definition: pre.c:642
UBYTE * buffer
Definition: structs.h:691
Definition: structs.h:633
int size
Definition: structs.h:209
#define NUMBERMEMSTARTNUM
Definition: tools.c:2646
UBYTE * top
Definition: structs.h:693
int num
Definition: structs.h:207
#define TERMMEMSTARTNUM
Definition: tools.c:2546
int CopyFile(char *source, char *dest)
Definition: tools.c:1101
LONG TimeWallClock(WORD par)
Definition: tools.c:3476
UBYTE * FoldName
Definition: structs.h:694
LONG TimeCPU(WORD par)
Definition: tools.c:3550
LONG PF_BroadcastNumber(LONG x)
Definition: parallel.c:2083
void * lijst
Definition: structs.h:205
UBYTE * name
Definition: structs.h:695
char * message
Definition: structs.h:206
int PF_Bcast(void *buffer, int count)
Definition: mpi.c:440
int maxnum
Definition: structs.h:208
Definition: structs.h:204
struct bit_field * one_byte
Definition: structs.h:909
LONG PF_WriteFileToFile(int handle, UBYTE *buffer, LONG size)
Definition: parallel.c:4371
UBYTE * pname
Definition: structs.h:696
int TestTerm(WORD *term)
Definition: tools.c:3861
struct bit_field set_of_char[32]
Definition: structs.h:903
int handle
Definition: structs.h:971