[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Emacs crash
|
From: |
Stavros Macrakis |
|
Subject: |
Emacs crash |
|
Date: |
Fri, 12 Oct 2001 22:24:11 -0400 (EDT) |
GNU Emacs 20.7.1 (i386-*-nt5.0.2195) of Tue Jun 13 2000 on buffy
Emacs crashed apparently in the redisplay routine.
I was running (update-traffic-loop) -- see below. It had successfully
run for several hours.
I enclose the DrWatson dump. There is also a complete core dump for
anyone who wants to look at it -- let me know. Anything else I should
be doing to make debugging easier?
-s
(defun update-traffic-loop ()
(let ((nomessageu t)
(smarttravbuf (get-buffer-create " smarttrav")))
(set-buffer smarttravbuf)
(buffer-disable-undo)
(setq buffer-file-coding-system 'iso-8859-1)
(setq lasttime-assq '(t)) ;keep global for debugging
(while t
(update-traffic "90" "10")
(update-traffic "128" "6")
(update-traffic "2" "4")
(update-traffic "9" "13")
(sleep-for 60))))
(defun update-traffic (routename routeindex)
(set-buffer smarttravbuf)
(erase-buffer)
(insert-http-contents
"www.smartraveler.com"
(concat "/scripts/bostraffic.asp?index="
routeindex
"&city=bos&cityname=Boston")
"" 80 nil)
(goto-char (point-min))
(search-forward "<!--Start of content display function--->")
(search-forward ")")
(setq thistime
(buffer-substring (point)
(progn (end-of-line)
(point))))
(if (equal (cdr (assoc routename lasttime-assq))
(put-assoc routename lasttime-assq thistime))
(message "No change for %s at %s" routename
(current-time-string))
(message "New info for %s at %s" routename
(current-time-string))
(write-region
(point-min) (point-max)
(format-time-string
(concat "c:/temp/traffic"
routename
"/%y%m%d %H%M%S"))))
(sit-for 0)
(erase-buffer))
(defun put-assoc (val list new)
(let ((cell (assoc val list)))
(if cell
(rplacd cell new)
(rplacd (last list)
(list (cons val new)))))
new)
-------------------------------
;; Utilities
(eval-and-compile (if (not (boundp 'http-debug)) (setq http-debug nil)))
(defun http-send (&rest l)
(setq l (apply 'concat l))
(if http-debug (mapcar 'insert l))
(send-string conn l))
(defmacro http-eof () nil) ; EOF confuses some servers
;; (list 'progn
;; (if http-debug
;; '(progn (message "HTTP EOF")))
;; '(process-send-eof conn)))
(setq nomessageu nil)
(defmacro messageu (&rest x)
(subst x 'x '(or nomessageu (message . x))))
(defmacro iuc-msg (&rest x)
(if (null x) '(setq iuc-time (timefloat))
(list* 'messageu
(list 'concat "T+%.3f %d (%s) " (car x))
'(- (timefloat) iuc-time)
(point-max)
(buffer-substring (max (point-min) (- (point-max) 5)) (point-max))
(cdr x))))
'(defmacro iuc-msg (&rest x) nil)
;; Find all links and pics in a page
(defun clean-html-syntax ()
(goto-char (point-min))
;; First put all tags on their own lines just for ease of hacking
(while (not (eobp))
(delete-char (- (skip-chars-forward " \t\n")))
(skip-chars-forward "^<")
(if (not (bolp)) (insert ?\n))
(forward-char 1)
(delete-char (- (skip-chars-forward " \t\n")))
(while
(progn
(skip-chars-forward "^>\n\"")
(cond ((eobp) nil)
((eq (following-char) ?\n)
(delete-char 1)
(insert " ")
t)
((eq (following-char) ?\")
(forward-char 1)
(while
(progn
(skip-chars-forward "^\"\n")
(cond ((eq (following-char) ?\n)
(delete-char 1)
(insert " ")
t)
((eq (following-char) ?\")
(forward-char 1)
nil))))
t)
((eq (following-char) ?>)
(forward-char 1)
(if (looking-at "[ \t]*\\(\n[ \t]*\\)+")
(replace-match "\n" t t)
(insert "\n"))
nil)))))
(goto-char (point-min))
(setq endgood (point))
(while (re-search-forward "<\\(a\\|img\\) " nil t)
(delete-region endgood (match-beginning 0))
(re-search-forward (if (= (- (match-end 1) (match-beginning 1)) 1)
"</a[^>]*>\n?"
">\n?")
nil t)
(setq endgood (match-end 0)))
(goto-char (point-min))
)
;;; (while (re-search-forward "<a href=\\(\"[^\"]*\\.jpg\"\\)" nil t)
;;; (replace-match (concat "<img src=" (match-string 1))))
;;; (goto-char (point-min))
;;; (while (re-search-forward "<a href=\"\\([^:\"]*\\)\"[^>]*>" nil t)
;;; (let ((next (match-string 1)))
;;; (delete-region (match-beginning 0) (match-end 0))
;;; (if (not (= (aref next 0) ?.))
;;; (insert-clean-url-contents next)))))
(defun find-page (url &optional insert-url-noclean body form-alist)
"Find page (URL); select and return buf"
(interactive "sFind page (URL): \nP")
(switch-to-buffer (find-page-noselect url nil nil body form-alist)))
(global-set-key "\C-x\C-u" 'find-page)
(defun find-page-other-window (url &optional insert-url-noclean body
form-alist)
"Find page (URL) in other window; return buf"
(interactive "sFind page other window (URL): ")
(switch-to-buffer-other-window (find-page-noselect url nil nil body
form-alist)))
(defvar cookies nil) ;assoc list ((site . cookie) ...)
(global-set-key "\C-x4\C-u" 'find-page-other-window)
(defvar buffer-url nil "URL of this buffer")
(make-variable-buffer-local 'buffer-url)
(defvar buffer-alist nil "Form alist of this buffer")
(make-variable-buffer-local 'buffer-alist)
(setq max-redirects 5)
(defun find-page-noselect (url &optional redirect-count comment body form-alist)
"Find page (URL); return, but don't select buf"
(interactive "sFind page (URL): ")
(or comment (setq comment ""))
(if (and redirect-count (> redirect-count max-redirects))
(error "Too many levels of redirect")
(let (host port rest query part prettyname)
(parse-url url) ;SETS HOST etc.
(cond
((eq scheme 'file)
(find-file-noselect rest))
((eq scheme 'http)
(set-buffer (create-file-buffer (concat (shorthostname host)
(shortrest rest))))
(messageu "Loading %s %s (%s)" prettyname comment (buffer-name
(current-buffer)))
(setq buffer-url prettyname
buffer-source (list host port rest query part)
buffer-alist form-alist)
(insert-http-contents host rest body port form-alist)
(messageu "Loaded %s" prettyname)
(goto-char (point-min))
(when (and (search-forward "\nLocation: " nil t)
(> max-redirects 0))
(messageu "Redirected to: %s"
(setq url (buffer-substring
(point)
(progn (end-of-line) (point)))))
(set-buffer (find-page-noselect
url
(1+ (or redirect-count 0))
(concat " redirected from " prettyname))))
(current-buffer))
(t (error "Don't understand scheme in %s" url))))))
(defun insert-page (url)
"Insert contents of page (URL)"
(interactive "sInsert page (URL): ")
(let (host port rest query part prettyname)
(parse-url url) ;SETS HOST etc.
(cond ((eq scheme 'file)
(insert-file-contents rest))
((eq scheme 'http)
(messageu "Loading %s" prettyname)
(insert-http-contents host rest))
(t (error "What scheme??")))))
(defun url-content-string (host url)
(save-excursion
(set-buffer (get-buffer-create " *contents-temp*"))
(erase-buffer)
(insert-http-contents host url)
(buffer-substring (point) (point-max))))
'(defun url-content-string-clean-newbuf (host url)
(save-excursion
(set-buffer (get-buffer-create (url-abbrev host url)))
(erase-buffer)
(insert-http-contents host url)
(clean-html-syntax)
(point-max)))
(setq insert-url-retries 4
insert-url-timeout 30)
(defconst http-default-port 80)
(defconst http-proxy-server nil)
(setq insert-url-noclean nil)
(setq extra-stuff-to-send nil) ;Global!!
(setq quit-at-first nil) ;; Quits after first read
(defun insert-http-contents (host url &optional body port form-alist)
(iuc-msg)
(let ((pt (point))
(conn
(condition-case err
(open-network-stream "*cont-proc*" (current-buffer) host
(or port http-default-port))
(error (iuc-msg "Error")
(signal (car err) (cdr err)))))
lastmax
(more-header nil)
(n 0))
(iuc-msg "Opened %s" conn)
(when form-alist
(if body (error "Can't specify both body and form-alist"))
(setq body
(substring
(apply 'concat
(mapcar '(lambda (pair)
(concat (url-encode (car pair))
"="
(url-encode (cdr pair))
"&"))
form-alist))
0 -1)
more-header
(concat
"Content-Type: application/x-www-form-urlencoded\r\n"
"Content-Length: " (format "%d" (length body))
"\r\n")))
(if body
(http-send "POST " url " HTTP/1.0\r\n")
(http-send "GET " url " HTTP/1.0\r\n"))
(http-send "Host: " host "\r\n")
(if (assoc host cookies)
(http-send "Cookie: " (cdr (assoc host cookies)) "\n"))
(if extra-stuff-to-send (http-send extra-stuff-to-send))
(if more-header (http-send more-header))
(http-send "\r\n") ;End header
(if body (http-send body))
(insert "\n\n")
(http-eof)
(iuc-msg "Sent msg + eof")
(setq lastmax (point-max))
(catch 'quithttp
(let ((retries-left insert-url-retries))
(while (progn (if (accept-process-output conn insert-url-timeout)
(setq retries-left insert-url-retries)
(setq retries-left (1- retries-left)))
(and (> retries-left 0)
(eq (process-status conn) 'open)))
(if (= retries-left insert-url-retries)
(if quit-at-first
(throw 'quithttp nil)
(iuc-msg "Read %d..." (- (point-max) lastmax)))
(iuc-msg "Retry number %d" (- insert-url-retries retries-left)))
(setq lastmax (point-max)))))
(iuc-msg "Process status %s" (process-status conn))
(delete-process conn)
(goto-char pt)
(unless insert-url-noclean
(while (re-search-forward "\r\n?" nil t)
(replace-match "\n" t t)))
(goto-char pt)
(setq url-saved-header
(buffer-substring (point)
(progn (re-search-forward "\n\r*\n" nil t)
(point))))
(- (point-max) (point))))
(defun get-goodstuff (num)
(let ((n 0) (p))
(buffer-disable-undo)
(while (< n 1000)
(insert-http-contents "www.infoxpress.com"
(concat "/cmp/win/winfolnk.asp?issue=199805&rsn="
(int-to-string (setq n (1+ n)))))
(setq p (point))
(search-forward "<TABLE BORDER=1 CELLPADDING=1 CELLSPACING=1 WIDTH=470>")
(delete-region p (match-beginning 0))
(search-forward "\t\t</TABLE>\n\t" nil nil 2)
(delete-region (point) (point-max))
(goto-char p)
(while (re-search-forward
"
\\(width=[0-9]+\\|nowrap\\|size=[0-9]+\\|align=[a-z]+\\|colspan=[0-9]+\\|rowspan=[0-9]+\\|valign=[a-z]+\\|cellspacing=[0-9]+\\|cellpadding=[0-9]+\\)\\b"
nil t)
(replace-match "" t t))
(goto-char p)
(while (re-search-forward "</?\\(font\\|center\\|b\\|i\\)>" nil t)
(replace-match "" t t))
(goto-char p)
(while (re-search-forward "<td><input[^>]*></td>[ \t\n]*" nil t)
(replace-match "" t t))
(goto-char p)
(while (re-search-forward "\n[ \t]+" nil t)
(replace-match "\n" t t))
(goto-char p)
(setq last (point))
(while (search-forward "<tr>" nil t)
(delete-region last (match-beginning 0))
(if (looking-at "[ \t\n]*<td\\(>company<br>\\|>mail</td>\\| 470>\\)")
(delete-region last (progn (search-forward "</tr>") (point)))
(search-forward "</tr>"))
(setq last (point))))))
(defun parse-url (url)
"Sets globals [scheme host port rest query part prettyname]; signals error if
bad"
(setq host (setq port (setq rest (setq query (setq part nil)))))
(cond
((string-match
"^\\(http://\\)?\\([^/:]+\\)\\(:[0-9]+\\)?\\(/\\|$\\)"
url)
(setq scheme 'http
host (match-string 2 url)
port (if (match-beginning 3)
(string-to-int
(substring url (1+ (match-beginning 3))
(match-end 3))))
rest (substring url (match-beginning 4) nil))
(cond ((equal rest "") (setq rest "/"))
((/= (aref rest 0) ?/) (setq rest (concat "/" rest))))
(if (string-match "\\([?]\\([^#]*\\)\\)?\\([#]\\(.*\\)\\)?$" rest)
(setq query (match-string 2 rest)
part (match-string 4 rest)
;rest (substring rest 0 (match-beginning 0))
))
(setq prettyname (concat "http://"; host
(if port (concat ":" port))
rest
(if query (concat "?" query))
(if part (concat "#" part)))))
((string-match "^file:///?\\(.:[/\\].*\\)$" url)
(setq scheme 'file
rest (match-string 1 url)
prettyname (concat "file:///" rest)))
((string-match "^file://\\([^:\n/\\]+\\)[/\\]\\([^:\n]*\\)$" url)
(setq scheme 'file
host (match-string 1 url)
rest (concat "//" host "/" (match-string 2 url))
prettyname (concat "file:" rest)))
((string-match "^[a-z]:[/\\].*$" url)
(setq scheme 'file
rest url
prettyname (concat "file:///" rest)))
((string-match "^[/\\][/\\].*$" url)
(setq scheme 'file
rest url
prettyname (concat "file:" rest)))
((string-match "^https:" url)
(error "Can't handle HTTPS"))
(t (error "Can't parse URL %s" url))))
(defun test-parse (url)
(parse-url url)
(princ (format "URL: %s\nScheme: %s\nHost: %s\nPort: %s\nRest:
%s\nQuery: %s\nPart: %s\nPretty: %s\n"
url
scheme
host
port
rest
query
part
prettyname))
(intern ""))
(defun shorthostname (h)
(if (and (> (length h) 4) (string= (substring h 0 4) "www."))
(setq h (concat "." (substring h 4))))
(if (> (length h) 4)
(setq h
(concat (substring h 0 -4)
(or
(cdr
(assoc (substring h -4)
'((".com" . ".")
(".edu" . "E")
(".org" . "O")
(".net" . "N"))))
(substring h -4)))))
(if (> (length h) 3)
(setq h
(concat (substring h 0 -3)
(or
(cdr
(assoc (substring h -3)
'((".us" . "U")
(".fr" . "F")
(".jp" . "J")
(".uk" . "G"))))
(substring h -3)))))
h)
(defun shortrest (r)
(if (member r '("/" "/index.htm" "/index.html")) ""
(if (string-match "\\.html?$" r)
(substring r 0 (1+ (match-beginning 0)))
r)))
(defun addatt (att val)
(setq parsed (cons (cons att val) parsed)))
(defun expect (regex)
(if (looking-at regex)
(goto-char (match-end 0))
(error "Didn't see expected %s" regex)))
(defun parse-http-header ()
(let ((parsed nil)
(curstr)
(att))
(expect " *HTTP/\\([0-9]+\\)\\.\\([0-9]+\\) +\\([0-9][0-9][0-9]\\)
*\\(.*\\)\r\n")
(addatt 'major-version (string-to-int (match-string 1)))
(addatt 'minor-version (string-to-int (match-string 2)))
(addatt 'status-code (string-to-int (match-string 3)))
(addatt 'reason-phrase (match-string 4))
(while (not (looking-at "\r\n"))
(expect "\\([-A-Za-z0-9]+\\):[ \t]\\(.*\\)\r\n")
(setq att (match-string 1)
curstr (match-string 2))
(while (looking-at "[ \t]+\\(.*\\)\r\n")
(setq curstr (concat curstr (match-string 1)))
(goto-char match-end 0))
(addatt att curstr))
(expect "\r\n")
(nreverse parsed)))
(defun time-url-fetch (host url &optional body)
(messageu "Timing http://%s %s" host url)
(let* ((time0) ;Start
(time1) ;Connection requested
(time2) ;EOF sent
(time3) ;1st packet
(time4) ;Last packet
(time5) ;Connection closed
(bufsizi 0)
(bufdel)
(n 0)
(chunkcount 0)
(minchunk 100000)
(maxchunk 0)
(conn)) ;The connection
(condition-case err
(progn
(save-excursion
(set-buffer (get-buffer-create "*time-url-fetch*"))
(erase-buffer)
(setq time0 (timefloat))
(setq conn (open-network-stream "*cont-proc*" (current-buffer) host
http-default-port))
(setq time1 (timefloat))
(if body
(http-send "POST " url " HTTP/1.0\r\n"
body "\r\n\r\n")
(http-send "GET " url " HTTP/1.0\r\n\r\n"))
(http-eof)
(setq time2 (timefloat))
(while (progn (accept-process-output conn 0)
(and (eq (process-status conn) 'open)
(< n 100000)))
(when (/= (buffer-size) 0)
(if (not time3) (setq time3 (timefloat))))
(when (/= (setq bufdel (- (buffer-size) bufsizi)) 0)
(setq time4 (timefloat)
chunkcount (1+ chunkcount)
minchunk (min minchunk bufdel)
maxchunk (max maxchunk bufdel)
bufsizi (buffer-size))
(if (< minchunk 0) (debug)) )
(setq n (1+ n))))
(setq time5 (timefloat))
(delete-process conn)
(princ
(format "
http://%s %s
%.1fKb in %d chunks (%d <= avg %.0f <= %d)
Delays: %4.2f = Open/send %4.2f + Data starts %4.2f + Close %4.2f
Transfer: %4.2f (%4.1fKB/s)
Total: %4.2f (%4.1fKB/s)
"
host
url
(* 1.0e-3 bufsizi)
chunkcount
minchunk
(/ bufsizi chunkcount)
maxchunk
(+ (- time3 time0) (- time5 time4))
(- time2 time0)
(- time3 time2)
(- time5 time4)
(- time4 time3)
(/ bufsizi
(max 0.06 (- time4 time3))
1000.0)
(- time5 time0)
(/ bufsizi
(max 0.06 (- time5 time0))
1000.0)
)))
(error
(mapcar '(lambda (x) (prin1 x) (terpri))
(list err
(list host url)
(mapcar '(lambda (q) (if (and q time0) (- q time0) q))
(list time0 time1 time2 time3 time4 time5))
bufsizi
(list chunkcount minchunk maxchunk)
conn)))))
(intern ""))
(defsubst skip-white () (skip-chars-forward "[ \t\n\r]"))
(defun looking-atn (&rest args)
"== (looking-at (concat ...args...))"
(looking-at (apply 'concat args)))
(defconst Rwhite "[ \t\n\r]+")
(defconst Rxwhite "[ \t\n\r]*")
(defun markup-text ()
(goto-char (point-min))
(let (saved-from-num saved-from-url
dtd-version dtd-features
dtd-language dtd-url
(case-fold-search t))
(skip-white)
(when (looking-at "<!-- saved from url=(\\([0-9]+\\))\\([^<>\n]+\\) -->")
(setq saved-from-num (match-string 1)
saved-from-url (match-string 2))
(goto-char (match-end 0)))
(skip-white)
(when (looking-at "<!DOCTYPE")
(if (not (looking-atn "<!DOCTYPE"
Rwhite
"HTML"
Rwhite
"public"
Rwhite
"\"-//W3C//DTD\\( W3\\)?"
Rwhite "HTML"
"\\([0-9.]*\\)" ;2
"\\([^/]*\\)" ;3
"//"
"\\([a-z]+\\)" ;4
"\""
Rxwhite
"\\(\"\\([^\"]\\)*\"\\|\\([^\"<> ]*\\)\\)?"
;5,6,7
Rxwhite ">"
))
(error "Don't understand doctype")
(setq dtd-version (match-string 2)
dtd-features (match-string 3)
dtd-language (match-string 4)
dtd-url (or (match-string 6) (match-string 7)))
(goto-char (match-end 0))))
(skip-white)
(with-output-to-temp-buffer (concat (buffer-name) " Page info")
(princ (format "\nInfo for buffer %s\n\n" (buffer-name)))
(label-princ "Filename:" buffer-file-name)
(xformat-princ "Saved from:" "%s (%s)" saved-from-url saved-from-num)
(xformat-princ "DTD:" "%s%s%s"
(if (not (member dtd-version '(nil "")))
(format "Version: %s" dtd-version) "")
(if (not (member dtd-features '(nil ""))) (format " + %s"
dtd-features) "")
(if (and dtd-language (not (equal dtd-language "EN")))
(format " %s" dtd-language)
""))
(label-princ "DTD URL:" dtd-url))))
(defun label-princ (label thing)
(save-excursion
(set-buffer standard-output)
(when (not (member thing '(nil "")))
(insert label)
(indent-to 20)
(insert thing)
(insert "\n"))))
(defun xformat-princ (label format thing &rest rest)
(save-excursion
(set-buffer standard-output)
(when (not (member thing '(nil "")))
(insert label)
(indent-to 20)
(insert (apply 'format format thing rest))
(insert "\n"))))
(defun replace (str &optional n)
(or n (setq n 1))
(if (not (match-beginning 0))
nil
(delete-region (match-beginning 0) (match-end 0))
(set-match-data nil))
(skip-chars-backward str)
(insert-char (aref str 0)
(max (min 2 (skip-chars-forward str))
n)))
(defun replace-mat (&rest strs)
(if (not (match-beginning 0))
nil
(delete-region (match-beginning 0) (match-end 0))
(set-match-data nil))
(apply 'insert strs))
(defun just-the-text ()
(goto-char (point-min))
(while (re-search-forward "[ \t\n\r]+" nil t)
(delete-region (match-beginning 0) (match-end 0))
(insert " "))
(goto-char (point-min))
(let (tag assoc last href
(match-beg (make-marker))
(match-end (make-marker))
(tag-end (make-marker))
(name-end (make-marker)))
(while (re-search-forward "&\\([a-z0-9]+\\);" nil t)
(setq tag (match-string 1))
(setq assoc (assoc tag '(("amp" . "&") ("copy" . "©") ("frac12" . "½")
("frac14" . "¼")
("nbsp" . " ") ("quot" . "\"") ("reg" . "®"))))
(if assoc (replace-mat (cdr assoc))))
(goto-char (point-min))
(setq last (point))
(while (re-search-forward "[ \n\t\r]*</?\\([^> \n]*\\)[^>]*>[ \n\t\r]*" nil
t)
(setq tag (downcase (match-string 1))
endp (= (char-after (1- (match-beginning 1))) ?/))
(move-marker match-beg (match-beginning 0))
(move-marker match-end (match-end 0))
(move-marker tag-end (match-end 0))
(move-marker name-end (match-end 1))
(goto-char name-end)
(if endp
(if (member tag '("p" "table" "div" "br" "center" "li" "td" "dd"))
(replace "\n")
(replace " "))
(cond ((search-forward "alt *= *\\(\"[^\"]*\"\\|[^ \n>]+\\)" tag-end t)
(replace-mat (concat " << " (match-string 1) " >> ")))
((member tag '("p" "table" "div" "br" "center"))
(replace "\n" 2))
((and (member tag '("a"))
(re-search-forward "href *= *\"\\([^\"]*\\)\"\\|\\([^
\n>]+\\)" tag-end t))
(setq href (if (match-beginning 1)
(match-string 1)
(match-string 2)))
(delete-region match-beg match-end)
(insert " <<** " href " **>> "))
((member tag '("li"))
(replace "\n")
(insert " --")
(replace " "))
((member tag '("hr"))
(replace "\n" 2)
(replace-mat "\n\n ---------------- \n\n"))
(t (replace-mat "")))))
(goto-char (point-min))
(while (re-search-forward "\n[\240 ]*\\(\n[ \240]*\\)+\n" nil t)
(delete-region (match-beginning 0) (match-end 0))
(insert "\n\n"))))
;;; Each entry in pending/failed/done list looks like:
;;; ( host or nil if unparseable
;;; url
;;; number-of-tries-so-far
;;;
(setq host-stats nil)
;;; host statistics
;;; ( (host avgwait ...history.of.waits...) ...)
;;; Asynchronous fetch
(defun asynch-fetch (url whenstart eachchunk whendone)
;;; NOTA BENE: DNS fetch is NOT asynch
)
(defun asnew () (list nil nil))
(defun asget (l key)
(or (plist-get l key)
(error "No key %s in assq %s" key l)))
(defun asput (l key val)
(plist-put l key val))
(defun asget2 (l key1 key2)
(or (plist-get (plist-get l key1) key2)
(error "No key %s/%s in assq %s" key1 key2 l)))
(defun asget2if (l key1 key2) (plist-get (plist-get l key1) key2))
(defun asput2 (l key1 key2 val)
(plist-put (or (plist-get l key1)
(plist-get (plist-put l key1 (asnew))
key1))
key2
val))
(defun prx (proc &rest x)
(when trace
(goto-char (point-max))
(setq curtime (timefloat))
(princ (format "%2d/%2d %6.3f %6.3f %6.3f "
(asget2 connections proc 'num)
(length pool)
(- curtime start-time)
(- curtime (asget2 connections proc 'start))
(- curtime (asget2 connections proc 'last))))
(asput2 connections proc 'last curtime)
(prin1 x)
(terpri)
(when (> (- curtime last-time) 1.0)
(setq last-time curtime)
(sit-for 0))))
(defun multifetch (url count batch &optional tracepar)
"Fetch URL COUNT times. Have as many as BATCH parallel HTTP
sessions open; if optional TRACEPAR, print a trace of events."
(setq trace tracepar) ;Must persist
;; Delete processes/connections hanging around
(when (process-list)
(when trace
(princ (format "Deleting %d processes\n" (length (process-list)))))
(mapcar 'delete-process (process-list)))
(princ (format "Fetching %s %d times in batches of %d\n" url count batch))
(setq start-time (timefloat))
(setq last-time start-time)
(setq connections (asnew))
(let (host port rest query part prettyname num
(startcount count))
(save-excursion
(setq pool nil)
(parse-url url)
(if (not (eq scheme 'http)) (error "Multifetch only on http"))
(while (> count 0)
(when (< (length pool) batch)
(setq conn-time (timefloat))
(setq num (- startcount count))
(setq conn (open-network-stream (int-to-string num)
(current-buffer) host (or port
http-default-port)))
(asput2 connections conn 'last conn-time)
(asput2 connections conn 'start conn-time)
(asput2 connections conn 'num num)
(prx conn '-)
(set-process-filter
conn
(lambda (proc str)
(prx proc (length str))))
(set-process-sentinel
conn
(lambda (proc sent)
(prx proc 'Died)
(delete-process conn)
(setq pool (delq proc pool))))
(http-send "GET " url " HTTP/1.0\r\n")
(if extra-stuff-to-send (http-send extra-stuff-to-send))
(http-send "\r\n")
(http-eof)
(setq pool (cons conn pool)
count (1- count)))
(while (accept-process-output))
(mapcar 'maybe-kill-process pool))
;;; End main loop
(when trace (princ "Cleanup\n"))
;; Clean up
(while pool
(accept-process-output)
(mapcar 'maybe-kill-process pool)))
(princ (format "%d fetches in %.3f sec = %.1f/sec; %5.1f mS each\n"
startcount
(- (setq end-time (timefloat)) start-time)
(/ startcount (- end-time start-time))
(* 1000 (/ (- end-time start-time) startcount))))
)
(intern ""))
(defun maybe-kill-process (x)
(let ((procstat (process-status x)))
(if (eq procstat 'open)
nil
(if (eq procstat 'closed)
(prx x 'Dead)
(prx x 'Dead (process-status x)))
(setq pool (delq x pool)))))
;;;Used to measure <<latency>>. Cuts off response after first packet.
(require 'stats)
(defun response-time (host &optional count pause)
(or count (setq count 20))
(or pause (setq pause 0.5))
(let ((max-redirects -1) ;No redirects
(quit-at-first t) ;Just one packet
(nomessageu t) ;No screen messages
(start-time (timefloat))
(i count))
(statistics
(progn
(setq l nil)
(while (>= (setq i (1- i)) 0)
(sleep-for 0.5)
(setq l
(cons (timit (find-page-noselect host))
l)))
l))
(princ
(format "Avg from overall time: %.2f\n"
(- (/ (- (timefloat) start-time) count)
pause)))))
(defun url-encode (str)
(apply 'concat
(mapcar
'(lambda (char)
(cond ((or (and (>= char ?0)
(<= char ?9))
(and (>= char ?a)
(<= char ?z))
(and (>= char ?A)
(<= char ?Z))
(memq char '(?- ?\;)))
(list char))
((= char ? ) '(?+))
(t (list ?%
(princ-digit (/ char 16) 16)
(princ-digit (logand char 15) 16)))))
str)))
------------------------
State Dump for Thread Id 0x6f0
eax=011e5804 ebx=01544400 ecx=111e5834 edx=ffffffff esi=0fffffff edi=00000000
eip=0105657a esp=0082e6a4 ebp=0082e714 iopl=0 nv up ei pl nz na pe nc
cs=001b ss=0023 ds=0023 es=0023 fs=0038 gs=0000 efl=00000202
function: redisplay
0105654c 8b4b30 mov ecx,[ebx+0x30]
ds:01fc19d2=????????
0105654f 23c6 and eax,esi
01056551 3b8888000000 cmp ecx,[eax+0x88]
ds:011e588c=411ee000
01056557 0f84a1010000 je redisplay+0xb2e (010566fe)
0105655d c70588260f0101000000
ds:010f2688=00000002
mov dword ptr [update_mode_lines
(010f2688)],0x1
01056567 e992010000 jmp redisplay+0xb2e (010566fe)
0105656c 8b4334 mov eax,[ebx+0x34]
ds:01fc19d2=????????
0105656f 893d90260f01
ds:010f2690=00000000
mov [update_mode_lines+0x8 (010f2690)],edi
01056575 23c6 and eax,esi
01056577 8b4834 mov ecx,[eax+0x34]
ds:01c62dd6=????????
FAULT ->0105657a 8b4918 mov ecx,[ecx+0x18]
ds:11c62e06=????????
0105657d 890d04270f01
ds:010f2704=00000b2c
mov [unchanged_modified (010f2704)],ecx
01056583 8b4834 mov ecx,[eax+0x34]
ds:01c62dd6=????????
01056586 8b4920 mov ecx,[ecx+0x20]
ds:11c62e06=????????
01056589 890de8260f01
ds:010f26e8=0000000f
mov [overlay_unchanged_modified
(010f26e8)],ecx
0105658f 8b4834 mov ecx,[eax+0x34]
ds:01c62dd6=????????
01056592 8b4904 mov ecx,[ecx+0x4]
ds:11c62e06=????????
01056595 49 dec ecx
01056596 890d7c260f01 mov [beg_unchanged (010f267c)],ecx
ds:010f267c=00000041
0105659c 8b4834 mov ecx,[eax+0x34]
ds:01c62dd6=????????
0105659f 8b5108 mov edx,[ecx+0x8]
ds:11c62e06=????????
010565a2 2b5104 sub edx,[ecx+0x4]
ds:11c62e06=????????
*----> Stack Back Trace <----*
FramePtr ReturnAd Param#1 Param#2 Param#3 Param#4 Function Name
0082E714 01055BD7 00000000 01007F2B 011D7468 0082E858 temacs!redisplay
0082E804 01045349 00000000 00000000 00000000 111E5834 temacs!redisplay
0082E830 010454B1 00000000 00000000 00000000 00000000
temacs!read_filtered_event
0082E848 0104451F 111E5804 111E5804 111E5804 111E5804 temacs!Fread_event
0082E880 0103F80E 0082E894 00000000 111F6984 00000000 temacs!Ffuncall
0082E8E8 01043981 31196E58 41196F20 01196E66 01196CE6 temacs!Fbyte_code
0082E97C 01042724 51196E48 112E3434 111E5804 0082EDC0 temacs!Feval
0082E9EC 0103FD0C 112E3434 010435B1 51196E48 112E3434 temacs!internal_catch
0082EA60 01044990 31196CA8 41196D1C 01196CE6 0082EAD8 temacs!Fbyte_code
0082EA94 010445EC 41196C90 00000000 0082EADC 01196336 temacs!funcall_lambda
0082EAC8 0103F80E 0082EADC 40000000 112E3434 00000043 temacs!Ffuncall
0082EB38 01044990 31196158 41196370 01196336 0082EBD0 temacs!Fbyte_code
0082EB6C 010445EC 41196130 00000001 0082EBD4 FFFFFFE8 temacs!funcall_lambda
0082EBA0 0103F29C 0082EBD4 40000000 111FD07C 111E5804 temacs!Ffuncall
0082ECBC 0100DCFC 112E331C 111E5804 411DF400 111E5804
temacs!Fcall_interactively
0082ED0C 010079CF 112E331C 111E5804 111E5804 111E5804 temacs!Fcommand_execute
0082EDB8 01042AD5 111E5804 111E5804 0082EE54 0082EF34 temacs!command_loop_1
0082EE38 01006E6B 01006F44 111E59FC 01006C5B 01042724
temacs!internal_condition_case
0082EEB8 01006E46 111F668C 01006E56 111E5804 01006B4E temacs!command_loop_2
0082EF0C 0103F80E 0082EF20 40000000 11203E2C 313E92C0 temacs!command_loop
0082EF6C 01043981 313E9130 41402E00 013E91F9 013E905F temacs!Fbyte_code
0082F000 01041BF8 5147266C 5147247C 013E905F 00000044 temacs!Feval
0082F024 01063721 5147247C 01062E35 413BA800 011E2390 temacs!Fprogn
0082F040 0103FCE0 5147247C 5147247C 111E5804 111E5804
temacs!Fsave_window_excursion
0082F0F4 01044990 313E8FB4 41402D00 013E905F 0082F16C temacs!Fbyte_code
0082F128 010445EC 413A0AE0 00000002 0082F170 111E5804 temacs!funcall_lambda
0082F15C 01043D02 0082F170 40000000 11230B64 111E59FC temacs!Ffuncall
0082F198 010440BC 00000002 0082F1B4 0082F2A8 0082F1B4 temacs!Fapply
0082F1BC 0104193C 11230B64 512D1D4C 0082F1FC 01042EAC temacs!apply1
0082F1CC 01042EAC 512D1D4C 111E59FC 512D1D54 512D1D5C temacs!call_debugger
0082F1FC 01042C9D 00000000 511F460C 111FE4AC 512D1D5C temacs!Fsignal
0082F248 0104451F 111FE4AC 512D1D6C 014BC188 0082F288 temacs!Fsignal
0082F278 0103F80E 0082F28C 40000000 111F9DE4 111FE4AC temacs!Ffuncall
0082F2E0 01043981 314BC168 4143B280 014BC188 10000000 temacs!Fbyte_code
0082F374 01041BF8 5145FCAC 5145FD0C 10000000 F0000000 temacs!Feval
0082F398 010429BD 5145FD0C 5145FCB4 014BC020 0082F45C temacs!Fprogn
0082F43C 0103FD56 512D1D8C 1125BAA4 512D1D94 5145FC9C temacs!Fcondition_case
0082F4B8 01044990 314BC00C 413D1F00 014BC020 0082F500 temacs!Fbyte_code
0082F4EC 01044761 41405C00 00000005 0082F500 3153A02C temacs!funcall_lambda
0082F54C 01043A5C 41405C00 111E5804 00000001 111E5804 temacs!apply_lambda
0082F5E0 01041BF8 51314D34 51314CE4 1143F96C 0000000B temacs!Feval
0082F604 01044962 51314CE4 51314D6C 51369F84 0082F64C temacs!Fprogn
0082F638 01044761 51369F84 00000002 0082F64C 31539FCC temacs!funcall_lambda
0082F68C 01043A5C 51369F84 111E5804 00000001 111E5804 temacs!apply_lambda
0082F720 01041BF8 512FA624 512FA5FC 0FFFFFFF 411D7270 temacs!Feval
0082F744 01042508 512FA5FC 0082F75C 0082F768 00000001 temacs!Fprogn
0082F770 010437E1 512FA6AC 512FA7A4 513039AC 0082F830 temacs!Fwhile
0082F7FC 01041BF8 512FA6F4 513039AC 0082F838 00000009 temacs!Feval
0082F820 01042450 513039AC 512FAF3C 111E5834 4140C000 temacs!Fprogn
0082F868 010437E1 512FAF3C 00000000 5130394C F0000000 temacs!Flet
0082F8F4 01041BF8 512FA004 5130394C 00000000 00000008 temacs!Feval
0082F918 01044962 5130394C 512FA00C 5130C044 0082F960 temacs!Fprogn
0082F94C 01044761 5130C044 00000000 0082F960 0FFFFFFF temacs!funcall_lambda
0082F998 01043A5C 5130C044 111E5804 00000001 0082FA38 temacs!apply_lambda
0082FA2C 01044719 51459484 010446AE 0FFFFFFF 40000000 temacs!Feval
0082FA74 01043A5C 41305700 111E5804 00000001 011D7348 temacs!apply_lambda
0082FB08 01044515 514594D4 0135F499 0082FB44 0FFFFFFF temacs!Feval
0082FB34 0103F80E 0082FB48 40000000 111F9E14 514594D4 temacs!Ffuncall
0082FBA8 01044990 3135F440 413B4280 0135F499 0082FC40 temacs!Fbyte_code
0082FBDC 010445EC 413C18C0 00000001 0082FC44 FFFFFFE8 temacs!funcall_lambda
0082FC10 0103F29C 0082FC44 40000000 111FD07C 111E5804 temacs!Ffuncall
0082FD2C 0100DCFC 1124D3C4 111E5804 411DF400 111E5804
temacs!Fcall_interactively
0082FD7C 010079CF 1124D3C4 111E5804 111E5804 111E5804 temacs!Fcommand_execute
0082FE28 01042AD5 111E5804 111E5804 0082FEC4 00000000 temacs!command_loop_1
0082FEA8 01006E6B 01006F44 111E59FC 01006C5B 01042724
temacs!internal_condition_case
0082FF28 01006E0C 111E59E4 01006E56 111E5804 111E59E4 temacs!command_loop_2
0082FF80 010B7826 00000000 011F5C10 0120E600 00AD00AC temacs!command_loop
0082FFC0 77E97D08 00AD00AC 00AF00AE 7FFDF000 C0000005 temacs!mainCRTStartup
0082FFF0 00000000 01049756 00000000 000000C8 00000100 kernel32!CreateProcessW
*----> Raw Stack Dump <----*
0082e6a4 00 00 00 00 ff ff ff 0f - 00 00 00 f0 01 00 00 00 ................
0082e6b4 b4 e7 82 00 f0 e6 82 00 - 01 00 00 00 01 00 00 00 ................
0082e6c4 ff ff ff ff ff ff ff ff - 50 e0 2c 41 04 58 1e 11 ........P.,A.X..
0082e6d4 ff ff ff 0f 00 00 00 f0 - 6c e8 82 00 58 09 0f 01 ........l...X...
0082e6e4 14 e7 82 00 01 00 00 00 - 04 58 1e 11 04 e7 36 01 .........X....6.
0082e6f4 04 58 1e 11 04 e7 82 00 - 01 00 00 00 00 00 00 00 .X..............
0082e704 d1 03 00 00 43 b0 00 01 - 01 00 00 00 00 00 00 00 ....C...........
0082e714 04 e8 82 00 d7 5b 05 01 - 00 00 00 00 2b 7f 00 01 .....[......+...
0082e724 68 74 1d 01 58 e8 82 00 - 02 00 00 00 04 e8 82 00 ht..X...........
0082e734 00 00 00 f0 00 00 00 00 - ff ff ff 0f 18 e7 82 00 ................
0082e744 dd 80 00 01 b0 ff 82 00 - 00 00 00 00 30 32 43 56 ............02CV
0082e754 00 00 00 00 0c e1 82 00 - 14 00 00 00 00 18 1f 01 ................
0082e764 00 00 00 40 78 e7 82 00 - 07 27 01 01 60 fc 82 00 ...@x....'..`...
0082e774 00 00 00 f0 00 00 00 00 - ff ff ff 0f 74 fb 82 00 ............t...
0082e784 dd 80 00 01 b0 ff 82 00 - 00 00 00 00 30 32 43 56 ............02CV
0082e794 00 00 00 00 00 00 00 f0 - 00 00 00 50 ff ff ff 0f ...........P....
0082e7a4 8c 99 28 51 f8 fb 82 00 - 69 11 02 01 88 71 0c 01 ..(Q....i....q..
0082e7b4 d8 e7 82 00 f4 e7 82 00 - 01 00 00 00 58 b8 5a 01 ............X.Z.
0082e7c4 01 00 00 00 00 00 00 00 - 00 00 00 00 38 34 0f 01 ............84..
0082e7d4 01 00 00 00 b0 e8 82 00 - 00 e8 82 00 01 00 00 00 ................
State Dump for Thread Id 0x114
eax=107fff2c ebx=00000000 ecx=107fffdc edx=00000000 esi=107fff2c edi=107fff98
eip=77e1325c esp=107ffee8 ebp=107fff08 iopl=0 nv up ei pl zr na po nc
cs=001b ss=0023 ds=0023 es=0023 fs=0038 gs=0000 efl=00000246
function: TranslateMessageEx
77e1323a 0f8500c40200 jne EnumDesktopWindows+0xd88 (77e3f640)
77e13240 33c0 xor eax,eax
77e13242 c20800 ret 0x8
77e13245 ff742408 push dword ptr [esp+0x8]
ss:1127d4bb=????????
77e13249 51 push ecx
77e1324a e8b7370000 call GetKeyState+0x92 (77e16a06)
77e1324f ebf1 jmp DialogBoxIndirectParamAorW+0x6ba
(77e1eb42)
77e13251 b89a110000 mov eax,0x119a
77e13256 8d542404 lea edx,[esp+0x4]
ss:1127d4bb=????????
77e1325a cd2e int 2e
77e1325c c21000 ret 0x10
*----> Stack Back Trace <----*
FramePtr ReturnAd Param#1 Param#2 Param#3 Param#4 Function Name
107FFF08 010A4270 107FFF2C 00000000 00000000 00000000 user32!TranslateMessageEx
107FFF48 010A4241 107FFF5C 77F82DC3 0082F34C 00000000 temacs!w32_msg_worker
107FFFB4 77E8758A 00000000 77F82DC3 0082F34C 00000000 temacs!w32_msg_worker
107FFFEC 00000000 010A41F4 00000000 00000000 00905A4D kernel32!SetFilePointer
*----> Raw Stack Dump <----*
107ffee8 63 58 e1 77 2c ff 7f 10 - 00 00 00 00 00 00 00 00 cX.w,...........
107ffef8 00 00 00 00 00 00 00 00 - 00 00 00 00 98 ff 7f 10 ................
107fff08 48 ff 7f 10 70 42 0a 01 - 2c ff 7f 10 00 00 00 00 H...pB..,.......
107fff18 00 00 00 00 00 00 00 00 - 98 ff 7f 10 00 00 00 00 ................
107fff28 00 00 00 00 5e 03 1b 00 - a1 00 00 00 08 00 00 00 ....^...........
107fff38 92 03 4b 00 ad 83 d7 0c - 92 03 00 00 4b 00 00 00 ..K.........K...
107fff48 b4 ff 7f 10 41 42 0a 01 - 5c ff 7f 10 c3 2d f8 77 ....AB..\....-.w
107fff58 4c f3 82 00 00 00 00 00 - 00 00 00 00 00 00 00 00 L...............
107fff68 00 00 00 00 00 00 00 00 - 00 00 00 00 00 00 00 00 ................
107fff78 00 00 00 00 00 00 00 00 - 00 00 00 00 00 00 00 00 ................
107fff88 00 00 00 00 00 00 00 00 - 00 00 00 00 00 00 00 00 ................
107fff98 60 69 36 81 ff ff ff ff - 77 0d 43 80 00 00 00 00 `i6.....w.C.....
107fffa8 00 00 00 00 00 00 00 00 - 7b 10 43 80 ec ff 7f 10 ........{.C.....
107fffb8 8a 75 e8 77 00 00 00 00 - c3 2d f8 77 4c f3 82 00 .u.w.....-.wL...
107fffc8 00 00 00 00 00 d0 fd 7f - 24 f3 82 00 c0 ff 7f 10 ........$.......
107fffd8 24 f3 82 00 ff ff ff ff - 5b 61 e8 77 80 b5 e8 77 $.......[a.w...w
107fffe8 00 00 00 00 00 00 00 00 - 00 00 00 00 f4 41 0a 01 .............A..
107ffff8 00 00 00 00 00 00 00 00 - 4d 5a 90 00 03 00 00 00 ........MZ......
10800008 04 00 00 00 ff ff 00 00 - b8 00 00 00 00 00 00 00 ................
10800018 40 00 00 00 00 00 00 00 - 00 00 00 00 00 00 00 00 @...............
State Dump for Thread Id 0x6fc
eax=778321fe ebx=00000004 ecx=77db0260 edx=00000000 esi=77f8281e edi=00000004
eip=77f82829 esp=115efd24 ebp=115efd70 iopl=0 nv up ei pl zr na po nc
cs=001b ss=0023 ds=0023 es=0023 fs=0038 gs=0000 efl=00000246
function: NtWaitForMultipleObjects
77f8281e b8e9000000 mov eax,0xe9
77f82823 8d542404 lea edx,[esp+0x4]
ss:1206d2f7=????????
77f82827 cd2e int 2e
77f82829 c21400 ret 0x14
*----> Stack Back Trace <----*
FramePtr ReturnAd Param#1 Param#2 Param#3 Param#4 Function Name
115EFD70 77E86E1A 115EFD48 00000001 00000000 00000000
ntdll!NtWaitForMultipleObjects
115EFFB4 77E8758A 00000005 00000000 000B000A 0085BF68
kernel32!WaitForMultipleObjects
115EFFEC 00000000 778321FE 0085BF68 00000000 000000C8 kernel32!SetFilePointer
*----> Raw Stack Dump <----*
115efd24 da 6d e8 77 04 00 00 00 - 48 fd 5e 11 01 00 00 00 .m.w....H.^.....
115efd34 00 00 00 00 00 00 00 00 - 01 00 00 00 68 bf 85 00 ............h...
115efd44 01 00 00 00 64 01 00 00 - 68 01 00 00 78 01 00 00 ....d...h...x...
115efd54 d0 01 00 00 ff 03 1f 00 - 2c 0b cd be 01 00 00 00 ........,.......
115efd64 84 c7 27 81 a8 0a cd be - 4c c4 49 80 b4 ff 5e 11 ..'.....L.I...^.
115efd74 1a 6e e8 77 48 fd 5e 11 - 01 00 00 00 00 00 00 00 .n.wH.^.........
115efd84 00 00 00 00 00 00 00 00 - b2 22 83 77 04 00 00 00 .........".w....
115efd94 b0 fe 5e 11 00 00 00 00 - ff ff ff ff 68 bf 85 00 ..^.........h...
115efda4 0a 00 0b 00 00 00 00 00 - ff ff ff ff f0 0a cd be ................
115efdb4 8e f5 49 80 00 00 00 00 - 01 00 00 00 38 00 00 00 ..I.........8...
115efdc4 23 00 00 00 23 00 00 00 - 00 00 00 00 0a 00 0b 00 #...#...........
115efdd4 68 bf 85 00 c8 43 f8 77 - 60 02 db 77 fe 21 83 77 h....C.w`..w.!.w
115efde4 00 00 00 00 32 75 e8 77 - 1b 00 00 00 00 02 00 00 ....2u.w........
115efdf4 fc ff 5e 11 23 00 00 00 - 0f 00 00 00 0c 00 00 00 ..^.#...........
115efe04 b4 e3 88 e2 00 00 00 00 - 00 00 00 00 00 00 00 02 ................
115efe14 48 0b cd be 00 00 00 02 - 7c 0b cd be 3b fc 49 80 H.......|...;.I.
115efe24 70 cc 07 e3 70 cc 07 e3 - 00 00 00 00 00 00 00 00 p...p...........
115efe34 01 00 00 00 48 0b cd be - 43 fc 49 80 70 cc 07 e3 ....H...C.I.p...
115efe44 00 00 00 02 80 0c cd be - 00 00 00 00 00 00 00 00 ................
115efe54 00 00 00 00 00 00 00 00 - 00 00 00 00 00 00 00 00 ................
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- Emacs crash,
Stavros Macrakis <=