From: BT Templeton Date: Wed, 10 Jul 2013 04:38:40 +0000 (-0400) Subject: record_unwind_protect error handling X-Git-Url: https://git.hcoop.net/bpt/emacs.git/commitdiff_plain/5d1922cd701711977a5b002dd544587ab03ce7e1 record_unwind_protect error handling --- diff --git a/src/callproc.c b/src/callproc.c index 70afbedeca..3647a1a03e 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -82,12 +82,7 @@ static Lisp_Object Vtemp_file_name_pattern; /* If nonzero, a process-ID that has not been reaped. */ static pid_t synch_process_pid; -/* If a string, the name of a temp file that has not been removed. */ -#ifdef MSDOS static Lisp_Object synch_process_tempfile; -#else -# define synch_process_tempfile make_number (0) -#endif /* Indexes of file descriptors that need closing on call_process_kill. */ enum @@ -103,7 +98,7 @@ enum CALLPROC_FDS }; -static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, ptrdiff_t); +static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int *, Lisp_Object *); /* Return the current buffer's working directory, or the home directory if it's unreachable, as a string suitable for a system call. @@ -161,9 +156,11 @@ record_kill_process (struct Lisp_Process *p, Lisp_Object tempfile) /* Clean up files, file descriptors and processes created by Fcall_process. */ static void -delete_temp_file (Lisp_Object name) +delete_temp_file_ptr (Lisp_Object *name_ptr) { - unlink (SSDATA (name)); + Lisp_Object name = *name_ptr; + if (! NILP (name)) + unlink (SSDATA (name)); } static void @@ -184,7 +181,7 @@ call_process_kill (void *ptr) synch_process_pid = 0; } else if (STRINGP (synch_process_tempfile)) - delete_temp_file (synch_process_tempfile); + delete_temp_file_ptr (&synch_process_tempfile); } /* Clean up when exiting Fcall_process: restore the buffer, and @@ -264,9 +261,9 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0); if (filefd < 0) report_file_error ("Opening process input file", infile); - record_unwind_protect_int (close_file_unwind, filefd); + record_unwind_protect_ptr (close_file_ptr_unwind, &filefd); UNGCPRO; - return unbind_to (count, call_process (nargs, args, filefd, -1)); + return unbind_to (count, call_process (nargs, args, &filefd, NULL)); } /* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file. @@ -278,8 +275,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * At entry, the specpdl stack top entry must be close_file_unwind (FILEFD). */ static Lisp_Object -call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, - ptrdiff_t tempfile_index) +call_process (ptrdiff_t nargs, Lisp_Object *args, int *filefd, Lisp_Object *tempfile_ptr) { Lisp_Object buffer, current_dir, path; bool display_p; @@ -570,7 +566,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, #ifdef MSDOS /* MW, July 1993 */ /* Note that on MSDOS `child_setup' actually returns the child process exit status, not its PID, so assign it to status below. */ - pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + pid = child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir); if (pid < 0) { @@ -589,8 +585,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, emacs_close (callproc_fd[i]); callproc_fd[i] = -1; } - emacs_close (filefd); - clear_unwind_protect (count - 1); + emacs_close (*filefd); + *filefd = -1; if (tempfile) { @@ -619,7 +615,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, block_child_signal (&oldset); #ifdef WINDOWSNT - pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + pid = child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir); #else /* not WINDOWSNT */ /* vfork, and prevent local vars from being clobbered by the vfork. */ @@ -629,7 +625,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, Lisp_Object volatile current_dir_volatile = current_dir; bool volatile display_p_volatile = display_p; int volatile fd_error_volatile = fd_error; - int volatile filefd_volatile = filefd; + int *volatile filefd_volatile = filefd; ptrdiff_t volatile count_volatile = count; char **volatile new_argv_volatile = new_argv; int volatile callproc_fd_volatile[CALLPROC_FDS]; @@ -665,7 +661,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, signal (SIGPROF, SIG_DFL); #endif - child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir); } #endif /* not WINDOWSNT */ @@ -678,14 +674,15 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, if (INTEGERP (buffer)) { - if (tempfile_index < 0) - record_deleted_pid (pid, Qnil); - else - { - eassert (1 < nargs); - record_deleted_pid (pid, args[1]); - clear_unwind_protect (tempfile_index); - } + if (tempfile_ptr) + { + record_deleted_pid (pid, *tempfile_ptr); + *tempfile_ptr = Qnil; + } + else + { + record_deleted_pid (pid, Qnil); + } synch_process_pid = 0; } } @@ -704,8 +701,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, emacs_close (callproc_fd[i]); callproc_fd[i] = -1; } - emacs_close (filefd); - clear_unwind_protect (count - 1); + emacs_close (*filefd); + *filefd = -1; #endif /* not MSDOS */ @@ -924,9 +921,9 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, Unwind-protect the file, so that the file descriptor will be closed and the file removed when the caller unwinds the specpdl stack. */ -static int +static void create_temp_file (ptrdiff_t nargs, Lisp_Object *args, - Lisp_Object *filename_string_ptr) + Lisp_Object *filename_string_ptr, int *fdp) { int fd; struct gcpro gcpro1; @@ -976,14 +973,14 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args, GCPRO1 (filename_string); tempfile = SSDATA (filename_string); - count = SPECPDL_INDEX (); - record_unwind_protect_nothing (); fd = mkostemp (tempfile, O_CLOEXEC); if (fd < 0) report_file_error ("Failed to open temporary file using pattern", pattern); - set_unwind_protect (count, delete_temp_file, filename_string); - record_unwind_protect_int (close_file_unwind, fd); + *fdp = fd; + *filename_string_ptr = filename_string; + record_unwind_protect (delete_temp_file_ptr, filename_string_ptr); + record_unwind_protect_ptr (close_file_ptr_unwind, fdp); } start = args[0]; @@ -1025,9 +1022,7 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args, /* Note that Fcall_process takes care of binding coding-system-for-read. */ - *filename_string_ptr = filename_string; UNGCPRO; - return fd; } DEFUN ("call-process-region", Fcall_process_region, Scall_process_region, @@ -1078,14 +1073,14 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } if (!empty_input) - fd = create_temp_file (nargs, args, &infile); + create_temp_file (nargs, args, &infile, &fd); else { infile = Qnil; fd = emacs_open (NULL_DEVICE, O_RDONLY, 0); if (fd < 0) report_file_error ("Opening null device", Qnil); - record_unwind_protect_int (close_file_unwind, fd); + record_unwind_protect_ptr (close_file_ptr_unwind, &fd); } GCPRO1 (infile); @@ -1105,7 +1100,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } args[1] = infile; - val = call_process (nargs, args, fd, empty_input ? -1 : count); + val = call_process (nargs, args, &fd, &infile); RETURN_UNGCPRO (unbind_to (count, val)); } @@ -1665,10 +1660,8 @@ syms_of_callproc (void) #endif staticpro (&Vtemp_file_name_pattern); -#ifdef MSDOS synch_process_tempfile = make_number (0); staticpro (&synch_process_tempfile); -#endif DEFVAR_LISP ("shell-file-name", Vshell_file_name, doc: /* File name to load inferior shells from. diff --git a/src/charset.c b/src/charset.c index fb285c6d7d..64d0152a80 100644 --- a/src/charset.c +++ b/src/charset.c @@ -484,7 +484,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, unsigned min_code = CHARSET_MIN_CODE (charset); unsigned max_code = CHARSET_MAX_CODE (charset); int fd; - FILE *fp; + FILE *fp = NULL; Lisp_Object suffixes; struct charset_map_entries *head, *entries; int n_entries; @@ -493,7 +493,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, suffixes = list2 (build_string (".map"), build_string (".TXT")); count = SPECPDL_INDEX (); - record_unwind_protect_nothing (); + record_unwind_protect_ptr (fclose_ptr_unwind, &fp); specbind (Qfile_name_handler_alist, Qnil); fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil, false); fp = fd < 0 ? 0 : fdopen (fd, "r"); @@ -503,7 +503,6 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, emacs_close (fd); report_file_errno ("Loading charset map", mapfile, open_errno); } - set_unwind_protect_ptr (count, fclose_unwind, fp); unbind_to (count + 1, Qnil); /* Use record, as `charset_map_entries' is large (larger than @@ -551,7 +550,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, n_entries++; } fclose (fp); - clear_unwind_protect (count); + fp = NULL; load_charset_map (charset, head, n_entries, control_flag); unbind_to (count, Qnil); diff --git a/src/dired.c b/src/dired.c index f2784f7177..f603911ad7 100644 --- a/src/dired.c +++ b/src/dired.c @@ -146,9 +146,6 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; struct dirent *dp; -#ifdef WINDOWSNT - Lisp_Object w32_save = Qnil; -#endif /* Because of file name handlers, these functions might call Ffuncall, and cause a GC. */ @@ -203,7 +200,6 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, file in the directory, when we call Ffile_attributes below. */ record_unwind_protect (directory_files_internal_w32_unwind, Vw32_get_true_file_attributes); - w32_save = Vw32_get_true_file_attributes; if (EQ (Vw32_get_true_file_attributes, Qlocal)) { /* w32.c:stat will notice these bindings and avoid calling @@ -310,16 +306,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, UNGCPRO; } - block_input (); - closedir (d); - unblock_input (); -#ifdef WINDOWSNT - if (attrs) - Vw32_get_true_file_attributes = w32_save; -#endif - - /* Discard the unwind protect. */ - specpdl_ptr = specpdl + count; + unbind_to (count, Qnil); if (NILP (nosort)) list = Fsort (Fnreverse (list), diff --git a/src/eval.c b/src/eval.c index c44fa643c8..d6c0e8751e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1140,6 +1140,8 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object This is used for correct unwinding in Fthrow and Fsignal. */ +static Lisp_Object unbind_to_1 (ptrdiff_t, Lisp_Object, bool); + static _Noreturn void unwind_to_catch (struct handler *catch, Lisp_Object value) { @@ -1159,7 +1161,7 @@ unwind_to_catch (struct handler *catch, Lisp_Object value) { /* Unwind the specpdl stack, and then restore the proper set of handlers. */ - unbind_to (handlerlist->pdlcount, Qnil); + unbind_to_1 (handlerlist->pdlcount, Qnil, false); last_time = handlerlist == catch; if (! last_time) handlerlist = handlerlist->next; @@ -3178,89 +3180,74 @@ specbind (Lisp_Object symbol, Lisp_Object value) /* Push unwind-protect entries of various types. */ void -record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) +record_unwind_protect_1 (void (*function) (Lisp_Object), Lisp_Object arg, + bool wind_explicitly) { specpdl_ptr->unwind.kind = SPECPDL_UNWIND; specpdl_ptr->unwind.func = function; specpdl_ptr->unwind.arg = arg; + specpdl_ptr->unwind.wind_explicitly = wind_explicitly; grow_specpdl (); } void -record_unwind_protect_ptr (void (*function) (void *), void *arg) +record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) { - specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR; - specpdl_ptr->unwind_ptr.func = function; - specpdl_ptr->unwind_ptr.arg = arg; - grow_specpdl (); + record_unwind_protect_1 (function, arg, true); } void -record_unwind_protect_int (void (*function) (int), int arg) +record_unwind_protect_ptr_1 (void (*function) (void *), void *arg, + bool wind_explicitly) { - specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT; - specpdl_ptr->unwind_int.func = function; - specpdl_ptr->unwind_int.arg = arg; + specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR; + specpdl_ptr->unwind_ptr.func = function; + specpdl_ptr->unwind_ptr.arg = arg; + specpdl_ptr->unwind_ptr.wind_explicitly = wind_explicitly; grow_specpdl (); } void -record_unwind_protect_void (void (*function) (void)) +record_unwind_protect_ptr (void (*function) (void *), void *arg) { - specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID; - specpdl_ptr->unwind_void.func = function; - grow_specpdl (); + record_unwind_protect_ptr_1 (function, arg, true); } -static void -do_nothing (void) -{} - -/* Push an unwind-protect entry that does nothing, so that - set_unwind_protect_ptr can overwrite it later. */ - void -record_unwind_protect_nothing (void) +record_unwind_protect_int_1 (void (*function) (int), int arg, + bool wind_explicitly) { - record_unwind_protect_void (do_nothing); + specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT; + specpdl_ptr->unwind_int.func = function; + specpdl_ptr->unwind_int.arg = arg; + specpdl_ptr->unwind_int.wind_explicitly = wind_explicitly; + grow_specpdl (); } -/* Clear the unwind-protect entry COUNT, so that it does nothing. - It need not be at the top of the stack. */ - void -clear_unwind_protect (ptrdiff_t count) +record_unwind_protect_int (void (*function) (int), int arg) { - union specbinding *p = specpdl + count; - p->unwind_void.kind = SPECPDL_UNWIND_VOID; - p->unwind_void.func = do_nothing; + record_unwind_protect_int_1 (function, arg, true); } -/* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG). - It need not be at the top of the stack. Discard the entry's - previous value without invoking it. */ - void -set_unwind_protect (ptrdiff_t count, void (*func) (Lisp_Object), - Lisp_Object arg) +record_unwind_protect_void_1 (void (*function) (void), + bool wind_explicitly) { - union specbinding *p = specpdl + count; - p->unwind.kind = SPECPDL_UNWIND; - p->unwind.func = func; - p->unwind.arg = arg; + specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID; + specpdl_ptr->unwind_void.func = function; + specpdl_ptr->unwind_void.wind_explicitly = wind_explicitly; + grow_specpdl (); } void -set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg) +record_unwind_protect_void (void (*function) (void)) { - union specbinding *p = specpdl + count; - p->unwind_ptr.kind = SPECPDL_UNWIND_PTR; - p->unwind_ptr.func = func; - p->unwind_ptr.arg = arg; + record_unwind_protect_void_1 (function, true); } void -unbind_once (void) +unbind_once (bool explicit) { /* Decrement specpdl_ptr before we do the work to unbind it, so that an error in unbinding won't try to unbind the same entry @@ -3272,16 +3259,20 @@ unbind_once (void) switch (specpdl_ptr->kind) { case SPECPDL_UNWIND: - specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg); + if (specpdl_ptr->unwind.wind_explicitly || ! explicit) + specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg); break; case SPECPDL_UNWIND_PTR: - specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg); + if (specpdl_ptr->unwind_ptr.wind_explicitly || ! explicit) + specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg); break; case SPECPDL_UNWIND_INT: - specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg); + if (specpdl_ptr->unwind_int.wind_explicitly || ! explicit) + specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg); break; case SPECPDL_UNWIND_VOID: - specpdl_ptr->unwind_void.func (); + if (specpdl_ptr->unwind_void.wind_explicitly || ! explicit) + specpdl_ptr->unwind_void.func (); break; case SPECPDL_BACKTRACE: break; @@ -3321,11 +3312,34 @@ unbind_once (void) } } -/* Pop and execute entries from the unwind-protect stack until the - depth COUNT is reached. Return VALUE. */ +void +dynwind_begin (void) +{ + specpdl_ptr->kind = SPECPDL_FRAME; + grow_specpdl (); +} -Lisp_Object -unbind_to (ptrdiff_t count, Lisp_Object value) +void +dynwind_end (void) +{ + enum specbind_tag last; + Lisp_Object quitf = Vquit_flag; + union specbinding *pdl = specpdl_ptr; + + Vquit_flag = Qnil; + + do + pdl--; + while (pdl->kind != SPECPDL_FRAME); + + while (specpdl_ptr != pdl) + unbind_once (true); + + Vquit_flag = quitf; +} + +static Lisp_Object +unbind_to_1 (ptrdiff_t count, Lisp_Object value, bool explicit) { Lisp_Object quitf = Vquit_flag; struct gcpro gcpro1, gcpro2; @@ -3334,7 +3348,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value) Vquit_flag = Qnil; while (specpdl_ptr != specpdl + count) - unbind_once (); + unbind_once (explicit); if (NILP (Vquit_flag) && !NILP (quitf)) Vquit_flag = quitf; @@ -3343,6 +3357,12 @@ unbind_to (ptrdiff_t count, Lisp_Object value) return value; } +Lisp_Object +unbind_to (ptrdiff_t count, Lisp_Object value) +{ + return unbind_to_1 (count, value, true); +} + DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0, doc: /* Return non-nil if SYMBOL's global binding has been declared special. A special variable is one that will be bound dynamically, even in a diff --git a/src/fileio.c b/src/fileio.c index 3b4776cc65..cc3b4ebe88 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -273,6 +273,14 @@ close_file_unwind (int fd) emacs_close (fd); } +void +close_file_ptr_unwind (void *fdp) +{ + int fd = *((int *) fdp); + if (fd >= 0) + emacs_close (fd); +} + void fclose_unwind (void *arg) { @@ -280,6 +288,14 @@ fclose_unwind (void *arg) fclose (stream); } +void +fclose_ptr_unwind (void *arg) +{ + FILE *stream = *((void **) arg); + if (stream) + fclose (stream); +} + /* Restore point, having saved it as a marker. */ void @@ -2015,7 +2031,7 @@ permissions. */) if (ifd < 0) report_file_error ("Opening input file", file); - record_unwind_protect_int (close_file_unwind, ifd); + record_unwind_protect_int_1 (close_file_unwind, ifd, false); if (fstat (ifd, &st) != 0) report_file_error ("Input file status", file); @@ -2056,7 +2072,7 @@ permissions. */) if (ofd < 0) report_file_error ("Opening output file", newname); - record_unwind_protect_int (close_file_unwind, ofd); + record_unwind_protect_int_1 (close_file_unwind, ofd, false); if (already_exists) { @@ -2160,8 +2176,7 @@ permissions. */) #endif /* MSDOS */ #endif /* not WINDOWSNT */ - /* Discard the unwind protects. */ - specpdl_ptr = specpdl + count; + unbind_to (count, Qnil); UNGCPRO; return Qnil; @@ -3494,7 +3509,7 @@ by calling `format-decode', which see. */) } fd_index = SPECPDL_INDEX (); - record_unwind_protect_int (close_file_unwind, fd); + record_unwind_protect_ptr (close_file_ptr_unwind, &fd); /* Replacement should preserve point as it preserves markers. */ if (!NILP (replace)) @@ -3625,10 +3640,10 @@ by calling `format-decode', which see. */) report_file_error ("Read error", orig_filename); else if (nread > 0) { - struct buffer *prev = current_buffer; Lisp_Object workbuf; struct buffer *buf; + ptrdiff_t count1 = SPECPDL_INDEX (); record_unwind_current_buffer (); workbuf = Fget_buffer_create (build_string (" *code-converting-work*")); @@ -3650,11 +3665,8 @@ by calling `format-decode', which see. */) TEMP_SET_PT_BOTH (BEG, BEG_BYTE); coding_system = call2 (Vset_auto_coding_function, filename, make_number (nread)); - set_buffer_internal (prev); - /* Discard the unwind protect for recovering the - current buffer. */ - specpdl_ptr--; + unbind_to (count1, Qnil); /* Rewind the file for the actual read done later. */ if (lseek (fd, 0, SEEK_SET) < 0) @@ -3772,7 +3784,7 @@ by calling `format-decode', which see. */) if (same_at_start - BEGV_BYTE == end_offset - beg_offset) { emacs_close (fd); - clear_unwind_protect (fd_index); + fd = -1; /* Truncate the buffer to the size of the file. */ del_range_1 (same_at_start, same_at_end, 0, 0); @@ -3951,7 +3963,7 @@ by calling `format-decode', which see. */) if (this < 0) report_file_error ("Read error", orig_filename); emacs_close (fd); - clear_unwind_protect (fd_index); + fd = -1; if (unprocessed > 0) { @@ -4195,7 +4207,7 @@ by calling `format-decode', which see. */) Vdeactivate_mark = Qt; emacs_close (fd); - clear_unwind_protect (fd_index); + fd = -1; if (how_much < 0) report_file_error ("Read error", orig_filename); @@ -4845,7 +4857,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, } count1 = SPECPDL_INDEX (); - record_unwind_protect_int (close_file_unwind, desc); + record_unwind_protect_int_1 (close_file_unwind, desc, false); } if (NUMBERP (append)) @@ -4921,8 +4933,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, if (emacs_close (desc) < 0) ok = 0, save_errno = errno; - /* Discard the unwind protect for close_file_unwind. */ - specpdl_ptr = specpdl + count1; + unbind_to (count1, Qnil); } /* Some file systems have a bug where st_mtime is not updated diff --git a/src/fns.c b/src/fns.c index ba6fabef29..931a08331d 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4280,7 +4280,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, } else { - struct buffer *prev = current_buffer; + ptrdiff_t count = SPECPDL_INDEX (); record_unwind_current_buffer (); @@ -4374,10 +4374,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, } object = make_buffer_string (b, e, 0); - set_buffer_internal (prev); - /* Discard the unwind protect for recovering the current - buffer. */ - specpdl_ptr--; + unbind_to (count, Qnil); if (STRING_MULTIBYTE (object)) object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); diff --git a/src/lisp.h b/src/lisp.h index 5aad565497..2ceab5fa5a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2563,21 +2563,25 @@ union specbinding } frame; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (Lisp_Object); Lisp_Object arg; } unwind; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (void *); void *arg; } unwind_ptr; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (int); int arg; } unwind_int; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool wind_explicitly; void (*func) (void); } unwind_void; struct { @@ -3442,14 +3446,14 @@ extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); extern void specbind (Lisp_Object, Lisp_Object); +extern void record_unwind_protect_1 (void (*) (Lisp_Object), Lisp_Object, bool); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); +extern void record_unwind_protect_ptr_1 (void (*) (void *), void *, bool); extern void record_unwind_protect_ptr (void (*) (void *), void *); +extern void record_unwind_protect_int_1 (void (*) (int), int, bool); extern void record_unwind_protect_int (void (*) (int), int); +extern void record_unwind_protect_void_1 (void (*) (void), bool); extern void record_unwind_protect_void (void (*) (void)); -extern void record_unwind_protect_nothing (void); -extern void clear_unwind_protect (ptrdiff_t); -extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object); -extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *); extern void dynwind_begin (void); extern void dynwind_end (void); extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); @@ -3534,7 +3538,9 @@ extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int); extern void close_file_unwind (int); +extern void close_file_ptr_unwind (void *); extern void fclose_unwind (void *); +extern void fclose_ptr_unwind (void *); extern void restore_point_unwind (Lisp_Object); extern _Noreturn void report_file_errno (const char *, Lisp_Object, int); extern _Noreturn void report_file_error (const char *, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 0f7b42b77a..908db2933c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1046,7 +1046,7 @@ Return t if the file exists and loads successfully. */) (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix) { - FILE *stream; + FILE *stream = NULL; int fd; int fd_index; ptrdiff_t count = SPECPDL_INDEX (); @@ -1187,7 +1187,8 @@ Return t if the file exists and loads successfully. */) else { fd_index = SPECPDL_INDEX (); - record_unwind_protect_int (close_file_unwind, fd); + record_unwind_protect_ptr (close_file_ptr_unwind, &fd); + record_unwind_protect_ptr (fclose_ptr_unwind, &stream); } /* Check if we're stuck in a recursive load cycle. @@ -1300,7 +1301,7 @@ Return t if the file exists and loads successfully. */) if (fd >= 0) { emacs_close (fd); - clear_unwind_protect (fd_index); + fd = -1; } val = call4 (Vload_source_file_function, found, hist_file_name, NILP (noerror) ? Qnil : Qt, @@ -1323,7 +1324,7 @@ Return t if the file exists and loads successfully. */) { #ifdef WINDOWSNT emacs_close (fd); - clear_unwind_protect (fd_index); + fd = -1; efound = ENCODE_FILE (found); stream = emacs_fopen (SSDATA (efound), fmode); #else @@ -1332,7 +1333,6 @@ Return t if the file exists and loads successfully. */) } if (! stream) report_file_error ("Opening stdio stream", file); - set_unwind_protect_ptr (fd_index, fclose_unwind, stream); if (! NILP (Vpurify_flag)) Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list); diff --git a/src/process.c b/src/process.c index 82d1773a19..3ef9ca1ceb 100644 --- a/src/process.c +++ b/src/process.c @@ -2565,7 +2565,7 @@ usage: (make-serial-process &rest ARGS) */) CHECK_STRING (name); proc = make_process (name); specpdl_count = SPECPDL_INDEX (); - record_unwind_protect (remove_process, proc); + record_unwind_protect_1 (remove_process, proc, false); p = XPROCESS (proc); fd = serial_open (port); @@ -2648,7 +2648,7 @@ usage: (make-serial-process &rest ARGS) */) Fserial_process_configure (nargs, args); - specpdl_ptr = specpdl + specpdl_count; + unbind_to (specpdl_count, Qnil); UNGCPRO; return proc; @@ -3162,7 +3162,7 @@ usage: (make-network-process &rest ARGS) */) #endif /* Make us close S if quit. */ - record_unwind_protect_int (close_file_unwind, s); + record_unwind_protect_int_1 (close_file_unwind, s, false); /* Parse network options in the arg list. We simply ignore anything which isn't a known option (including other keywords). @@ -3269,8 +3269,7 @@ usage: (make-network-process &rest ARGS) */) immediate_quit = 0; - /* Discard the unwind protect closing S. */ - specpdl_ptr = specpdl + count1; + unbind_to (count1, Qnil); emacs_close (s); s = -1; @@ -3378,8 +3377,7 @@ usage: (make-network-process &rest ARGS) */) p->infd = inch; p->outfd = outch; - /* Discard the unwind protect for closing S, if any. */ - specpdl_ptr = specpdl + count1; + unbind_to (count1, Qnil); /* Unwind bind_polling_period and request_sigio. */ unbind_to (count, Qnil); @@ -4043,7 +4041,7 @@ server_accept_connection (Lisp_Object server, int channel) } count = SPECPDL_INDEX (); - record_unwind_protect_int (close_file_unwind, s); + record_unwind_protect_int_1 (close_file_unwind, s, false); connect_counter++; @@ -4162,8 +4160,7 @@ server_accept_connection (Lisp_Object server, int channel) pset_command (p, Qnil); p->pid = 0; - /* Discard the unwind protect for closing S. */ - specpdl_ptr = specpdl + count; + unbind_to (count, Qnil); p->open_fd[SUBPROCESS_STDIN] = s; p->infd = s; diff --git a/src/sysdep.c b/src/sysdep.c index a083a887e8..e440d14ae4 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3070,13 +3070,11 @@ system_process_attributes (Lisp_Object pid) { ptrdiff_t readsize, nread_incr; record_unwind_protect_int (close_file_unwind, fd); - record_unwind_protect_nothing (); nread = cmdline_size = 0; do { cmdline = xpalloc (cmdline, &cmdline_size, 2, STRING_BYTES_BOUND, 1); - set_unwind_protect_ptr (count + 1, xfree, cmdline); /* Leave room even if every byte needs escaping below. */ readsize = (cmdline_size >> 1) - nread; @@ -3110,7 +3108,6 @@ system_process_attributes (Lisp_Object pid) nread = cmdsize + 2; cmdline_size = nread + 1; q = cmdline = xrealloc (cmdline, cmdline_size); - set_unwind_protect_ptr (count + 1, xfree, cmdline); sprintf (cmdline, "[%.*s]", cmdsize, cmd); } /* Command line is encoded in locale-coding-system; decode it. */