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