FORM  4.3
store.c
Go to the documentation of this file.
1 
6 /* #[ License : */
7 /*
8  * Copyright (C) 1984-2022 J.A.M. Vermaseren
9  * When using this file you are requested to refer to the publication
10  * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
11  * This is considered a matter of courtesy as the development was paid
12  * for by FOM the Dutch physics granting agency and we would like to
13  * be able to track its scientific use to convince FOM of its value
14  * for the community.
15  *
16  * This file is part of FORM.
17  *
18  * FORM is free software: you can redistribute it and/or modify it under the
19  * terms of the GNU General Public License as published by the Free Software
20  * Foundation, either version 3 of the License, or (at your option) any later
21  * version.
22  *
23  * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
24  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
25  * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
26  * details.
27  *
28  * You should have received a copy of the GNU General Public License along
29  * with FORM. If not, see <http://www.gnu.org/licenses/>.
30  */
31 /* #] License : */
32 /*
33 #define HIDEDEBUG
34  #[ Includes : store.c
35 */
36 
37 #include "form3.h"
38 
39 /*
40  #] Includes :
41  #[ StoreExpressions :
42  #[ OpenTemp :
43 
44  Opens the scratch files for the input -> output operations.
45 
46 */
47 
48 WORD OpenTemp()
49 {
50  GETIDENTITY
51  if ( AR.outfile->handle >= 0 ) {
52  SeekFile(AR.outfile->handle,&(AR.outfile->filesize),SEEK_SET);
53  AR.outfile->POposition = AR.outfile->filesize;
54  AR.outfile->POfill = AR.outfile->PObuffer;
55  }
56  return(0);
57 }
58 
59 /*
60  #] OpenTemp :
61  #[ SeekScratch :
62 */
63 
64 VOID SeekScratch(FILEHANDLE *fi, POSITION *pos)
65 {
66  *pos = fi->POposition;
67  ADDPOS(*pos,(TOLONG(fi->POfill)-TOLONG(fi->PObuffer)));
68 }
69 
70 /*
71  #] SeekScratch :
72  #[ SetEndScratch :
73 */
74 
75 VOID SetEndScratch(FILEHANDLE *f, POSITION *position)
76 {
77  if ( f->handle < 0 ) {
78  SETBASEPOSITION(*position,(f->POfull-f->PObuffer)*sizeof(WORD));
79  }
80  else *position = f->filesize;
81  SetScratch(f,position);
82 }
83 
84 /*
85  #] SetEndScratch :
86  #[ SetEndHScratch :
87 */
88 
89 VOID SetEndHScratch(FILEHANDLE *f, POSITION *position)
90 {
91  if ( f->handle < 0 ) {
92  SETBASEPOSITION(*position,(f->POfull-f->PObuffer)*sizeof(WORD));
93  f->POfill = f->POfull;
94  }
95  else {
96 #ifdef HIDEDEBUG
97  POSITION possize;
98  PUTZERO(possize);
99  SeekFile(f->handle,&possize,SEEK_END);
100  MesPrint("SetEndHScratch: filesize(th) = %12p, filesize(ex) = %12p",&(f->filesize),
101  &(possize));
102 #endif
103  *position = f->filesize;
104  f->POposition = f->filesize;
105  f->POfill = f->POfull = f->PObuffer;
106  }
107 /* SetScratch(f,position); */
108 }
109 
110 /*
111  #] SetEndHScratch :
112  #[ SetScratch :
113 */
114 
115 VOID SetScratch(FILEHANDLE *f, POSITION *position)
116 {
117  GETIDENTITY
118  POSITION possize;
119  LONG size, *whichInInBuf;
120  if ( f == AR.hidefile ) whichInInBuf = &(AR.InHiBuf);
121  else whichInInBuf = &(AR.InInBuf);
122 #ifdef HIDEDEBUG
123  if ( f == AR.hidefile ) MesPrint("In the hide file");
124  else MesPrint("In the input file");
125  MesPrint("SetScratch to position %15p",position);
126  MesPrint("POposition = %15p, full = %l, fill = %l"
127  ,&(f->POposition),(f->POfull-f->PObuffer)*sizeof(WORD)
128  ,(f->POfill-f->PObuffer)*sizeof(WORD));
129 #endif
130  if ( ISLESSPOS(*position,f->POposition) ||
131  ISGEPOSINC(*position,f->POposition,(f->POfull-f->PObuffer)*sizeof(WORD)) ) {
132  if ( f->handle < 0 ) {
133  if ( ISEQUALPOSINC(*position,f->POposition,
134  (f->POfull-f->PObuffer)*sizeof(WORD)) ) goto endpos;
135  MesPrint("Illegal position in SetScratch");
136  Terminate(-1);
137  }
138  possize = *position;
139  LOCK(AS.inputslock);
140  SeekFile(f->handle,&possize,SEEK_SET);
141  if ( ISNOTEQUALPOS(possize,*position) ) {
142  UNLOCK(AS.inputslock);
143  MesPrint("Cannot position file in SetScratch");
144  Terminate(-1);
145  }
146 #ifdef HIDEDEBUG
147  MesPrint("SetScratch1(%w): position = %12p, size = %l, address = %x",position,f->POsize,f->PObuffer);
148 #endif
149  if ( ( size = ReadFile(f->handle,(UBYTE *)(f->PObuffer),f->POsize) ) < 0
150  || ( size & 1 ) != 0 ) {
151  UNLOCK(AS.inputslock);
152  MesPrint("Read error in SetScratch");
153  Terminate(-1);
154  }
155  UNLOCK(AS.inputslock);
156  if ( size == 0 ) {
157  f->PObuffer[0] = 0;
158  }
159  f->POfill = f->PObuffer;
160  f->POposition = *position;
161 #ifdef WORD2
162  *whichInInBuf = size >> 1;
163 #else
164  *whichInInBuf = size / TABLESIZE(WORD,UBYTE);
165 #endif
166  f->POfull = f->PObuffer + *whichInInBuf;
167 #ifdef HIDEDEBUG
168  MesPrint("SetScratch2: size = %l, InInBuf = %l, fill = %l, full = %l"
169  ,size,*whichInInBuf,(f->POfill-f->PObuffer)*sizeof(WORD)
170  ,(f->POfull-f->PObuffer)*sizeof(WORD));
171 #endif
172  }
173  else {
174 endpos:
175  DIFPOS(possize,*position,f->POposition);
176  f->POfill = (WORD *)(BASEPOSITION(possize)+(UBYTE *)(f->PObuffer));
177  *whichInInBuf = f->POfull-f->POfill;
178  }
179 }
180 
181 /*
182  #] SetScratch :
183  #[ RevertScratch :
184 
185  Reverts the input/output directions. This way input comes
186  always from AR.infile
187 
188 */
189 
190 WORD RevertScratch()
191 {
192  GETIDENTITY
193  FILEHANDLE *f;
194  if ( AR.infile->handle >= 0 && AR.infile->handle != AR.outfile->handle ) {
195  CloseFile(AR.infile->handle);
196  AR.infile->handle = -1;
197  remove(AR.infile->name);
198  }
199  f = AR.infile; AR.infile = AR.outfile; AR.outfile = f;
200  AR.infile->POfull = AR.infile->POfill;
201  AR.infile->POfill = AR.infile->PObuffer;
202  if ( AR.infile->handle >= 0 ) {
203  POSITION scrpos;
204  PUTZERO(scrpos);
205  SeekFile(AR.infile->handle,&scrpos,SEEK_SET);
206  if ( ISNOTZEROPOS(scrpos) ) {
207  return(MesPrint("Error with scratch output."));
208  }
209  if ( ( AR.InInBuf = ReadFile(AR.infile->handle,(UBYTE *)(AR.infile->PObuffer)
210  ,AR.infile->POsize) ) < 0 || AR.InInBuf & 1 ) {
211  return(MesPrint("Error while reading from scratch file"));
212  }
213  else {
214  AR.InInBuf /= TABLESIZE(WORD,UBYTE);
215  }
216  AR.infile->POfull = AR.infile->PObuffer + AR.InInBuf;
217  }
218  PUTZERO(AR.infile->POposition);
219  AR.outfile->POfill = AR.outfile->POfull = AR.outfile->PObuffer;
220  PUTZERO(AR.outfile->POposition);
221  PUTZERO(AR.outfile->filesize);
222  return(0);
223 }
224 
225 /*
226  #] RevertScratch :
227  #[ ResetScratch :
228 
229  Resets the output scratch file to its beginning in such a way
230  that the write routines can read it. The output buffers are
231  left untouched as they may still be needed for extra declarations.
232 
233 */
234 
235 WORD ResetScratch()
236 {
237  GETIDENTITY
238  FILEHANDLE *f;
239  if ( AR.infile->handle >= 0 ) {
240  CloseFile(AR.infile->handle); AR.infile->handle = -1;
241  remove(AR.infile->name);
242  PUTZERO(AR.infile->POposition);
243  AR.infile->POfill = AR.infile->POfull = AR.infile->PObuffer;
244  }
245  if ( AR.outfile->handle >= 0 ) {
246  POSITION scrpos;
247  PUTZERO(scrpos);
248  SeekFile(AR.outfile->handle,&scrpos,SEEK_SET);
249  if ( ISNOTZEROPOS(scrpos) ) {
250  return(MesPrint("Error with scratch output."));
251  }
252  if ( ( AR.InInBuf = ReadFile(AR.outfile->handle,(UBYTE *)(AR.outfile->PObuffer)
253  ,AR.outfile->POsize) ) < 0 || AR.InInBuf & 1 ) {
254  return(MesPrint("Error while reading from scratch file"));
255  }
256  else AR.InInBuf /= TABLESIZE(WORD,UBYTE);
257  AR.outfile->POfull = AR.outfile->PObuffer + AR.InInBuf;
258  }
259  else AR.outfile->POfull = AR.outfile->POfill;
260  AR.outfile->POfill = AR.outfile->PObuffer;
261  PUTZERO(AR.outfile->POposition);
262  f = AR.outfile; AR.outfile = AR.infile; AR.infile = f;
263  return(0);
264 }
265 
266 /*
267  #] ResetScratch :
268  #[ ReadFromScratch :
269 
270  Routine is used to copy files from scratch to hide.
271 */
272 
273 int ReadFromScratch(FILEHANDLE *fi, POSITION *pos, UBYTE *buffer, POSITION *length)
274 {
275  GETIDENTITY
276  LONG l = BASEPOSITION(*length);
277  if ( fi->handle < 0 ) {
278  memcpy(buffer,fi->POfill,l);
279  }
280  else {
281  SeekFile(fi->handle,pos,SEEK_SET);
282  if ( ReadFile(fi->handle,buffer,l) != l ) {
283  if ( fi == AR.hidefile )
284  MesPrint("Error reading from hide file.");
285  else
286  MesPrint("Error reading from scratch file.");
287  return(-1);
288  }
289  }
290  return(0);
291 }
292 
293 /*
294  #] ReadFromScratch :
295  #[ AddToScratch :
296 
297  Routine is used to copy files from scratch to hide.
298 */
299 
300 int AddToScratch(FILEHANDLE *fi, POSITION *pos, UBYTE *buffer, POSITION *length,
301  int withflush)
302 {
303  GETIDENTITY
304  LONG l = BASEPOSITION(*length), avail;
305  DUMMYUSE(pos)
306  fi->POfill = fi->POfull;
307  while ( fi->POfill+l/sizeof(WORD) > fi->POstop ) {
308  avail = (fi->POstop-fi->POfill)*sizeof(WORD);
309  if ( avail > 0 ) {
310  memcpy(fi->POfill,buffer,avail);
311  l -= avail; buffer += avail;
312  }
313  if ( fi->handle < 0 ) {
314  if ( ( fi->handle = (WORD)CreateFile(fi->name) ) < 0 ) {
315  if ( fi == AR.hidefile )
316  MesPrint("Cannot create hide file %s",fi->name);
317  else
318  MesPrint("Cannot create scratch file %s",fi->name);
319  return(-1);
320  }
321  PUTZERO(fi->POposition);
322  }
323  SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
324  if ( WriteFile(fi->handle,(UBYTE *)fi->PObuffer,fi->POsize) != fi->POsize )
325  goto writeerror;
326  ADDPOS(fi->POposition,fi->POsize);
327  fi->POfill = fi->POfull = fi->PObuffer;
328  }
329  if ( l > 0 ) {
330  memcpy(fi->POfill,buffer,l);
331  fi->POfill += l/sizeof(WORD);
332  fi->POfull = fi->POfill;
333  }
334  if ( withflush && fi->handle >= 0 && fi->POfill > fi->PObuffer ) { /* flush */
335  l = (LONG)fi->POfill - (LONG)fi->PObuffer;
336  SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
337  if ( WriteFile(fi->handle,(UBYTE *)fi->PObuffer,l) != l ) goto writeerror;
338  ADDPOS(fi->POposition,fi->POsize);
339  fi->POfill = fi->POfull = fi->PObuffer;
340  }
341  if ( withflush && fi->handle >= 0 )
342  SETBASEPOSITION(fi->filesize,TellFile(fi->handle));
343  return(0);
344 writeerror:
345  if ( fi == AR.hidefile )
346  MesPrint("Error writing to hide file. Disk full?");
347  else
348  MesPrint("Error writing to scratch file. Disk full?");
349  return(-1);
350 }
351 
352 /*
353  #] AddToScratch :
354  #[ CoSave :
355 
356  The syntax of the save statement is:
357 
358  save filename
359  save filename expr1 expr2
360 
361 */
362 
363 int CoSave(UBYTE *inp)
364 {
365  GETIDENTITY
366  UBYTE *p, c;
367  WORD n = 0, i;
368  WORD error = 0, type, number;
369  LONG RetCode = 0, wSize;
370  EXPRESSIONS e;
371  INDEXENTRY *ind;
372  INDEXENTRY *indold;
373  WORD TMproto[SUBEXPSIZE];
374  POSITION scrpos, scrpos1, filesize;
375  int ii, j = sizeof(FILEINDEX)/(sizeof(LONG));
376  LONG *lo;
377  while ( *inp == ',' ) inp++;
378  p = inp;
379 
380 #ifdef WITHMPI
381  if( PF.me != MASTER) return(0);
382 #endif
383 
384  if ( !*p ) return(MesPrint("No filename in save statement"));
385  if ( FG.cTable[*p] > 1 && ( *p != '.' ) && ( *p != SEPARATOR ) && ( *p != ALTSEPARATOR ) )
386  return(MesPrint("Illegal filename"));
387  while ( *++p && *p != ',' ) {}
388  c = *p;
389  *p = 0;
390  if ( !AP.preError ) {
391  if ( ( RetCode = CreateFile((char *)inp) ) < 0 ) {
392  return(MesPrint("Cannot open file %s",inp));
393  }
394  }
395  AO.SaveData.Handle = (WORD)RetCode;
396  PUTZERO(filesize);
397 
398  e = Expressions;
399  n = NumExpressions;
400  if ( c ) { /* There follows a list of expressions */
401  *p++ = c;
402  inp = p;
403  i = (WORD)(INFILEINDEX);
404  if ( WriteStoreHeader(AO.SaveData.Handle) ) return(MesPrint("Error writing storage file header"));
405 /* PUTZERO(AO.SaveData.Index.number); */
406 /* PUTZERO(AO.SaveData.Index.next); */
407  lo = (LONG *)(&AO.SaveData.Index);
408  for ( ii = 0; ii < j; ii++ ) *lo++ = 0;
409  SETBASEPOSITION(AO.SaveData.Position,(LONG)sizeof(STOREHEADER));
410  ind = AO.SaveData.Index.expression;
411  if ( !AP.preError && WriteFile(AO.SaveData.Handle,(UBYTE *)(&(AO.SaveData.Index))
412  ,(LONG)sizeof(struct FiLeInDeX))!= (LONG)sizeof(struct FiLeInDeX) ) goto SavWrt;
413  SeekFile(AO.SaveData.Handle,&(filesize),SEEK_END);
414 /* ADDPOS(filesize,sizeof(struct FiLeInDeX)); */
415 
416  do { /* Scan the list */
417  if ( !FG.cTable[*p] || *p == '[' ) {
418  p = SkipAName(p);
419  if ( p == 0 ) return(-1);
420  }
421  c = *p; *p = 0;
422  if ( GetVar(inp,&type,&number,CEXPRESSION,NOAUTO) != NAMENOTFOUND ) {
423  if ( e[number].status == STOREDEXPRESSION ) {
424 /*
425  Here we have to locate the stored expression, copy its index entry
426  possibly after making a new fileindex and then copy the whole
427  expression.
428 */
429  if ( AP.preError ) goto NextExpr;
430  TMproto[0] = EXPRESSION;
431  TMproto[1] = SUBEXPSIZE;
432  TMproto[2] = number;
433  TMproto[3] = 1;
434  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
435  AT.TMaddr = TMproto;
436  if ( ( indold = FindInIndex(number,&AR.StoreData,0,0) ) != 0 ) {
437  if ( i <= 0 ) {
438 /*
439  AO.SaveData.Index.next = filesize;
440 */
441  SeekFile(AO.SaveData.Handle,&(AO.SaveData.Index.next),SEEK_END);
442  scrpos = AO.SaveData.Position;
443  SeekFile(AO.SaveData.Handle,&scrpos,SEEK_SET);
444  if ( ISNOTEQUALPOS(scrpos,AO.SaveData.Position) ) goto SavWrt;
445  if ( WriteFile(AO.SaveData.Handle,(UBYTE *)(&(AO.SaveData.Index))
446  ,(LONG)sizeof(struct FiLeInDeX)) != (LONG)sizeof(struct FiLeInDeX) )
447  goto SavWrt;
448  i = (WORD)(INFILEINDEX);
449  AO.SaveData.Position = AO.SaveData.Index.next;
450  lo = (LONG *)(&AO.SaveData.Index);
451  for ( ii = 0; ii < j; ii++ ) *lo++ = 0;
452  ind = AO.SaveData.Index.expression;
453  scrpos = AO.SaveData.Position;
454  SeekFile(AO.SaveData.Handle,&scrpos,SEEK_SET);
455  if ( ISNOTEQUALPOS(scrpos,AO.SaveData.Position) ) goto SavWrt;
456  if ( WriteFile(AO.SaveData.Handle,(UBYTE *)(&(AO.SaveData.Index))
457  ,(LONG)sizeof(struct FiLeInDeX)) != (LONG)sizeof(struct FiLeInDeX) )
458  goto SavWrt;
459  ADDPOS(filesize,sizeof(struct FiLeInDeX));
460  }
461  *ind = *indold;
462 /*
463  ind->variables = SeekFile(AO.SaveData.Handle,&(AM.zeropos),SEEK_END);
464 */
465  ind->variables = filesize;
466  ind->position = ind->variables;
467  ADDPOS(ind->position,DIFBASE(indold->position,indold->variables));
468  SeekFile(AR.StoreData.Handle,&(indold->variables),SEEK_SET);
469  wSize = TOLONG(AT.WorkTop) - TOLONG(AT.WorkPointer);
470  scrpos = ind->length;
471  ADDPOS(scrpos,DIFBASE(ind->position,ind->variables));
472  ADD2POS(filesize,scrpos);
473  SETBASEPOSITION(scrpos1,wSize);
474  do {
475  if ( ISLESSPOS(scrpos,scrpos1) ) wSize = BASEPOSITION(scrpos);
476  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)AT.WorkPointer,wSize)
477  != wSize ) {
478  MesPrint("ReadError");
479  error = -1;
480  goto EndSave;
481  }
482  if ( WriteFile(AO.SaveData.Handle,(UBYTE *)AT.WorkPointer,wSize)
483  != wSize ) goto SavWrt;
484  ADDPOS(scrpos,-wSize);
485  } while ( ISPOSPOS(scrpos) );
486  ADDPOS(AO.SaveData.Index.number,1);
487  ind++;
488  }
489  else error = -1;
490  i--;
491  }
492  else {
493  MesPrint("%s is not a stored expression",inp);
494  error = -1;
495  }
496 NextExpr:;
497  }
498  else {
499  MesPrint("%s is not an expression",inp);
500  error = -1;
501  }
502  *p = c;
503  if ( c != ',' && c ) {
504  MesComp("Illegal character",inp,p);
505  error = -1;
506  goto EndSave;
507  }
508  if ( c ) c = *++p;
509  inp = p;
510  } while ( c );
511  if ( !AP.preError ) {
512  scrpos = AO.SaveData.Position;
513  SeekFile(AO.SaveData.Handle,&scrpos,SEEK_SET);
514  if ( ISNOTEQUALPOS(scrpos,AO.SaveData.Position) ) goto SavWrt;
515  }
516  if ( !AP.preError &&
517  WriteFile(AO.SaveData.Handle,(UBYTE *)(&(AO.SaveData.Index))
518  ,(LONG)sizeof(struct FiLeInDeX)) != (LONG)sizeof(struct FiLeInDeX) ) goto SavWrt;
519  }
520  else if ( !AP.preError ) { /* All stored expressions should be saved. Easy */
521  if ( n > 0 ) { do {
522  if ( e->status == STOREDEXPRESSION ) break;
523  e++;
524  } while ( --n > 0 ); }
525  if ( n ) {
526  wSize = TOLONG(AT.WorkTop) - TOLONG(AT.WorkPointer);
527  PUTZERO(scrpos);
528  SeekFile(AR.StoreData.Handle,&scrpos,SEEK_SET); /* Start at the beginning */
529  scrpos = AR.StoreData.Fill; /* Number of bytes to be copied */
530  SETBASEPOSITION(scrpos1,wSize);
531  do {
532  if ( ISLESSPOS(scrpos,scrpos1) ) wSize = BASEPOSITION(scrpos);
533  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)AT.WorkPointer,wSize) != wSize ) {
534  MesPrint("ReadError");
535  error = -1;
536  goto EndSave;
537  }
538  if ( WriteFile(AO.SaveData.Handle,(UBYTE *)AT.WorkPointer,wSize) != wSize )
539  goto SavWrt;
540  ADDPOS(scrpos,-wSize);
541  } while ( ISPOSPOS(scrpos) );
542  }
543  }
544 EndSave:
545  if ( !AP.preError ) {
546  CloseFile(AO.SaveData.Handle);
547  AO.SaveData.Handle = -1;
548  }
549  return(error);
550 SavWrt:
551  MesPrint("WriteError");
552  error = -1;
553  goto EndSave;
554 }
555 
556 /*
557  #] CoSave :
558  #[ CoLoad :
559 */
560 
561 int CoLoad(UBYTE *inp)
562 {
563  GETIDENTITY
564  INDEXENTRY *ind;
565  LONG RetCode;
566  UBYTE *p, c;
567  WORD num, i, error = 0;
568  WORD type, number, silentload = 0;
569  WORD TMproto[SUBEXPSIZE];
570  POSITION scrpos,firstposition;
571  while ( *inp == ',' ) inp++;
572  p = inp;
573  if ( ( *p == ',' && p[1] == '-' ) || *p == '-' ) {
574  if ( *p == ',' ) p++;
575  p++;
576  if ( *p == 's' || *p == 'S' ) {
577  silentload = 1;
578  while ( *p && ( *p != ',' && *p != '-' && *p != '+'
579  && *p != SEPARATOR && *p != ALTSEPARATOR && *p != '.' ) ) p++;
580  }
581  else if ( *p != ',' ) {
582  return(MesPrint("Illegal option in Load statement"));
583  }
584  while ( *p == ',' ) p++;
585  }
586  inp = p;
587  if ( !*p ) return(MesPrint("No filename in load statement"));
588  if ( FG.cTable[*p] > 1 && ( *p != '.' ) && ( *p != SEPARATOR ) && ( *p != ALTSEPARATOR ) )
589  return(MesPrint("Illegal filename"));
590  while ( *++p && *p != ',' ) {}
591  c = *p;
592  *p = 0;
593  if ( ( RetCode = OpenFile((char *)inp) ) < 0 ) {
594  return(MesPrint("Cannot open file %s",inp));
595  }
596 
597  if ( SetFileIndex() ) {
598  MesCall("CoLoad");
599  SETERROR(-1)
600  }
601 
602  AO.SaveData.Handle = (WORD)(RetCode);
603 
604 #ifdef SYSDEPENDENTSAVE
605  if ( ReadFile(AO.SaveData.Handle,(UBYTE *)(&(AO.SaveData.Index)),
606  (LONG)sizeof(struct FiLeInDeX)) != (LONG)sizeof(struct FiLeInDeX) ) goto LoadRead;
607 #else
608  if ( ReadSaveHeader() ) goto LoadRead;
609  TELLFILE(AO.SaveData.Handle,&firstposition);
610  if ( ReadSaveIndex(&AO.SaveData.Index) ) goto LoadRead;
611 #endif
612  if ( c ) { /* There follows a list of expressions */
613  *p++ = c;
614  inp = p;
615 
616  do { /* Scan the list */
617  if ( !FG.cTable[*p] || *p == '[' ) {
618  p = SkipAName(p);
619  if ( p == 0 ) return(-1);
620  }
621  c = *p; *p = 0;
622  if ( GetVar(inp,&type,&number,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
623  MesPrint("Conflicting name: %s",inp);
624  error = -1;
625  }
626  else {
627  if ( ( num = EntVar(CEXPRESSION,inp,STOREDEXPRESSION,0,0,0) ) >= 0 ) {
628  TMproto[0] = EXPRESSION;
629  TMproto[1] = SUBEXPSIZE;
630  TMproto[2] = num;
631  TMproto[3] = 1;
632  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
633  AT.TMaddr = TMproto;
634  SeekFile(AO.SaveData.Handle,&firstposition,SEEK_SET);
635  AO.SaveData.Position = firstposition;
636  if ( ReadSaveIndex(&AO.SaveData.Index) ) goto LoadRead;
637  if ( ( ind = FindInIndex(num,&AO.SaveData,1,0) ) != 0 ) {
638  if ( !error ) {
639  if ( PutInStore(ind,num) ) error = -1;
640  else if ( !AM.silent && silentload == 0 )
641  MesPrint(" %s loaded",ind->name);
642  }
643 /*
644 !!! Added 1-feb-1998
645 */
646  Expressions[num].counter = -1;
647  }
648  else {
649  MesPrint(" %s not found",inp);
650  error = -1;
651  }
652  }
653  else error = -1;
654  }
655  *p = c;
656  if ( c != ',' && c ) {
657  MesComp("Illegal character",inp,p);
658  error = -1;
659  goto EndLoad;
660  }
661  if ( c ) c = *++p;
662  inp = p;
663  } while ( c );
664  scrpos = AR.StoreData.Position;
665  SeekFile(AR.StoreData.Handle,&scrpos,SEEK_SET);
666  if ( ISNOTEQUALPOS(scrpos,AR.StoreData.Position) ) goto LoadWrt;
667  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)(&(AR.StoreData.Index))
668  ,(LONG)sizeof(struct FiLeInDeX)) != (LONG)sizeof(struct FiLeInDeX) ) goto LoadWrt;
669  }
670  else { /* All saved expressions should be stored. Easy */
671  i = (WORD)BASEPOSITION(AO.SaveData.Index.number);
672  ind = AO.SaveData.Index.expression;
673 #ifdef SYSDEPENDENTSAVE
674  if ( i > 0 ) { do {
675  if ( GetVar((UBYTE *)(ind->name),&type,&number,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
676  MesPrint("Conflicting name: %s",ind->name);
677  error = -1;
678  }
679  else {
680  if ( ( num = EntVar(CEXPRESSION,(UBYTE *)(ind->name),STOREDEXPRESSION,0,0,0) ) >= 0 ) {
681  if ( !error ) {
682  if ( PutInStore(ind,num) ) error = -1;
683  else if ( !AM.silent && silentload == 0 )
684  MesPrint(" %s loaded",ind->name);
685  }
686  }
687  else error = -1;
688  }
689  i--;
690  if ( i == 0 && ISNOTZEROPOS(AO.SaveData.Index.next) ) {
691  SeekFile(AO.SaveData.Handle,&(AO.SaveData.Index.next),SEEK_SET);
692  if ( ReadFile(AO.SaveData.Handle,(UBYTE *)(&(AO.SaveData.Index)),
693  (LONG)sizeof(struct FiLeInDeX)) != (LONG)sizeof(struct FiLeInDeX) ) goto LoadRead;
694  i = (WORD)BASEPOSITION(AO.SaveData.Index.number);
695  ind = AO.SaveData.Index.expression;
696  }
697  else ind++;
698  } while ( i > 0 ); }
699 #else
700  if ( i > 0 ) {
701  do {
702  if ( GetVar((UBYTE *)(ind->name),&type,&number,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
703  MesPrint("Conflicting name: %s",ind->name);
704  error = -1;
705  }
706  else {
707  if ( ( num = EntVar(CEXPRESSION,(UBYTE *)(ind->name),STOREDEXPRESSION,0,0,0) ) >= 0 ) {
708  if ( !error ) {
709  if ( PutInStore(ind,num) ) error = -1;
710  else if ( !AM.silent && silentload == 0 )
711  MesPrint(" %s loaded",ind->name);
712  }
713  }
714  else error = -1;
715  }
716  i--;
717  if ( i == 0 && (ISNOTZEROPOS(AO.SaveData.Index.next) || AO.bufferedInd) ) {
718  SeekFile(AO.SaveData.Handle,&(AO.SaveData.Index.next),SEEK_SET);
719  if ( ReadSaveIndex(&AO.SaveData.Index) ) goto LoadRead;
720  i = (WORD)BASEPOSITION(AO.SaveData.Index.number);
721  ind = AO.SaveData.Index.expression;
722  }
723  else ind++;
724  } while ( i > 0 );
725  }
726 #endif
727  }
728 EndLoad:
729 #ifndef SYSDEPENDENTSAVE
730  if ( AO.powerFlag ) {
731  MesPrint("WARNING: min-/maxpower had to be adjusted!");
732  }
733  if ( AO.resizeFlag ) {
734  MesPrint("ERROR: could not downsize data!");
735  return ( -2 );
736  }
737 #endif
738  CloseFile(AO.SaveData.Handle);
739  AO.SaveData.Handle = -1;
740  SeekFile(AR.StoreData.Handle,&(AC.StoreFileSize),SEEK_END);
741  return(error);
742 LoadWrt:
743  MesPrint("WriteError");
744  error = -1;
745  goto EndLoad;
746 LoadRead:
747  MesPrint("ReadError");
748  error = -1;
749  goto EndLoad;
750 }
751 
752 /*
753  #] CoLoad :
754  #[ DeleteStore :
755 
756  Routine deletes the contents of the entire storage file.
757  We close the file and recreate it.
758  If par > 0 we have to remove the expressions from the namelists.
759 */
760 
761 WORD DeleteStore(WORD par)
762 {
763  GETIDENTITY
764  char *s;
765  WORD j, n = 0;
766  EXPRESSIONS e_in, e_out;
767  WORD DidClean = 0;
768  if ( AR.StoreData.Handle >= 0 ) {
769  if ( par > 0 ) {
770  n = NumExpressions;
771  j = 0;
772  e_in = e_out = Expressions;
773  if ( n > 0 ) { do {
774  if ( e_in->status == STOREDEXPRESSION ) {
775  NAMENODE *node = GetNode(AC.exprnames,
776  AC.exprnames->namebuffer+e_in->name);
777  node->type = CDELETE;
778  DidClean = 1;
779  }
780  else {
781  if ( e_out != e_in ) {
782  NAMENODE *node;
783  node = GetNode(AC.exprnames,
784  AC.exprnames->namebuffer+e_in->name);
785  node->number = (WORD)(e_out - Expressions);
786  e_out->onfile = e_in->onfile;
787  e_out->prototype = e_in->prototype;
788  e_out->printflag = 0;
789  e_out->status = e_in->status;
790  e_out->name = e_in->name;
791  e_out->inmem = e_in->inmem;
792  e_out->counter = e_in->counter;
793  e_out->numfactors = e_in->numfactors;
794  e_out->numdummies = e_in->numdummies;
795  e_out->compression = e_in->compression;
796  e_out->namesize = e_in->namesize;
797  e_out->whichbuffer = e_in->whichbuffer;
798  e_out->hidelevel = e_in->hidelevel;
799  e_out->node = e_in->node;
800  e_out->replace = e_in->replace;
801  e_out->vflags = e_in->vflags;
802 #ifdef PARALLELCODE
803  e_out->partodo = e_in->partodo;
804 #endif
805  }
806  e_out++;
807  j++;
808  }
809  e_in++;
810  } while ( --n > 0 ); }
811  NumExpressions = j;
812  if ( DidClean ) CompactifyTree(AC.exprnames,EXPRNAMES);
813  }
814  AR.StoreData.Handle = -1;
815  CloseFile(AC.StoreHandle);
816  AC.StoreHandle = -1;
817  {
818 /*
819  Knock out the storage caches (25-apr-1990!)
820 */
821  STORECACHE st;
822  st = (STORECACHE)(AT.StoreCache);
823  while ( st ) {
824  SETBASEPOSITION(st->position,-1);
825  SETBASEPOSITION(st->toppos,-1);
826  st = st->next;
827  }
828 #ifdef WITHPTHREADS
829  for ( j = 1; j < AM.totalnumberofthreads; j++ ) {
830  st = (STORECACHE)(AB[j]->T.StoreCache);
831  while ( st ) {
832  SETBASEPOSITION(st->position,-1);
833  SETBASEPOSITION(st->toppos,-1);
834  st = st->next;
835  }
836  }
837 #endif
838  }
839  PUTZERO(AC.StoreFileSize);
840  s = FG.fname; while ( *s ) s++;
841 #ifdef VMS
842  *s = ';'; s[1] = '*'; s[2] = 0;
843  remove(FG.fname);
844  *s = 0;
845 #endif
846  return(AC.StoreHandle = CreateFile(FG.fname));
847  }
848  else return(0);
849 }
850 
851 /*
852  #] DeleteStore :
853  #[ PutInStore :
854 
855  Copies the expression indicated by ind from a load file to the
856  internal storage file. A return value of zero indicates that
857  everything is OK.
858 
859 */
860 
861 WORD PutInStore(INDEXENTRY *ind, WORD num)
862 {
863  GETIDENTITY
864  INDEXENTRY *newind;
865  LONG wSize;
866 #ifndef SYSDEPENDENTSAVE
867  LONG wSizeOut;
868  LONG stage;
869 #endif
870  POSITION scrpos,scrpos1;
871  newind = NextFileIndex(&(Expressions[num].onfile));
872  *newind = *ind;
873 #ifndef SYSDEPENDENTSAVE
874  SETBASEPOSITION(newind->length, 0);
875 #endif
876  newind->variables = AR.StoreData.Fill;
877  SeekFile(AR.StoreData.Handle,&(newind->variables),SEEK_SET);
878  if ( ISNOTEQUALPOS(newind->variables,AR.StoreData.Fill) ) goto PutErrS;
879  newind->position = newind->variables;
880 #ifdef SYSDEPENDENTSAVE
881  ADDPOS(newind->position,DIFBASE(ind->position,ind->variables));
882 #endif
883  /* set read position to ind->variables */
884  scrpos = ind->variables;
885  SeekFile(AO.SaveData.Handle,&scrpos,SEEK_SET);
886  if ( ISNOTEQUALPOS(scrpos,ind->variables) ) goto PutErrS;
887  /* set max size for read-in */
888  wSize = TOLONG(AT.WorkTop) - TOLONG(AT.WorkPointer);
889 #ifdef SYSDEPENDENTSAVE
890  scrpos = ind->length;
891  ADDPOS(scrpos,DIFBASE(ind->position,ind->variables));
892  ADD2POS(AR.StoreData.Fill,scrpos);
893 #endif
894  SETBASEPOSITION(scrpos1,wSize);
895 #ifndef SYSDEPENDENTSAVE
896  /* prepare look-up table for tensor functions */
897  if ( ind->nfunctions ) {
898  AO.tensorList = (UBYTE *)Malloc1(MAXSAVEFUNCTION,"PutInStore");
899  }
900  SETBASEPOSITION(scrpos, DIFBASE(ind->position,ind->variables));
901  /* copy variables first */
902  stage = -1;
903  do {
904  wSize = TOLONG(AT.WorkTop) - TOLONG(AT.WorkPointer);
905  if ( ISLESSPOS(scrpos,scrpos1) ) wSize = BASEPOSITION(scrpos);
906  wSizeOut = wSize;
907  if ( ReadSaveVariables(
908  (UBYTE *)AT.WorkPointer, (UBYTE *)AT.WorkTop, &wSize, &wSizeOut, ind, &stage) ) {
909  goto PutErrS;
910  }
911  if ( WriteFile(AR.StoreData.Handle, (UBYTE *)AT.WorkPointer, wSizeOut)
912  != wSizeOut ) goto PutErrS;
913  ADDPOS(scrpos,-wSize);
914  ADDPOS(newind->position, wSizeOut);
915  ADDPOS(AR.StoreData.Fill, wSizeOut);
916  } while ( ISPOSPOS(scrpos) );
917  /* then copy the expression itself */
918  wSize = TOLONG(AT.WorkTop) - TOLONG(AT.WorkPointer);
919  scrpos = ind->length;
920 #endif
921  do {
922  wSize = TOLONG(AT.WorkTop) - TOLONG(AT.WorkPointer);
923  if ( ISLESSPOS(scrpos,scrpos1) ) wSize = BASEPOSITION(scrpos);
924 #ifdef SYSDEPENDENTSAVE
925  if ( ReadFile(AO.SaveData.Handle,(UBYTE *)AT.WorkPointer,wSize)
926  != wSize ) goto PutErrS;
927  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)AT.WorkPointer,wSize)
928  != wSize ) goto PutErrS;
929  ADDPOS(scrpos,-wSize);
930 #else
931  wSizeOut = wSize;
932 
933  if ( ReadSaveExpression((UBYTE *)AT.WorkPointer, (UBYTE *)AT.WorkTop, &wSize, &wSizeOut) ) {
934  goto PutErrS;
935  }
936 
937  if ( WriteFile(AR.StoreData.Handle, (UBYTE *)AT.WorkPointer, wSizeOut)
938  != wSizeOut ) goto PutErrS;
939  ADDPOS(scrpos,-wSize);
940  ADDPOS(AR.StoreData.Fill, wSizeOut);
941  ADDPOS(newind->length, wSizeOut);
942 #endif
943  } while ( ISPOSPOS(scrpos) );
944  /* free look-up table for tensor functions */
945  if ( ind->nfunctions ) {
946  M_free(AO.tensorList,"PutInStore");
947  }
948  scrpos = AR.StoreData.Position;
949  SeekFile(AR.StoreData.Handle,&scrpos,SEEK_SET);
950  if ( ISNOTEQUALPOS(scrpos,AR.StoreData.Position) ) goto PutErrS;
951  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)(&AR.StoreData.Index),(LONG)sizeof(FILEINDEX))
952  == (LONG)sizeof(FILEINDEX) ) return(0);
953 PutErrS:
954  return(MesPrint("File error"));
955 }
956 
957 /*
958  #] PutInStore :
959  #[ GetTerm :
960 
961  Gets one term from input scratch stream.
962  Puts it in 'term'.
963  Returns the length of the term.
964 
965  Used by Processor (proces.c)
966  WriteAll (sch.c)
967  WriteOne (sch.c)
968  GetMoreTerms (store.c)
969  ToStorage (store.c)
970  CoFillExpression (comexpr.c)
971  FactorInExpr (factor.c)
972  LoadOpti (optim.c)
973  PF_Processor (parallel.c)
974  ThreadsProcessor (threads.c)
975  In multi thread/processor mode all calls are done by the master.
976  Note however that other routines, used by the threads, can use
977  the same file. Hence we need to be careful about SeekFile and locks.
978 */
979 
980 WORD GetTerm(PHEAD WORD *term)
981 {
982  GETBIDENTITY
983  WORD *inp, i, j = 0, len;
984  LONG InIn, *whichInInBuf;
985  WORD *r, *m, *mstop = 0, minsiz = 0, *bra = 0, *from;
986  WORD first, *start = 0, testing = 0;
987  FILEHANDLE *fi;
988  AN.deferskipped = 0;
989  if ( AR.GetFile == 2 ) {
990  fi = AR.hidefile;
991  whichInInBuf = &(AR.InHiBuf);
992  }
993  else {
994  fi = AR.infile;
995  whichInInBuf = &(AR.InInBuf);
996  }
997  InIn = *whichInInBuf;
998  from = term;
999  if ( AR.KeptInHold ) {
1000  r = AR.CompressBuffer;
1001  i = *r;
1002  AR.KeptInHold = 0;
1003  if ( i <= 0 ) { *term = 0; goto RegRet; }
1004  m = term;
1005  NCOPY(m,r,i);
1006  goto RegRet;
1007  }
1008  if ( AR.DeferFlag ) {
1009  m = AR.CompressBuffer;
1010  if ( *m > 0 ) {
1011  mstop = m + *m;
1012  mstop -= ABS(mstop[-1]);
1013  m++;
1014  while ( m < mstop ) {
1015  if ( *m == HAAKJE ) {
1016  testing = 1;
1017  mstop = m + m[1];
1018  bra = (WORD *)(((UBYTE *)(term)) + 2*AM.MaxTer);
1019  m = AR.CompressBuffer+1;
1020  r = bra;
1021  while ( m < mstop ) *r++ = *m++;
1022  mstop = r;
1023  minsiz = WORDDIF(mstop,bra);
1024  goto ReStart;
1025 /*
1026  We have the bracket to be tested in bra till mstop
1027 */
1028  }
1029  m += m[1];
1030  }
1031  }
1032  bra = (WORD *)(((UBYTE *)(term)) + 2*AM.MaxTer);
1033  mstop = bra+1;
1034  *bra = 0;
1035  minsiz = 1;
1036  testing = 1;
1037  }
1038 ReStart:
1039  first = 0;
1040  r = AR.CompressBuffer;
1041  if ( fi->handle >= 0 ) {
1042  if ( InIn <= 0 ) {
1043  ADDPOS(fi->POposition,(fi->POfull-fi->PObuffer)*sizeof(WORD));
1044  LOCK(AS.inputslock);
1045  SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
1046  InIn = ReadFile(fi->handle,(UBYTE *)(fi->PObuffer),fi->POsize);
1047  UNLOCK(AS.inputslock);
1048  if ( ( InIn < 0 ) || ( InIn & 1 ) ) {
1049  goto GTerr;
1050  }
1051 #ifdef WORD2
1052  InIn >>= 1;
1053 #else
1054  InIn /= TABLESIZE(WORD,UBYTE);
1055 #endif
1056  *whichInInBuf = InIn;
1057  if ( !InIn ) { *r = 0; *from = 0; goto RegRet; }
1058  fi->POfill = fi->PObuffer;
1059  fi->POfull = fi->PObuffer + InIn;
1060  }
1061  inp = fi->POfill;
1062  if ( ( len = i = *inp ) == 0 ) {
1063  (*whichInInBuf)--;
1064  (fi->POfill)++;
1065  *r = 0;
1066  *from = 0;
1067  goto RegRet;
1068  }
1069  if ( i < 0 ) {
1070  InIn--;
1071  inp++;
1072  r++;
1073  start = term;
1074  *term++ = -i + 1;
1075  while ( ++i <= 0 ) *term++ = *r++;
1076  if ( InIn > 0 ) {
1077  i = *inp++;
1078  InIn--;
1079  *start += i;
1080  *(AR.CompressBuffer) = len = *start;
1081  }
1082  else {
1083  first = 1;
1084  goto NewIn;
1085  }
1086  }
1087  InIn -= i;
1088  if ( InIn < 0 ) {
1089  j = (WORD)(- InIn);
1090  i -= j;
1091  }
1092  else j = 0;
1093  while ( --i >= 0 ) {
1094  *r++ = *term++ = *inp++;
1095  }
1096  if ( j ) {
1097 NewIn:
1098  ADDPOS(fi->POposition,(fi->POfull-fi->PObuffer)*sizeof(WORD));
1099  LOCK(AS.inputslock);
1100  SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
1101  InIn = ReadFile(fi->handle,(UBYTE *)(fi->PObuffer),fi->POsize);
1102  UNLOCK(AS.inputslock);
1103  if ( ( InIn <= 0 ) || ( InIn & 1 ) ) {
1104  goto GTerr;
1105  }
1106 #ifdef WORD2
1107  InIn >>= 1;
1108 #else
1109  InIn /= TABLESIZE(WORD,UBYTE);
1110 #endif
1111  inp = fi->PObuffer;
1112  fi->POfull = inp + InIn;
1113 
1114  if ( first ) {
1115  j = *inp++;
1116  InIn--;
1117  *start += j;
1118  *(AR.CompressBuffer) = len = *start;
1119  }
1120  InIn -= j;
1121  while ( --j >= 0 ) { *r++ = *term++ = *inp++; }
1122  }
1123  fi->POfill = inp;
1124  *whichInInBuf = InIn;
1125  AR.DefPosition = fi->POposition;
1126  ADDPOS(AR.DefPosition,((UBYTE *)(fi->POfill)-(UBYTE *)(fi->PObuffer)));
1127  }
1128  else {
1129  inp = fi->POfill;
1130  if ( inp >= fi->POfull ) { *from = 0; goto RegRet; }
1131  len = j = *inp;
1132  if ( j < 0 ) {
1133  inp++;
1134  *term++ = *r++ = len = - j + 1 + *inp;
1135  while ( ++j <= 0 ) *term++ = *r++;
1136  j = *inp++;
1137  }
1138  else if ( !j ) j = 1;
1139  while ( --j >= 0 ) { *r++ = *term++ = *inp++; }
1140  fi->POfill = inp;
1141 /*%%%%%ADDED 7-apr-2006 for Keep Brackets in bucket */
1142  SETBASEPOSITION(AR.DefPosition,((UBYTE *)(fi->POfill)-(UBYTE *)(fi->PObuffer)));
1143  if ( inp > fi->POfull ) {
1144  goto GTerr;
1145  }
1146  }
1147  if ( r >= AR.ComprTop ) {
1148  MesPrint("CompressSize of %10l is insufficient",AM.CompressSize);
1149  Terminate(-1);
1150  }
1151  AR.CompressPointer = r; *r = 0;
1152 /*
1153  The next *from is a bug fix that made the program read in forbidden
1154  territory.
1155 */
1156  if ( testing && *from != 0 ) {
1157  WORD jj;
1158  r = from;
1159  jj = *r - 1 - ABS(*(r+*r-1));
1160  if ( jj < minsiz ) goto strip;
1161  r++;
1162  m = bra;
1163  while ( m < mstop ) {
1164  if ( *m != *r ) {
1165 strip: r = from;
1166  m = r + *r;
1167  mstop = m - ABS(m[-1]);
1168  r++;
1169  while ( r < mstop ) {
1170  if ( *r == HAAKJE ) {
1171  *r++ = 1;
1172  *r++ = 1;
1173  *r++ = 3;
1174  len = WORDDIF(r,from);
1175  *from = len;
1176  goto RegRet;
1177  }
1178  r += r[1];
1179  }
1180  goto RegRet;
1181  }
1182  m++;
1183  r++;
1184  }
1185  term = from;
1186  AN.deferskipped++;
1187  goto ReStart;
1188  }
1189 RegRet:;
1190 /*
1191  #[ debug :
1192 */
1193  {
1194  UBYTE OutBuf[140];
1195 /* if ( AP.DebugFlag ) { */
1196  if ( ( AP.PreDebug & DUMPINTERMS ) == DUMPINTERMS ) {
1197  MLOCK(ErrorMessageLock);
1198  AO.OutFill = AO.OutputLine = OutBuf;
1199  AO.OutSkip = 3;
1200  FiniLine();
1201  r = from;
1202  i = *r;
1203  TokenToLine((UBYTE *)("Input: "));
1204  if ( i == 0 ) {
1205  TokenToLine((UBYTE *)"zero");
1206  }
1207  else if ( i < 0 ) {
1208  TokenToLine((UBYTE *)"negative!!");
1209  }
1210  else {
1211  while ( --i >= 0 ) {
1212  TalToLine((UWORD)(*r++)); TokenToLine((UBYTE *)" ");
1213  }
1214  }
1215  FiniLine();
1216  MUNLOCK(ErrorMessageLock);
1217  }
1218  }
1219 /*
1220  #] debug :
1221 */
1222  return(*from);
1223 GTerr:
1224  MesPrint("Error while reading scratch file in GetTerm");
1225  Terminate(-1);
1226  return(-1);
1227 }
1228 
1229 /*
1230  #] GetTerm :
1231  #[ GetOneTerm :
1232 
1233  Gets one term from stream AR.infile->handle.
1234  Puts it in 'term'.
1235  Returns the length of the term.
1236  Input is unbuffered.
1237  Compression via AR.CompressPointer
1238  par is actually in all calls a file handle
1239 
1240  Routine is called from
1241  DoOnePow Get one power of an expression
1242  Deferred Get the contents of a bracket
1243  GetFirstBracket
1244  FindBracket
1245  We should do something about the lack of buffering.
1246  Maybe a buffer of a few times AM.MaxTer (MaxTermSize*sizeof(WORD)).
1247  Each thread will need its own buffer!
1248 
1249  If par == 0 we use ReadPosFile which can fill the whole buffer.
1250  If par == 1 we use ReadFile and do actual read operations.
1251 
1252  Note: we cannot use ReadPosFile when running in the master thread.
1253 */
1254 
1255 WORD GetOneTerm(PHEAD WORD *term, FILEHANDLE *fi, POSITION *pos, int par)
1256 {
1257  GETBIDENTITY
1258  WORD i, *p;
1259  LONG j, siz;
1260  WORD *r, *rr = AR.CompressPointer;
1261  int error = 0;
1262  r = rr;
1263  if ( fi->handle >= 0 ) {
1264 #ifdef READONEBYONE
1265 #ifdef WITHPTHREADS
1266 /*
1267  This code needs some investigation.
1268  It may be that we should do this always.
1269  It may be that even for workers it is no good.
1270  We may have to make a variable like AM.ReadDirect with
1271  if ( AM.ReadDirect ) par = 1;
1272  and a user command like
1273  On ReadDirect;
1274 */
1275  if ( AT.identity > 0 ) par = 1;
1276 #endif
1277 #endif
1278 /*
1279  To be changed:
1280  1: check first whether the term lies completely inside the buffer
1281  2: if not a: use old strategy for AT.identity == 0 (master)
1282  b: for workers, position file and read buffer
1283 */
1284  if ( par == 0 ) {
1285  siz = ReadPosFile(BHEAD fi,(UBYTE *)term,1L,pos);
1286  }
1287  else {
1288  LOCK(AS.inputslock);
1289  SeekFile(fi->handle,pos,SEEK_SET);
1290  siz = ReadFile(fi->handle,(UBYTE *)term,sizeof(WORD));
1291  UNLOCK(AS.inputslock);
1292  ADDPOS(*pos,siz);
1293  }
1294  if ( siz == sizeof(WORD) ) {
1295  p = term;
1296  j = i = *term++;
1297  if ( ( i > AM.MaxTer/((WORD)sizeof(WORD)) ) || ( -i >= AM.MaxTer/((WORD)sizeof(WORD)) ) )
1298  {
1299  error = 1;
1300  goto ErrGet;
1301  }
1302  r++;
1303  if ( i < 0 ) {
1304  *p = -i + 1;
1305  while ( ++i <= 0 ) *term++ = *r++;
1306  if ( par == 0 ) {
1307  siz = ReadPosFile(BHEAD fi,(UBYTE *)term,1L,pos);
1308  }
1309  else {
1310  LOCK(AS.inputslock);
1311  SeekFile(fi->handle,pos,SEEK_SET);
1312  siz = ReadFile(fi->handle,(UBYTE *)term,sizeof(WORD));
1313  UNLOCK(AS.inputslock);
1314  ADDPOS(*pos,sizeof(WORD));
1315  }
1316  if ( siz != sizeof(WORD) ) {
1317  error = 2;
1318  goto ErrGet;
1319  }
1320  *p += *term;
1321  j = *term;
1322  if ( ( j > AM.MaxTer/((WORD)sizeof(WORD)) ) || ( j <= 0 ) )
1323  {
1324  error = 3;
1325  goto ErrGet;
1326  }
1327  *rr = *p;
1328  }
1329  else {
1330  if ( !j ) return(0);
1331  j--;
1332  }
1333  i = (WORD)j;
1334  if ( par == 0 ) {
1335  siz = ReadPosFile(BHEAD fi,(UBYTE *)term,j,pos);
1336  j *= TABLESIZE(WORD,UBYTE);
1337  }
1338  else {
1339  j *= TABLESIZE(WORD,UBYTE);
1340  LOCK(AS.inputslock);
1341  SeekFile(fi->handle,pos,SEEK_SET);
1342  siz = ReadFile(fi->handle,(UBYTE *)term,j);
1343  UNLOCK(AS.inputslock);
1344  ADDPOS(*pos,j);
1345  }
1346  if ( siz != j ) {
1347  error = 4;
1348  goto ErrGet;
1349  }
1350  while ( --i >= 0 ) *r++ = *term++;
1351  if ( r >= AR.ComprTop ) {
1352  MLOCK(ErrorMessageLock);
1353  MesPrint("CompressSize of %10l is insufficient",AM.CompressSize);
1354  MUNLOCK(ErrorMessageLock);
1355  Terminate(-1);
1356  }
1357  AR.CompressPointer = r; *r = 0;
1358  return(*p);
1359  }
1360  error = 5;
1361  }
1362  else {
1363 /*
1364  Here the whole expression is in the buffer.
1365 */
1366  fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(*pos));
1367  p = fi->POfill;
1368  if ( p >= fi->POfull ) { *term = 0; return(0); }
1369  j = i = *p;
1370  if ( i < 0 ) {
1371  p++;
1372  j = *r++ = *term++ = -i + 1 + *p;
1373  while ( ++i <= 0 ) *term++ = *r++;
1374  i = *p++;
1375  }
1376  if ( i == 0 ) { i = 1; *r++ = 0; *term++ = 0; }
1377  else { while ( --i >= 0 ) { *r++ = *term++ = *p++; } }
1378  fi->POfill = p;
1379  SETBASEPOSITION(*pos,(UBYTE *)(fi->POfill)-(UBYTE *)(fi->PObuffer));
1380  if ( p <= fi->POfull ) {
1381  if ( r >= AR.ComprTop ) {
1382  MLOCK(ErrorMessageLock);
1383  MesPrint("CompressSize of %10l is insufficient",AM.CompressSize);
1384  MUNLOCK(ErrorMessageLock);
1385  Terminate(-1);
1386  }
1387  AR.CompressPointer = r; *r = 0;
1388  return((WORD)j);
1389  }
1390  error = 6;
1391  }
1392 ErrGet:
1393  MLOCK(ErrorMessageLock);
1394  MesPrint("Error while reading scratch file in GetOneTerm (%d)",error);
1395  MUNLOCK(ErrorMessageLock);
1396  Terminate(-1);
1397  return(-1);
1398 }
1399 
1400 /*
1401  #] GetOneTerm :
1402  #[ GetMoreTerms :
1403  Routine collects more contents of brackets inside a function,
1404  indicated by the number in AC.CollectFun.
1405  The first term is in term already.
1406  We can keep calling GetTerm either till a bracket is finished
1407  or till it would make the term too long (> AM.MaxTer/2)
1408  In all cases this function makes that the routine GetTerm
1409  has a term in 'hold', so the AR.KeptInHold flag must be turned on.
1410 */
1411 
1412 WORD GetMoreTerms(WORD *term)
1413 {
1414  GETIDENTITY
1415  WORD *t, *r, *m, *h, *tstop, i, inc, same;
1416  WORD extra;
1417  WORD retval = 0;
1418 /*
1419  We use 23% as a quasi-random default value.
1420 */
1421  extra = ((AM.MaxTer/sizeof(WORD))*((LONG)100-AC.CollectPercentage))/100;
1422  if ( extra < 23 ) extra = 23;
1423 /*
1424  First find the bracket pointer
1425 */
1426  t = term + *term;
1427  tstop = t - ABS(t[-1]);
1428  h = term+1;
1429  while ( *h != HAAKJE && h < tstop ) h += h[1];
1430  if ( h >= tstop ) return(retval);
1431  inc = FUNHEAD+ARGHEAD+1-h[1];
1432  same = WORDDIF(h,term) + h[1] - 1;
1433  r = m = t + inc;
1434  tstop = h + h[1];
1435  while ( t > tstop ) *--r = *--t;
1436  r--;
1437  *r = WORDDIF(m,r);
1438  while ( GetTerm(BHEAD m) > 0 ) {
1439  r = m + 1;
1440  t = m + *m - 1;
1441  if ( same > ( i = ( *m - ABS(*t) -1 ) ) ) { /* Must fail */
1442  if ( AC.AltCollectFun && AS.CollectOverFlag == 2 ) AS.CollectOverFlag = 3;
1443  break;
1444  }
1445  t = term+1;
1446  i = same;
1447  while ( --i >= 0 ) {
1448  if ( *r != *t ) {
1449  if ( AC.AltCollectFun && AS.CollectOverFlag == 2 ) AS.CollectOverFlag = 3;
1450  goto FullTerm;
1451  }
1452  r++; t++;
1453  }
1454  if ( ( WORDDIF(m,term) + i + extra ) > (WORD)(AM.MaxTer/sizeof(WORD)) ) {
1455 /* 23 = 3 +20. The 20 is to have some extra for substitutions or whatever */
1456  if ( AS.CollectOverFlag == 0 && AC.AltCollectFun == 0 ) {
1457  Warning("Bracket contents too long in Collect statement");
1458  Warning("Contents spread over more than one term");
1459  Warning("If possible: increase MaxTermSize in setfile");
1460  AS.CollectOverFlag = 1;
1461  }
1462  else if ( AC.AltCollectFun ) {
1463  AS.CollectOverFlag = 2;
1464  }
1465  break;
1466  }
1467  tstop = m + *m;
1468  *m -= same;
1469  m++;
1470  while ( r < tstop ) *m++ = *r++;
1471  retval++;
1472  if ( extra == 23 ) extra = ((AM.MaxTer/sizeof(WORD))/6);
1473  }
1474 FullTerm:
1475  h[1] = WORDDIF(m,h);
1476  if ( AS.CollectOverFlag > 1 ) {
1477  *h = AC.AltCollectFun;
1478  if ( AS.CollectOverFlag == 3 ) AS.CollectOverFlag = 1;
1479  }
1480  else *h = AC.CollectFun;
1481  h[2] |= DIRTYFLAG;
1482  h[FUNHEAD] = h[1] - FUNHEAD;
1483  h[FUNHEAD+1] = 0;
1484  if ( ToFast(h+FUNHEAD,h+FUNHEAD) ) {
1485  if ( h[FUNHEAD] <= -FUNCTION ) {
1486  h[1] = FUNHEAD+1;
1487  m = h + FUNHEAD+1;
1488  }
1489  else {
1490  h[1] = FUNHEAD+2;
1491  m = h + FUNHEAD+2;
1492  }
1493  }
1494  *m++ = 1;
1495  *m++ = 1;
1496  *m++ = 3;
1497  *term = WORDDIF(m,term);
1498  AR.KeptInHold = 1;
1499  return(retval);
1500 }
1501 
1502 /*
1503  #] GetMoreTerms :
1504  #[ GetMoreFromMem :
1505 
1506 */
1507 
1508 WORD GetMoreFromMem(WORD *term, WORD **tpoin)
1509 {
1510  GETIDENTITY
1511  WORD *t, *r, *m, *h, *tstop, i, j, inc, same;
1512  LONG extra = 23;
1513 /*
1514  First find the bracket pointer
1515 */
1516  t = term + *term;
1517  tstop = t - ABS(t[-1]);
1518  h = term+1;
1519  while ( *h != HAAKJE && h < tstop ) h += h[1];
1520  if ( h >= tstop ) return(0);
1521  inc = FUNHEAD+ARGHEAD+1-h[1];
1522  same = WORDDIF(h,term) + h[1] - 1;
1523  r = m = t + inc;
1524  tstop = h + h[1];
1525  while ( t > tstop ) *--r = *--t;
1526  r--;
1527  *r = WORDDIF(m,r);
1528  while ( **tpoin ) {
1529  r = *tpoin; j = *r;
1530  for ( i = 0; i < j; i++ ) m[i] = *r++;
1531  *tpoin = r;
1532  r = m + 1;
1533  t = m + *m - 1;
1534  if ( same > ( i = ( *m - ABS(*t) -1 ) ) ) { /* Must fail */
1535  if ( AC.AltCollectFun && AS.CollectOverFlag == 2 ) AS.CollectOverFlag = 3;
1536  break;
1537  }
1538  t = term+1;
1539  i = same;
1540  while ( --i >= 0 ) {
1541  if ( *r != *t ) {
1542  if ( AC.AltCollectFun && AS.CollectOverFlag == 2 ) AS.CollectOverFlag = 3;
1543  goto FullTerm;
1544  }
1545  r++; t++;
1546  }
1547  if ( ( WORDDIF(m,term) + i + extra ) > (LONG)(AM.MaxTer/(2*sizeof(WORD))) ) {
1548 /* 23 = 3 +20. The 20 is to have some extra for substitutions or whatever */
1549  if ( AS.CollectOverFlag == 0 && AC.AltCollectFun == 0 ) {
1550  Warning("Bracket contents too long in Collect statement");
1551  Warning("Contents spread over more than one term");
1552  Warning("If possible: increase MaxTermSize in setfile");
1553  AS.CollectOverFlag = 1;
1554  }
1555  else if ( AC.AltCollectFun ) {
1556  AS.CollectOverFlag = 2;
1557  }
1558  break;
1559  }
1560  tstop = m + *m;
1561  *m -= same;
1562  m++;
1563  while ( r < tstop ) *m++ = *r++;
1564  if ( extra == 23 ) extra = ((AM.MaxTer/sizeof(WORD))/6);
1565  }
1566 FullTerm:
1567  h[1] = WORDDIF(m,h);
1568  if ( AS.CollectOverFlag > 1 ) {
1569  *h = AC.AltCollectFun;
1570  if ( AS.CollectOverFlag == 3 ) AS.CollectOverFlag = 1;
1571  }
1572  else *h = AC.CollectFun;
1573  h[2] |= DIRTYFLAG;
1574  h[FUNHEAD] = h[1] - FUNHEAD;
1575  h[FUNHEAD+1] = 0;
1576  if ( ToFast(h+FUNHEAD,h+FUNHEAD) ) {
1577  if ( h[FUNHEAD] <= -FUNCTION ) {
1578  h[1] = FUNHEAD+1;
1579  m = h + FUNHEAD+1;
1580  }
1581  else {
1582  h[1] = FUNHEAD+2;
1583  m = h + FUNHEAD+2;
1584  }
1585  }
1586  *m++ = 1;
1587  *m++ = 1;
1588  *m++ = 3;
1589  *term = WORDDIF(m,term);
1590  AR.KeptInHold = 1;
1591  return(0);
1592 }
1593 
1594 /*
1595  #] GetMoreFromMem :
1596  #[ GetFromStore :
1597 
1598  Gets a single term from the storage file at position and puts
1599  it at 'to'.
1600  The value to be returned is the number of words read.
1601  Renumbering is done also.
1602  This is controled by the renumber table, given in 'renumber'
1603 
1604  This routine should work with a number of cache buffers. The
1605  exact number should be definable in form.set.
1606  The parameters are:
1607  AM.SizeStoreCache (4096)
1608  The numbers are the proposed default values.
1609 
1610  The cache is a pure read cache.
1611 */
1612 
1613 static int gfs = 0;
1614 
1615 WORD GetFromStore(WORD *to, POSITION *position, RENUMBER renumber, WORD *InCompState, WORD nexpr)
1616 {
1617  GETIDENTITY
1618  LONG RetCode, num, first = 0;
1619  WORD *from, *m;
1620  struct StOrEcAcHe sc;
1621  STORECACHE s;
1622  STORECACHE snext, sold;
1623  WORD *r, *rr = AR.CompressPointer;
1624  r = rr;
1625  gfs++;
1626  sc.next = AT.StoreCache;
1627  sold = s = &sc;
1628  snext = s->next;
1629  while ( snext ) {
1630  sold = s;
1631  s = snext;
1632  snext = s->next;
1633  if ( BASEPOSITION(s->position) == -1 ) break;
1634  if ( ISLESSPOS(*position,s->toppos) &&
1635  ISGEPOS(*position,s->position) ) { /* Hit */
1636  if ( AT.StoreCache != s ) {
1637  sold->next = s->next;
1638  s->next = AT.StoreCache->next;
1639  AT.StoreCache = s;
1640  }
1641  from = (WORD *)(((UBYTE *)(s->buffer)) + DIFBASE(*position,s->position));
1642  num = *from;
1643  if ( !num ) { return(*to = 0); }
1644  *InCompState = (WORD)num;
1645  m = to;
1646  if ( num < 0 ) {
1647  from++;
1648  ADDPOS(*position,sizeof(WORD));
1649  *m++ = (WORD)(-num+1);
1650  r++;
1651  while ( ++num <= 0 ) *m++ = *r++;
1652  if ( ISLESSPOS(*position,s->toppos) ) {
1653  num = *from++;
1654  *to += (WORD)num;
1655  ADDPOS(*position,sizeof(WORD));
1656  *InCompState = (WORD)(num + 2);
1657  }
1658  else {
1659  first = 1;
1660  goto InNew;
1661  }
1662  }
1663 PastCon:;
1664  while ( num > 0 && ISLESSPOS(*position,s->toppos) ) {
1665  *r++ = *m++ = *from++; ADDPOS(*position,sizeof(WORD)); num--;
1666  }
1667  if ( num > 0 ) {
1668 InNew:
1669  SETBASEPOSITION(s->position,-1);
1670  SETBASEPOSITION(s->toppos,-1);
1671  LOCK(AM.storefilelock);
1672  SeekFile(AR.StoreData.Handle,position,SEEK_SET);
1673  RetCode = ReadFile(AR.StoreData.Handle,(UBYTE *)(s->buffer),AM.SizeStoreCache);
1674  UNLOCK(AM.storefilelock);
1675  if ( RetCode < 0 ) goto PastErr;
1676  if ( !RetCode ) return( *to = 0 );
1677  s->position = *position;
1678  s->toppos = *position;
1679  ADDPOS(s->toppos,RetCode);
1680  from = s->buffer;
1681  if ( first ) {
1682  num = *from++;
1683  ADDPOS(*position,sizeof(WORD));
1684  *to += (WORD)num;
1685 /* first = 0; */
1686  *InCompState = (WORD)(num + 2);
1687  }
1688  goto PastCon;
1689  }
1690  goto PastEnd;
1691  }
1692  }
1693  if ( AT.StoreCache ) { /* Fill the last buffer */
1694  s->position = *position;
1695  LOCK(AM.storefilelock);
1696  SeekFile(AR.StoreData.Handle,position,SEEK_SET);
1697  RetCode = ReadFile(AR.StoreData.Handle,(UBYTE *)(s->buffer),AM.SizeStoreCache);
1698  UNLOCK(AM.storefilelock);
1699  if ( RetCode < 0 ) goto PastErr;
1700  if ( !RetCode ) return( *to = 0 );
1701  s->toppos = *position;
1702  ADDPOS(s->toppos,RetCode);
1703  if ( AT.StoreCache != s ) {
1704  sold->next = s->next;
1705  s->next = AT.StoreCache->next;
1706  AT.StoreCache = s;
1707  }
1708  m = to;
1709  from = s->buffer;
1710  num = *from;
1711  if ( !num ) { return( *to = 0 ); }
1712  *InCompState = (WORD)num;
1713  if ( num < 0 ) {
1714  *m++ = (WORD)(-num+1);
1715  r++;
1716  from++;
1717  ADDPOS(*position,sizeof(WORD));
1718  while ( ++num <= 0 ) *m++ = *r++;
1719  num = *from++;
1720  *to += (WORD)num;
1721  ADDPOS(*position,sizeof(WORD));
1722  *InCompState = (WORD)(num+2);
1723  }
1724  goto PastCon;
1725  }
1726 /* No caching available */
1727  LOCK(AM.storefilelock);
1728  SeekFile(AR.StoreData.Handle,position,SEEK_SET);
1729  RetCode = ReadFile(AR.StoreData.Handle,(UBYTE *)to,(LONG)sizeof(WORD));
1730  SeekFile(AR.StoreData.Handle,position,SEEK_CUR);
1731  UNLOCK(AM.storefilelock);
1732  if ( RetCode != sizeof(WORD) ) {
1733  *to = 0;
1734  return((WORD)RetCode);
1735  }
1736  if ( !*to ) return(0);
1737  m = to;
1738  if ( *to < 0 ) {
1739  num = *m++;
1740  *to = *r++ = (WORD)(-num + 1);
1741  while ( ++num <= 0 ) *m++ = *r++;
1742  LOCK(AM.storefilelock);
1743  SeekFile(AR.StoreData.Handle,position,SEEK_SET);
1744  RetCode = ReadFile(AR.StoreData.Handle,(UBYTE *)m,(LONG)sizeof(WORD));
1745  SeekFile(AR.StoreData.Handle,position,SEEK_CUR);
1746  UNLOCK(AM.storefilelock);
1747  if ( RetCode != sizeof(WORD) ) {
1748  MLOCK(ErrorMessageLock);
1749  MesPrint("@Error in compression of store file");
1750  MUNLOCK(ErrorMessageLock);
1751  return(-1);
1752  }
1753  num = *m;
1754  *to += (WORD)num;
1755  *InCompState = (WORD)(num + 2);
1756  }
1757  else {
1758  *InCompState = *to;
1759  num = *to - 1; m = to + 1; r = rr + 1;
1760  }
1761  first = num;
1762  num *= wsizeof(WORD);
1763  if ( num < 0 ) {
1764  MLOCK(ErrorMessageLock);
1765  MesPrint("@Error in stored expressions file at position %9p",position);
1766  MUNLOCK(ErrorMessageLock);
1767  return(-1);
1768  }
1769  LOCK(AM.storefilelock);
1770  SeekFile(AR.StoreData.Handle,position,SEEK_SET);
1771  RetCode = ReadFile(AR.StoreData.Handle,(UBYTE *)m,num);
1772  SeekFile(AR.StoreData.Handle,position,SEEK_CUR);
1773  UNLOCK(AM.storefilelock);
1774  if ( RetCode != num ) {
1775  MLOCK(ErrorMessageLock);
1776  MesPrint("@Error in stored expressions file at position %9p",position);
1777  MUNLOCK(ErrorMessageLock);
1778  return(-1);
1779  }
1780  NCOPY(r,m,first);
1781 PastEnd:
1782  *rr = *to;
1783  if ( r >= AR.ComprTop ) {
1784  MLOCK(ErrorMessageLock);
1785  MesPrint("CompressSize of %10l is insufficient",AM.CompressSize);
1786  MUNLOCK(ErrorMessageLock);
1787  Terminate(-1);
1788  }
1789  AR.CompressPointer = r; *r = 0;
1790  if ( !TermRenumber(to,renumber,nexpr) ) {
1791  MarkDirty(to,DIRTYSYMFLAG);
1792  if ( AR.CurDum > AM.IndDum && Expressions[nexpr].numdummies > 0 )
1793  MoveDummies(BHEAD to,AR.CurDum - AM.IndDum);
1794  return((WORD)*to);
1795  }
1796 PastErr:
1797  MLOCK(ErrorMessageLock);
1798  MesCall("GetFromStore");
1799  MUNLOCK(ErrorMessageLock);
1800  SETERROR(-1)
1801 }
1802 
1803 /*
1804  #] GetFromStore :
1805  #[ DetVars : VOID DetVars(term)
1806 
1807  Determines which variables are used in term.
1808 
1809  When par = 1 we are scanning a prototype expression which involves
1810  completely different rules.
1811 
1812 */
1813 
1814 VOID DetVars(WORD *term, WORD par)
1815 {
1816  GETIDENTITY
1817  WORD *stopper;
1818  WORD *t, sym;
1819  WORD *sarg;
1820  stopper = term + *term - 1;
1821  stopper = stopper - ABS(*stopper) + 1;
1822  term++;
1823  if ( par ) { /* Prototype expression */
1824  WORD n;
1825  if ( ( n = NumSymbols ) > 0 ) {
1826  SYMBOLS tt;
1827  tt = symbols;
1828  do {
1829  (tt++)->flags &= ~INUSE;
1830  } while ( --n > 0 );
1831  }
1832  if ( ( n = NumIndices ) > 0 ) {
1833  INDICES tt;
1834  tt = indices;
1835  do {
1836  (tt++)->flags &= ~INUSE;
1837  } while ( --n > 0 );
1838  }
1839  if ( ( n = NumVectors ) > 0 ) {
1840  VECTORS tt;
1841  tt = vectors;
1842  do {
1843  (tt++)->flags &= ~INUSE;
1844  } while ( --n > 0 );
1845  }
1846  if ( ( n = NumFunctions ) > 0 ) {
1847  FUNCTIONS tt;
1848  tt = functions;
1849  do {
1850  (tt++)->flags &= ~INUSE;
1851  } while ( --n > 0 );
1852  }
1853  term += SUBEXPSIZE;
1854  while ( term < stopper ) {
1855  if ( *term == SYMTOSYM || *term == SYMTONUM ) {
1856  term += 2;
1857  AN.UsedSymbol[*term] = 1;
1858  symbols[*term].flags |= INUSE;
1859  }
1860  else if ( *term == VECTOVEC ) {
1861  term += 2;
1862  AN.UsedVector[*term-AM.OffsetVector] = 1;
1863  vectors[*term-AM.OffsetVector].flags |= INUSE;
1864  }
1865  else if ( *term == INDTOIND ) {
1866  term += 2;
1867  sym = indices[*term - AM.OffsetIndex].dimension;
1868  if ( sym < 0 ) AN.UsedSymbol[-sym] = 1;
1869  AN.UsedIndex[(*term) - AM.OffsetIndex] = 1;
1870  sym = indices[*term-AM.OffsetIndex].nmin4;
1871  if ( sym < -NMIN4SHIFT ) AN.UsedSymbol[-sym-NMIN4SHIFT] = 1;
1872  indices[*term-AM.OffsetIndex].flags |= INUSE;
1873  }
1874  else if ( *term == FUNTOFUN ) {
1875  term += 2;
1876  AN.UsedFunction[*term-FUNCTION] = 1;
1877  functions[*term-FUNCTION].flags |= INUSE;
1878  }
1879  term += 2;
1880  }
1881  }
1882  else {
1883  while ( term < stopper ) {
1884  t = term + term[1];
1885  if ( *term == SYMBOL ) {
1886  term += 2;
1887  do {
1888  AN.UsedSymbol[*term] = 1;
1889  term += 2;
1890  } while ( term < t );
1891  }
1892  else if ( *term == DOTPRODUCT ) {
1893  term += 2;
1894  do {
1895  AN.UsedVector[(*term++) - AM.OffsetVector] = 1;
1896  AN.UsedVector[(*term) - AM.OffsetVector] = 1;
1897  term += 2;
1898  } while ( term < t );
1899  }
1900  else if ( *term == VECTOR ) {
1901  term += 2;
1902  do {
1903  AN.UsedVector[(*term++) - AM.OffsetVector] = 1;
1904  if ( *term >= AM.OffsetIndex && *term < AM.DumInd ) {
1905  sym = indices[*term - AM.OffsetIndex].dimension;
1906  if ( sym < 0 ) AN.UsedSymbol[-sym] = 1;
1907  AN.UsedIndex[*term - AM.OffsetIndex] = 1;
1908  sym = indices[(*term++)-AM.OffsetIndex].nmin4;
1909  if ( sym < -NMIN4SHIFT ) AN.UsedSymbol[-sym-NMIN4SHIFT] = 1;
1910  }
1911  else term++;
1912  } while ( term < t );
1913  }
1914  else if ( *term == INDEX || *term == LEVICIVITA || *term == GAMMA
1915  || *term == DELTA ) {
1916 /*
1917 Tensors:
1918  term += 2;
1919 */
1920  if ( *term == INDEX || *term == DELTA ) term += 2;
1921  else {
1922 Tensors:
1923  term += FUNHEAD;
1924  }
1925  while ( term < t ) {
1926  if ( *term >= AM.OffsetIndex && *term < AM.DumInd ) {
1927  sym = indices[*term - AM.OffsetIndex].dimension;
1928  if ( sym < 0 ) AN.UsedSymbol[-sym] = 1;
1929  AN.UsedIndex[(*term) - AM.OffsetIndex] = 1;
1930  sym = indices[*term-AM.OffsetIndex].nmin4;
1931  if ( sym < -NMIN4SHIFT ) AN.UsedSymbol[-sym-NMIN4SHIFT] = 1;
1932  }
1933  else if ( *term < (WILDOFFSET+AM.OffsetVector) )
1934  AN.UsedVector[(*term) - AM.OffsetVector] = 1;
1935  term++;
1936  }
1937  }
1938  else if ( *term == HAAKJE ) term = t;
1939  else {
1940  if ( *term > MAXBUILTINFUNCTION )
1941  AN.UsedFunction[(*term)-FUNCTION] = 1;
1942  if ( *term >= FUNCTION && functions[*term-FUNCTION].spec
1943  >= TENSORFUNCTION && term[1] > FUNHEAD ) goto Tensors;
1944  term += FUNHEAD; /* First argument */
1945  while ( term < t ) {
1946  sarg = term;
1947  NEXTARG(sarg)
1948  if ( *term > 0 ) {
1949  sarg = term + *term; /* End of argument */
1950  term += ARGHEAD; /* First term in argument */
1951  if ( term < sarg ) { do {
1952  DetVars(term,par);
1953  term += *term;
1954  } while ( term < sarg ); }
1955  }
1956  else {
1957  if ( *term < -MAXBUILTINFUNCTION ) {
1958  AN.UsedFunction[-*term-FUNCTION] = 1;
1959  }
1960  else if ( *term == -SYMBOL ) {
1961  AN.UsedSymbol[term[1]] = 1;
1962  }
1963  else if ( *term == -INDEX ) {
1964  if ( term[1] < (WILDOFFSET+AM.OffsetVector) ) {
1965  AN.UsedVector[term[1]-AM.OffsetVector] = 1;
1966  }
1967  else if ( term[1] >= AM.OffsetIndex && term[1] < AM.DumInd ) {
1968  sym = indices[term[1] - AM.OffsetIndex].dimension;
1969  if ( sym < 0 ) AN.UsedSymbol[-sym] = 1;
1970  AN.UsedIndex[term[1] - AM.OffsetIndex] = 1;
1971  sym = indices[term[1]-AM.OffsetIndex].nmin4;
1972  if ( sym < -NMIN4SHIFT ) AN.UsedSymbol[-sym-NMIN4SHIFT] = 1;
1973  }
1974  }
1975  else if ( *term == -VECTOR || *term == -MINVECTOR ) {
1976  AN.UsedVector[term[1]-AM.OffsetVector] = 1;
1977  }
1978  }
1979  term = sarg; /* Next argument */
1980  }
1981  term = t;
1982  }
1983  }
1984  }
1985 }
1986 
1987 /*
1988  #] DetVars :
1989  #[ ToStorage :
1990 
1991  This routine takes an expression in the scratch buffer (indicated by e)
1992  and puts it in the storage file. The necessary actions are:
1993 
1994  1: determine the list of the used variables.
1995  2: make an index entry.
1996  3: write the namelists.
1997  4: copy the 'length' bytes of the expression.
1998 
1999 */
2000 
2001 WORD ToStorage(EXPRESSIONS e, POSITION *length)
2002 {
2003  GETIDENTITY
2004  WORD *w, i, j;
2005  WORD *term;
2006  INDEXENTRY *indexent;
2007  LONG size;
2008  POSITION indexpos, scrpos;
2009  FILEHANDLE *f;
2010  if ( ( indexent = NextFileIndex(&indexpos) ) == 0 ) {
2011  MesCall("ToStorage");
2012  SETERROR(-1)
2013  }
2014  indexent->CompressSize = 0; /* thus far no compression */
2015  f = AR.infile; AR.infile = AR.outfile; AR.outfile = f;
2016  if ( e->status == HIDDENGEXPRESSION ) {
2017  AR.InHiBuf = 0; f = AR.hidefile; AR.GetFile = 2;
2018  }
2019  else {
2020  AR.InInBuf = 0; f = AR.infile; AR.GetFile = 0;
2021  }
2022  if ( f->handle >= 0 ) {
2023  scrpos = e->onfile;
2024  SeekFile(f->handle,&scrpos,SEEK_SET);
2025  if ( ISNOTEQUALPOS(scrpos,e->onfile) ) {
2026  MesPrint(":::Error in Scratch file");
2027  goto ErrReturn;
2028  }
2029  f->POposition = e->onfile;
2030  f->POfull = f->PObuffer;
2031  if ( e->status == HIDDENGEXPRESSION ) AR.InHiBuf = 0;
2032  else AR.InInBuf = 0;
2033  }
2034  else {
2035  f->POfill = (WORD *)((UBYTE *)(f->PObuffer)+BASEPOSITION(e->onfile));
2036  }
2037  w = AT.WorkPointer;
2038  AN.UsedSymbol = w; w += NumSymbols;
2039  AN.UsedVector = w; w += NumVectors;
2040  AN.UsedIndex = w; w += NumIndices;
2041  AN.UsedFunction = w; w += NumFunctions;
2042  term = w;
2043  w = (WORD *)(((UBYTE *)(w)) + AM.MaxTer);
2044  if ( w > AT.WorkTop ) {
2045  MesWork();
2046  goto ErrReturn;
2047  }
2048  w = AN.UsedSymbol;
2049  i = NumSymbols + NumVectors + NumIndices + NumFunctions;
2050  do { *w++ = 0; } while ( --i > 0 );
2051  if ( GetTerm(BHEAD term) > 0 ) {
2052  DetVars(term,1);
2053  if ( GetTerm(BHEAD term) ) {
2054  do { DetVars(term,0); } while ( GetTerm(BHEAD term) > 0 );
2055  }
2056  }
2057  j = 0;
2058  w = AN.UsedSymbol;
2059  i = NumSymbols;
2060  while ( --i >= 0 ) { if ( *w++ ) j++; }
2061  indexent->nsymbols = j;
2062 /* size = j * sizeof(struct SyMbOl); */
2063  j = 0;
2064  w = AN.UsedIndex;
2065  i = NumIndices;
2066  while ( --i >= 0 ) { if ( *w++ ) j++; }
2067  indexent->nindices = j;
2068 /* size += j * sizeof(struct InDeX); */
2069  j = 0;
2070  w = AN.UsedVector;
2071  i = NumVectors;
2072  while ( --i >= 0 ) { if ( *w++ ) j++; }
2073  indexent->nvectors = j;
2074 /* size += j * sizeof(struct VeCtOr); */
2075  j = 0;
2076  w = AN.UsedFunction;
2077  i = NumFunctions;
2078  while ( --i >= 0 ) { if ( *w++ ) j++; }
2079  indexent->nfunctions = j;
2080 /* size += j * sizeof(struct FuNcTiOn); */
2081  indexent->length = *length;
2082  indexent->variables = AR.StoreData.Fill;
2083 /* indexent->position = AR.StoreData.Fill + size; */
2084  StrCopy(AC.exprnames->namebuffer+e->name,(UBYTE *)(indexent->name));
2085  SeekFile(AR.StoreData.Handle,&(AR.StoreData.Fill),SEEK_SET);
2086  AO.wlen = 100000;
2087  AO.wpos = (UBYTE *)Malloc1(AO.wlen,"AO.wpos buffer");
2088  AO.wpoin = AO.wpos;
2089  {
2090  SYMBOLS a;
2091  w = AN.UsedSymbol;
2092  a = symbols;
2093  j = 0;
2094  i = indexent->nsymbols;
2095  while ( --i >= 0 ) {
2096  while ( !*w ) { w++; a++; j++; }
2097  a->number = j;
2098  if ( VarStore((UBYTE *)a,(WORD)(sizeof(struct SyMbOl)),a->name,
2099  a->namesize) ) goto ErrToSto;
2100  w++; j++; a++;
2101  }
2102  }
2103  {
2104  INDICES a;
2105  w = AN.UsedIndex;
2106  a = indices;
2107  j = 0;
2108  i = indexent->nindices;
2109  while ( --i >= 0 ) {
2110  while ( !*w ) { w++; a++; j++; }
2111  a->number = j;
2112  if ( VarStore((UBYTE *)a,(WORD)(sizeof(struct InDeX)),a->name,
2113  a->namesize) ) goto ErrToSto;
2114  w++; j++; a++;
2115  }
2116  }
2117  {
2118  VECTORS a;
2119  w = AN.UsedVector;
2120  a = vectors;
2121  j = 0;
2122  i = indexent->nvectors;
2123  while ( --i >= 0 ) {
2124  while ( !*w ) { w++; a++; j++; }
2125  a->number = j;
2126  if ( VarStore((UBYTE *)a,(WORD)(sizeof(struct VeCtOr)),a->name,
2127  a->namesize) ) goto ErrToSto;
2128  w++; j++; a++;
2129  }
2130  }
2131  {
2132  FUNCTIONS a;
2133  w = AN.UsedFunction;
2134  a = functions;
2135  j = 0;
2136  i = indexent->nfunctions;
2137  while ( --i >= 0 ) {
2138  while ( !*w ) { w++; a++; j++; }
2139  a->number = j;
2140  if ( VarStore((UBYTE *)a,(WORD)(sizeof(struct FuNcTiOn)),a->name,
2141  a->namesize) ) goto ErrToSto;
2142  w++; a++; j++;
2143  }
2144  }
2145  if ( VarStore((UBYTE *)0L,(WORD)0,(WORD)0,(WORD)0) ) goto ErrToSto; /* Flush buffer */
2146  TELLFILE(AR.StoreData.Handle,&(indexent->position));
2147  indexent->size = (WORD)DIFBASE(indexent->position,indexent->variables);
2148 /*
2149  The following code was added when it became apparent (30-jan-2007)
2150  that we need provisions for extra space without upsetting existing
2151  .sav files. Here we can put as much as we want.
2152  Look in GetTable on how to recover numdummies.
2153  Forgetting numdummies has been in there from the beginning.
2154 */
2155  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)(&(e->numdummies)),(LONG)sizeof(WORD)) !=
2156  sizeof(WORD) ) {
2157  MesPrint("Error while writing storage file");
2158  goto ErrReturn;
2159  }
2160  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)(&(e->numfactors)),(LONG)sizeof(WORD)) !=
2161  sizeof(WORD) ) {
2162  MesPrint("Error while writing storage file");
2163  goto ErrReturn;
2164  }
2165  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)(&(e->vflags)),(LONG)sizeof(WORD)) !=
2166  sizeof(WORD) ) {
2167  MesPrint("Error while writing storage file");
2168  goto ErrReturn;
2169  }
2170  TELLFILE(AR.StoreData.Handle,&(indexent->position));
2171  if ( f->handle >= 0 ) {
2172  POSITION llength;
2173  llength = *length;
2174  SeekFile(f->handle,&(e->onfile),SEEK_SET);
2175  while ( ISPOSPOS(llength) ) {
2176  SETBASEPOSITION(scrpos,AO.wlen);
2177  if ( ISLESSPOS(llength,scrpos) ) size = BASEPOSITION(llength);
2178  else size = AO.wlen;
2179  if ( ReadFile(f->handle,AO.wpos,size) != size ) {
2180  MesPrint("Error while reading scratch file");
2181  goto ErrReturn;
2182  }
2183  if ( WriteFile(AR.StoreData.Handle,AO.wpos,size) != size ) {
2184  MesPrint("Error while writing storage file");
2185  goto ErrReturn;
2186  }
2187  ADDPOS(llength,-size);
2188  }
2189  }
2190  else {
2191  WORD *ppp;
2192  ppp = (WORD *)((UBYTE *)(f->PObuffer) + BASEPOSITION(e->onfile));
2193  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)ppp,BASEPOSITION(*length)) !=
2194  BASEPOSITION(*length) ) {
2195  MesPrint("Error while writing storage file");
2196  goto ErrReturn;
2197  }
2198  }
2199  ADD2POS(*length,indexent->position);
2200  e->onfile = indexpos;
2201 /*
2202  AR.StoreData.Fill = SeekFile(AR.StoreData.Handle,&(AM.zeropos),SEEK_END);
2203 */
2204  AR.StoreData.Fill = *length;
2205  SeekFile(AR.StoreData.Handle,&(AR.StoreData.Fill),SEEK_SET);
2206  scrpos = AR.StoreData.Position;
2207  ADDPOS(scrpos,sizeof(POSITION));
2208  SeekFile(AR.StoreData.Handle,&scrpos,SEEK_SET);
2209  if ( WriteFile(AR.StoreData.Handle,((UBYTE *)&(AR.StoreData.Index.number))
2210  ,(LONG)(sizeof(POSITION))) != sizeof(POSITION) ) goto ErrInSto;
2211  SeekFile(AR.StoreData.Handle,&indexpos,SEEK_SET);
2212  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)indexent,(LONG)(sizeof(INDEXENTRY))) !=
2213  sizeof(INDEXENTRY) ) goto ErrInSto;
2214  FlushFile(AR.StoreData.Handle);
2215  SeekFile(AR.StoreData.Handle,&(AC.StoreFileSize),SEEK_END);
2216  f = AR.infile; AR.infile = AR.outfile; AR.outfile = f;
2217  if ( AO.wpos ) M_free(AO.wpos,"AO.wpos buffer");
2218  AO.wpos = AO.wpoin = 0;
2219  return(0);
2220 ErrToSto:
2221  MesPrint("---Error while storing namelists");
2222  goto ErrReturn;
2223 ErrInSto:
2224  MesPrint("Error in storage");
2225 ErrReturn:
2226  if ( AO.wpos ) M_free(AO.wpos,"AO.wpos buffer");
2227  AO.wpos = AO.wpoin = 0;
2228  f = AR.infile; AR.infile = AR.outfile; AR.outfile = f;
2229  return(-1);
2230 }
2231 
2232 /*
2233  #] ToStorage :
2234  #[ NextFileIndex :
2235 */
2236 
2237 INDEXENTRY *NextFileIndex(POSITION *indexpos)
2238 {
2239  GETIDENTITY
2240  INDEXENTRY *ind;
2241  int i, j = sizeof(FILEINDEX)/(sizeof(LONG));
2242  LONG *lo;
2243  if ( AR.StoreData.Handle <= 0 ) {
2244  if ( SetFileIndex() ) {
2245  MesCall("NextFileIndex");
2246  return(0);
2247  }
2248  SETBASEPOSITION(AR.StoreData.Index.number,1);
2249 #ifdef SYSDEPENDENTSAVE
2250  SETBASEPOSITION(*indexpos,(2*sizeof(POSITION)));
2251 #else
2252  SETBASEPOSITION(*indexpos,(2*sizeof(POSITION)+sizeof(STOREHEADER)));
2253 #endif
2254  return(AR.StoreData.Index.expression);
2255  }
2256  while ( BASEPOSITION(AR.StoreData.Index.number) >= (LONG)(INFILEINDEX) ) {
2257  if ( ISNOTZEROPOS(AR.StoreData.Index.next) ) {
2258  SeekFile(AR.StoreData.Handle,&(AR.StoreData.Index.next),SEEK_SET);
2259  AR.StoreData.Position = AR.StoreData.Index.next;
2260  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)(&AR.StoreData.Index),(LONG)(sizeof(FILEINDEX))) !=
2261  (LONG)(sizeof(FILEINDEX)) ) goto ErrNextS;
2262  }
2263  else {
2264  PUTZERO(AR.StoreData.Index.number);
2265  SeekFile(AR.StoreData.Handle,&(AR.StoreData.Position),SEEK_SET);
2266  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)(&(AR.StoreData.Fill)),(LONG)(sizeof(POSITION)))
2267  != (LONG)(sizeof(POSITION)) ) goto ErrNextS;
2268  PUTZERO(AR.StoreData.Index.next);
2269  SeekFile(AR.StoreData.Handle,&(AR.StoreData.Fill),SEEK_SET);
2270  AR.StoreData.Position = AR.StoreData.Fill;
2271  lo = (LONG *)(&AR.StoreData.Index);
2272  for ( i = 0; i < j; i++ ) *lo++ = 0;
2273  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)(&AR.StoreData.Index),(LONG)(sizeof(FILEINDEX))) !=
2274  (LONG)(sizeof(FILEINDEX)) ) goto ErrNextS;
2275  ADDPOS(AR.StoreData.Fill,sizeof(FILEINDEX));
2276  }
2277  }
2278  *indexpos = AR.StoreData.Position;
2279  ADDPOS(*indexpos,(2*sizeof(POSITION)) +
2280  BASEPOSITION(AR.StoreData.Index.number) * sizeof(INDEXENTRY));
2281  ind = &AR.StoreData.Index.expression[BASEPOSITION(AR.StoreData.Index.number)];
2282  ADDPOS(AR.StoreData.Index.number,1);
2283  return(ind);
2284 ErrNextS:
2285  MesPrint("Error in storage file");
2286  return(0);
2287 }
2288 
2289 /*
2290  #] NextFileIndex :
2291  #[ SetFileIndex :
2292 */
2293 
2301 {
2302  GETIDENTITY
2303  int i, j = sizeof(FILEINDEX)/(sizeof(LONG));
2304  LONG *lo;
2305  if ( AR.StoreData.Handle < 0 ) {
2306  AR.StoreData.Handle = AC.StoreHandle;
2307  PUTZERO(AR.StoreData.Index.next);
2308  PUTZERO(AR.StoreData.Index.number);
2309 #ifdef SYSDEPENDENTSAVE
2310  SETBASEPOSITION(AR.StoreData.Fill,sizeof(FILEINDEX));
2311 #else
2312  if ( WriteStoreHeader(AR.StoreData.Handle) ) return(MesPrint("Error writing storage file header"));
2313  SETBASEPOSITION(AR.StoreData.Fill, (LONG)sizeof(FILEINDEX)+(LONG)sizeof(STOREHEADER));
2314 #endif
2315  lo = (LONG *)(&AR.StoreData.Index);
2316  for ( i = 0; i < j; i++ ) *lo++ = 0;
2317  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)(&AR.StoreData.Index),(LONG)(sizeof(FILEINDEX))) !=
2318  (LONG)(sizeof(FILEINDEX)) ) return(MesPrint("Error writing storage file"));
2319  }
2320  else {
2321  POSITION scrpos;
2322 #ifdef SYSDEPENDENTSAVE
2323  PUTZERO(scrpos);
2324 #else
2325  SETBASEPOSITION(scrpos, (LONG)(sizeof(STOREHEADER)));
2326 #endif
2327  SeekFile(AR.StoreData.Handle,&scrpos,SEEK_SET);
2328  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)(&AR.StoreData.Index),(LONG)(sizeof(FILEINDEX))) !=
2329  (LONG)(sizeof(FILEINDEX)) ) return(MesPrint("Error reading storage file"));
2330  }
2331 #ifdef SYSDEPENDENTSAVE
2332  PUTZERO(AR.StoreData.Position);
2333 #else
2334  SETBASEPOSITION(AR.StoreData.Position, (LONG)(sizeof(STOREHEADER)));
2335 #endif
2336  return(0);
2337 }
2338 
2339 /*
2340  #] SetFileIndex :
2341  #[ VarStore :
2342 
2343  The n -= sizeof(WORD); makes that the real length comes in the
2344  padding space, provided there is padding space (it seems so).
2345  The reading of the information assumes this is the case and hence
2346  things work....
2347 */
2348 
2349 WORD VarStore(UBYTE *s, WORD n, WORD name, WORD namesize)
2350 {
2351  GETIDENTITY
2352  UBYTE *t, *u;
2353  if ( s ) {
2354  n -= sizeof(WORD);
2355  t = (UBYTE *)AO.wpoin;
2356 /*
2357  u = (UBYTE *)AT.WorkTop;
2358 */
2359  u = AO.wpos+AO.wlen;
2360  while ( n > 0 && t < u ) { *t++ = *s++; n--; }
2361  while ( t >= u ) {
2362  if ( WriteFile(AR.StoreData.Handle,AO.wpos,AO.wlen) != AO.wlen ) return(-1);
2363  t = AO.wpos;
2364  while ( n > 0 && t < u ) { *t++ = *s++; n--; }
2365  }
2366  s = AC.varnames->namebuffer + name;
2367  n = namesize;
2368  n += sizeof(void *)-1; n &= -(sizeof(void *));
2369  *((WORD *)t) = n;
2370  t += sizeof(WORD);
2371  while ( n > 0 && t < u ) {
2372  if ( namesize > 0 ) { *t++ = *s++; namesize--; }
2373  else { *t++ = 0; }
2374  n--;
2375  }
2376  while ( t >= u ) {
2377  if ( WriteFile(AR.StoreData.Handle,AO.wpos,AO.wlen) != AO.wlen ) return(-1);
2378  t = AO.wpos;
2379  while ( n > 0 && t < u ) {
2380  if ( namesize > 0 ) { *t++ = *s++; namesize--; }
2381  else { *t++ = 0; }
2382  n--;
2383  }
2384  }
2385  AO.wpoin = t;
2386  }
2387  else {
2388  LONG size;
2389  size = AO.wpoin - AO.wpos;
2390  if ( WriteFile(AR.StoreData.Handle,AO.wpos,size) != size ) return(-1);
2391  AO.wpoin = AO.wpos;
2392  }
2393  return(0);
2394 }
2395 
2396 /*
2397  #] VarStore :
2398  #[ TermRenumber :
2399 
2400  renumbers the variables inside term according to the information
2401  in struct renumber.
2402  The search is binary. This avoided having to read/write the
2403  expression twice when it was stored.
2404 
2405 */
2406 
2407 WORD TermRenumber(WORD *term, RENUMBER renumber, WORD nexpr)
2408 {
2409  WORD *stopper;
2414  WORD *t, *sarg, n;
2415  stopper = term + *term - 1;
2416  stopper = stopper - ABS(*stopper) + 1;
2417  term++;
2418  while ( term < stopper ) {
2422  if ( *term == SYMBOL ) {
2423  t = term + term[1];
2424  term += 2;
2425  do {
2426  if ( ( n = FindrNumber(*term,&(renumber->symb)) ) < 0 ) goto ErrR;
2427  *term = renumber->symnum[n];
2428  term += 2;
2429  } while ( term < t );
2430  }
2431  else if ( *term == DOTPRODUCT ) {
2432  t = term + term[1];
2433  term += 2;
2434  do {
2435  if ( ( n = FindrNumber(*term,&(renumber->vect)) )
2436  < 0 ) goto ErrR;
2437  *term++ = renumber->vecnum[n];
2438  if ( ( n = FindrNumber(*term,&(renumber->vect)) )
2439  < 0 ) goto ErrR;
2440  *term = renumber->vecnum[n];
2441  term += 2;
2442  } while ( term < t );
2443  }
2444  else if ( *term == VECTOR ) {
2445  t = term + term[1];
2446  term += 2;
2447  do {
2448  if ( ( n = FindrNumber(*term,&(renumber->vect)) )
2449  < 0 ) goto ErrR;
2450  *term++ = renumber->vecnum[n];
2451  if ( ( *term >= AM.OffsetIndex ) && ( *term < AM.IndDum ) ) {
2452  if ( ( n = FindrNumber(*term,&(renumber->indi)) )
2453  < 0 ) goto ErrR;
2454  *term++ = renumber->indnum[n];
2455  }
2456  else term++;
2457  } while ( term < t );
2458  }
2459  else if ( *term == INDEX || *term == LEVICIVITA || *term == GAMMA
2460  || *term == DELTA ) {
2461 Tensors:
2462  t = term + term[1];
2463  if ( *term == INDEX || * term == DELTA ) term += 2;
2464  else term += FUNHEAD;
2465 /*
2466  term += 2;
2467 */
2468  while ( term < t ) {
2469  if ( *term >= AM.OffsetIndex + WILDOFFSET ) {
2470 /*
2471  Still TOBEDONE
2472 */
2473  }
2474  else if ( ( *term >= AM.OffsetIndex ) && ( *term < AM.IndDum ) ) {
2475  if ( ( n = FindrNumber(*term,&(renumber->indi)) )
2476  < 0 ) goto ErrR;
2477  *term = renumber->indnum[n];
2478  }
2479  else if ( *term < (WILDOFFSET+AM.OffsetVector) ) {
2480  if ( ( n = FindrNumber(*term,&(renumber->vect)) )
2481  < 0 ) goto ErrR;
2482  *term = renumber->vecnum[n];
2483  }
2484  term++;
2485  }
2486  }
2487  else if ( *term == HAAKJE ) term += term[1];
2488  else {
2489  if ( *term > MAXBUILTINFUNCTION ) {
2490  if ( ( n = FindrNumber(*term,&(renumber->func)) )
2491  < 0 ) goto ErrR;
2492  *term = renumber->funnum[n];
2493  }
2494  if ( *term >= FUNCTION && functions[*term-FUNCTION].spec
2495  >= TENSORFUNCTION && term[1] > FUNHEAD ) goto Tensors;
2496  t = term + term[1]; /* General stopper */
2497  term += FUNHEAD; /* First argument */
2498  while ( term < t ) {
2499  sarg = term;
2500  NEXTARG(sarg)
2501  if ( *term > 0 ) {
2502 /*
2503  Problem here:
2504  Marking the argument as dirty attacks the heap
2505  very heavily and costs much computer time.
2506 */
2507  *++term = 1;
2508  term += ARGHEAD-1;
2509  while ( term < sarg ) {
2510  if ( TermRenumber(term,renumber,nexpr) ) goto ErrR;
2511  term += *term;
2512  }
2513  }
2514  else {
2515  if ( *term <= -MAXBUILTINFUNCTION ) {
2516  if ( ( n = FindrNumber(-*term,&(renumber->func)) )
2517  < 0 ) goto ErrR;
2518  *term = -renumber->funnum[n];
2519  }
2520  else if ( *term == -SYMBOL ) {
2521  term++;
2522  if ( ( n = FindrNumber(*term,
2523  &(renumber->symb)) ) < 0 ) goto ErrR;
2524  *term = renumber->symnum[n];
2525  }
2526  else if ( *term == -INDEX ) {
2527  term++;
2528  if ( *term >= AM.OffsetIndex + WILDOFFSET ) {
2529 /*
2530  Still TOBEDONE
2531 */
2532  }
2533  else if ( ( *term >= AM.OffsetIndex ) && ( *term < AM.IndDum ) ) {
2534  if ( ( n = FindrNumber(*term,&(renumber->indi)) )
2535  < 0 ) goto ErrR;
2536  *term = renumber->indnum[n];
2537  }
2538  else if ( *term < (WILDOFFSET+AM.OffsetVector) ) {
2539  if ( ( n = FindrNumber(*term,&(renumber->vect)) )
2540  < 0 ) goto ErrR;
2541  *term = renumber->vecnum[n];
2542  }
2543  }
2544  else if ( *term == -VECTOR || *term == -MINVECTOR ) {
2545  term++;
2546  if ( ( n = FindrNumber(*term,&(renumber->vect)) )
2547  < 0 ) goto ErrR;
2548  *term = renumber->vecnum[n];
2549  }
2550  }
2551  term = sarg; /* Next argument */
2552  }
2553  term = t;
2554  }
2555  }
2556  return(0);
2557 ErrR:
2558  MesCall("TermRenumber");
2559  SETERROR(-1)
2560 }
2561 
2562 /*
2563  #] TermRenumber :
2564  #[ FindrNumber :
2565 */
2566 
2567 WORD FindrNumber(WORD n, VARRENUM *v)
2568 {
2569  WORD *hi,*med,*lo;
2570  hi = v->hi;
2571  lo = v->lo;
2572  med = v->start;
2573  if ( *hi == 0 ) {
2574  if ( n != *hi ) {
2575  MesPrint("Serious problems coming up in FindrNumber");
2576  return(-1);
2577  }
2578  return(*hi);
2579  }
2580  while ( *med != n ) {
2581  if ( *med < n ) {
2582  if ( med == hi ) goto ErrFindr;
2583  lo = med;
2584  med = hi - ((WORDDIF(hi,med))/2);
2585  }
2586  else {
2587  if ( med == lo ) goto ErrFindr;
2588  hi = med;
2589  med = lo + ((WORDDIF(med,lo))/2);
2590  }
2591  }
2592  return(WORDDIF(med,v->lo));
2593 ErrFindr:
2594 /*
2595  Reconstruction:
2596 */
2597  {
2598  int i;
2599  i = WORDDIF(v->hi,v->lo);
2600  MesPrint("FindrNumber: n = %d, list has %d members",n,i);
2601  while ( i >= 0 ) {
2602  MesPrint("v->lo[%d] = %d",i,v->lo[i]); i--;
2603  }
2604  hi = v->hi;
2605  lo = v->lo;
2606  med = v->start;
2607  MesPrint("Start with %d,%d,%d",0,WORDDIF(med,v->lo),WORDDIF(hi,v->lo));
2608  while ( *med != n ) {
2609  if ( *med < n ) {
2610  if ( med == hi ) goto ErrFindr2;
2611  lo = med;
2612  med = hi - ((WORDDIF(hi,med))/2);
2613  }
2614  else {
2615  if ( med == lo ) goto ErrFindr2;
2616  hi = med;
2617  med = ((WORDDIF(med,lo))/2) + lo;
2618  }
2619  MesPrint("New: %d,%d,%d, *med = %d",WORDDIF(lo,v->lo),WORDDIF(med,v->lo),WORDDIF(hi,v->lo),*med);
2620  }
2621  }
2622  return(WORDDIF(med,v->lo));
2623 ErrFindr2:
2624  return(MesPrint("Renumbering problems"));
2625 }
2626 
2627 /*
2628  #] FindrNumber :
2629  #[ FindInIndex :
2630 
2631  Finds an expression in the storage index if it exists.
2632  If found it returns a pointer to the index entry, otherwise zero.
2633  par = 0 Search by address (--> f == &AR.StoreData, called by GetTable, CoSave )
2634  par = 1 Search by name (--> f == &AO.SaveData, called by CoLoad )
2635 
2636  When comparing parameter fields the parameters of the expression
2637  to be searched are in AT.TMaddr. This includes the primary expression
2638  and a possible FROMBRAC information. The FROMBRAC is always last.
2639 
2640  The parameter mode tells whether we should worry about arguments of
2641  a stored expression.
2642 */
2643 
2644 INDEXENTRY *FindInIndex(WORD expr, FILEDATA *f, WORD par, WORD mode)
2645 {
2646  GETIDENTITY
2647  INDEXENTRY *ind;
2648  WORD i, hand, *m;
2649  WORD *start, *stop, *stop2, *m2, nomatch = 0;
2650  POSITION stindex, indexpos, scrpos;
2651  LONG number, num;
2652  stindex = f->Position;
2653  m = AT.TMaddr;
2654  stop = m + m[1];
2655  m += SUBEXPSIZE;
2656  start = m;
2657  while ( m < stop ) {
2658  if ( *m == FROMBRAC || *m == WILDCARDS ) break;
2659  m += m[1];
2660  }
2661  stop = m;
2662  if ( !par ) hand = AR.StoreData.Handle;
2663  else hand = AO.SaveData.Handle;
2664  for(;;) {
2665  if ( ( i = (WORD)BASEPOSITION(f->Index.number) ) != 0 ) {
2666  indexpos = f->Position;
2667  ADDPOS(indexpos,(2*sizeof(POSITION)));
2668  ind = f->Index.expression;
2669  do {
2670  if ( ( !par && ISEQUALPOS(indexpos,Expressions[expr].onfile) )
2671  || ( par && !StrCmp(EXPRNAME(expr),(UBYTE *)(ind->name)) ) ) {
2672  nomatch = 1;
2673 /*
2674 MesPrint("index: position: %8p",&(ind->position));
2675 MesPrint("index: length: %8p",&(ind->length));
2676 MesPrint("index: variables: %8p",&(ind->variables));
2677 MesPrint("index: nsymbols: %d",ind->nsymbols);
2678 MesPrint("index: nindices: %d",ind->nindices);
2679 MesPrint("index: nvectors: %d",ind->nvectors);
2680 MesPrint("index: nfunctions: %d",ind->nfunctions);
2681 MesPrint("index: size: %d",ind->size);
2682 */
2683  if ( par ) return(ind);
2684  scrpos = ind->position;
2685  SeekFile(hand,&scrpos,SEEK_SET);
2686  if ( ISNOTEQUALPOS(scrpos,ind->position) ) goto ErrGt2;
2687  if ( ReadFile(hand,(UBYTE *)AT.WorkPointer,(LONG)sizeof(WORD)) !=
2688  sizeof(WORD) || !*AT.WorkPointer ) goto ErrGt2;
2689  num = *AT.WorkPointer - 1;
2690  num *= wsizeof(WORD);
2691  if ( *AT.WorkPointer < 0 ||
2692  ReadFile(hand,(UBYTE *)(AT.WorkPointer+1),num) != num ) goto ErrGt2;
2693  m = start; /* start of parameter field to be searched */
2694  m2 = AT.WorkPointer + 1;
2695  stop2 = m2 + m2[1];
2696  m2 += SUBEXPSIZE;
2697  while ( m < stop && m2 < stop2 ) {
2698  if ( *m == SYMBOL ) {
2699  if ( *m2 != SYMTOSYM ) break;
2700  m2[3] = m[2];
2701  }
2702  else if ( *m == INDEX ) {
2703  if ( m[2] >= 0 ) {
2704  if ( *m2 != INDTOIND ) break;
2705  }
2706  else {
2707  if ( *m2 != VECTOVEC ) break;
2708  }
2709  m2[3] = m[2];
2710  }
2711  else if ( *m >= FUNCTION ) {
2712  if ( *m2 != FUNTOFUN ) break;
2713  m2[3] = *m;
2714  }
2715  else {}
2716  m += m[1];
2717  m2 += m2[1];
2718  }
2719  if ( ( m >= stop && m2 >= stop2 ) || mode == 0 ) {
2720  AT.WorkPointer = stop2;
2721 
2722  return(ind);
2723  }
2724  }
2725  ind++;
2726  ADDPOS(indexpos,sizeof(INDEXENTRY));
2727  } while ( --i > 0 );
2728  }
2729  f->Position = f->Index.next;
2730 #ifndef SYSDEPENDENTSAVE
2731  if ( !ISNOTZEROPOS(f->Position) ) ADDPOS(f->Position,sizeof(STOREHEADER));
2732  number = sizeof(struct FiLeInDeX);
2733 #endif
2734  if ( ISEQUALPOS(f->Position,stindex) && !AO.bufferedInd ) goto ErrGetTab;
2735  if ( !par ) {
2736  SeekFile(AR.StoreData.Handle,&(f->Position),SEEK_SET);
2737  if ( ISNOTEQUALPOS(f->Position,AR.StoreData.Position) ) goto ErrGt2;
2738 #ifndef SYSDEPENDENTSAVE
2739  if ( ReadFile(f->Handle, (UBYTE *)(&(f->Index)), number) != number ) goto ErrGt2;
2740 #endif
2741  }
2742  else {
2743  SeekFile(AO.SaveData.Handle,&(f->Position),SEEK_SET);
2744  if ( ISNOTEQUALPOS(f->Position,AO.SaveData.Position) ) goto ErrGt2;
2745 #ifndef SYSDEPENDENTSAVE
2746  if ( ReadSaveIndex(&f->Index) ) goto ErrGt2;
2747 #endif
2748  }
2749 #ifdef SYSDEPENDENTSAVE
2750  number = sizeof(struct FiLeInDeX);
2751  if ( ReadFile(f->Handle,(UBYTE *)(&(f->Index)),number) !=
2752  number ) goto ErrGt2;
2753 #endif
2754  }
2755 ErrGetTab:
2756  if ( nomatch ) {
2757  MesPrint("Parameters of expression %s don't match."
2758  ,EXPRNAME(expr));
2759  }
2760  else {
2761  MesPrint("Cannot find expression %s",EXPRNAME(expr));
2762  }
2763  return(0);
2764 ErrGt2:
2765  MesPrint("Readerror in IndexSearch");
2766  return(0);
2767 }
2768 
2769 /*
2770  #] FindInIndex :
2771  #[ GetTable :
2772 
2773  Locates stored files and constructs the renumbering tables.
2774  They are allocated in the WorkSpace.
2775  First the expression data are located. The Index is treated
2776  as a circularly linked buffer which is paged forwardly.
2777  If the indexentry is located (in ind) the two renumber tables
2778  have to be constructed.
2779  Finally the prototype has to be put in the proper buffer, so
2780  that wildcards can be passed. There should be a test with
2781  an already existing prototype that is constructed by the
2782  pattern matcher. This has not been put in yet.
2783 
2784  There is a problem with the parallel processing.
2785  Feeding in the variables that were erased by a .store could in
2786  principle happen in different orders (ParFORM) or simultaneously
2787  (TFORM). The proper resolution is to have the compiler call GetTable
2788  when a stored expression is encountered.
2789 
2790  This has been mended in development of TFORM by reading the
2791  symbol tables during compilation. See the call to GetTable
2792  in the CodeGenerator.
2793 
2794  Next is the problem of FindInIndex which writes in AR.StoreData
2795  Copying this is expensive!
2796 
2797  This Doesn't work well for TFORM yet.!!!!!!!!
2798  e[x1,x2] versus e[x2,x1] messes up.
2799  For the rest is the reloading during execution not thread safe.
2800 
2801  The parameter mode tells whether we should worry about arguments
2802  of a stored expression.
2803 */
2804 
2805 RENUMBER GetTable(WORD expr, POSITION *position, WORD mode)
2806 {
2807  GETIDENTITY
2808  WORD i, j;
2809  WORD *w;
2810  RENUMBER r;
2811  LONG num, nsize, xx;
2812  WORD jsym, jind, jvec, jfun;
2813  WORD k, type, error = 0, *oldw, *neww, *oldwork = AT.WorkPointer;
2814  struct SyMbOl SyM;
2815  struct InDeX InD;
2816  struct VeCtOr VeC;
2817  struct FuNcTiOn FuN;
2818  INDEXENTRY *ind;
2819 /*
2820  Prepare for FindInIndex to put the prototype in the WorkSpace.
2821  oldw will point at the "wildcards"
2822 */
2823 /*
2824  Bug fix. Look also in Generator.
2825 #ifndef WITHPTHREADS
2826 
2827  if ( ( r = Expressions[expr].renum ) != 0 ) { }
2828  else {
2829  Expressions[expr].renum =
2830  r = (RENUMBER)Malloc1(sizeof(struct ReNuMbEr),"Renumber");
2831  }
2832 #else
2833  r = (RENUMBER)Malloc1(sizeof(struct ReNuMbEr),"Renumber");
2834 #endif
2835 */
2836  r = (RENUMBER)Malloc1(sizeof(struct ReNuMbEr),"Renumber");
2837 
2838  oldw = AT.WorkPointer + 1 + SUBEXPSIZE;
2839 /*
2840  The protoype is loaded in the WorkSpace by the Index routine.
2841  After all it has to find an occurrence with the proper arguments.
2842  This sets the WorkPointer. Hence be careful now.
2843 */
2844  LOCK(AM.storefilelock);
2845  if ( ( ind = FindInIndex(expr,&AR.StoreData,0,mode) ) == 0 ) {
2846  UNLOCK(AM.storefilelock);
2847  return(0);
2848  }
2849 
2850  xx = ind->nsymbols+ind->nindices+ind->nvectors+ind->nfunctions;
2851  if ( xx == 0 ) {
2852  Expressions[expr].renumlists =
2853  w = AN.dummyrenumlist;
2854  }
2855  else {
2856 /*
2857 #ifndef WITHPTHREADS
2858  Expressions[expr].renumlists =
2859 #endif
2860 */
2861  w = (WORD *)Malloc1(sizeof(WORD)*(xx*2),"VarSpace");
2862  }
2863  r->symb.lo = w;
2864  r->symb.start = w + ind->nsymbols/2;
2865  w += ind->nsymbols;
2866  r->symb.hi = w - 1;
2867  r->symnum = w;
2868  w += ind->nsymbols;
2869 
2870  r->indi.lo = w;
2871  r->indi.start = w + ind->nindices/2;
2872  w += ind->nindices;
2873  r->indi.hi = w - 1;
2874  r->indnum = w;
2875  w += ind->nindices;
2876 
2877  r->vect.lo = w;
2878  r->vect.start = w + ind->nvectors/2;
2879  w += ind->nvectors;
2880  r->vect.hi = w - 1;
2881  r->vecnum = w;
2882  w += ind->nvectors;
2883 
2884  r->func.lo = w;
2885  r->func.start = w + ind->nfunctions/2;
2886  w += ind->nfunctions;
2887  r->func.hi = w - 1;
2888  r->funnum = w;
2889 /* w += ind->nfunctions; */
2890 
2891  SeekFile(AR.StoreData.Handle,&(ind->variables),SEEK_SET);
2892  *position = ind->position;
2893  jsym = ind->nsymbols;
2894  jvec = ind->nvectors;
2895  jind = ind->nindices;
2896  jfun = ind->nfunctions;
2897 /*
2898  #[ Symbols :
2899 */
2900  {
2901  SYMBOLS s = &SyM;
2902  w = r->symb.lo; j = jsym;
2903  for ( i = 0; i < j; i++ ) {
2904  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)s,(LONG)(sizeof(struct SyMbOl)))
2905  != sizeof(struct SyMbOl) ) goto ErrGt2;
2906  nsize = s->namesize; nsize += sizeof(void *)-1;
2907  nsize &= -sizeof(void *);
2908  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)(AT.WorkPointer),nsize)
2909  != nsize ) goto ErrGt2;
2910  *w = s->number;
2911  if ( ( s->flags & INUSE ) != 0 ) {
2912  /* Find the replacement. It must exist! */
2913  neww = oldw;
2914  while ( *neww != SYMTOSYM || neww[2] != *w ) neww += neww[1];
2915  k = neww[3];
2916  }
2917  else if ( GetVar((UBYTE *)AT.WorkPointer,&type,&k,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
2918  if ( type != CSYMBOL ) {
2919  MesPrint("Error: Conflicting types for %s",(AT.WorkPointer));
2920  error = -1;
2921  }
2922  else {
2923  if ( ( s->complex & (VARTYPEIMAGINARY|VARTYPECOMPLEX) ) !=
2924  ( symbols[k].complex & (VARTYPEIMAGINARY|VARTYPECOMPLEX) ) ) {
2925  MesPrint("Warning: Conflicting complexity for %s",AT.WorkPointer);
2926  error = -1;
2927  }
2928  if ( ( s->complex & (VARTYPEROOTOFUNITY) ) !=
2929  ( symbols[k].complex & (VARTYPEROOTOFUNITY) ) ) {
2930  MesPrint("Warning: Conflicting root of unity properties for %s",AT.WorkPointer);
2931  error = -1;
2932  }
2933  if ( ( s->complex & VARTYPEROOTOFUNITY ) == VARTYPEROOTOFUNITY ) {
2934  if ( s->maxpower != symbols[k].maxpower ) {
2935  MesPrint("Warning: Conflicting n in n-th root of unity properties for %s",AT.WorkPointer);
2936  error = -1;
2937  }
2938  }
2939  else if ( ( s->minpower !=
2940  symbols[k].minpower || s->maxpower !=
2941  symbols[k].maxpower ) && AC.WarnFlag ) {
2942  MesPrint("Warning: Conflicting power restrictions for %s",AT.WorkPointer);
2943  }
2944  }
2945  }
2946  else {
2947  if ( ( k = EntVar(CSYMBOL,(UBYTE *)(AT.WorkPointer),s->complex,s->minpower,
2948  s->maxpower,s->dimension) ) < 0 ) goto GetTcall;
2949  }
2950  *(w+j) = k;
2951  w++;
2952  }
2953  }
2954 /*
2955  #] Symbols :
2956  #[ Indices :
2957 */
2958  {
2959  INDICES s = &InD;
2960  w = r->indi.lo; j = jind;
2961  for ( i = 0; i < j; i++ ) {
2962  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)s,(LONG)(sizeof(struct InDeX)))
2963  != sizeof(struct InDeX) ) goto ErrGt2;
2964  nsize = s->namesize; nsize += sizeof(void *)-1;
2965  nsize &= -sizeof(void *);
2966  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)(AT.WorkPointer),nsize)
2967  != nsize ) goto ErrGt2;
2968  *w = s->number + AM.OffsetIndex;
2969  if ( s->dimension < 0 ) { /* Relabel the dimension */
2970  s->dimension = -r->symnum[FindrNumber(-s->dimension,&(r->symb))];
2971  if ( s->nmin4 < -NMIN4SHIFT ) { /* Relabel n-4 */
2972  s->nmin4 = -r->symnum[FindrNumber(-s->nmin4-NMIN4SHIFT
2973  ,&(r->symb))]-NMIN4SHIFT;
2974  }
2975  }
2976  if ( ( s->flags & INUSE ) != 0 ) {
2977  /* Find the replacement. It must exist! */
2978  neww = oldw;
2979  while ( *neww != INDTOIND || neww[2] != *w ) neww += neww[1];
2980  k = neww[3] - AM.OffsetIndex;
2981  }
2982  else if ( s->type == DUMMY ) {
2983 /*
2984 --------> Here we may have to execute some renumbering
2985 */
2986  }
2987  else if ( GetVar((UBYTE *)(AT.WorkPointer),&type,&k,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
2988  if ( type != CINDEX ) {
2989  MesPrint("Error: Conflicting types for %s",(AT.WorkPointer));
2990  error = -1;
2991  }
2992  else {
2993  if ( s->type !=
2994  indices[k].type ) {
2995  MesPrint("Warning: %s is also a dummy index",(AT.WorkPointer));
2996  error = -1;
2997  goto GetTb3;
2998  }
2999  if ( s->dimension != indices[k].dimension ) {
3000  MesPrint("Warning: Conflicting dimensions for %s",(AT.WorkPointer));
3001  error = -1;
3002  }
3003  }
3004  }
3005  else {
3006 GetTb3:
3007  if ( ( k = EntVar(CINDEX,(UBYTE *)(AT.WorkPointer),
3008  s->dimension,0,s->nmin4,0) ) < 0 ) goto GetTcall;
3009 
3010  }
3011  *(w+j) = k + AM.OffsetIndex;
3012  w++;
3013  }
3014  }
3015 /*
3016  #] Indices :
3017  #[ Vectors :
3018 */
3019  {
3020  VECTORS s = &VeC;
3021  w = r->vect.lo; j = jvec;
3022  for ( i = 0; i < j; i++ ) {
3023  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)s,(LONG)(sizeof(struct VeCtOr)))
3024  != sizeof(struct VeCtOr) ) goto ErrGt2;
3025  nsize = s->namesize; nsize += sizeof(void *)-1;
3026  nsize &= -sizeof(void *);
3027  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)(AT.WorkPointer),nsize)
3028  != nsize ) goto ErrGt2;
3029  *w = s->number + AM.OffsetVector;
3030  if ( ( s->flags & INUSE ) != 0 ) {
3031  /* Find the replacement. It must exist! */
3032  neww = oldw;
3033  while ( *neww != VECTOVEC || neww[2] != *w ) neww += neww[1];
3034  k = neww[3] - AM.OffsetVector;
3035  }
3036  else if ( GetVar((UBYTE *)(AT.WorkPointer),&type,&k,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
3037  if ( type != CVECTOR ) {
3038  MesPrint("Error: Conflicting types for %s",(AT.WorkPointer));
3039  error = -1;
3040  }
3041  else {
3042  if ( ( s->complex & (VARTYPEIMAGINARY|VARTYPECOMPLEX) ) !=
3043  ( vectors[k].complex & (VARTYPEIMAGINARY|VARTYPECOMPLEX) ) ) {
3044  MesPrint("Warning: Conflicting complexity for %s",(AT.WorkPointer));
3045  error = -1;
3046  }
3047  }
3048  }
3049  else {
3050  if ( ( k = EntVar(CVECTOR,(UBYTE *)(AT.WorkPointer),
3051  s->complex,0,0,s->dimension) ) < 0 ) goto GetTcall;
3052  }
3053  *(w+j) = k + AM.OffsetVector;
3054  w++;
3055  }
3056  }
3057 /*
3058  #] Vectors :
3059  #[ Functions :
3060 */
3061  {
3062  FUNCTIONS s = &FuN;
3063  w = r->func.lo; j = jfun;
3064  for ( i = 0; i < j; i++ ) {
3065  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)s,(LONG)(sizeof(struct FuNcTiOn)))
3066  != sizeof(struct FuNcTiOn) ) goto ErrGt2;
3067  nsize = s->namesize; nsize += sizeof(void *)-1;
3068  nsize &= -sizeof(void *);
3069  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)(AT.WorkPointer),nsize)
3070  != nsize ) goto ErrGt2;
3071  *w = s->number + FUNCTION;
3072  if ( ( s->flags & INUSE ) != 0 ) {
3073  /* Find the replacement. It must exist! */
3074  neww = oldw;
3075  while ( *neww != FUNTOFUN || neww[2] != *w ) neww += neww[1];
3076  k = neww[3] - FUNCTION;
3077  }
3078  else if ( GetVar((UBYTE *)(AT.WorkPointer),&type,&k,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
3079  if ( type != CFUNCTION ) {
3080  MesPrint("Error: Conflicting types for %s",(AT.WorkPointer));
3081  error = -1;
3082  }
3083  else {
3084  if ( s->complex != functions[k].complex ) {
3085  MesPrint("Warning: Conflicting complexity for %s",(AT.WorkPointer));
3086  error = -1;
3087  }
3088  else if ( s->symmetric != functions[k].symmetric ) {
3089  MesPrint("Warning: Conflicting symmetry properties for %s",(AT.WorkPointer));
3090  error = -1;
3091  }
3092  else if ( ( s->maxnumargs != functions[k].maxnumargs )
3093  || ( s->minnumargs != functions[k].minnumargs ) ) {
3094  MesPrint("Warning: Conflicting argument restriction properties for %s",(AT.WorkPointer));
3095  error = -1;
3096  }
3097  }
3098  }
3099  else {
3100  if ( ( k = EntVar(CFUNCTION,(UBYTE *)(AT.WorkPointer),
3101  s->complex,s->commute,s->spec,s->dimension) ) < 0 ) goto GetTcall;
3102  functions[k].symmetric = s->symmetric;
3103  functions[k].maxnumargs = s->maxnumargs;
3104  functions[k].minnumargs = s->minnumargs;
3105  }
3106  *(w+j) = k + FUNCTION;
3107  w++;
3108  }
3109  }
3110 /*
3111  #] Functions :
3112 
3113  Now we skip the prototype. This sets the start position at the first term
3114 */
3115  if ( error ) {
3116  UNLOCK(AM.storefilelock);
3117  AT.WorkPointer = oldwork;
3118  return(0);
3119  }
3120 
3121  {
3122 /*
3123  For clarity we look where we are.
3124  We want to know: is this position already known?
3125  Could we have inserted extra information here?
3126 
3127  nummystery indicates extra words. We have currently in order
3128  (if they exist)
3129  numdummies
3130  numfactors
3131  vflags
3132 */
3133  POSITION pos;
3134  int nummystery;
3135  TELLFILE(AR.StoreData.Handle,&pos);
3136  nummystery = DIFBASE(ind->position,pos);
3137 /*
3138  MesPrint("--> We are at position %8p",&pos);
3139  MesPrint("--> The index says at %8p",&(ind->position));
3140  MesPrint("--> There are %d mystery bytes",nummystery);
3141 */
3142  if ( nummystery > 0 ) {
3143  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)AT.WorkPointer,(LONG)sizeof(WORD)) !=
3144  sizeof(WORD) ) {
3145  UNLOCK(AM.storefilelock);
3146  AT.WorkPointer = oldwork;
3147  return(0);
3148  }
3149  Expressions[expr].numdummies = *AT.WorkPointer;
3150 /*
3151  MesPrint("--> numdummies = %d",Expressions[expr].numdummies);
3152 */
3153  nummystery -= sizeof(WORD);
3154  }
3155  else {
3156  Expressions[expr].numdummies = 0;
3157  }
3158  if ( nummystery > 0 ) {
3159  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)AT.WorkPointer,(LONG)sizeof(WORD)) !=
3160  sizeof(WORD) ) {
3161  UNLOCK(AM.storefilelock);
3162  AT.WorkPointer = oldwork;
3163  return(0);
3164  }
3165  if ( ( AS.OldNumFactors == 0 ) || ( AS.NumOldNumFactors < NumExpressions ) ) {
3166  WORD *buffer;
3167  int capacity = 20;
3168  if (capacity < NumExpressions) capacity = NumExpressions * 2;
3169 
3170  buffer = (WORD *)Malloc1(capacity * sizeof(WORD), "numfactors pointers");
3171  if (AS.OldNumFactors) {
3172  WCOPY(buffer, AS.OldNumFactors, AS.NumOldNumFactors);
3173  M_free(AS.OldNumFactors, "numfactors pointers");
3174  }
3175  AS.OldNumFactors = buffer;
3176 
3177  buffer = (WORD *)Malloc1(capacity * sizeof(WORD), "vflags pointers");
3178  if (AS.Oldvflags) {
3179  WCOPY(buffer, AS.Oldvflags, AS.NumOldNumFactors);
3180  M_free(AS.Oldvflags, "vflags pointers");
3181  }
3182  AS.Oldvflags = buffer;
3183 
3184  AS.NumOldNumFactors = capacity;
3185  }
3186 
3187  AS.OldNumFactors[expr] =
3188  Expressions[expr].numfactors = *AT.WorkPointer;
3189 /*
3190  MesPrint("--> numfactors = %d",Expressions[expr].numfactors);
3191 */
3192  nummystery -= sizeof(WORD);
3193  }
3194  else {
3195  Expressions[expr].numfactors = 0;
3196  }
3197  if ( nummystery > 0 ) {
3198  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)AT.WorkPointer,(LONG)sizeof(WORD)) !=
3199  sizeof(WORD) ) {
3200  UNLOCK(AM.storefilelock);
3201  AT.WorkPointer = oldwork;
3202  return(0);
3203  }
3204  AS.Oldvflags[expr] =
3205  Expressions[expr].vflags = *AT.WorkPointer;
3206 /*
3207  MesPrint("--> vflags = %d",Expressions[expr].vflags);
3208 */
3209  nummystery -= sizeof(WORD);
3210  }
3211  else {
3212  Expressions[expr].vflags = 0;
3213  }
3214  }
3215 
3216  SeekFile(AR.StoreData.Handle,&(ind->position),SEEK_SET);
3217  if ( ReadFile(AR.StoreData.Handle,(UBYTE *)AT.WorkPointer,(LONG)sizeof(WORD)) !=
3218  sizeof(WORD) || !*AT.WorkPointer ) {
3219  UNLOCK(AM.storefilelock);
3220  AT.WorkPointer = oldwork;
3221  return(0);
3222  }
3223  num = *AT.WorkPointer - 1;
3224  num *= sizeof(WORD);
3225  if ( *AT.WorkPointer < 0 ||
3226  ReadFile(AR.StoreData.Handle,(UBYTE *)(AT.WorkPointer+1),num) != num ) {
3227  MesPrint("@Error in stored expressions file at position %10p",*position);
3228  UNLOCK(AM.storefilelock);
3229  AT.WorkPointer = oldwork;
3230  return(0);
3231  }
3232  UNLOCK(AM.storefilelock);
3233  ADDPOS(*position,num+sizeof(WORD));
3234  r->startposition = *position;
3235  AT.WorkPointer = oldwork;
3236  return(r);
3237 GetTcall:
3238  UNLOCK(AM.storefilelock);
3239  AT.WorkPointer = oldwork;
3240  MesCall("GetTable");
3241  return(0);
3242 ErrGt2:
3243  UNLOCK(AM.storefilelock);
3244  AT.WorkPointer = oldwork;
3245  MesPrint("Readerror in GetTable");
3246  return(0);
3247 }
3248 
3249 /*
3250  #] GetTable :
3251  #[ CopyExpression :
3252 
3253  Copies from one scratch buffer to another.
3254  We assume here that the complete 'from' scratch buffer is taken.
3255  We also assume that the 'from' buffer is positioned at the end of
3256  the expression.
3257 
3258  The locks should be placed in the calling routine. We need basically
3259  AS.outputslock.
3260 */
3261 
3262 int CopyExpression(FILEHANDLE *from, FILEHANDLE *to)
3263 {
3264  POSITION posfrom, poscopy;
3265  LONG fullsize,i;
3266  WORD *t1, *t2;
3267  int RetCode;
3268  SeekScratch(from,&posfrom);
3269  if ( from->handle < 0 ) { /* input is in memory */
3270  fullsize = (BASEPOSITION(posfrom))/sizeof(WORD);
3271  if ( ( to->POstop - to->POfull ) >= fullsize ) {
3272 /*
3273  Fits inside the buffer of the output. This will be fast.
3274 */
3275  t1 = from->PObuffer;
3276  t2 = to->POfull;
3277  NCOPY(t2,t1,fullsize)
3278  to->POfull = to->POfill = t2;
3279  goto WriteTrailer;
3280  }
3281  if ( to->handle < 0 ) { /* First open the file */
3282  if ( ( RetCode = CreateFile(to->name) ) >= 0 ) {
3283  to->handle = (WORD)RetCode;
3284  PUTZERO(to->filesize);
3285  PUTZERO(to->POposition);
3286  }
3287  else {
3288  MLOCK(ErrorMessageLock);
3289  MesPrint("Cannot create scratch file %s",to->name);
3290  MUNLOCK(ErrorMessageLock);
3291  return(-1);
3292  }
3293  }
3294  t1 = from->PObuffer;
3295  while ( fullsize > 0 ) {
3296  i = to->POstop - to->POfull;
3297  if ( i > fullsize ) i = fullsize;
3298  fullsize -= i;
3299  t2 = to->POfull;
3300  NCOPY(t2,t1,i)
3301  if ( fullsize > 0 ) {
3302  SeekFile(to->handle,&(to->POposition),SEEK_SET);
3303  if ( WriteFile(to->handle,((UBYTE *)(to->PObuffer)),to->POsize) != to->POsize ) {
3304  MLOCK(ErrorMessageLock);
3305  MesPrint("Error while writing to disk. Disk full?");
3306  MUNLOCK(ErrorMessageLock);
3307  return(-1);
3308  }
3309  ADDPOS(to->POposition,to->POsize);
3310 /* SeekFile(to->handle,&(to->POposition),SEEK_CUR); */
3311  to->filesize = to->POposition;
3312  to->POfill = to->POfull = to->PObuffer;
3313  }
3314  else {
3315  to->POfill = to->POfull = t2;
3316  }
3317  }
3318  goto WriteTrailer;
3319  }
3320 /*
3321  Now the input involves a file. This needs the use of the PObuffer of from.
3322  First make sure the tail of the buffer has been written
3323 */
3324  if ( ((UBYTE *)(from->POfill)-(UBYTE *)(from->PObuffer)) > 0 ) {
3325  if ( WriteFile(from->handle,((UBYTE *)(from->PObuffer)),((UBYTE *)(from->POfill)-(UBYTE *)(from->PObuffer)))
3326  != ((UBYTE *)(from->POfill)-(UBYTE *)(from->PObuffer)) ) {
3327  MLOCK(ErrorMessageLock);
3328  MesPrint("Error while writing to disk. Disk full?");
3329  MUNLOCK(ErrorMessageLock);
3330  return(-1);
3331  }
3332  SeekFile(from->handle,&(from->POposition),SEEK_CUR);
3333  posfrom = from->filesize = from->POposition;
3334  from->POfill = from->POfull = from->PObuffer;
3335  }
3336 /*
3337  Now copy the complete contents
3338 */
3339  PUTZERO(poscopy);
3340  SeekFile(from->handle,&poscopy,SEEK_SET);
3341  while ( ISLESSPOS(poscopy,posfrom) ) {
3342  fullsize = ReadFile(from->handle,((UBYTE *)(from->PObuffer)),from->POsize);
3343  if ( fullsize < 0 || ( fullsize % sizeof(WORD) ) != 0 ) {
3344  MLOCK(ErrorMessageLock);
3345  MesPrint("Error while reading from disk while copying expression.");
3346  MUNLOCK(ErrorMessageLock);
3347  return(-1);
3348  }
3349  fullsize /= sizeof(WORD);
3350  from->POfull = from->PObuffer + fullsize;
3351  t1 = from->PObuffer;
3352 
3353  if ( ( to->POstop - to->POfull ) >= fullsize ) {
3354 /*
3355  Fits inside the buffer of the output. This will be fast.
3356 */
3357  t2 = to->POfull;
3358  NCOPY(t2,t1,fullsize)
3359  to->POfill = to->POfull = t2;
3360  }
3361  else {
3362  if ( to->handle < 0 ) { /* First open the file */
3363  if ( ( RetCode = CreateFile(to->name) ) >= 0 ) {
3364  to->handle = (WORD)RetCode;
3365  PUTZERO(to->POposition);
3366  PUTZERO(to->filesize);
3367  }
3368  else {
3369  MLOCK(ErrorMessageLock);
3370  MesPrint("Cannot create scratch file %s",to->name);
3371  MUNLOCK(ErrorMessageLock);
3372  return(-1);
3373  }
3374  }
3375  while ( fullsize > 0 ) {
3376  i = to->POstop - to->POfull;
3377  if ( i > fullsize ) i = fullsize;
3378  fullsize -= i;
3379  t2 = to->POfull;
3380  NCOPY(t2,t1,i)
3381  if ( fullsize > 0 ) {
3382  SeekFile(to->handle,&(to->POposition),SEEK_SET);
3383  if ( WriteFile(to->handle,((UBYTE *)(to->PObuffer)),to->POsize) != to->POsize ) {
3384  MLOCK(ErrorMessageLock);
3385  MesPrint("Error while writing to disk. Disk full?");
3386  MUNLOCK(ErrorMessageLock);
3387  return(-1);
3388  }
3389  ADDPOS(to->POposition,to->POsize);
3390 /* SeekFile(to->handle,&(to->POposition),SEEK_CUR); */
3391  to->filesize = to->POposition;
3392  to->POfill = to->POfull = to->PObuffer;
3393  }
3394  else {
3395  to->POfill = to->POfull = t2;
3396  }
3397  }
3398  }
3399  SeekFile(from->handle,&poscopy,SEEK_CUR);
3400  }
3401 WriteTrailer:
3402  if ( ( to->handle >= 0 ) && ( to->POfill > to->PObuffer ) ) {
3403  fullsize = (UBYTE *)(to->POfill) - (UBYTE *)(to->PObuffer);
3404 /*
3405  PUTZERO(to->POposition);
3406  SeekFile(to->handle,&(to->POposition),SEEK_END);
3407 */
3408  SeekFile(to->handle,&(to->filesize),SEEK_SET);
3409  if ( WriteFile(to->handle,((UBYTE *)(to->PObuffer)),fullsize) != fullsize ) {
3410  MLOCK(ErrorMessageLock);
3411  MesPrint("Error while writing to disk. Disk full?");
3412  MUNLOCK(ErrorMessageLock);
3413  return(-1);
3414  }
3415  ADDPOS(to->filesize,fullsize);
3416  to->POposition = to->filesize;
3417  to->POfill = to->POfull = to->PObuffer;
3418  }
3419 
3420  return(0);
3421 }
3422 
3423 /*
3424  #] CopyExpression :
3425  #[ ExprStatus :
3426 */
3427 
3428 #ifdef HIDEDEBUG
3429 
3430 static UBYTE *statusexpr[] = {
3431  (UBYTE *)"LOCALEXPRESSION"
3432  ,(UBYTE *)"SKIPLEXPRESSION"
3433  ,(UBYTE *)"DROPLEXPRESSION"
3434  ,(UBYTE *)"DROPPEDEXPRESSION"
3435  ,(UBYTE *)"GLOBALEXPRESSION"
3436  ,(UBYTE *)"SKIPGEXPRESSION"
3437  ,(UBYTE *)"DROPGEXPRESSION"
3438  ,(UBYTE *)"UNKNOWN"
3439  ,(UBYTE *)"STOREDEXPRESSION"
3440  ,(UBYTE *)"HIDDENLEXPRESSION"
3441  ,(UBYTE *)"HIDELEXPRESSION"
3442  ,(UBYTE *)"DROPHLEXPRESSION"
3443  ,(UBYTE *)"UNHIDELEXPRESSION"
3444  ,(UBYTE *)"HIDDENGEXPRESSION"
3445  ,(UBYTE *)"HIDEGEXPRESSION"
3446  ,(UBYTE *)"DROPHGEXPRESSION"
3447  ,(UBYTE *)"UNHIDEGEXPRESSION"
3448  ,(UBYTE *)"INTOHIDELEXPRESSION"
3449  ,(UBYTE *)"INTOHIDEGEXPRESSION"
3450 };
3451 
3452 void ExprStatus(EXPRESSIONS e)
3453 {
3454  MesPrint("Expression %s(%d) has status %s(%d,%d). Buffer: %d, Position: %15p",
3455  AC.exprnames->namebuffer+e->name,(WORD)(e-Expressions),
3456  statusexpr[e->status],e->status,e->hidelevel,
3457  e->whichbuffer,&(e->onfile));
3458 }
3459 
3460 #endif
3461 
3462 /*
3463  #] ExprStatus :
3464  #] StoreExpressions :
3465  #[ System Independent Saved Expressions :
3466 
3467  All functions concerned with the system independent reading of save-files
3468  are here. They are called by the functions CoLoad, PutInStore,
3469  SetFileIndex, FindInIndex. In case no translation (endianness flip,
3470  resizing of words, renumbering) has to be done, they just do simple file
3471  reading. The function SaveFileHeader() for writing a header with
3472  information about the system architecture, FORM version, etc. is also
3473  located here.
3474 
3475  #[ Flip :
3476 */
3477 
3478 #ifndef INT16
3479 #error "INT16 not defined!"
3480 #endif
3481 #ifndef INT32
3482 #error "INT32 not defined!"
3483 #endif
3484 
3494 static void FlipN(UBYTE *p, int length)
3495 {
3496  UBYTE *q, buf;
3497  q = p + length;
3498  do {
3499  --q;
3500  buf = *p; *p = *q; *q = buf;
3501  } while ( ++p != q );
3502 }
3503 
3513 static void Flip16(UBYTE *p)
3514 {
3515  INT16 in = *((INT16 *)p);
3516  INT16 out = (INT16)( (((in) >> 8) & 0x00FF) | (((in) << 8) & 0xFF00) );
3517  *((INT16 *)p) = out;
3518 }
3519 
3521 static void Flip32(UBYTE *p)
3522 {
3523  INT32 in = *((INT32 *)p);
3524  INT32 out =
3525  ( (((in) >> 24) & 0x000000FF) | (((in) >> 8) & 0x0000FF00) | \
3526  (((in) << 8) & 0x00FF0000) | (((in) << 24) & 0xFF000000) );
3527  *((INT32 *)p) = out;
3528 }
3529 
3531 #ifdef INT64
3532 static void Flip64(UBYTE *p)
3533 {
3534  INT64 in = *((INT64 *)p);
3535  INT64 out =
3536  ( (((in) >> 56) & (INT64)0x00000000000000FFLL) | (((in) >> 40) & (INT64)0x000000000000FF00LL) | \
3537  (((in) >> 24) & (INT64)0x0000000000FF0000LL) | (((in) >> 8) & (INT64)0x00000000FF000000LL) | \
3538  (((in) << 8) & (INT64)0x000000FF00000000LL) | (((in) << 24) & (INT64)0x0000FF0000000000LL) | \
3539  (((in) << 40) & (INT64)0x00FF000000000000LL) | (((in) << 56) & (INT64)0xFF00000000000000LL) );
3540  *((INT64 *)p) = out;
3541 }
3542 #else
3543 static void Flip64(UBYTE *p) { FlipN(p, 8); }
3544 #endif /* INT64 */
3545 
3547 static void Flip128(UBYTE *p) { FlipN(p, 16); }
3548 
3549 /*
3550  #] Flip :
3551  #[ Resize :
3552 */
3553 
3565 static void ResizeDataBE(UBYTE *src, int slen, UBYTE *dst, int dlen)
3566 {
3567  if ( slen > dlen ) {
3568  src += slen - dlen;
3569  while ( dlen-- ) { *dst++ = *src++; }
3570  }
3571  else {
3572  int i = dlen - slen;
3573  while ( i-- ) { *dst++ = 0; }
3574  while ( slen-- ) { *dst++ = *src++; }
3575  }
3576 }
3577 
3581 static void ResizeDataLE(UBYTE *src, int slen, UBYTE *dst, int dlen)
3582 {
3583  if ( slen > dlen ) {
3584  while ( dlen-- ) { *dst++ = *src++; }
3585  }
3586  else {
3587  int i = dlen - slen;
3588  while ( slen-- ) { *dst++ = *src++; }
3589  while ( i-- ) { *dst++ = 0; }
3590  }
3591 }
3592 
3605 static void Resize16t16(UBYTE *src, UBYTE *dst)
3606 {
3607  *((INT16 *)dst) = *((INT16 *)src);
3608 }
3609 
3611 static void Resize16t32(UBYTE *src, UBYTE *dst)
3612 {
3613  INT16 in = *((INT16 *)src);
3614  INT32 out = (INT32)in;
3615  *((INT32 *)dst) = out;
3616 }
3617 
3619 #ifdef INT64
3620 static void Resize16t64(UBYTE *src, UBYTE *dst)
3621 {
3622  INT16 in = *((INT16 *)src);
3623  INT64 out = (INT64)in;
3624  *((INT64 *)dst) = out;
3625 }
3626 #else
3627 static void Resize16t64(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 2, dst, 8); }
3628 #endif /* INT64 */
3629 
3631 static void Resize16t128(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 2, dst, 16); }
3632 
3634 static void Resize32t32(UBYTE *src, UBYTE *dst)
3635 {
3636  *((INT32 *)dst) = *((INT32 *)src);
3637 }
3638 
3640 #ifdef INT64
3641 static void Resize32t64(UBYTE *src, UBYTE *dst)
3642 {
3643  INT32 in = *((INT32 *)src);
3644  INT64 out = (INT64)in;
3645  *((INT64 *)dst) = out;
3646 }
3647 #else
3648 static void Resize32t64(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 4, dst, 8); }
3649 #endif /* INT64 */
3650 
3652 static void Resize32t128(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 4, dst, 16); }
3653 
3655 #ifdef INT64
3656 static void Resize64t64(UBYTE *src, UBYTE *dst)
3657 {
3658  *((INT64 *)dst) = *((INT64 *)src);
3659 }
3660 #else
3661 static void Resize64t64(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 8, dst, 8); }
3662 #endif /* INT64 */
3663 
3665 static void Resize64t128(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 8, dst, 16); }
3666 
3668 static void Resize128t128(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 16, dst, 16); }
3669 
3671 static void Resize32t16(UBYTE *src, UBYTE *dst)
3672 {
3673  INT32 in = *((INT32 *)src);
3674  INT16 out = (INT16)in;
3675  if ( in > (1<<15)-1 || in < -(1<<15)+1 ) AO.resizeFlag |= 1;
3676  *((INT16 *)dst) = out;
3677 }
3678 
3685 static void Resize32t16NC(UBYTE *src, UBYTE *dst)
3686 {
3687  INT32 in = *((INT32 *)src);
3688  INT16 out = (INT16)in;
3689  *((INT16 *)dst) = out;
3690 }
3691 
3692 #ifdef INT64
3693 
3694 static void Resize64t16(UBYTE *src, UBYTE *dst)
3695 {
3696  INT64 in = *((INT64 *)src);
3697  INT16 out = (INT16)in;
3698  if ( in > (1<<15)-1 || in < -(1<<15)+1 ) AO.resizeFlag |= 1;
3699  *((INT16 *)dst) = out;
3700 }
3702 static void Resize64t16NC(UBYTE *src, UBYTE *dst)
3703 {
3704  INT64 in = *((INT64 *)src);
3705  INT16 out = (INT16)in;
3706  *((INT16 *)dst) = out;
3707 }
3708 #else
3709 
3710 static void Resize64t16(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 8, dst, 2); }
3712 static void Resize64t16NC(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 8, dst, 2); }
3713 #endif /* INT64 */
3714 
3715 #ifdef INT64
3716 
3717 static void Resize64t32(UBYTE *src, UBYTE *dst)
3718 {
3719  INT64 in = *((INT64 *)src);
3720  INT32 out = (INT32)in;
3721  if ( in > ((INT64)1<<31)-1 || in < -((INT64)1<<31)+1 ) AO.resizeFlag |= 1;
3722  *((INT32 *)dst) = out;
3723 }
3725 static void Resize64t32NC(UBYTE *src, UBYTE *dst)
3726 {
3727  INT64 in = *((INT64 *)src);
3728  INT32 out = (INT32)in;
3729  *((INT32 *)dst) = out;
3730 }
3731 #else
3732 
3733 static void Resize64t32(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 8, dst, 4); }
3735 static void Resize64t32NC(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 8, dst, 4); }
3736 #endif /* INT64 */
3737 
3739 static void Resize128t16(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 16, dst, 2); }
3740 
3742 static void Resize128t16NC(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 16, dst, 2); }
3743 
3745 static void Resize128t32(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 16, dst, 4); }
3746 
3748 static void Resize128t32NC(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 16, dst, 4); }
3749 
3751 static void Resize128t64(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 16, dst, 8); }
3752 
3754 static void Resize128t64NC(UBYTE *src, UBYTE *dst) { AO.ResizeData(src, 16, dst, 8); }
3755 
3756 /*
3757  #] Resize :
3758  #[ CheckPower and RenumberVec :
3759 */
3760 
3767 static void CheckPower32(UBYTE *p)
3768 {
3769  if ( *((INT32 *)p) < -MAXPOWER ) {
3770  AO.powerFlag |= 0x01;
3771  *((INT32 *)p) = -MAXPOWER;
3772  }
3773  p += sizeof(INT32);
3774  if ( *((INT32 *)p) > MAXPOWER ) {
3775  AO.powerFlag |= 0x02;
3776  *((INT32 *)p) = MAXPOWER;
3777  }
3778 }
3779 
3787 static void RenumberVec32(UBYTE *p)
3788 {
3789 /* INT32 wildoffset = *((INT32 *)AO.SaveHeader.wildoffset); */
3790  void *dummy = (void *)AO.SaveHeader.wildoffset; /* to remove a warning about strict-aliasing rules in gcc */
3791  INT32 wildoffset = *(INT32 *)dummy;
3792  INT32 in = *((INT32 *)p);
3793  in = in + 2*wildoffset;
3794  in = in - 2*WILDOFFSET;
3795  *((INT32 *)p) = in;
3796 }
3797 
3798 /*
3799  #] CheckPower and RenumberVec :
3800  #[ ResizeCoeff :
3801 */
3802 
3816 static void ResizeCoeff32(UBYTE **bout, UBYTE *bend, UBYTE *top)
3817 {
3818  int i;
3819  INT32 sign;
3820  INT32 *in, *p;
3821  INT32 *out = (INT32 *)*bout;
3822  INT32 *end = (INT32 *)bend;
3823 
3824  if ( sizeof(WORD) == 2 ) {
3825  /* 4 -> 2 */
3826  INT32 len = (end - 1 - out) / 2;
3827  int zeros = 2;
3828  p = out + len - 1;
3829 
3830  if ( *p & 0xFFFF0000 ) --zeros;
3831  p += len;
3832  if ( *p & 0xFFFF0000 ) --zeros;
3833 
3834  in = end - 1;
3835  sign = ( *in-- > 0 ) ? 1 : -1;
3836  p = out + 4*len;
3837  if ( zeros == 2 ) p -= 2;
3838  out = p--;
3839 
3840  if ( zeros < 2 ) *p-- = *in >> 16;
3841  *p-- = *in-- & 0x0000FFFF;
3842  for ( i = 1; i < len; ++i ) {
3843  *p-- = *in >> 16;
3844  *p-- = *in-- & 0x0000FFFF;
3845  }
3846  if ( zeros < 2 ) *p-- = *in >> 16;
3847  *p-- = *in-- & 0x0000FFFF;
3848  for ( i = 1; i < len; ++i ) {
3849  *p-- = *in >> 16;
3850  *p-- = *in-- & 0x0000FFFF;
3851  }
3852 
3853  *out = (out - p) * sign;
3854  *bout = (UBYTE *)(out+1);
3855 
3856  }
3857  else {
3858  /* 2 -> 4 */
3859  INT32 len = (end - 1 - out) / 2;
3860  if ( len == 1 ) {
3861  *out = *(unsigned INT16 *)out;
3862  ++out;
3863  *out = *(unsigned INT16 *)out;
3864  ++out;
3865  ++out;
3866  }
3867  else {
3868  p = out;
3869  *out = *(unsigned INT16 *)out;
3870  in = out + 1;
3871  for ( i = 1; i < len; ++i ) {
3872  /* shift */
3873  *out = (unsigned INT32)(*(unsigned INT16 *)out)
3874  + ((unsigned INT32)(*(unsigned INT16 *)in) << 16);
3875  ++in;
3876  if ( ++i == len ) break;
3877  /* copy */
3878  ++out;
3879  *out = *(unsigned INT16 *)in;
3880  ++in;
3881  }
3882  ++out;
3883  *out = *(unsigned INT16 *)in;
3884  ++in;
3885  for ( i = 1; i < len; ++i ) {
3886  /* shift */
3887  *out = (unsigned INT32)(*(unsigned INT16 *)out)
3888  + ((unsigned INT32)(*(unsigned INT16 *)in) << 16);
3889  ++in;
3890  if ( ++i == len ) break;
3891  /* copy */
3892  ++out;
3893  *out = *(unsigned INT16 *)in;
3894  ++in;
3895  }
3896  ++out;
3897  if ( *in < 0 ) *out = -(out - p + 1);
3898  else *out = out - p + 1;
3899  ++out;
3900  }
3901 
3902  if ( out > (INT32 *)top ) {
3903  MesPrint("Error in resizing coefficient!");
3904  }
3905 
3906  *bout = (UBYTE *)out;
3907  }
3908 }
3909 
3910 /*
3911  #] ResizeCoeff :
3912  #[ WriteStoreHeader :
3913 */
3914 
3915 #define SAVEREVISION 0x02
3916 
3926 WORD WriteStoreHeader(WORD handle)
3927 {
3928  /* template of the STOREHEADER */
3929  static STOREHEADER sh = {
3930  { 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF }, /* store header mark */
3931  0, 0, 0, 0, /* sizeof of WORD,LONG,POSITION,void* */
3932  { 0 }, /* endianness check number */
3933  0, 0, 0, 0, /* sizeof variable structs */
3934  { 0 }, /* maxpower */
3935  { 0 }, /* wildoffset */
3936  SAVEREVISION, /* revision */
3937  { 0 } }; /* reserved */
3938  int endian, i;
3939 
3940  /* if called for the first time ... */
3941  if ( sh.lenWORD == 0 ) {
3942  sh.lenWORD = sizeof(WORD);
3943  sh.lenLONG = sizeof(LONG);
3944  sh.lenPOS = sizeof(POSITION);
3945  sh.lenPOINTER = sizeof(void *);
3946 
3947  endian = 1;
3948  for ( i = 1; i < (int)sizeof(int); ++i ) {
3949  endian <<= 8;
3950  endian += i+1;
3951  }
3952  for ( i = 0; i < (int)sizeof(int); ++i ) sh.endianness[i] = ((char *)&endian)[i];
3953 
3954  sh.sSym = sizeof(struct SyMbOl);
3955  sh.sInd = sizeof(struct InDeX);
3956  sh.sVec = sizeof(struct VeCtOr);
3957  sh.sFun = sizeof(struct FuNcTiOn);
3958 
3959 /* *((WORD *)sh.maxpower) = MAXPOWER;
3960  *((WORD *)sh.wildoffset) = WILDOFFSET; */
3961  {
3962  WORD dumw[8];
3963  UBYTE *dummy;
3964  for ( i = 0; i < 8; i++ ) dumw[i] = 0;
3965  dummy = (UBYTE *)dumw;
3966  dumw[0] = (WORD)MAXPOWER;
3967  for ( i = 0; i < 16; i++ ) sh.maxpower[i] = dummy[i];
3968  dumw[0] = (WORD)WILDOFFSET;
3969  for ( i = 0; i < 16; i++ ) sh.wildoffset[i] = dummy[i];
3970  }
3971  }
3972 
3973  return ( WriteFile(handle,(UBYTE *)(&sh),(LONG)(sizeof(STOREHEADER)))
3974  != (LONG)(sizeof(STOREHEADER)) );
3975 }
3976 
3977 /*
3978  #] WriteStoreHeader :
3979  #[ CompactifySizeof :
3980 */
3981 
3989 static unsigned int CompactifySizeof(unsigned int size)
3990 {
3991  switch ( size ) {
3992  case 2: return 0;
3993  case 4: return 1;
3994  case 8: return 2;
3995  case 16: return 3;
3996  default: MesPrint("Error compactifying size.");
3997  return 3;
3998  }
3999 }
4000 
4001 /*
4002  #] CompactifySizeof :
4003  #[ ReadSaveHeader :
4004 */
4005 
4020 {
4021  /* Read-only tables of function pointers for conversions. */
4022  static VOID (*flipJumpTable[4])(UBYTE *) =
4023  { Flip16, Flip32, Flip64, Flip128 };
4024  static VOID (*resizeJumpTable[4][4])(UBYTE *, UBYTE *) = /* "own x saved"-sizes */
4025  { { Resize16t16, Resize32t16, Resize64t16, Resize128t16 },
4026  { Resize16t32, Resize32t32, Resize64t32, Resize128t32 },
4027  { Resize16t64, Resize32t64, Resize64t64, Resize128t64 },
4028  { Resize16t128, Resize32t128, Resize64t128, Resize128t128 } };
4029  static VOID (*resizeNCJumpTable[4][4])(UBYTE *, UBYTE *) = /* "own x saved"-sizes */
4030  { { Resize16t16, Resize32t16NC, Resize64t16NC, Resize128t16NC },
4031  { Resize16t32, Resize32t32, Resize64t32NC, Resize128t32NC },
4032  { Resize16t64, Resize32t64, Resize64t64, Resize128t64NC },
4033  { Resize16t128, Resize32t128, Resize64t128, Resize128t128 } };
4034 
4035  int endian, i;
4036  WORD idxW = CompactifySizeof(sizeof(WORD));
4037  WORD idxL = CompactifySizeof(sizeof(LONG));
4038  WORD idxP = CompactifySizeof(sizeof(POSITION));
4039  WORD idxVP = CompactifySizeof(sizeof(void *));
4040 
4041  AO.transFlag = 0;
4042  AO.powerFlag = 0;
4043  AO.resizeFlag = 0;
4044  AO.bufferedInd = 0;
4045 
4046  if ( ReadFile(AO.SaveData.Handle,(UBYTE *)(&AO.SaveHeader),
4047  (LONG)sizeof(STOREHEADER)) != (LONG)sizeof(STOREHEADER) )
4048  return(MesPrint("Error reading save file header"));
4049 
4050  /* check whether save-file has no header. if yes then it is an old version
4051  of FORM -> go back to position 0 in file which then contains the first
4052  index and skip the rest. */
4053  for ( i = 0; i < 8; ++i ) {
4054  if ( AO.SaveHeader.headermark[i] != 0xFF ) {
4055  POSITION p;
4056  PUTZERO(p);
4057  SeekFile(AO.SaveData.Handle, &p, SEEK_SET);
4058  return ( 0 );
4059  }
4060  }
4061 
4062  if ( AO.SaveHeader.revision != SAVEREVISION ) {
4063  return(MesPrint("Save file header from an old version. Cannot read this file."));
4064  }
4065 
4066  endian = 1;
4067  for ( i = 1; i < (int)sizeof(int); ++i ) {
4068  endian <<= 8;
4069  endian += i+1;
4070  }
4071  if ( ((char *)&endian)[0] < ((char *)&endian)[1] ) {
4072  /* this machine is big-endian */
4073  AO.ResizeData = ResizeDataBE;
4074  }
4075  else {
4076  /* this machine is little-endian */
4077  AO.ResizeData = ResizeDataLE;
4078  }
4079 
4080  /* set AO.transFlag if ANY conversion has to be done later */
4081  if ( AO.SaveHeader.endianness[0] > AO.SaveHeader.endianness[1] ) {
4082  AO.transFlag = ( ((char *)&endian)[0] < ((char *)&endian)[1] );
4083  }
4084  else {
4085  AO.transFlag = ( ((char *)&endian)[0] > ((char *)&endian)[1] );
4086  }
4087  if ( (WORD)AO.SaveHeader.lenWORD != sizeof(WORD) ) AO.transFlag |= 0x02;
4088  if ( (WORD)AO.SaveHeader.lenLONG != sizeof(LONG) ) AO.transFlag |= 0x04;
4089  if ( (WORD)AO.SaveHeader.lenPOS != sizeof(POSITION) ) AO.transFlag |= 0x08;
4090  if ( (WORD)AO.SaveHeader.lenPOINTER != sizeof(void *) ) AO.transFlag |= 0x10;
4091 
4092  AO.FlipWORD = flipJumpTable[idxW];
4093  AO.FlipLONG = flipJumpTable[idxL];
4094  AO.FlipPOS = flipJumpTable[idxP];
4095  AO.FlipPOINTER = flipJumpTable[idxVP];
4096 
4097  /* Works only for machines where WORD is not greater than 32bit ! */
4098  AO.CheckPower = CheckPower32;
4099  AO.RenumberVec = RenumberVec32;
4100 
4101  AO.ResizeWORD = resizeJumpTable[idxW][CompactifySizeof(AO.SaveHeader.lenWORD)];
4102  AO.ResizeNCWORD = resizeNCJumpTable[idxW][CompactifySizeof(AO.SaveHeader.lenWORD)];
4103  AO.ResizeLONG = resizeJumpTable[idxL][CompactifySizeof(AO.SaveHeader.lenLONG)];
4104  AO.ResizePOS = resizeJumpTable[idxP][CompactifySizeof(AO.SaveHeader.lenPOS)];
4105  AO.ResizePOINTER = resizeJumpTable[idxVP][CompactifySizeof(AO.SaveHeader.lenPOINTER)];
4106 
4107  {
4108  WORD dumw[8];
4109  UBYTE *dummy;
4110  for ( i = 0; i < 8; i++ ) dumw[i] = 0;
4111  dummy = (UBYTE *)dumw;
4112  for ( i = 0; i < 16; i++ ) dummy[i] = AO.SaveHeader.maxpower[i];
4113  AO.mpower = dumw[0];
4114  }
4115 
4116  return ( 0 );
4117 }
4118 
4119 /*
4120  #] ReadSaveHeader :
4121  #[ ReadSaveIndex :
4122 */
4123 
4137 WORD ReadSaveIndex(FILEINDEX *fileind)
4138 {
4139  /* do we need some translation for the FILEINDEX? */
4140  if ( AO.transFlag ) {
4141  /* if a translated FILEINDEX can hold less entries than the original
4142  FILEINDEX, then we need to buffer the extra entires in this static
4143  variable (can happen going from 32bit to 64bit */
4144  static FILEINDEX sbuffer;
4145 
4146  FILEINDEX buffer;
4147  UBYTE *p, *q;
4148  int i;
4149 
4150  /* shortcuts */
4151  int lenW = AO.SaveHeader.lenWORD;
4152  int lenL = AO.SaveHeader.lenLONG;
4153  int lenP = AO.SaveHeader.lenPOS;
4154 
4155  /* if we have a buffered FILEINDEX then just return it */
4156  if ( AO.bufferedInd ) {
4157  *fileind = sbuffer;
4158  AO.bufferedInd = 0;
4159  return ( 0 );
4160  }
4161 
4162  if ( ReadFile(AO.SaveData.Handle, (UBYTE *)fileind, sizeof(FILEINDEX))
4163  != sizeof(FILEINDEX) ) {
4164  return ( MesPrint("Error(1) reading stored expression.") );
4165  }
4166 
4167  /* do we need to flip the endianness? */
4168  if ( AO.transFlag & 1 ) {
4169  LONG number;
4170  /* padding bytes */
4171  int padp = lenL - ((lenW*5+(MAXENAME + 1)) & (lenL-1));
4172  p = (UBYTE *)fileind;
4173  AO.FlipPOS(p); p += lenP; /* next */
4174  AO.FlipPOS(p); /* number */
4175  AO.ResizePOS(p, (UBYTE *)&number);
4176  p += lenP;
4177  for ( i = 0; i < number; ++i ) {
4178  AO.FlipPOS(p); p += lenP; /* position */
4179  AO.FlipPOS(p); p += lenP; /* length */
4180  AO.FlipPOS(p); p += lenP; /* variables */
4181  AO.FlipLONG(p); p += lenL; /* CompressSize */
4182  AO.FlipWORD(p); p += lenW; /* nsymbols */
4183  AO.FlipWORD(p); p += lenW; /* nindices */
4184  AO.FlipWORD(p); p += lenW; /* nvectors */
4185  AO.FlipWORD(p); p += lenW; /* nfunctions */
4186  AO.FlipWORD(p); p += lenW; /* size */
4187  p += padp;
4188  }
4189  }
4190 
4191  /* do we need to resize data? */
4192  if ( AO.transFlag > 1 ) {
4193  LONG number, maxnumber;
4194  int n;
4195  /* padding bytes */
4196  int padp = lenL - ((lenW*5+(MAXENAME + 1)) & (lenL-1));
4197  int padq = sizeof(LONG) - ((sizeof(WORD)*5+(MAXENAME + 1)) & (sizeof(LONG)-1));
4198 
4199  p = (UBYTE *)fileind; q = (UBYTE *)&buffer;
4200  AO.ResizePOS(p, q); /* next */
4201  p += lenP; q += sizeof(POSITION);
4202  AO.ResizePOS(p, q); /* number */
4203  p += lenP;
4204  number = BASEPOSITION(*((POSITION *)q));
4205  /* if FILEINDEX in file contains more entries than the FILEINDEX in
4206  memory can contain, then adjust the numbers and prepare for
4207  buffering */
4208  if ( number > (LONG)INFILEINDEX ) {
4209  AO.bufferedInd = number-INFILEINDEX;
4210  if ( AO.bufferedInd > (WORD)INFILEINDEX ) {
4211  /* can happen when reading 32bit and writing >=128bit.
4212  Fix: more than one static buffer for FILEINDEX */
4213  return ( MesPrint("Too many index entries.") );
4214  }
4215  maxnumber = INFILEINDEX;
4216  SETBASEPOSITION(*((POSITION *)q),INFILEINDEX);
4217  }
4218  else {
4219  maxnumber = number;
4220  }
4221  q += sizeof(POSITION);
4222  /* read all INDEXENTRY that fit into the output buffer */
4223  for ( i = 0; i < maxnumber; ++i ) {
4224  AO.ResizePOS(p, q); /* position */
4225  p += lenP; q += sizeof(POSITION);
4226  AO.ResizePOS(p, q); /* length */
4227  p += lenP; q += sizeof(POSITION);
4228  AO.ResizePOS(p, q); /* variables */
4229  p += lenP; q += sizeof(POSITION);
4230  AO.ResizeLONG(p, q); /* CompressSize */
4231  p += lenL; q += sizeof(LONG);
4232  AO.ResizeWORD(p, q); /* nsymbols */
4233  p += lenW; q += sizeof(WORD);
4234  AO.ResizeWORD(p, q); /* nindices */
4235  p += lenW; q += sizeof(WORD);
4236  AO.ResizeWORD(p, q); /* nvectors */
4237  p += lenW; q += sizeof(WORD);
4238  AO.ResizeWORD(p, q); /* nfunctions */
4239  p += lenW; q += sizeof(WORD);
4240  AO.ResizeWORD(p, q); /* size (unchanged!) */
4241  p += lenW; q += sizeof(WORD);
4242  n = MAXENAME + 1;
4243  NCOPYB(q, p, n)
4244  p += padp;
4245  q += padq;
4246  }
4247  /* read all the remaining INDEXENTRY and put them into the static buffer */
4248  if ( AO.bufferedInd ) {
4249  sbuffer.next = buffer.next;
4250  SETBASEPOSITION(sbuffer.number,AO.bufferedInd);
4251  q = (UBYTE *)&sbuffer + sizeof(POSITION) + sizeof(LONG);
4252  for ( i = maxnumber; i < number; ++i ) {
4253  AO.ResizePOS(p, q); /* position */
4254  p += lenP; q += sizeof(POSITION);
4255  AO.ResizePOS(p, q); /* length */
4256  p += lenP; q += sizeof(POSITION);
4257  AO.ResizePOS(p, q); /* variables */
4258  p += lenP; q += sizeof(POSITION);
4259  AO.ResizeLONG(p, q); /* CompressSize */
4260  p += lenL; q += sizeof(LONG);
4261  AO.ResizeWORD(p, q); /* nsymbols */
4262  p += lenW; q += sizeof(WORD);
4263  AO.ResizeWORD(p, q); /* nindices */
4264  p += lenW; q += sizeof(WORD);
4265  AO.ResizeWORD(p, q); /* nvectors */
4266  p += lenW; q += sizeof(WORD);
4267  AO.ResizeWORD(p, q); /* nfunctions */
4268  p += lenW; q += sizeof(WORD);
4269  AO.ResizeWORD(p, q); /* size (unchanged!) */
4270  p += lenW; q += sizeof(WORD);
4271  n = MAXENAME + 1;
4272  NCOPYB(q, p, n)
4273  p += padp;
4274  q += padq;
4275  }
4276  }
4277  /* copy to output */
4278  p = (UBYTE *)fileind; q = (UBYTE *)&buffer; n = sizeof(FILEINDEX);
4279  NCOPYB(p, q, n)
4280  }
4281  return ( 0 );
4282  } else {
4283  return ( ReadFile(AO.SaveData.Handle, (UBYTE *)fileind, sizeof(FILEINDEX))
4284  != sizeof(FILEINDEX) );
4285  }
4286 }
4287 
4288 /*
4289  #] ReadSaveIndex :
4290  #[ ReadSaveVariables :
4291 */
4292 
4323 WORD ReadSaveVariables(UBYTE *buffer, UBYTE *top, LONG *size, LONG *outsize,\
4324  INDEXENTRY *ind, LONG *stage)
4325 {
4326  /* do we need some translation for the variables? */
4327  if ( AO.transFlag ) {
4328  /* counters for the number of already read symbols, indices, ... that
4329  need to remain valid between different calls to ReadSaveVariables().
4330  are initialized if stage == -1 */
4331  static WORD numReadSym;
4332  static WORD numReadInd;
4333  static WORD numReadVec;
4334  static WORD numReadFun;
4335 
4336  POSITION pos;
4337  UBYTE *in, *out, *pp = 0, *end, *outbuf;
4338  LONG numread;
4339  WORD namelen, realnamelen;
4340  /* shortcuts */
4341  WORD lenW = AO.SaveHeader.lenWORD;
4342  WORD lenL = AO.SaveHeader.lenLONG;
4343  WORD lenP = AO.SaveHeader.lenPOINTER;
4344  WORD flip = AO.transFlag & 1;
4345 
4346  /* remember file position in case we have to rewind */
4347  TELLFILE(AO.SaveData.Handle,&pos);
4348 
4349  /* decide on the position of the in and out buffers.
4350  if the input is "bigger" than the output, we resize in-place, i.e.
4351  we immediately overwrite the source data by the translated data. in
4352  and out buffers start at the same place.
4353  if not, we read from the end of the given buffer and write at the
4354  beginning. */
4355  if ( (lenW > (WORD)sizeof(WORD))
4356  || ( (lenW == (WORD)sizeof(WORD))
4357  && ( (lenL > (WORD)sizeof(LONG))
4358  || ( (lenL == (WORD)sizeof(LONG)) && lenP > (WORD)sizeof(void *))
4359  )
4360  ) ) {
4361  in = out = buffer;
4362  end = buffer + *size;
4363  }
4364  else {
4365  /* data will grow roughly by sizeof(WORD)/lenW. the exact value is
4366  not important. if reading and writing areas start to overlap, the
4367  reading will already be near the end of the data and overwriting
4368  doesn't matter. */
4369  LONG newsize = (top - buffer) / (1 + sizeof(WORD)/lenW);
4370  end = top;
4371  out = buffer;
4372  in = end - newsize;
4373  if ( *size > newsize ) *size = newsize;
4374  }
4375 
4376  if ( ( numread = ReadFile(AO.SaveData.Handle, in, *size) ) != *size ) {
4377  return ( MesPrint("Error(2) reading stored expression.") );
4378  }
4379 
4380  *size = 0;
4381  *outsize = 0;
4382 
4383  /* first time in ReadSaveVariables(). initialize counters. */
4384  if ( *stage == -1 ) {
4385  numReadSym = 0;
4386  numReadInd = 0;
4387  numReadVec = 0;
4388  numReadFun = 0;
4389  ++*stage;
4390  }
4391 
4392  while ( in < end ) {
4393  /* Symbols */
4394  if ( *stage == 0 ) {
4395  if ( ind->nsymbols <= numReadSym ) {
4396  ++*stage;
4397  continue;
4398  }
4399  if ( end - in < AO.SaveHeader.sSym ) {
4400  goto RSVEnd;
4401  }
4402  if ( flip ) {
4403  pp = in;
4404  AO.FlipLONG(pp); pp += lenL;
4405  while ( pp < in + AO.SaveHeader.sSym ) {
4406  AO.FlipWORD(pp); pp += lenW;
4407  }
4408  }
4409  pp = in + AO.SaveHeader.sSym;
4410  AO.ResizeLONG(in, out); in += lenL; out += sizeof(LONG); /* name */
4411  AO.CheckPower(in);
4412  AO.ResizeWORD(in, out); in += lenW;
4413  if ( *((WORD *)out) == -AO.mpower ) *((WORD *)out) = -MAXPOWER;
4414  out += sizeof(WORD); /* minpower */
4415  AO.ResizeWORD(in, out); in += lenW;
4416  if ( *((WORD *)out) == AO.mpower ) *((WORD *)out) = MAXPOWER;
4417  out += sizeof(WORD); /* maxpower */
4418  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* complex */
4419  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* number */
4420  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* flags */
4421  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* node */
4422  AO.ResizeWORD(in, out); in += lenW; /* namesize */
4423  realnamelen = *((WORD *)out);
4424  realnamelen += sizeof(void *)-1; realnamelen &= -(sizeof(void *));
4425  out += sizeof(WORD);
4426  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* dimension */
4427  while ( in < pp ) {
4428  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD);
4429  }
4430  namelen = *((WORD *)out-1); /* cares for padding "bug" */
4431  if ( end - in < namelen ) {
4432  goto RSVEnd;
4433  }
4434  *((WORD *)out-1) = realnamelen;
4435  *size += AO.SaveHeader.sSym + namelen;
4436  *outsize += sizeof(struct SyMbOl) + realnamelen;
4437  if ( realnamelen > namelen ) {
4438  int j = namelen;
4439  NCOPYB(out, in, j);
4440  out += realnamelen - namelen;
4441  }
4442  else {
4443  int j = realnamelen;
4444  NCOPYB(out, in, j);
4445  in += namelen - realnamelen;
4446  }
4447  ++numReadSym;
4448  continue;
4449  }
4450  /* Indices */
4451  if ( *stage == 1 ) {
4452  if ( ind->nindices <= numReadInd ) {
4453  ++*stage;
4454  continue;
4455  }
4456  if ( end - in < AO.SaveHeader.sInd ) {
4457  goto RSVEnd;
4458  }
4459  if ( flip ) {
4460  pp = in;
4461  AO.FlipLONG(pp); pp += lenL;
4462  while ( pp < in + AO.SaveHeader.sInd ) {
4463  AO.FlipWORD(pp); pp += lenW;
4464  }
4465  }
4466  pp = in + AO.SaveHeader.sInd;
4467  AO.ResizeLONG(in, out); in += lenL; out += sizeof(LONG); /* name */
4468  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* type */
4469  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* dimension */
4470  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* number */
4471  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* flags */
4472  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* nmin4 */
4473  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* node */
4474  AO.ResizeWORD(in, out); in += lenW; /* namesize */
4475  realnamelen = *((WORD *)out);
4476  realnamelen += sizeof(void *)-1; realnamelen &= -(sizeof(void *));
4477  out += sizeof(WORD);
4478  while ( in < pp ) {
4479  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD);
4480  }
4481  namelen = *((WORD *)out-1); /* cares for padding "bug" */
4482  if ( end - in < namelen ) {
4483  goto RSVEnd;
4484  }
4485  *((WORD *)out-1) = realnamelen;
4486  *size += AO.SaveHeader.sInd + namelen;
4487  *outsize += sizeof(struct InDeX) + realnamelen;
4488  if ( realnamelen > namelen ) {
4489  int j = namelen;
4490  NCOPYB(out, in, j);
4491  out += realnamelen - namelen;
4492  }
4493  else {
4494  int j = realnamelen;
4495  NCOPYB(out, in, j);
4496  in += namelen - realnamelen;
4497  }
4498  ++numReadInd;
4499  continue;
4500  }
4501  /* Vectors */
4502  if ( *stage == 2 ) {
4503  if ( ind->nvectors <= numReadVec ) {
4504  ++*stage;
4505  continue;
4506  }
4507  if ( end - in < AO.SaveHeader.sVec ) {
4508  goto RSVEnd;
4509  }
4510  if ( flip ) {
4511  pp = in;
4512  AO.FlipLONG(pp); pp += lenL;
4513  while ( pp < in + AO.SaveHeader.sVec ) {
4514  AO.FlipWORD(pp); pp += lenW;
4515  }
4516  }
4517  pp = in + AO.SaveHeader.sVec;
4518  AO.ResizeLONG(in, out); in += lenL; out += sizeof(LONG); /* name */
4519  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* complex */
4520  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* number */
4521  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* flags */
4522  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* node */
4523  AO.ResizeWORD(in, out); in += lenW; /* namesize */
4524  realnamelen = *((WORD *)out);
4525  realnamelen += sizeof(void *)-1; realnamelen &= -(sizeof(void *));
4526  out += sizeof(WORD);
4527  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* dimension */
4528  while ( in < pp ) {
4529  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD);
4530  }
4531  namelen = *((WORD *)out-1); /* cares for padding "bug" */
4532  if ( end - in < namelen ) {
4533  goto RSVEnd;
4534  }
4535  *((WORD *)out-1) = realnamelen;
4536  *size += AO.SaveHeader.sVec + namelen;
4537  *outsize += sizeof(struct VeCtOr) + realnamelen;
4538  if ( realnamelen > namelen ) {
4539  int j = namelen;
4540  NCOPYB(out, in, j)
4541  out += realnamelen - namelen;
4542  }
4543  else {
4544  int j = realnamelen;
4545  NCOPYB(out, in, j)
4546  in += namelen - realnamelen;
4547  }
4548  ++numReadVec;
4549  continue;
4550  }
4551  /* Functions */
4552  if ( *stage == 3 ) {
4553  if ( ind->nfunctions <= numReadFun ) {
4554  ++*stage;
4555  continue;
4556  }
4557  if ( end - in < AO.SaveHeader.sFun ) {
4558  goto RSVEnd;
4559  }
4560  if ( flip ) {
4561  pp = in;
4562  AO.FlipPOINTER(pp); pp += lenP;
4563  AO.FlipLONG(pp); pp += lenL;
4564  AO.FlipLONG(pp); pp += lenL;
4565  while ( pp < in + AO.SaveHeader.sFun ) {
4566  AO.FlipWORD(pp); pp += lenW;
4567  }
4568  }
4569  pp = in + AO.SaveHeader.sFun;
4570  outbuf = out;
4571  AO.ResizePOINTER(in, out); in += lenP; out += sizeof(void *); /* tabl */
4572  AO.ResizeLONG(in, out); in += lenL; out += sizeof(LONG); /* symminfo */
4573  AO.ResizeLONG(in, out); in += lenL; out += sizeof(LONG); /* name */
4574  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* commute */
4575  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* complex */
4576  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* number */
4577  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* flags */
4578  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* spec */
4579  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* symmetric */
4580  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* numargs */
4581  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* node */
4582  AO.ResizeWORD(in, out); in += lenW; /* namesize */
4583  realnamelen = *((WORD *)out);
4584  realnamelen += sizeof(void *)-1; realnamelen &= -(sizeof(void *));
4585  out += sizeof(WORD);
4586  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD); /* dimension */
4587  while ( in < pp ) {
4588  AO.ResizeWORD(in, out); in += lenW; out += sizeof(WORD);
4589  }
4590  namelen = *((WORD *)out-1); /* cares for padding "bug" */
4591  if ( end - in < namelen ) {
4592  goto RSVEnd;
4593  }
4594  *((WORD *)out-1) = realnamelen;
4595  *size += AO.SaveHeader.sFun + namelen;
4596  *outsize += sizeof(struct FuNcTiOn) + realnamelen;
4597  if ( realnamelen > namelen ) {
4598  int j = namelen;
4599  NCOPYB(out, in, j);
4600  out += realnamelen - namelen;
4601  }
4602  else {
4603  int j = realnamelen;
4604  NCOPYB(out, in, j);
4605  in += namelen - realnamelen;
4606  }
4607  ++numReadFun;
4608  /* we use the information whether a function is tensorial later in ReadSaveTerm */
4609  AO.tensorList[((FUNCTIONS)outbuf)->number+FUNCTION] =
4610  (UBYTE)(((FUNCTIONS)outbuf)->spec == TENSORFUNCTION);
4611  continue;
4612  }
4613  /* handle numdummies */
4614  if ( end - in >= lenW ) {
4615  if ( flip ) AO.FlipWORD(in);
4616  AO.ResizeWORD(in, out);
4617  *size += lenW;
4618  *outsize += sizeof(WORD);
4619  }
4620  /* handle numfactors */
4621  if ( end - in >= lenW ) {
4622  if ( flip ) AO.FlipWORD(in);
4623  AO.ResizeWORD(in, out);
4624  *size += lenW;
4625  *outsize += sizeof(WORD);
4626  }
4627  /* handle vflags */
4628  if ( end - in >= lenW ) {
4629  if ( flip ) AO.FlipWORD(in);
4630  AO.ResizeWORD(in, out);
4631  *size += lenW;
4632  *outsize += sizeof(WORD);
4633  }
4634  return ( 0 );
4635  }
4636 
4637 RSVEnd:
4638  /* we are here because the remaining buffer cannot hold the next
4639  struct. we position the file behind the last sucessfully translated
4640  struct and return. */
4641  ADDPOS(pos, *size);
4642  SeekFile(AO.SaveData.Handle, &pos, SEEK_SET);
4643  return ( 0 );
4644  } else {
4645  return ( ReadFile(AO.SaveData.Handle, buffer, *size) != *size );
4646  }
4647 }
4648 
4649 /*
4650  #] ReadSaveVariables :
4651  #[ ReadSaveTerm :
4652 */
4653 
4682 UBYTE *
4683 ReadSaveTerm32(UBYTE *bin, UBYTE *binend, UBYTE **bout, UBYTE *boutend, UBYTE *top, int terminbuf)
4684 {
4685  GETIDENTITY
4686 
4687  UBYTE *boutbuf;
4688  INT32 len, j, id;
4689  INT32 *r, *t, *coeff, *end, *newtermsize, *rend;
4690  INT32 *newsubtermp;
4691  INT32 *in = (INT32 *)bin;
4692  INT32 *out = (INT32 *)*bout;
4693 
4694  /* if called recursively the term is already decompressed in buffer.
4695  is this the case? */
4696  if ( terminbuf ) {
4697  /* don't do any decompression, just adjust the pointers */
4698  len = *out;
4699  end = out + len;
4700  r = in + 1;
4701  rend = (INT32 *)boutend;
4702  coeff = end - ABS(*(end-1));
4703  newtermsize = (INT32 *)*bout;
4704  out = newtermsize + 1;
4705  }
4706  else {
4707  /* do deprompression of necessary. always return if the space in the
4708  buffer is not sufficient */
4709  INT32 rbuf;
4710  r = (INT32 *)AR.CompressBuffer;
4711  rbuf = *r;
4712  len = j = *in;
4713  /* first copy from AR.CompressBuffer if necessary */
4714  if ( j < 0 ) {
4715  ++in;
4716  if ( (UBYTE *)in >= binend ) {
4717  return ( bin );
4718  }
4719  *out = len = -j + 1 + *in;
4720  end = out + *out;
4721  if ( (UBYTE *)end >= top ) {
4722  return ( bin );
4723  }
4724  ++out;
4725  *r++ = len;
4726  while ( ++j <= 0 ) {
4727  INT32 bb = *r++;
4728  *out++ = bb;
4729  }
4730  j = *in++;
4731  }
4732  else if ( j == 0 ) {
4733  /* care for padding words */
4734  while ( (UBYTE *)in < binend ) {
4735  *out++ = 0;
4736  if ( (UBYTE *)out > top ) {
4737  return ( (UBYTE *)bin );
4738  }
4739 
4740  *r++ = 0;
4741  ++in;
4742  }
4743  *bout = (UBYTE *)out;
4744  return ( (UBYTE *)in );
4745  }
4746  else {
4747  end = out + len;
4748  if ( (UBYTE *)end >= top ) {
4749  return ( bin );
4750  }
4751  }
4752  if ( (UBYTE *)(in + j) >= binend ) {
4753  *(AR.CompressBuffer) = rbuf;
4754  return ( bin );
4755  }
4756  if ( (UBYTE *)out + j >= top ) {
4757  return ( bin );
4758  }
4759  /* second copy from input buffer */
4760  while ( --j >= 0 ) {
4761  INT32 bb = *in++;
4762  *r++ = *out++ = bb;
4763  }
4764 
4765  rend = r;
4766  r = (INT32 *)AR.CompressBuffer + 1;
4767  coeff = end - ABS(*(end-1));
4768  newtermsize = (INT32 *)*bout;
4769  out = newtermsize + 1;
4770  }
4771 
4772  /* iterate over subterms */
4773  while ( out < coeff ) {
4774 
4775  id = *out++;
4776  ++r;
4777  t = out + *out - 1;
4778  newsubtermp = out;
4779  ++out; ++r;
4780 
4781  if ( id == SYMBOL ) {
4782  while ( out < t ) {
4783  ++out; ++r; /* symbol number */
4784  /* if exponent is too big, rewrite as exponent function */
4785  if ( ABS(*out) >= MAXPOWER ) {
4786  INT32 *a, *b;
4787  INT32 n;
4788  INT32 num = *(out-1);
4789  INT32 exp = *out;
4790  coeff += 9;
4791  end += 9;
4792  t += 9;
4793  if ( (UBYTE *)end > top ) return ( bin );
4794  out -= 3;
4795  *out++ = EXPONENT; /* id */
4796  *out++ = 13; /* size */
4797  *out++ = 1; /* dirtyflag */
4798  *out++ = -SYMBOL; /* first short arg */
4799  *out++ = num;
4800  *out++ = 8; /* second arg, size */
4801  *out++ = 0; /* dirtyflag */
4802  *out++ = 6; /* term size */
4803  *out++ = ABS(exp) & 0x0000FFFF;
4804  *out++ = ABS(exp) >> 16;
4805  *out++ = 1;
4806  *out++ = 0;
4807  *out++ = ( exp < 0 ) ? -5 : 5;
4808  a = ++r;
4809  b = out;
4810  n = rend - r;
4811  NCOPYI32(b, a, n)
4812  }
4813  else {
4814  ++out; ++r;
4815  }
4816  }
4817  }
4818  else if ( id == DOTPRODUCT ) {
4819  while ( out < t ) {
4820  AO.RenumberVec((UBYTE *)out); /* vector 1 */
4821  ++out; ++r;
4822  AO.RenumberVec((UBYTE *)out); /* vector 2 */
4823  ++out; ++r;
4824  /* if exponent is too big, rewrite as exponent function */
4825  if ( ABS(*out) >= MAXPOWER ) {
4826  INT32 *a, *b;
4827  INT32 n;
4828  INT32 num1 = *(out-2);
4829  INT32 num2 = *(out-1);
4830  INT32 exp = *out;
4831  coeff += 17;
4832  end += 17;
4833  t += 17;
4834  if ( (UBYTE *)end > top ) return ( bin );
4835  out -= 4;
4836  *out++ = EXPONENT; /* id */
4837  *out++ = 22; /* size */
4838  *out++ = 1; /* dirtyflag */
4839  *out++ = 11; /* first arg, size */
4840  *out++ = 0; /* dirtyflag */
4841  *out++ = 9; /* term size */
4842  *out++ = DOTPRODUCT; /* p1.p2 */
4843  *out++ = 5; /* subterm size */
4844  *out++ = num1; /* p1 */
4845  *out++ = num2; /* p2 */
4846  *out++ = 1; /* exponent */
4847  *out++ = 1; /* coeff */
4848  *out++ = 1;
4849  *out++ = 3;
4850  *out++ = 8; /* second arg, size */
4851  *out++ = 0; /* dirtyflag */
4852  *out++ = 6; /* term size */
4853  *out++ = ABS(exp) & 0x0000FFFF;
4854  *out++ = ABS(exp) >> 16;
4855  *out++ = 1;
4856  *out++ = 0;
4857  *out++ = ( exp < 0 ) ? -5 : 5;
4858  a = ++r;
4859  b = out;
4860  n = rend - r;
4861  NCOPYI32(b, a, n)
4862  }
4863  else {
4864  ++out; ++r;
4865  }
4866  }
4867  }
4868  else if ( id == VECTOR ) {
4869  while ( out < t ) {
4870  AO.RenumberVec((UBYTE *)out); /* vector number */
4871  ++out; ++r;
4872  ++out; ++r; /* index, do nothing */
4873  }
4874  }
4875  else if ( id == INDEX ) {
4876 /* INT32 vectoroffset = -2 * *((INT32 *)AO.SaveHeader.wildoffset); */
4877  void *dummy = (void *)AO.SaveHeader.wildoffset; /* to remove a warning about strict-aliasing rules in gcc */
4878  INT32 vectoroffset = -2 * *((INT32 *)dummy);
4879  while ( out < t ) {
4880  /* if there is a vector, renumber it */
4881  if ( *out < vectoroffset ) {
4882  AO.RenumberVec((UBYTE *)out);
4883  }
4884  ++out; ++r;
4885  }
4886  }
4887  else if ( id == SUBEXPRESSION ) {
4888  /* nothing to translate */
4889  while ( out < t ) {
4890  ++out; ++r;
4891  }
4892  }
4893  else if ( id == DELTA ) {
4894  /* nothing to translate */
4895  r += t - out;
4896  out = t;
4897  }
4898  else if ( id == HAAKJE ) {
4899  /* nothing to translate */
4900  r += t - out;
4901  out = t;
4902  }
4903  else if ( id == GAMMA || id == LEVICIVITA || (id >= FUNCTION && AO.tensorList[id]) ) {
4904 /* INT32 vectoroffset = -2 * *((INT32 *)AO.SaveHeader.wildoffset); */
4905  void *dummy = (void *)AO.SaveHeader.wildoffset; /* to remove a warning about strict-aliasing rules in gcc */
4906  INT32 vectoroffset = -2 * *((INT32 *)dummy);
4907  while ( out < t ) {
4908  /* if there is a vector as an argument, renumber it */
4909  if ( *out < vectoroffset ) {
4910  AO.RenumberVec((UBYTE *)out);
4911  }
4912  ++out; ++r;
4913  }
4914  }
4915  else if ( id >= FUNCTION ) {
4916  INT32 *argEnd;
4917  UBYTE *newbin;
4918 
4919  ++out; ++r; /* dirty flags */
4920 
4921  /* loop over arguments */
4922  while ( out < t ) {
4923  if ( *out < 0 ) {
4924  /* short notation arguments */
4925  switch ( -*out ) {
4926  case SYMBOL:
4927  ++out; ++r;
4928  ++out; ++r;
4929  break;
4930  case SNUMBER:
4931  ++out; ++r;
4932  if ( sizeof(WORD) == 2 ) {
4933  /* resize if needed */
4934  if ( *out > (1<<15)-1 || *out < -(1<<15)+1 ) {
4935  INT32 *a, *b;
4936  INT32 n;
4937  INT32 num = *out;
4938  coeff += 6;
4939  end += 6;
4940  argEnd += 6;
4941  t += 6;
4942  if ( (UBYTE *)end > top ) return ( bin );
4943  --out;
4944  *out++ = 8; /* argument size */
4945  *out++ = 0; /* dirtyflag */
4946  *out++ = 6; /* term size */
4947  *out++ = ABS(num) & 0x0000FFFF;
4948  *out++ = ABS(num) >> 16;
4949  *out++ = 1;
4950  *out++ = 0;
4951  *out++ = ( num < 0 ) ? -5 : 5;
4952  a = ++r;
4953  b = out;
4954  n = rend - r;
4955  NCOPYI32(b, a, n)
4956  }
4957  else {
4958  ++out; ++r;
4959  }
4960  }
4961  else {
4962  ++out; ++r;
4963  }
4964  break;
4965  case VECTOR:
4966  ++out; ++r;
4967  AO.RenumberVec((UBYTE *)out);
4968  ++out; ++r;
4969  break;
4970  case INDEX:
4971  ++out; ++r;
4972  ++out; ++r;
4973  break;
4974  case MINVECTOR:
4975  ++out; ++r;
4976  AO.RenumberVec((UBYTE *)out);
4977  ++out; ++r;
4978  break;
4979  default:
4980  if ( -*out >= FUNCTION ) {
4981  ++out; ++r;
4982  break;
4983  } else {
4984  MesPrint("short function code %d not implemented.", *out);
4985  return ( (UBYTE *)in );
4986  }
4987  }
4988  }
4989  else {
4990  /* long arguments */
4991  INT32 *newargsize = out;
4992  argEnd = out + *out;
4993  ++out; ++r;
4994  ++out; ++r; /* dirty flags */
4995  while ( out < argEnd ) {
4996  INT32 *keepsizep = out + *out;
4997  INT32 lenbuf = *out;
4998  INT32 **ppp = &out; /* to avoid a compiler warning */
4999  /* recursion */
5000  newbin = ReadSaveTerm32((UBYTE *)r, binend, (UBYTE **)ppp, (UBYTE *)rend, top, 1);
5001  r += lenbuf;
5002  if ( newbin == (UBYTE *)r ) {
5003  return ( (UBYTE *)in );
5004  }
5005  /* if the term done by recursion has changed in size,
5006  we need to move the rest of the data accordingly */
5007  if ( out > keepsizep ) {
5008  INT32 *a, *b;
5009  INT32 n;
5010  INT32 extention = out - keepsizep;
5011  a = r;
5012  b = out;
5013  n = rend - r;
5014  NCOPYI32(b, a, n)
5015  coeff += extention;
5016  end += extention;
5017  argEnd += extention;
5018  t += extention;
5019  }
5020  else if ( out < keepsizep ) {
5021  INT32 *a, *b;
5022  INT32 n;
5023  INT32 extention = keepsizep - out;
5024  a = keepsizep;
5025  b = out;
5026  n = rend - r;
5027  NCOPYI32(b, a, n)
5028  coeff -= extention;
5029  end -= extention;
5030  argEnd -= extention;
5031  t -= extention;
5032  }
5033  }
5034  *newargsize = out - newargsize;
5035  }
5036  }
5037  }
5038  else {
5039  MesPrint("ID %d not recognized.", id);
5040  return ( (UBYTE *)in );
5041  }
5042 
5043  *newsubtermp = out - newsubtermp + 1;
5044  }
5045 
5046  if ( (UBYTE *)end >= top ) {
5047  return ( bin );
5048  }
5049 
5050  /* do coefficient and adjust term size */
5051  boutbuf = *bout;
5052  *bout = (UBYTE *)out;
5053 
5054  ResizeCoeff32(bout, (UBYTE *)end, top);
5055 
5056  if ( *bout >= top ) {
5057  *bout = boutbuf;
5058  return ( bin );
5059  }
5060 
5061  *newtermsize = (INT32 *)*bout - newtermsize;
5062 
5063  return ( (UBYTE *)in );
5064 }
5065 
5066 /*
5067  #] ReadSaveTerm :
5068  #[ ReadSaveExpression :
5069 */
5070 
5092 WORD ReadSaveExpression(UBYTE *buffer, UBYTE *top, LONG *size, LONG *outsize)
5093 {
5094  if ( AO.transFlag ) {
5095  UBYTE *in, *end, *out, *outend, *p;
5096  POSITION pos;
5097  LONG half;
5098  WORD lenW = AO.SaveHeader.lenWORD;
5099 
5100  /* remember the last file position in case an expression cannot be
5101  fully processed */
5102  TELLFILE(AO.SaveData.Handle,&pos);
5103 
5104  /* adjust 'size' depending on whether the translated data is bigger or
5105  smaller */
5106  half = (top-buffer)/2;
5107  if ( *size > half ) *size = half;
5108  if ( lenW < (WORD)sizeof(WORD) ) {
5109  if ( *size * (LONG)sizeof(WORD)/lenW > half ) *size = half*lenW/(LONG)sizeof(WORD);
5110  }
5111  else {
5112  if ( *size > half ) *size = half;
5113  }
5114 
5115  /* depending on the necessary resizing we position the input pointer
5116  either at the start of the buffer or in the middle. if the data will
5117  roughly remain the same size, we need only one processing step, so
5118  we put the 'in' at the middle and 'out' and the beginning. in the
5119  other cases we need two processing steps, so first we put 'in' at
5120  the beginning and write at the middle. the second step can then read
5121  from the middle and put its results at the beginning. */
5122  in = out = buffer;
5123  if ( lenW == sizeof(WORD) ) in += half;
5124  else out += half;
5125  end = in + *size;
5126  outend = out + *size;
5127 
5128  if ( ReadFile(AO.SaveData.Handle, in, *size) != *size ) {
5129  return ( MesPrint("Error(3) reading stored expression.") );
5130  }
5131 
5132  if ( AO.transFlag & 1 ) {
5133  p = in;
5134  end -= lenW;
5135  while ( p <= end ) {
5136  AO.FlipWORD(p); p += lenW;
5137  }
5138  end += lenW;
5139  }
5140 
5141  if ( lenW > (WORD)sizeof(WORD) ) {
5142  /* renumber first */
5143  do {
5144  outend = out+*size;
5145  if ( outend > top ) outend = top;
5146  p = ReadSaveTerm32(in, end, &out, outend, top, 0);
5147  if ( p == in ) break;
5148  in = p;
5149  } while ( in <= end - lenW );
5150  /* then resize */
5151  *size = in - buffer;
5152  in = buffer + half;
5153  end = out;
5154  out = buffer;
5155 
5156  while ( in < end ) {
5157  /* resize without checking */
5158  AO.ResizeNCWORD(in, out);
5159  in += lenW; out += sizeof(WORD);
5160  }
5161  }
5162  else {
5163  if ( lenW < (WORD)sizeof(WORD) ) {
5164  /* resize first */
5165  while ( in < end ) {
5166  AO.ResizeWORD(in, out);
5167  in += lenW; out += sizeof(WORD);
5168  }
5169  in = buffer + half;
5170  end = out;
5171  out = buffer;
5172  }
5173  /* then renumber */
5174  do {
5175  p = ReadSaveTerm32(in, end, &out, buffer+half, buffer+half, 0);
5176  if ( p == in ) break;
5177  in = p;
5178  } while ( in <= end - sizeof(WORD) );
5179  *size = (in - buffer - half) * lenW / (ULONG)sizeof(WORD);
5180  }
5181  *outsize = out - buffer;
5182  ADDPOS(pos, *size);
5183  SeekFile(AO.SaveData.Handle, &pos, SEEK_SET);
5184 
5185  return ( 0 );
5186  }
5187  else {
5188  return ( ReadFile(AO.SaveData.Handle, buffer, *size) != *size );
5189  }
5190 }
5191 
5192 /*
5193  #] ReadSaveExpression :
5194  #] System Independent Saved Expressions :
5195 */
WORD number
Definition: structs.h:481
UBYTE wildoffset[16]
Definition: structs.h:87
UBYTE sFun
Definition: structs.h:85
UBYTE * ReadSaveTerm32(UBYTE *bin, UBYTE *binend, UBYTE **bout, UBYTE *boutend, UBYTE *top, int terminbuf)
Definition: store.c:4683
#define INFILEINDEX
Definition: structs.h:118
Definition: structs.h:443
WORD nsymbols
Definition: structs.h:104
Definition: structs.h:633
WORD nvectors
Definition: structs.h:106
POSITION position
Definition: structs.h:100
VARRENUM indi
Definition: structs.h:181
LONG CompressSize
Definition: structs.h:103
VARRENUM vect
Definition: structs.h:182
POSITION next
Definition: structs.h:138
WORD node
Definition: structs.h:485
WORD ReadSaveIndex(FILEINDEX *fileind)
Definition: store.c:4137
UBYTE lenPOINTER
Definition: structs.h:80
UBYTE sVec
Definition: structs.h:84
UBYTE sInd
Definition: structs.h:83
POSITION variables
Definition: structs.h:102
UBYTE lenPOS
Definition: structs.h:79
struct ReNuMbEr * RENUMBER
SBYTE name[MAXENAME+1]
Definition: structs.h:109
WORD * vecnum
Definition: structs.h:187
INDEXENTRY expression[INFILEINDEX]
Definition: structs.h:140
WORD * symnum
Definition: structs.h:185
UBYTE sSym
Definition: structs.h:82
UBYTE lenWORD
Definition: structs.h:77
WORD SetFileIndex()
Definition: store.c:2300
UBYTE lenLONG
Definition: structs.h:78
POSITION length
Definition: structs.h:101
WORD * hi
Definition: structs.h:168
POSITION number
Definition: structs.h:139
WORD ReadSaveExpression(UBYTE *buffer, UBYTE *top, LONG *size, LONG *outsize)
Definition: store.c:5092
WORD nindices
Definition: structs.h:105
struct StOrEcAcHe * STORECACHE
WORD size
Definition: structs.h:108
WORD ReadSaveVariables(UBYTE *buffer, UBYTE *top, LONG *size, LONG *outsize, INDEXENTRY *ind, LONG *stage)
Definition: store.c:4323
WORD spec
Definition: structs.h:483
WORD * start
Definition: structs.h:166
WORD WriteStoreHeader(WORD handle)
Definition: store.c:3926
UBYTE endianness[16]
Definition: structs.h:81
WORD * indnum
Definition: structs.h:186
UBYTE maxpower[16]
Definition: structs.h:86
VARRENUM func
Definition: structs.h:183
struct FuNcTiOn * FUNCTIONS
WORD TermRenumber(WORD *term, RENUMBER renumber, WORD nexpr)
Definition: store.c:2407
struct FiLeInDeX FILEINDEX
WORD nfunctions
Definition: structs.h:107
int handle
Definition: structs.h:661
WORD ReadSaveHeader()
Definition: store.c:4019
VARRENUM symb
Definition: structs.h:180
WORD * funnum
Definition: structs.h:188
WORD * lo
Definition: structs.h:167