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