home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-19.28-src.tgz / tar.out / fsf / emacs / src / amiga_dump.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  36KB  |  1,530 lines
  1. #include <exec/types.h>
  2. #include <fcntl.h>
  3. #include <stdio.h>
  4. #include <assert.h>
  5. #include <proto/dos.h>
  6. #include <setjmp.h>
  7. #include <internal/messages.h>
  8. #include "config.h"
  9. #include "lisp.h"
  10. #include "buffer.h"
  11. #include "regex.h"
  12. #include "amiga.h"
  13. #include "dispextern.h"
  14. #include "termchar.h"
  15. #include "paths.h"
  16. #include "frame.h"
  17.  
  18. #ifdef USE_PROTOS
  19. #include "protos.h"
  20. #endif
  21.  
  22. #define RANGE(ptr, s, e) ((char *)ptr >= (char *)s && (char *)ptr < (char *)e)
  23. #define HUNK_POS (VALBITS - 3)
  24. #define HUNK_MASK (7 << HUNK_POS)
  25. #define HUNK_CODE (0 << HUNK_POS)
  26. #define HUNK_DATA (1 << HUNK_POS)
  27. #define HUNK_BSS (2 << HUNK_POS)
  28. #define HUNK_MALLOC (3 << HUNK_POS)
  29. #define HUNK_PURE (4 << HUNK_POS)
  30. #define ARRAY_MARK_FLAG ((MARKBIT >> 1) & ~MARKBIT)
  31.  
  32. void *far first_fn = first_function, *far last_fn = last_function;
  33.  
  34. /* alloc.c */
  35. extern int *pure, puresize;
  36. extern struct gcpro *gcprolist;
  37. extern Lisp_Object *staticvec[];
  38. extern int staticidx;
  39. extern struct cons_block *cons_block;
  40. extern struct Lisp_Cons *cons_free_list;
  41. extern struct Lisp_Vector *all_vectors;
  42. extern struct symbol_block *symbol_block;
  43. extern struct Lisp_Symbol *symbol_free_list;
  44. extern struct marker_block *marker_block;
  45. extern struct Lisp_Marker *marker_free_list;
  46. extern struct interval_block *interval_block;
  47. extern INTERVAL interval_free_list;
  48. struct string_block_head
  49.   {
  50.     struct string_block_head *next, *prev;
  51.     int pos;
  52.   };
  53. struct string_block
  54.   {
  55.     struct string_block *next, *prev;
  56. #if 0 /* not needed */
  57.     int pos;
  58.     char chars[STRING_BLOCK_SIZE];
  59. #endif
  60.   };
  61. extern struct string_block *current_string_block;
  62. extern struct string_block *first_string_block;
  63. extern struct string_block *large_string_blocks;
  64. #ifdef LISP_FLOAT_TYPE
  65. extern struct float_block *float_block;
  66. extern struct Lisp_Float *float_free_list;
  67. #endif /* LISP_FLOAT_TYPE */
  68.  
  69. struct backtrace /* see eval.c or alloc.c */
  70.   {
  71.     struct backtrace *next;
  72.     Lisp_Object *function;
  73.     Lisp_Object *args;    /* Points to vector of args. */
  74.     int nargs;        /* Length of vector.
  75.                If nargs is UNEVALLED, args points to slot holding
  76.                list of unevalled args */
  77.     char evalargs;
  78.     /* Nonzero means call value of debugger when done with this operation. */
  79.     char debug_on_exit;
  80.   };
  81. extern struct backtrace *backtrace_list;
  82. struct catchtag
  83.   {
  84.     Lisp_Object tag;
  85.     Lisp_Object val;
  86.     struct catchtag *next;
  87.     struct gcpro *gcpro;
  88.     jmp_buf jmp;
  89.     struct backtrace *backlist;
  90.     struct handler *handlerlist;
  91.     int lisp_eval_depth;
  92.     int pdlcount;
  93.     int poll_suppress_count;
  94.   };
  95. extern struct catchtag *catchlist;
  96. extern char *stack_copy;
  97.  
  98. extern int *kbd_macro_buffer;
  99. extern char *read_buffer, *chars_wasted, *copybuf;
  100. #if 0
  101. extern struct minibuf_save_data *minibuf_save_vector;
  102. #endif
  103. extern struct re_pattern_buffer searchbuf;
  104. #if 0 /* CHFIXME */
  105. extern int *ILcost, *DLcost, *ILncost, *DLncost;
  106. #endif
  107. #if 0
  108. extern Lisp_Object MouseMap, global_map, Vglobal_map, Vesc_map, Vctl_x_map;
  109. #else
  110. extern Lisp_Object global_map, meta_map, control_x_map;
  111. #endif
  112. extern Lisp_Object selected_window;
  113.  
  114. extern char *callint_argfuns[];
  115.  
  116. /* lread.c/init_obarray variables */
  117. extern Lisp_Object Qvariable_documentation, Vpurify_flag;
  118.  
  119. /* eval.c/init_eval_once variables */
  120. /* specpdl */
  121.  
  122. /* syntax.c/init_syntax_once */
  123. /* */
  124.  
  125. /* window.c variables */
  126. /* */
  127.  
  128.  
  129. /* buffer.c */
  130. /* -> buffer.h */
  131.  
  132. /* dired.c */
  133. extern Lisp_Object Qdirectory_files, Qfile_name_completion,
  134.     Qfile_name_all_completions, Qfile_attributes;
  135.  
  136. /* fileio.c */
  137. extern Lisp_Object Qset_visited_file_modtime;
  138.  
  139. /* process.c */
  140. /* extern Lisp_Object stream_process; CHFIXME activate HAVE_SOCKETS ?*/
  141.  
  142. /* editfns.c */
  143. extern char *message_text;
  144.  
  145. /* regex variables */
  146. typedef unsigned char *fail_stack_elt_t;
  147. typedef struct
  148. {
  149.   fail_stack_elt_t *stack;
  150.   unsigned size;
  151.   unsigned avail;            /* Offset of next open position.  */
  152. } fail_stack_type;
  153. typedef short register_info_type;
  154.  
  155. extern fail_stack_type fail_stack;
  156. extern const char **     regstart, **     regend;
  157. extern const char ** old_regstart, ** old_regend;
  158. extern const char **best_regstart, **best_regend;
  159. extern register_info_type *reg_info; 
  160. extern const char **reg_dummy;
  161. extern void *reg_info_dummy;
  162.  
  163. /* keyboard.c/variables CHFIXME: need to be checked on version change */
  164. #define HEAD_TABLE_SIZE 3
  165. #define SCROLL_BAR_PARTS_SIZE 3
  166. struct event_head {
  167.   Lisp_Object *var;
  168.   char *name;
  169.   Lisp_Object *kind;
  170. };
  171.  
  172. extern struct event_head head_table[];
  173. extern Lisp_Object *scroll_bar_parts[];
  174. extern struct input_event *kbd_fetch_ptr;
  175. extern struct input_event volatile *kbd_store_ptr;
  176.  
  177. /* search.c */
  178. extern struct re_registers search_regs;
  179.  
  180. #if 0
  181. #define DBUG /* dump debug */
  182. #endif
  183.  
  184. static char *dump_error_example[] =
  185. {
  186.     "dump-error-example-1",
  187.     "dump-error-example-2"
  188. };
  189.  
  190. static void cpr() {} /* CHFIXME */
  191.  
  192. static void *dump_malloc(int size)
  193. {
  194.   void *new = malloc(size);
  195.  
  196.   if (!new) no_memory();
  197.  
  198.   return new;
  199. }
  200.  
  201. static void bailout(char *fn)
  202. {
  203.   if (fn) _message("%s isn't a dump file for this version of Emacs, aborting", fn);
  204.   else _message("Dump file isn't for this version of Emacs, aborting");
  205.  
  206.   /* We are in deep trouble, as all our variables are potentially corrupt */
  207.   /* Therefore, no cleanup is possible */
  208.   /* Remove cleanup routines */
  209.   onexit(0);
  210.   /* However, the library & the memory allocation should be ok, so
  211.      we can exit reasonably */
  212.   _fail("Some system resources may have been lost");
  213. }
  214.  
  215. void print_ranges()
  216. {
  217. #if 0
  218.     _message("HUNK_CODE  : %08lx .. %08lx (%08lx)",
  219.          first_fn, last_fn, (char *) last_fn - (char *) first_fn);
  220.     _message("HUNK_DATA  : %08lx .. %08lx (%08lx)",
  221.          &first_data, &last_data, (char *) &last_data - (char *) &first_data);
  222.     _message("HUNK_BSS   : %08lx .. %08lx (%08lx)",
  223.          &first_bss, &last_bss, (char *) &last_bss - (char *) &first_bss);
  224.     _message("HUNK_PURE  : %08lx .. %08lx (%08lx)"
  225.          , pure, (char *)pure + puresize, puresize);
  226.     _message("HUNK_MALLOC: %08lx .. %08lx (%08lx)",
  227.          malloc_hunk, malloc_hunk + malloc_hunk_size, malloc_hunk_size);
  228. #endif
  229. }
  230.  
  231. /*
  232.  * ignore:
  233.  *    stack_bottom, IconBase, last_marked (array), interval_block_index (int)
  234.  *      gcprolist (currently?),
  235.  *    pending (list), returned (list)
  236.  */
  237.  
  238. int
  239. check_ignore(void *x)
  240. {
  241. #ifndef USE_PROTOS
  242.     extern int IconBase, IFFParseBase, interval_block_index, instream, cliphook;
  243. #else
  244.     extern int interval_block_index;
  245. #endif
  246.     
  247.     int ign = 0;
  248.     if((x == (void *) &IconBase)
  249.        || (x == (void *) &stack_bottom)
  250. /*        || (x == (void *) &interval_block_index) */
  251.        || (x == (void *) &pure)
  252.        || (x == (void *) &gcprolist)
  253.        || (x == (void *) &malloc_hunk)
  254.        || (x == (void *) &IFFParseBase)
  255.        || (x == (void *) &instream)
  256.        || (x == (void *) &cbuffer_pos)
  257.        || (x == (void *) &cliphook)
  258.        || (x == (void *) ((int *)&cliphook+1))
  259.        || (x == (void *) ((int *)&cliphook+2))
  260.        || (x == (void *) &specpdl_ptr)
  261.        || (x == (void *) &handlerlist) /* CHFIXME: ok? */
  262.        || (x == (void *) &catchlist) /* CHFIXME: ok? */
  263.        || (x == (void *) &backtrace_list) /* CHFIXME: ok? */
  264.        )
  265.     ign = 1;
  266.     
  267.     return ign;
  268. }
  269.  
  270. /*
  271.  *  test for candidates which may need extra handling on dump
  272.  */
  273. void
  274. check_cand(char *s, void *start, void *end)
  275. {
  276.     unsigned int *ip, *starthit = NULL, *lasthit = NULL;
  277.     unsigned short int *is;
  278.     int range = 0;
  279.     int de = ((unsigned)dump_error_example[0] >> 24);
  280.           
  281. #define FIRST ((char*) &first_data) /* first symbol in data hunk */
  282.  
  283.     for(is = start; (char *)is < (char *)end; is++)
  284.     {
  285.     ip = (unsigned int *) is;
  286.     if((((*ip >> 24) == 0x08)
  287.         || (*ip >> 24) == de)
  288.        && ! check_ignore(ip))
  289.     {
  290.         if(lasthit+1 == ip)
  291.         {
  292.         lasthit++;
  293.         range = 1;
  294.         }
  295.         else
  296.         {
  297.         if(range)
  298.         {
  299.             fprintf(stderr,"%s: 0x%08lx .. 0x%08lx (0x%08lx)\n",
  300.                 s,
  301.                 (char *)starthit-FIRST,
  302.                 (char *)lasthit-FIRST,
  303.                 (char*)lasthit-(char*)starthit);
  304.             range = 0;
  305.         }
  306.         else
  307.         {
  308.             starthit = lasthit = ip;
  309.         }
  310.         }
  311.     }
  312.     else
  313.     {
  314.         if((unsigned short *) lasthit+1 != is)
  315.         {
  316.         if(range)
  317.         {
  318.             fprintf(stderr,"%s: 0x%08lx .. 0x%08lx (0x%08lx)\n",
  319.                 s,
  320.                 (char *)starthit-FIRST,
  321.                 (char *)lasthit-FIRST,
  322.                 (char*)lasthit-(char*)starthit);
  323.         }
  324.         else if(lasthit)
  325.         {
  326.             fprintf(stderr,"%s: 0x%08lx (0x%08lx)\n", s, (char *)lasthit-FIRST, *lasthit);
  327.         }
  328.         range = 0;
  329.         lasthit = NULL;
  330.         }
  331.     }
  332.         
  333.     }
  334.     if(range)
  335.     {
  336.     fprintf(stderr,"%s: 0x%08lx .. 0x%08lx (0x%08lx)\n",
  337.         s,
  338.         (char *)starthit-FIRST,
  339.         (char *)lasthit-FIRST,
  340.         (char*)lasthit-(char*)starthit);
  341.     }
  342.     else if(lasthit)
  343.     {
  344.     fprintf(stderr,"%s: 0x%08lx\n (0x%08ls)", s, (char *)lasthit-FIRST, *lasthit);
  345.     }
  346. }
  347.  
  348. void
  349. check_cands(void)
  350. {
  351.     fprintf(stderr,"Possible candidates for FAR or amiga_dump\n");
  352.     check_cand("DATA", &first_data, &last_data);
  353.     check_cand("BSS ", &first_bss, &last_bss);
  354. }
  355.     
  356.  
  357. #ifdef DBUG
  358. static int mcol = 0;
  359. static int mrow = 0;
  360. static FILE *mfile;
  361. static char spaces[] = "                                                                                                                                                                   ";
  362. static mtresh = 0;
  363. void MInit(char *s)
  364. {
  365.     mcol = 0;
  366.     mrow = 0;
  367.     mtresh = 0;
  368.     mfile = fopen(s,"a");
  369.     fprintf(mfile,"\n***START***\n");
  370. }
  371. void MClean()
  372. {
  373.     fprintf(mfile,"\n**END**\n");
  374.     fclose(mfile);
  375. }
  376. #define P(x)
  377. void MEnter(char *s)
  378. {
  379.     if(mtresh > 100) return;
  380. #if 0
  381.     fwrite(spaces, mcol, 1, mfile);
  382. #endif
  383.     fprintf(mfile, "(%d) %s\n", mcol, s);
  384.     mcol += 1;
  385. }
  386. void  M(char *s)
  387. {
  388.     if(mtresh > 100) return;
  389.     mtresh++;
  390. #if 0
  391.     if(mcol)
  392.     fwrite(spaces, mcol, 1, mfile);
  393. #endif
  394.     fprintf(mfile, "(%d) %s\n", mcol, s);
  395. }
  396. void MLeave(char *s)
  397. {
  398.     if(mtresh > 100) return;
  399.  
  400.     mcol -= 1;
  401. #if 0
  402.     if(mcol)
  403.     fwrite(spaces, mcol, 1, mfile);
  404. #endif
  405.     fprintf(mfile, "(%d) %s\n", mcol, s);
  406. }
  407. #else
  408. #define MInit(x)
  409. #define MClean()
  410. #define MEnter(x)
  411. #define M(x)
  412. #define P(x)
  413. #define MLeave(x)
  414. #endif
  415.  
  416. static void *hunk_pointer(void *ptr)
  417. {
  418.     if (!ptr)
  419.     {
  420.     P("P0");
  421.     return ptr;
  422.     }
  423.  
  424. #if 1 /* CHFIXME */
  425.     if(RANGE(ptr, first_fn, last_fn) && ((char *)ptr - (char *)first_fn) == 0x21c)
  426.     cpr();
  427. #endif
  428.     
  429.     if (RANGE(ptr, first_fn, last_fn))
  430.     {
  431.     P("PC");
  432.     return (void *)(HUNK_CODE | (char *)ptr - (char *)first_fn);
  433.     }
  434.     else if (RANGE(ptr, &first_data, &last_data))
  435.     {
  436.     P("PD");
  437.     return (void *)(HUNK_DATA | (char *)ptr - (char *)&first_data);
  438.     }
  439.     else if (RANGE(ptr, &first_bss, &last_bss))
  440.     {
  441.     P("PB");
  442.     return (void *)(HUNK_BSS | (char *)ptr - (char *)&first_bss);
  443.     }
  444.     else if (RANGE(ptr, malloc_hunk, malloc_hunk + malloc_hunk_size))
  445.     {
  446.     P("PM");
  447.     return (void *)(HUNK_MALLOC | (char *)ptr - malloc_hunk);
  448.     }
  449.     else if (RANGE(ptr, pure, (char *)pure + puresize))
  450.     {
  451.     P("PP");
  452.     return (void *)(HUNK_PURE | (char *)ptr - (char *)pure);
  453.     }
  454.     else
  455.     {
  456.     _message("hunk_pointer: cannot locate pointer 0x%08lx", ptr);
  457.     print_ranges();
  458.     bailout(0);
  459.     }
  460. }
  461.  
  462. static Lisp_Object hunk_lispptr(Lisp_Object *objptr, Lisp_Object val)
  463. {
  464.     int type = val & ~VALMASK;
  465.     void *ptr = (void *)XPNTR(val);
  466.  
  467. #if 1 /* CHFIXME */
  468.     if(RANGE(ptr, first_fn, last_fn) && ((char *)ptr - (char *)first_fn) == 0x21c)
  469.     cpr();
  470. #endif
  471.     
  472.     if (RANGE(ptr, first_fn, last_fn))
  473.     {
  474.     M("LC");
  475.     return type | HUNK_CODE | (char *)ptr - (char *)first_fn;
  476.     }
  477.     else if (RANGE(ptr, &first_data, &last_data))
  478.     {
  479.     M("LD");
  480.     return type | HUNK_DATA | (char *)ptr - (char *)&first_data;
  481.     }
  482.     else if (RANGE(ptr, &first_bss, &last_bss))
  483.     {
  484.     M("LB");
  485.     return type | HUNK_BSS | (char *)ptr - (char *)&first_bss;
  486.     }
  487.     else if (RANGE(ptr, pure, (char *)pure + puresize))
  488.     {
  489.     M("LP");
  490.     return type | HUNK_PURE | (char *)ptr - (char *)pure;
  491.     }
  492.     else if (RANGE(ptr, malloc_hunk, malloc_hunk + malloc_hunk_size))
  493.     {
  494.     M("LM");
  495.     return type | HUNK_MALLOC | (char *)ptr - malloc_hunk;
  496.     }
  497.     else 
  498.     {
  499.     _message("hunk_pointer: cannot locate pointer 0x%08lx", ptr);
  500.     print_ranges();
  501.     bailout(0);
  502.     }
  503. }
  504.  
  505. static void patch_pointers ();
  506.  
  507. static void patch_buffer (buf)
  508.      Lisp_Object buf;
  509. {
  510.   Lisp_Object tem;
  511.   register struct buffer *buffer = XBUFFER (buf);
  512.   register Lisp_Object *ptr;
  513.  
  514.   buffer->text.beg = hunk_pointer (buffer->text.beg);
  515.   patch_pointers (&buffer->markers);
  516.  
  517.   /* This is the buffer's markbit */
  518.   patch_pointers (&buffer->name);
  519.   assert(!XMARKBIT(&buffer->name)); /* CHFIXME */
  520.   XMARK (buffer->name);
  521.  
  522.   for (ptr = &buffer->name + 1;
  523.        (char *)ptr < (char *)buffer + sizeof (struct buffer);
  524.        ptr++)
  525.     patch_pointers (ptr);
  526. }
  527.  
  528. static void patch_pointers (objptr)
  529.      Lisp_Object *objptr;
  530. {
  531.   register Lisp_Object obj;
  532.  
  533.   MEnter("O+");
  534.  loop:
  535.   obj = *objptr;
  536.  
  537.  loop2:
  538.   XUNMARK (obj);
  539.  
  540.   switch (XGCTYPE (obj))
  541.     {
  542.     case Lisp_String:
  543.     M("O1");
  544.     /* CHIXME */
  545.       {
  546.     register struct Lisp_String *ptr = XSTRING (obj);
  547.  
  548.     if (ptr->size & MARKBIT)
  549.       /* A large string. */
  550.         _message("Lisp_String case: large_string found!");
  551.       }
  552.       *objptr = hunk_lispptr(objptr, *objptr);
  553.       break;
  554.  
  555.     case Lisp_Vector:
  556.     case Lisp_Window:
  557.     case Lisp_Process:
  558.     case Lisp_Window_Configuration:
  559. M("O2");
  560.       *objptr = hunk_lispptr(objptr, *objptr);
  561.       {
  562.     register struct Lisp_Vector *ptr = XVECTOR (obj);
  563.     register int size = ptr->size;
  564.     struct Lisp_Vector *volatile ptr1 = ptr; /* CHFIXME */
  565.     register int i;
  566.  
  567.     if (size & ARRAY_MARK_FLAG) break;   /* Already marked */
  568.     ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
  569.     for (i = 0; i < size; i++)     /* and then mark its elements */
  570.       patch_pointers (&ptr1->contents[i]);
  571.       }
  572.       break;
  573.  
  574.     case Lisp_Compiled: /* similar to vector but avoid some recursion */
  575.     M("O3");
  576.       *objptr = hunk_lispptr(objptr, *objptr);
  577.       {
  578.     register struct Lisp_Vector *ptr = XVECTOR (obj);
  579.     register int size = ptr->size;
  580.     struct Lisp_Vector *volatile ptr1 = ptr; /* CHFIXME */
  581.     register int i;
  582.  
  583.     if (size & ARRAY_MARK_FLAG) break;   /* Already marked */
  584.     ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
  585.     for (i = 0; i < size; i++)     /* and then mark its elements */
  586.         if (i != COMPILED_CONSTANTS)
  587.         patch_pointers (&ptr1->contents[i]);
  588.     objptr = &ptr1->contents[COMPILED_CONSTANTS];
  589.  
  590.     goto loop;
  591.       }
  592.       break;
  593.  
  594.     case Lisp_Symbol:
  595.     M("O4");
  596.       *objptr = hunk_lispptr(objptr, *objptr);
  597.       {
  598.     register struct Lisp_Symbol * volatile ptr = XSYMBOL (obj);
  599.     struct Lisp_Symbol *ptrx;
  600.  
  601.     if (XMARKBIT (ptr->plist)) break;
  602.     XMARK (ptr->plist);
  603.     patch_pointers ((Lisp_Object *) &ptr->value);
  604.     patch_pointers (&ptr->function);
  605.     patch_pointers (&ptr->plist);
  606.     XSETTYPE (*(Lisp_Object *) &ptr->name, Lisp_String);
  607.     patch_pointers ((Lisp_Object *) &ptr->name);
  608.     objptr = (Lisp_Object *)&ptr->next;
  609.     ptr = ptr->next;
  610.     if (ptr)
  611.       {
  612.         ptrx = ptr;        /* Use pf ptrx avoids compiler bug on Sun */
  613.         XSETSYMBOL (obj, ptrx);
  614.         /* We can't goto loop here because *objptr doesn't contain an
  615.            actual Lisp_Object with valid datatype field.  */
  616.  
  617.         goto loop2;
  618.       }
  619.       }
  620.       break;
  621.  
  622.     case Lisp_Marker:
  623.     M("O5");
  624.     {
  625.     struct Lisp_Marker *ptr = XMARKER (obj);
  626.  
  627.     *objptr = hunk_lispptr(objptr, *objptr);
  628.     if (XMARKBIT (ptr->chain)) break;
  629.     XMARK (ptr->chain);
  630.     ptr->buffer = hunk_pointer (ptr->buffer);
  631.     patch_pointers (&ptr->chain);
  632.     break;
  633.     }
  634.  
  635.     case Lisp_Cons:
  636.     case Lisp_Buffer_Local_Value:
  637.     case Lisp_Some_Buffer_Local_Value:
  638.     M("O6");
  639.       *objptr = hunk_lispptr(objptr, *objptr);
  640.       {
  641.     register struct Lisp_Cons *ptr = XCONS (obj);
  642.     if (XMARKBIT (ptr->car)) break;
  643.     XMARK (ptr->car);
  644.     patch_pointers (&ptr->car);
  645.     objptr = &XCONS (obj)->cdr;
  646.     goto loop;
  647.       }
  648.  
  649.     case Lisp_Buffer:
  650.     M("O7");
  651.       *objptr = hunk_lispptr(objptr, *objptr);
  652.       if (!XMARKBIT (XBUFFER (obj)->name))
  653.     patch_buffer (obj);
  654.       break;
  655.  
  656.     case Lisp_Subr: 
  657.     M("O8");
  658.     {
  659.     struct Lisp_Subr *subr = XSUBR(obj);
  660.  
  661.     *objptr = hunk_lispptr(objptr, *objptr);
  662.     if (subr->min_args & 0x8000) break;
  663.     subr->min_args |= 0x8000;
  664.     subr->function = hunk_pointer(subr->function);
  665.     subr->symbol_name = hunk_pointer(subr->symbol_name);
  666.     subr->prompt = hunk_pointer(subr->prompt);
  667.     if ((long)subr->doc >= 0) /* Make sure that not a doc offset */
  668.         subr->doc = hunk_pointer(subr->doc);
  669.     break;
  670.     }
  671.  
  672.     case Lisp_Int:
  673.     case Lisp_Void:
  674.     case Lisp_Buffer_Objfwd: break;
  675.  
  676.     case Lisp_Intfwd:
  677.     case Lisp_Boolfwd:
  678.     case Lisp_Objfwd:
  679.     case Lisp_Internal_Stream:
  680.       M("O9");
  681.       *objptr = hunk_lispptr(objptr, *objptr);
  682.     /* Don't bother with Lisp_Buffer_Objfwd,
  683.        since all markable slots in current buffer marked anyway.  */
  684.     /* Don't need to do Lisp_Objfwd, since the places they point
  685.        are protected with staticpro.  */
  686.       break;
  687.  
  688. #ifdef LISP_FLOAT_TYPE
  689.     case Lisp_Float:
  690.       M("OA");
  691.       *objptr = hunk_lispptr(objptr, *objptr);
  692.       XMARK (XFLOAT (obj)->type);
  693.       break;
  694. #endif /* LISP_FLOAT_TYPE */
  695.     
  696.     default:
  697.       _message("patch_pointers: unknown XGCTYPE (obj): %ld", XGCTYPE (obj));
  698.       abort ();
  699.     }
  700.   MLeave("O-");
  701. }
  702.  
  703. static void patch_chain(void **ptr, int offset)
  704. {
  705.     while (*ptr)
  706.     {
  707.     void **next = (void **)((char *)*ptr + offset);
  708.  
  709.     *ptr = hunk_pointer(*ptr);
  710.     ptr = next;
  711.     }
  712. }
  713.  
  714. #define HUNK_LISPPTR(a) a = hunk_lispptr(&a,a)
  715. #define HUNK_PTR(a) a = hunk_pointer(a)
  716.  
  717. static void patch(void)
  718. {
  719.     Lisp_Object LO;
  720.     int i;
  721.     struct string_block *sptr;
  722.     struct buffer *bptr;
  723.     struct mem_header *mem;
  724.     struct backtrace *backlist;
  725.     struct catchtag *catch;
  726.     
  727.     MInit("MLOG.patch");
  728.     print_ranges(); /* CHFIXME */
  729.  
  730. #ifdef DBUG
  731.     i = 0;
  732. #else
  733.     for (i = 0; i < staticidx; i++)
  734. #endif
  735.     {
  736.     if (!XMARKBIT(*staticvec[i]))
  737.     {
  738.         patch_pointers(staticvec[i]);
  739.         XMARK(*staticvec[i]);
  740.     }
  741.     staticvec[i] = hunk_pointer(staticvec[i]);
  742.     }
  743. #ifndef DBUG
  744.     /* Patch all the pointers normally used before a dump ! */
  745.     patch_chain((void **)&cons_block, 0);
  746.     patch_chain((void **)&cons_free_list, 0);
  747.  
  748.     patch_chain((void **)&all_vectors, 4);
  749.  
  750.     patch_chain((void **)&symbol_block, 0);
  751.     patch_chain((void **)&symbol_free_list, 4);
  752.  
  753.     patch_chain((void **)&marker_block, 0);
  754.     patch_chain((void **)&marker_free_list, 4);
  755.  
  756.     patch_chain((void **)&interval_block, 0);
  757.     patch_chain((void **)&interval_free_list, 4*sizeof(long));
  758.         
  759.     /* Strings are lots of fun */
  760.     patch_chain((void **)&large_string_blocks, 0);
  761.     sptr = first_string_block;
  762.     while (sptr)
  763.     {
  764.     struct string_block *next = sptr->next;
  765.  
  766.     if (sptr->next) HUNK_PTR(sptr->next);
  767.     if (sptr->prev) HUNK_PTR(sptr->prev);
  768.     sptr = next;
  769.     }
  770.     HUNK_PTR(first_string_block);
  771.     HUNK_PTR(current_string_block);
  772.  
  773.     /* More fun with buffers */
  774.     bptr = all_buffers;
  775.     if (bptr)
  776.     {
  777.     while (bptr->next)
  778.     {
  779.         struct buffer *next = bptr->next;
  780.  
  781.         HUNK_PTR(bptr->next);
  782.         bptr = next;
  783.     }
  784.     }
  785.     HUNK_PTR(all_buffers);
  786.     HUNK_PTR(current_buffer);
  787.  
  788. #ifdef LISP_FLOAT_TYPE
  789.     patch_chain((void **) &float_block, 0);
  790.     patch_chain((void **) &float_free_list, 0);
  791. #endif /* LISP_FLOAT_TYPE */
  792.  
  793. #if 0 /* CHFIXME needed ? */
  794.     /* even more fun with 19.28 backtrace */
  795.     for (backlist = backtrace_list; backlist; )
  796.     {
  797.       struct backtrace *next = backlist->next;
  798.       
  799.       if (!XMARKBIT (*backlist->function))
  800.     {
  801.       patch_pointers(backlist->function);
  802.       XMARK (*backlist->function);
  803.     }
  804.       if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
  805.     i = 0;
  806.       else
  807.     i = backlist->nargs - 1;
  808.       for (; i >= 0; i--)
  809.     if (!XMARKBIT (backlist->args[i]))
  810.       {
  811.         patch_pointers(&backlist->args[i]);
  812.         XMARK (backlist->args[i]);
  813.       }
  814.       if(backlist->next) HUNK_PTR(backlist->next);
  815.       backlist = next;
  816.     }  
  817.     HUNK_PTR(backtrace_list);
  818.  
  819.     for (catch = catchlist; catch;)
  820.     {
  821.       struct catchtag *next = catch->next;
  822.     
  823.       patch_pointers (&catch->tag);
  824.       patch_pointers (&catch->val);
  825.       HUNK_PTR(catch->backlist);
  826.       HUNK_PTR(catch->handlerlist);
  827.  
  828.       if(catch->next) HUNK_PTR(catch->next);
  829.       catch = next;
  830.     }
  831.     HUNK_PTR(catchlist);
  832. #endif
  833.     
  834. /*     HUNK_PTR(gcprolist); CHFIXME*/
  835.     HUNK_PTR(stack_copy);
  836.  
  837.     HUNK_PTR(kbd_macro_buffer);
  838. #if 0
  839.     HUNK_PTR(minibuf_save_vector);
  840. #endif
  841.     HUNK_PTR(searchbuf.buffer);
  842.     HUNK_PTR(searchbuf.fastmap);
  843.     HUNK_PTR(specpdl);
  844.     HUNK_PTR(read_buffer);
  845.     
  846. #if 0 /* CHFIXME */
  847.     MouseMap = hunk_lispptr(&MouseMap, MouseMap);
  848. #endif
  849.     HUNK_LISPPTR( current_global_map );
  850.     HUNK_LISPPTR( global_map );
  851.     HUNK_LISPPTR( meta_map );
  852.     HUNK_LISPPTR( control_x_map );
  853.  
  854.     HUNK_LISPPTR( selected_window );
  855.  
  856.     HUNK_LISPPTR( Qvariable_documentation );
  857.  
  858. #ifndef MULTI_FRAME
  859.     /* CHFIXME: use makro */
  860.     HUNK_LISPPTR( the_only_frame.root_window );
  861. #else
  862.     you lose;
  863. #endif
  864.     
  865.     mem = free_list;
  866.     HUNK_PTR( free_list );
  867.     while (mem)
  868.     {
  869.     struct mem_header *next = mem->next;
  870.  
  871.     HUNK_PTR( mem->prev );
  872.     HUNK_PTR( mem->next );
  873.     mem = next;
  874.     }
  875.  
  876.     for (i = 0; i <= 4; i++)
  877.     HUNK_PTR( callint_argfuns[i] );
  878.  
  879.     HUNK_PTR( fail_stack.stack );
  880.     HUNK_PTR( regstart );
  881.     HUNK_PTR( regend );
  882.     HUNK_PTR( old_regstart );
  883.     HUNK_PTR( old_regend );
  884.     HUNK_PTR( best_regstart );
  885.     HUNK_PTR( best_regend );
  886.     HUNK_PTR( reg_info );
  887.     HUNK_PTR( reg_dummy );
  888.     HUNK_PTR( reg_info_dummy );
  889.     
  890.     for(i = 0; i < HEAD_TABLE_SIZE; i++)
  891.     {
  892.     HUNK_PTR( head_table[i].var  );
  893.     HUNK_PTR( head_table[i].name );
  894.     HUNK_PTR( head_table[i].kind );
  895.     }
  896.     for(i = 0; i < SCROLL_BAR_PARTS_SIZE; i++)
  897.     {
  898.     HUNK_PTR( scroll_bar_parts[i] );
  899.     }
  900.     HUNK_PTR(kbd_fetch_ptr);
  901.     HUNK_PTR(kbd_store_ptr);
  902.     XSET(LO, Lisp_Buffer, &buffer_local_types);
  903.     patch_buffer(LO);
  904.     
  905.     HUNK_LISPPTR(Qdirectory_files);
  906.     HUNK_LISPPTR(Qfile_name_completion);
  907.     HUNK_LISPPTR(Qfile_name_all_completions);
  908.     HUNK_LISPPTR(Qfile_attributes);
  909.     HUNK_LISPPTR(Qset_visited_file_modtime);
  910. /*    HUNK_LISPPTR(stream_process);*/
  911.  
  912.     HUNK_PTR(message_text);
  913.  
  914.     /* search.c */
  915.     HUNK_PTR(search_regs.start);
  916.     HUNK_PTR(search_regs.end);
  917. #endif
  918.     MClean();
  919.     check_cands();
  920. }
  921.  
  922. static dump(char *fn)
  923. {
  924.     BPTR fd;
  925.     long size;
  926.  
  927.     fd = Open(fn, MODE_NEWFILE);
  928.     if (!fd)
  929.       {
  930.         static void unpatch(void);
  931.  
  932.         unpatch();
  933.         _fail("emacs hasn't been dumped (%s missing)", fn);
  934.       }
  935.  
  936.     Write(fd, (char *)&puresize, sizeof puresize);
  937.     Write(fd, (char *)&malloc_hunk_size, sizeof malloc_hunk_size);
  938.     Write(fd, (char *)&first_data, (char *)&last_data - (char *)&first_data);
  939.     Write(fd, (char *)&first_bss, (char *)&last_bss - (char *)&first_bss);
  940.     Write(fd, (char *)pure, puresize);
  941.     Write(fd, (char *)malloc_hunk, malloc_hunk_size);
  942.     Write(fd, (char *)&staticidx, sizeof staticidx);
  943.     Write(fd, (char *)staticvec, staticidx * sizeof(Lisp_Object *));
  944.     size = (char *)last_fn - (char *)first_fn;
  945.     Write(fd, (char *)&size, sizeof size);
  946.  
  947.     Close(fd);
  948. }
  949.  
  950. static void *make_pointer(void *ptr)
  951. {
  952.     int hunk = (long)ptr & HUNK_MASK;
  953.     int offset = (long)ptr & (VALMASK & ~HUNK_MASK);
  954.  
  955.     if (!ptr)
  956.     {
  957.     P("P0");
  958.     return 0;
  959.     }
  960.  
  961.     if (hunk == HUNK_CODE)
  962.     {
  963.     P("PC");
  964.     return (char *)first_fn + offset;
  965.     }
  966.     if (hunk == HUNK_DATA)
  967.     {
  968.     P("PD");
  969.     return (char *)&first_data + offset;
  970.     }
  971.     if (hunk == HUNK_BSS)
  972.     {
  973.     P("PB");
  974.     return (char *)&first_bss + offset;
  975.     }
  976.     if (hunk == HUNK_PURE)
  977.     {
  978.     P("PP");
  979.     return (char *)pure + offset;
  980.     }
  981.     if (hunk == HUNK_MALLOC)
  982.     {
  983.     P("PM");
  984.     return malloc_hunk + offset;
  985.     }
  986.     assert(0);
  987. }
  988.  
  989. static Lisp_Object make_lispptr(Lisp_Object *objptr, Lisp_Object obj)
  990. {
  991.     long val = XUINT(obj);
  992.     int hunk = val & HUNK_MASK;
  993.     int offset = val & ~HUNK_MASK;
  994.     char *ptr;
  995.  
  996.     assert(obj); /* CHFIXME */
  997.     if (hunk == HUNK_CODE)
  998.     {
  999.     M("LC");
  1000.     ptr = (char *)first_fn + offset;
  1001.     }
  1002.     else if (hunk == HUNK_DATA)
  1003.     {
  1004.     M("LD");
  1005.     ptr = (char *)&first_data + offset;
  1006.     }
  1007.     else if (hunk == HUNK_BSS)
  1008.     {
  1009.     M("LB");
  1010.     ptr = (char *)&first_bss + offset;
  1011.     }
  1012.     else if (hunk == HUNK_PURE)
  1013.     {
  1014.     M("LP");
  1015.     ptr = (char *)pure + offset;
  1016.     } 
  1017.     else if (hunk == HUNK_MALLOC)
  1018.     {
  1019.     M("LM");
  1020.     ptr = malloc_hunk + offset;
  1021.     }
  1022.     else assert(0);
  1023.  
  1024.     assert((int) ptr > 0); /* CHFIXME */
  1025.     OXSETPNTR(obj, (long)ptr); /* CHFIXME */
  1026.     return obj;
  1027. }
  1028.  
  1029. static void unpatch_pointers ();
  1030.  
  1031. static void unpatch_buffer (buf)
  1032.      Lisp_Object buf;
  1033. {
  1034.   Lisp_Object tem;
  1035.   register struct buffer *buffer = XBUFFER (buf);
  1036.   register Lisp_Object *ptr;
  1037.  
  1038.   buffer->text.beg = make_pointer (buffer->text.beg);
  1039.   unpatch_pointers (&buffer->markers);
  1040.  
  1041.   /* This is the buffer's markbit */
  1042.   XUNMARK (buffer->name);
  1043.   unpatch_pointers (&buffer->name);
  1044.  
  1045.   for (ptr = &buffer->name + 1;
  1046.        (char *)ptr < (char *)buffer + sizeof (struct buffer);
  1047.        ptr++)
  1048.     unpatch_pointers (ptr);
  1049. }
  1050.  
  1051. static void unpatch_pointers (objptr)
  1052.      Lisp_Object *objptr;
  1053. {
  1054.   register Lisp_Object obj;
  1055.   Lisp_Object obj2;
  1056.  
  1057.   MEnter("O+");
  1058.  loop:
  1059.   obj = *objptr;
  1060.  
  1061.  loop2:
  1062.   XUNMARK (obj);
  1063.  
  1064.   switch (XGCTYPE (obj))
  1065.     {
  1066.     case Lisp_String:
  1067.     M("O1");
  1068.       *objptr = make_lispptr(objptr, *objptr);
  1069.       break;
  1070.  
  1071.     case Lisp_Vector:
  1072.     case Lisp_Window:
  1073.     case Lisp_Process:
  1074.     case Lisp_Window_Configuration:
  1075.     M("O2");
  1076.       obj = *objptr = make_lispptr(objptr, *objptr);
  1077.       {
  1078.     register struct Lisp_Vector *ptr = XVECTOR (obj);
  1079.     register int size;
  1080.     struct Lisp_Vector *volatile ptr1 = ptr; /* CHFIXME */
  1081.     register int i;
  1082.  
  1083.     if (!(ptr->size & ARRAY_MARK_FLAG)) break;   /* Already unmarked */
  1084.     size = ptr->size &= ~ARRAY_MARK_FLAG; /* Else unmark it */
  1085.     for (i = 0; i < size; i++)     /* and then unmark its elements */
  1086.       unpatch_pointers (&ptr1->contents[i]);
  1087.       }
  1088.       break;
  1089.  
  1090.     case Lisp_Compiled: /* similar to vector but avoid some recursion */
  1091.     M("O3");
  1092.       obj = *objptr = make_lispptr(objptr, *objptr);
  1093.       {
  1094.     register struct Lisp_Vector *ptr = XVECTOR (obj);
  1095.     register int size = ptr->size;
  1096.     struct Lisp_Vector *volatile ptr1 = ptr; /* CHFIXME */
  1097.     register int i;
  1098.  
  1099.     if (!(size & ARRAY_MARK_FLAG)) break;   /* Already unmarked */
  1100.     size = ptr->size &= ~ARRAY_MARK_FLAG; /* Else unmark it */
  1101.     for (i = 0; i < size; i++)     /* and then mark its elements */
  1102.         if (i != COMPILED_CONSTANTS)
  1103.         unpatch_pointers (&ptr1->contents[i]);
  1104.     objptr = (Lisp_Object *) &ptr1->contents[COMPILED_CONSTANTS];
  1105.  
  1106.     goto loop;
  1107.       }
  1108.       break;
  1109.  
  1110.     case Lisp_Symbol:
  1111.     M("O4");
  1112.     /* due to goto below objptr may not point to object containing
  1113.        SYMBOL type information so let obj care for symbol type */
  1114.       obj2 = *objptr = make_lispptr(objptr, *objptr);
  1115.       {
  1116.     register struct Lisp_Symbol * volatile ptr = XSYMBOL (obj2);
  1117.     struct Lisp_Symbol *ptrx;
  1118.  
  1119.     if (!XMARKBIT (ptr->plist)) break;
  1120.     XUNMARK (ptr->plist);
  1121.     unpatch_pointers ((Lisp_Object *) &ptr->value);
  1122.     unpatch_pointers (&ptr->function);
  1123.     unpatch_pointers (&ptr->plist);
  1124.     unpatch_pointers ((Lisp_Object *) &ptr->name);
  1125.     ptr->name = XSTRING (*(Lisp_Object *)&ptr->name);
  1126.     objptr = (Lisp_Object *)&ptr->next;
  1127.     ptr = ptr->next;
  1128.     if (ptr)
  1129.       {
  1130.         ptrx = ptr;        /* Use pf ptrx avoids compiler bug on Sun */
  1131.         XSETSYMBOL (obj, ptrx);
  1132.  
  1133.         /* We can't goto loop here because *objptr doesn't contain an
  1134.            actual Lisp_Object with valid datatype field.  */
  1135.  
  1136.         goto loop2;
  1137.       }
  1138.       }
  1139.       break;
  1140.  
  1141.     case Lisp_Marker:
  1142.     M("O5");
  1143.      obj = *objptr = make_lispptr(objptr, *objptr);
  1144.       {
  1145.     struct Lisp_Marker *ptr = XMARKER (obj);
  1146.     
  1147.     if (!XMARKBIT (ptr->chain)) break;
  1148.     XUNMARK (ptr->chain);
  1149.     ptr->buffer = make_pointer (ptr->buffer);
  1150.     unpatch_pointers (&ptr->chain);
  1151.       }
  1152.       break;
  1153.  
  1154.     case Lisp_Cons:
  1155.     case Lisp_Buffer_Local_Value:
  1156.     case Lisp_Some_Buffer_Local_Value:
  1157.     M("O6");
  1158.       obj = *objptr = make_lispptr(objptr, *objptr);
  1159.       {
  1160.     register struct Lisp_Cons *ptr = XCONS (obj);
  1161.     if (!XMARKBIT (ptr->car)) break;
  1162.     XUNMARK (ptr->car);
  1163.     unpatch_pointers (&ptr->car);
  1164.     objptr = &ptr->cdr;
  1165.  
  1166.     goto loop;
  1167.       }
  1168.  
  1169.     case Lisp_Buffer:
  1170.     M("O7");
  1171.       obj = *objptr = make_lispptr(objptr, *objptr);
  1172.       if (XMARKBIT (XBUFFER (obj)->name))
  1173.     unpatch_buffer (obj);
  1174.       break;
  1175.  
  1176.     case Lisp_Subr:
  1177.     M("O8");
  1178.     obj = *objptr = make_lispptr(objptr, *objptr);
  1179.     {
  1180.     struct Lisp_Subr *subr = XSUBR(obj);
  1181.     
  1182.     if (!(subr->min_args & 0x8000)) break;
  1183.     subr->min_args &= ~0x8000;
  1184.     subr->function = make_pointer(subr->function);
  1185.     subr->symbol_name = make_pointer(subr->symbol_name);
  1186.     subr->prompt = make_pointer(subr->prompt);
  1187.     if ((long)subr->doc >= 0) /* Make sure that not a doc offset */
  1188.         subr->doc = make_pointer(subr->doc);
  1189.     break;
  1190.     }
  1191.  
  1192.     case Lisp_Int:
  1193.     case Lisp_Void:
  1194.     case Lisp_Buffer_Objfwd: break;
  1195.  
  1196.     case Lisp_Intfwd:
  1197.     case Lisp_Boolfwd:
  1198.     case Lisp_Objfwd:
  1199.     case Lisp_Internal_Stream:
  1200.     M("O9");
  1201.       *objptr = make_lispptr(objptr, *objptr);
  1202.     /* Don't bother with Lisp_Buffer_Objfwd,
  1203.        since all markable slots in current buffer marked anyway.  */
  1204.     /* Don't need to do Lisp_Objfwd, since the places they point
  1205.        are protected with staticpro.  */
  1206.       break;
  1207.  
  1208. #ifdef LISP_FLOAT_TYPE
  1209.     case Lisp_Float:
  1210.       M("OA");
  1211.       obj = *objptr = make_lispptr(objptr, *objptr);
  1212.       XUNMARK (XFLOAT (obj)->type);
  1213.       break;
  1214. #endif /* LISP_FLOAT_TYPE */
  1215.  
  1216.     default:
  1217.       abort ();
  1218.     }
  1219.   MLeave("O-");
  1220. }
  1221.  
  1222. static void unpatch_chain(void **ptr, int offset)
  1223. {
  1224.     while (*ptr)
  1225.     {
  1226.     *ptr = make_pointer(*ptr);
  1227.     ptr = (void **)((char *)*ptr + offset);
  1228.     }
  1229. }
  1230.  
  1231. /* CHFIXME: for all! */
  1232. #define MAKE_LISPPTR(a) a = make_lispptr(&a,a)
  1233. #define MAKE_PTR(a) a = make_pointer(a)
  1234.  
  1235. /* Reconstructs the addresses that were patched */
  1236. static void unpatch(void)
  1237. {
  1238.     Lisp_Object LO;
  1239.     int fd, i;
  1240.     struct string_block *sptr;
  1241.     struct buffer *bptr;
  1242.     struct mem_header *mem;
  1243.     struct backtrace *backlist;
  1244.     struct catchtag *catch;
  1245.  
  1246.     print_ranges(); /* CHFIXME */
  1247.  
  1248.     MInit("MLOG.unpatch");
  1249. #ifdef DBUG
  1250.     i = 0;
  1251. #else
  1252.     for (i = 0; i < staticidx; i++)
  1253. #endif
  1254.     {
  1255.     staticvec[i] = make_pointer(staticvec[i]);
  1256.     if (XMARKBIT(*staticvec[i]))
  1257.     {
  1258.         XUNMARK(*staticvec[i]);
  1259.         unpatch_pointers(staticvec[i]);
  1260.     }
  1261.     }
  1262.  
  1263. #ifndef DBUG
  1264.     /* Unpatch all the pointers normally used before a dump ! */
  1265.     unpatch_chain((void **)&cons_block, 0);
  1266.     unpatch_chain((void **)&cons_free_list, 0);
  1267.  
  1268.     unpatch_chain((void **)&all_vectors, 4);
  1269.  
  1270.     unpatch_chain((void **)&symbol_block, 0);
  1271.     unpatch_chain((void **)&symbol_free_list, 4);
  1272.  
  1273.     unpatch_chain((void **)&marker_block, 0);
  1274.     unpatch_chain((void **)&marker_free_list, 4);
  1275.  
  1276.     unpatch_chain((void **)&interval_block, 0);
  1277.     unpatch_chain((void **)&interval_free_list, 4*sizeof(long));
  1278.         
  1279.     /* Strings are lots of fun */
  1280.     unpatch_chain((void **)&large_string_blocks, 0);
  1281.     sptr = MAKE_PTR(first_string_block);
  1282.     MAKE_PTR(current_string_block);
  1283.     while (sptr)
  1284.     {
  1285.     if (sptr->next) MAKE_PTR(sptr->next);
  1286.     if (sptr->prev) MAKE_PTR(sptr->prev);
  1287.     sptr = sptr->next;
  1288.     }
  1289.  
  1290.     /* More fun with buffers */
  1291.     bptr = MAKE_PTR(all_buffers);
  1292.     if (bptr)
  1293.     {
  1294.     while (bptr->next)
  1295.     {
  1296.         MAKE_PTR(bptr->next);
  1297.         bptr = bptr->next;
  1298.     }
  1299.     }
  1300.     MAKE_PTR(current_buffer);
  1301.  
  1302. #ifdef LISP_FLOAT_TYPE
  1303.     unpatch_chain((void **) &float_block, 0);
  1304.     unpatch_chain((void **) &float_free_list, 0);
  1305. #endif /* LISP_FLOAT_TYPE */
  1306.     
  1307. #if 0 /* CHFIXME needed ? */
  1308.     /* even more fun with 19.28 backtrace */
  1309.     MAKE_PTR(backtrace_list);
  1310.     for (backlist = backtrace_list; backlist; backlist = backlist->next)
  1311.     {
  1312.       if(backlist->next) MAKE_PTR(backlist->next);
  1313.       
  1314.       if (XMARKBIT (*backlist->function))
  1315.     {
  1316.       XUNMARK (*backlist->function);
  1317.       unpatch_pointers(backlist->function);
  1318.     }
  1319.       if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
  1320.     i = 0;
  1321.       else
  1322.     i = backlist->nargs - 1;
  1323.       for (; i >= 0; i--)
  1324.     if (XMARKBIT (backlist->args[i]))
  1325.       {
  1326.         XUNMARK (backlist->args[i]);
  1327.         unpatch_pointers(&backlist->args[i]);
  1328.       }
  1329.     }  
  1330.  
  1331.     MAKE_PTR(catchlist);
  1332.     for (catch = catchlist; catch; catch = catch->next)
  1333.     {
  1334.       if(catch->next) MAKE_PTR(catch->next);
  1335.     
  1336.       unpatch_pointers (&catch->tag);
  1337.       unpatch_pointers (&catch->val);
  1338.       MAKE_PTR(catch->backlist);
  1339.       MAKE_PTR(catch->handlerlist);
  1340.     }
  1341. #endif
  1342.     
  1343. /*    MAKE_PTR(gcprolist); CHFIXME */
  1344.     MAKE_PTR(stack_copy);
  1345.  
  1346.     MAKE_PTR(kbd_macro_buffer);
  1347. #if 0
  1348.     MAKE_PTR(minibuf_save_vector);
  1349. #endif
  1350.     MAKE_PTR(searchbuf.buffer);
  1351.     MAKE_PTR(searchbuf.fastmap);
  1352.     MAKE_PTR(specpdl);
  1353.     MAKE_PTR(read_buffer);
  1354.  
  1355. #if 0 /* CHFIXME */
  1356.     MouseMap = make_lispptr(&MouseMap, MouseMap);
  1357. #endif
  1358.     MAKE_LISPPTR(current_global_map);
  1359.     MAKE_LISPPTR(global_map);
  1360.     MAKE_LISPPTR(meta_map);
  1361.     MAKE_LISPPTR(control_x_map);
  1362.  
  1363.     MAKE_LISPPTR(selected_window);
  1364.  
  1365.     MAKE_LISPPTR(Qvariable_documentation);
  1366.  
  1367. #ifndef MULTI_FRAME
  1368.     /* CHFIXME: use makro */
  1369.     MAKE_LISPPTR(the_only_frame.root_window);
  1370. #else
  1371.     you lose;
  1372. #endif
  1373.  
  1374.     MAKE_PTR(free_list);
  1375.     mem = free_list;
  1376.     while (mem)
  1377.     {
  1378.     MAKE_PTR(mem->prev);
  1379.     MAKE_PTR(mem->next);
  1380.     mem = mem->next;
  1381.     }
  1382.  
  1383.     for (i = 0; i <= 4; i++)
  1384.     MAKE_PTR(callint_argfuns[i]);
  1385.  
  1386.     MAKE_PTR(fail_stack.stack);
  1387.     MAKE_PTR(regstart);
  1388.     MAKE_PTR(regend);
  1389.     MAKE_PTR(old_regstart);
  1390.     MAKE_PTR(old_regend);
  1391.     MAKE_PTR(best_regstart);
  1392.     MAKE_PTR(best_regend);
  1393.     MAKE_PTR(reg_info);
  1394.     MAKE_PTR(reg_dummy);
  1395.     MAKE_PTR(reg_info_dummy);
  1396.     
  1397.     for(i = 0; i < HEAD_TABLE_SIZE; i++)
  1398.     {
  1399.     MAKE_PTR(head_table[i].var);
  1400.     MAKE_PTR(head_table[i].name);
  1401.     MAKE_PTR(head_table[i].kind);
  1402.     }
  1403.     for(i = 0; i < SCROLL_BAR_PARTS_SIZE; i++)
  1404.     MAKE_PTR(scroll_bar_parts[i]);
  1405.  
  1406.     MAKE_PTR(kbd_fetch_ptr);
  1407.     MAKE_PTR(kbd_store_ptr);
  1408.  
  1409.     XSET(LO, Lisp_Buffer, &buffer_local_types);
  1410.     unpatch_buffer(LO);
  1411.     
  1412.     MAKE_LISPPTR(Qdirectory_files);
  1413.     MAKE_LISPPTR(Qfile_name_completion);
  1414.     MAKE_LISPPTR(Qfile_name_all_completions);
  1415.     MAKE_LISPPTR(Qfile_attributes);
  1416.     MAKE_LISPPTR(Qset_visited_file_modtime);
  1417. /*    MAKE_LISPPTR(stream_process);*/
  1418.  
  1419.     MAKE_PTR(message_text);
  1420.  
  1421.     /* search.c */
  1422.     MAKE_PTR(search_regs.start);
  1423.     MAKE_PTR(search_regs.end);
  1424. #endif
  1425.     MClean();
  1426. }
  1427.  
  1428. static undump(char *fn)
  1429. {
  1430.   BPTR fd;
  1431.   long code_size;
  1432.   char *_malloc_hunk;
  1433.   int *_pure;
  1434.   /*extern struct Library *FifoBase;
  1435.   struct Library *_FifoBase = FifoBase;*/
  1436.  
  1437.   fd = Open(fn, MODE_OLDFILE);
  1438.   if (!fd) return 0;
  1439.  
  1440.   Read(fd, (char *)&puresize, sizeof puresize);
  1441.   Read(fd, (char *)&malloc_hunk_size, sizeof malloc_hunk_size);
  1442.   _pure = dump_malloc(puresize);
  1443.   _malloc_hunk = dump_malloc(malloc_hunk_size + pre_alloc);
  1444.   Read(fd, (char *)&first_data, (char *)&last_data - (char *)&first_data);
  1445.   Read(fd, (char *)&first_bss, (char *)&last_bss - (char *)&first_bss);
  1446.   Read(fd, (char *)_pure, puresize);
  1447.   Read(fd, (char *)_malloc_hunk, malloc_hunk_size);
  1448.   Read(fd, (char *)&staticidx, sizeof staticidx);
  1449.   Read(fd, (char *)staticvec, staticidx * sizeof(Lisp_Object *));
  1450.   /*FifoBase = _FifoBase;*/
  1451.   if (Read(fd, (char *)&code_size, sizeof code_size) != sizeof code_size ||
  1452.       code_size != (char *)last_fn - (char *)first_fn)
  1453.   {
  1454.       Close(fd);
  1455.       bailout(fn);
  1456.   }
  1457.  
  1458.   Close(fd);
  1459.   malloc_hunk = _malloc_hunk;
  1460.   pure = _pure;
  1461.   return 1;
  1462. }
  1463.  
  1464. void map_out_data(char *fn)
  1465. {
  1466.     if (amiga_initialized) error("You can only dump once !");
  1467.     Fgarbage_collect();
  1468.  
  1469. #if 0 /* CHFIXME */
  1470.     dump("EMACS-DATA.pre");
  1471. #endif
  1472.     patch();
  1473.     dump(fn);
  1474.     unpatch();
  1475. #if 0
  1476.     dump("EMACS-DATA.post");
  1477. #endif
  1478.     amiga_initialized = 1;
  1479. }
  1480.  
  1481. #ifndef MULTI_FRAME
  1482. static struct x_display A_Display;
  1483. #else
  1484. you lose */
  1485. #endif
  1486.  
  1487. void map_in_data(int load)
  1488. {
  1489.     if (load && undump(NAME_DATA))
  1490.     {
  1491.     unpatch();
  1492. #if 0 /*CHFIXME */
  1493.     current_screen = new_screen = temp_screen = 0;
  1494.     message_buf = 0;
  1495. #endif
  1496.     chars_wasted = 0;
  1497.     copybuf = 0;
  1498.     initialized = amiga_initialized = 1;
  1499.     
  1500.     /* CHFIXME: force errors if used but not patched */
  1501.     handlerlist = (void *) -1;
  1502.     catchlist = (void *)-1;
  1503.         backtrace_list = (void *)-1;
  1504. #if 0
  1505.     FRAME_EXTERNAL_MENU_BAR(selected_frame) = 1; /* CHFIXME where to put? */
  1506. #endif
  1507.     }
  1508.     else
  1509.       {
  1510.     malloc_hunk = dump_malloc(malloc_hunk_size + pre_alloc);
  1511.     pure = dump_malloc(puresize);
  1512.       }
  1513. #ifndef MULTI_FRAME
  1514.     FRAME_DISPLAY(selected_frame) = &A_Display;
  1515. #else
  1516.     you lose again.
  1517. #endif
  1518.     amiga_undump_reinit();
  1519. }
  1520.  
  1521. void
  1522. early_init_amiga_dump()
  1523. {
  1524. #ifndef MULTI_FRAME
  1525.     FRAME_DISPLAY(selected_frame) = &A_Display;
  1526. #else
  1527.     you lose again.
  1528. #endif
  1529. }
  1530.