emacs hangs in garbage collection related code

[Alex Schroeder]

Your bug report will be posted to the address@hidden mailing list.

In GNU Emacs 21.2.92.1 (i686-pc-linux-gnu, X toolkit, Xaw3d scroll bars)
 of 2003-01-19 on confusibombus
Important settings:
  value of $LC_ALL: nil
  value of $LC_COLLATE: nil
  value of $LC_CTYPE: nil
  value of $LC_MESSAGES: nil
  value of $LC_MONETARY: nil
  value of $LC_NUMERIC: nil
  value of $LC_TIME: nil
  value of $LANG: en_US.ISO-8859-1
  locale-coding-system: iso-latin-1
  default-enable-multibyte-characters: t

I was testing my http-get function posted to gnu.emacs.sources the
other day and crashed Emacs.  At the time, Emacs did not run under a
debugger and on a Microsoft operating system.  This time, however, I
was at home on my GNU/Linux system.  So I sent a kill signal to Emacs
and switched to GDB.

(gdb) bt
#0  0x402e8581 in kill () from /lib/libc.so.6
#1  0x080d1e0e in abort () at emacs.c:387
#2  0x081259af in Fsignal (error_symbol=405338420, data=1495614164)
    at eval.c:1387
#3  0x08116fc8 in wrong_type_argument (predicate=405338828, value=405410316)
    at data.c:119
#4  0x0812d5bc in Fplist_get (plist=-668215420, prop=405410316) at fns.c:1884
#5  0x0812d604 in Fget (symbol=405650796, propname=405410316) at fns.c:1896
#6  0x0808c61f in Fcoding_system_p (obj=405650796) at coding.c:6139
#7  0x0808c739 in Fcheck_coding_system (coding_system=405650796)
    at coding.c:6185
#8  0x0808d313 in code_convert_string_norecord (string=959562188, 
    coding_system=405650796, encodep=1) at coding.c:6614
#9  0x080eef37 in unlock_file (fn=959562044) at filelock.c:651
#10 0x080eefde in unlock_all_files () at filelock.c:670
#11 0x080d34c2 in shut_down_emacs (sig=15, no_x=0, stuff=405241980)
    at emacs.c:1886
#12 0x080d1d91 in fatal_error_signal (sig=15) at emacs.c:341
#13 0x402e8518 in sigaction () from /lib/libc.so.6
#14 0x08115edd in mark_object (argptr=0x843c290) at alloc.c:4611
#15 0x08115edd in mark_object (argptr=0x8434860) at alloc.c:4611
#16 0x08115f19 in mark_object (argptr=0x87362fc) at alloc.c:4623
#17 0x08115edd in mark_object (argptr=0x873524c) at alloc.c:4611
...
#314 0x08115f25 in mark_object (argptr=0x8ff6454) at alloc.c:4624
#315 0x08116079 in mark_object (argptr=0x8f5b584) at alloc.c:4721
#316 0x08112d9c in mark_interval (i=0x8f5b56c, dummy=405241980) at alloc.c:953
---Type <return> to continue, or q <return> to quit---
#317 0x0815a194 in traverse_intervals (tree=0x8f5b56c, position=1, depth=10, 
    function=0x8112d74 <mark_interval>, arg=405241980) at intervals.c:207
#318 0x0815a178 in traverse_intervals (tree=0x8f5b4c4, position=1, depth=9, 
    function=0x8112d74 <mark_interval>, arg=405241980) at intervals.c:204
...
#939 0x08116079 in mark_object (argptr=0x8333c5c) at alloc.c:4721
#940 0x08115edd in mark_object (argptr=0x8299864) at alloc.c:4611
#941 0x08116079 in mark_object (argptr=0x82f49a8) at alloc.c:4721
#942 0x08115f34 in mark_object (argptr=0x8371e10) at alloc.c:4625
#943 0x08115edd in mark_object (argptr=0x8373e38) at alloc.c:4611
#944 0x08115f34 in mark_object (argptr=0x833738c) at alloc.c:4625
#945 0x08116079 in mark_object (argptr=0x839a36c) at alloc.c:4721
#946 0x08115edd in mark_object (argptr=0x833721c) at alloc.c:4611
...
#1262 0x08115f25 in mark_object (argptr=0x901ee88) at alloc.c:4624
#1263 0x08115edd in mark_object (argptr=0x8ee3d8c) at alloc.c:4611
#1264 0x08115f25 in mark_object (argptr=0x8ff85bc) at alloc.c:4624
#1265 0x08116079 in mark_object (argptr=0x829ddd0) at alloc.c:4721
#1266 0x08115f34 in mark_object (argptr=0x840e0a4) at alloc.c:4625
#1267 0x08116079 in mark_object (argptr=0x82ae288) at alloc.c:4721
---Type <return> to continue, or q <return> to quit---q
Quit


Wow.

#1438 0x08116079 in mark_object (argptr=0x8278088) at alloc.c:4721
#1439 0x08115f34 in mark_object (argptr=0x82780a0) at alloc.c:4625
#1440 0x08115f34 in mark_object (argptr=0x8f901f0) at alloc.c:4625
#1441 0x08115f19 in mark_object (argptr=0x827d0c0) at alloc.c:4623
#1442 0x08115edd in mark_object (argptr=0x8275940) at alloc.c:4611
#1443 0x0811551f in Fgarbage_collect () at alloc.c:4092
#1444 0x08126582 in Feval (form=1495614076) at eval.c:1912
#1445 0x08126959 in Feval (form=1483470892) at eval.c:2069
#1446 0x08124603 in Fprogn (args=1483470524) at eval.c:431
#1447 0x0812507d in Fwhile (args=1483470900) at eval.c:897
---Type <return> to continue, or q <return> to quit---
#1448 0x081266cc in Feval (form=1483466932) at eval.c:1960
#1449 0x08124603 in Fprogn (args=1483466940) at eval.c:431
#1450 0x081252dd in internal_catch (tag=405536924, func=0x8124564 <Fprogn>, 
    arg=1483466940) at eval.c:1030
#1451 0x08125236 in Fcatch (args=1483466980) at eval.c:999
#1452 0x081266cc in Feval (form=1483467004) at eval.c:1960
#1453 0x08124603 in Fprogn (args=1483470140) at eval.c:431
#1454 0x0811dd73 in Fsave_excursion (args=1483470140) at editfns.c:902
#1455 0x081266cc in Feval (form=1483467012) at eval.c:1960
#1456 0x08124603 in Fprogn (args=1497210740) at eval.c:431
#1457 0x081266cc in Feval (form=1497210732) at eval.c:1960
#1458 0x081244ef in Fif (args=1481800164) at eval.c:364
#1459 0x081266cc in Feval (form=1494530556) at eval.c:1960
#1460 0x08126959 in Feval (form=1483467140) at eval.c:2069
#1461 0x08124603 in Fprogn (args=1483467148) at eval.c:431
#1462 0x08127731 in funcall_lambda (fun=1483470116, nargs=0, 
    arg_vector=0xbfffe5fc) at eval.c:2844
#1463 0x08127301 in Ffuncall (nargs=1, args=0xbfffe5f8) at eval.c:2716
#1464 0x08126d9f in run_hook_with_args (nargs=1, args=0xbfffe5f8, 
    cond=to_completion) at eval.c:2330
#1465 0x08126c1b in Frun_hooks (nargs=1, args=0xbfffe614) at eval.c:2198
#1466 0x08126757 in Feval (form=1483466500) at eval.c:1986
#1467 0x08124603 in Fprogn (args=1483466572) at eval.c:431
---Type <return> to continue, or q <return> to quit---
#1468 0x0811dd73 in Fsave_excursion (args=1483466572) at editfns.c:902
#1469 0x081266cc in Feval (form=1483466612) at eval.c:1960
#1470 0x08124603 in Fprogn (args=1483466404) at eval.c:431
#1471 0x08125004 in Flet (args=1483466620) at eval.c:875
#1472 0x081266cc in Feval (form=1483466700) at eval.c:1960
#1473 0x08124603 in Fprogn (args=1495827044) at eval.c:431
#1474 0x0811ddbf in Fsave_current_buffer (args=1495827044) at editfns.c:917
#1475 0x081266cc in Feval (form=1495826924) at eval.c:1960
#1476 0x08126959 in Feval (form=1483466756) at eval.c:2069
#1477 0x08124603 in Fprogn (args=1483466764) at eval.c:431
#1478 0x08127731 in funcall_lambda (fun=1483466316, nargs=2, 
    arg_vector=0xbfffec28) at eval.c:2844
#1479 0x08127301 in Ffuncall (nargs=3, args=0xbfffec24) at eval.c:2716
#1480 0x08126be5 in Fapply (nargs=2, args=0xbfffeca4) at eval.c:2169
#1481 0x08126ee1 in apply1 (fn=409820308, arg=1495827188) at eval.c:2423
#1482 0x08151d17 in read_process_output_call (fun_and_args=1495827164)
    at process.c:2872
#1483 0x08125844 in internal_condition_case_1 (
    bfun=0x8151cfc <read_process_output_call>, arg=1495827164, 
    handlers=405338372, hfun=0x8151d1c <read_process_output_error_handler>)
    at eval.c:1307
#1484 0x08152055 in read_process_output (proc=1229984936, channel=9)
    at process.c:3053
---Type <return> to continue, or q <return> to quit---
#1485 0x08151b98 in wait_reading_process_input (time_limit=30, microsecs=0, 
    read_kbd=268435455, do_display=1) at process.c:2774
#1486 0x08057323 in sit_for (sec=30, usec=0, reading=1, display=1, 
    initial_display=0) at dispnew.c:6240
#1487 0x080d6175 in read_char (commandflag=1, nmaps=4, maps=0xbffff584, 
    prev_event=405241980, used_mouse_menu=0xbffff5cc) at keyboard.c:2500
#1488 0x080dc6d3 in read_key_sequence (keybuf=0xbffff6d4, bufsize=30, 
    prompt=405241980, dont_downcase_last=0, can_return_switch_frame=1, 
    fix_current_buffer=1) at keyboard.c:8191
#1489 0x080d4844 in command_loop_1 () at keyboard.c:1440
#1490 0x08125749 in internal_condition_case (bfun=0x80d4550 <command_loop_1>, 
    handlers=405338372, hfun=0x80d4194 <cmd_error>) at eval.c:1267
#1491 0x080d4428 in command_loop_2 () at keyboard.c:1245
#1492 0x081252dd in internal_catch (tag=405299700, 
    func=0x80d4404 <command_loop_2>, arg=405241980) at eval.c:1030
#1493 0x080d43d7 in command_loop () at keyboard.c:1224
#1494 0x080d3f51 in recursive_edit_1 () at keyboard.c:950
#1495 0x080d4080 in Frecursive_edit () at keyboard.c:1006
#1496 0x080d2faf in main (argc=1, argv=0xbffffc94, envp=0xbffffc9c)
    at emacs.c:1547
(gdb) 


How would I start debugging such a beast?  If you are interested in
the repeating the experiment...

Paste the following into emacs -q scratch buffer, and hit C-j after
either line.

(load-file "~/elisp/http-get.el")
(http-get "http://www.linuxwiki.de/"; nil nil 1.1)

I tried this twice.  On both occasions, Emacs got stuck.
The second time around, I started gdb and attached it to the running
Emacs and did a bt.  It sure seems to be the same problem.

0x08115a59 in mark_object (argptr=0x83c666c) at alloc.c:4363
4363    {
(gdb) bt
#0  0x08115a59 in mark_object (argptr=0x83c666c) at alloc.c:4363
#1  0x08115edd in mark_object (argptr=0x8320a20) at alloc.c:4611
#2  0x08115edd in mark_object (argptr=0x82e462c) at alloc.c:4611
#3  0x08116079 in mark_object (argptr=0x828b10c) at alloc.c:4721
#4  0x08115edd in mark_object (argptr=0x82e4694) at alloc.c:4611
#5  0x08116079 in mark_object (argptr=0x82f4c18) at alloc.c:4721
#6  0x08115f34 in mark_object (argptr=0x84fbb58) at alloc.c:4625
#7  0x08115edd in mark_object (argptr=0x82e6c5c) at alloc.c:4611

What follows is the code in http-get.el -- the important part could be
the (set-process-coding-system proc 'binary)...

Alex.

;;; http-get.el --- simple HTTP GET

;; Copyright (C) 2002, 2003  Alex Schroeder

;; Author: Alex Schroeder <address@hidden>
;; Maintainer: Alex Schroeder <address@hidden>
;; Version: 1.0.1
;; Keywords: hypermedia
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?HttpGet

;; This file is not part of GNU Emacs.

;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Use `http-get' to download an URL.

;;; Code:

(require 'hexl)

;; Filtering

(defvar http-filter-pre-insert-hook nil
  "Hook run by the `http-filter'.
This is called whenever a chunk of input arrives, before it is
inserted into the buffer.  If you want to modify the string that gets
inserted, modify the variable `string' which is dynamically bound to
what will get inserted in the end.  The string will be inserted at
the process-mark, which you can get by calling \(process-mark proc).
`proc' is dynamically bound to the process, and the current buffer
is the very buffer where the string will be inserted.  Note that
`http-unchunk' does not deal gracefully with changed input -- so only
change `string' if you know that `http-unchunk' will not run.")

(defvar http-filter-post-insert-hook '(http-headers http-unchunk)
  "Hook run by the `http-filter'.
This is called whenever a chunk of input arrives, after it has been
inserted, but before the process-mark has moved.  Therefore, the new
text lies between the process-mark and point.  You can get the value
of the process-mark by calling \(process-mark proc).  Please take care
to leave point at the right place, eg.  by wrapping your code in a
`save-excursion'.")

(defun http-filter (proc string)
  "Filter function for HTTP buffers.
See `http-filter-pre-insert-hook' and `http-filter-post-insert-hook'
for places where you can do your own stuff such as HTML rendering."
  (with-current-buffer (process-buffer proc)
    (let ((moving (= (point) (process-mark proc))))
      (save-excursion
        ;; Insert the text, advancing the process marker.
        (goto-char (process-mark proc))
        (run-hooks 'http-filter-pre-insert-hook)
        (insert string)
        (run-hooks 'http-filter-post-insert-hook)
        (set-marker (process-mark proc) (point)))
      (if moving (goto-char (process-mark proc))))))

;; Dealing with headers

(defvar http-status-code nil
  "The status code returned for the current buffer.
This is set by the function `http-headers'.")

(defvar http-reason-phrase nil
  "The reason phrase returned for the `http-status-code'.
This is set by the function `http-headers'.")

(defvar http-headers nil
  "An alist of the headers that have been parsed and removed from the buffer.
The headers are stored as an alist.
This is set by the function `http-headers'.")

(defun http-headers ()
  "Check the current buffer for headers.
If any are found, they are stored in the variable `http-headers'."
  (unless http-headers
    (save-excursion
      (goto-char (point-min))
      (when (looking-at "HTTP/[0-9.]+ \\([0-9]+\\) \\(.*\\)\r\n")
        (set (make-local-variable 'http-status-code)
             (string-to-number (match-string 1)))
        (set (make-local-variable 'http-reason-phrase)
             (match-string 2))
        (when (search-forward "\r\n\r\n")
          (set (make-local-variable 'http-headers)
               (mapcar (lambda (line)
                         (if (string-match ": " line)
                             (cons (substring line 0 (match-beginning 0))
                                   (substring line (match-end 0)))
                           line))
                       (split-string (buffer-substring (point-min) (point)) 
"\r\n")))
          (delete-region (point-min) (point))
          (message http-reason-phrase)
          http-status-code)))))

;; Dealing with the chunked encoding

(defvar http-unchunk-chunk-size 0
  "Size of the current unfinished chunk.")
(make-variable-buffer-local 'http-unchunk-chunk-size)

(defun http-unchunk ()
  "Undo the chunking transfer encoding.
The counter http-unchunk-chunk-size says how much content we still have to
expect.  Whenever a chunk-size is received, it is increased, whenever we insert
text into the buffer, it is decreased.  This function assumes that we are at the
beginning of the buffer when chunking starts -- as we should be, if 
`http-headers'
runs before us."
  (when (string= "chunked" (cdr (assoc "Transfer-Encoding" http-headers)))
    (save-excursion
      (catch 'done
        (goto-char (process-mark proc))
        (while (< (point) (point-max))
          (when (> http-unchunk-chunk-size 0)
            (when (> (- (buffer-size) (point)) http-unchunk-chunk-size)
              (setq http-unchunk-chunk-size
                    (- http-unchunk-chunk-size (- (buffer-size) (point))))
              (throw 'done t))
            (forward-char http-unchunk-chunk-size)
            (setq http-unchunk-chunk-size 0))
          (when (looking-at "\\([0-9a-f]\\).*?\r\n")
            (setq http-unchunk-chunk-size (hexl-hex-string-to-integer 
(match-string 1)))
            (replace-match "")
            (when (= 0 http-unchunk-chunk-size)
              (setq http-headers (delete (assoc "Transfer-Encoding" 
http-headers)
                                         http-headers))
              (throw 'done t))))))))

;; Debugging

(defvar http-log-function 'ignore
  "Function to call for log messages.")

(defun http-log (str)
  "Log STR using `http-log-function'.
The default value just ignores STR."
  (funcall http-log-function str))

(defun http-get-debug (url &optional headers version)
  "Debug the call to `http-get'."
  (interactive "sURL: ")
  (let* ((http-log-function (lambda (str)
                              (save-excursion
                                ;; dynamic binding -- buf from http-get is used
                                (set-buffer buf)
                                (insert str))))
         proc)
    (when (get-buffer "*Debug HTTP-GET*")
      (kill-buffer "*Debug HTTP-GET*"))
    (setq proc (http-get url headers nil version))
    (set (make-local-variable 'http-filter-pre-insert-hook) nil)
    (set (make-local-variable 'http-filter-post-insert-hook) nil)
    (rename-buffer "*Debug HTTP-GET*")))

;; The main function

(defun http-get (url &optional headers sentinel version)
  "Get URL in a buffer, and return the process.
You can get the buffer associated with this process using 
`process-buffer'.

The optional HEADERS are an alist where each element has the form
\(NAME . VALUE).  Both must be strings and will be passed along with
the request.

With optional argument SENTINEL, the buffer is not shown.  It is the
responsability of the sentinel to show it, if appropriate.  A sentinel
function takes two arguments, process and message.  It is called when
the process is killed, for example.  This is useful when specifying a
non-persistent connection.  By default, connections are persistent.
Add \(\"Connection\" . \"close\") to HEADERS in order to specify a
non-persistent connection.  Usually you do not need to specify a
sentinel, and `ignore' is used instead, to prevent a message being
printed when the connection is closed.

If you want to filter the content as it arrives, bind
`http-filter-pre-insert-hook' and `http-filter-post-insert-hook'.

The optional argument VERSION specifies the HTTP version to use.  It
defaults to version 1.0, such that the connection is automatically
closed when the entire document has been downloaded.  This will then
call SENTINEL, if provided.  If no sentinel is provided, `ignore' will
be used in order to prevent a message in the buffer when the process
is killed.

The coding system of the process is set to `unix', because we need to
distinguish between \\r and \\n.  To correctly decode the text later,
use `decode-coding-region' and get the coding system to use from
`http-headers'."
  (interactive "sURL: ")
  (setq version (or version 1.0))
  (let* (host dir file port proc buf command start-line (message-headers ""))
    (unless (string-match 
"http://\\([^/]+\\)/\\(.*/\\)?\\([^:]*\\)\\(:\\([0-9]+\\)\\)?" url)
      (error "Cannot parse URL %s" url))
    (setq host (match-string 1 url)
          dir  (or (match-string 2 url) "")
          file (or (match-string 3 url) "")
          port (or (match-string 5 url) 80)
          buf (get-buffer-create (format "*HTTP GET %s *" url))
          proc (open-network-stream (concat "HTTP GET " url) buf host port))
    (if sentinel
        (set-buffer buf)
      (switch-to-buffer buf))
    (erase-buffer)
    (kill-all-local-variables)
    (cond ((= version 1.0)
           (setq start-line (format "GET /%s%s" dir file)))
          ((= version 1.1)
           (setq start-line (format "GET /%s%s HTTP/1.1\r\nHost: %s"
                                    dir file host)))
          (t
           (error "HTTP Version %S is not supported" version)))
    (when headers
      (setq message-headers (mapconcat (lambda (pair)
                                         (concat (car pair) ": " (cdr pair)))
                                       headers
                                       "\r\n")))
    (setq command (format "%s\r\n%s\r\n" start-line message-headers))
    (http-log (format "Connecting to %s %d\nCommand:\n%s\n" host port command))
    (set-process-sentinel proc (or sentinel 'ignore))
    (set-process-coding-system proc 'binary); we need \r\n in the headers!
    (set-process-filter proc 'http-filter)
    (set-marker (process-mark proc) (point-max))
    (process-send-string proc command)
    proc))

;; (progn (when (get-buffer "Google") (kill-buffer "Google")) (rename-buffer 
"Google" (process-buffer (http-get "http://www.google.ch/"; nil nil 1.1))))
;; (http-get-debug "http://www.google.ch/"; nil 1.0)
;; (http-get-debug "http://www.google.ch/"; nil 1.1)
;; (http-get-debug "http://www.emacswiki.org/"; nil 1.1)

(provide 'http-get)

;;; http-get.el ends here