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