1 /*---------------------------------------------------------------------------
2  * Swapping of object programs and variables.
3  *
4  *---------------------------------------------------------------------------
5  * TODO: 'status swap' should also list the swaps/s.
6  * TODO: Background defragmentation of the swapfile
7  *
8  * The swapper helps reducing the resident memory usage of the driver
9  * by writing program code and variable values of objects into a file.
10  * The decision which object to swap is done by the backend loop, which
11  * hopefully selects only objects which are not in use at the moment.
12  *
13  * The program and variables are swapped independently because the more
14  * complicated structure of variable values makes swapping them significantly
15  * more expensive than swapping the program. Additionally, since programs
16  * don't change, once a program has been swapped out, later swap ins can
17  * all be satisfied from the image created on the first swap out - no need
18  * for a costly rewrite of the program image.
19  *
20  * Every program resp. variable block swapped is identified by a "swap
21  * number", which incidentally is the offset at which the data can be found
22  * in the swap file. The swap number or'ed with 0x01 is stored in place of
23  * the .prog resp. .variables pointer in the object structure. Also the
24  * object flag O_SWAPPED is set if either one of the data blocks has been
25  * swapped.
26  *
27  * Programs can be swapped only if the have but one reference - that means
28  * that inherited or cloned objects can't swap. The line number information
29  * for a program is included in the program's swap block.
30  *
31  * Variables can be swapped all the time, however, some of the _values_
32  * can't be removed from memory: arrays and mappings with more than one
33  * reference (this conveniently includes recursive data structures), objects,
34  * closure, etc. For these values, the swapper writes a binary copy of
35  * the referencing svalue into the file. All other values are written into
36  * the file by value and removed from memory.
37  *
38  * The swap file is managed by the swapper and opened as soon as it is
39  * needed. If no other name is set, the filename defaults to
40  * "SWAP_FILE.<hostname>". The file is kept open over the whole runtime of
41  * the driver.
42  *
43  * The space in the swap file is managed in blocks of different sizes:
44  * blocks used for swapped programs and variable sets, and free blocks.
45  * Adjacent free blocks are concatenated, of course. The block structure
46  * of the file is mirrored in memory by a linked list of associated data
47  * structures - this simple structure proved to be efficient enough.
48  *
49  * When allocating a new block, the swapper follows one of two strategies:
50  *
51  * swap_compact_mode == TRUE:
52  *
53  *   In this mode, the swap file is kept short, but possibly heavily
54  *   fragmented.
55  *
56  *   The swapper first searches a suitable free block in the whole file
57  *   and extends the swap file only if no existing free block can be
58  *   found.
59  *
60  * swap_compact_mode == FALSE:
61  *
62  *   In this mode, the swapper tries to keep a "healthy" balance between
63  *   free and used blocks. For the price of a larger swap file the
64  *   fragmentation and search times are lower.
65  *
66  *   The swapper extends the file for new blocks until more
67  *   than half of the swap file is unused. At that point the swapper
68  *   starts recycling the free blocks as in the compact mode, but only
69  *   until the free blocks occupy only 1/4th of the swap file - then
70  *   the swapper switches back to immediate extension.
71  *
72  *---------------------------------------------------------------------------
73  */
74 
75 #include "driver.h"
76 #include "typedefs.h"
77 
78 #include <sys/types.h>
79 #include <sys/stat.h>
80 #include <stddef.h>
81 #include <stdio.h>
82 
83 #include "swap.h"
84 
85 #include "array.h"
86 #include "backend.h"
87 #include "closure.h"
88 #include "comm.h"
89 #include "gcollect.h"
90 #include "interpret.h"
91 #include "main.h"
92 #include "mapping.h"
93 #include "mempools.h"
94 #include "mstrings.h"
95 #include "object.h"
96 #include "otable.h"
97 #include "prolang.h"
98 #include "random.h"
99 #include "simulate.h"
100 #include "simul_efun.h"
101 #include "stdstrings.h"
102 #include "strfuns.h"
103 #ifdef USE_STRUCTS
104 #include "structs.h"
105 #endif /* USE_STRUCTS */
106 #include "svalue.h"
107 #include "wiz_list.h"
108 #include "xalloc.h"
109 
110 #include "../mudlib/sys/debug_info.h"
111 
112 /*-------------------------------------------------------------------------*/
113 
114 typedef struct swap_block_s swap_block_t;
115 typedef struct varblock_s   varblock_t;
116 typedef struct free_swapped_mapping_locals_s free_swapped_mapping_locals_t;
117 
118 
119 /* --- struct swap_block_s
120  *
121  * A linked list of these structures describes the use of the
122  * swapfile. Every structure describes one continguous block
123  * in the swapfile with the given size. A positive size denotes
124  * a free block, a negative size a used block.
125  */
126 
127 struct swap_block_s
128 {
129   swap_block_t *next;
130   mp_int        size;
131 };
132 
133 
134 /* --- struct varblock_s
135  *
136  * Varblocks are used to store the data from variables.
137  * The storage area is located _before_ the varblock_t so that
138  * data-storing functions need to know only the storage pointer .current
139  * and the remaining size .rest.
140  */
141 
142 struct varblock_s
143 {
144     /* unsigned char data[]: Allocated memory */
145 
146     unsigned char *current;  /* First free byte */
147     mp_int rest;             /* Number of free bytes */
148     char *start;             /* Start of the memory area */
149 };
150 
151 
152 /* --- struct free_swapped_mapping_locals_s
153  *
154  * Auxiliary datastructure to free a mapping after swapping out.
155  */
156 
157 struct free_swapped_mapping_locals_s
158 {
159     p_int          num_values; /* width of the mapping */
160     unsigned char *p;          /* current position in buffer */
161 };
162 
163 
164 #define LOW_WATER_MARK  (swapfile_size >> 2)
165 #define HIGH_WATER_MARK (swapfile_size >> 1)
166   /* The two limits for non-compact swapping.
167    */
168 
169 #define SWAP_ABS(a) ((a)>0 ? (a) : (-a))
170 
171 /*-------------------------------------------------------------------------*/
172 
173 Bool swap_compact_mode = MY_FALSE;
174   /* When true, the swapper tries to keep the swapfile short.
175    */
176 
177 static char file_name[MAXPATHLEN+1] = "";
178   /* Name of the swap file.
179    * Defaults to "SWAP_FILE.<hostname>".
180    */
181 
182 static FILE *swap_file = NULL;
183   /* The swapfile - it is kept open all the time.
184    */
185 
186 static Bool recycle_free_space = MY_FALSE;
187   /* True when freespace should be re-used, false if not
188    */
189 
190 static swap_block_t swap_list;
191   /* Headblock of the list of swap blocks.
192    */
193 
194 static swap_block_t *swap_rover = NULL;
195   /* Pointer to the current swap_block. By anchoring searches
196    * at the rover, we potentially increase the locality of
197    * file accesses.
198    */
199 
200 static swap_block_t *swap_previous = &swap_list;
201   /* One prior to swap_rover.
202    */
203 
204 static /* TODO: offset_t */ mp_int current_offset;
205   /* File offset corresponding to swap_rover.
206    */
207 
208 static mp_int swapfile_size = 0;
209   /* Total size of the swapfile.
210    */
211 
212 mp_int total_bytes_swapfree = 0;
213   /* Free bytes in the swapfile.
214    */
215 
216 static unsigned char *last_variable_block;
217   /* Swap during a and by the GC: address of the last variable
218    * block to be written.
219    */
220 
221 static mp_int last_variable_swap_num;
222   /* Swap during a and by the GC: swap number of the last variable
223    * block to be written.
224    */
225 
226 static char *last_changed_swapped_svalue;
227   /* Swap during a and by the GC: The last stored svalue
228    * free_swapped_svalues() had to change.
229    */
230 
231 
232 /* Statistics (some are accessed directly from the outside) */
233 
234 static mp_int num_swap_structs = 0;
235   /* Number of swap block structs allocated.
236    */
237 
238 mp_int num_swapped = 0;
239   /* Number of program blocks used in the swapfile (including unswapped
240    * blocks).
241    */
242 
243 mp_int num_unswapped = 0;
244   /* Number of program blocks read back in from the swapfile (but still
245    * marked as allocated).
246    */
247 
248 mp_int total_bytes_swapped = 0;
249   /* Number of program bytes stored in the swapfile (including unswapped
250    * bytes).
251    */
252 
253 mp_int total_bytes_unswapped = 0;
254   /* Number of program bytes read back in from the swapfile (but still
255    * marked as allocated).
256    */
257 
258 static mp_int num_swapfree = 0;
259   /* Number of free swap blocks.
260    */
261 
262 mp_int num_vb_swapped = 0;
263   /* Number of variables blocks in the swapfile.
264    */
265 
266 mp_int total_vb_bytes_swapped = 0;
267   /* Total size of variables stored in the swapfile.
268    */
269 
270 static mp_int total_swap_reused = 0;
271   /* Size of bytes reused from previously freed blocks.
272    */
273 
274 static long swap_num_searches;
275   /* Number of searches for a free block to allocate (as opposed to
276    * simply allocating it).
277    */
278 
279 static long swap_total_searchlength;
280   /* Sum of search steps done when allocating a new block.
281    */
282 
283 static long swap_free_searches;
284   /* Number of searches for a block to free.
285    */
286 
287 static long swap_free_searchlength;
288   /* Sum of search steps done when freeing a block.
289    */
290 
291 mp_int total_num_prog_blocks;
292   /* Number of program blocks in memory.
293    */
294 
295 mp_int total_prog_block_size;
296   /* Total size of program blocks in memory.
297    */
298 
299 /*-------------------------------------------------------------------------*/
300 /* Forward declarations */
301 
302 static varblock_t *swap_svalues(svalue_t *, mp_int, varblock_t *);
303 static unsigned char *free_swapped_svalues(svalue_t *, mp_int, unsigned char *);
304 static unsigned char * dump_swapped_values (mp_int num, unsigned char * p, int indent);
305 
306 /*-------------------------------------------------------------------------*/
307 static Bool
locate_out(program_t * prog)308 locate_out (program_t *prog)
309 
310 /* Prepare program <prog> for swap out: all pointers within the program
311  * memory block are changed into offsets relative to the start of the
312  * area.
313  *
314  * Return TRUE on success.
315  */
316 
317 {
318     char *p = NULL; /* keep cc happy */
319 
320     if (!prog)
321         return MY_FALSE;
322 
323 #define MAKEOFFSET(type, name) (type)&p[(char *)prog->name - (char *)prog]
324 
325     prog->program        = MAKEOFFSET(bytecode_p, program);
326     prog->functions      = MAKEOFFSET(uint32*, functions);
327     prog->function_names = MAKEOFFSET(unsigned short *, function_names);
328     prog->strings        = MAKEOFFSET(string_t**, strings);
329     prog->variables      = MAKEOFFSET(variable_t *, variables);
330     prog->inherit        = MAKEOFFSET(inherit_t *, inherit);
331 #ifdef USE_STRUCTS
332     prog->struct_defs    = MAKEOFFSET(struct_def_t *, struct_defs);
333 #endif /* USE_STRUCTS */
334     prog->includes       = MAKEOFFSET(include_t *, includes);
335     if (prog->type_start)
336     {
337         prog->argument_types = MAKEOFFSET(vartype_t *, argument_types);
338         prog->type_start = MAKEOFFSET(unsigned short *, type_start);
339     }
340     return MY_TRUE;
341 
342 #undef MAKEOFFSET
343 } /* locate_out() */
344 
345 
346 /*-------------------------------------------------------------------------*/
347 static Bool
locate_in(program_t * prog)348 locate_in (program_t *prog)
349 
350 /* After <prog> was swapped in, restore the intra-block pointers
351  * from the stored offsets.
352  * .line_numbers is not modified, and the program will get a new
353  * id-number.
354  *
355  * Return TRUE on success.
356  */
357 
358 {
359     char *p = (char *)prog;
360 
361 
362     if (!prog)
363         return MY_FALSE;
364 
365     prog->id_number = ++current_id_number
366                       ? current_id_number
367                       : renumber_programs();
368 
369 #define MAKEPTR(type, name) (type)&p[(char *)prog->name - (char *)0]
370 
371     prog->program        = MAKEPTR(bytecode_p, program);
372     prog->functions      = MAKEPTR(uint32*, functions);
373     prog->function_names = MAKEPTR(unsigned short *, function_names);
374     prog->strings        = MAKEPTR(string_t**, strings);
375     prog->variables      = MAKEPTR(variable_t*, variables);
376     prog->inherit        = MAKEPTR(inherit_t*, inherit);
377 #ifdef USE_STRUCTS
378     prog->struct_defs    = MAKEPTR(struct_def_t*, struct_defs);
379 #endif /* USE_STRUCTS */
380     prog->includes       = MAKEPTR(include_t*, includes);
381     if (prog->type_start)
382     {
383         prog->argument_types = MAKEPTR(vartype_t *, argument_types);
384         prog->type_start     = MAKEPTR(unsigned short *, type_start);
385     }
386 
387     return MY_TRUE;
388 
389 #undef MAKEPTR
390 } /* locate_in() */
391 
392 /*-------------------------------------------------------------------------*/
393 static mp_int
swap_alloc(mp_int size)394 swap_alloc (mp_int size)
395 
396 /* Find a free block of sufficient <size> in the swap file and allocate
397  * it. If there is none, add one at the end of the file.
398  * Return the offset of the block from the beginning of the file,
399  * and let the swap_rover point to the swap_block_t.
400  */
401 
402 {
403     swap_block_t *mark, *last;
404     int save_privilege;
405 
406     /* Make sure the size is something even, to meet the requirement
407      * that all swap offsets are even.
408      */
409     size = (size + sizeof(char*)-1) & ~(sizeof(char*)-1);
410 
411     save_privilege = malloc_privilege;
412     malloc_privilege = MALLOC_SYSTEM;
413 
414     if (!swap_compact_mode)
415     {
416         /* Determine the allocation mode */
417         if (!recycle_free_space)
418         {
419             if (total_bytes_swapfree < HIGH_WATER_MARK)
420                 goto alloc_new_space;
421             recycle_free_space = MY_TRUE;
422         }
423         else
424         {
425             if (total_bytes_swapfree < LOW_WATER_MARK)
426             {
427                 recycle_free_space = MY_FALSE;
428                 goto alloc_new_space;
429             }
430         }
431     } /* if (swap_compact_mode) */
432 
433     swap_num_searches++;
434 
435     /* Search for a free block, and if necessary allocated it */
436     mark = swap_rover;
437     for (;;)
438     {
439         swap_total_searchlength++;
440 
441         /* Wrap-around the end of the list? */
442         if (!swap_rover)
443         {
444             swap_rover = &swap_list;
445             swap_previous = NULL;
446             current_offset = 0;
447         }
448 
449         if (size <= swap_rover->size)
450         {
451             /* Found a suitable block */
452             total_bytes_swapfree -= size;
453             total_swap_reused += size;
454 
455             /* perfect fit? */
456             if (size == swap_rover->size)
457             {
458                 swap_rover->size = -size;
459                 num_swapfree--;
460                 malloc_privilege = save_privilege;
461 
462                 return current_offset;
463             }
464 
465             /* Unperfect fit: split the block in two.
466              * num_swapfree remains unchanged.
467              */
468             num_swap_structs++;
469             mark = pxalloc(sizeof(swap_block_t));
470             mark->size = swap_rover->size - size;
471             swap_rover->size = -size;
472             mark->next = swap_rover->next;
473             swap_rover->next = mark;
474             malloc_privilege = save_privilege;
475 
476             return current_offset;
477         }
478 
479         /* Block too small: try the next */
480         current_offset += SWAP_ABS(swap_rover->size);
481         swap_previous = swap_rover;
482         swap_rover = swap_rover->next;
483 
484         if (swap_rover == mark) /* Once around the list without success */
485         {
486 alloc_new_space:
487             /* Allocate a new block and add it to the swap file */
488 
489             last = swap_previous;
490             while ( NULL != (mark = last->next) )
491                 last = mark;
492             num_swap_structs++;
493             mark = pxalloc(sizeof(swap_block_t));
494             mark->next = NULL;
495             last->next = mark;
496             mark->size = -size;
497             if (!swap_rover)
498                 swap_rover = mark;
499             swapfile_size += size;
500             malloc_privilege = save_privilege;
501 
502             return swapfile_size - size;
503         }
504     } /* for() */
505 
506     /* NOTREACHED */
507 } /* swap_alloc() */
508 
509 /*-------------------------------------------------------------------------*/
510 static void
swap_free(mp_int offset)511 swap_free (mp_int offset)
512 
513 /* Free the swap block at the given <offset>.
514  */
515 
516 {
517     swap_free_searches++;
518 
519     /* If we are already after the block, reset the rover
520      */
521     if (offset < current_offset)
522     {
523         swap_rover = swap_list.next;
524         swap_previous = &swap_list;
525         current_offset = 0;
526     }
527 
528     /* Set the rover on the block to free
529      */
530     while (current_offset < offset && swap_rover)
531     {
532         swap_free_searchlength++;
533         swap_previous = swap_rover;
534         current_offset += SWAP_ABS(swap_rover->size);
535         swap_rover = swap_rover->next;
536     }
537 
538     /* Sanity checks
539      */
540     if (current_offset != offset || !swap_rover)
541         fatal("Bad swapfile offset.\n");
542     if (swap_rover->size > 0)
543         fatal("Freeing non-allocated block within swap file.\n");
544 
545     swap_rover->size = -swap_rover->size; /* Make the size positive */
546     total_bytes_swapfree += swap_rover->size;
547     num_swapfree++;
548 
549     /* first skip any allocated block adjacent to the one just freed */
550     if (swap_previous->size <= 0)
551     {
552         swap_previous = swap_rover;
553         current_offset += swap_rover->size;
554         swap_rover = swap_rover->next;
555     }
556 
557     /* now collapse adjacent free blocks */
558     while (swap_rover && swap_rover->size > 0)
559     {
560         swap_previous->size += swap_rover->size;
561         current_offset += swap_rover->size;
562         swap_previous->next = swap_rover->next;
563         num_swap_structs--;
564         pfree(swap_rover);
565         num_swapfree--;
566         swap_rover = swap_previous->next;
567     }
568 } /* swap_free() */
569 
570 /*-------------------------------------------------------------------------*/
571 static p_int
store_swap_block(void * buffer,mp_int size)572 store_swap_block (void * buffer, mp_int size)
573 
574 /* Store the memory block <buffer> of <size> bytes into the swapfile
575  * and return the offset at which it was stored.
576  * Return -1 on a failure.
577  *
578  * The swapfile is opened it necessary.
579  */
580 
581 {
582     mp_int offset;
583 
584     /* Make sure the swap file is open. */
585     if (swap_file == NULL)
586     {
587         if (*file_name == '\0')
588         {
589             sprintf(file_name, "%s.%s", SWAP_FILE, query_host_name());
590         }
591         swap_file = fopen(file_name, "w+b");
592         /* Leave this file pointer open! */
593         if (swap_file == NULL)
594         {
595             debug_message("%s Couldn't open swap file.\n", time_stamp());
596             return -1;
597         }
598     }
599 
600     /* Find a free swap block */
601     offset = swap_alloc(size);
602 
603     /* Seek and write the data */
604     if (fseek(swap_file, offset, 0) == -1)
605     {
606         debug_message("%s Couldn't seek the swap file, errno %d, "
607             "offset %"PRIdMPINT".\n", time_stamp(), errno, offset);
608         return -1;
609     }
610 
611     if (fwrite((char *)buffer, size, 1, swap_file) != 1)
612     {
613         debug_message("%s I/O error in swap.\n", time_stamp());
614         return -1;
615     }
616 
617     return offset;
618 } /* store_swap_block() */
619 
620 /*-------------------------------------------------------------------------*/
621 static p_int
store_swap_block2(void * buffer1,mp_int size1,void * buffer2,mp_int size2)622 store_swap_block2 ( void * buffer1, mp_int size1
623                   , void * buffer2, mp_int size2 )
624 
625 /* Store the memory blocks <buffer1> of <size1> bytes and <buffer2> of
626  * <size2> bytes into one block in the swapfile and return the offset at
627  * which it was stored.
628  * Return -1 on a failure.
629  *
630  * The swapfile is opened it necessary.
631  */
632 
633 {
634     mp_int offset;
635 
636     /* Make sure the swap file is open. */
637     if (swap_file == NULL)
638     {
639         if (*file_name == '\0')
640         {
641             sprintf(file_name, "%s.%s", SWAP_FILE, query_host_name());
642         }
643         swap_file = fopen(file_name, "w+b");
644         /* Leave this file pointer open! */
645         if (swap_file == NULL)
646         {
647             debug_message("%s Couldn't open swap file.\n", time_stamp());
648             return -1;
649         }
650     }
651 
652     /* Find a free swap block */
653     offset = swap_alloc(size1 + size2);
654 
655     /* Seek and write the data */
656     if (fseek(swap_file, offset, 0) == -1)
657     {
658         debug_message("%s Couldn't seek the swap file, errno %d, "
659             "offset %"PRIdMPINT".\n", time_stamp(), errno, offset);
660         return -1;
661     }
662 
663     if (fwrite((char *)buffer1, size1, 1, swap_file) != 1)
664     {
665         debug_message("%s I/O error in swap.\n", time_stamp());
666         return -1;
667     }
668 
669     if (fwrite((char *)buffer2, size2, 1, swap_file) != 1)
670     {
671         debug_message("%s I/O error in swap.\n", time_stamp());
672         return -1;
673     }
674 
675     return offset;
676 } /* store_swap_block2() */
677 
678 /*-------------------------------------------------------------------------*/
679 Bool
swap_program(object_t * ob)680 swap_program (object_t *ob)
681 
682 /* Swap out the program of object <ob>. This is only possible if the
683  * program has only one reference, ie. is neither cloned nor inherited.
684  *
685  * Result is TRUE if the program could be swapped.
686  */
687 
688 {
689     program_t *prog;
690     p_int swap_num;
691 
692     if (d_flag > 1)
693     {
694         debug_message("%s Swap object %s (obj ref %"PRIdPINT
695             ", prog ref %"PRIdPINT")\n",
696             time_stamp(), get_txt(ob->name), ob->ref, ob->prog->ref);
697     }
698 
699     prog = ob->prog;
700 
701     /* May we swap? */
702     if (prog->ref > 1)
703     {
704         if (d_flag > 1)
705         {
706             debug_message ("%s Program not swapped - cloned or inherited.\n"
707                           , time_stamp());
708         }
709         return MY_FALSE;
710     }
711 
712     /* Has this object already been swapped, and read in again ?
713      * Then it is very easy to swap it out again.
714      */
715     if (prog->swap_num >= 0)
716     {
717         total_bytes_unswapped -= prog->total_size;
718         if (prog->line_numbers)
719             total_bytes_unswapped -= prog->line_numbers->size;
720         ob->prog = (program_t *)(prog->swap_num | 1);
721         free_prog(prog, MY_FALSE);  /* Do not free the strings or blueprint */
722         ob->flags |= O_SWAPPED;
723         num_unswapped--;
724         return MY_TRUE;
725     }
726 
727     /* relocate the internal pointers */
728     locate_out(prog);
729     swap_num = store_swap_block2(prog, prog->total_size
730                                 , prog->line_numbers, prog->line_numbers->size);
731     if (swap_num == -1)
732     {
733         locate_in(prog);
734         return MY_FALSE;
735     }
736 
737     total_bytes_swapped += prog->total_size + prog->line_numbers->size;
738     num_swapped++;
739 
740     /* Free the program */
741     free_prog(prog, MY_FALSE);  /* Don't free the shared strings or the blueprint */
742 
743     /* Mark the program as swapped */
744     ob->prog = (program_t *)(swap_num | 1);
745     ob->flags |= O_SWAPPED;
746 
747     return MY_TRUE;
748 } /* swap_program() */
749 
750 /*-------------------------------------------------------------------------*/
751 static varblock_t *
reallocate_block(unsigned char * p,mp_int rest,mp_int count)752 reallocate_block (unsigned char *p, mp_int rest, mp_int count)
753 
754 /* Reallocate the varblock for address <p> and remaining size <rest>
755  * to hold space for at least <count> bytes more.
756  *
757  * Result is the new varblock_t, or NULL on failure.
758  */
759 
760 {
761     varblock_t *tmp;
762     char *start1, *start2;
763     mp_int size, size2;
764 
765     /* Get the varblock structure */
766     tmp = (varblock_t *)(p + rest);
767     start1 = tmp->start;
768     size = (char *)tmp - start1;
769 
770     /* Compute the required allocation size */
771     size2 = size;
772     do {
773         rest += size2;
774         size2 <<= 1;
775     } while (rest < count);
776 
777     /* Allocate the new memory area and copy the data stored so far.
778      */
779     if ( !(start2 = mb_realloc(mbSwap, size2 + sizeof(varblock_t))) )
780         return NULL;
781 
782     /* Set up the new varblock */
783     tmp = (varblock_t *)(start2 + size2);
784     tmp->current = (unsigned char *)tmp - rest;
785     tmp->rest = rest;
786     tmp->start = start2;
787 
788     return tmp;
789 } /* reallocate_block() */
790 
791 /*-------------------------------------------------------------------------*/
792 static void
swap_mapping_filter(svalue_t * key,svalue_t * values,void * extra)793 swap_mapping_filter (svalue_t *key, svalue_t *values, void *extra)
794 
795 /* Filter to swap one mapping entry. <extra> is the varblock_t** for
796  * the varblock to store the data in, and may be changed during the
797  * course of this function.
798  */
799 
800 {
801     varblock_t *block = *((varblock_t **)extra);
802 
803     if (block->current)
804     {
805         block = swap_svalues(key, 1, block);
806     }
807 
808     if (block->current)
809     {
810         block = swap_svalues(values, *((p_int *)block->start), block);
811     }
812 
813     *((varblock_t **)extra) = block;
814 } /* swap_mapping_filter() */
815 
816 /*-------------------------------------------------------------------------*/
817 static varblock_t *
swap_svalues(svalue_t * svp,mp_int num,varblock_t * block)818 swap_svalues (svalue_t *svp, mp_int num, varblock_t *block)
819 
820 /* Store the <num> svalues starting at <svp> into the varblock <block>.
821  * Return the (possibly reallocated) varblock.
822  *
823  * The data values are added to the end of the varblock in the following
824  * formats:
825  *
826  * swtype := (ph_int)svp->type | TYPE_MOD_SWAPPED.
827  *
828  * STRING, SYMBOL:
829  *    swtype, (ph_int)svp->x, (mp_int)mstrsize(string), string
830  *
831  *    For strings, svp->x.generic is 1 for untabled strings, and 0 for
832  *    tabled string.
833 
834  * POINTER, STRUCTS:
835  *    swtype, (size_t) swapsize, (size_t)size, (wiz_list_t*) user, values...
836  *
837  * QUOTED_ARRAY:
838  *    swtype, (ph_int)quotes, (size_t) swapsize, (size_t)size, (wiz_list_t*) user, values...
839  *
840  * STRUCT:
841  *    swtype, (size_t) swapsize, (struct_type_t *)type, (wiz_list_t*)user, values...
842  *
843  * MAPPING:
844  *    swtype, (size_t) swapsize, (p_int)width, (p_int)size, (wiz_list_t*) user, entries...
845  *
846  * Opaque, NUMBER, FLOAT, OBJECT, CLOSURE
847  *    svp->type, svp->x, svp->u
848  *
849  * Opaque are: contents of alists, empty arrays, structs/arrays/mappings with
850  * more than one ref (this also protects against recursive data structures),
851  * and mappings with closure or object keys (see the comment in the T_MAPPING
852  * case for the reason).
853  *
854  * The 'swapsize' is the size of the data block starting from the first
855  * byte of the 'swapsize' value. This value is used for sanity checks.
856  */
857 
858 {
859     static Bool swapping_alist = MY_FALSE;
860 
861     unsigned char *p;
862     mp_int rest;
863     size_t swapsize;  /* the swapsize value */
864     mp_int ss_loc;    /* the location of the swapsize entry */
865 
866 #   define CHECK_SPACE(count) \
867         if (rest < (mp_int)(count)) { \
868             varblock_t *CStmp; \
869             if ( !(CStmp = reallocate_block(p, rest, count)) ) {\
870                 CStmp = (varblock_t *)(p + rest); \
871                 CStmp->current = NULL; \
872                 return CStmp; \
873             } \
874             p = CStmp->current; \
875             rest = CStmp->rest; \
876         }
877 
878 #   define ADD_TO_BLOCK(var) \
879         memcpy(p, &var, sizeof(var)); \
880         p += sizeof(var); \
881         rest -= sizeof(var); \
882 
883 #   define SWAP_SVALUES(svp, num) {\
884         varblock_t *tmp; \
885         tmp = (varblock_t *)(p + rest); \
886         tmp->current = p; \
887         tmp->rest = rest; \
888         tmp = swap_svalues(svp, num, tmp); \
889         if ( !(p = tmp->current) ) { \
890             return tmp; \
891         } \
892         rest = tmp->rest; \
893     }
894 
895 #    define INIT_SWAPSIZE() \
896         { \
897             varblock_t *ustmp; \
898             ustmp = (varblock_t *)(p + rest); \
899             ss_loc = p - (unsigned char *)ustmp->start; \
900         } \
901         swapsize = 0; \
902         ADD_TO_BLOCK(swapsize);
903 
904 #    define UPDATE_SWAPSIZE() \
905         { \
906             varblock_t *ustmp; \
907             ustmp = (varblock_t *)(p + rest); \
908             swapsize = (p - (unsigned char *)ustmp->start) - ss_loc; \
909         } \
910         memcpy(p - swapsize, &swapsize, sizeof(swapsize));
911 
912     p = block->current;
913     rest = block->rest;
914 
915     /* Loop over all values */
916     for (; --num >= 0; svp++)
917     {
918         switch(svp->type)
919         {
920 
921         case T_STRING:
922             /* Use x.generic as flag whether the string is tabled or not */
923             svp->x.generic = (mstr_tabled(svp->u.str) ? 0 : 1);
924             /* FALL THROUGH */
925 
926         case T_SYMBOL:
927           {
928             mp_int len, size;
929 
930             if (swapping_alist)
931                 goto swap_opaque;
932 
933             len = mstrsize(svp->u.str);
934             size = 1 + sizeof svp->x + sizeof(len) + len;
935             CHECK_SPACE(size)
936             rest -= size;
937 
938             *p++ = svp->type | T_MOD_SWAPPED;
939             memcpy(p, &svp->x, sizeof(svp->x));
940             p += sizeof svp->x;
941             memcpy(p, &len, sizeof(len));
942             p += sizeof len;
943             memcpy(p, get_txt(svp->u.str), len);
944             p += len;
945             break;
946           }
947 
948         case T_POINTER:
949           {
950             size_t size;
951 
952             size = VEC_SIZE(svp->u.vec);
953             if (svp->u.vec->ref > 1 || !size || swapping_alist)
954                 goto swap_opaque;
955 
956             if (size > 1 && is_ordered(svp->u.vec))
957                 swapping_alist = MY_TRUE;
958 
959             CHECK_SPACE(1 + sizeof(swapsize) + sizeof(size) + sizeof(wiz_list_t *))
960             *p++ = svp->type | T_MOD_SWAPPED;
961             rest--;
962             INIT_SWAPSIZE();
963             ADD_TO_BLOCK(size)
964             ADD_TO_BLOCK(svp->u.vec->user)
965             SWAP_SVALUES(svp->u.vec->item, size)
966             UPDATE_SWAPSIZE();
967             swapping_alist = MY_FALSE;
968             break;
969           }
970 
971 #ifdef USE_STRUCTS
972         case T_STRUCT:
973           {
974             struct_t *st = svp->u.strct;
975             size_t size;
976 
977             size = struct_size(st);
978             if (st->ref > 1 || swapping_alist)
979                 goto swap_opaque;
980 
981             CHECK_SPACE(1 + sizeof(swapsize) + sizeof(struct_type_t *) + sizeof(wiz_list_t *))
982             *p++ = svp->type | T_MOD_SWAPPED;
983             rest--;
984             INIT_SWAPSIZE();
985             ADD_TO_BLOCK(st->type)
986             ADD_TO_BLOCK(st->user)
987             SWAP_SVALUES(st->member, size)
988             UPDATE_SWAPSIZE();
989             swapping_alist = MY_FALSE;
990             break;
991           }
992 #endif /* USE_STRUCTS */
993 
994         case T_QUOTED_ARRAY:
995           {
996             size_t size;
997 
998             size = VEC_SIZE(svp->u.vec);
999             if (svp->u.vec->ref > 1 || swapping_alist)
1000                 goto swap_opaque;
1001 
1002             CHECK_SPACE(
1003               1 + sizeof(swapsize)+ sizeof svp->x.quotes +
1004               sizeof size + sizeof(wiz_list_t *)
1005             )
1006 
1007             *p++ = T_QUOTED_ARRAY | T_MOD_SWAPPED;
1008             rest--;
1009             ADD_TO_BLOCK(svp->x.quotes)
1010             INIT_SWAPSIZE();
1011               /* The odd order of swapsize makes the swap-in code simpler */
1012             ADD_TO_BLOCK(size)
1013             ADD_TO_BLOCK(svp->u.vec->user)
1014             SWAP_SVALUES(svp->u.vec->item, size)
1015             UPDATE_SWAPSIZE();
1016             break;
1017           }
1018 
1019         case T_MAPPING:
1020           {
1021             mapping_t *m = svp->u.map;
1022             p_int num_entries, num_values, save;
1023             varblock_t *tmp;
1024 
1025             if (m->ref > 1 || swapping_alist)
1026                 goto swap_opaque;
1027 
1028             /* Mappings with object or closure keys can get stale, which
1029              * necessiates special treatment in garbage_collection().
1030              * The GC however requires all such mappings to be resident,
1031              * so they can't be swapped.
1032              * This alleviates the swapper from the need to check the
1033              * mapping for destructed object keys.
1034              */
1035             if (mapping_references_objects(m))
1036             {
1037                 goto swap_opaque;
1038             }
1039 
1040             CHECK_SPACE(
1041               1 + sizeof(swapsize)+ sizeof num_values + sizeof num_entries + sizeof m->user
1042             )
1043 
1044             *p++ = T_MAPPING | T_MOD_SWAPPED;
1045             rest--;
1046             INIT_SWAPSIZE();
1047             num_values = m->num_values;
1048               /* The type of num_values might be wider than m->num_values. */
1049             ADD_TO_BLOCK(num_values);
1050             num_entries = MAP_SIZE(m);
1051             ADD_TO_BLOCK(num_entries);
1052             ADD_TO_BLOCK(m->user);
1053 
1054             tmp = (varblock_t *)(p + rest);
1055             tmp->current = p;
1056             tmp->rest = rest;
1057             save = *((p_int *)tmp->start);
1058             *((p_int *)tmp->start) = m->num_values;
1059             walk_mapping(m, swap_mapping_filter, &tmp);
1060             *((p_int *)tmp->start) = save;
1061             if ( !(p = tmp->current) )
1062             {
1063                 return tmp;
1064             }
1065             rest = tmp->rest;
1066             UPDATE_SWAPSIZE();
1067             break;
1068           }
1069 
1070         case T_NUMBER:
1071         case T_FLOAT:
1072         case T_OBJECT:
1073         case T_CLOSURE:
1074 swap_opaque:
1075             /* opaque swapped data must be prevented from recursive freeing */
1076             CHECK_SPACE(sizeof(*svp))
1077             *p++ = svp->type;
1078             rest--;
1079             ADD_TO_BLOCK(svp->x)
1080             ADD_TO_BLOCK(svp->u)
1081             break;
1082 
1083         default:
1084            fatal("bad type %d in swap_svalues()\n", svp->type);
1085         }
1086     } /* for() */
1087 
1088     /* All saved - construct the varblock to return */
1089     {
1090         varblock_t *tmp;
1091 
1092         tmp = (varblock_t *)(p + rest);
1093         tmp->current = p;
1094         tmp->rest = rest;
1095         return tmp;
1096     }
1097 
1098 #   undef SWAP_SVALUES
1099 #   undef ADD_TO_BLOCK
1100 #   undef CHECK_SPACE
1101 #   undef INIT_SWAPSIZE
1102 #   undef UPDATE_SWAPSIZE
1103 
1104 } /* swap_svalues() */
1105 
1106 /*-------------------------------------------------------------------------*/
1107 #if 0
1108 static unsigned char *
1109 check_swapped_values (mp_int num, unsigned char * p)
1110 
1111 /* Check the content of the swap buffer starting at <p>, supposedly holding
1112  * <num> svalues.
1113  * Result is a pointer to the first byte after the data block, or NULL
1114  * on an error.
1115  */
1116 
1117 {
1118     size_t          swapsize;
1119     unsigned char * start;  /* Start value of <p> for swapsize checks */
1120 
1121 #   define GET_SWAPSIZE() \
1122         start = p; \
1123         memcpy(&swapsize, p, sizeof(swapsize)); \
1124         p += sizeof(swapsize);
1125 
1126 #   define CHECK_SWAPSIZE() \
1127         if (start + swapsize != p) \
1128         { \
1129             fprintf(stderr \
1130                  , "--- Incorrect swapsize on check: expected %zu bytes, " \
1131                    "read %zu (%p .. %p)\n" \
1132                  , swapsize \
1133                  , (size_t)(p - start), start, p \
1134                 ); \
1135             return NULL; \
1136         }
1137 
1138     /* For all values yadda yadda... */
1139     while (--num >= 0)
1140     {
1141         svalue_t sv;
1142 
1143         sv.type = *p & ~T_MOD_SWAPPED; /* get the original type */
1144 
1145         switch(*p++)
1146         {
1147         case T_STRING | T_MOD_SWAPPED:
1148         case T_SYMBOL | T_MOD_SWAPPED:
1149           {
1150             mp_int    len;
1151 
1152             memcpy(&sv.x, p, sizeof sv.x);
1153             p += sizeof sv.x;
1154             memcpy(&len, p, sizeof len);
1155             p += sizeof len;
1156             p += len;
1157             break;
1158           }
1159 
1160         case T_QUOTED_ARRAY | T_MOD_SWAPPED:
1161             memcpy(&sv.x, p, sizeof sv.x);
1162             p += sizeof sv.x;
1163             /* FALLTHROUGH */
1164 
1165         case T_POINTER | T_MOD_SWAPPED:
1166           {
1167             size_t size;
1168             wiz_list_t *user;
1169 
1170             GET_SWAPSIZE();
1171             memcpy(&size, p, sizeof size);
1172             p += sizeof size;
1173             memcpy(&user, p, sizeof user);
1174             p += sizeof user;
1175             p = check_swapped_values(size, p);
1176             if (!p)
1177                 return NULL;
1178             CHECK_SWAPSIZE();
1179             break;
1180           }
1181 
1182 #ifdef USE_STRUCTS
1183         case T_STRUCT | T_MOD_SWAPPED:
1184           {
1185             wiz_list_t *user;
1186             struct_type_t *stt;
1187 
1188             GET_SWAPSIZE();
1189             memcpy(&stt, p, sizeof stt);
1190             p += sizeof stt;
1191             memcpy(&user, p, sizeof user);
1192             p += sizeof user;
1193             p = check_swapped_values(struct_t_size(stt), p);
1194             if (!p)
1195                 return NULL;
1196             CHECK_SWAPSIZE();
1197             break;
1198           }
1199 #endif /* USE_STRUCTS */
1200 
1201         case T_MAPPING | T_MOD_SWAPPED:
1202           {
1203             p_int num_values;
1204             wiz_list_t *user;
1205             p_int num_keys;
1206 
1207             GET_SWAPSIZE();
1208             memcpy(&num_values, p, sizeof num_values);
1209             p += sizeof num_values;
1210             memcpy(&num_keys, p, sizeof num_keys);
1211             p += sizeof num_keys;
1212             memcpy(&user, p, sizeof user);
1213             p += sizeof user;
1214             p = check_swapped_values(num_keys*(1+num_values), p);
1215             if (!p)
1216                 return NULL;
1217             CHECK_SWAPSIZE();
1218             break;
1219           }
1220 
1221         case T_STRING:
1222         case T_SYMBOL:
1223         case T_POINTER:
1224 #ifdef USE_STRUCTS
1225         case T_STRUCT:
1226 #endif /* USE_STRUCTS */
1227         case T_QUOTED_ARRAY:
1228         case T_MAPPING:
1229         case T_NUMBER:
1230         case T_FLOAT:
1231         case T_OBJECT:
1232         case T_CLOSURE:
1233             p += sizeof sv.x;
1234             p += sizeof sv.u;
1235             break;
1236 
1237         default:
1238             return NULL;
1239         }
1240     } /* for() */
1241 
1242     return p;
1243 
1244 #   undef GET_SWAPSIZE
1245 #   undef CHECK_SWAPSIZE
1246 } /* check_swapped_values() */
1247 
1248 #endif
1249 
1250 /*-------------------------------------------------------------------------*/
1251 static unsigned char *
dump_swapped_values(mp_int num,unsigned char * p,int indent)1252 dump_swapped_values (mp_int num, unsigned char * p, int indent)
1253 
1254 /* Dump the content of the swap buffer starting at <p>, supposedly holding
1255  * <num> svalues, to stderr.
1256  * Result is a pointer to the first byte after the data block, or NULL
1257  * on an irrecoverable error.
1258  *
1259  * This function is called when free_swapped_values() or
1260  * read_unswapped_values() detect an inconsistency.
1261  */
1262 
1263 {
1264     mp_int          max_num = num;
1265     unsigned char * block = p;
1266 
1267     size_t          swapsize;
1268     unsigned char * start;  /* Start value of <p> for swapsize checks */
1269 
1270 #   define GET_SWAPSIZE() \
1271         start = p; \
1272         memcpy(&swapsize, p, sizeof(swapsize)); \
1273         p += sizeof(swapsize);
1274 
1275 #   define CHECK_SWAPSIZE() \
1276         if (start + swapsize != p) \
1277         { \
1278             fprintf(stderr \
1279                  , "%.*s--- Incorrect swapsize: expected %zu bytes, " \
1280                    "read %zu (%p .. %p)\n" \
1281                  , indent, "               " \
1282                  , swapsize \
1283                  , (size_t)(p - start), start, p \
1284                 ); \
1285         }
1286 
1287     /* For all values yadda yadda... */
1288     while (--num >= 0)
1289     {
1290         svalue_t sv;
1291 
1292         sv.type = *p & ~T_MOD_SWAPPED; /* get the original type */
1293 
1294         fprintf(stderr, "%.*s%16p (%6zu) [%3"PRIdMPINT"]: type %d"
1295                       , indent, "                "
1296                       , p, (size_t)(p - block)
1297                       , max_num  - num - 1
1298                       , sv.type
1299                );
1300         switch(*p++)
1301         {
1302         case T_STRING | T_MOD_SWAPPED:
1303         case T_SYMBOL | T_MOD_SWAPPED:
1304           {
1305             mp_int    len;
1306 
1307             memcpy(&sv.x, p, sizeof sv.x);
1308             p += sizeof sv.x;
1309             memcpy(&len, p, sizeof len);
1310             p += sizeof len;
1311             fprintf(stderr, " string (%d) : '%.*s'\n"
1312                           , (int)sv.x.generic, (int)len, p
1313                    );
1314             p += len;
1315             break;
1316           }
1317 
1318         case T_QUOTED_ARRAY | T_MOD_SWAPPED:
1319             memcpy(&sv.x, p, sizeof sv.x);
1320             p += sizeof sv.x;
1321             /* FALLTHROUGH */
1322 
1323         case T_POINTER | T_MOD_SWAPPED:
1324           {
1325             size_t size;
1326             wiz_list_t *user;
1327 
1328             GET_SWAPSIZE();
1329             memcpy(&size, p, sizeof size);
1330             p += sizeof size;
1331             memcpy(&user, p, sizeof user);
1332             p += sizeof user;
1333             fprintf(stderr, " array: %zu values\n", size);
1334             p = dump_swapped_values(size, p, indent+2);
1335             if (!p)
1336                 return NULL;
1337             CHECK_SWAPSIZE();
1338             break;
1339           }
1340 
1341 #ifdef USE_STRUCTS
1342         case T_STRUCT | T_MOD_SWAPPED:
1343           {
1344             wiz_list_t *user;
1345             struct_type_t *stt;
1346 
1347             GET_SWAPSIZE();
1348             memcpy(&stt, p, sizeof stt);
1349             p += sizeof stt;
1350             memcpy(&user, p, sizeof user);
1351             p += sizeof user;
1352             fprintf(stderr, " struct '%s': %ld values\n"
1353                           , get_txt(stt->name), (long)struct_t_size(stt));
1354             p = dump_swapped_values(struct_t_size(stt), p, indent+2);
1355             if (!p)
1356                 return NULL;
1357             CHECK_SWAPSIZE();
1358             break;
1359           }
1360 #endif /* USE_STRUCTS */
1361 
1362         case T_MAPPING | T_MOD_SWAPPED:
1363           {
1364             p_int num_values;
1365             wiz_list_t *user;
1366             p_int num_keys;
1367 
1368             GET_SWAPSIZE();
1369             memcpy(&num_values, p, sizeof num_values);
1370             p += sizeof num_values;
1371             memcpy(&num_keys, p, sizeof num_keys);
1372             p += sizeof num_keys;
1373             memcpy(&user, p, sizeof user);
1374             p += sizeof user;
1375             fprintf(stderr, " mapping: %"PRIdPINT" keys, %"PRIdPINT" values\n"
1376                           , num_keys, num_values);
1377             p = dump_swapped_values(num_keys*(1+num_values), p, indent+2);
1378             if (!p)
1379                 return NULL;
1380             CHECK_SWAPSIZE();
1381             break;
1382           }
1383 
1384         case T_STRING:
1385         case T_SYMBOL:
1386         case T_POINTER:
1387 #ifdef USE_STRUCTS
1388         case T_STRUCT:
1389 #endif /* USE_STRUCTS */
1390         case T_QUOTED_ARRAY:
1391         case T_MAPPING:
1392         case T_NUMBER:
1393         case T_FLOAT:
1394         case T_OBJECT:
1395         case T_CLOSURE:
1396             p += sizeof sv.x;
1397             p += sizeof sv.u;
1398             fprintf(stderr, " opaque\n");
1399             break;
1400 
1401         default:
1402             fprintf(stderr, " bad type\n");
1403             return NULL;
1404         }
1405     } /* for() */
1406 
1407     return p;
1408 
1409 #   undef GET_SWAPSIZE
1410 #   undef CHECK_SWAPSIZE
1411 } /* dump_swapped_values() */
1412 
1413 /*-------------------------------------------------------------------------*/
1414 static void
free_swapped_mapping_filter(svalue_t * key,svalue_t * values,void * extra)1415 free_swapped_mapping_filter (svalue_t *key, svalue_t *values, void *extra)
1416 
1417 /* Filterfunction to free a swapped-out mapping.
1418  * <extra> is a (free_swapped_mapping_locals_t *), and <extra>->p is updated.
1419  */
1420 
1421 {
1422     free_swapped_mapping_locals_t *l;
1423     unsigned char *p;
1424 
1425     l = (free_swapped_mapping_locals_t *)extra;
1426     p = l->p;
1427     p = free_swapped_svalues(key, 1, p);
1428     p = free_swapped_svalues(values, l->num_values, p);
1429     l->p = p;
1430 } /* free_swapped_mapping_filter */
1431 
1432 /*-------------------------------------------------------------------------*/
1433 static unsigned char *
free_swapped_svalues(svalue_t * svp,mp_int num,unsigned char * p)1434 free_swapped_svalues (svalue_t *svp, mp_int num, unsigned char *p)
1435 
1436 /* Free the <num> svalues starting at <svp> after they have been swapped.
1437  * <p> is the pointer into the buffer where this block of svalues has
1438  * been stored in.
1439  *
1440  * The algorithm is that this function mirrors the saving algorithm
1441  * of swap_svalues(), just that it reads what swap_svalues() has stored
1442  * in the buffer and frees all svalues with a T_MOD_SWAPPED flag.
1443  *
1444  * The function acknowledges that it may be called from the garbage
1445  * collector, which means that some of the object and closure values
1446  * stored with swap_svalues() might have become invalid meanwhile.
1447  * In those cases, the stored data is adjusted.
1448  *
1449  * Take care to not interfere with a garbage_collection in progress!
1450  */
1451 
1452 {
1453     mp_int          max_num = num;
1454     unsigned char * block = p;
1455 
1456     size_t          swapsize;
1457     unsigned char * start;
1458 
1459 #   define GET_SWAPSIZE() \
1460         start = p; \
1461         memcpy(&swapsize, p, sizeof(swapsize)); \
1462         p += sizeof(swapsize);
1463 
1464 #   define CHECK_SWAPSIZE() \
1465         if (start + swapsize != p) \
1466         { \
1467             dump_swapped_values(max_num, block, 0); \
1468             fatal("svalue type %d: expected %zu bytes, read %zu (%p .. %p)\n" \
1469                  , (int)svp->type, swapsize \
1470                  , (size_t)(p - start), start, p \
1471                 ); \
1472         }
1473 
1474     for (; --num >= 0; svp++)
1475     {
1476         switch(*p)
1477         {
1478         case T_STRING | T_MOD_SWAPPED:
1479         case T_SYMBOL | T_MOD_SWAPPED:
1480             {
1481                 mp_int strsize;
1482                 p += 1 + sizeof(svp->x);
1483                 memcpy(&strsize, p, sizeof(strsize));
1484                 p += sizeof(strsize) + strsize;
1485 
1486                 if (!gc_status)
1487                     free_mstring(svp->u.str);
1488             }
1489             break;
1490 
1491         case T_QUOTED_ARRAY | T_MOD_SWAPPED:
1492             p += sizeof svp->x;
1493             /* FALLTHROUGH */
1494 
1495         case T_POINTER | T_MOD_SWAPPED:
1496             p += 1;
1497             GET_SWAPSIZE();
1498             p += sizeof(size_t) + sizeof(wiz_list_t *);
1499             p =
1500               free_swapped_svalues(svp->u.vec->item, VEC_SIZE(svp->u.vec), p);
1501             free_empty_vector(svp->u.vec);
1502             CHECK_SWAPSIZE();
1503             break;
1504 
1505 #ifdef USE_STRUCTS
1506         case T_STRUCT | T_MOD_SWAPPED:
1507           {
1508             p += 1;
1509             GET_SWAPSIZE();
1510             p += sizeof(struct_type_t *) + sizeof(wiz_list_t *);
1511             p =
1512               free_swapped_svalues(svp->u.strct->member, struct_size(svp->u.strct), p);
1513             struct_free_empty(svp->u.strct);
1514             CHECK_SWAPSIZE();
1515             break;
1516           }
1517 #endif /* USE_STRUCTS */
1518 
1519         case T_MAPPING | T_MOD_SWAPPED:
1520           {
1521             /* beware: a mapping can get unswappable when it is entered
1522              * in the stale_mapping list. Or the stale_mapping list has to
1523              * be recoded to include swapped mappings.
1524              */
1525             free_swapped_mapping_locals_t l;
1526 
1527             p += 1;
1528             GET_SWAPSIZE();
1529             p += sizeof(p_int) +
1530                  sizeof(p_int) +
1531                  sizeof(wiz_list_t *);
1532             l.num_values = svp->u.map->num_values;
1533             l.p = p;
1534             walk_mapping(svp->u.map, free_swapped_mapping_filter, &l);
1535             p = l.p;
1536             free_empty_mapping(svp->u.map);
1537             CHECK_SWAPSIZE();
1538             break;
1539           }
1540 
1541         case T_OBJECT:
1542             if (svp->type == T_NUMBER)
1543             {
1544                 /* Object was destructed */
1545                 *p++ = T_NUMBER;
1546                 memcpy(p, &svp->x, sizeof svp->x);
1547                 p += sizeof svp->x;
1548                 memcpy(p, &svp->u, sizeof svp->u);
1549                 p += sizeof svp->u;
1550                 last_changed_swapped_svalue = (char*)p;
1551                 break;
1552             }
1553             goto advance;
1554 
1555         case T_CLOSURE:
1556             /* the garbage collector replaces closures bound to destructed
1557              * objects by F_UNDEF
1558              */
1559             if (is_undef_closure(svp)) /* this shouldn't happen */
1560             {
1561               if ( memcmp(p+1, &svp->x, sizeof svp->x)
1562                 || memcmp(p+1+sizeof svp->x, &svp->u, sizeof svp->u))
1563               {
1564                   p++;
1565                   memcpy(p, (char *)&svp->x, sizeof svp->x);
1566                   p += sizeof svp->x;
1567                   memcpy(p, (char *)&svp->u, sizeof svp->u);
1568                   p += sizeof svp->u;
1569                   last_changed_swapped_svalue = (char*)p;
1570                   break;
1571               }
1572             }
1573 
1574         case T_STRING:
1575         case T_SYMBOL:
1576         case T_POINTER:
1577 #ifdef USE_STRUCTS
1578         case T_STRUCT:
1579 #endif /* USE_STRUCTS */
1580         case T_QUOTED_ARRAY:
1581         case T_MAPPING:
1582         case T_NUMBER:
1583         case T_FLOAT:
1584 advance:
1585             /* Opaque storage: skip it */
1586             p += 1 + sizeof svp->x + sizeof svp->u;
1587             break;
1588 
1589         default:
1590             dump_swapped_values(max_num, block, 0);
1591             fatal("bad type %d in free_swapped_svalues()\n", *p);
1592         }
1593     }
1594 
1595     return p;
1596 
1597 #   undef GET_SWAPSIZE
1598 #   undef CHECK_SWAPSIZE
1599 } /* free_swapped_svalues() */
1600 
1601 /*-------------------------------------------------------------------------*/
1602 Bool
swap_variables(object_t * ob)1603 swap_variables (object_t *ob)
1604 
1605 /* Swap the variables of object <ob> into the swap file.
1606  * The simul_efun object is not swapped.
1607  *
1608  * This function might be called recursively through the garbagecollector.
1609  * In that case it completes the swap operation begun before.
1610  *
1611  * Return TRUE on success, FALSE else.
1612  */
1613 
1614 {
1615     char *start;
1616     p_int total_size;
1617     varblock_t *block;
1618     p_int swap_num;
1619     unsigned short num_variables;
1620 
1621 #define VARBLOCK_STARTSIZE 0x800
1622 
1623 
1624     if (!ob->variables)
1625         return MY_TRUE;
1626 
1627     if (ob == simul_efun_object)
1628         return MY_TRUE;
1629 
1630     if (gc_status)
1631     {
1632         /* During a GC, the swapper is called in close swap-in/swap-out
1633          * sequences. To minimized interaction with the allocator,
1634          * the swap out only has to check if svalues changed due to
1635          * the GC; otherwise it is sufficient to just pretend to swap
1636          * out and free the associated memory.
1637          */
1638         num_variables = ob->prog->num_variables;
1639         last_changed_swapped_svalue = NULL;
1640         (void)free_swapped_svalues(
1641           ob->variables, num_variables, last_variable_block
1642         );
1643 
1644         if (last_changed_swapped_svalue)
1645         {
1646             if (fseek(swap_file, last_variable_swap_num + sizeof(p_int), 0) ==
1647                                                                             -1)
1648             {
1649                 fatal("Couldn't seek the swap file, errno %d, offset %"
1650                     PRIdMPINT".\n",
1651                     errno, last_variable_swap_num + sizeof(p_int));
1652             }
1653             if (fwrite(
1654                   last_variable_block,
1655                   last_changed_swapped_svalue - (char *)last_variable_block,
1656                   1, swap_file) != 1)
1657             {
1658                 fatal("I/O error in swap.\n");
1659             }
1660         }
1661         mb_free(mbSwap);
1662         xfree(ob->variables);
1663         ob->variables = (svalue_t *)(last_variable_swap_num | 1);
1664         ob->flags |= O_SWAPPED;
1665 
1666 #ifdef CHECK_OBJECT_STAT
1667         if (check_object_stat)
1668         {
1669             fprintf(stderr, "DEBUG: OSTAT: (%ld:%ld) swapout( %p '%s') gc %d "
1670                 "vars : %ld -> (%ld:%ld)\n",
1671                 tot_alloc_object, tot_alloc_object_size, ob,
1672                 ob->name ? get_txt(ob->name) : "<null>",
1673                 num_variables, (long)(num_variables * sizeof (svalue_t)),
1674                 tot_alloc_object,
1675                 tot_alloc_object_size - (num_variables * sizeof (svalue_t))
1676                 );
1677         }
1678 #endif
1679         tot_alloc_object_size -= num_variables * sizeof (svalue_t);
1680 
1681         return MY_TRUE;
1682     }
1683 
1684     /* Get the number of variables from the program without
1685      * swapping it in.
1686      */
1687     swap_num = (p_int)ob->prog;
1688     if (swap_num & 1)
1689     {
1690         swap_num &= ~1;
1691         swap_num += offsetof(program_t, num_variables);
1692         if (swapfile_size <= swap_num)
1693             fatal("Attempt to swap in from beyond the end of the swapfile.\n");
1694         if (fseek(swap_file, swap_num, 0) == -1)
1695             fatal("Couldn't seek the swap file, errno %d, offset %"
1696                 PRIdPINT".\n", errno, swap_num);
1697         if (fread(&num_variables, sizeof num_variables, 1, swap_file)
1698             != 1)
1699         {
1700             fatal("Couldn't read the swap file.\n");
1701         }
1702     }
1703     else
1704     {
1705         num_variables = ob->prog->num_variables;
1706     }
1707 
1708     /* Allocate the initial varblock and initialize it
1709      */
1710     start = mb_alloc(mbSwap, VARBLOCK_STARTSIZE + sizeof(varblock_t));
1711     if (!start)
1712         return MY_FALSE;
1713     block = (varblock_t *)(start + VARBLOCK_STARTSIZE);
1714     block->current = (unsigned char *)start + sizeof total_size;
1715     block->rest = VARBLOCK_STARTSIZE - sizeof total_size;
1716     block->start = start;
1717 
1718     /* Store the values */
1719     block = swap_svalues(ob->variables, num_variables, block);
1720     if (!block->current)
1721     {
1722         /* Oops */
1723         mb_free(mbSwap);
1724         return MY_FALSE;
1725     }
1726 
1727     /* Store the block's total size in the first word of the block */
1728     *(p_int*)block->start = total_size =
1729       (((char *)block->current - block->start) + (sizeof(p_int) - 1)) &
1730         (~(sizeof(p_int) - 1));
1731 
1732     /* Write the values */
1733     swap_num = store_swap_block(block->start, total_size);
1734     if (swap_num  == -1)
1735     {
1736         mb_free(mbSwap);
1737         return MY_FALSE;
1738     }
1739 
1740     /* Free the swapped values */
1741     (void)free_swapped_svalues(
1742       ob->variables, num_variables
1743       , (unsigned char *)block->start + sizeof total_size
1744     );
1745 
1746     num_vb_swapped++;
1747     total_vb_bytes_swapped += total_size - sizeof total_size;
1748     mb_free(mbSwap);
1749     xfree(ob->variables);
1750 #ifdef CHECK_OBJECT_STAT
1751     if (check_object_stat)
1752     {
1753         fprintf(stderr, "DEBUG: OSTAT: (%ld:%ld) swapout( %p '%s') %d "
1754             "vars : %ld -> (%ld:%ld)\n",
1755             tot_alloc_object, tot_alloc_object_size, ob,
1756             ob->name ? get_txt(ob->name) : "<null>",
1757             num_variables, (long)(num_variables * sizeof (svalue_t)),
1758             tot_alloc_object,
1759             tot_alloc_object_size - (num_variables * sizeof (svalue_t))
1760             );
1761     }
1762 #endif
1763     tot_alloc_object_size -= num_variables * sizeof (svalue_t);
1764 
1765     /* Mark the variables as swapped */
1766     ob->variables = (svalue_t *)(swap_num | 1);
1767     ob->flags |= O_SWAPPED;
1768     return MY_TRUE;
1769 
1770 #undef VARBLOCK_STARTSIZE
1771 
1772 } /* swap_variables() */
1773 
1774 /*-------------------------------------------------------------------------*/
1775 Bool
swap(object_t * ob,int mode)1776 swap (object_t *ob, int mode)
1777 
1778 /* Swap the object <ob> according to <mode>:
1779  *
1780  *   <mode> & 0x01: swap program
1781  *   <mode> & 0x02: swap variables
1782  *
1783  * The same flags are returned by load_ob_from_swap().
1784  *
1785  * Result is TRUE if all requested swaps succeeded.
1786  */
1787 
1788 {
1789     Bool result = MY_TRUE;
1790 
1791     if (ob->flags & O_DESTRUCTED)
1792         return MY_FALSE;
1793 
1794     if (mode & 2)
1795     {
1796         result = swap_variables(ob) && result;
1797     }
1798     if (mode & 1)
1799     {
1800         result = swap_program(ob) && result;
1801     }
1802     return result;
1803 } /* swap() */
1804 
1805 /*-------------------------------------------------------------------------*/
1806 static INLINE void
clear_svalues(svalue_t * svp,mp_int num)1807 clear_svalues (svalue_t *svp, mp_int num)
1808 
1809 /* Auxiliary function: clear all <num> svalues starting at <svp> to 0.
1810  */
1811 
1812 {
1813     for (; --num >= 0;) {
1814         *svp++ = const0;
1815     }
1816 } /* clear_svalues() */
1817 
1818 /*-------------------------------------------------------------------------*/
1819 static unsigned char *
read_unswapped_svalues(svalue_t * svp,mp_int num,unsigned char * p)1820 read_unswapped_svalues (svalue_t *svp, mp_int num, unsigned char *p)
1821 
1822 /* Restore the <num> swapped values into <svp>, reading from the buffer
1823  * position <p>.
1824  *
1825  * Note: when garbage collection is done, restoring strings would give nothing
1826  * but trouble, thus, a dummy number is inserted instead.
1827  *
1828  * Return the next byte to read, or NULL when out of memory.
1829  */
1830 
1831 {
1832     mp_int          max_num = num;
1833     unsigned char * block = p;
1834 
1835     size_t          swapsize;
1836     unsigned char * start;  /* Start value of <p> for swapsize checks */
1837 
1838 #   define GET_SWAPSIZE() \
1839         start = p; \
1840         memcpy(&swapsize, p, sizeof(swapsize)); \
1841         p += sizeof(swapsize);
1842 
1843 #   define CHECK_SWAPSIZE() \
1844         if (start + swapsize != p) \
1845         { \
1846             dump_swapped_values(max_num, block, 0); \
1847             fatal("svalue type %d: expected %zu bytes, read %zu (%p .. %p)\n" \
1848                  , (int)svp->type, swapsize \
1849                  , (size_t)(p - start), start, p \
1850                 ); \
1851         }
1852 
1853     /* For all values yadda yadda... */
1854     for (;--num >= 0; svp++)
1855     {
1856         svp->type = *p & ~T_MOD_SWAPPED; /* get the original type */
1857 
1858         switch(*p++)
1859         {
1860         case T_STRING | T_MOD_SWAPPED:
1861         case T_SYMBOL | T_MOD_SWAPPED:
1862           {
1863             string_t *s;
1864             mp_int    len;
1865 
1866             memcpy(&svp->x, p, sizeof svp->x);
1867             p += sizeof svp->x;
1868             memcpy(&len, p, sizeof len);
1869             p += sizeof len;
1870             if (gc_status)
1871             {
1872                 svp->type = T_NUMBER;
1873             }
1874             else
1875             {
1876                 if (svp->type == T_STRING
1877                  && svp->x.generic != 0)
1878                 {
1879                     s = new_n_mstring((char *)p, len);
1880                 }
1881                 else
1882                 {
1883                     s = new_n_tabled((char *)p, len);
1884                 }
1885 
1886                 if (!s)
1887                 {
1888                     clear_svalues(svp, num + 1);
1889                     return NULL;
1890                 }
1891 
1892                 svp->u.str = s;
1893             }
1894             p += len;
1895             break;
1896           }
1897 
1898         case T_QUOTED_ARRAY | T_MOD_SWAPPED:
1899             memcpy(&svp->x, p, sizeof svp->x);
1900             p += sizeof svp->x;
1901             /* FALLTHROUGH */
1902 
1903         case T_POINTER | T_MOD_SWAPPED:
1904           {
1905             size_t size;
1906             wiz_list_t *user;
1907             vector_t *v;
1908 
1909             GET_SWAPSIZE();
1910             memcpy(&size, p, sizeof size);
1911             p += sizeof size;
1912             memcpy(&user, p, sizeof user);
1913             p += sizeof user;
1914             current_object->user = user;
1915             v = allocate_array_unlimited(size);
1916             svp->u.vec = v;
1917             if (!v)
1918             {
1919                 clear_svalues(svp, num + 1);
1920                 return NULL;
1921             }
1922             p = read_unswapped_svalues(v->item, size, p);
1923             if (!p)
1924             {
1925                 clear_svalues(svp + 1, num);
1926                 return NULL;
1927             }
1928             CHECK_SWAPSIZE();
1929 #ifdef GC_SUPPORT
1930             if (gc_status == gcCountRefs)
1931             {
1932                 /* Pretend that this memory block already existing
1933                  * in the clear phase.
1934                  */
1935                 clear_memory_reference(v);
1936                 v->ref = 0;
1937             }
1938 #endif
1939             break;
1940           }
1941 
1942 #ifdef USE_STRUCTS
1943         case T_STRUCT | T_MOD_SWAPPED:
1944           {
1945             wiz_list_t *user;
1946             struct_t *st;
1947             struct_type_t *stt;
1948 
1949             GET_SWAPSIZE();
1950             memcpy(&stt, p, sizeof stt);
1951             p += sizeof stt;
1952             memcpy(&user, p, sizeof user);
1953             p += sizeof user;
1954             current_object->user = user;
1955             st = struct_new(stt);
1956             (void)deref_struct_type(stt); /* just reactivate the old ref */
1957             svp->u.strct = st;
1958             if (!st)
1959             {
1960                 clear_svalues(svp, num + 1);
1961                 return NULL;
1962             }
1963             p = read_unswapped_svalues(st->member, struct_size(st), p);
1964             if (!p)
1965             {
1966                 clear_svalues(svp + 1, num);
1967                 return NULL;
1968             }
1969             CHECK_SWAPSIZE();
1970 #ifdef GC_SUPPORT
1971             if (gc_status == gcCountRefs)
1972             {
1973                 /* Pretend that this memory block was already existing
1974                  * in the clear phase.
1975                  */
1976                 clear_memory_reference(st);
1977                 st->ref = 0;
1978             }
1979 #endif
1980             break;
1981           }
1982 #endif /* USE_STRUCTS */
1983 
1984         case T_MAPPING | T_MOD_SWAPPED:
1985           {
1986             mapping_t *m;
1987             p_int num_values;
1988             wiz_list_t *user;
1989             p_int num_keys;
1990 
1991             GET_SWAPSIZE();
1992             memcpy(&num_values, p, sizeof num_values);
1993             p += sizeof num_values;
1994             memcpy(&num_keys, p, sizeof num_keys);
1995             p += sizeof num_keys;
1996             memcpy(&user, p, sizeof user);
1997             p += sizeof user;
1998             if (gc_status)
1999             {
2000                 /* The garbage collector is not prepared to handle hash
2001                  * mappings. On the other hand, the order of keys does
2002                  * not matter here.
2003                  * We can assume here that all allocation functions succeed
2004                  * because the garbage collector runs with
2005                  * malloc_privilege == MALLOC_SYSTEM .
2006                  */
2007                 mapping_cond_t *cm;
2008                 mp_int size;
2009                 svalue_t *data, *svp2;
2010 
2011                 m = allocate_cond_mapping(user, num_keys, num_values);
2012                 svp->u.map = m;
2013                 if (m->cond)
2014                 {
2015                     cm = m->cond;
2016 
2017                     svp2 = &(cm->data[0]);
2018                     size = cm->size;
2019                     data = COND_DATA(cm, 0, num_values);
2020                     while ( --size >= 0) {
2021                         p = read_unswapped_svalues(svp2++, 1, p);
2022                         p = read_unswapped_svalues(data, num_values, p);
2023                         data += num_values;
2024                     }
2025 #ifdef GC_SUPPORT
2026                     if (gc_status == gcCountRefs)
2027                     {
2028                         /* Pretend that this memory block was already existing
2029                          * in the clear phase.
2030                          */
2031                         clear_memory_reference(m);
2032                         clear_memory_reference(cm);
2033                         m->ref = 0;
2034                     }
2035 #endif
2036                 }
2037             }
2038             else
2039             {
2040                 mp_int i;
2041                 wiz_list_t *save;
2042 
2043                 save = current_object->user;
2044                 current_object->user = user;
2045                 m = allocate_mapping(num_keys, num_values);
2046                 current_object->user = save;
2047                 if (!m)
2048                 {
2049                     clear_svalues(svp, num + 1);
2050                     return NULL;
2051                 }
2052                 svp->u.map = m;
2053                 for (i = num_keys; --i >= 0;)
2054                 {
2055                     svalue_t sv, *data;
2056 
2057                     p = read_unswapped_svalues(&sv, 1, p); /* adds 1 ref */
2058                     if (!p)
2059                         break;
2060                     data = get_map_lvalue_unchecked(m, &sv); /* adds another ref */
2061                     free_svalue(&sv);
2062                     if (!data)
2063                         break;
2064                     p = read_unswapped_svalues(data, num_values, p);
2065                     if (!p)
2066                         break;
2067                 } /* for() */
2068                 if (!p)
2069                 {
2070                     clear_svalues(svp + 1, num);
2071                     return NULL;
2072                 }
2073             }
2074             CHECK_SWAPSIZE();
2075             break;
2076           }
2077 
2078         case T_STRING:
2079         case T_SYMBOL:
2080         case T_POINTER:
2081 #ifdef USE_STRUCTS
2082         case T_STRUCT:
2083 #endif /* USE_STRUCTS */
2084         case T_QUOTED_ARRAY:
2085         case T_MAPPING:
2086         case T_NUMBER:
2087         case T_FLOAT:
2088         case T_OBJECT:
2089         case T_CLOSURE:
2090             memcpy(&svp->x, p, sizeof svp->x);
2091             p += sizeof svp->x;
2092             memcpy(&svp->u, p, sizeof svp->u);
2093             p += sizeof svp->u;
2094             break;
2095 
2096         default:
2097             dump_swapped_values(max_num, block, 0);
2098             fatal("bad type %d in read_unswapped_svalues()\n", svp->type);
2099         }
2100     } /* for() */
2101 
2102     return p;
2103 
2104 #   undef GET_SWAPSIZE
2105 #   undef CHECK_SWAPSIZE
2106 } /* read_unswapped_svalues() */
2107 
2108 /*-------------------------------------------------------------------------*/
2109 static void
dummy_handler(const char * fmt UNUSED,...)2110 dummy_handler(const char * fmt UNUSED, ...)
2111 
2112 /* Dummy error handler for array allocations in a swap-in.
2113  */
2114 
2115 {
2116 #ifdef __MWERKS__
2117 #    pragma unused(fmt)
2118 #endif
2119 } /* dummy_handler() */
2120 
2121 /*-------------------------------------------------------------------------*/
2122 int
load_ob_from_swap(object_t * ob)2123 load_ob_from_swap (object_t *ob)
2124 
2125 /* Load an object <ob> from the swap, both variables and program (without
2126  * the linenumbers).
2127  * The swap block for the variables is removed, the program swap block
2128  * is kept.
2129  *
2130  * Results are: 0: object was not swapped out
2131  *              > 0: object swapped in
2132  *              < 0: out of memory.
2133  *
2134  * The result (both positive and negative) can be interpreted
2135  * more detailed as well:
2136  *
2137  *    result & 0x01: program swapped in
2138  *    result & 0x02: variables swapped in
2139  *
2140  * The same flags are accepted by swap() as argument.
2141  */
2142 
2143 {
2144     p_int swap_num;
2145     int result;
2146 
2147     result = 0;
2148 
2149     swap_num = (p_int)ob->prog;
2150     if (swap_num & 1)
2151     {
2152         /* Swap in the program */
2153 
2154         program_t tmp_prog, *prog;
2155 
2156         swap_num &= ~1;
2157 
2158         if (swapfile_size <= swap_num)
2159             fatal("Attempt to swap in from beyond the end of the swapfile.\n");
2160         if (fseek(swap_file, swap_num, 0) == -1)
2161             fatal("Couldn't seek the swap file, errno %d, offset %"
2162                 PRIdPINT".\n", errno, swap_num);
2163         if (d_flag > 1)
2164         {
2165             debug_message("%s Unswap object %s (ref %"PRIdPINT")\n",
2166                 time_stamp(), get_txt(ob->name), ob->ref);
2167         }
2168 
2169         /* The size of the program is unkown, so read first part to
2170          * find out. For greater efficiency we read in the full program_t
2171          * structure.
2172          */
2173         if (fread(&tmp_prog, sizeof tmp_prog, 1, swap_file) != 1)
2174         {
2175             fatal("Couldn't read the swap file.\n");
2176         }
2177         tmp_prog.swap_num = swap_num;
2178 
2179         /* Allocate the memory for the program, except for the
2180          * line numbers.
2181          */
2182         if ( !(prog = xalloc(tmp_prog.total_size)) )
2183             return -0x80;
2184         memcpy(prog, &tmp_prog, sizeof tmp_prog);
2185 
2186         /* Read in the rest of the program */
2187         if (tmp_prog.total_size - sizeof tmp_prog)
2188         {
2189             if (fread( ((char *)prog) + sizeof tmp_prog,
2190               tmp_prog.total_size - sizeof tmp_prog, 1, swap_file) != 1)
2191             {
2192                 fatal("Couldn't read the swap file.\n");
2193             }
2194         }
2195 
2196         ob->prog = prog;
2197         locate_in (prog); /* relocate the internal pointers */
2198         prog->line_numbers = NULL;
2199 
2200         /* The reference count will already be 1 ! */
2201 
2202         total_bytes_unswapped += ob->prog->total_size;
2203         num_unswapped++;
2204         total_prog_block_size += ob->prog->total_size;
2205         total_num_prog_blocks += 1;
2206         result = 1;
2207     }
2208 
2209     swap_num = (p_int)ob->variables;
2210     if (swap_num & 1)
2211     {
2212         /* Swap in the variables */
2213 
2214         p_int total_size;
2215         unsigned char *block;
2216         mp_int size;
2217         svalue_t *variables;
2218         object_t dummy;
2219         object_t *save_current = current_object;
2220         void (*save_handler)(const char *, ...);
2221 
2222         swap_num &= ~1;
2223         if (swapfile_size <= swap_num)
2224             fatal("Attempt to swap in from beyond the end of the swapfile.\n");
2225         if (fseek(swap_file, swap_num, 0) == -1)
2226             fatal("Couldn't seek the swap file, errno %d, offset %"
2227                 PRIdPINT".\n", errno, swap_num);
2228         if (d_flag > 1)
2229         {
2230             debug_message("%s Unswap variables of %s\n", time_stamp()
2231                          , get_txt(ob->name));
2232         }
2233 
2234         /* Read the size of the block from the file */
2235         if (fread(&total_size, sizeof total_size, 1, swap_file) != 1)
2236         {
2237             fatal("Couldn't read the swap file.\n");
2238         }
2239         size = total_size - sizeof total_size;
2240 
2241         /* Allocate the memory buffer */
2242         block = (unsigned char *) mb_alloc(mbSwap, size);
2243         if ( !block)
2244             return result | -0x80;
2245 
2246         /* Allocate the variable space */
2247         if ( !(variables = xalloc(
2248                 sizeof(svalue_t) * ob->prog->num_variables
2249         )) )
2250         {
2251             mb_free(mbSwap);
2252             return result | -0x80;
2253         }
2254 
2255         fread(block, size, 1, swap_file);
2256 
2257         /* Prepare to restore */
2258         current_object = &dummy;
2259 #ifdef MALLOC_LPC_TRACE
2260         dummy.name = ob->name;
2261         dummy.prog = ob->prog;
2262 #endif
2263         save_handler = allocate_array_error_handler;
2264         allocate_array_error_handler = dummy_handler;
2265         if (read_unswapped_svalues(variables, ob->prog->num_variables, block))
2266         {
2267             ob->variables = variables;
2268             result |= 2;
2269 #ifdef CHECK_OBJECT_STAT
2270             if (check_object_stat)
2271             {
2272                 fprintf(stderr, "DEBUG: OSTAT: (%ld:%ld) swapin( %p '%s') %d "
2273                     "vars : %ld -> (%ld:%ld)\n",
2274                     tot_alloc_object, tot_alloc_object_size, ob,
2275                     ob->name ? get_txt(ob->name) : "<null>",
2276                     ob->prog->num_variables,
2277                     (long)(ob->prog->num_variables * sizeof (svalue_t)),
2278                     tot_alloc_object, tot_alloc_object_size +
2279                       (ob->prog->num_variables * sizeof (svalue_t))
2280                     );
2281             }
2282 #endif
2283             tot_alloc_object_size += ob->prog->num_variables * sizeof (svalue_t);
2284 
2285             if (gc_status)
2286             {
2287                 /* During a GC, the swapper is called in close swap-in/swap-out
2288                  * sequences. To minimized interaction with the allocator,
2289                  * the memory blocks are kept for now, and freed during the
2290                  * 'swap out'.
2291                  */
2292                 last_variable_block = block;
2293                 last_variable_swap_num = swap_num;
2294             }
2295             else
2296             {
2297                 mb_free(mbSwap);
2298                 swap_free(swap_num);
2299                 num_vb_swapped--;
2300                 total_vb_bytes_swapped -= total_size - sizeof total_size;
2301             }
2302         }
2303         else
2304         {
2305             /* Out of memory */
2306 #ifdef CHECK_OBJECT_STAT
2307             if (check_object_stat)
2308             {
2309                 fprintf(stderr, "DEBUG: OSTAT: (%ld:%ld) swapin( %p '%s') %d "
2310                     "vars failed\n",
2311                     tot_alloc_object, tot_alloc_object_size, ob,
2312                     ob->name ? get_txt(ob->name) : "<null>",
2313                     ob->prog->num_variables);
2314             }
2315 #endif
2316 
2317             mb_free(mbSwap);
2318             result |= -0x80;
2319         }
2320 
2321         current_object = save_current;
2322         allocate_array_error_handler = save_handler;
2323     }
2324 
2325     if (!result)
2326         fatal("Loading unswapped object from swap.\n");
2327 
2328     /* Update the object flags */
2329     ob->flags &= ~O_SWAPPED;
2330 
2331     return result;
2332 } /* load_ob_from_swap() */
2333 
2334 /*-------------------------------------------------------------------------*/
2335 Bool
load_line_numbers_from_swap(program_t * prog)2336 load_line_numbers_from_swap (program_t *prog)
2337 
2338 /* Load the line numbers for program <prog> from the swap.
2339  * Result is TRUE on success.
2340  */
2341 
2342 {
2343     linenumbers_t tmp_numbers;
2344     linenumbers_t *lines;
2345     p_int swap_num;
2346 
2347     swap_num = prog->swap_num + prog->total_size;
2348 
2349     if (swapfile_size <= swap_num)
2350         fatal("Attempt to swap in from beyond the end of the swapfile.\n");
2351     if (fseek(swap_file, swap_num, 0) == -1)
2352         fatal("Couldn't seek the swap file, errno %d, offset %"
2353             PRIdPINT".\n", errno, swap_num);
2354     if (fread((char *)&tmp_numbers, sizeof tmp_numbers, 1, swap_file) != 1) {
2355         fatal("Couldn't read the swap file.\n");
2356     }
2357 
2358     if ( !(lines = xalloc(tmp_numbers.size)) )
2359         return MY_FALSE;
2360 
2361     *lines = tmp_numbers;
2362 
2363     if (tmp_numbers.size > sizeof(tmp_numbers))
2364     {
2365         fread(lines+1, tmp_numbers.size - sizeof(tmp_numbers)
2366              , 1, swap_file);
2367     }
2368 
2369     prog->line_numbers = lines;
2370     total_prog_block_size += lines->size;
2371     total_bytes_unswapped += lines->size;
2372 
2373     return MY_TRUE;
2374 } /* load_line_numbers_from_swap() */
2375 
2376 /*-------------------------------------------------------------------------*/
2377 void
remove_prog_swap(program_t * prog,Bool load_line_numbers)2378 remove_prog_swap (program_t *prog, Bool load_line_numbers)
2379 
2380 /* Program <prog> is going to be deleted or has been changed - remove its
2381  * swapfile entry if it has one. If <load_line_numbers> is true, load
2382  * the line number information back into memory before removing the swap entry.
2383  */
2384 
2385 {
2386     p_int swap_num;
2387 
2388     swap_num = prog->swap_num;
2389 
2390     if (swap_num == -1) /* then program not swapped */
2391         return;
2392 
2393     /* This test is good not only for debugging, but also when the
2394      * processor is on fire, to stop subsequent damage.
2395      */
2396     if (swapfile_size <= swap_num)
2397         fatal("Attempt to remove swap entry beyond the end of the swapfile.\n");
2398 
2399     if (!prog->line_numbers && load_line_numbers)
2400     {
2401         if (!load_line_numbers_from_swap(prog))
2402             fatal("Can't unswap the line numbers.\n");
2403     }
2404 
2405     if (!prog->line_numbers)
2406     {
2407         /* The linenumber information has not been unswapped, thus
2408          * we need to read the linenumber size directly from the
2409          * swapfile.
2410          */
2411         linenumbers_t tmp_lines;
2412 
2413         if (fseek(swap_file, swap_num + prog->total_size, 0 ) == -1)
2414             fatal("Couldn't seek the swap file, errno %d, offset %"
2415                 PRIdPINT".\n", errno, swap_num);
2416         if (fread(&tmp_lines, sizeof tmp_lines, 1, swap_file) != 1)
2417         {
2418             fatal("Couldn't read the swap file.\n");
2419         }
2420         total_bytes_swapped -= tmp_lines.size;
2421     }
2422     else
2423     {
2424         total_bytes_unswapped -= prog->line_numbers->size;
2425         total_bytes_swapped -= prog->line_numbers->size;
2426     }
2427 
2428     swap_free(prog->swap_num);
2429     total_bytes_unswapped -= prog->total_size;
2430     total_bytes_swapped -= prog->total_size;
2431     num_unswapped--;
2432     num_swapped--;
2433     prog->swap_num = -1;
2434 } /* remove_prog_swap() */
2435 
2436 /*-------------------------------------------------------------------------*/
2437 void
name_swap_file(const char * name)2438 name_swap_file (const char *name)
2439 
2440 /* Set the swap file name to a copy of <name>.
2441  */
2442 
2443 {
2444     xstrncpy(file_name, name, sizeof file_name);
2445     file_name[sizeof file_name - 1] = '\0';
2446 } /* name_swap_file()*/
2447 
2448 /*-------------------------------------------------------------------------*/
2449 void
unlink_swap_file(void)2450 unlink_swap_file (void)
2451 
2452 /* Called at shutdown: Remove the swap file.
2453  */
2454 
2455 {
2456     if (swap_file == NULL)
2457         return;
2458     unlink(file_name);
2459     fclose(swap_file);
2460 } /* unlink_swap_file() */
2461 
2462 /*-------------------------------------------------------------------------*/
2463 size_t
swap_overhead(void)2464 swap_overhead (void)
2465 
2466 /* Return the overhead size of the swap structures.
2467  */
2468 
2469 {
2470     return num_swap_structs * sizeof(swap_block_t);
2471 } /* swap_overhead() */
2472 
2473 /*-------------------------------------------------------------------------*/
2474 void
swap_status(strbuf_t * sbuf)2475 swap_status (strbuf_t *sbuf)
2476 
2477 /* Add the information for "status swap" to the stringbuffer <sbuf>.
2478  */
2479 
2480 {
2481     /* maximum seen so far: 28574 var blocks swapped,   32754860 bytes */
2482     strbuf_addf(sbuf, "%10"PRIdMPINT" prog blocks swapped, %13"PRIdMPINT" bytes\n"
2483                       "%10"PRIdMPINT" prog blocks unswapped,%12"PRIdMPINT" bytes\n"
2484                       "%10"PRIdMPINT" var blocks swapped,%15"PRIdMPINT" bytes\n"
2485                       "%10"PRIdMPINT" free blocks in swap,%14"PRIdMPINT" bytes\n"
2486                       "Swapfile size:%31"PRIdMPINT" bytes\n"
2487                 , num_swapped - num_unswapped
2488                 , total_bytes_swapped - total_bytes_unswapped
2489                 , num_unswapped, total_bytes_unswapped
2490                 , num_vb_swapped, total_vb_bytes_swapped
2491                 , num_swapfree, total_bytes_swapfree
2492                 , swapfile_size
2493     );
2494     strbuf_addf(sbuf, "Total reused space:%26"PRIdMPINT" bytes\n\n"
2495                     , total_swap_reused);
2496     strbuf_addf(sbuf
2497                , "Swap: searches: %10ld average search length: %3.1f\n"
2498                  "Free: searches: %10ld average search length: %3.1f\n"
2499                , swap_num_searches
2500                , (double)swap_total_searchlength /
2501                  ( swap_num_searches ? swap_num_searches : 1 )
2502                , swap_free_searches
2503                , (double)swap_free_searchlength /
2504                  ( swap_free_searches ? swap_free_searches : 1 )
2505     );
2506     strbuf_addf(sbuf, "Overhead: %"PRIdMPINT" blocks using %"
2507         PRIdMPINT" bytes.\n",
2508         num_swap_structs, num_swap_structs * sizeof(swap_block_t) );
2509     strbuf_addf(sbuf, "Mode: %s - Freespace recycling: %s\n"
2510                , swap_compact_mode ? "compact" : "non-compact"
2511                , (recycle_free_space || !swap_compact_mode) ? "on" : "off"
2512     );
2513 } /* swap_status() */
2514 
2515 /*-------------------------------------------------------------------------*/
2516 void
swap_dinfo_data(svalue_t * svp,int value)2517 swap_dinfo_data (svalue_t *svp, int value)
2518 
2519 /* Fill in the data for debug_info(DINFO_DATA, DID_SWAP)
2520  * into the svalue block <svp>.
2521  * If <value> is -1, <svp> points indeed to a value block; other it is
2522  * the index of the desired value and <svp> points to a single svalue.
2523  */
2524 
2525 {
2526 #define ST_NUMBER(which,code) \
2527     if (value == -1) svp[which].u.number = code; \
2528     else if (value == which) svp->u.number = code
2529 
2530     ST_NUMBER(DID_SW_PROGS, num_swapped - num_unswapped);
2531     ST_NUMBER(DID_SW_PROG_SIZE, total_bytes_swapped - total_bytes_unswapped);
2532     ST_NUMBER(DID_SW_PROG_UNSWAPPED, num_unswapped);
2533     ST_NUMBER(DID_SW_PROG_U_SIZE, total_bytes_unswapped);
2534     ST_NUMBER(DID_SW_VARS, num_vb_swapped);
2535     ST_NUMBER(DID_SW_VAR_SIZE, total_vb_bytes_swapped);
2536     ST_NUMBER(DID_SW_FREE, num_swapfree);
2537     ST_NUMBER(DID_SW_FREE_SIZE, total_bytes_swapfree);
2538     ST_NUMBER(DID_SW_FILE_SIZE, swapfile_size);
2539     ST_NUMBER(DID_SW_REUSED, total_swap_reused);
2540     ST_NUMBER(DID_SW_SEARCHES, swap_num_searches);
2541     ST_NUMBER(DID_SW_SEARCH_LEN, swap_total_searchlength);
2542     ST_NUMBER(DID_SW_F_SEARCHES, swap_free_searches);
2543     ST_NUMBER(DID_SW_F_SEARCH_LEN, swap_free_searchlength);
2544     ST_NUMBER(DID_SW_COMPACT, swap_compact_mode);
2545     ST_NUMBER(DID_SW_RECYCLE_FREE, recycle_free_space);
2546 
2547 #undef ST_NUMBER
2548 } /* swap_dinfo_data() */
2549 
2550 /***************************************************************************/
2551 
2552