#include #include #include #include #include #include #include #include "config.h" #include "lisp.h" #include "buffer.h" #include "regex.h" #include "amiga.h" #include "dispextern.h" #include "termchar.h" #include "paths.h" #include "frame.h" #ifdef USE_PROTOS #include "protos.h" #endif #define RANGE(ptr, s, e) ((char *)ptr >= (char *)s && (char *)ptr < (char *)e) #define HUNK_POS (VALBITS - 3) #define HUNK_MASK (7 << HUNK_POS) #define HUNK_CODE (0 << HUNK_POS) #define HUNK_DATA (1 << HUNK_POS) #define HUNK_BSS (2 << HUNK_POS) #define HUNK_MALLOC (3 << HUNK_POS) #define HUNK_PURE (4 << HUNK_POS) #define ARRAY_MARK_FLAG ((MARKBIT >> 1) & ~MARKBIT) void *far first_fn = first_function, *far last_fn = last_function; /* alloc.c */ extern int *pure, puresize; extern struct gcpro *gcprolist; extern Lisp_Object *staticvec[]; extern int staticidx; extern struct cons_block *cons_block; extern struct Lisp_Cons *cons_free_list; extern struct Lisp_Vector *all_vectors; extern struct symbol_block *symbol_block; extern struct Lisp_Symbol *symbol_free_list; extern struct marker_block *marker_block; extern struct Lisp_Marker *marker_free_list; extern struct interval_block *interval_block; extern INTERVAL interval_free_list; struct string_block_head { struct string_block_head *next, *prev; int pos; }; struct string_block { struct string_block *next, *prev; #if 0 /* not needed */ int pos; char chars[STRING_BLOCK_SIZE]; #endif }; extern struct string_block *current_string_block; extern struct string_block *first_string_block; extern struct string_block *large_string_blocks; #ifdef LISP_FLOAT_TYPE extern struct float_block *float_block; extern struct Lisp_Float *float_free_list; #endif /* LISP_FLOAT_TYPE */ struct backtrace /* see eval.c or alloc.c */ { struct backtrace *next; Lisp_Object *function; Lisp_Object *args; /* Points to vector of args. */ int nargs; /* Length of vector. If nargs is UNEVALLED, args points to slot holding list of unevalled args */ char evalargs; /* Nonzero means call value of debugger when done with this operation. */ char debug_on_exit; }; extern struct backtrace *backtrace_list; struct catchtag { Lisp_Object tag; Lisp_Object val; struct catchtag *next; struct gcpro *gcpro; jmp_buf jmp; struct backtrace *backlist; struct handler *handlerlist; int lisp_eval_depth; int pdlcount; int poll_suppress_count; }; extern struct catchtag *catchlist; extern char *stack_copy; extern int *kbd_macro_buffer; extern char *read_buffer, *chars_wasted, *copybuf; extern struct minibuf_save_data *minibuf_save_vector; extern struct re_pattern_buffer searchbuf; #if 0 /* CHFIXME */ extern int *ILcost, *DLcost, *ILncost, *DLncost; #endif #if 0 extern Lisp_Object MouseMap, global_map, Vglobal_map, Vesc_map, Vctl_x_map; #else extern Lisp_Object global_map, meta_map, control_x_map; #endif extern Lisp_Object selected_window; extern char *callint_argfuns[]; /* lread.c/init_obarray variables */ extern Lisp_Object Qvariable_documentation, Vpurify_flag; /* eval.c/init_eval_once variables */ /* specpdl */ /* syntax.c/init_syntax_once */ /* */ /* window.c variables */ /* */ /* buffer.c */ /* -> buffer.h */ /* dired.c */ extern Lisp_Object Qdirectory_files, Qfile_name_completion, Qfile_name_all_completions, Qfile_attributes; /* fileio.c */ extern Lisp_Object Qset_visited_file_modtime; /* process.c */ /* extern Lisp_Object stream_process; CHFIXME activate HAVE_SOCKETS ?*/ /* editfns.c */ extern char *message_text; /* regex variables */ typedef unsigned char *fail_stack_elt_t; typedef struct { fail_stack_elt_t *stack; unsigned size; unsigned avail; /* Offset of next open position. */ } fail_stack_type; typedef short register_info_type; extern fail_stack_type fail_stack; extern const char ** regstart, ** regend; extern const char ** old_regstart, ** old_regend; extern const char **best_regstart, **best_regend; extern register_info_type *reg_info; extern const char **reg_dummy; extern void *reg_info_dummy; /* keyboard.c/variables CHFIXME: need to be checked on version change */ #define HEAD_TABLE_SIZE 3 #define SCROLL_BAR_PARTS_SIZE 3 struct event_head { Lisp_Object *var; char *name; Lisp_Object *kind; }; extern struct event_head head_table[]; extern Lisp_Object *scroll_bar_parts[]; extern struct input_event *kbd_fetch_ptr; extern struct input_event volatile *kbd_store_ptr; /* search.c */ extern struct re_registers search_regs; #if 0 #define DBUG /* dump debug */ #endif static char *dump_error_example[] = { "dump-error-example-1", "dump-error-example-2" }; static void cpr() {} /* CHFIXME */ static void *dump_malloc(int size) { void *new = malloc(size); if (!new) no_memory(); return new; } static void bailout(char *fn) { if (fn) _message("%s isn't a dump file for this version of Emacs, aborting", fn); else _message("Dump file isn't for this version of Emacs, aborting"); /* We are in deep trouble, as all our variables are potentially corrupt */ /* Therefore, no cleanup is possible */ /* Remove cleanup routines */ onexit(0); /* However, the library & the memory allocation should be ok, so we can exit reasonably */ _fail("Some system resources may have been lost"); } void print_ranges() { #if 0 _message("HUNK_CODE : %08lx .. %08lx (%08lx)", first_fn, last_fn, (char *) last_fn - (char *) first_fn); _message("HUNK_DATA : %08lx .. %08lx (%08lx)", &first_data, &last_data, (char *) &last_data - (char *) &first_data); _message("HUNK_BSS : %08lx .. %08lx (%08lx)", &first_bss, &last_bss, (char *) &last_bss - (char *) &first_bss); _message("HUNK_PURE : %08lx .. %08lx (%08lx)" , pure, (char *)pure + puresize, puresize); _message("HUNK_MALLOC: %08lx .. %08lx (%08lx)", malloc_hunk, malloc_hunk + malloc_hunk_size, malloc_hunk_size); #endif } /* * ignore: * stack_bottom, IconBase, last_marked (array), interval_block_index (int) * gcprolist (currently?), * pending (list), returned (list) */ int check_ignore(void *x) { #ifndef USE_PROTOS extern int IconBase, IFFParseBase, interval_block_index, instream, cliphook; #else extern int interval_block_index; #endif int ign = 0; if((x == (void *) &IconBase) || (x == (void *) &stack_bottom) /* || (x == (void *) &interval_block_index) */ || (x == (void *) &pure) || (x == (void *) &gcprolist) || (x == (void *) &malloc_hunk) || (x == (void *) &IFFParseBase) || (x == (void *) &instream) || (x == (void *) &cbuffer_pos) || (x == (void *) &cliphook) || (x == (void *) ((int *)&cliphook+1)) || (x == (void *) ((int *)&cliphook+2)) || (x == (void *) &specpdl_ptr) || (x == (void *) &handlerlist) /* CHFIXME: ok? */ || (x == (void *) &catchlist) /* CHFIXME: ok? */ || (x == (void *) &backtrace_list) /* CHFIXME: ok? */ ) ign = 1; return ign; } /* * test for candidates which may need extra handling on dump */ void check_cand(char *s, void *start, void *end) { unsigned int *ip, *starthit = NULL, *lasthit = NULL; unsigned short int *is; int range = 0; int de = ((unsigned)dump_error_example[0] >> 24); #define FIRST ((char*) &first_data) /* first symbol in data hunk */ for(is = start; (char *)is < (char *)end; is++) { ip = (unsigned int *) is; if((((*ip >> 24) == 0x08) || (*ip >> 24) == de) && ! check_ignore(ip)) { if(lasthit+1 == ip) { lasthit++; range = 1; } else { if(range) { fprintf(stderr,"%s: 0x%08lx .. 0x%08lx (0x%08lx)\n", s, (char *)starthit-FIRST, (char *)lasthit-FIRST, (char*)lasthit-(char*)starthit); range = 0; } else { starthit = lasthit = ip; } } } else { if((unsigned short *) lasthit+1 != is) { if(range) { fprintf(stderr,"%s: 0x%08lx .. 0x%08lx (0x%08lx)\n", s, (char *)starthit-FIRST, (char *)lasthit-FIRST, (char*)lasthit-(char*)starthit); } else if(lasthit) { fprintf(stderr,"%s: 0x%08lx (0x%08lx)\n", s, (char *)lasthit-FIRST, *lasthit); } range = 0; lasthit = NULL; } } } if(range) { fprintf(stderr,"%s: 0x%08lx .. 0x%08lx (0x%08lx)\n", s, (char *)starthit-FIRST, (char *)lasthit-FIRST, (char*)lasthit-(char*)starthit); } else if(lasthit) { fprintf(stderr,"%s: 0x%08lx\n (0x%08ls)", s, (char *)lasthit-FIRST, *lasthit); } } void check_cands(void) { fprintf(stderr,"Possible candidates for FAR or amiga_dump\n"); check_cand("DATA", &first_data, &last_data); check_cand("BSS ", &first_bss, &last_bss); } #ifdef DBUG static int mcol = 0; static int mrow = 0; static FILE *mfile; static char spaces[] = " "; static mtresh = 0; void MInit(char *s) { mcol = 0; mrow = 0; mtresh = 0; mfile = fopen(s,"a"); fprintf(mfile,"\n***START***\n"); } void MClean() { fprintf(mfile,"\n**END**\n"); fclose(mfile); } #define P(x) void MEnter(char *s) { if(mtresh > 100) return; #if 0 fwrite(spaces, mcol, 1, mfile); #endif fprintf(mfile, "(%d) %s\n", mcol, s); mcol += 1; } void M(char *s) { if(mtresh > 100) return; mtresh++; #if 0 if(mcol) fwrite(spaces, mcol, 1, mfile); #endif fprintf(mfile, "(%d) %s\n", mcol, s); } void MLeave(char *s) { if(mtresh > 100) return; mcol -= 1; #if 0 if(mcol) fwrite(spaces, mcol, 1, mfile); #endif fprintf(mfile, "(%d) %s\n", mcol, s); } #else #define MInit(x) #define MClean() #define MEnter(x) #define M(x) #define P(x) #define MLeave(x) #endif static void *hunk_pointer(void *ptr) { if (!ptr) { P("P0"); return ptr; } #if 1 /* CHFIXME */ if(RANGE(ptr, first_fn, last_fn) && ((char *)ptr - (char *)first_fn) == 0x21c) cpr(); #endif if (RANGE(ptr, first_fn, last_fn)) { P("PC"); return (void *)(HUNK_CODE | (char *)ptr - (char *)first_fn); } else if (RANGE(ptr, &first_data, &last_data)) { P("PD"); return (void *)(HUNK_DATA | (char *)ptr - (char *)&first_data); } else if (RANGE(ptr, &first_bss, &last_bss)) { P("PB"); return (void *)(HUNK_BSS | (char *)ptr - (char *)&first_bss); } else if (RANGE(ptr, malloc_hunk, malloc_hunk + malloc_hunk_size)) { P("PM"); return (void *)(HUNK_MALLOC | (char *)ptr - malloc_hunk); } else if (RANGE(ptr, pure, (char *)pure + puresize)) { P("PP"); return (void *)(HUNK_PURE | (char *)ptr - (char *)pure); } else { _message("hunk_pointer: cannot locate pointer 0x%08lx", ptr); print_ranges(); bailout(0); } } static Lisp_Object hunk_lispptr(Lisp_Object *objptr, Lisp_Object val) { int type = val & ~VALMASK; void *ptr = (void *)XPNTR(val); #if 1 /* CHFIXME */ if(RANGE(ptr, first_fn, last_fn) && ((char *)ptr - (char *)first_fn) == 0x21c) cpr(); #endif if (RANGE(ptr, first_fn, last_fn)) { M("LC"); return type | HUNK_CODE | (char *)ptr - (char *)first_fn; } else if (RANGE(ptr, &first_data, &last_data)) { M("LD"); return type | HUNK_DATA | (char *)ptr - (char *)&first_data; } else if (RANGE(ptr, &first_bss, &last_bss)) { M("LB"); return type | HUNK_BSS | (char *)ptr - (char *)&first_bss; } else if (RANGE(ptr, pure, (char *)pure + puresize)) { M("LP"); return type | HUNK_PURE | (char *)ptr - (char *)pure; } else if (RANGE(ptr, malloc_hunk, malloc_hunk + malloc_hunk_size)) { M("LM"); return type | HUNK_MALLOC | (char *)ptr - malloc_hunk; } else { _message("hunk_pointer: cannot locate pointer 0x%08lx", ptr); print_ranges(); bailout(0); } } static void patch_pointers (); static void patch_buffer (buf) Lisp_Object buf; { Lisp_Object tem; register struct buffer *buffer = XBUFFER (buf); register Lisp_Object *ptr; buffer->text.beg = hunk_pointer (buffer->text.beg); patch_pointers (&buffer->markers); /* This is the buffer's markbit */ patch_pointers (&buffer->name); assert(!XMARKBIT(&buffer->name)); /* CHFIXME */ XMARK (buffer->name); for (ptr = &buffer->name + 1; (char *)ptr < (char *)buffer + sizeof (struct buffer); ptr++) patch_pointers (ptr); } static void patch_pointers (objptr) Lisp_Object *objptr; { register Lisp_Object obj; MEnter("O+"); loop: obj = *objptr; loop2: XUNMARK (obj); switch (XGCTYPE (obj)) { case Lisp_String: M("O1"); /* CHIXME */ { register struct Lisp_String *ptr = XSTRING (obj); if (ptr->size & MARKBIT) /* A large string. */ _message("Lisp_String case: large_string found!"); } *objptr = hunk_lispptr(objptr, *objptr); break; case Lisp_Vector: case Lisp_Window: case Lisp_Process: case Lisp_Window_Configuration: M("O2"); *objptr = hunk_lispptr(objptr, *objptr); { register struct Lisp_Vector *ptr = XVECTOR (obj); register int size = ptr->size; struct Lisp_Vector *volatile ptr1 = ptr; /* CHFIXME */ register int i; if (size & ARRAY_MARK_FLAG) break; /* Already marked */ ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ for (i = 0; i < size; i++) /* and then mark its elements */ patch_pointers (&ptr1->contents[i]); } break; case Lisp_Compiled: /* similar to vector but avoid some recursion */ M("O3"); *objptr = hunk_lispptr(objptr, *objptr); { register struct Lisp_Vector *ptr = XVECTOR (obj); register int size = ptr->size; struct Lisp_Vector *volatile ptr1 = ptr; /* CHFIXME */ register int i; if (size & ARRAY_MARK_FLAG) break; /* Already marked */ ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ for (i = 0; i < size; i++) /* and then mark its elements */ if (i != COMPILED_CONSTANTS) patch_pointers (&ptr1->contents[i]); objptr = &ptr1->contents[COMPILED_CONSTANTS]; goto loop; } break; case Lisp_Symbol: M("O4"); *objptr = hunk_lispptr(objptr, *objptr); { register struct Lisp_Symbol * volatile ptr = XSYMBOL (obj); struct Lisp_Symbol *ptrx; if (XMARKBIT (ptr->plist)) break; XMARK (ptr->plist); patch_pointers ((Lisp_Object *) &ptr->value); patch_pointers (&ptr->function); patch_pointers (&ptr->plist); XSETTYPE (*(Lisp_Object *) &ptr->name, Lisp_String); patch_pointers ((Lisp_Object *) &ptr->name); objptr = (Lisp_Object *)&ptr->next; ptr = ptr->next; if (ptr) { ptrx = ptr; /* Use pf ptrx avoids compiler bug on Sun */ XSETSYMBOL (obj, ptrx); /* We can't goto loop here because *objptr doesn't contain an actual Lisp_Object with valid datatype field. */ goto loop2; } } break; case Lisp_Marker: M("O5"); { struct Lisp_Marker *ptr = XMARKER (obj); *objptr = hunk_lispptr(objptr, *objptr); if (XMARKBIT (ptr->chain)) break; XMARK (ptr->chain); ptr->buffer = hunk_pointer (ptr->buffer); patch_pointers (&ptr->chain); break; } case Lisp_Cons: case Lisp_Buffer_Local_Value: case Lisp_Some_Buffer_Local_Value: M("O6"); *objptr = hunk_lispptr(objptr, *objptr); { register struct Lisp_Cons *ptr = XCONS (obj); if (XMARKBIT (ptr->car)) break; XMARK (ptr->car); patch_pointers (&ptr->car); objptr = &XCONS (obj)->cdr; goto loop; } case Lisp_Buffer: M("O7"); *objptr = hunk_lispptr(objptr, *objptr); if (!XMARKBIT (XBUFFER (obj)->name)) patch_buffer (obj); break; case Lisp_Subr: M("O8"); { struct Lisp_Subr *subr = XSUBR(obj); *objptr = hunk_lispptr(objptr, *objptr); if (subr->min_args & 0x8000) break; subr->min_args |= 0x8000; subr->function = hunk_pointer(subr->function); subr->symbol_name = hunk_pointer(subr->symbol_name); subr->prompt = hunk_pointer(subr->prompt); if ((long)subr->doc >= 0) /* Make sure that not a doc offset */ subr->doc = hunk_pointer(subr->doc); break; } case Lisp_Int: case Lisp_Void: case Lisp_Buffer_Objfwd: break; case Lisp_Intfwd: case Lisp_Boolfwd: case Lisp_Objfwd: case Lisp_Internal_Stream: M("O9"); *objptr = hunk_lispptr(objptr, *objptr); /* Don't bother with Lisp_Buffer_Objfwd, since all markable slots in current buffer marked anyway. */ /* Don't need to do Lisp_Objfwd, since the places they point are protected with staticpro. */ break; #ifdef LISP_FLOAT_TYPE case Lisp_Float: M("OA"); *objptr = hunk_lispptr(objptr, *objptr); XMARK (XFLOAT (obj)->type); break; #endif /* LISP_FLOAT_TYPE */ default: _message("patch_pointers: unknown XGCTYPE (obj): %ld", XGCTYPE (obj)); abort (); } MLeave("O-"); } static void patch_chain(void **ptr, int offset) { while (*ptr) { void **next = (void **)((char *)*ptr + offset); *ptr = hunk_pointer(*ptr); ptr = next; } } #define HUNK_LISPPTR(a) a = hunk_lispptr(&a,a) #define HUNK_PTR(a) a = hunk_pointer(a) static void patch(void) { Lisp_Object LO; int i; struct string_block *sptr; struct buffer *bptr; struct mem_header *mem; struct backtrace *backlist; struct catchtag *catch; MInit("MLOG.patch"); print_ranges(); /* CHFIXME */ #ifdef DBUG i = 0; #else for (i = 0; i < staticidx; i++) #endif { if (!XMARKBIT(*staticvec[i])) { patch_pointers(staticvec[i]); XMARK(*staticvec[i]); } staticvec[i] = hunk_pointer(staticvec[i]); } #ifndef DBUG /* Patch all the pointers normally used before a dump ! */ patch_chain((void **)&cons_block, 0); patch_chain((void **)&cons_free_list, 0); patch_chain((void **)&all_vectors, 4); patch_chain((void **)&symbol_block, 0); patch_chain((void **)&symbol_free_list, 4); patch_chain((void **)&marker_block, 0); patch_chain((void **)&marker_free_list, 4); patch_chain((void **)&interval_block, 0); patch_chain((void **)&interval_free_list, 4*sizeof(long)); /* Strings are lots of fun */ patch_chain((void **)&large_string_blocks, 0); sptr = first_string_block; while (sptr) { struct string_block *next = sptr->next; if (sptr->next) HUNK_PTR(sptr->next); if (sptr->prev) HUNK_PTR(sptr->prev); sptr = next; } HUNK_PTR(first_string_block); HUNK_PTR(current_string_block); /* More fun with buffers */ bptr = all_buffers; if (bptr) { while (bptr->next) { struct buffer *next = bptr->next; HUNK_PTR(bptr->next); bptr = next; } } HUNK_PTR(all_buffers); HUNK_PTR(current_buffer); #ifdef LISP_FLOAT_TYPE patch_chain((void **) &float_block, 0); patch_chain((void **) &float_free_list, 0); #endif /* LISP_FLOAT_TYPE */ #if 0 /* CHFIXME needed ? */ /* even more fun with 19.25 backtrace */ for (backlist = backtrace_list; backlist; ) { struct backtrace *next = backlist->next; if (!XMARKBIT (*backlist->function)) { patch_pointers(backlist->function); XMARK (*backlist->function); } if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) i = 0; else i = backlist->nargs - 1; for (; i >= 0; i--) if (!XMARKBIT (backlist->args[i])) { patch_pointers(&backlist->args[i]); XMARK (backlist->args[i]); } if(backlist->next) HUNK_PTR(backlist->next); backlist = next; } HUNK_PTR(backtrace_list); for (catch = catchlist; catch;) { struct catchtag *next = catch->next; patch_pointers (&catch->tag); patch_pointers (&catch->val); HUNK_PTR(catch->backlist); HUNK_PTR(catch->handlerlist); if(catch->next) HUNK_PTR(catch->next); catch = next; } HUNK_PTR(catchlist); #endif /* HUNK_PTR(gcprolist); CHFIXME*/ HUNK_PTR(stack_copy); HUNK_PTR(kbd_macro_buffer); HUNK_PTR(minibuf_save_vector); HUNK_PTR(searchbuf.buffer); HUNK_PTR(searchbuf.fastmap); HUNK_PTR(specpdl); HUNK_PTR(read_buffer); #if 0 /* CHFIXME */ MouseMap = hunk_lispptr(&MouseMap, MouseMap); #endif HUNK_LISPPTR( current_global_map ); HUNK_LISPPTR( global_map ); HUNK_LISPPTR( meta_map ); HUNK_LISPPTR( control_x_map ); HUNK_LISPPTR( selected_window ); HUNK_LISPPTR( Qvariable_documentation ); #ifndef MULTI_FRAME /* CHFIXME: use makro */ HUNK_LISPPTR( the_only_frame.root_window ); #else you lose; #endif mem = free_list; HUNK_PTR( free_list ); while (mem) { struct mem_header *next = mem->next; HUNK_PTR( mem->prev ); HUNK_PTR( mem->next ); mem = next; } for (i = 0; i <= 4; i++) HUNK_PTR( callint_argfuns[i] ); HUNK_PTR( fail_stack.stack ); HUNK_PTR( regstart ); HUNK_PTR( regend ); HUNK_PTR( old_regstart ); HUNK_PTR( old_regend ); HUNK_PTR( best_regstart ); HUNK_PTR( best_regend ); HUNK_PTR( reg_info ); HUNK_PTR( reg_dummy ); HUNK_PTR( reg_info_dummy ); for(i = 0; i < HEAD_TABLE_SIZE; i++) { HUNK_PTR( head_table[i].var ); HUNK_PTR( head_table[i].name ); HUNK_PTR( head_table[i].kind ); } for(i = 0; i < SCROLL_BAR_PARTS_SIZE; i++) { HUNK_PTR( scroll_bar_parts[i] ); } HUNK_PTR(kbd_fetch_ptr); HUNK_PTR(kbd_store_ptr); XSET(LO, Lisp_Buffer, &buffer_local_types); patch_buffer(LO); HUNK_LISPPTR(Qdirectory_files); HUNK_LISPPTR(Qfile_name_completion); HUNK_LISPPTR(Qfile_name_all_completions); HUNK_LISPPTR(Qfile_attributes); HUNK_LISPPTR(Qset_visited_file_modtime); /* HUNK_LISPPTR(stream_process);*/ HUNK_PTR(message_text); /* search.c */ HUNK_PTR(search_regs.start); HUNK_PTR(search_regs.end); #endif MClean(); check_cands(); } static dump(char *fn) { BPTR fd; long size; fd = Open(fn, MODE_NEWFILE); if (!fd) { static void unpatch(void); unpatch(); _fail("emacs hasn't been dumped (%s missing)", fn); } Write(fd, (char *)&puresize, sizeof puresize); Write(fd, (char *)&malloc_hunk_size, sizeof malloc_hunk_size); Write(fd, (char *)&first_data, (char *)&last_data - (char *)&first_data); Write(fd, (char *)&first_bss, (char *)&last_bss - (char *)&first_bss); Write(fd, (char *)pure, puresize); Write(fd, (char *)malloc_hunk, malloc_hunk_size); Write(fd, (char *)&staticidx, sizeof staticidx); Write(fd, (char *)staticvec, staticidx * sizeof(Lisp_Object *)); size = (char *)last_fn - (char *)first_fn; Write(fd, (char *)&size, sizeof size); Close(fd); } static void *make_pointer(void *ptr) { int hunk = (long)ptr & HUNK_MASK; int offset = (long)ptr & (VALMASK & ~HUNK_MASK); if (!ptr) { P("P0"); return 0; } if (hunk == HUNK_CODE) { P("PC"); return (char *)first_fn + offset; } if (hunk == HUNK_DATA) { P("PD"); return (char *)&first_data + offset; } if (hunk == HUNK_BSS) { P("PB"); return (char *)&first_bss + offset; } if (hunk == HUNK_PURE) { P("PP"); return (char *)pure + offset; } if (hunk == HUNK_MALLOC) { P("PM"); return malloc_hunk + offset; } assert(0); } static Lisp_Object make_lispptr(Lisp_Object *objptr, Lisp_Object obj) { long val = XUINT(obj); int hunk = val & HUNK_MASK; int offset = val & ~HUNK_MASK; char *ptr; assert(obj); /* CHFIXME */ if (hunk == HUNK_CODE) { M("LC"); ptr = (char *)first_fn + offset; } else if (hunk == HUNK_DATA) { M("LD"); ptr = (char *)&first_data + offset; } else if (hunk == HUNK_BSS) { M("LB"); ptr = (char *)&first_bss + offset; } else if (hunk == HUNK_PURE) { M("LP"); ptr = (char *)pure + offset; } else if (hunk == HUNK_MALLOC) { M("LM"); ptr = malloc_hunk + offset; } else assert(0); assert((int) ptr > 0); /* CHFIXME */ OXSETPNTR(obj, (long)ptr); /* CHFIXME */ return obj; } static void unpatch_pointers (); static void unpatch_buffer (buf) Lisp_Object buf; { Lisp_Object tem; register struct buffer *buffer = XBUFFER (buf); register Lisp_Object *ptr; buffer->text.beg = make_pointer (buffer->text.beg); unpatch_pointers (&buffer->markers); /* This is the buffer's markbit */ XUNMARK (buffer->name); unpatch_pointers (&buffer->name); for (ptr = &buffer->name + 1; (char *)ptr < (char *)buffer + sizeof (struct buffer); ptr++) unpatch_pointers (ptr); } static void unpatch_pointers (objptr) Lisp_Object *objptr; { register Lisp_Object obj; Lisp_Object obj2; MEnter("O+"); loop: obj = *objptr; loop2: XUNMARK (obj); switch (XGCTYPE (obj)) { case Lisp_String: M("O1"); *objptr = make_lispptr(objptr, *objptr); break; case Lisp_Vector: case Lisp_Window: case Lisp_Process: case Lisp_Window_Configuration: M("O2"); obj = *objptr = make_lispptr(objptr, *objptr); { register struct Lisp_Vector *ptr = XVECTOR (obj); register int size; struct Lisp_Vector *volatile ptr1 = ptr; /* CHFIXME */ register int i; if (!(ptr->size & ARRAY_MARK_FLAG)) break; /* Already unmarked */ size = ptr->size &= ~ARRAY_MARK_FLAG; /* Else unmark it */ for (i = 0; i < size; i++) /* and then unmark its elements */ unpatch_pointers (&ptr1->contents[i]); } break; case Lisp_Compiled: /* similar to vector but avoid some recursion */ M("O3"); obj = *objptr = make_lispptr(objptr, *objptr); { register struct Lisp_Vector *ptr = XVECTOR (obj); register int size = ptr->size; struct Lisp_Vector *volatile ptr1 = ptr; /* CHFIXME */ register int i; if (!(size & ARRAY_MARK_FLAG)) break; /* Already unmarked */ size = ptr->size &= ~ARRAY_MARK_FLAG; /* Else unmark it */ for (i = 0; i < size; i++) /* and then mark its elements */ if (i != COMPILED_CONSTANTS) unpatch_pointers (&ptr1->contents[i]); objptr = (Lisp_Object *) &ptr1->contents[COMPILED_CONSTANTS]; goto loop; } break; case Lisp_Symbol: M("O4"); /* due to goto below objptr may not point to object containing SYMBOL type information so let obj care for symbol type */ obj2 = *objptr = make_lispptr(objptr, *objptr); { register struct Lisp_Symbol * volatile ptr = XSYMBOL (obj2); struct Lisp_Symbol *ptrx; if (!XMARKBIT (ptr->plist)) break; XUNMARK (ptr->plist); unpatch_pointers ((Lisp_Object *) &ptr->value); unpatch_pointers (&ptr->function); unpatch_pointers (&ptr->plist); unpatch_pointers ((Lisp_Object *) &ptr->name); ptr->name = XSTRING (*(Lisp_Object *)&ptr->name); objptr = (Lisp_Object *)&ptr->next; ptr = ptr->next; if (ptr) { ptrx = ptr; /* Use pf ptrx avoids compiler bug on Sun */ XSETSYMBOL (obj, ptrx); /* We can't goto loop here because *objptr doesn't contain an actual Lisp_Object with valid datatype field. */ goto loop2; } } break; case Lisp_Marker: M("O5"); obj = *objptr = make_lispptr(objptr, *objptr); { struct Lisp_Marker *ptr = XMARKER (obj); if (!XMARKBIT (ptr->chain)) break; XUNMARK (ptr->chain); ptr->buffer = make_pointer (ptr->buffer); unpatch_pointers (&ptr->chain); } break; case Lisp_Cons: case Lisp_Buffer_Local_Value: case Lisp_Some_Buffer_Local_Value: M("O6"); obj = *objptr = make_lispptr(objptr, *objptr); { register struct Lisp_Cons *ptr = XCONS (obj); if (!XMARKBIT (ptr->car)) break; XUNMARK (ptr->car); unpatch_pointers (&ptr->car); objptr = &ptr->cdr; goto loop; } case Lisp_Buffer: M("O7"); obj = *objptr = make_lispptr(objptr, *objptr); if (XMARKBIT (XBUFFER (obj)->name)) unpatch_buffer (obj); break; case Lisp_Subr: M("O8"); obj = *objptr = make_lispptr(objptr, *objptr); { struct Lisp_Subr *subr = XSUBR(obj); if (!(subr->min_args & 0x8000)) break; subr->min_args &= ~0x8000; subr->function = make_pointer(subr->function); subr->symbol_name = make_pointer(subr->symbol_name); subr->prompt = make_pointer(subr->prompt); if ((long)subr->doc >= 0) /* Make sure that not a doc offset */ subr->doc = make_pointer(subr->doc); break; } case Lisp_Int: case Lisp_Void: case Lisp_Buffer_Objfwd: break; case Lisp_Intfwd: case Lisp_Boolfwd: case Lisp_Objfwd: case Lisp_Internal_Stream: M("O9"); *objptr = make_lispptr(objptr, *objptr); /* Don't bother with Lisp_Buffer_Objfwd, since all markable slots in current buffer marked anyway. */ /* Don't need to do Lisp_Objfwd, since the places they point are protected with staticpro. */ break; #ifdef LISP_FLOAT_TYPE case Lisp_Float: M("OA"); obj = *objptr = make_lispptr(objptr, *objptr); XUNMARK (XFLOAT (obj)->type); break; #endif /* LISP_FLOAT_TYPE */ default: abort (); } MLeave("O-"); } static void unpatch_chain(void **ptr, int offset) { while (*ptr) { *ptr = make_pointer(*ptr); ptr = (void **)((char *)*ptr + offset); } } /* CHFIXME: for all! */ #define MAKE_LISPPTR(a) a = make_lispptr(&a,a) #define MAKE_PTR(a) a = make_pointer(a) /* Reconstructs the addresses that were patched */ static void unpatch(void) { Lisp_Object LO; int fd, i; struct string_block *sptr; struct buffer *bptr; struct mem_header *mem; struct backtrace *backlist; struct catchtag *catch; print_ranges(); /* CHFIXME */ MInit("MLOG.unpatch"); #ifdef DBUG i = 0; #else for (i = 0; i < staticidx; i++) #endif { staticvec[i] = make_pointer(staticvec[i]); if (XMARKBIT(*staticvec[i])) { XUNMARK(*staticvec[i]); unpatch_pointers(staticvec[i]); } } #ifndef DBUG /* Unpatch all the pointers normally used before a dump ! */ unpatch_chain((void **)&cons_block, 0); unpatch_chain((void **)&cons_free_list, 0); unpatch_chain((void **)&all_vectors, 4); unpatch_chain((void **)&symbol_block, 0); unpatch_chain((void **)&symbol_free_list, 4); unpatch_chain((void **)&marker_block, 0); unpatch_chain((void **)&marker_free_list, 4); unpatch_chain((void **)&interval_block, 0); unpatch_chain((void **)&interval_free_list, 4*sizeof(long)); /* Strings are lots of fun */ unpatch_chain((void **)&large_string_blocks, 0); sptr = MAKE_PTR(first_string_block); MAKE_PTR(current_string_block); while (sptr) { if (sptr->next) MAKE_PTR(sptr->next); if (sptr->prev) MAKE_PTR(sptr->prev); sptr = sptr->next; } /* More fun with buffers */ bptr = MAKE_PTR(all_buffers); if (bptr) { while (bptr->next) { MAKE_PTR(bptr->next); bptr = bptr->next; } } MAKE_PTR(current_buffer); #ifdef LISP_FLOAT_TYPE unpatch_chain((void **) &float_block, 0); unpatch_chain((void **) &float_free_list, 0); #endif /* LISP_FLOAT_TYPE */ #if 0 /* CHFIXME needed ? */ /* even more fun with 19.25 backtrace */ MAKE_PTR(backtrace_list); for (backlist = backtrace_list; backlist; backlist = backlist->next) { if(backlist->next) MAKE_PTR(backlist->next); if (XMARKBIT (*backlist->function)) { XUNMARK (*backlist->function); unpatch_pointers(backlist->function); } if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) i = 0; else i = backlist->nargs - 1; for (; i >= 0; i--) if (XMARKBIT (backlist->args[i])) { XUNMARK (backlist->args[i]); unpatch_pointers(&backlist->args[i]); } } MAKE_PTR(catchlist); for (catch = catchlist; catch; catch = catch->next) { if(catch->next) MAKE_PTR(catch->next); unpatch_pointers (&catch->tag); unpatch_pointers (&catch->val); MAKE_PTR(catch->backlist); MAKE_PTR(catch->handlerlist); } #endif /* MAKE_PTR(gcprolist); CHFIXME */ MAKE_PTR(stack_copy); MAKE_PTR(kbd_macro_buffer); MAKE_PTR(minibuf_save_vector); MAKE_PTR(searchbuf.buffer); MAKE_PTR(searchbuf.fastmap); MAKE_PTR(specpdl); MAKE_PTR(read_buffer); #if 0 /* CHFIXME */ MouseMap = make_lispptr(&MouseMap, MouseMap); #endif MAKE_LISPPTR(current_global_map); MAKE_LISPPTR(global_map); MAKE_LISPPTR(meta_map); MAKE_LISPPTR(control_x_map); MAKE_LISPPTR(selected_window); MAKE_LISPPTR(Qvariable_documentation); #ifndef MULTI_FRAME /* CHFIXME: use makro */ MAKE_LISPPTR(the_only_frame.root_window); #else you lose; #endif MAKE_PTR(free_list); mem = free_list; while (mem) { MAKE_PTR(mem->prev); MAKE_PTR(mem->next); mem = mem->next; } for (i = 0; i <= 4; i++) MAKE_PTR(callint_argfuns[i]); MAKE_PTR(fail_stack.stack); MAKE_PTR(regstart); MAKE_PTR(regend); MAKE_PTR(old_regstart); MAKE_PTR(old_regend); MAKE_PTR(best_regstart); MAKE_PTR(best_regend); MAKE_PTR(reg_info); MAKE_PTR(reg_dummy); MAKE_PTR(reg_info_dummy); for(i = 0; i < HEAD_TABLE_SIZE; i++) { MAKE_PTR(head_table[i].var); MAKE_PTR(head_table[i].name); MAKE_PTR(head_table[i].kind); } for(i = 0; i < SCROLL_BAR_PARTS_SIZE; i++) MAKE_PTR(scroll_bar_parts[i]); MAKE_PTR(kbd_fetch_ptr); MAKE_PTR(kbd_store_ptr); XSET(LO, Lisp_Buffer, &buffer_local_types); unpatch_buffer(LO); MAKE_LISPPTR(Qdirectory_files); MAKE_LISPPTR(Qfile_name_completion); MAKE_LISPPTR(Qfile_name_all_completions); MAKE_LISPPTR(Qfile_attributes); MAKE_LISPPTR(Qset_visited_file_modtime); /* MAKE_LISPPTR(stream_process);*/ MAKE_PTR(message_text); /* search.c */ MAKE_PTR(search_regs.start); MAKE_PTR(search_regs.end); #endif MClean(); } static undump(char *fn) { BPTR fd; long code_size; char *_malloc_hunk; int *_pure; /*extern struct Library *FifoBase; struct Library *_FifoBase = FifoBase;*/ fd = Open(fn, MODE_OLDFILE); if (!fd) return 0; Read(fd, (char *)&puresize, sizeof puresize); Read(fd, (char *)&malloc_hunk_size, sizeof malloc_hunk_size); _pure = dump_malloc(puresize); _malloc_hunk = dump_malloc(malloc_hunk_size + pre_alloc); Read(fd, (char *)&first_data, (char *)&last_data - (char *)&first_data); Read(fd, (char *)&first_bss, (char *)&last_bss - (char *)&first_bss); Read(fd, (char *)_pure, puresize); Read(fd, (char *)_malloc_hunk, malloc_hunk_size); Read(fd, (char *)&staticidx, sizeof staticidx); Read(fd, (char *)staticvec, staticidx * sizeof(Lisp_Object *)); /*FifoBase = _FifoBase;*/ if (Read(fd, (char *)&code_size, sizeof code_size) != sizeof code_size || code_size != (char *)last_fn - (char *)first_fn) { Close(fd); bailout(fn); } Close(fd); malloc_hunk = _malloc_hunk; pure = _pure; return 1; } void map_out_data(char *fn) { if (amiga_initialized) error("You can only dump once !"); Fgarbage_collect(); #if 0 /* CHFIXME */ dump("EMACS-DATA.pre"); #endif patch(); dump(fn); unpatch(); #if 0 dump("EMACS-DATA.post"); #endif amiga_initialized = 1; } #ifndef MULTI_FRAME static struct x_display A_Display; #else you lose */ #endif void map_in_data(int load) { if (load && undump(NAME_DATA)) { unpatch(); #if 0 /*CHFIXME */ current_screen = new_screen = temp_screen = 0; message_buf = 0; #endif chars_wasted = 0; copybuf = 0; initialized = amiga_initialized = 1; /* CHFIXME: force errors if used but not patched */ handlerlist = (void *) -1; catchlist = (void *)-1; backtrace_list = (void *)-1; #if 0 FRAME_EXTERNAL_MENU_BAR(selected_frame) = 1; /* CHFIXME where to put? */ #endif } else { malloc_hunk = dump_malloc(malloc_hunk_size + pre_alloc); pure = dump_malloc(puresize); } #ifndef MULTI_FRAME FRAME_DISPLAY(selected_frame) = &A_Display; #else you lose again. #endif amiga_undump_reinit(); } void early_init_amiga_dump() { #ifndef MULTI_FRAME FRAME_DISPLAY(selected_frame) = &A_Display; #else you lose again. #endif }