ArchWizard

DGD/

source navigation ]
diff markup ]
identifier search ]
file search ]
Version: [ 1.0.a0 ] [ 1.1 ] [ 1.2 ] [ 1.2p1 ] [ 1.2p2 ] [ 1.2p3 ] [ 1.2p4 ] [ 1.2.151 ]

  1 # include "dgd.h"
  2 # include "str.h"
  3 # include "array.h"
  4 # include "object.h"
  5 # include "interpret.h"
  6 # include "data.h"
  7 # include "call_out.h"
  8 # include "parse.h"
  9 # include "csupport.h"
 10 
 11 /* bit values for ctrl->flags */
 12 # define CTRL_PROGCMP           0x03    /* program compressed */
 13 # define CTRL_STRCMP            0x0c    /* strings compressed */
 14 # define CTRL_COMPILED          0x10    /* precompiled control block */
 15 # define CTRL_VARMAP            0x20    /* varmap updated */
 16 
 17 /* bit values for dataspace->flags */
 18 # define DATA_STRCMP            0x03    /* strings compressed */
 19 
 20 /* bit values for dataspace->plane->flags */
 21 # define MOD_ALL                0x3f
 22 # define MOD_VARIABLE           0x01    /* variable changed */
 23 # define MOD_ARRAY              0x02    /* array element changed */
 24 # define MOD_ARRAYREF           0x04    /* array reference changed */
 25 # define MOD_STRINGREF          0x08    /* string reference changed */
 26 # define MOD_CALLOUT            0x10    /* callout changed */
 27 # define MOD_NEWCALLOUT         0x20    /* new callout added */
 28 # define PLANE_MERGE            0x40    /* merge planes on commit */
 29 
 30 /* data compression */
 31 # define CMP_TYPE               0x03
 32 # define CMP_NONE               0x00    /* no compression */
 33 # define CMP_PRED               0x01    /* predictor compression */
 34 
 35 # define CMPLIMIT               2048    /* compress if >= CMPLIMIT */
 36 
 37 # define ARR_MOD                0x80000000L     /* in arrref->ref */
 38 # define PRIV                   0x8000          /* in sinherit->varoffset */
 39 
 40 # define AR_UNCHANGED           0       /* mapping unchanged */
 41 # define AR_CHANGED             1       /* mapping changed */
 42 
 43 typedef struct {
 44     sector nsectors;            /* # sectors in part one */
 45     char flags;                 /* control flags: compression */
 46     char ninherits;             /* # objects in inherit table */
 47     Uint compiled;              /* time of compilation */
 48     Uint progsize;              /* size of program code */
 49     unsigned short nstrings;    /* # strings in string constant table */
 50     Uint strsize;               /* size of string constant table */
 51     char nfuncdefs;             /* # entries in function definition table */
 52     char nvardefs;              /* # entries in variable definition table */
 53     uindex nfuncalls;           /* # entries in function call table */
 54     unsigned short nsymbols;    /* # entries in symbol table */
 55     unsigned short nvariables;  /* # variables */
 56     unsigned short nifdefs;     /* # int/float definitions */
 57     unsigned short nvinit;      /* # variables requiring initialization */
 58     unsigned short vmapsize;    /* size of variable map, or 0 for none */
 59 } scontrol;
 60 
 61 static char sc_layout[] = "dcciisiccusssss";
 62 
 63 typedef struct {
 64     uindex oindex;              /* index in object table */
 65     uindex funcoffset;          /* function call offset */
 66     unsigned short varoffset;   /* variable offset + private bit */
 67 } sinherit;
 68 
 69 static char si_layout[] = "uus";
 70 
 71 typedef struct {
 72     sector nsectors;            /* number of sectors in data space */
 73     short flags;                /* dataspace flags: compression */
 74     unsigned short nvariables;  /* number of variables */
 75     Uint narrays;               /* number of array values */
 76     Uint eltsize;               /* total size of array elements */
 77     Uint nstrings;              /* number of strings */
 78     Uint strsize;               /* total size of strings */
 79     uindex ncallouts;           /* number of callouts */
 80     uindex fcallouts;           /* first free callout */
 81 } sdataspace;
 82 
 83 static char sd_layout[] = "dssiiiiuu";
 84 
 85 typedef struct _svalue_ {
 86     short type;                 /* object, number, string, array */
 87     uindex oindex;              /* index in object table */
 88     union {
 89         Int number;             /* number */
 90         Uint string;            /* string */
 91         Uint objcnt;            /* object creation count */
 92         Uint array;             /* array */
 93     } u;
 94 } svalue;
 95 
 96 static char sv_layout[] = "sui";
 97 
 98 typedef struct _sarray_ {
 99     Uint index;                 /* index in array value table */
100     unsigned short size;        /* size of array */
101     Uint ref;                   /* refcount */
102     Uint tag;                   /* unique value for each array */
103 } sarray;
104 
105 static char sa_layout[] = "isii";
106 
107 typedef struct _sstring_ {
108     Uint index;                 /* index in string text table */
109     ssizet len;                 /* length of string */
110     Uint ref;                   /* refcount */
111 } sstring;
112 
113 static char ss_layout[] = "iti";
114 
115 typedef struct _dcallout_ {
116     Uint time;                  /* time of call */
117     unsigned short nargs;       /* number of arguments */
118     value val[4];               /* function name, 3 direct arguments */
119 } dcallout;
120 
121 typedef struct {
122     Uint time;                  /* time of call */
123     unsigned short nargs;       /* number of arguments */
124     svalue val[4];              /* function name, 3 direct arguments */
125 } scallout;
126 
127 static char sco_layout[] = "is[sui][sui][sui][sui]";
128 
129 # define co_prev        time
130 # define co_next        nargs
131 
132 # define COP_ADD        0       /* add callout patch */
133 # define COP_REMOVE     1       /* remove callout patch */
134 # define COP_REPLACE    2       /* replace callout patch */
135 
136 typedef struct _copatch_ {
137     short type;                 /* add, remove, replace */
138     uindex handle;              /* callout handle */
139     dataplane *plane;           /* dataplane */
140     Uint time;                  /* start time */
141     unsigned short mtime;       /* start time millisec component */
142     cbuf *queue;                /* callout queue */
143     struct _copatch_ *next;     /* next in linked list */
144     dcallout aco;               /* added callout */
145     dcallout rco;               /* removed callout */
146 } copatch;
147 
148 # define COPCHUNKSZ     32
149 
150 typedef struct _copchunk_ {
151     struct _copchunk_ *next;    /* next in linked list */
152     copatch cop[COPCHUNKSZ];    /* callout patches */
153 } copchunk;
154 
155 typedef struct _coptable_ {
156     copchunk *chunk;                    /* callout patch chunk */
157     unsigned short chunksz;             /* size of callout patch chunk */
158     copatch *flist;                     /* free list of callout patches */
159     copatch *cop[COPATCHHTABSZ];        /* hash table of callout patches */
160 } coptable;
161 
162 typedef struct {
163     Uint narr;                          /* # of arrays */
164     Uint nstr;                          /* # of strings */
165     Uint arrsize;                       /* # of array elements */
166     Uint strsize;                       /* total string size */
167     sarray *sarrays;                    /* save arrays */
168     svalue *selts;                      /* save array elements */
169     sstring *sstrings;                  /* save strings */
170     char *stext;                        /* save string elements */
171 } savedata;
172 
173 typedef struct {
174     array **itab;                       /* imported array replacement table */
175     Uint itabsz;                        /* size of table */
176     Uint narr;                          /* # of arrays */
177 } arrimport;
178 
179 static control *chead, *ctail;          /* list of control blocks */
180 static dataspace *dhead, *dtail;        /* list of dataspace blocks */
181 static dataplane *plist;                /* list of dataplanes */
182 static sector nctrl;                    /* # control blocks */
183 static sector ndata;                    /* # dataspace blocks */
184 static bool nilisnot0;                  /* nil != int 0 */
185 static uindex ncallout;                 /*  # callouts added */
186 
187 
188 /*
189  * NAME:        data->init()
190  * DESCRIPTION: initialize swapped data handling
191  */
192 void d_init(flag)
193 int flag;
194 {
195     chead = ctail = (control *) NULL;
196     dhead = dtail = (dataspace *) NULL;
197     plist = (dataplane *) NULL;
198     nctrl = ndata = 0;
199     nilisnot0 = flag;
200 }
201 
202 /*
203  * NAME:        data->new_control()
204  * DESCRIPTION: create a new control block
205  */
206 control *d_new_control()
207 {
208     register control *ctrl;
209 
210     ctrl = ALLOC(control, 1);
211     if (chead != (control *) NULL) {
212         /* insert at beginning of list */
213         chead->prev = ctrl;
214         ctrl->prev = (control *) NULL;
215         ctrl->next = chead;
216         chead = ctrl;
217     } else {
218         /* list was empty */
219         ctrl->prev = ctrl->next = (control *) NULL;
220         chead = ctail = ctrl;
221     }
222     ctrl->ndata = 0;
223     nctrl++;
224 
225     ctrl->flags = 0;
226 
227     ctrl->nsectors = 0;         /* nothing on swap device yet */
228     ctrl->sectors = (sector *) NULL;
229     ctrl->oindex = UINDEX_MAX;
230     ctrl->ninherits = 0;
231     ctrl->inherits = (dinherit *) NULL;
232     ctrl->progsize = 0;
233     ctrl->prog = (char *) NULL;
234     ctrl->nstrings = 0;
235     ctrl->strings = (string **) NULL;
236     ctrl->sstrings = (dstrconst *) NULL;
237     ctrl->stext = (char *) NULL;
238     ctrl->nfuncdefs = 0;
239     ctrl->funcdefs = (dfuncdef *) NULL;
240     ctrl->nvardefs = 0;
241     ctrl->vardefs = (dvardef *) NULL;
242     ctrl->nfuncalls = 0;
243     ctrl->funcalls = (char *) NULL;
244     ctrl->nsymbols = 0;
245     ctrl->symbols = (dsymbol *) NULL;
246     ctrl->nvariables = 0;
247     ctrl->nifdefs = 0;
248     ctrl->nvinit = 0;
249     ctrl->vmapsize = 0;
250     ctrl->vmap = (unsigned short *) NULL;
251 
252     return ctrl;
253 }
254 
255 /*
256  * NAME:        d_alloc_dataspace()
257  * DESCRIPTION: allocate a new dataspace block
258  */
259 static dataspace *d_alloc_dataspace(obj)
260 object *obj;
261 {
262     register dataspace *data;
263 
264     data = ALLOC(dataspace, 1);
265     if (dhead != (dataspace *) NULL) {
266         /* insert at beginning of list */
267         dhead->prev = data;
268         data->prev = (dataspace *) NULL;
269         data->next = dhead;
270         dhead = data;
271     } else {
272         /* list was empty */
273         data->prev = data->next = (dataspace *) NULL;
274         dhead = dtail = data;
275     }
276     ndata++;
277 
278     data->iprev = (dataspace *) NULL;
279     data->inext = (dataspace *) NULL;
280     data->flags = 0;
281 
282     data->oindex = obj->index;
283     data->ctrl = (control *) NULL;
284 
285     /* sectors */
286     data->nsectors = 0;
287     data->sectors = (sector *) NULL;
288 
289     /* variables */
290     data->nvariables = 0;
291     data->variables = (value *) NULL;
292     data->svariables = (svalue *) NULL;
293 
294     /* arrays */
295     data->narrays = 0;
296     data->eltsize = 0;
297     data->sarrays = (sarray *) NULL;
298     data->selts = (svalue *) NULL;
299 
300     /* strings */
301     data->nstrings = 0;
302     data->strsize = 0;
303     data->sstrings = (sstring *) NULL;
304     data->stext = (char *) NULL;
305 
306     /* callouts */
307     data->ncallouts = 0;
308     data->fcallouts = 0;
309     data->callouts = (dcallout *) NULL;
310 
311     /* value plane */
312     data->base.level = 0;
313     data->base.flags = 0;
314     data->base.schange = 0;
315     data->base.achange = 0;
316     data->base.imports = 0;
317     data->base.alocal.arr = (array *) NULL;
318     data->base.alocal.plane = &data->base;
319     data->base.alocal.data = data;
320     data->base.alocal.state = AR_CHANGED;
321     data->base.arrays = (arrref *) NULL;
322     data->base.strings = (strref *) NULL;
323     data->base.coptab = (coptable *) NULL;
324     data->base.prev = (dataplane *) NULL;
325     data->base.plist = (dataplane *) NULL;
326     data->plane = &data->base;
327 
328     /* parse_string data */
329     data->parser = (struct _parser_ *) NULL;
330 
331     return data;
332 }
333 
334 /*
335  * NAME:        data->new_dataspace()
336  * DESCRIPTION: create a new dataspace block
337  */
338 dataspace *d_new_dataspace(obj)
339 object *obj;
340 {
341     register dataspace *data;
342 
343     data = d_alloc_dataspace(obj);
344     data->base.flags = MOD_VARIABLE;
345     data->ctrl = o_control(obj);
346     data->ctrl->ndata++;
347     data->nvariables = data->ctrl->nvariables + 1;
348 
349     return data;
350 }
351 
352 /*
353  * NAME:        data->load_control()
354  * DESCRIPTION: load a control block from the swap device
355  */
356 control *d_load_control(obj)
357 register object *obj;
358 {
359     register control *ctrl;
360 
361     ctrl = d_new_control();
362     ctrl->oindex = obj->index;
363 
364     if (obj->flags & O_COMPILED) {
365         /* initialize control block of compiled object */
366         pc_control(ctrl, obj);
367         ctrl->flags |= CTRL_COMPILED;
368     } else {
369         scontrol header;
370         register Uint size;
371 
372         /* header */
373         sw_readv((char *) &header, &obj->cfirst, (Uint) sizeof(scontrol),
374                  (Uint) 0);
375         ctrl->nsectors = header.nsectors;
376         ctrl->sectors = ALLOC(sector, header.nsectors);
377         ctrl->sectors[0] = obj->cfirst;
378         size = header.nsectors * (Uint) sizeof(sector);
379         if (header.nsectors > 1) {
380             sw_readv((char *) ctrl->sectors, ctrl->sectors, size,
381                      (Uint) sizeof(scontrol));
382         }
383         size += sizeof(scontrol);
384 
385         ctrl->flags = header.flags;
386 
387         /* inherits */
388         ctrl->ninherits = UCHAR(header.ninherits);
389 
390         if (header.vmapsize != 0) {
391             /*
392              * Control block for outdated issue; only vmap can be loaded.
393              * The load offsets will be invalid (and unused).
394              */
395             ctrl->vmapsize = header.vmapsize;
396             ctrl->vmap = ALLOC(unsigned short, header.vmapsize);
397             sw_readv((char *) ctrl->vmap, ctrl->sectors,
398                      header.vmapsize * (Uint) sizeof(unsigned short), size);
399         } else {
400             register int n;
401             register dinherit *inherits;
402             register sinherit *sinherits;
403 
404             /* load inherits */
405             n = UCHAR(header.ninherits); /* at least one */
406             ctrl->inherits = inherits = ALLOC(dinherit, n);
407             sinherits = ALLOCA(sinherit, n);
408             sw_readv((char *) sinherits, ctrl->sectors,
409                      n * (Uint) sizeof(sinherit), size);
410             size += n * sizeof(sinherit);
411             do {
412                 inherits->oindex = sinherits->oindex;
413                 inherits->funcoffset = sinherits->funcoffset;
414                 inherits->varoffset = sinherits->varoffset & ~PRIV;
415                 (inherits++)->priv = (((sinherits++)->varoffset & PRIV) != 0);
416             } while (--n > 0);
417             AFREE(sinherits - UCHAR(header.ninherits));
418         }
419 
420         /* compile time */
421         ctrl->compiled = header.compiled;
422 
423         /* program */
424         ctrl->progoffset = size;
425         ctrl->progsize = header.progsize;
426         size += header.progsize;
427 
428         /* string constants */
429         ctrl->stroffset = size;
430         ctrl->nstrings = header.nstrings;
431         ctrl->strsize = header.strsize;
432         size += header.nstrings * (Uint) sizeof(dstrconst) + header.strsize;
433 
434         /* function definitions */
435         ctrl->funcdoffset = size;
436         ctrl->nfuncdefs = UCHAR(header.nfuncdefs);
437         size += UCHAR(header.nfuncdefs) * (Uint) sizeof(dfuncdef);
438 
439         /* variable definitions */
440         ctrl->vardoffset = size;
441         ctrl->nvardefs = UCHAR(header.nvardefs);
442         size += UCHAR(header.nvardefs) * (Uint) sizeof(dvardef);
443 
444         /* function call table */
445         ctrl->funccoffset = size;
446         ctrl->nfuncalls = header.nfuncalls;
447         size += header.nfuncalls * (Uint) 2;
448 
449         /* symbol table */
450         ctrl->symboffset = size;
451         ctrl->nsymbols = header.nsymbols;
452 
453         /* # variables */
454         ctrl->nvariables = header.nvariables;
455         ctrl->nifdefs = header.nifdefs;
456         ctrl->nvinit = header.nvinit;
457     }
458 
459     return ctrl;
460 }
461 
462 static void d_upgrade_clone P((dataspace*));
463 
464 /*
465  * NAME:        data->load_dataspace()
466  * DESCRIPTION: load the dataspace header block of an object from the swap
467  */
468 dataspace *d_load_dataspace(obj)
469 object *obj;
470 {
471     sdataspace header;
472     register dataspace *data;
473     register Uint size;
474 
475     data = d_alloc_dataspace(obj);
476     data->ctrl = o_control(obj);
477     data->ctrl->ndata++;
478 
479     /* header */
480     sw_readv((char *) &header, &obj->dfirst, (Uint) sizeof(sdataspace),
481              (Uint) 0);
482     data->nsectors = header.nsectors;
483     data->sectors = ALLOC(sector, header.nsectors);
484     data->sectors[0] = obj->dfirst;
485     size = header.nsectors * (Uint) sizeof(sector);
486     if (header.nsectors > 1) {
487         sw_readv((char *) data->sectors, data->sectors, size,
488                  (Uint) sizeof(sdataspace));
489     }
490     size += sizeof(sdataspace);
491 
492     data->flags = header.flags;
493 
494     /* variables */
495     data->varoffset = size;
496     data->nvariables = header.nvariables;
497     size += data->nvariables * (Uint) sizeof(svalue);
498 
499     /* arrays */
500     data->arroffset = size;
501     data->narrays = header.narrays;
502     data->eltsize = header.eltsize;
503     size += header.narrays * (Uint) sizeof(sarray) +
504             header.eltsize * sizeof(svalue);
505 
506     /* strings */
507     data->stroffset = size;
508     data->nstrings = header.nstrings;
509     data->strsize = header.strsize;
510     size += header.nstrings * sizeof(sstring) + header.strsize;
511 
512     /* callouts */
513     data->cooffset = size;
514     data->ncallouts = header.ncallouts;
515     data->fcallouts = header.fcallouts;
516 
517     if (!(obj->flags & O_MASTER) && obj->update != OBJ(obj->u_master)->update &&
518         obj->count != 0) {
519         d_upgrade_clone(data);
520     }
521 
522     return data;
523 }
524 
525 /*
526  * NAME:        data->ref_control()
527  * DESCRIPTION: reference control block
528  */
529 void d_ref_control(ctrl)
530 register control *ctrl;
531 {
532     if (ctrl != chead) {
533         /* move to head of list */
534         ctrl->prev->next = ctrl->next;
535         if (ctrl->next != (control *) NULL) {
536             ctrl->next->prev = ctrl->prev;
537         } else {
538             ctail = ctrl->prev;
539         }
540         ctrl->prev = (control *) NULL;
541         ctrl->next = chead;
542         chead->prev = ctrl;
543         chead = ctrl;
544     }
545 }
546 
547 /*
548  * NAME:        data->ref_dataspace()
549  * DESCRIPTION: reference data block
550  */
551 void d_ref_dataspace(data)
552 register dataspace *data;
553 {
554     if (data != dhead) {
555         /* move to head of list */
556         data->prev->next = data->next;
557         if (data->next != (dataspace *) NULL) {
558             data->next->prev = data->prev;
559         } else {
560             dtail = data->prev;
561         }
562         data->prev = (dataspace *) NULL;
563         data->next = dhead;
564         dhead->prev = data;
565         dhead = data;
566     }
567 }
568 
569 
570 /*
571  * NAME:        compress()
572  * DESCRIPTION: compress data
573  */
574 static Uint compress(data, text, size)
575 char *data, *text;
576 register Uint size;
577 {
578     char htab[16384];
579     register unsigned short buf, bufsize, x;
580     register char *p, *q;
581     register Uint cspace;
582 
583     if (size <= 4 + 1) {
584         /* can't get smaller than this */
585         return 0;
586     }
587 
588     /* clear the hash table */
589     memset(htab, '\0', sizeof(htab));
590 
591     buf = bufsize = 0;
592     x = 0;
593     p = text;
594     q = data;
595     *q++ = size >> 24;
596     *q++ = size >> 16;
597     *q++ = size >> 8;
598     *q++ = size;
599     cspace = size - 4;
600 
601     while (size != 0) {
602         if (htab[x] == *p) {
603             buf >>= 1;
604             bufsize += 1;
605         } else {
606             htab[x] = *p;
607             buf = (buf >> 9) + 0x0080 + (UCHAR(*p) << 8);
608             bufsize += 9;
609         }
610         x = ((x << 3) & 0x3fff) ^ UCHAR(strhashtab[UCHAR(*p++)]);
611 
612         if (bufsize >= 8) {
613             if (bufsize == 16) {
614                 if ((Int) (cspace-=2) <= 0) {
615                     return 0;   /* out of space */
616                 }
617                 *q++ = buf;
618                 *q++ = buf >> 8;
619                 bufsize = 0;
620             } else {
621                 if (--cspace == 0) {
622                     return 0;   /* out of space */
623                 }
624                 *q++ = buf >> (16 - bufsize);
625                 bufsize -= 8;
626             }
627         }
628 
629         --size;
630     }
631     if (bufsize != 0) {
632         if (--cspace == 0) {
633             return 0;   /* compression did not reduce size */
634         }
635         /* add last incomplete byte */
636         *q++ = (buf >> (16 - bufsize)) + (0xff << bufsize);
637     }
638 
639     return (long) q - (long) data;
640 }
641 
642 /*
643  * NAME:        decompress()
644  * DESCRIPTION: read and decompress data from the swap file
645  */
646 static char *decompress(sectors, readv, size, offset, dsize)
647 sector *sectors;
648 void (*readv) P((char*, sector*, Uint, Uint));
649 Uint size, offset;
650 Uint *dsize;
651 {
652     char buffer[8192], htab[16384];
653     register unsigned short buf, bufsize, x;
654     register Uint n;
655     register char *p, *q;
656 
657     buf = bufsize = 0;
658     x = 0;
659 
660     /* clear the hash table */
661     memset(htab, '\0', sizeof(htab));
662 
663     n = sizeof(buffer);
664     if (n > size) {
665         n = size;
666     }
667     (*readv)(p = buffer, sectors, n, offset);
668     size -= n;
669     offset += n;
670     *dsize = (UCHAR(p[0]) << 24) | (UCHAR(p[1]) << 16) | (UCHAR(p[2]) << 8) |
671              UCHAR(p[3]);
672     q = ALLOC(char, *dsize);
673     p += 4;
674     n -= 4;
675 
676     for (;;) {
677         for (;;) {
678             if (bufsize == 0) {
679                 if (n == 0) {
680                     break;
681                 }
682                 --n;
683                 buf = UCHAR(*p++);
684                 bufsize = 8;
685             }
686             if (buf & 1) {
687                 if (n == 0) {
688                     break;
689                 }
690                 --n;
691                 buf += UCHAR(*p++) << bufsize;
692 
693                 *q = htab[x] = buf >> 1;
694                 buf >>= 9;
695             } else {
696                 *q = htab[x];
697                 buf >>= 1;
698             }
699             --bufsize;
700 
701             x = ((x << 3) & 0x3fff) ^ UCHAR(strhashtab[UCHAR(*q++)]);
702         }
703 
704         if (size == 0) {
705             return q - *dsize;
706         }
707         n = sizeof(buffer);
708         if (n > size) {
709             n = size;
710         }
711         (*readv)(p = buffer, sectors, n, offset);
712         size -= n;
713         offset += n;
714     }
715 }
716 
717 
718 /*
719  * NAME:        data->varmap()
720  * DESCRIPTION: add a variable mapping to a control block
721  */
722 void d_varmap(ctrl, nvar, vmap)
723 register control *ctrl;
724 unsigned int nvar;
725 unsigned short *vmap;
726 {
727     ctrl->vmapsize = nvar;
728     ctrl->vmap = vmap;
729 
730     /* varmap modified */
731     ctrl->flags |= CTRL_VARMAP;
732 }
733 
734 /*
735  * NAME:        data->get_prog()
736  * DESCRIPTION: get the program
737  */
738 char *d_get_prog(ctrl)
739 register control *ctrl;
740 {
741     if (ctrl->prog == (char *) NULL && ctrl->progsize != 0) {
742         if (ctrl->flags & CTRL_PROGCMP) {
743             ctrl->prog = decompress(ctrl->sectors, sw_readv, ctrl->progsize,
744                                     ctrl->progoffset, &ctrl->progsize);
745         } else {
746             ctrl->prog = ALLOC(char, ctrl->progsize);
747             sw_readv(ctrl->prog, ctrl->sectors, ctrl->progsize,
748                      ctrl->progoffset);
749         }
750     }
751     return ctrl->prog;
752 }
753 
754 /*
755  * NAME:        d_get_stext()
756  * DESCRIPTION: load strings text
757  */
758 static void d_get_stext(ctrl)
759 register control *ctrl;
760 {
761     /* load strings text */
762     if (ctrl->flags & CTRL_STRCMP) {
763         ctrl->stext = decompress(ctrl->sectors, sw_readv,
764                                  ctrl->strsize,
765                                  ctrl->stroffset +
766                                  ctrl->nstrings * sizeof(dstrconst),
767                                  &ctrl->strsize);
768     } else {
769         ctrl->stext = ALLOC(char, ctrl->strsize);
770         sw_readv(ctrl->stext, ctrl->sectors, ctrl->strsize,
771                  ctrl->stroffset + ctrl->nstrings * (Uint) sizeof(dstrconst));
772     }
773 }
774 
775 /*
776  * NAME:        data->get_strconst()
777  * DESCRIPTION: get a string constant
778  */
779 string *d_get_strconst(ctrl, inherit, idx)
780 register control *ctrl;
781 register int inherit;
782 unsigned int idx;
783 {
784     if (UCHAR(inherit) < ctrl->ninherits - 1) {
785         /* get the proper control block */
786         ctrl = o_control(OBJR(ctrl->inherits[UCHAR(inherit)].oindex));
787     }
788 
789     if (ctrl->strings == (string **) NULL) {
790         /* make string pointer block */
791         ctrl->strings = ALLOC(string*, ctrl->nstrings);
792         memset(ctrl->strings, '\0', ctrl->nstrings * sizeof(string *));
793 
794         if (ctrl->sstrings == (dstrconst *) NULL) {
795             /* load strings */
796             ctrl->sstrings = ALLOC(dstrconst, ctrl->nstrings);
797             sw_readv((char *) ctrl->sstrings, ctrl->sectors,
798                      ctrl->nstrings * (Uint) sizeof(dstrconst),
799                      ctrl->stroffset);
800             if (ctrl->strsize > 0 && ctrl->stext == (char *) NULL) {
801                 d_get_stext(ctrl);      /* load strings text */
802             }
803         }
804     }
805 
806     if (ctrl->strings[idx] == (string *) NULL) {
807         register string *str;
808 
809         str = str_alloc(ctrl->stext + ctrl->sstrings[idx].index,
810                         (long) ctrl->sstrings[idx].len);
811         str_ref(ctrl->strings[idx] = str);
812     }
813 
814     return ctrl->strings[idx];
815 }
816 
817 /*
818  * NAME:        data->get_funcdefs()
819  * DESCRIPTION: get function definitions
820  */
821 dfuncdef *d_get_funcdefs(ctrl)
822 register control *ctrl;
823 {
824     if (ctrl->funcdefs == (dfuncdef *) NULL && ctrl->nfuncdefs != 0) {
825         ctrl->funcdefs = ALLOC(dfuncdef, ctrl->nfuncdefs);
826         sw_readv((char *) ctrl->funcdefs, ctrl->sectors,
827                  ctrl->nfuncdefs * (Uint) sizeof(dfuncdef), ctrl->funcdoffset);
828     }
829     return ctrl->funcdefs;
830 }
831 
832 /*
833  * NAME:        data->get_vardefs()
834  * DESCRIPTION: get variable definitions
835  */
836 dvardef *d_get_vardefs(ctrl)
837 register control *ctrl;
838 {
839     if (ctrl->vardefs == (dvardef *) NULL && ctrl->nvardefs != 0) {
840         ctrl->vardefs = ALLOC(dvardef, ctrl->nvardefs);
841         sw_readv((char *) ctrl->vardefs, ctrl->sectors,
842                  ctrl->nvardefs * (Uint) sizeof(dvardef), ctrl->vardoffset);
843     }
844     return ctrl->vardefs;
845 }
846 
847 /*
848  * NAME:        data->get_funcalls()
849  * DESCRIPTION: get function call table
850  */
851 char *d_get_funcalls(ctrl)
852 register control *ctrl;
853 {
854     if (ctrl->funcalls == (char *) NULL && ctrl->nfuncalls != 0) {
855         ctrl->funcalls = ALLOC(char, 2L * ctrl->nfuncalls);
856         sw_readv((char *) ctrl->funcalls, ctrl->sectors,
857                  ctrl->nfuncalls * (Uint) 2, ctrl->funccoffset);
858     }
859     return ctrl->funcalls;
860 }
861 
862 /*
863  * NAME:        data->get_symbols()
864  * DESCRIPTION: get symbol table
865  */
866 dsymbol *d_get_symbols(ctrl)
867 register control *ctrl;
868 {
869     if (ctrl->symbols == (dsymbol *) NULL && ctrl->nsymbols > 0) {
870         ctrl->symbols = ALLOC(dsymbol, ctrl->nsymbols);
871         sw_readv((char *) ctrl->symbols, ctrl->sectors,
872                  ctrl->nsymbols * (Uint) sizeof(dsymbol), ctrl->symboffset);
873     }
874     return ctrl->symbols;
875 }
876 
877 /*
878  * NAME:        data->get_progsize()
879  * DESCRIPTION: get the size of a control block
880  */
881 Uint d_get_progsize(ctrl)
882 register control *ctrl;
883 {
884     if (ctrl->progsize != 0 && ctrl->prog == (char *) NULL &&
885         (ctrl->flags & CTRL_PROGCMP)) {
886         d_get_prog(ctrl);       /* decompress program */
887     }
888     if (ctrl->strsize != 0 && ctrl->stext == (char *) NULL &&
889         (ctrl->flags & CTRL_STRCMP)) {
890         d_get_stext(ctrl);      /* decompress strings */
891     }
892 
893     return ctrl->ninherits * sizeof(dinherit) +
894            ctrl->progsize +
895            ctrl->nstrings * (Uint) sizeof(dstrconst) +
896            ctrl->strsize +
897            ctrl->nfuncdefs * sizeof(dfuncdef) +
898            ctrl->nvardefs * sizeof(dvardef) +
899            ctrl->nfuncalls * (Uint) 2 +
900            ctrl->nsymbols * (Uint) sizeof(dsymbol);
901 }
902 
903 
904 /*
905  * NAME:        data->get_string()
906  * DESCRIPTION: get a string from the dataspace
907  */
908 static string *d_get_string(data, idx)
909 register dataspace *data;
910 register Uint idx;
911 {
912     if (data->plane->strings == (strref *) NULL ||
913         data->plane->strings[idx].str == (string *) NULL) {
914         register string *str;
915         register strref *s;
916         register dataplane *p;
917         register Uint i;
918 
919         if (data->sstrings == (sstring *) NULL) {
920             /* load strings */
921             data->sstrings = ALLOC(sstring, data->nstrings);
922             sw_readv((char *) data->sstrings, data->sectors,
923                      data->nstrings * sizeof(sstring), data->stroffset);
924             if (data->strsize > 0) {
925                 /* load strings text */
926                 if (data->flags & DATA_STRCMP) {
927                     data->stext = decompress(data->sectors, sw_readv,
928                                              data->strsize,
929                                              data->stroffset +
930                                                data->nstrings * sizeof(sstring),
931                                              &data->strsize);
932                 } else {
933                     data->stext = ALLOC(char, data->strsize);
934                     sw_readv(data->stext, data->sectors, data->strsize,
935                              data->stroffset +
936                                             data->nstrings * sizeof(sstring));
937                 }
938             }
939         }
940 
941         str = str_alloc(data->stext + data->sstrings[idx].index,
942                         (long) data->sstrings[idx].len);
943         str->ref = 0;
944         p = data->plane;
945 
946         do {
947             if (p->strings == (strref *) NULL) {
948                 /* initialize string pointers */
949                 s = p->strings = ALLOC(strref, data->nstrings);
950                 for (i = data->nstrings; i > 0; --i) {
951                     (s++)->str = (string *) NULL;
952                 }
953             }
954             s = &p->strings[idx];
955             str_ref(s->str = str);
956             s->data = data;
957             s->ref = data->sstrings[idx].ref;
958             p = p->prev;
959         } while (p != (dataplane *) NULL);
960 
961         str->primary = &data->plane->strings[idx];
962         return str;
963     }
964     return data->plane->strings[idx].str;
965 }
966 
967 /*
968  * NAME:        data->get_array()
969  * DESCRIPTION: get an array from the dataspace
970  */
971 static array *d_get_array(data, idx)
972 register dataspace *data;
973 register Uint idx;
974 {
975     if (data->plane->arrays == (arrref *) NULL ||
976         data->plane->arrays[idx].arr == (array *) NULL) {
977         register array *arr;
978         register arrref *a;
979         register dataplane *p;
980         register Uint i;
981 
982         if (data->sarrays == (sarray *) NULL) {
983             /* load arrays */
984             data->sarrays = ALLOC(sarray, data->narrays);
985             sw_readv((char *) data->sarrays, data->sectors,
986                      data->narrays * (Uint) sizeof(sarray), data->arroffset);
987         }
988 
989         arr = arr_alloc(data->sarrays[idx].size);
990         arr->ref = 0;
991         arr->tag = data->sarrays[idx].tag;
992         p = data->plane;
993 
994         do {
995             if (p->arrays == (arrref *) NULL) {
996                 /* create array pointers */
997                 a = p->arrays = ALLOC(arrref, data->narrays);
998                 for (i = data->narrays; i > 0; --i) {
999                     (a++)->arr = (array *) NULL;
1000                 }
1001             }
1002             a = &p->arrays[idx];
1003             arr_ref(a->arr = arr);
1004             a->plane = &data->base;
1005             a->data = data;
1006             a->state = AR_UNCHANGED;
1007             a->ref = data->sarrays[idx].ref;
1008             p = p->prev;
1009         } while (p != (dataplane *) NULL);
1010 
1011         arr->primary = &data->plane->arrays[idx];
1012         return arr;
1013     }
1014     return data->plane->arrays[idx].arr;
1015 }
1016 
1017 /*
1018  * NAME:        data->get_values()
1019  * DESCRIPTION: get values from the dataspace
1020  */
1021 static void d_get_values(data, sv, v, n)
1022 register dataspace *data;
1023 register svalue *sv;
1024 register value *v;
1025 register int n;
1026 {
1027     while (n > 0) {
1028         v->modified = FALSE;
1029         switch (v->type = sv->type) {
1030         case T_NIL:
1031             v->u.number = 0;
1032             break;
1033 
1034         case T_INT:
1035             v->u.number = sv->u.number;
1036             break;
1037 
1038         case T_STRING:
1039             str_ref(v->u.string = d_get_string(data, sv->u.string));
1040             break;
1041 
1042         case T_FLOAT:
1043         case T_OBJECT:
1044             v->oindex = sv->oindex;
1045             v->u.objcnt = sv->u.objcnt;
1046             break;
1047 
1048         case T_ARRAY:
1049         case T_MAPPING:
1050             arr_ref(v->u.array = d_get_array(data, sv->u.array));
1051             break;
1052         }
1053         sv++;
1054         v++;
1055         --n;
1056     }
1057 }
1058 
1059 /*
1060  * NAME:        data->new_variables()
1061  * DESCRIPTION: initialize variables in a dataspace block
1062  */
1063 static void d_new_variables(data)
1064 dataspace *data;
1065 {
1066     register unsigned short nifdefs, nvars, nvinit;
1067     register value *val;
1068     register dvardef *var;
1069     register control *ctrl;
1070     register dinherit *inh;
1071 
1072     /*
1073      * first, initialize all variables to nil
1074      */
1075     for (val = data->variables, nvars = data->nvariables; nvars > 0; --nvars) {
1076         *val++ = nil_value;
1077     }
1078 
1079     if (data->ctrl->nvinit != 0) {
1080         /*
1081          * explicitly initialize some variables
1082          */
1083         nvars = 0;
1084         for (nvinit = data->ctrl->nvinit, inh = data->ctrl->inherits;
1085              nvinit > 0; inh++) {
1086             if (inh->varoffset == nvars) {
1087                 ctrl = o_control(OBJR(inh->oindex));
1088                 if (ctrl->nifdefs != 0) {
1089                     nvinit -= ctrl->nifdefs;
1090                     for (nifdefs = ctrl->nifdefs, var = d_get_vardefs(ctrl);
1091                          nifdefs > 0; var++) {
1092                         if (var->type == T_INT && nilisnot0) {
1093                             data->variables[nvars] = zero_int;
1094                             --nifdefs;
1095                         } else if (var->type == T_FLOAT) {
1096                             data->variables[nvars] = zero_float;
1097                             --nifdefs;
1098                         }
1099                         nvars++;
1100                     }
1101                 }
1102                 nvars = inh->varoffset + ctrl->nvardefs;
1103             }
1104         }
1105     }
1106 }
1107 
1108 /*
1109  * NAME:        data->get_variable()
1110  * DESCRIPTION: get a variable from the dataspace
1111  */
1112 value *d_get_variable(data, idx)
1113 register dataspace *data;
1114 register unsigned int idx;
1115 {
1116     if (data->variables == (value *) NULL) {
1117         /* create room for variables */
1118         data->variables = ALLOC(value, data->nvariables);
1119         if (data->nsectors == 0 && data->svariables == (svalue *) NULL) {
1120             /* new datablock */
1121             d_new_variables(data);
1122         } else {
1123             /*
1124              * variables must be loaded from the swap
1125              */
1126             if (data->svariables == (svalue *) NULL) {
1127                 /* load svalues */
1128                 data->svariables = ALLOC(svalue, data->nvariables);
1129                 sw_readv((char *) data->svariables, data->sectors,
1130                          data->nvariables * (Uint) sizeof(svalue),
1131                          data->varoffset);
1132             }
1133             d_get_values(data, data->svariables, data->variables,
1134                          data->nvariables);
1135         }
1136     }
1137 
1138     return &data->variables[idx];
1139 }
1140 
1141 /*
1142  * NAME:        data->get_elts()
1143  * DESCRIPTION: get the elements of an array
1144  */
1145 value *d_get_elts(arr)
1146 register array *arr;
1147 {
1148     register value *v;
1149 
1150     v = arr->elts;
1151     if (v == (value *) NULL && arr->size != 0) {
1152         register dataspace *data;
1153         Uint idx;
1154 
1155         data = arr->primary->data;
1156         if (data->selts == (svalue *) NULL) {
1157             /* load array elements */
1158             data->selts = (svalue *) ALLOC(svalue, data->eltsize);
1159             sw_readv((char *) data->selts, data->sectors,
1160                      data->eltsize * sizeof(svalue),
1161                      data->arroffset + data->narrays * sizeof(sarray));
1162         }
1163         v = arr->elts = ALLOC(value, arr->size);
1164         idx = data->sarrays[arr->primary - data->plane->arrays].index;
1165         d_get_values(data, &data->selts[idx], v, arr->size);
1166     }
1167 
1168     return v;
1169 }
1170 
1171 
1172 static dataspace *ifirst;       /* list of dataspaces with imports */
1173 
1174 /*
1175  * NAME:        ref_rhs()
1176  * DESCRIPTION: reference the right-hand side in an assignment
1177  */
1178 static void ref_rhs(data, rhs)
1179 register dataspace *data;
1180 register value *rhs;
1181 {
1182     register string *str;
1183     register array *arr;
1184 
1185     switch (rhs->type) {
1186     case T_STRING:
1187         str = rhs->u.string;
1188         if (str->primary != (strref *) NULL && str->primary->data == data) {
1189             /* in this object */
1190             str->primary->ref++;
1191             data->plane->flags |= MOD_STRINGREF;
1192         } else {
1193             /* not in this object: ref imported string */
1194             data->plane->schange++;
1195         }
1196         break;
1197 
1198     case T_ARRAY:
1199     case T_MAPPING:
1200         arr = rhs->u.array;
1201         if (arr->primary->data == data) {
1202             /* in this object */
1203             if (arr->primary->arr != (array *) NULL) {
1204                 /* swapped in */
1205                 arr->primary->ref++;
1206                 data->plane->flags |= MOD_ARRAYREF;
1207             } else {
1208                 /* ref new array */
1209                 data->plane->achange++;
1210             }
1211         } else {
1212             /* not in this object: ref imported array */
1213             if (data->plane->imports++ == 0 && ifirst != data &&
1214                 data->iprev == (dataspace *) NULL) {
1215                 /* add to imports list */
1216                 data->iprev = (dataspace *) NULL;
1217                 data->inext = ifirst;
1218                 if (ifirst != (dataspace *) NULL) {
1219                     ifirst->iprev = data;
1220                 }
1221                 ifirst = data;
1222             }
1223             data->plane->achange++;
1224         }
1225         break;
1226     }
1227 }
1228 
1229 /*
1230  * NAME:        del_lhs()
1231  * DESCRIPTION: delete the left-hand side in an assignment
1232  */
1233 static void del_lhs(data, lhs)
1234 register dataspace *data;
1235 register value *lhs;
1236 {
1237     register string *str;
1238     register array *arr;
1239 
1240     switch (lhs->type) {
1241     case T_STRING:
1242         str = lhs->u.string;
1243         if (str->primary != (strref *) NULL && str->primary->data == data) {
1244             /* in this object */
1245             if (--(str->primary->ref) == 0) {
1246                 str->primary->str = (string *) NULL;
1247                 str->primary = (strref *) NULL;
1248                 str_del(str);
1249                 data->plane->schange++; /* last reference removed */
1250             }
1251             data->plane->flags |= MOD_STRINGREF;
1252         } else {
1253             /* not in this object: deref imported string */
1254             data->plane->schange--;
1255         }
1256         break;
1257 
1258     case T_ARRAY:
1259     case T_MAPPING:
1260         arr = lhs->u.array;
1261         if (arr->primary->data == data) {
1262             /* in this object */
1263             if (arr->primary->arr != (array *) NULL) {
1264                 /* swapped in */
1265                 data->plane->flags |= MOD_ARRAYREF;
1266                 if ((--(arr->primary->ref) & ~ARR_MOD) == 0) {
1267                     register unsigned short n;
1268 
1269                     /* last reference removed */
1270                     if (arr->hashed != (struct _maphash_ *) NULL) {
1271                         map_compact(data, arr);
1272                     } else {
1273                         d_get_elts(arr);
1274                     }
1275                     arr->primary->arr = (array *) NULL;
1276                     arr->primary = &arr->primary->plane->alocal;
1277 
1278                     for (n = arr->size, lhs = arr->elts; n != 0; --n, lhs++) {
1279                         del_lhs(data, lhs);
1280                     }
1281 
1282                     arr_del(arr);
1283                     data->plane->achange++;
1284                 }
1285             } else {
1286                 /* deref new array */
1287                 data->plane->achange--;
1288             }
1289         } else {
1290             /* not in this object: deref imported array */
1291             data->plane->imports--;
1292             data->plane->achange--;
1293         }
1294         break;
1295     }
1296 }
1297 
1298 
1299 /*
1300  * NAME:        data->get_callouts()
1301  * DESCRIPTION: load callouts from swap
1302  */
1303 static void d_get_callouts(data)
1304 register dataspace *data;
1305 {
1306     scallout *scallouts;
1307     register scallout *sco;
1308     register dcallout *co;
1309     register uindex n;
1310 
1311     co = data->callouts = ALLOC(dcallout, data->ncallouts);
1312     sco = scallouts = ALLOCA(scallout, data->ncallouts);
1313     sw_readv((char *) scallouts, data->sectors,
1314              data->ncallouts * (Uint) sizeof(scallout), data->cooffset);
1315 
1316     for (n = data->ncallouts; n > 0; --n) {
1317         co->time = sco->time;
1318         co->nargs = sco->nargs;
1319         if (sco->val[0].type == T_STRING) {
1320             d_get_values(data, sco->val, co->val,
1321                          (sco->nargs > 3) ? 4 : sco->nargs + 1);
1322         } else {
1323             co->val[0] = nil_value;
1324         }
1325         sco++;
1326         co++;
1327     }
1328 
1329     AFREE(scallouts);
1330 }
1331 
1332 /*
1333  * NAME:        data->alloc_call_out()
1334  * DESCRIPTION: allocate a new callout
1335  */
1336 static uindex d_alloc_call_out(data, handle, time, nargs, v)
1337 register dataspace *data;
1338 register uindex handle;
1339 Uint time;
1340 int nargs;
1341 register value *v;
1342 {
1343     register dcallout *co;
1344 
1345     if (data->ncallouts == 0) {
1346         /*
1347          * the first in this object
1348          */
1349         co = data->callouts = ALLOC(dcallout, 1);
1350         data->ncallouts = handle = 1;
1351         data->plane->flags |= MOD_NEWCALLOUT;
1352     } else {
1353         if (data->callouts == (dcallout *) NULL) {
1354             d_get_callouts(data);
1355         }
1356         if (handle != 0) {
1357             /*
1358              * get a specific callout from the free list
1359              */
1360             co = &data->callouts[handle - 1];
1361             if (handle == data->fcallouts) {
1362                 data->fcallouts = co->co_next;
1363             } else {
1364                 data->callouts[co->co_prev - 1].co_next = co->co_next;
1365                 if (co->co_next != 0) {
1366                     data->callouts[co->co_next - 1].co_prev = co->co_prev;
1367                 }
1368             }
1369         } else {
1370             handle = data->fcallouts;
1371             if (handle != 0) {
1372                 /*
1373                  * from free list
1374                  */
1375                 co = &data->callouts[handle - 1];
1376                 if (co->co_next == 0 || co->co_next > handle) {
1377                     /* take 1st free callout */
1378                     data->fcallouts = co->co_next;
1379                 } else {
1380                     /* take 2nd free callout */
1381                     co = &data->callouts[co->co_next - 1];
1382                     data->callouts[handle - 1].co_next = co->co_next;
1383                     if (co->co_next != 0) {
1384                         data->callouts[co->co_next - 1].co_prev = handle;
1385                     }
1386                     handle = co - data->callouts + 1;
1387                 }
1388                 data->plane->flags |= MOD_CALLOUT;
1389             } else {
1390                 /*
1391                  * add new callout
1392                  */
1393                 handle = data->ncallouts;
1394                 co = data->callouts = REALLOC(data->callouts, dcallout, handle,
1395                                               handle + 1);
1396                 co += handle;
1397                 data->ncallouts = ++handle;
1398                 data->plane->flags |= MOD_NEWCALLOUT;
1399             }
1400         }
1401     }
1402 
1403     co->time = time;
1404     co->nargs = nargs;
1405     memcpy(co->val, v, sizeof(co->val));
1406     switch (nargs) {
1407     default:
1408         ref_rhs(data, &v[3]);
1409     case 2:
1410         ref_rhs(data, &v[2]);
1411     case 1:
1412         ref_rhs(data, &v[1]);
1413     case 0:
1414         ref_rhs(data, &v[0]);
1415         break;
1416     }
1417 
1418     return handle;
1419 }
1420 
1421 /*
1422  * NAME:        data->free_call_out()
1423  * DESCRIPTION: free a callout
1424  */
1425 static void d_free_call_out(data, handle)
1426 register dataspace *data;
1427 unsigned int handle;
1428 {
1429     register dcallout *co;
1430     register value *v;
1431     uindex n;
1432 
1433     co = &data->callouts[handle - 1];
1434     v = co->val;
1435     switch (co->nargs) {
1436     default:
1437         del_lhs(data, &v[3]);
1438         i_del_value(&v[3]);
1439     case 2:
1440         del_lhs(data, &v[2]);
1441         i_del_value(&v[2]);
1442     case 1:
1443         del_lhs(data, &v[1]);
1444         i_del_value(&v[1]);
1445     case 0:
1446         del_lhs(data, &v[0]);
1447         str_del(v[0].u.string);
1448         break;
1449     }
1450     v[0] = nil_value;
1451 
1452     n = data->fcallouts;
1453     if (n != 0) {
1454         data->callouts[n - 1].co_prev = handle;
1455     }
1456     co->co_next = n;
1457     data->fcallouts = handle;
1458 
1459     data->plane->flags |= MOD_CALLOUT;
1460 }
1461 
1462 
1463 /*
1464  * NAME:        copatch->init()
1465  * DESCRIPTION: initialize copatch table
1466  */
1467 static void cop_init(plane)
1468 dataplane *plane;
1469 {
1470     memset(plane->coptab = ALLOC(coptable, 1), '\0', sizeof(coptable));
1471 }
1472 
1473 /*
1474  * NAME:        copatch->clean()
1475  * DESCRIPTION: free copatch table
1476  */
1477 static void cop_clean(plane)
1478 dataplane *plane;
1479 {
1480     register copchunk *c, *f;
1481 
1482     c = plane->coptab->chunk;
1483     while (c != (copchunk *) NULL) {
1484         f = c;
1485         c = c->next;
1486         FREE(f);
1487     }
1488 
1489     FREE(plane->coptab);
1490     plane->coptab = (coptable *) NULL;
1491 }
1492 
1493 /*
1494  * NAME:        copatch->new()
1495  * DESCRIPTION: create a new callout patch
1496  */
1497 static copatch *cop_new(plane, c, type, handle, co, time, mtime, q)
1498 dataplane *plane;
1499 copatch **c;
1500 int type;
1501 unsigned int handle, mtime;
1502 register dcallout *co;
1503 Uint time;
1504 cbuf *q;
1505 {
1506     register coptable *tab;
1507     register copatch *cop;
1508     register int i;
1509     register value *v;
1510 
1511     /* allocate */
1512     tab = plane->coptab;
1513     if (tab->flist != (copatch *) NULL) {
1514         /* from free list */
1515         cop = tab->flist;
1516         tab->flist = cop->next;
1517     } else {
1518         /* newly allocated */
1519         if (tab->chunk == (copchunk *) NULL || tab->chunksz == COPCHUNKSZ) {
1520             register copchunk *cc;
1521 
1522             /* create new chunk */
1523             cc = ALLOC(copchunk, 1);
1524             cc->next = tab->chunk;
1525             tab->chunk = cc;
1526             tab->chunksz = 0;
1527         }
1528 
1529         cop = &tab->chunk->cop[tab->chunksz++];
1530     }
1531 
1532     /* initialize */
1533     cop->type = type;
1534     cop->handle = handle;
1535     if (type == COP_ADD) {
1536         cop->aco = *co;
1537     } else {
1538         cop->rco = *co;
1539     }
1540     for (i = (co->nargs > 3) ? 4 : co->nargs + 1, v = co->val; i > 0; --i) {
1541         i_ref_value(v++);
1542     }
1543     cop->time = time;
1544     cop->mtime = mtime;
1545     cop->plane = plane;
1546     cop->queue = q;
1547 
1548     /* add to hash table */
1549     cop->next = *c;
1550     return *c = cop;
1551 }
1552 
1553 /*
1554  * NAME:        copatch->del()
1555  * DESCRIPTION: delete a callout patch
1556  */
1557 static void cop_del(plane, c, del)
1558 dataplane *plane;
1559 copatch **c;
1560 bool del;
1561 {
1562     register copatch *cop;
1563     register dcallout *co;
1564     register int i;
1565     register value *v;
1566     coptable *tab;
1567 
1568     /* remove from hash table */
1569     cop = *c;
1570     *c = cop->next;
1571 
1572     if (del) {
1573         /* free referenced callout */
1574         co = (cop->type == COP_ADD) ? &cop->aco : &cop->rco;
1575         v = co->val;
1576         for (i = (co->nargs > 3) ? 4 : co->nargs + 1; i > 0; --i) {
1577             i_del_value(v++);
1578         }
1579     }
1580 
1581     /* add to free list */
1582     tab = plane->coptab;
1583     cop->next = tab->flist;
1584     tab->flist = cop;
1585 }
1586 
1587 /*
1588  * NAME:        copatch->replace()
1589  * DESCRIPTION: replace one callout patch with another
1590  */
1591 static void cop_replace(cop, co, time, mtime, q)
1592 register copatch *cop;
1593 register dcallout *co;
1594 Uint time;
1595 unsigned int mtime;
1596 cbuf *q;
1597 {
1598     register int i;
1599     register value *v;
1600 
1601     cop->type = COP_REPLACE;
1602     cop->aco = *co;
1603     for (i = (co->nargs > 3) ? 4 : co->nargs + 1, v = co->val; i > 0; --i) {
1604         i_ref_value(v++);
1605     }
1606     cop->time = time;
1607     cop->mtime = mtime;
1608     cop->queue = q;
1609 }
1610 
1611 /*
1612  * NAME:        copatch->commit()
1613  * DESCRIPTION: commit a callout replacement
1614  */
1615 static void cop_commit(cop)
1616 register copatch *cop;
1617 {
1618     register int i;
1619     register value *v;
1620 
1621     cop->type = COP_ADD;
1622     for (i = (cop->rco.nargs > 3) ? 4 : cop->rco.nargs + 1, v = cop->rco.val;
1623          i > 0; --i) {
1624         i_del_value(v++);
1625     }
1626 }
1627 
1628 /*
1629  * NAME:        copatch->release()
1630  * DESCRIPTION: remove a callout replacement
1631  */
1632 static void cop_release(cop)
1633 register copatch *cop;
1634 {
1635     register int i;
1636     register value *v;
1637 
1638     cop->type = COP_REMOVE;
1639     for (i = (cop->aco.nargs > 3) ? 4 : cop->aco.nargs + 1, v = cop->aco.val;
1640          i > 0; --i) {
1641         i_del_value(v++);
1642     }
1643 }
1644 
1645 /*
1646  * NAME:        copatch->discard()
1647  * DESCRIPTION: discard replacement
1648  */
1649 static void cop_discard(cop)
1650 copatch *cop;
1651 {
1652     /* force unref of proper component later */
1653     cop->type = COP_ADD;
1654 }
1655 
1656 
1657 /*
1658  * NAME:        data->new_plane()
1659  * DESCRIPTION: create a new dataplane
1660  */
1661 void d_new_plane(data, level)
1662 register dataspace *data;
1663 Int level;
1664 {
1665     register dataplane *p;
1666     register Uint i;
1667 
1668     p = ALLOC(dataplane, 1);
1669 
1670     p->level = level;
1671     p->flags = data->plane->flags;
1672     p->schange = data->plane->schange;
1673     p->achange = data->plane->achange;
1674     p->imports = data->plane->imports;
1675 
1676     /* copy value information from previous plane */
1677     p->original = (value *) NULL;
1678     p->alocal.arr = (array *) NULL;
1679     p->alocal.plane = p;
1680     p->alocal.data = data;
1681     p->alocal.state = AR_CHANGED;
1682     p->coptab = data->plane->coptab;
1683 
1684     if (data->plane->arrays != (arrref *) NULL) {
1685         register arrref *a, *b;
1686 
1687         p->arrays = ALLOC(arrref, i = data->narrays);
1688         for (a = p->arrays, b = data->plane->arrays; i != 0; a++, b++, --i) {
1689             if (b->arr != (array *) NULL) {
1690                 *a = *b;
1691                 a->arr->primary = a;
1692                 arr_ref(a->arr);
1693             } else {
1694                 a->arr = (array *) NULL;
1695             }
1696         }
1697     } else {
1698         p->arrays = (arrref *) NULL;
1699     }
1700     p->achunk = (abchunk *) NULL;
1701 
1702     if (data->plane->strings != (strref *) NULL) {
1703         register strref *s, *t;
1704 
1705         p->strings = ALLOC(strref, i = data->nstrings);
1706         for (s = p->strings, t = data->plane->strings; i != 0; s++, t++, --i) {
1707             if (t->str != (string *) NULL) {
1708                 *s = *t;
1709                 s->str->primary = s;
1710                 str_ref(s->str);
1711             } else {
1712                 s->str = (string *) NULL;
1713             }
1714         }
1715     } else {
1716         p->strings = (strref *) NULL;
1717     }
1718 
1719     p->prev = data->plane;
1720     data->plane = p;
1721     p->plist = plist;
1722     plist = p;
1723 }
1724 
1725 /*
1726  * NAME:        commit_values()
1727  * DESCRIPTION: commit non-swapped arrays among the values
1728  */
1729 static void commit_values(v, n, level)
1730 register value *v;
1731 register unsigned int n;
1732 register Int level;
1733 {
1734     register array *arr;
1735 
1736     while (n != 0) {
1737         if (T_INDEXED(v->type)) {
1738             arr = v->u.array;
1739             if (arr->primary->arr == (array *) NULL &&
1740                 arr->primary->plane->level > level) {
1741                 if (arr->hashed != (struct _maphash_ *) NULL) {
1742                     map_compact(arr->primary->data, arr);
1743                 }
1744                 arr->primary = &arr->primary->plane->prev->alocal;
1745                 commit_values(arr->elts, arr->size, level);
1746             }
1747 
1748         }
1749         v++;
1750         --n;
1751     }
1752 }
1753 
1754 /*
1755  * NAME:        commit_callouts()
1756  * DESCRIPTION: commit callout patches to previous plane
1757  */
1758 static void commit_callouts(plane, merge)
1759 register dataplane *plane;
1760 bool merge;
1761 {
1762     register dataplane *prev;
1763     register copatch **c, **n, *cop;
1764     copatch **t, **next;
1765     int i;
1766 
1767     prev = plane->prev;
1768     for (i = COPATCHHTABSZ, t = plane->coptab->cop; --i >= 0; t++) {
1769         if (*t != (copatch *) NULL && (*t)->plane == plane) {
1770             /*
1771              * find previous plane in hash chain
1772              */
1773             next = t;
1774             do {
1775                 next = &(*next)->next;
1776             } while (*next != (copatch *) NULL && (*next)->plane == plane);
1777 
1778             c = t;
1779             do {
1780                 cop = *c;
1781                 if (cop->type != COP_REMOVE) {
1782                     commit_values(cop->aco.val + 1,
1783                                   (cop->aco.nargs > 3) ? 3 : cop->aco.nargs,
1784                                   prev->level);
1785                 }
1786 
1787                 if (prev->level == 0) {
1788                     /*
1789                      * commit to last plane
1790                      */
1791                     switch (cop->type) {
1792                     case COP_ADD:
1793                         co_new(plane->alocal.data->oindex, cop->handle,
1794                                cop->time, cop->mtime, cop->queue);
1795                         --ncallout;
1796                         break;
1797 
1798                     case COP_REMOVE:
1799                         co_del(plane->alocal.data->oindex, cop->handle,
1800                                cop->rco.time);
1801                         ncallout++;
1802                         break;
1803 
1804                     case COP_REPLACE:
1805                         co_del(plane->alocal.data->oindex, cop->handle,
1806                                cop->rco.time);
1807                         co_new(plane->alocal.data->oindex, cop->handle,
1808                                cop->time, cop->mtime, cop->queue);
1809                         cop_commit(cop);
1810                         break;
1811                     }
1812 
1813                     if (next == &cop->next) {
1814                         next = c;
1815                     }
1816                     cop_del(plane, c, TRUE);
1817                 } else {
1818                     /*
1819                      * commit to previous plane
1820                      */
1821                     cop->plane = prev;
1822                     if (merge) {
1823                         for (n = next;
1824                              *n != (copatch *) NULL && (*n)->plane == prev;
1825                              n = &(*n)->next) {
1826                             if (cop->handle == (*n)->handle) {
1827                                 switch (cop->type) {
1828                                 case COP_ADD:
1829                                     /* turn old remove into replace, del new */
1830                                     cop_replace(*n, &cop->aco, cop->time,
1831                                                 cop->mtime, cop->queue);
1832                                     if (next == &cop->next) {
1833                                         next = c;
1834                                     }
1835                                     cop_del(prev, c, TRUE);
1836                                     break;
1837 
1838                                 case COP_REMOVE:
1839                                     if ((*n)->type == COP_REPLACE) {
1840                                         /* turn replace back into remove */
1841                                         cop_release(*n);
1842                                     } else {
1843                                         /* del old */
1844                                         cop_del(prev, n, TRUE);
1845                                     }
1846                                     /* del new */
1847                                     if (next == &cop->next) {
1848                                         next = c;
1849                                     }
1850                                     cop_del(prev, c, TRUE);
1851                                     break;
1852 
1853                                 case COP_REPLACE:
1854                                     if ((*n)->type == COP_REPLACE) {
1855                                         /* merge replaces into old, del new */
1856                                         cop_release(*n);
1857                                         cop_replace(*n, &cop->aco, cop->time,
1858                                                     cop->mtime, cop->queue);
1859                                         if (next == &cop->next) {
1860                                             next = c;
1861                                         }
1862                                         cop_del(prev, c, TRUE);
1863                                     } else {
1864                                         /* make replace into add, remove old */
1865                                         cop_del(prev, n, TRUE);
1866                                         cop_commit(cop);
1867                                     }
1868                                     break;
1869                                 }
1870                                 break;
1871                             }
1872                         }
1873                     }
1874 
1875                     if (*c == cop) {
1876                         c = &cop->next;
1877                     }
1878                 }
1879             } while (c != next);
1880         }
1881     }
1882 }
1883 
1884 /*
1885  * NAME:        data->commit_plane()
1886  * DESCRIPTION: commit the current data plane
1887  */
1888 void d_commit_plane(level, retval)
1889 Int level;
1890 value *retval;
1891 {
1892     register dataplane *p, *commit, **r, **cr;
1893     register dataspace *data;
1894     register value *v;
1895     register Uint i;
1896     dataplane *clist;
1897 
1898     /*
1899      * pass 1: construct commit planes
1900      */
1901     clist = (dataplane *) NULL;
1902     cr = &clist;
1903     for (r = &plist, p = *r; p != (dataplane *) NULL && p->level == level;
1904          r = &p->plist, p = *r) {
1905         if (p->prev->level != level - 1) {
1906             /* insert commit plane */
1907             commit = ALLOC(dataplane, 1);
1908             commit->level = level - 1;
1909             commit->original = (value *) NULL;
1910             commit->alocal.arr = (array *) NULL;
1911             commit->alocal.plane = commit;
1912             commit->alocal.data = p->alocal.data;
1913             commit->alocal.state = AR_CHANGED;
1914             commit->arrays = p->arrays;
1915             commit->achunk = p->achunk;
1916             commit->strings = p->strings;
1917             commit->coptab = p->coptab;
1918             commit->prev = p->prev;
1919             *cr = commit;
1920             cr = &commit->plist;
1921 
1922             p->prev = commit;
1923         } else {
1924             p->flags |= PLANE_MERGE;
1925         }
1926     }
1927     if (clist != (dataplane *) NULL) {
1928         /* insert commit planes in plane list */
1929         *cr = p;
1930         *r = clist;
1931     }
1932     clist = *r; /* sentinel */
1933 
1934     /*
1935      * pass 2: commit
1936      */
1937     for (p = plist; p != clist; p = p->plist) {
1938         /*
1939          * commit changes to previous plane
1940          */
1941         data = p->alocal.data;
1942         if (p->original != (value *) NULL) {
1943             if (p->level == 1 || p->prev->original != (value *) NULL) {
1944                 /* free backed-up variable values */
1945                 for (v = p->original, i = data->nvariables; i != 0; v++, --i) {
1946                     i_del_value(v);
1947                 }
1948                 FREE(p->original);
1949             } else {
1950                 /* move originals to previous plane */
1951                 p->prev->original = p->original;
1952             }
1953             commit_values(data->variables, data->nvariables, level - 1);
1954         }
1955 
1956         if (p->coptab != (coptable *) NULL) {
1957             /* commit callout changes */
1958             commit_callouts(p, p->flags & PLANE_MERGE);
1959             if (p->level == 1) {
1960                 cop_clean(p);
1961             } else {
1962                 p->prev->coptab = p->coptab;
1963             }
1964         }
1965 
1966         arr_commit(&p->achunk, p->prev, p->flags & PLANE_MERGE);
1967         if (p->flags & PLANE_MERGE) {
1968             if (p->arrays != (arrref *) NULL) {
1969                 register arrref *a;
1970 
1971                 /* remove old array refs */
1972                 for (a = p->prev->arrays, i = data->narrays; i != 0; a++, --i) {
1973                     if (a->arr != (array *) NULL) {
1974                         if (a->arr->primary == &p->alocal) {
1975                             a->arr->primary = &p->prev->alocal;
1976                         }
1977                         arr_del(a->arr);
1978                     }
1979                 }
1980                 FREE(p->prev->arrays);
1981                 p->prev->arrays = p->arrays;
1982             }
1983 
1984             if (p->strings != (strref *) NULL) {
1985                 register strref *s;
1986 
1987                 /* remove old string refs */
1988                 for (s = p->prev->strings, i = data->nstrings; i != 0; s++, --i)
1989                 {
1990                     if (s->str != (string *) NULL) {
1991                         str_del(s->str);
1992                     }
1993                 }
1994                 FREE(p->prev->strings);
1995                 p->prev->strings = p->strings;
1996             }
1997         }
1998     }
1999     commit_values(retval, 1, level - 1);
2000 
2001     /*
2002      * pass 3: deallocate
2003      */
2004     for (p = plist; p != clist; p = plist) {
2005         p->prev->flags = p->flags & MOD_ALL;
2006         p->prev->schange = p->schange;
2007         p->prev->achange = p->achange;
2008         p->prev->imports = p->imports;
2009         p->alocal.data->plane = p->prev;
2010         plist = p->plist;
2011         FREE(p);
2012     }
2013 }
2014 
2015 /*
2016  * NAME:        discard_callouts()
2017  * DESCRIPTION: discard callout patches on current plane, restoring old callouts
2018  */
2019 static void discard_callouts(plane)
2020 register dataplane *plane;
2021 {
2022     register copatch *cop, **c, **t;
2023     register dataspace *data;
2024     register int i;
2025 
2026     data = plane->alocal.data;
2027     for (i = COPATCHHTABSZ, t = plane->coptab->cop; --i >= 0; t++) {
2028         c = t;
2029         while (*c != (copatch *) NULL && (*c)->plane == plane) {
2030             cop = *c;
2031             switch (cop->type) {
2032             case COP_ADD:
2033                 d_free_call_out(data, cop->handle);
2034                 cop_del(plane, c, TRUE);
2035                 --ncallout;
2036                 break;
2037 
2038             case COP_REMOVE:
2039                 d_alloc_call_out(data, cop->handle, cop->rco.time,
2040                                  cop->rco.nargs, cop->rco.val);
2041                 cop_del(plane, c, FALSE);
2042                 ncallout++;
2043                 break;
2044 
2045             case COP_REPLACE:
2046                 d_free_call_out(data, cop->handle);
2047                 d_alloc_call_out(data, cop->handle, cop->rco.time,
2048                                  cop->rco.nargs, cop->rco.val);
2049                 cop_discard(cop);
2050                 cop_del(plane, c, TRUE);
2051                 break;
2052             }
2053         }
2054     }
2055 }
2056 
2057 /*
2058  * NAME:        data->discard_plane()
2059  * DESCRIPTION: discard the current data plane without committing it
2060  */
2061 void d_discard_plane(level)
2062 Int level;
2063 {
2064     register dataplane *p;
2065     register dataspace *data;
2066     register value *v;
2067     register Uint i;
2068 
2069     for (p = plist; p != (dataplane *) NULL && p->level == level; p = p->plist)
2070     {
2071         /*
2072          * discard changes except for callout mods
2073          */
2074         p->prev->flags |= p->flags & (MOD_CALLOUT | MOD_NEWCALLOUT);
2075 
2076         data = p->alocal.data;
2077         if (p->original != (value *) NULL) {
2078             /* restore original variable values */
2079             for (v = data->variables, i = data->nvariables; i != 0; --i, v++) {
2080                 i_del_value(v);
2081             }
2082             memcpy(data->variables, p->original,
2083                    data->nvariables * sizeof(value));
2084             FREE(p->original);
2085         }
2086 
2087         if (p->coptab != (coptable *) NULL) {
2088             /* undo callout changes */
2089             discard_callouts(p);
2090             if (p->prev == &data->base) {
2091                 cop_clean(p);
2092             } else {
2093                 p->prev->coptab = p->coptab;
2094             }
2095         }
2096 
2097         arr_discard(&p->achunk);
2098         if (p->arrays != (arrref *) NULL) {
2099             register arrref *a;
2100 
2101             /* delete new array refs */
2102             for (a = p->arrays, i = data->narrays; i != 0; a++, --i) {
2103                 if (a->arr != (array *) NULL) {
2104                     arr_del(a->arr);
2105                 }
2106             }
2107             FREE(p->arrays);
2108             /* fix old ones */
2109             for (a = p->prev->arrays, i = data->narrays; i != 0; a++, --i) {
2110                 if (a->arr != (array *) NULL) {
2111                     a->arr->primary = a;
2112                 }
2113             }
2114         }
2115 
2116         if (p->strings != (strref *) NULL) {
2117             register strref *s;
2118 
2119             /* delete new string refs */
2120             for (s = p->strings, i = data->nstrings; i != 0; s++, --i) {
2121                 if (s->str != (string *) NULL) {
2122                     str_del(s->str);
2123                 }
2124             }
2125             FREE(p->strings);
2126             /* fix old ones */
2127             for (s = p->prev->strings, i = data->nstrings; i != 0; s++, --i) {
2128                 if (s->str != (string *) NULL) {
2129                     s->str->primary = s;
2130                 }
2131             }
2132         }
2133 
2134         data->plane = p->prev;
2135         plist = p->plist;
2136         FREE(p);
2137     }
2138 }
2139 
2140 
2141 /*
2142  * NAME:        data->commit_arr()
2143  * DESCRIPTION: commit array to previous plane
2144  */
2145 abchunk **d_commit_arr(arr, prev, old)
2146 register array *arr;
2147 dataplane *prev, *old;
2148 {
2149     if (arr->primary->plane != prev) {
2150         if (arr->hashed != (struct _maphash_ *) NULL) {
2151             map_compact(arr->primary->data, arr);
2152         }
2153 
2154         if (arr->primary->arr == (array *) NULL) {
2155             arr->primary = &prev->alocal;
2156         } else {
2157             arr->primary->plane = prev;
2158         }
2159         commit_values(arr->elts, arr->size, prev->level);
2160     }
2161 
2162     return (prev == old) ? (abchunk **) NULL : &prev->achunk;
2163 }
2164 
2165 /*
2166  * NAME:        data->discard_arr()
2167  * DESCRIPTION: restore array to previous plane
2168  */
2169 void d_discard_arr(arr, plane)
2170 array *arr;
2171 dataplane *plane;
2172 {
2173     /* swapped-in arrays will be fixed later */
2174     arr->primary = &plane->alocal;
2175 }
2176 
2177 
2178 /*
2179  * NAME:        data->ref_imports()
2180  * DESCRIPTION: check the elements of an array for imports
2181  */
2182 void d_ref_imports(arr)
2183 array *arr;
2184 {
2185     register dataspace *data;
2186     register unsigned short n;
2187     register value *v;
2188 
2189     data = arr->primary->data;
2190     for (n = arr->size, v = arr->elts; n > 0; --n, v++) {
2191         if (T_INDEXED(v->type) && data != v->u.array->primary->data) {
2192             /* mark as imported */
2193             if (data->plane->imports++ == 0 && ifirst != data &&
2194                 data->iprev == (dataspace *) NULL) {
2195                 /* add to imports list */
2196                 data->iprev = (dataspace *) NULL;
2197                 data->inext = ifirst;
2198                 if (ifirst != (dataspace *) NULL) {
2199                     ifirst->iprev = data;
2200                 }
2201                 ifirst = data;
2202             }
2203         }
2204     }
2205 }
2206 
2207 /*
2208  * NAME:        data->assign_var()
2209  * DESCRIPTION: assign a value to a variable
2210  */
2211 void d_assign_var(data, var, val)
2212 register dataspace *data;
2213 register value *var;
2214 register value *val;
2215 {
2216     if (var >= data->variables && var < data->variables + data->nvariables) {
2217         if (data->plane->level != 0 &&
2218             data->plane->original == (value *) NULL) {
2219             /*
2220              * back up variables
2221              */
2222             i_copy(data->plane->original = ALLOC(value, data->nvariables),
2223                    data->variables, data->nvariables);
2224         }
2225         ref_rhs(data, val);
2226         del_lhs(data, var);
2227         data->plane->flags |= MOD_VARIABLE;
2228     }
2229 
2230     i_ref_value(val);
2231     i_del_value(var);
2232 
2233     *var = *val;
2234     var->modified = TRUE;
2235 }
2236 
2237 /*
2238  * NAME:        data->get_extravar()
2239  * DESCRIPTION: get an object's special value
2240  */
2241 value *d_get_extravar(data)
2242 dataspace *data;
2243 {
2244     return d_get_variable(data, data->nvariables - 1);
2245 }
2246 
2247 /*
2248  * NAME:        data->set_extravar()
2249  * DESCRIPTION: set an object's special value
2250  */
2251 void d_set_extravar(data, val)
2252 register dataspace *data;
2253 value *val;
2254 {
2255     d_assign_var(data, d_get_variable(data, data->nvariables - 1), val);
2256 }
2257 
2258 /*
2259  * NAME:        data->wipe_extravar()
2260  * DESCRIPTION: wipe out an object's special value
2261  */
2262 void d_wipe_extravar(data)
2263 register dataspace *data;
2264 {
2265     d_assign_var(data, d_get_variable(data, data->nvariables - 1), &nil_value);
2266 
2267     if (data->parser != (struct _parser_ *) NULL) {
2268         /*
2269          * get rid of the parser, too
2270          */
2271         ps_del(data->parser);
2272         data->parser = (struct _parser_ *) NULL;
2273     }
2274 }
2275 
2276 /*
2277  * NAME:        data->assign_elt()
2278  * DESCRIPTION: assign a value to an array element
2279  */
2280 void d_assign_elt(data, arr, elt, val)
2281 register dataspace *data;
2282 register array *arr;
2283 register value *elt, *val;
2284 {
2285     if (data->plane->level != arr->primary->data->plane->level) {
2286         /*
2287          * bring dataspace of imported array up to the current plane level
2288          */
2289         d_new_plane(arr->primary->data, data->plane->level);
2290     }
2291 
2292     data = arr->primary->data;
2293     if (arr->primary->plane != data->plane) {
2294         /*
2295          * backup array's current elements
2296          */
2297         arr_backup(&data->plane->achunk, arr);
2298         if (arr->primary->arr != (array *) NULL) {
2299             arr->primary->plane = data->plane;
2300         } else {
2301             arr->primary = &data->plane->alocal;
2302         }
2303     }
2304 
2305     if (arr->primary->arr != (array *) NULL) {
2306         /*
2307          * the array is in the loaded dataspace of some object
2308          */
2309         if ((arr->primary->ref & ARR_MOD) == 0) {
2310             arr->primary->ref |= ARR_MOD;
2311             data->plane->flags |= MOD_ARRAY;
2312         }
2313         ref_rhs(data, val);
2314         del_lhs(data, elt);
2315     } else {
2316         if (T_INDEXED(val->type) && data != val->u.array->primary->data) {
2317             /* mark as imported */
2318             if (data->plane->imports++ == 0 && ifirst != data &&
2319                 data->iprev == (dataspace *) NULL) {
2320                 /* add to imports list */
2321                 data->iprev = (dataspace *) NULL;
2322                 data->inext = ifirst;
2323                 if (ifirst != (dataspace *) NULL) {
2324                     ifirst->iprev = data;
2325                 }
2326                 ifirst = data;
2327             }
2328         }
2329         if (T_INDEXED(elt->type) && data != elt->u.array->primary->data) {
2330             /* mark as unimported */
2331             data->plane->imports--;
2332         }
2333     }
2334 
2335     i_ref_value(val);
2336     i_del_value(elt);
2337 
2338     *elt = *val;
2339     elt->modified = TRUE;
2340 }
2341 
2342 /*
2343  * NAME:        data->change_map()
2344  * DESCRIPTION: mark a mapping as changed in size
2345  */
2346 void d_change_map(map)
2347 array *map;
2348 {
2349     register arrref *a;
2350 
2351     a = map->primary;
2352     if (a->state == AR_UNCHANGED) {
2353         a->plane->achange++;
2354         a->state = AR_CHANGED;
2355     }
2356 }
2357 
2358 
2359 /*
2360  * NAME:        data->new_call_out()
2361  * DESCRIPTION: add a new callout
2362  */
2363 uindex d_new_call_out(data, func, delay, mdelay, f, nargs)
2364 register dataspace *data;
2365 string *func;
2366 Int delay;
2367 unsigned int mdelay;
2368 register frame *f;
2369 int nargs;
2370 {
2371     Uint ct, t;
2372     unsigned short m;
2373     cbuf *q;
2374     value v[4];
2375     uindex handle;
2376 
2377     ct = co_check(ncallout, delay, mdelay, &t, &m, &q);
2378     if (ct == 0 && q == (cbuf *) NULL) {
2379         /* callouts are disabled */
2380         return 0;
2381     }
2382     if (data->ncallouts >= conf_array_size() && data->fcallouts == 0) {
2383         error("Too many callouts in object");
2384     }
2385 
2386     PUT_STRVAL(&v[0], func);
2387     switch (nargs) {
2388     case 3:
2389         v[3] = f->sp[2];
2390     case 2:
2391         v[2] = f->sp[1];
2392     case 1:
2393         v[1] = f->sp[0];
2394     case 0:
2395         break;
2396 
2397     default:
2398         v[1] = f->sp[0];
2399         v[2] = f->sp[1];
2400         PUT_ARRVAL(&v[3], arr_new(data, nargs - 2L));
2401         memcpy(v[3].u.array->elts, f->sp + 2, (nargs - 2) * sizeof(value));
2402         d_ref_imports(v[3].u.array);
2403         break;
2404     }
2405     f->sp += nargs;
2406     handle = d_alloc_call_out(data, 0, ct, nargs, v);
2407 
2408     if (data->plane->level == 0) {
2409         /*
2410          * add normal callout
2411          */
2412         co_new(data->oindex, handle, t, m, q);
2413     } else {
2414         register dataplane *plane;
2415         register copatch **c, *cop;
2416         dcallout *co;
2417         copatch **cc;
2418 
2419         /*
2420          * add callout patch
2421          */
2422         plane = data->plane;
2423         if (plane->coptab == (coptable *) NULL) {
2424             cop_init(plane);
2425         }
2426         co = &data->callouts[handle - 1];
2427         cc = c = &plane->coptab->cop[handle % COPATCHHTABSZ];
2428         for (;;) {
2429             cop = *c;
2430             if (cop == (copatch *) NULL || cop->plane != plane) {
2431                 /* add new */
2432                 cop_new(plane, cc, COP_ADD, handle, co, t, m, q);
2433                 break;
2434             }
2435 
2436             if (cop->handle == handle) {
2437                 /* replace removed */
2438                 cop_replace(cop, co, t, m, q);
2439                 break;
2440             }
2441 
2442             c = &cop->next;
2443         }
2444 
2445         ncallout++;
2446     }
2447 
2448     return handle;
2449 }
2450 
2451 /*
2452  * NAME:        data->del_call_out()
2453  * DESCRIPTION: remove a callout
2454  */
2455 Int d_del_call_out(data, handle)
2456 dataspace *data;
2457 Uint handle;
2458 {
2459     register dcallout *co;
2460     Int t;
2461 
2462     if (handle == 0 || handle > data->ncallouts) {
2463         /* no such callout */
2464         return -1;
2465     }
2466     if (data->callouts == (dcallout *) NULL) {
2467         d_get_callouts(data);
2468     }
2469 
2470     co = &data->callouts[handle - 1];
2471     if (co->val[0].type != T_STRING) {
2472         /* invalid callout */
2473         return -1;
2474     }
2475 
2476     t = co_remaining(co->time);
2477     if (data->plane->level == 0) {
2478         /*
2479          * remove normal callout
2480          */
2481         co_del(data->oindex, (uindex) handle, co->time);
2482     } else {
2483         register dataplane *plane;
2484         register copatch **c, *cop;
2485         copatch **cc;
2486 
2487         /*
2488          * add/remove callout patch
2489          */
2490         --ncallout;
2491 
2492         plane = data->plane;
2493         if (plane->coptab == (coptable *) NULL) {
2494             cop_init(plane);
2495         }
2496         cc = c = &plane->coptab->cop[handle % COPATCHHTABSZ];
2497         for (;;) {
2498             cop = *c;
2499             if (cop == (copatch *) NULL || cop->plane != plane) {
2500                 /* delete new */
2501                 cop_new(plane, cc, COP_REMOVE, (uindex) handle, co, (Uint) 0, 0,
2502                         (cbuf *) NULL);
2503                 break;
2504             }
2505             if (cop->handle == handle) {
2506                 /* delete existing */
2507                 if (cop->type == COP_REPLACE) {
2508                     cop_release(cop);
2509                 } else {
2510                     cop_del(plane, c, TRUE);
2511                 }
2512                 break;
2513             }
2514             c = &cop->next;
2515         }
2516     }
2517     d_free_call_out(data, (uindex) handle);
2518 
2519     return t;
2520 }
2521 
2522 /*
2523  * NAME:        data->get_call_out()
2524  * DESCRIPTION: get a callout
2525  */
2526 string *d_get_call_out(data, handle, f, nargs)
2527 dataspace *data;
2528 unsigned int handle;
2529 register frame *f;
2530 int *nargs;
2531 {
2532     string *str;
2533     register dcallout *co;
2534     register value *v;
2535     register uindex n;
2536 
2537     if (data->callouts == (dcallout *) NULL) {
2538         d_get_callouts(data);
2539     }
2540 
2541     co = &data->callouts[handle - 1];
2542     v = co->val;
2543     del_lhs(data, &v[0]);
2544     str = v[0].u.string;
2545 
2546     i_grow_stack(f, (*nargs = co->nargs) + 1);
2547     *--f->sp = v[0];
2548 
2549     switch (co->nargs) {
2550     case 3:
2551         del_lhs(data, &v[3]);
2552         *--f->sp = v[3];
2553     case 2:
2554         del_lhs(data, &v[2]);
2555         *--f->sp = v[2];
2556     case 1:
2557         del_lhs(data, &v[1]);
2558         *--f->sp = v[1];
2559     case 0:
2560         break;
2561 
2562     default:
2563         n = co->nargs - 2;
2564         f->sp -= n;
2565         memcpy(f->sp, d_get_elts(v[3].u.array), n * sizeof(value));
2566         del_lhs(data, &v[3]);
2567         FREE(v[3].u.array->elts);
2568         v[3].u.array->elts = (value *) NULL;
2569         arr_del(v[3].u.array);
2570         del_lhs(data, &v[2]);
2571         *--f->sp = v[2];
2572         del_lhs(data, &v[1]);
2573         *--f->sp = v[1];
2574         break;
2575     }
2576 
2577     /* wipe out destructed objects */
2578     for (n = co->nargs, v = f->sp; n > 0; --n, v++) {
2579         if (v->type == T_OBJECT && DESTRUCTED(v)) {
2580             *v = nil_value;
2581         }
2582     }
2583 
2584     co->val[0] = nil_value;
2585     n = data->fcallouts;
2586     if (n != 0) {
2587         data->callouts[n - 1].co_prev = handle;
2588     }
2589     co->co_next = n;
2590     data->fcallouts = handle;
2591 
2592     data->plane->flags |= MOD_CALLOUT;
2593     return str;
2594 }
2595 
2596 /*
2597  * NAME:        data->list_callouts()
2598  * DESCRIPTION: list all call_outs in an object
2599  */
2600 array *d_list_callouts(host, data)
2601 dataspace *host;
2602 register dataspace *data;
2603 {
2604     register uindex n, count, size;
2605     register dcallout *co;
2606     register value *v, *v2, *elts;
2607     array *list, *a;
2608     uindex max_args;
2609 
2610     if (data->ncallouts == 0) {
2611         return arr_new(host, 0L);
2612     }
2613     if (data->callouts == (dcallout *) NULL) {
2614         d_get_callouts(data);
2615     }
2616 
2617     /* get the number of callouts in this object */
2618     count = data->ncallouts;
2619     for (n = data->fcallouts; n != 0; n = data->callouts[n - 1].co_next) {
2620         --count;
2621     }
2622 
2623     list = arr_new(host, (long) count);
2624     elts = list->elts;
2625     max_args = conf_array_size() - 3;
2626 
2627     for (co = data->callouts; count > 0; co++) {
2628         if (co->val[0].type == T_STRING) {
2629             size = co->nargs;
2630             if (size > max_args) {
2631                 /* unlikely, but possible */
2632                 size = max_args;
2633             }
2634             a = arr_new(host, size + 3L);
2635             v = a->elts;
2636 
2637             /* handle */
2638             PUT_INTVAL(v, co - data->callouts + 1);
2639             v++;
2640             /* function */
2641             PUT_STRVAL(v, co->val[0].u.string);
2642             v++;
2643             /* time */
2644             PUT_INTVAL(v, co->time);
2645             v++;
2646 
2647             /* copy arguments */
2648             switch (size) {
2649             case 3:
2650                 *v++ = co->val[3];
2651             case 2:
2652                 *v++ = co->val[2];
2653             case 1:
2654                 *v++ = co->val[1];
2655             case 0:
2656                 break;
2657 
2658             default:
2659                 n = size - 2;
2660                 for (v2 = d_get_elts(co->val[3].u.array) + n; n > 0; --n) {
2661                     *v++ = *--v2;
2662                 }
2663                 *v++ = co->val[2];
2664                 *v++ = co->val[1];
2665                 break;
2666             }
2667             while (size > 0) {
2668                 i_ref_value(--v);
2669                 --size;
2670             }
2671             d_ref_imports(a);
2672 
2673             /* put in list */
2674             PUT_ARRVAL(elts, a);
2675             elts++;
2676             --count;
2677         }
2678     }
2679     co_list(list);
2680 
2681     return list;
2682 }
2683 
2684 /*
2685  * NAME:        data->swapalloc()
2686  * DESCRIPTION: allocate swapspace for something
2687  */
2688 static sector d_swapalloc(size, nsectors, sectors)
2689 Uint size;
2690 register sector nsectors, **sectors;
2691 {
2692     register sector n, *s;
2693 
2694     s = *sectors;
2695     if (nsectors != 0) {
2696         /* wipe old sectors */
2697         sw_wipev(s, nsectors);
2698     }
2699 
2700     n = sw_mapsize(size);
2701     if (nsectors > n) {
2702         /* too many sectors */
2703         sw_delv(s + n, nsectors - n);
2704     }
2705 
2706     s = *sectors = REALLOC(*sectors, sector, nsectors, n);
2707     if (nsectors < n) {
2708         /* not enough sectors */
2709         sw_newv(s + nsectors, n - nsectors);
2710     }
2711 
2712     return n;
2713 }
2714 
2715 /*
2716  * NAME:        data->save_control()
2717  * DESCRIPTION: save the control block
2718  */
2719 static void d_save_control(ctrl)
2720 register control *ctrl;
2721 {
2722     scontrol header;
2723     char *prog, *stext, *text;
2724     dstrconst *sstrings;
2725     register Uint size, i;
2726     register sinherit *sinherits;
2727     register dinherit *inherits;
2728 
2729     /*
2730      * Save a control block.
2731      */
2732 
2733     /* create header */
2734     header.flags = 0;
2735     header.ninherits = ctrl->ninherits;
2736     header.compiled = ctrl->compiled;
2737     header.progsize = ctrl->progsize;
2738     header.nstrings = ctrl->nstrings;
2739     header.strsize = ctrl->strsize;
2740     header.nfuncdefs = ctrl->nfuncdefs;
2741     header.nvardefs = ctrl->nvardefs;
2742     header.nfuncalls = ctrl->nfuncalls;
2743     header.nsymbols = ctrl->nsymbols;
2744     header.nvariables = ctrl->nvariables;
2745     header.nifdefs = ctrl->nifdefs;
2746     header.nvinit = ctrl->nvinit;
2747     header.vmapsize = ctrl->vmapsize;
2748 
2749     /* create sector space */
2750     if (header.vmapsize != 0) {
2751         size = sizeof(scontrol) +
2752                header.vmapsize * (Uint) sizeof(unsigned short);
2753     } else {
2754         prog = ctrl->prog;
2755         if (header.progsize >= CMPLIMIT) {
2756             prog = ALLOCA(char, header.progsize);
2757             size = compress(prog, ctrl->prog, header.progsize);
2758             if (size != 0) {
2759                 header.flags |= CMP_PRED;
2760                 header.progsize = size;
2761             } else {
2762                 AFREE(prog);
2763                 prog = ctrl->prog;
2764             }
2765         }
2766 
2767         sstrings = ctrl->sstrings;
2768         stext = ctrl->stext;
2769         if (header.nstrings > 0 && sstrings == (dstrconst *) NULL) {
2770             register string **strs;
2771             register Uint strsize;
2772             register dstrconst *s;
2773             register char *t;
2774 
2775             sstrings = ALLOCA(dstrconst, header.nstrings);
2776             if (header.strsize > 0) {
2777                 stext = ALLOCA(char, header.strsize);
2778             }
2779 
2780             strs = ctrl->strings;
2781             strsize = 0;
2782             s = sstrings;
2783             t = stext;
2784             for (i = header.nstrings; i > 0; --i) {
2785                 s->index = strsize;
2786                 strsize += s->len = (*strs)->len;
2787                 memcpy(t, (*strs++)->text, s->len);
2788                 t += (s++)->len;
2789             }
2790         }
2791 
2792         text = stext;
2793         if (header.strsize >= CMPLIMIT) {
2794             text = ALLOCA(char, header.strsize);
2795             size = compress(text, stext, header.strsize);
2796             if (size != 0) {
2797                 header.flags |= CMP_PRED << 2;
2798                 header.strsize = size;
2799             } else {
2800                 AFREE(text);
2801                 text = stext;
2802             }
2803         }
2804 
2805         size = sizeof(scontrol) +
2806                UCHAR(header.ninherits) * sizeof(sinherit) +
2807                header.progsize +
2808                header.nstrings * (Uint) sizeof(dstrconst) +
2809                header.strsize +
2810                UCHAR(header.nfuncdefs) * sizeof(dfuncdef) +
2811                UCHAR(header.nvardefs) * sizeof(dvardef) +
2812                header.nfuncalls * (Uint) 2 +
2813                header.nsymbols * (Uint) sizeof(dsymbol);
2814     }
2815     ctrl->nsectors = header.nsectors = d_swapalloc(size, ctrl->nsectors,
2816                                                    &ctrl->sectors);
2817     OBJ(ctrl->oindex)->cfirst = ctrl->sectors[0];
2818 
2819     /*
2820      * Copy everything to the swap device.
2821      */
2822 
2823     /* save header */
2824     sw_writev((char *) &header, ctrl->sectors, (Uint) sizeof(scontrol),
2825               (Uint) 0);
2826     size = sizeof(scontrol);
2827 
2828     /* save sector map */
2829     sw_writev((char *) ctrl->sectors, ctrl->sectors,
2830               header.nsectors * (Uint) sizeof(sector), size);
2831     size += header.nsectors * (Uint) sizeof(sector);
2832 
2833     if (header.vmapsize != 0) {
2834         /*
2835          * save only vmap
2836          */
2837         sw_writev((char *) ctrl->vmap, ctrl->sectors,
2838                   header.vmapsize * (Uint) sizeof(unsigned short), size);
2839     } else {
2840         /* save inherits */
2841         inherits = ctrl->inherits;
2842         sinherits = ALLOCA(sinherit, i = UCHAR(header.ninherits));
2843         do {
2844             sinherits->oindex = inherits->oindex;
2845             sinherits->funcoffset = inherits->funcoffset;
2846             sinherits->varoffset = inherits->varoffset;
2847             if (inherits->priv) {
2848                 sinherits->varoffset |= PRIV;
2849             }
2850             inherits++;
2851             sinherits++;
2852         } while (--i > 0);
2853         sinherits -= UCHAR(header.ninherits);
2854         sw_writev((char *) sinherits, ctrl->sectors,
2855                   UCHAR(header.ninherits) * (Uint) sizeof(sinherit), size);
2856         size += UCHAR(header.ninherits) * sizeof(sinherit);
2857         AFREE(sinherits);
2858 
2859         /* save program */
2860         if (header.progsize > 0) {
2861             sw_writev(prog, ctrl->sectors, (Uint) header.progsize, size);
2862             size += header.progsize;
2863             if (prog != ctrl->prog) {
2864                 AFREE(prog);
2865             }
2866         }
2867 
2868         /* save string constants */
2869         if (header.nstrings > 0) {
2870             sw_writev((char *) sstrings, ctrl->sectors,
2871                       header.nstrings * (Uint) sizeof(dstrconst), size);
2872             size += header.nstrings * (Uint) sizeof(dstrconst);
2873             if (header.strsize > 0) {
2874                 sw_writev(text, ctrl->sectors, header.strsize, size);
2875                 size += header.strsize;
2876                 if (text != stext) {
2877                     AFREE(text);
2878                 }
2879                 if (stext != ctrl->stext) {
2880                     AFREE(stext);
2881                 }
2882             }
2883             if (sstrings != ctrl->sstrings) {
2884                 AFREE(sstrings);
2885             }
2886         }
2887 
2888         /* save function definitions */
2889         if (UCHAR(header.nfuncdefs) > 0) {
2890             sw_writev((char *) ctrl->funcdefs, ctrl->sectors,
2891                       UCHAR(header.nfuncdefs) * (Uint) sizeof(dfuncdef), size);
2892             size += UCHAR(header.nfuncdefs) * (Uint) sizeof(dfuncdef);
2893         }
2894 
2895         /* save variable definitions */
2896         if (UCHAR(header.nvardefs) > 0) {
2897             sw_writev((char *) ctrl->vardefs, ctrl->sectors,
2898                       UCHAR(header.nvardefs) * (Uint) sizeof(dvardef), size);
2899             size += UCHAR(header.nvardefs) * (Uint) sizeof(dvardef);
2900         }
2901 
2902         /* save function call table */
2903         if (header.nfuncalls > 0) {
2904             sw_writev((char *) ctrl->funcalls, ctrl->sectors,
2905                       header.nfuncalls * (Uint) 2, size);
2906             size += header.nfuncalls * (Uint) 2;
2907         }
2908 
2909         /* save symbol table */
2910         if (header.nsymbols > 0) {
2911             sw_writev((char *) ctrl->symbols, ctrl->sectors,
2912                       header.nsymbols * (Uint) sizeof(dsymbol), size);
2913         }
2914     }
2915 }
2916 
2917 
2918 /*
2919  * NAME:        data->count()
2920  * DESCRIPTION: recursively count the number of arrays and strings in an object
2921  */
2922 static void d_count(save, v, n)
2923 register savedata *save;
2924 register value *v;
2925 register unsigned short n;
2926 {
2927     while (n > 0) {
2928         switch (v->type) {
2929         case T_STRING:
2930             if (str_put(v->u.string, save->nstr) >= save->nstr) {
2931                 save->nstr++;
2932                 save->strsize += v->u.string->len;
2933             }
2934             break;
2935 
2936         case T_ARRAY:
2937         case T_MAPPING:
2938             if (arr_put(v->u.array) >= save->narr) {
2939                 if (v->u.array->hashed != (struct _maphash_ *) NULL) {
2940                     map_compact(v->u.array->primary->data, v->u.array);
2941                 }
2942                 save->narr++;
2943                 save->arrsize += v->u.array->size;
2944                 d_count(save, d_get_elts(v->u.array), v->u.array->size);
2945             }
2946             break;
2947         }
2948 
2949         v++;
2950         --n;
2951     }
2952 }
2953 
2954 /*
2955  * NAME:        data->save()
2956  * DESCRIPTION: recursively save the values in an object
2957  */
2958 static void d_save(save, sv, v, n)
2959 register savedata *save;
2960 register svalue *sv;
2961 register value *v;
2962 register unsigned short n;
2963 {
2964     register Uint i;
2965 
2966     while (n > 0) {
2967         switch (sv->type = v->type) {
2968         case T_NIL:
2969             sv->oindex = 0;
2970             sv->u.number = 0;
2971             break;
2972 
2973         case T_INT:
2974             sv->oindex = 0;
2975             sv->u.number = v->u.number;
2976             break;
2977 
2978         case T_STRING:
2979             i = str_put(v->u.string, save->nstr);
2980             sv->oindex = 0;
2981             sv->u.string = i;
2982             if (i >= save->nstr) {
2983                 /* new string value */
2984                 save->sstrings[i].index = save->strsize;
2985                 save->sstrings[i].len = v->u.string->len;
2986                 save->sstrings[i].ref = 0;
2987                 memcpy(save->stext + save->strsize, v->u.string->text,
2988                        v->u.string->len);
2989                 save->strsize += v->u.string->len;
2990                 save->nstr++;
2991             }
2992             save->sstrings[i].ref++;
2993             break;
2994 
2995         case T_FLOAT:
2996         case T_OBJECT:
2997             sv->oindex = v->oindex;
2998             sv->u.objcnt = v->u.objcnt;
2999             break;
3000 
3001         case T_ARRAY:
3002         case T_MAPPING:
3003             i = arr_put(v->u.array);
3004             sv->oindex = 0;
3005             sv->u.array = i;
3006             if (i >= save->narr) {
3007                 svalue *tmp;
3008 
3009                 /* new array */
3010                 save->sarrays[i].index = save->arrsize;
3011                 save->sarrays[i].size = v->u.array->size;
3012                 save->sarrays[i].ref = 0;
3013                 save->sarrays[i].tag = v->u.array->tag;
3014                 tmp = save->selts + save->arrsize;
3015                 save->arrsize += v->u.array->size;
3016                 save->narr++;
3017                 d_save(save, tmp, v->u.array->elts, v->u.array->size);
3018             }
3019             save->sarrays[i].ref++;
3020             break;
3021         }
3022         sv++;
3023         v++;
3024         --n;
3025     }
3026 }
3027 
3028 /*
3029  * NAME:        data->put_values()
3030  * DESCRIPTION: save modified values as svalues
3031  */
3032 static void d_put_values(data, sv, v, n)
3033 register dataspace *data;
3034 register svalue *sv;
3035 register value *v;
3036 register unsigned short n;
3037 {
3038     while (n > 0) {
3039         if (v->modified) {
3040             switch (sv->type = v->type) {
3041             case T_NIL:
3042                 sv->oindex = 0;
3043                 sv->u.number = 0;
3044                 break;
3045 
3046             case T_INT:
3047                 sv->oindex = 0;
3048                 sv->u.number = v->u.number;
3049                 break;
3050 
3051             case T_STRING:
3052                 sv->oindex = 0;
3053                 sv->u.string = v->u.string->primary - data->base.strings;
3054                 break;
3055 
3056             case T_FLOAT:
3057             case T_OBJECT:
3058                 sv->oindex = v->oindex;
3059                 sv->u.objcnt = v->u.objcnt;
3060                 break;
3061 
3062             case T_ARRAY:
3063             case T_MAPPING:
3064                 sv->oindex = 0;
3065                 sv->u.array = v->u.array->primary - data->base.arrays;
3066                 break;
3067             }
3068             v->modified = FALSE;
3069         }
3070         sv++;
3071         v++;
3072         --n;
3073     }
3074 }
3075 
3076 /*
3077  * NAME:        data->free_values()
3078  * DESCRIPTION: free values in a dataspace block
3079  */
3080 static void d_free_values(data)
3081 register dataspace *data;
3082 {
3083     register Uint i;
3084 
3085     /* free parse_string data */
3086     if (data->parser != (struct _parser_ *) NULL) {
3087         ps_del(data->parser);
3088         data->parser = (struct _parser_ *) NULL;
3089     }
3090 
3091     /* free variables */
3092     if (data->variables != (value *) NULL) {
3093         register value *v;
3094 
3095         for (i = data->nvariables, v = data->variables; i > 0; --i, v++) {
3096             i_del_value(v);
3097         }
3098 
3099         FREE(data->variables);
3100         data->variables = (value *) NULL;
3101     }
3102 
3103     /* free callouts */
3104     if (data->callouts != (dcallout *) NULL) {
3105         register dcallout *co;
3106         register value *v;
3107         register int j;
3108 
3109         for (i = data->ncallouts, co = data->callouts; i > 0; --i, co++) {
3110             v = co->val;
3111             if (v->type == T_STRING) {
3112                 j = 1 + co->nargs;
3113                 if (j > 4) {
3114                     j = 4;
3115                 }
3116                 do {
3117                     i_del_value(v++);
3118                 } while (--j > 0);
3119             }
3120         }
3121 
3122         FREE(data->callouts);
3123         data->callouts = (dcallout *) NULL;
3124     }
3125 
3126     /* free arrays */
3127     if (data->base.arrays != (arrref *) NULL) {
3128         register arrref *a;
3129 
3130         for (i = data->narrays, a = data->base.arrays; i > 0; --i, a++) {
3131             if (a->arr != (array *) NULL) {
3132                 arr_del(a->arr);
3133             }
3134         }
3135 
3136         FREE(data->base.arrays);
3137         data->base.arrays = (arrref *) NULL;
3138     }
3139 
3140     /* free strings */
3141     if (data->base.strings != (strref *) NULL) {
3142         register strref *s;
3143 
3144         for (i = data->nstrings, s = data->base.strings; i > 0; --i, s++) {
3145             if (s->str != (string *) NULL) {
3146                 s->str->primary = (strref *) NULL;
3147                 str_del(s->str);
3148             }
3149         }
3150 
3151         FREE(data->base.strings);
3152         data->base.strings = (strref *) NULL;
3153     }
3154 }
3155 
3156 /*
3157  * NAME:        data->save_dataspace()
3158  * DESCRIPTION: save all values in a dataspace block
3159  */
3160 static bool d_save_dataspace(data)
3161 register dataspace *data;
3162 {
3163     sdataspace header;
3164     register Uint n;
3165 
3166     if (data->parser != (struct _parser_ *) NULL) {
3167         ps_save(data->parser);
3168     }
3169     if (data->base.flags == 0) {
3170         return FALSE;
3171     }
3172 
3173     if (data->nsectors != 0 && data->base.achange == 0 &&
3174         data->base.schange == 0 && !(data->base.flags & MOD_NEWCALLOUT)) {
3175         bool mod;
3176 
3177         /*
3178          * No strings/arrays added or deleted. Check individual variables and
3179          * array elements.
3180          */
3181         if (data->base.flags & MOD_VARIABLE) {
3182             /*
3183              * variables changed
3184              */
3185             d_put_values(data, data->svariables, data->variables,
3186                          data->nvariables);
3187             sw_writev((char *) data->svariables, data->sectors,
3188                       data->nvariables * (Uint) sizeof(svalue),
3189                       data->varoffset);
3190         }
3191         if (data->base.flags & MOD_ARRAYREF) {
3192             register sarray *sa;
3193             register arrref *a;
3194 
3195             /*
3196              * references to arrays changed
3197              */
3198             sa = data->sarrays;
3199             a = data->base.arrays;
3200             mod = FALSE;
3201             for (n = data->narrays; n > 0; --n) {
3202                 if (a->arr != (array *) NULL && sa->ref != (a->ref & ~ARR_MOD))
3203                 {
3204                     sa->ref = a->ref & ~ARR_MOD;
3205                     mod = TRUE;
3206                 }
3207                 sa++;
3208                 a++;
3209             }
3210             if (mod) {
3211                 sw_writev((char *) data->sarrays, data->sectors,
3212                           data->narrays * sizeof(sarray), data->arroffset);
3213             }
3214         }
3215         if (data->base.flags & MOD_ARRAY) {
3216             register arrref *a;
3217             Uint idx;
3218 
3219             /*
3220              * array elements changed
3221              */
3222             a = data->base.arrays;
3223             for (n = 0; n < data->narrays; n++) {
3224                 if (a->arr != (array *) NULL && (a->ref & ARR_MOD)) {
3225                     a->ref &= ~ARR_MOD;
3226                     idx = data->sarrays[n].index;
3227                     d_put_values(data, &data->selts[idx], a->arr->elts,
3228                                  a->arr->size);
3229                     sw_writev((char *) &data->selts[idx], data->sectors,
3230                               a->arr->size * (Uint) sizeof(svalue),
3231                               data->arroffset + data->narrays * sizeof(sarray) +
3232                                 idx * sizeof(svalue));
3233                 }
3234                 a++;
3235             }
3236         }
3237         if (data->base.flags & MOD_STRINGREF) {
3238             register sstring *ss;
3239             register strref *s;
3240 
3241             /*
3242              * string references changed
3243              */
3244             ss = data->sstrings;
3245             s = data->base.strings;
3246             mod = FALSE;
3247             for (n = data->nstrings; n > 0; --n) {
3248                 if (s->str != (string *) NULL && ss->ref != s->ref) {
3249                     ss->ref = s->ref;
3250                     mod = TRUE;
3251                 }
3252                 ss++;
3253                 s++;
3254             }
3255             if (mod) {
3256                 sw_writev((char *) data->sstrings, data->sectors,
3257                           data->nstrings * sizeof(sstring),
3258                           data->stroffset);
3259             }
3260         }
3261         if (data->base.flags & MOD_CALLOUT) {
3262             scallout *scallouts;
3263             register scallout *sco;
3264             register dcallout *co;
3265 
3266             /* save new (?) fcallouts value */
3267             sw_writev((char *) &data->fcallouts, data->sectors,
3268                       (Uint) sizeof(uindex),
3269                       (Uint) ((char *) &header.fcallouts - (char *) &header));
3270 
3271             sco = scallouts = ALLOCA(scallout, data->ncallouts);
3272             co = data->callouts;
3273             for (n = data->ncallouts; n > 0; --n) {
3274                 sco->time = co->time;
3275                 sco->nargs = co->nargs;
3276                 if (co->val[0].type == T_STRING) {
3277                     co->val[0].modified = TRUE;
3278                     co->val[1].modified = TRUE;
3279                     co->val[2].modified = TRUE;
3280                     co->val[3].modified = TRUE;
3281                     d_put_values(data, sco->val, co->val,
3282                                  (co->nargs > 3) ? 4 : co->nargs + 1);
3283                 } else {
3284                     sco->val[0].type = T_NIL;
3285                 }
3286                 sco++;
3287                 co++;
3288             }
3289 
3290             sw_writev((char *) scallouts, data->sectors,
3291                       data->ncallouts * (Uint) sizeof(scallout),
3292                       data->cooffset);
3293             AFREE(scallouts);
3294         }
3295     } else {
3296         savedata save;
3297         scallout *scallouts;
3298         char *text;
3299         register Uint size;
3300 
3301         /*
3302          * count the number and sizes of strings and arrays
3303          */
3304         save.narr = 0;
3305         save.nstr = 0;
3306         save.arrsize = 0;
3307         save.strsize = 0;
3308 
3309         d_get_variable(data, 0);
3310         if (data->svariables == (svalue *) NULL) {
3311             data->svariables = ALLOC(svalue, data->nvariables);
3312         }
3313         d_count(&save, data->variables, data->nvariables);
3314 
3315         if (data->ncallouts > 0) {
3316             register dcallout *co;
3317 
3318             if (data->callouts == (dcallout *) NULL) {
3319                 d_get_callouts(data);
3320             }
3321             /* remove empty callouts at the end */
3322             for (n = data->ncallouts, co = data->callouts + n; n > 0; --n) {
3323                 if ((--co)->val[0].type == T_STRING) {
3324                     break;
3325                 }
3326                 if (data->fcallouts == n) {
3327                     /* first callout in the free list */
3328                     data->fcallouts = co->co_next;
3329                 } else {
3330                     /* connect previous to next */
3331                     data->callouts[co->co_prev - 1].co_next = co->co_next;
3332                     if (co->co_next != 0) {
3333                         /* connect next to previous */
3334                         data->callouts[co->co_next - 1].co_prev = co->co_prev;
3335                     }
3336                 }
3337             }
3338             data->ncallouts = n;
3339             if (n == 0) {
3340                 /* all callouts removed */
3341                 FREE(data->callouts);
3342                 data->callouts = (dcallout *) NULL;
3343             } else {
3344                 /* process callouts */
3345                 scallouts = ALLOCA(scallout, n);
3346                 for (co = data->callouts; n > 0; --n, co++) {
3347                     if (co->val[0].type == T_STRING) {
3348                         d_count(&save, co->val,
3349                                 (co->nargs > 3) ? 4 : co->nargs + 1);
3350                     }
3351                 }
3352             }
3353         }
3354 
3355         /* fill in header */
3356         header.flags = 0;
3357         header.nvariables = data->nvariables;
3358         header.narrays = save.narr;
3359         header.eltsize = save.arrsize;
3360         header.nstrings = save.nstr;
3361         header.strsize = save.strsize;
3362         header.ncallouts = data->ncallouts;
3363         header.fcallouts = data->fcallouts;
3364 
3365         /*
3366          * put everything in a saveable form
3367          */
3368         save.sstrings = data->sstrings =
3369                         REALLOC(data->sstrings, sstring, 0, header.nstrings);
3370         save.stext = data->stext =
3371                      REALLOC(data->stext, char, 0, header.strsize);
3372         save.sarrays = data->sarrays =
3373                        REALLOC(data->sarrays, sarray, 0, header.narrays);
3374         save.selts = data->selts =
3375                      REALLOC(data->selts, svalue, 0, header.eltsize);
3376         save.narr = 0;
3377         save.nstr = 0;
3378         save.arrsize = 0;
3379         save.strsize = 0;
3380 
3381         d_save(&save, data->svariables, data->variables, data->nvariables);
3382         if (header.ncallouts > 0) {
3383             register scallout *sco;
3384             register dcallout *co;
3385 
3386             sco = scallouts;
3387             co = data->callouts;
3388             for (n = data->ncallouts; n > 0; --n) {
3389                 sco->time = co->time;
3390                 sco->nargs = co->nargs;
3391                 if (co->val[0].type == T_STRING) {
3392                     d_save(&save, sco->val, co->val,
3393                            (co->nargs > 3) ? 4 : co->nargs + 1);
3394                 } else {
3395                     sco->val[0].type = T_NIL;
3396                 }
3397                 sco++;
3398                 co++;
3399             }
3400         }
3401 
3402         /* clear hash tables */
3403         str_clear();
3404         arr_clear();
3405 
3406         text = save.stext;
3407         if (header.strsize >= CMPLIMIT) {
3408             text = ALLOCA(char, header.strsize);
3409             size = compress(text, save.stext, header.strsize);
3410             if (size != 0) {
3411                 header.flags |= CMP_PRED;
3412                 header.strsize = size;
3413             } else {
3414                 AFREE(text);
3415                 text = save.stext;
3416             }
3417         }
3418 
3419         /* create sector space */
3420         size = sizeof(sdataspace) +
3421                (header.nvariables + header.eltsize) * sizeof(svalue) +
3422                header.narrays * sizeof(sarray) +
3423                header.nstrings * sizeof(sstring) +
3424                header.strsize +
3425                header.ncallouts * (Uint) sizeof(scallout);
3426         header.nsectors = d_swapalloc(size, data->nsectors, &data->sectors);
3427         data->nsectors = header.nsectors;
3428         OBJ(data->oindex)->dfirst = data->sectors[0];
3429 
3430         /* save header */
3431         size = sizeof(sdataspace);
3432         sw_writev((char *) &header, data->sectors, size, (Uint) 0);
3433         sw_writev((char *) data->sectors, data->sectors,
3434                   header.nsectors * (Uint) sizeof(sector), size);
3435         size += header.nsectors * (Uint) sizeof(sector);
3436 
3437         /* save variables */
3438         data->varoffset = size;
3439         sw_writev((char *) data->svariables, data->sectors,
3440                   data->nvariables * (Uint) sizeof(svalue), size);
3441         size += data->nvariables * (Uint) sizeof(svalue);
3442 
3443         /* save arrays */
3444         data->arroffset = size;
3445         if (header.narrays > 0) {
3446             sw_writev((char *) save.sarrays, data->sectors,
3447                       header.narrays * sizeof(sarray), size);
3448             size += header.narrays * sizeof(sarray);
3449             if (header.eltsize > 0) {
3450                 sw_writev((char *) save.selts, data->sectors,
3451                           header.eltsize * sizeof(svalue), size);
3452                 size += header.eltsize * sizeof(svalue);
3453             }
3454         }
3455 
3456         /* save strings */
3457         data->stroffset = size;
3458         if (header.nstrings > 0) {
3459             sw_writev((char *) save.sstrings, data->sectors,
3460                       header.nstrings * sizeof(sstring), size);
3461             size += header.nstrings * sizeof(sstring);
3462             if (header.strsize > 0) {
3463                 sw_writev(text, data->sectors, header.strsize, size);
3464                 size += header.strsize;
3465                 if (text != save.stext) {
3466                     AFREE(text);
3467                 }
3468             }
3469         }
3470 
3471         /* save callouts */
3472         data->cooffset = size;
3473         if (header.ncallouts > 0) {
3474             sw_writev((char *) scallouts, data->sectors,
3475                       header.ncallouts * (Uint) sizeof(scallout), size);
3476             AFREE(scallouts);
3477         }
3478 
3479         d_free_values(data);
3480 
3481         data->flags = header.flags;
3482         data->narrays = header.narrays;
3483         data->eltsize = header.eltsize;
3484         data->nstrings = header.nstrings;
3485         data->strsize = save.strsize;
3486 
3487         data->base.schange = 0;
3488         data->base.achange = 0;
3489     }
3490 
3491     data->base.flags = 0;
3492     return TRUE;
3493 }
3494 
3495 /*
3496  * NAME:        data->import()
3497  * DESCRIPTION: copy imported arrays to current dataspace
3498  */
3499 static void d_import(imp, data, val, n)
3500 register arrimport *imp;
3501 register dataspace *data;
3502 register value *val;
3503 register unsigned short n;
3504 {
3505     while (n > 0) {
3506         if (T_INDEXED(val->type)) {
3507             register array *a;
3508             register Uint i, j;
3509 
3510             a = val->u.array;
3511             if (a->primary->data != data) {
3512                 /*
3513                  * imported array
3514                  */
3515                 i = arr_put(a);
3516                 if (i >= imp->narr) {
3517                     /*
3518                      * first time encountered
3519                      */
3520                     if (a->hashed != (struct _maphash_ *) NULL) {
3521                         map_compact(a->primary->data, a);
3522                     }
3523 
3524                     if (a->ref == 2) {  /* + 1 for array merge table */
3525                         /*
3526                          * move array to new dataspace
3527                          */
3528                         a->primary = &data->base.alocal;
3529                     } else {
3530                         /*
3531                          * make new array
3532                          */
3533                         a = arr_alloc(a->size);
3534                         a->tag = val->u.array->tag;
3535                         a->odcount = val->u.array->odcount;
3536                         a->primary = &data->base.alocal;
3537 
3538                         if (a->size > 0) {
3539                             /*
3540                              * copy elements
3541                              */
3542                             i_copy(a->elts = ALLOC(value, a->size),
3543                                    d_get_elts(val->u.array), a->size);
3544                         }
3545 
3546                         /*
3547                          * replace
3548                          */
3549                         arr_del(val->u.array);
3550                         arr_ref(val->u.array = a);
3551                         imp->narr++;
3552                     }
3553 
3554                     /*
3555                      * store in itab
3556                      */
3557                     if (i >= imp->itabsz) {
3558                         /*
3559                          * increase size of itab
3560                          */
3561                         for (j = imp->itabsz; j <= i; j += j) ;
3562                         imp->itab = REALLOC(imp->itab, array*, imp->itabsz, j);
3563                         imp->itabsz = j;
3564                     }
3565                     arr_put(imp->itab[i] = a);
3566                     imp->narr++;
3567 
3568                     if (a->size > 0) {
3569                         /*
3570                          * import elements too
3571                          */
3572                         d_import(imp, data, a->elts, a->size);
3573                     }
3574                 } else {
3575                     /*
3576                      * array was previously replaced
3577                      */
3578                     arr_ref(a = imp->itab[i]);
3579                     arr_del(val->u.array);
3580                     val->u.array = a;
3581                 }
3582             } else if (arr_put(a) >= imp->narr) {
3583                 /*
3584                  * not previously encountered mapping or array
3585                  */
3586                 imp->narr++;
3587                 if (a->hashed != (struct _maphash_ *) NULL) {
3588                     map_compact(data, a);
3589                     d_import(imp, data, a->elts, a->size);
3590                 } else if (a->elts != (value *) NULL) {
3591                     d_import(imp, data, a->elts, a->size);
3592                 }
3593             }
3594         }
3595         val++;
3596         --n;
3597     }
3598 }
3599 
3600 /*
3601  * NAME:        data->export()
3602  * DESCRIPTION: handle exporting of arrays shared by more than one object
3603  */
3604 void d_export()
3605 {
3606     register dataspace *data;
3607     register Uint n;
3608     arrimport imp;
3609 
3610     if (ifirst != (dataspace *) NULL) {
3611         imp.itab = ALLOC(array*, imp.itabsz = 64);
3612 
3613         for (data = ifirst; data != (dataspace *) NULL; data = data->inext) {
3614             if (data->base.imports != 0) {
3615                 data->base.imports = 0;
3616                 imp.narr = 0;
3617                 if (data->variables != (value *) NULL) {
3618                     d_import(&imp, data, data->variables, data->nvariables);
3619                 }
3620                 if (data->base.arrays != (arrref *) NULL) {
3621                     register arrref *a;
3622 
3623                     for (n = data->narrays, a = data->base.arrays; n > 0;
3624                          --n, a++) {
3625                         if (a->arr != (array *) NULL) {
3626                             if (a->arr->hashed != (struct _maphash_ *) NULL) {
3627                                 /* mapping */
3628                                 map_compact(data, a->arr);
3629                                 d_import(&imp, data, a->arr->elts,
3630                                          a->arr->size);
3631                             } else if (a->arr->elts != (value *) NULL) {
3632                                 d_import(&imp, data, a->arr->elts,
3633                                          a->arr->size);
3634                             }
3635                         }
3636                     }
3637                 }
3638                 if (data->callouts != (dcallout *) NULL) {
3639                     register dcallout *co;
3640 
3641                     co = data->callouts;
3642                     for (n = data->ncallouts; n > 0; --n) {
3643                         if (co->val[0].type == T_STRING) {
3644                             d_import(&imp, data, co->val,
3645                                      (co->nargs > 3) ? 4 : co->nargs + 1);
3646                         }
3647                         co++;
3648                     }
3649                 }
3650                 arr_clear();    /* clear hash table */
3651             }
3652             data->iprev = (dataspace *) NULL;
3653         }
3654         ifirst = (dataspace *) NULL;
3655 
3656         FREE(imp.itab);
3657     }
3658 }
3659 
3660 /*
3661  * NAME:        data->upgrade()
3662  * DESCRIPTION: upgrade the dataspace for one object
3663  */
3664 static void d_upgrade(data, nvar, vmap, tmpl)
3665 register dataspace *data;
3666 register unsigned short nvar, *vmap;
3667 object *tmpl;
3668 {
3669     register value *v;
3670     register unsigned short n;
3671     value *vars;
3672 
3673     /* make sure variables are in memory */
3674     vars = d_get_variable(data, 0);
3675 
3676     /* map variables */
3677     for (n = nvar, v = ALLOC(value, n); n > 0; --n) {
3678         switch (*vmap) {
3679         case NEW_INT:
3680             *v++ = zero_int;
3681             break;
3682 
3683         case NEW_FLOAT:
3684             *v++ = zero_float;
3685             break;
3686 
3687         case NEW_POINTER:
3688             *v++ = nil_value;
3689             break;
3690 
3691         default:
3692             *v = vars[*vmap];
3693             i_ref_value(v);
3694             v->modified = TRUE;
3695             ref_rhs(data, v++);
3696             break;
3697         }
3698         vmap++;
3699     }
3700     vars = v - nvar;
3701 
3702     /* deref old values */
3703     v = data->variables;
3704     for (n = data->nvariables; n > 0; --n) {
3705         del_lhs(data, v);
3706         i_del_value(v++);
3707     }
3708 
3709     /* replace old with new */
3710     FREE(data->variables);
3711     data->variables = vars;
3712 
3713     data->base.flags |= MOD_VARIABLE;
3714     if (data->nvariables != nvar) {
3715         if (data->svariables != (svalue *) NULL) {
3716             FREE(data->svariables);
3717             data->svariables = (svalue *) NULL;
3718         }
3719         data->nvariables = nvar;
3720         data->base.achange++;   /* force rebuild on swapout */
3721     }
3722 
3723     o_upgraded(tmpl, OBJ(data->oindex));
3724 }
3725 
3726 /*
3727  * NAME:        data->upgrade_clone()
3728  * DESCRIPTION: upgrade a clone object
3729  */
3730 static void d_upgrade_clone(data)
3731 register dataspace *data;
3732 {
3733     register object *obj, *tmpl;
3734     register unsigned short nvar, *vmap;
3735     register Uint update;
3736 
3737     /*
3738      * the program for the clone was upgraded since last swapin
3739      */
3740     obj = OBJ(data->oindex);
3741     update = obj->update;
3742     obj = OBJ(obj->u_master);
3743     tmpl = OBJ(obj->prev);
3744     if (O_UPGRADING(obj)) {
3745         /* in the middle of an upgrade */
3746         tmpl = OBJ(tmpl->prev);
3747     }
3748     nvar = data->ctrl->nvariables + 1;
3749     vmap = o_control(tmpl)->vmap;
3750 
3751     if (tmpl->update != update) {
3752         register unsigned short *m1, *m2, n;
3753 
3754         m1 = vmap;
3755         vmap = ALLOCA(unsigned short, n = nvar);
3756         do {
3757             tmpl = OBJ(tmpl->prev);
3758             m2 = o_control(tmpl)->vmap;
3759             while (n > 0) {
3760                 *vmap++ = (NEW_VAR(*m1)) ? *m1++ : m2[*m1++];
3761                 --n;
3762             }
3763             n = nvar;
3764             vmap -= n;
3765             m1 = vmap;
3766         } while (tmpl->update != update);
3767     }
3768 
3769     d_upgrade(data, nvar, vmap, tmpl);
3770     if (vmap != tmpl->ctrl->vmap) {
3771         AFREE(vmap);
3772     }
3773 }
3774 
3775 /*
3776  * NAME:        data->upgrade_all()
3777  * DESCRIPTION: upgrade all obj and all objects cloned from obj that have
3778  *              dataspaces in memory
3779  */
3780 void d_upgrade_all(tmpl, new)
3781 register object *tmpl, *new;
3782 {
3783     register dataspace *data;
3784     register unsigned int nvar;
3785     register unsigned short *vmap;
3786     register object *obj;
3787 
3788     nvar = tmpl->ctrl->vmapsize;
3789     vmap = tmpl->ctrl->vmap;
3790 
3791     for (data = dtail; data != (dataspace *) NULL; data = data->prev) {
3792         obj = OBJ(data->oindex);
3793         if ((obj == new ||
3794              (!(obj->flags & O_MASTER) && obj->u_master == new->index)) &&
3795             obj->count != 0) {
3796             /* upgrade clone */
3797             if (nvar != 0) {
3798                 d_upgrade(data, nvar, vmap, tmpl);
3799             }
3800             data->ctrl->ndata--;
3801             data->ctrl = new->ctrl;
3802             data->ctrl->ndata++;
3803         }
3804     }
3805 }
3806 
3807 /*
3808  * NAME:        data->free_control()
3809  * DESCRIPTION: remove the control block from memory
3810  */
3811 static void d_free_control(ctrl)
3812 register control *ctrl;
3813 {
3814     register string **strs;
3815 
3816     /* delete strings */
3817     if (ctrl->strings != (string **) NULL) {
3818         register unsigned short i;
3819 
3820         strs = ctrl->strings;
3821         for (i = ctrl->nstrings; i > 0; --i) {
3822             if (*strs != (string *) NULL) {
3823                 str_del(*strs);
3824             }
3825             strs++;
3826         }
3827         FREE(ctrl->strings);
3828     }
3829 
3830     /* delete vmap */
3831     if (ctrl->vmap != (unsigned short *) NULL) {
3832         FREE(ctrl->vmap);
3833     }
3834 
3835     if (!(ctrl->flags & CTRL_COMPILED)) {
3836         /* delete sectors */
3837         if (ctrl->sectors != (sector *) NULL) {
3838             FREE(ctrl->sectors);
3839         }
3840 
3841         if (ctrl->inherits != (dinherit *) NULL) {
3842             /* delete inherits */
3843             FREE(ctrl->inherits);
3844         }
3845 
3846         if (ctrl->prog != (char *) NULL) {
3847             FREE(ctrl->prog);
3848         }
3849 
3850         /* delete string constants */
3851         if (ctrl->sstrings != (dstrconst *) NULL) {
3852             FREE(ctrl->sstrings);
3853         }
3854         if (ctrl->stext != (char *) NULL) {
3855             FREE(ctrl->stext);
3856         }
3857 
3858         /* delete function definitions */
3859         if (ctrl->funcdefs != (dfuncdef *) NULL) {
3860             FREE(ctrl->funcdefs);
3861         }
3862 
3863         /* delete variable definitions */
3864         if (ctrl->vardefs != (dvardef *) NULL) {
3865             FREE(ctrl->vardefs);
3866         }
3867 
3868         /* delete function call table */
3869         if (ctrl->funcalls != (char *) NULL) {
3870             FREE(ctrl->funcalls);
3871         }
3872 
3873         /* delete symbol table */
3874         if (ctrl->symbols != (dsymbol *) NULL) {
3875             FREE(ctrl->symbols);
3876         }
3877     }
3878 
3879     if (ctrl != chead) {
3880         ctrl->prev->next = ctrl->next;
3881     } else {
3882         chead = ctrl->next;
3883         if (chead != (control *) NULL) {
3884             chead->prev = (control *) NULL;
3885         }
3886     }
3887     if (ctrl != ctail) {
3888         ctrl->next->prev = ctrl->prev;
3889     } else {
3890         ctail = ctrl->prev;
3891         if (ctail != (control *) NULL) {
3892             ctail->next = (control *) NULL;
3893         }
3894     }
3895     --nctrl;
3896 
3897     FREE(ctrl);
3898 }
3899 
3900 /*
3901  * NAME:        data->free_dataspace()
3902  * DESCRIPTION: remove the dataspace block from memory
3903  */
3904 static void d_free_dataspace(data)
3905 register dataspace *data;
3906 {
3907     /* free values */
3908     d_free_values(data);
3909 
3910     /* delete sectors */
3911     if (data->sectors != (sector *) NULL) {
3912         FREE(data->sectors);
3913     }
3914 
3915     /* free sarrays */
3916     if (data->sarrays != (sarray *) NULL) {
3917         if (data->selts != (svalue *) NULL) {
3918             FREE(data->selts);
3919         }
3920         FREE(data->sarrays);
3921     }
3922 
3923     /* free sstrings */
3924     if (data->sstrings != (sstring *) NULL) {
3925         if (data->stext != (char *) NULL) {
3926             FREE(data->stext);
3927         }
3928         FREE(data->sstrings);
3929     }
3930 
3931     /* free svariables */
3932     if (data->svariables != (svalue *) NULL) {
3933         FREE(data->svariables);
3934     }
3935 
3936     if (data->ctrl != (control *) NULL) {
3937         data->ctrl->ndata--;
3938     }
3939 
3940     if (data != dhead) {
3941         data->prev->next = data->next;
3942     } else {
3943         dhead = data->next;
3944         if (dhead != (dataspace *) NULL) {
3945             dhead->prev = (dataspace *) NULL;
3946         }
3947     }
3948     if (data != dtail) {
3949         data->next->prev = data->prev;
3950     } else {
3951         dtail = data->prev;
3952         if (dtail != (dataspace *) NULL) {
3953             dtail->next = (dataspace *) NULL;
3954         }
3955     }
3956     --ndata;
3957 
3958     FREE(data);
3959 }
3960 
3961 
3962 /*
3963  * NAME:        data->swapout()
3964  * DESCRIPTION: Swap out a portion of the control and dataspace blocks in
3965  *              memory.  Return the number of dataspace blocks swapped out.
3966  */
3967 sector d_swapout(frag)
3968 unsigned int frag;
3969 {
3970     register sector n, count;
3971     register dataspace *data;
3972     register control *ctrl;
3973 
3974     count = 0;
3975 
3976     /* swap out dataspace blocks */
3977     data = dtail;
3978     for (n = ndata / frag; n > 0; --n) {
3979         register dataspace *prev;
3980 
3981         prev = data->prev;
3982         if (!(OBJ(data->oindex)->flags & O_PENDIO) || frag == 1) {
3983             if ((OBJ(data->oindex)->flags & O_SPECIAL) == O_SPECIAL &&
3984                 ext_swapout != (void (*) P((object*))) NULL) {
3985                 (*ext_swapout)(OBJ(data->oindex));
3986             }
3987             if (d_save_dataspace(data)) {
3988                 count++;
3989             }
3990             OBJ(data->oindex)->data = (dataspace *) NULL;
3991             d_free_dataspace(data);
3992         }
3993         data = prev;
3994     }
3995 
3996     /* swap out control blocks */
3997     ctrl = ctail;
3998     for (n = nctrl / frag; n > 0; --n) {
3999         register control *prev;
4000 
4001         prev = ctrl->prev;
4002         if (ctrl->ndata == 0) {
4003             if ((ctrl->sectors == (sector *) NULL &&
4004                  !(ctrl->flags & CTRL_COMPILED)) || (ctrl->flags & CTRL_VARMAP))
4005             {
4006                 d_save_control(ctrl);
4007             }
4008             OBJ(ctrl->oindex)->ctrl = (control *) NULL;
4009             d_free_control(ctrl);
4010         }
4011         ctrl = prev;
4012     }
4013 
4014     return count;
4015 }
4016 
4017 /*
4018  * NAME:        data->swapsync()
4019  * DESCRIPTION: Synchronize the swap file with the state of memory, swapping
4020  *              out as little as possible.
4021  */
4022 void d_swapsync()
4023 {
4024     register control *ctrl;
4025     register dataspace *data;
4026 
4027     /* save control blocks */
4028     for (ctrl = ctail; ctrl != (control *) NULL; ctrl = ctrl->prev) {
4029         if ((ctrl->sectors == (sector *) NULL &&
4030              !(ctrl->flags & CTRL_COMPILED)) || (ctrl->flags & CTRL_VARMAP)) {
4031             d_save_control(ctrl);
4032         }
4033     }
4034 
4035     /* save dataspace blocks */
4036     for (data = dtail; data != (dataspace *) NULL; data = data->prev) {
4037         if ((OBJ(data->oindex)->flags & O_SPECIAL) == O_SPECIAL &&
4038             ext_swapout != (void (*) P((object*))) NULL) {
4039             (*ext_swapout)(OBJ(data->oindex));
4040         }
4041         d_save_dataspace(data);
4042     }
4043 }
4044 
4045 /*
4046  * NAME:        data->conv()
4047  * DESCRIPTION: convert something from the dump file
4048  */
4049 static Uint d_conv(m, vec, layout, n, idx)
4050 char *m, *layout;
4051 sector *vec;
4052 Uint n, idx;
4053 {
4054     Uint bufsize;
4055     char *buf;
4056 
4057     bufsize = (conf_dsize(layout) & 0xff) * n;
4058     buf = ALLOCA(char, bufsize);
4059     sw_dreadv(buf, vec, bufsize, idx);
4060     conf_dconv(m, buf, layout, n);
4061     AFREE(buf);
4062 
4063     return bufsize;
4064 }
4065 
4066 /*
4067  * NAME:        data->conv_control()
4068  * DESCRIPTION: convert control block
4069  */
4070 void d_conv_control(oindex)
4071 unsigned int oindex;
4072 {
4073     scontrol header;
4074     register control *ctrl;
4075     register Uint size;
4076     register sector *s;
4077     register unsigned int n;
4078     object *obj;
4079 
4080     ctrl = d_new_control();
4081     ctrl->oindex = oindex;
4082     obj = OBJ(oindex);
4083 
4084     /*
4085      * restore from dump file
4086      */
4087     size = d_conv((char *) &header, &obj->cfirst, sc_layout, (Uint) 1,
4088                   (Uint) 0);
4089     if (header.nvariables >= PRIV) {
4090         fatal("too many variables in restored object");
4091     }
4092     ctrl->ninherits = UCHAR(header.ninherits);
4093     ctrl->compiled = header.compiled;
4094     ctrl->progsize = header.progsize;
4095     ctrl->nstrings = header.nstrings;
4096     ctrl->strsize = header.strsize;
4097     ctrl->nfuncdefs = UCHAR(header.nfuncdefs);
4098     ctrl->nvardefs = UCHAR(header.nvardefs);
4099     ctrl->nfuncalls = header.nfuncalls;
4100     ctrl->nsymbols = header.nsymbols;
4101     ctrl->nvariables = header.nvariables;
4102     ctrl->nifdefs = header.nifdefs;
4103     ctrl->nvinit = header.nvinit;
4104     ctrl->vmapsize = header.vmapsize;
4105 
4106     /* sectors */
4107     s = ALLOCA(sector, header.nsectors);
4108     s[0] = obj->cfirst;
4109     for (n = 0; n < header.nsectors; n++) {
4110         size += d_conv((char *) (s + n), s, "d", (Uint) 1, size);
4111     }
4112 
4113     if (header.vmapsize != 0) {
4114         /* only vmap */
4115         ctrl->vmap = ALLOC(unsigned short, header.vmapsize);
4116         d_conv((char *) ctrl->vmap, s, "s", (Uint) header.vmapsize, size);
4117     } else {
4118         register dinherit *inherits;
4119         register sinherit *sinherits;
4120 
4121         /* inherits */
4122         n = UCHAR(header.ninherits); /* at least one */
4123         ctrl->inherits = inherits = ALLOC(dinherit, n);
4124         sinherits = ALLOCA(sinherit, n);
4125         size += d_conv((char *) sinherits, s, si_layout, (Uint) n, size);
4126         do {
4127             inherits->oindex = sinherits->oindex;
4128             inherits->funcoffset = sinherits->funcoffset;
4129             inherits->varoffset = sinherits->varoffset & ~PRIV;
4130             (inherits++)->priv = (((sinherits++)->varoffset & PRIV) != 0);
4131         } while (--n > 0);
4132         AFREE(sinherits - UCHAR(header.ninherits));
4133 
4134         if (header.progsize != 0) {
4135             /* program */
4136             if (header.flags & CMP_TYPE) {
4137                 ctrl->prog = decompress(s, sw_dreadv, header.progsize, size,
4138                                         &ctrl->progsize);
4139             } else {
4140                 ctrl->prog = ALLOC(char, header.progsize);
4141                 sw_dreadv(ctrl->prog, s, header.progsize, size);
4142             }
4143             size += header.progsize;
4144         }
4145 
4146         if (header.nstrings != 0) {
4147             /* strings */
4148             ctrl->sstrings = ALLOC(dstrconst, header.nstrings);
4149             size += d_conv((char *) ctrl->sstrings, s, DSTR_LAYOUT,
4150                            (Uint) header.nstrings, size);
4151             if (header.strsize != 0) {
4152                 if (header.flags & (CMP_TYPE << 2)) {
4153                     ctrl->stext = decompress(s, sw_dreadv, header.strsize, size,
4154                                              &ctrl->strsize);
4155                 } else {
4156                     ctrl->stext = ALLOC(char, header.strsize);
4157                     sw_dreadv(ctrl->stext, s, header.strsize, size);
4158                 }
4159                 size += header.strsize;
4160             }
4161         }
4162 
4163         if (header.nfuncdefs != 0) {
4164             /* function definitions */
4165             ctrl->funcdefs = ALLOC(dfuncdef, UCHAR(header.nfuncdefs));
4166             size += d_conv((char *) ctrl->funcdefs, s, DF_LAYOUT,
4167                            (Uint) UCHAR(header.nfuncdefs), size);
4168         }
4169 
4170         if (header.nvardefs != 0) {
4171             /* variable definitions */
4172             ctrl->vardefs = ALLOC(dvardef, UCHAR(header.nvardefs));
4173             size += d_conv((char *) ctrl->vardefs, s, DV_LAYOUT,
4174                            (Uint) UCHAR(header.nvardefs), size);
4175         }
4176 
4177         if (header.nfuncalls != 0) {
4178             /* function calls */
4179             ctrl->funcalls = ALLOC(char, 2 * header.nfuncalls);
4180             sw_dreadv(ctrl->funcalls, s, header.nfuncalls * (Uint) 2, size);
4181             size += header.nfuncalls * (Uint) 2;
4182         }
4183 
4184         if (header.nsymbols != 0) {
4185             /* symbol table */
4186             ctrl->symbols = ALLOC(dsymbol, header.nsymbols);
4187             d_conv((char *) ctrl->symbols, s, DSYM_LAYOUT,
4188                    (Uint) header.nsymbols, size);
4189         }
4190     }
4191 
4192     AFREE(s);
4193 
4194     d_save_control(ctrl);
4195     OBJ(ctrl->oindex)->ctrl = (control *) NULL;
4196     d_free_control(ctrl);
4197 }
4198 
4199 /*
4200  * NAME:        data->fixobjs()
4201  * DESCRIPTION: fix objects in dataspace
4202  */
4203 static void d_fixobjs(v, n, ctab)
4204 register svalue *v;
4205 register Uint n, *ctab;
4206 {
4207     while (n != 0) {
4208         if (v->type == T_OBJECT) {
4209             if (v->u.objcnt == OBJ(v->oindex)->count) {
4210                 /* fix object count */
4211                 v->u.objcnt = ctab[v->oindex];
4212             } else {
4213                 /* destructed object; mark as invalid */
4214                 v->u.objcnt = 1;
4215             }
4216         }
4217         v++;
4218         --n;
4219     }
4220 }
4221 
4222 /*
4223  * NAME:        data->conv_dataspace()
4224  * DESCRIPTION: convert dataspace
4225  */
4226 void d_conv_dataspace(obj, counttab)
4227 object *obj;
4228 Uint *counttab;
4229 {
4230     sdataspace header;
4231     register dataspace *data;
4232     register Uint size;
4233     register sector *s;
4234     register unsigned int n;
4235 
4236     data = d_alloc_dataspace(obj);
4237 
4238     /*
4239      * restore from dump file
4240      */
4241     size = d_conv((char *) &header, &obj->dfirst, sd_layout, (Uint) 1,
4242                   (Uint) 0);
4243     data->nvariables = header.nvariables;
4244     data->narrays = header.narrays;
4245     data->eltsize = header.eltsize;
4246     data->nstrings = header.nstrings;
4247     data->strsize = header.strsize;
4248     data->ncallouts = header.ncallouts;
4249     data->fcallouts = header.fcallouts;
4250 
4251     /* sectors */
4252     s = ALLOCA(sector, header.nsectors);
4253     s[0] = obj->dfirst;
4254     for (n = 0; n < header.nsectors; n++) {
4255         size += d_conv((char *) (s + n), s, "d", (Uint) 1, size);
4256     }
4257 
4258     /* variables */
4259     data->svariables = ALLOC(svalue, header.nvariables);
4260     size += d_conv((char *) data->svariables, s, sv_layout,
4261                    (Uint) header.nvariables, size);
4262     d_fixobjs(data->svariables, (Uint) header.nvariables, counttab);
4263 
4264     if (header.narrays != 0) {
4265         /* arrays */
4266         data->sarrays = ALLOC(sarray, header.narrays);
4267         size += d_conv((char *) data->sarrays, s, sa_layout, header.narrays,
4268                        size);
4269         if (header.eltsize != 0) {
4270             data->selts = ALLOC(svalue, header.eltsize);
4271             size += d_conv((char *) data->selts, s, sv_layout, header.eltsize,
4272                            size);
4273             d_fixobjs(data->selts, header.eltsize, counttab);
4274         }
4275     }
4276 
4277     if (header.nstrings != 0) {
4278         /* strings */
4279         data->sstrings = ALLOC(sstring, header.nstrings);
4280         size += d_conv((char *) data->sstrings, s, ss_layout, header.nstrings,
4281                        size);
4282         if (header.strsize != 0) {
4283             if (header.flags & CMP_TYPE) {
4284                 data->stext = decompress(s, sw_dreadv, header.strsize, size,
4285                                          &data->strsize);
4286             } else {
4287                 data->stext = ALLOC(char, header.strsize);
4288                 sw_dreadv(data->stext, s, header.strsize, size);
4289             }
4290             size += header.strsize;
4291         }
4292     }
4293 
4294     if (header.ncallouts != 0) {
4295         scallout *scallouts;
4296         register scallout *sco;
4297         register dcallout *co;
4298 
4299         /* callouts */
4300         co = data->callouts = ALLOC(dcallout, header.ncallouts);
4301         sco = scallouts = ALLOCA(scallout, header.ncallouts);
4302         d_conv((char *) scallouts, s, sco_layout, (Uint) header.ncallouts,
4303                size);
4304 
4305         for (n = data->ncallouts; n > 0; --n) {
4306             co->time = sco->time;
4307             co->nargs = sco->nargs;
4308             if (sco->val[0].type == T_STRING) {
4309                 if (sco->nargs > 3) {
4310                     d_fixobjs(sco->val, (Uint) 4, counttab);
4311                     d_get_values(data, sco->val, co->val, 4);
4312                 } else {
4313                     d_fixobjs(sco->val, sco->nargs + (Uint) 1, counttab);
4314                     d_get_values(data, sco->val, co->val, sco->nargs + 1);
4315                 }
4316             } else {
4317                 co->val[0] = nil_value;
4318             }
4319             sco++;
4320             co++;
4321         }
4322 
4323         AFREE(scallouts);
4324     }
4325 
4326     AFREE(s);
4327 
4328     if (!(obj->flags & O_MASTER) && obj->update != OBJ(obj->u_master)->update) {
4329         /* handle object upgrading right away */
4330         data->ctrl = o_control(obj);
4331         data->ctrl->ndata++;
4332         d_upgrade_clone(data);
4333     }
4334 
4335     data->base.flags |= MOD_ALL;
4336     d_save_dataspace(data);
4337     OBJ(data->oindex)->data = (dataspace *) NULL;
4338     d_free_dataspace(data);
4339 }
4340 
4341 
4342 /*
4343  * NAME:        data->del_control()
4344  * DESCRIPTION: delete a control block from swap and memory
4345  */
4346 void d_del_control(ctrl)
4347 register control *ctrl;
4348 {
4349     if (ctrl->sectors != (sector *) NULL) {
4350         sw_wipev(ctrl->sectors, ctrl->nsectors);
4351         sw_delv(ctrl->sectors, ctrl->nsectors);
4352     }
4353     d_free_control(ctrl);
4354 }
4355 
4356 /*
4357  * NAME:        data->del_dataspace()
4358  * DESCRIPTION: delete a dataspace block from swap and memory
4359  */
4360 void d_del_dataspace(data)
4361 register dataspace *data;
4362 {
4363     if (data->iprev != (dataspace *) NULL) {
4364         data->iprev->inext = data->inext;
4365         if (data->inext != (dataspace *) NULL) {
4366             data->inext->iprev = data->iprev;
4367         }
4368     } else if (ifirst == data) {
4369         ifirst = data->inext;
4370         if (ifirst != (dataspace *) NULL) {
4371             ifirst->iprev = (dataspace *) NULL;
4372         }
4373     }
4374 
4375     if (data->ncallouts != 0) {
4376         register Uint n;
4377         register dcallout *co;
4378 
4379         /*
4380          * remove callouts from callout table
4381          */
4382         if (data->callouts == (dcallout *) NULL) {
4383             d_get_callouts(data);
4384         }
4385         for (n = data->ncallouts, co = data->callouts + n; n > 0; --n) {
4386             if ((--co)->val[0].type == T_STRING) {
4387                 d_del_call_out(data, n);
4388             }
4389         }
4390     }
4391     if (data->sectors != (sector *) NULL) {
4392         sw_wipev(data->sectors, data->nsectors);
4393         sw_delv(data->sectors, data->nsectors);
4394     }
4395     d_free_dataspace(data);
4396 }
4397 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.