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