* bug#10664: 24.0.93; JIT font-lock infloops in a C file
@ 2012-01-30 18:23 Eli Zaretskii
2012-02-05 18:18 ` Eli Zaretskii
0 siblings, 1 reply; 16+ messages in thread
From: Eli Zaretskii @ 2012-01-30 18:23 UTC (permalink / raw)
To: 10664
[-- Attachment #1: Type: text/plain, Size: 13626 bytes --]
This bug report will be sent to the Bug-GNU-Emacs mailing list
and the GNU bug tracker at debbugs.gnu.org. Please check that
the From: line contains a valid email address. After a delay of up
to one day, you should receive an acknowledgement at that address.
Please write in English if possible, as the Emacs maintainers
usually do not have translators for other languages.
Please describe exactly what actions triggered the bug, and
the precise symptoms of the bug. If you can, give a recipe
starting from `emacs -Q':
I don't have a recipe starting from "emacs -Q", sorry.
I left my freshly built Emacs 24.0.93 running, and when I returned to
it a few hours later, I found it unresponsive, endlessly showing in
the echo area "JIT lock socket.c", interspersed with GC messages
(I have garbage-collection-messages set non-nil).
Breaking into Emacs with a debugger produced the backtrace below (it's
an optimized build, so the backtrace may be inaccurate, sorry). I
attach the file socket.c (part of the Guile sources) as well.
I still have that session in a debugger, so if someone wants me to
look around and show some values, I can do that.
#0 find_symbol_value (symbol=50731778) at data.c:1044
1044 return do_symval_forwarding (SYMBOL_FWD (sym));
(gdb) bt
#0 find_symbol_value (symbol=50731778) at data.c:1044
#1 0x0100fb9b in specbind (symbol=50731778, value=50616370) at eval.c:3322
#2 0x0109f6d5 in exec_byte_code (bytestr=50731778, vector=2,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:747
#3 0x01011a8a in funcall_lambda (fun=69096517, nargs=1, arg_vector=0x82df24)
at eval.c:3218
#4 0x01011eed in Ffuncall (nargs=2, args=0x41e5445) at eval.c:3048
#5 0x0109f68c in exec_byte_code (bytestr=50731778, vector=1,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:785
#6 0x0109ff82 in Fbyte_code (bytestr=3, vector=3, maxdepth=3)
at bytecode.c:423
#7 0x01011227 in eval_sub (form=20240912) at eval.c:2341
#8 0x0100eef0 in internal_catch (tag=3, func=0x1010ce6 <eval_sub>,
arg=68864406) at eval.c:1257
#9 0x0109ed60 in exec_byte_code (bytestr=50731778, vector=141,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:966
#10 0x01011a8a in funcall_lambda (fun=68468261, nargs=1, arg_vector=0x82e2d4)
at eval.c:3218
#11 0x01011eed in Ffuncall (nargs=2, args=0x414be25) at eval.c:3048
#12 0x0109f68c in exec_byte_code (bytestr=50731778, vector=1,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:785
#13 0x01011a8a in funcall_lambda (fun=69603781, nargs=1, arg_vector=0x82e444)
at eval.c:3218
#14 0x01011eed in Ffuncall (nargs=2, args=0x42611c5) at eval.c:3048
#15 0x0109f68c in exec_byte_code (bytestr=50731778, vector=1,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:785
#16 0x01011a8a in funcall_lambda (fun=69603397, nargs=2, arg_vector=0x82e5b4)
at eval.c:3218
#17 0x01011eed in Ffuncall (nargs=3, args=0x4261045) at eval.c:3048
#18 0x0109f68c in exec_byte_code (bytestr=50731778, vector=2,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:785
#19 0x01011a8a in funcall_lambda (fun=69619589, nargs=1, arg_vector=0x82e72c)
at eval.c:3218
#20 0x01011eed in Ffuncall (nargs=2, args=0x4264f85) at eval.c:3048
#21 0x0101257a in call1 (fn=3, arg1=3) at eval.c:2756
#22 0x0103162e in mapcar1 (leni=1, vals=0x0, fn=69619589, seq=50731778)
at fns.c:2346
#23 0x010319d5 in Fmapc (function=3, sequence=71107830) at fns.c:2434
#24 0x010120e8 in Ffuncall (nargs=3, args=0x134acf8) at eval.c:2990
#25 0x0109f68c in exec_byte_code (bytestr=50731778, vector=2,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:785
#26 0x01011a8a in funcall_lambda (fun=69619429, nargs=3, arg_vector=0x82e9e4)
at eval.c:3218
#27 0x01011eed in Ffuncall (nargs=4, args=0x4264ee5) at eval.c:3048
#28 0x0109f68c in exec_byte_code (bytestr=50731778, vector=3,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:785
#29 0x01011a8a in funcall_lambda (fun=19193997, nargs=2, arg_vector=0x82ec68)
at eval.c:3218
#30 0x01011eed in Ffuncall (nargs=3, args=0x124e08d) at eval.c:3048
#31 0x01012618 in funcall_nil (nargs=3, args=0x3) at eval.c:2504
#32 0x0100f5af in run_hook_with_args (nargs=3, args=0x82ec64,
funcall=0x1012600 <funcall_nil>) at eval.c:2693
#33 0x0100f6f3 in Frun_hook_with_args (nargs=3, args=0x3) at eval.c:2554
#34 0x01012184 in Ffuncall (nargs=4, args=0x134a01d) at eval.c:2969
#35 0x0109f68c in exec_byte_code (bytestr=50731778, vector=3,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:785
#36 0x0109ff82 in Fbyte_code (bytestr=3, vector=3, maxdepth=3)
at bytecode.c:423
#37 0x01011227 in eval_sub (form=20240912) at eval.c:2341
#38 0x01012fbf in internal_lisp_condition_case (var=50869346,
bodyform=19206126, handlers=19206174) at eval.c:1454
#39 0x0109ed1e in exec_byte_code (bytestr=50731778, vector=143,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:981
#40 0x01011a8a in funcall_lambda (fun=19205877, nargs=2, arg_vector=0x82f034)
at eval.c:3218
#41 0x01011eed in Ffuncall (nargs=3, args=0x1250ef5) at eval.c:3048
#42 0x0109f68c in exec_byte_code (bytestr=50731778, vector=2,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:785
#43 0x01011a8a in funcall_lambda (fun=19206717, nargs=1, arg_vector=0x82f278)
at eval.c:3218
#44 0x01011eed in Ffuncall (nargs=2, args=0x125123d) at eval.c:3048
#45 0x0101275e in Fapply (nargs=2, args=0x82f274) at eval.c:2439
#46 0x01012184 in Ffuncall (nargs=3, args=0x134a065) at eval.c:2969
#47 0x0109f68c in exec_byte_code (bytestr=50731778, vector=2,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:785
#48 0x0109ff82 in Fbyte_code (bytestr=3, vector=3, maxdepth=3)
at bytecode.c:423
#49 0x01011227 in eval_sub (form=20240912) at eval.c:2341
#50 0x01012fbf in internal_lisp_condition_case (var=50616346,
bodyform=19235438, handlers=18612686) at eval.c:1454
#51 0x0109ed1e in exec_byte_code (bytestr=50731778, vector=143,
maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
at bytecode.c:981
#52 0x01011a8a in funcall_lambda (fun=19235277, nargs=1, arg_vector=0x82f64c)
at eval.c:3218
#53 0x01011eed in Ffuncall (nargs=2, args=0x12581cd) at eval.c:3048
#54 0x0101257a in call1 (fn=3, arg1=3) at eval.c:2756
#55 0x0101e391 in timer_check () at keyboard.c:4437
#56 0x0101e5c2 in readable_events (flags=1) at keyboard.c:3388
#57 0x010244ad in get_input_pending (addr=0x13c51b0, flags=1)
at keyboard.c:6713
#58 0x01024562 in detect_input_pending_run_timers (do_display=1)
at keyboard.c:10480
#59 0x0101984b in wait_reading_process_output (time_limit=0, microsecs=0,
read_kbd=-1, do_display=1, wait_for_cell=50616346, wait_proc=0x0,
just_wait_proc=0) at process.c:4733
#60 0x01025c6a in read_char (commandflag=1, nmaps=2, maps=0x82fab0,
prev_event=50616346, used_mouse_menu=0x82fbb8, end_time=0x0)
at keyboard.c:3851
#61 0x01027b26 in read_key_sequence (keybuf=0x82fcb0, bufsize=30,
prompt=50616346, dont_downcase_last=0, can_return_switch_frame=1,
fix_current_buffer=1) at keyboard.c:9300
#62 0x01029a9f in command_loop_1 () at keyboard.c:1448
#63 0x0100efbb in internal_condition_case (bfun=0x10298ff <command_loop_1>,
handlers=50674074, hfun=0x102374d <cmd_error>) at eval.c:1500
#64 0x0101cf0f in command_loop_2 (ignore=50616346) at keyboard.c:1159
#65 0x0100eef0 in internal_catch (tag=3, func=0x101ceec <command_loop_2>,
arg=50616346) at eval.c:1257
#66 0x0101cdc2 in recursive_edit_1 () at keyboard.c:1138
#67 0x0101ced6 in Frecursive_edit () at keyboard.c:822
#68 0x01002f21 in main (argc=1, argv=0xa47ff0) at emacs.c:1715
Lisp Backtrace:
"c-in-knr-argdecl" (0x82df24)
"byte-code" (0x82e030)
"c-beginning-of-decl-1" (0x82e2d4)
"c-set-fl-decl-start" (0x82e444)
"c-context-set-fl-decl-start" (0x82e5b4)
0x4264f80 PVEC_COMPILED
"mapc" (0x82e874)
"c-font-lock-fontify-region" (0x82e9e4)
"font-lock-fontify-region" (0x82ec68)
"run-hook-with-args" (0x82ec64)
"byte-code" (0x82ed60)
"jit-lock-fontify-now" (0x82f034)
"jit-lock-stealth-fontify" (0x82f278)
"apply" (0x82f274)
"byte-code" (0x82f370)
"timer-event-handler" (0x82f64c)
(gdb) p symbol
$1 = 50731778
(gdb) xtype
Lisp_Symbol
(gdb) xsymbol
$2 = (struct Lisp_Symbol *) 0x3061b00
"buffer-undo-list"
(gdb)
If Emacs crashed, and you have the Emacs process in the gdb debugger,
please include the output from the following gdb commands:
`bt full' and `xbacktrace'.
For information about debugging Emacs, please read the file
d:/usr/emacs/etc/DEBUG.
In GNU Emacs 24.0.93.1 (i386-mingw-nt5.1.2600)
of 2012-01-29 on HOME-C4E4A596F7
Windowing system distributor `Microsoft Corp.', version 5.1.2600
Configured using:
`configure --with-gcc (3.4)'
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: ENU
value of $XMODIFIERS: nil
locale-coding-system: cp1255
default enable-multibyte-characters: t
Major mode: Mail
Minor modes in effect:
flyspell-mode: t
diff-auto-refine-mode: t
desktop-save-mode: t
show-paren-mode: t
display-time-mode: t
tooltip-mode: t
mouse-wheel-mode: t
tool-bar-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
font-lock-mode: t
blink-cursor-mode: t
auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
temp-buffer-resize-mode: t
line-number-mode: t
abbrev-mode: t
Recent input:
<delete> <delete> <delete> <delete> <delete> <delete>
<delete> <delete> <delete> <delete> t h e SPC o t h
e r SPC p o s s i b l e SPC r e a s i n SPC <backspace>
<backspace> <backspace> o n SPC i s SPC t h a t M-q
<C-right> <C-right> <C-right> M-d <C-right> <C-right>
SPC ( n o t SPC i n s t a l l e d ) M-q <down> <down>
<C-home> C-c C-s <switch-frame> d SPC M-z M-z M-z M-z
M-z M-z M-z M-z M-z M-z M-z M-z M-z C-z C-z C-z C-z
C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z
C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z
C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z M-z n o G N
U W <tab> <return> SPC M-z n d SPC SPC d SPC d p p
p p p p p p n n n n n C-z C-z C-z C-z C-z C-z C-z C-z
<switch-frame> <help-echo> <switch-frame> <help-echo>
<switch-frame> <switch-frame> <C-home> f n e s s SPC
<backspace> <down> <down> <down> <down> <down> C h
e c k SPC t h i s SPC o u t . C-c C-s C-g C-x 1 <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> C-x <return> f <return> C-c C-s <switch-frame>
n SPC o P O <tab> <return> SPC n p p p p p p p p p
p p p n n n n n n n n n n n n n n n n n n n n n n n
n n n n <help-echo> <switch-frame> <help-echo> <help-echo>
<help-echo> <help-echo> <switch-frame> C-x C-s <switch-frame>
M-x r e p o r t - e m <tab> <return>
Recent messages:
Quit
Sending...
Added to d:/usr/eli/rmail/SENT.MAIL
Sending email
Sending email done
Sending...done
Added to d:/usr/eli/rmail/PORTS.rmail
No following nondeleted message [16 times]
Saving file d:/usr/eli/rmail/INBOX...
Wrote d:/usr/eli/rmail/INBOX [2 times]
Load-path shadows:
None found.
Features:
(shadow emacsbug find-func multi-isearch help-mode view dabbrev
network-stream starttls tls smtpmail auth-source eieio assoc gnus-util
password-cache mailalias sendmail rmailout ld-script sh-script
executable dired-x dired tcl nxml-uchnm rng-xsd xsd-regexp rng-cmpct
rng-nxml rng-valid rng-loc rng-uri rng-parse nxml-parse rng-match
rng-dt rng-util rng-pttrn nxml-ns nxml-mode nxml-outln nxml-rap
nxml-util nxml-glyph nxml-enc xmltok sgml-mode org-wl org-w3m org-vm
org-rmail org-mhe org-mew org-irc org-jsinfo org-infojs org-html
org-exp ob-exp org-exp-blocks org-agenda org-info org-gnus org-docview
org-bibtex bibtex org-bbdb org byte-opt warnings bytecomp byte-compile
cconv macroexp advice help-fns advice-preload ob-emacs-lisp ob-tangle
ob-ref ob-lob ob-table org-footnote org-src ob-comint ob-keys ob
ob-eval org-pcomplete pcomplete comint ring org-list org-faces
org-compat org-entities org-macs cal-menu calendar cal-loaddefs
noutline outline arc-mode archive-mode jka-compr flyspell ispell
autorevert diff-mode easy-mmode make-mode conf-mode newcomment generic
parse-time vc-cvs info vc-bzr cc-mode cc-fonts cc-guess cc-menus
cc-cmds cc-styles cc-align cc-engine cc-vars cc-defs regexp-opt
rmailsum qp rmailmm message format-spec rfc822 mml easymenu mml-sec
mm-decode mm-bodies mm-encode mailabbrev gmm-utils mailheader
mail-parse rfc2231 rmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr
mail-utils desktop server filecache saveplace midnight generic-x paren
battery time time-date tooltip ediff-hook vc-hooks lisp-float-type
mwheel dos-w32 disp-table ls-lisp w32-win w32-vars tool-bar dnd
fontset image fringe lisp-mode register page menu-bar rfn-eshadow
timer select scroll-bar mouse jit-lock font-lock syntax facemenu
font-core frame cham georgian utf-8-lang misc-lang vietnamese tibetan
thai tai-viet lao korean japanese hebrew greek romanian slovak czech
european ethiopic indian cyrillic chinese case-table epa-hook
jka-cmpr-hook help simple abbrev minibuffer loaddefs button faces
cus-face files text-properties overlay sha1 md5 base64 format env
code-pages mule custom widget hashtable-print-readable backquote
make-network-process multi-tty emacs)
[-- Attachment #2: socket.c --]
[-- Type: application/octet-stream, Size: 55842 bytes --]
/* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
* 2006, 2007, 2009, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
* the License, or (at your option) any later version.
*
* This library 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
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
* 02110-1301 USA
*/
\f
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <errno.h>
#include <gmp.h>
#include "libguile/_scm.h"
#include "libguile/arrays.h"
#include "libguile/feature.h"
#include "libguile/fports.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
#include "libguile/dynwind.h"
#include "libguile/srfi-13.h"
#include "libguile/validate.h"
#include "libguile/socket.h"
#if SCM_ENABLE_DEPRECATED == 1
# include "libguile/deprecation.h"
#endif
#ifdef __MINGW32__
#include "win32-socket.h"
#include <netdb.h>
#endif
#ifdef HAVE_STDINT_H
#include <stdint.h>
#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <sys/types.h>
#if HAVE_WINSOCK2_H && !GNULIB_TEST_SOCKET
#include <winsock2.h>
#else
#include <sys/socket.h>
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
#include <sys/un.h>
#endif
#include <netinet/in.h>
#include <netdb.h>
#include <arpa/inet.h>
#endif
#if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
#define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
+ strlen ((ptr)->sun_path))
#endif
/* The largest possible socket address. Wrapping it in a union guarantees
that the compiler will make it suitably aligned. */
typedef union
{
struct sockaddr sockaddr;
struct sockaddr_in sockaddr_in;
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
struct sockaddr_un sockaddr_un;
#endif
#ifdef HAVE_IPV6
struct sockaddr_in6 sockaddr_in6;
#endif
} scm_t_max_sockaddr;
/* Maximum size of a socket address. */
#define MAX_ADDR_SIZE (sizeof (scm_t_max_sockaddr))
\f
SCM_DEFINE (scm_htons, "htons", 1, 0, 0,
(SCM value),
"Convert a 16 bit quantity from host to network byte ordering.\n"
"@var{value} is packed into 2 bytes, which are then converted\n"
"and returned as a new integer.")
#define FUNC_NAME s_scm_htons
{
return scm_from_ushort (htons (scm_to_ushort (value)));
}
#undef FUNC_NAME
SCM_DEFINE (scm_ntohs, "ntohs", 1, 0, 0,
(SCM value),
"Convert a 16 bit quantity from network to host byte ordering.\n"
"@var{value} is packed into 2 bytes, which are then converted\n"
"and returned as a new integer.")
#define FUNC_NAME s_scm_ntohs
{
return scm_from_ushort (ntohs (scm_to_ushort (value)));
}
#undef FUNC_NAME
SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0,
(SCM value),
"Convert a 32 bit quantity from host to network byte ordering.\n"
"@var{value} is packed into 4 bytes, which are then converted\n"
"and returned as a new integer.")
#define FUNC_NAME s_scm_htonl
{
return scm_from_ulong (htonl (scm_to_uint32 (value)));
}
#undef FUNC_NAME
SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0,
(SCM value),
"Convert a 32 bit quantity from network to host byte ordering.\n"
"@var{value} is packed into 4 bytes, which are then converted\n"
"and returned as a new integer.")
#define FUNC_NAME s_scm_ntohl
{
return scm_from_ulong (ntohl (scm_to_uint32 (value)));
}
#undef FUNC_NAME
#ifdef HAVE_INET_NETOF
SCM_DEFINE (scm_inet_netof, "inet-netof", 1, 0, 0,
(SCM address),
"Return the network number part of the given IPv4\n"
"Internet address. E.g.,\n\n"
"@lisp\n"
"(inet-netof 2130706433) @result{} 127\n"
"@end lisp")
#define FUNC_NAME s_scm_inet_netof
{
struct in_addr addr;
addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
return scm_from_ulong (inet_netof (addr));
}
#undef FUNC_NAME
#endif
#ifdef HAVE_INET_LNAOF
SCM_DEFINE (scm_lnaof, "inet-lnaof", 1, 0, 0,
(SCM address),
"Return the local-address-with-network part of the given\n"
"IPv4 Internet address, using the obsolete class A/B/C system.\n"
"E.g.,\n\n"
"@lisp\n"
"(inet-lnaof 2130706433) @result{} 1\n"
"@end lisp")
#define FUNC_NAME s_scm_lnaof
{
struct in_addr addr;
addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
return scm_from_ulong (inet_lnaof (addr));
}
#undef FUNC_NAME
#endif
#ifdef HAVE_INET_MAKEADDR
SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
(SCM net, SCM lna),
"Make an IPv4 Internet address by combining the network number\n"
"@var{net} with the local-address-within-network number\n"
"@var{lna}. E.g.,\n\n"
"@lisp\n"
"(inet-makeaddr 127 1) @result{} 2130706433\n"
"@end lisp")
#define FUNC_NAME s_scm_inet_makeaddr
{
struct in_addr addr;
unsigned long netnum;
unsigned long lnanum;
netnum = SCM_NUM2ULONG (1, net);
lnanum = SCM_NUM2ULONG (2, lna);
addr = inet_makeaddr (netnum, lnanum);
return scm_from_ulong (ntohl (addr.s_addr));
}
#undef FUNC_NAME
#endif
#ifdef HAVE_IPV6
/* flip a 128 bit IPv6 address between host and network order. */
#ifdef WORDS_BIGENDIAN
#define FLIP_NET_HOST_128(addr)
#else
#define FLIP_NET_HOST_128(addr)\
{\
int i;\
\
for (i = 0; i < 8; i++)\
{\
scm_t_uint8 c = (addr)[i];\
\
(addr)[i] = (addr)[15 - i];\
(addr)[15 - i] = c;\
}\
}
#endif
#ifdef WORDS_BIGENDIAN
#define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
#else
#define FLIPCPY_NET_HOST_128(dest, src) \
{ \
const scm_t_uint8 *tmp_srcp = (src) + 15; \
scm_t_uint8 *tmp_destp = (dest); \
\
do { \
*tmp_destp++ = *tmp_srcp--; \
} while (tmp_srcp != (src)); \
}
#endif
#if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
#error "Assumption that scm_t_bits <= 128 bits has been violated."
#endif
#if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
#error "Assumption that unsigned long <= 128 bits has been violated."
#endif
#if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
#error "Assumption that unsigned long long <= 128 bits has been violated."
#endif
/* convert a 128 bit IPv6 address in network order to a host ordered
SCM integer. */
static SCM
scm_from_ipv6 (const scm_t_uint8 *src)
{
SCM result = scm_i_mkbig ();
mpz_import (SCM_I_BIG_MPZ (result),
1, /* chunk */
1, /* big-endian chunk ordering */
16, /* chunks are 16 bytes long */
1, /* big-endian byte ordering */
0, /* "nails" -- leading unused bits per chunk */
src);
return scm_i_normbig (result);
}
/* convert a host ordered SCM integer to a 128 bit IPv6 address in
network order. */
static void
scm_to_ipv6 (scm_t_uint8 dst[16], SCM src)
{
if (SCM_I_INUMP (src))
{
scm_t_signed_bits n = SCM_I_INUM (src);
if (n < 0)
scm_out_of_range (NULL, src);
#ifdef WORDS_BIGENDIAN
memset (dst, 0, 16 - sizeof (scm_t_signed_bits));
memcpy (dst + (16 - sizeof (scm_t_signed_bits)),
&n,
sizeof (scm_t_signed_bits));
#else
memset (dst + sizeof (scm_t_signed_bits),
0,
16 - sizeof (scm_t_signed_bits));
/* FIXME: this pair of ops is kinda wasteful -- should rewrite as
a single loop perhaps, similar to the handling of bignums. */
memcpy (dst, &n, sizeof (scm_t_signed_bits));
FLIP_NET_HOST_128 (dst);
#endif
}
else if (SCM_BIGP (src))
{
size_t count;
if ((mpz_sgn (SCM_I_BIG_MPZ (src)) < 0)
|| mpz_sizeinbase (SCM_I_BIG_MPZ (src), 2) > 128)
scm_out_of_range (NULL, src);
memset (dst, 0, 16);
mpz_export (dst,
&count,
1, /* big-endian chunk ordering */
16, /* chunks are 16 bytes long */
1, /* big-endian byte ordering */
0, /* "nails" -- leading unused bits per chunk */
SCM_I_BIG_MPZ (src));
scm_remember_upto_here_1 (src);
}
else
scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src, "integer");
}
#endif /* HAVE_IPV6 */
\f
SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
(SCM family, SCM address),
"Convert a network address into a printable string.\n"
"Note that unlike the C version of this function,\n"
"the input is an integer with normal host byte ordering.\n"
"@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
"@lisp\n"
"(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
"(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
" @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
"@end lisp")
#define FUNC_NAME s_scm_inet_ntop
{
int af;
#ifdef INET6_ADDRSTRLEN
char dst[INET6_ADDRSTRLEN];
#else
char dst[46];
#endif
const char *result;
af = scm_to_int (family);
SCM_ASSERT_RANGE (1, family,
af == AF_INET
#ifdef HAVE_IPV6
|| af == AF_INET6
#endif
);
if (af == AF_INET)
{
scm_t_uint32 addr4;
addr4 = htonl (SCM_NUM2ULONG (2, address));
result = inet_ntop (af, &addr4, dst, sizeof (dst));
}
#ifdef HAVE_IPV6
else if (af == AF_INET6)
{
char addr6[16];
scm_to_ipv6 ((scm_t_uint8 *) addr6, address);
result = inet_ntop (af, &addr6, dst, sizeof (dst));
}
#endif
else
SCM_MISC_ERROR ("unsupported address family", family);
if (result == NULL)
SCM_SYSERROR;
return scm_from_locale_string (dst);
}
#undef FUNC_NAME
SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
(SCM family, SCM address),
"Convert a string containing a printable network address to\n"
"an integer address. Note that unlike the C version of this\n"
"function,\n"
"the result is an integer with normal host byte ordering.\n"
"@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
"@lisp\n"
"(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
"(inet-pton AF_INET6 \"::1\") @result{} 1\n"
"@end lisp")
#define FUNC_NAME s_scm_inet_pton
{
int af;
char *src;
scm_t_uint32 dst[4];
int rv, eno;
af = scm_to_int (family);
SCM_ASSERT_RANGE (1, family,
af == AF_INET
#ifdef HAVE_IPV6
|| af == AF_INET6
#endif
);
src = scm_to_locale_string (address);
rv = inet_pton (af, src, dst);
eno = errno;
free (src);
errno = eno;
if (rv == -1)
SCM_SYSERROR;
else if (rv == 0)
SCM_MISC_ERROR ("Bad address", SCM_EOL);
if (af == AF_INET)
return scm_from_ulong (ntohl (*dst));
#ifdef HAVE_IPV6
else if (af == AF_INET6)
return scm_from_ipv6 ((scm_t_uint8 *) dst);
#endif
else
SCM_MISC_ERROR ("unsupported address family", family);
}
#undef FUNC_NAME
\f
SCM_SYMBOL (sym_socket, "socket");
#define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
SCM_DEFINE (scm_socket, "socket", 3, 0, 0,
(SCM family, SCM style, SCM proto),
"Return a new socket port of the type specified by @var{family},\n"
"@var{style} and @var{proto}. All three parameters are\n"
"integers. Supported values for @var{family} are\n"
"@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
"Typical values for @var{style} are @code{SOCK_STREAM},\n"
"@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
"@var{proto} can be obtained from a protocol name using\n"
"@code{getprotobyname}. A value of zero specifies the default\n"
"protocol, which is usually right.\n\n"
"A single socket port cannot by used for communication until it\n"
"has been connected to another socket.")
#define FUNC_NAME s_scm_socket
{
int fd;
fd = socket (scm_to_int (family),
scm_to_int (style),
scm_to_int (proto));
if (fd == -1)
SCM_SYSERROR;
return SCM_SOCK_FD_TO_PORT (fd);
}
#undef FUNC_NAME
#ifdef HAVE_SOCKETPAIR
SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0,
(SCM family, SCM style, SCM proto),
"Return a pair of connected (but unnamed) socket ports of the\n"
"type specified by @var{family}, @var{style} and @var{proto}.\n"
"Many systems support only socket pairs of the @code{AF_UNIX}\n"
"family. Zero is likely to be the only meaningful value for\n"
"@var{proto}.")
#define FUNC_NAME s_scm_socketpair
{
int fam;
int fd[2];
fam = scm_to_int (family);
if (socketpair (fam, scm_to_int (style), scm_to_int (proto), fd) == -1)
SCM_SYSERROR;
return scm_cons (SCM_SOCK_FD_TO_PORT (fd[0]), SCM_SOCK_FD_TO_PORT (fd[1]));
}
#undef FUNC_NAME
#endif
/* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
suitable alignment. */
typedef union
{
#ifdef HAVE_STRUCT_LINGER
struct linger linger;
#endif
size_t size;
int integer;
} scm_t_getsockopt_result;
SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
(SCM sock, SCM level, SCM optname),
"Return an option value from socket port @var{sock}.\n"
"\n"
"@var{level} is an integer specifying a protocol layer, either\n"
"@code{SOL_SOCKET} for socket level options, or a protocol\n"
"number from the @code{IPPROTO} constants or @code{getprotoent}\n"
"(@pxref{Network Databases}).\n"
"\n"
"@defvar SOL_SOCKET\n"
"@defvarx IPPROTO_IP\n"
"@defvarx IPPROTO_TCP\n"
"@defvarx IPPROTO_UDP\n"
"@end defvar\n"
"\n"
"@var{optname} is an integer specifying an option within the\n"
"protocol layer.\n"
"\n"
"For @code{SOL_SOCKET} level the following @var{optname}s are\n"
"defined (when provided by the system). For their meaning see\n"
"@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
"Manual}, or @command{man 7 socket}.\n"
"\n"
"@defvar SO_DEBUG\n"
"@defvarx SO_REUSEADDR\n"
"@defvarx SO_STYLE\n"
"@defvarx SO_TYPE\n"
"@defvarx SO_ERROR\n"
"@defvarx SO_DONTROUTE\n"
"@defvarx SO_BROADCAST\n"
"@defvarx SO_SNDBUF\n"
"@defvarx SO_RCVBUF\n"
"@defvarx SO_KEEPALIVE\n"
"@defvarx SO_OOBINLINE\n"
"@defvarx SO_NO_CHECK\n"
"@defvarx SO_PRIORITY\n"
"The value returned is an integer.\n"
"@end defvar\n"
"\n"
"@defvar SO_LINGER\n"
"The @var{value} returned is a pair of integers\n"
"@code{(@var{ENABLE} . @var{TIMEOUT})}. On old systems without\n"
"timeout support (ie.@: without @code{struct linger}), only\n"
"@var{ENABLE} has an effect but the value in Guile is always a\n"
"pair.\n"
"@end defvar")
#define FUNC_NAME s_scm_getsockopt
{
int fd;
/* size of optval is the largest supported option. */
scm_t_getsockopt_result optval;
socklen_t optlen = sizeof (optval);
int ilevel;
int ioptname;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
ilevel = scm_to_int (level);
ioptname = scm_to_int (optname);
fd = SCM_FPORT_FDES (sock);
if (getsockopt (fd, ilevel, ioptname, (void *) &optval, &optlen) == -1)
SCM_SYSERROR;
if (ilevel == SOL_SOCKET)
{
#ifdef SO_LINGER
if (ioptname == SO_LINGER)
{
#ifdef HAVE_STRUCT_LINGER
struct linger *ling = (struct linger *) &optval;
return scm_cons (scm_from_long (ling->l_onoff),
scm_from_long (ling->l_linger));
#else
return scm_cons (scm_from_long (*(int *) &optval),
scm_from_int (0));
#endif
}
else
#endif
if (0
#ifdef SO_SNDBUF
|| ioptname == SO_SNDBUF
#endif
#ifdef SO_RCVBUF
|| ioptname == SO_RCVBUF
#endif
)
{
return scm_from_size_t (*(size_t *) &optval);
}
}
return scm_from_int (*(int *) &optval);
}
#undef FUNC_NAME
SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
(SCM sock, SCM level, SCM optname, SCM value),
"Set an option on socket port @var{sock}. The return value is\n"
"unspecified.\n"
"\n"
"@var{level} is an integer specifying a protocol layer, either\n"
"@code{SOL_SOCKET} for socket level options, or a protocol\n"
"number from the @code{IPPROTO} constants or @code{getprotoent}\n"
"(@pxref{Network Databases}).\n"
"\n"
"@defvar SOL_SOCKET\n"
"@defvarx IPPROTO_IP\n"
"@defvarx IPPROTO_TCP\n"
"@defvarx IPPROTO_UDP\n"
"@end defvar\n"
"\n"
"@var{optname} is an integer specifying an option within the\n"
"protocol layer.\n"
"\n"
"For @code{SOL_SOCKET} level the following @var{optname}s are\n"
"defined (when provided by the system). For their meaning see\n"
"@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
"Manual}, or @command{man 7 socket}.\n"
"\n"
"@defvar SO_DEBUG\n"
"@defvarx SO_REUSEADDR\n"
"@defvarx SO_STYLE\n"
"@defvarx SO_TYPE\n"
"@defvarx SO_ERROR\n"
"@defvarx SO_DONTROUTE\n"
"@defvarx SO_BROADCAST\n"
"@defvarx SO_SNDBUF\n"
"@defvarx SO_RCVBUF\n"
"@defvarx SO_KEEPALIVE\n"
"@defvarx SO_OOBINLINE\n"
"@defvarx SO_NO_CHECK\n"
"@defvarx SO_PRIORITY\n"
"@var{value} is an integer.\n"
"@end defvar\n"
"\n"
"@defvar SO_LINGER\n"
"@var{value} is a pair of integers @code{(@var{ENABLE}\n"
". @var{TIMEOUT})}. On old systems without timeout support\n"
"(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
"effect but the value in Guile is always a pair.\n"
"@end defvar\n"
"\n"
"@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
"@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
"@c \n"
"For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
"are defined (when provided by the system). See @command{man\n"
"ip} for what they mean.\n"
"\n"
"@defvar IP_MULTICAST_IF\n"
"This sets the source interface used by multicast traffic.\n"
"@end defvar\n"
"\n"
"@defvar IP_MULTICAST_TTL\n"
"This sets the default TTL for multicast traffic. This defaults \n"
"to 1 and should be increased to allow traffic to pass beyond the\n"
"local network.\n"
"@end defvar\n"
"\n"
"@defvar IP_ADD_MEMBERSHIP\n"
"@defvarx IP_DROP_MEMBERSHIP\n"
"These can be used only with @code{setsockopt}, not\n"
"@code{getsockopt}. @var{value} is a pair\n"
"@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
"addresses (@pxref{Network Address Conversion}).\n"
"@var{MULTIADDR} is a multicast address to be added to or\n"
"dropped from the interface @var{INTERFACEADDR}.\n"
"@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
"select the interface. @var{INTERFACEADDR} can also be an\n"
"interface index number, on systems supporting that.\n"
"@end defvar")
#define FUNC_NAME s_scm_setsockopt
{
int fd;
int opt_int;
#ifdef HAVE_STRUCT_LINGER
struct linger opt_linger;
#endif
#ifdef HAVE_STRUCT_IP_MREQ
struct ip_mreq opt_mreq;
#endif
const void *optval = NULL;
socklen_t optlen = 0;
int ilevel, ioptname;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
ilevel = scm_to_int (level);
ioptname = scm_to_int (optname);
fd = SCM_FPORT_FDES (sock);
if (ilevel == SOL_SOCKET)
{
#ifdef SO_LINGER
if (ioptname == SO_LINGER)
{
#ifdef HAVE_STRUCT_LINGER
SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
opt_linger.l_onoff = scm_to_int (SCM_CAR (value));
opt_linger.l_linger = scm_to_int (SCM_CDR (value));
optlen = sizeof (struct linger);
optval = &opt_linger;
#else
SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
opt_int = scm_to_int (SCM_CAR (value));
/* timeout is ignored, but may as well validate it. */
scm_to_int (SCM_CDR (value));
optlen = sizeof (int);
optval = &opt_int;
#endif
}
else
#endif
if (0
#ifdef SO_SNDBUF
|| ioptname == SO_SNDBUF
#endif
#ifdef SO_RCVBUF
|| ioptname == SO_RCVBUF
#endif
)
{
opt_int = scm_to_int (value);
optlen = sizeof (size_t);
optval = &opt_int;
}
}
#ifdef HAVE_STRUCT_IP_MREQ
if (ilevel == IPPROTO_IP &&
(ioptname == IP_ADD_MEMBERSHIP || ioptname == IP_DROP_MEMBERSHIP))
{
/* Fourth argument must be a pair of addresses. */
SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
opt_mreq.imr_multiaddr.s_addr = htonl (scm_to_ulong (SCM_CAR (value)));
opt_mreq.imr_interface.s_addr = htonl (scm_to_ulong (SCM_CDR (value)));
optlen = sizeof (opt_mreq);
optval = &opt_mreq;
}
#endif
if (optval == NULL)
{
/* Most options take an int. */
opt_int = scm_to_int (value);
optlen = sizeof (int);
optval = &opt_int;
}
if (setsockopt (fd, ilevel, ioptname, optval, optlen) == -1)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0,
(SCM sock, SCM how),
"Sockets can be closed simply by using @code{close-port}. The\n"
"@code{shutdown} procedure allows reception or transmission on a\n"
"connection to be shut down individually, according to the parameter\n"
"@var{how}:\n\n"
"@table @asis\n"
"@item 0\n"
"Stop receiving data for this socket. If further data arrives, reject it.\n"
"@item 1\n"
"Stop trying to transmit data from this socket. Discard any\n"
"data waiting to be sent. Stop looking for acknowledgement of\n"
"data already sent; don't retransmit it if it is lost.\n"
"@item 2\n"
"Stop both reception and transmission.\n"
"@end table\n\n"
"The return value is unspecified.")
#define FUNC_NAME s_scm_shutdown
{
int fd;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
if (shutdown (fd, scm_to_signed_integer (how, 0, 2)) == -1)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
/* convert fam/address/args into a sockaddr of the appropriate type.
args is modified by removing the arguments actually used.
which_arg and proc are used when reporting errors:
which_arg is the position of address in the original argument list.
proc is the name of the original procedure.
size returns the size of the structure allocated. */
static struct sockaddr *
scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
const char *proc, size_t *size)
#define FUNC_NAME proc
{
switch (fam)
{
case AF_INET:
{
struct sockaddr_in *soka;
unsigned long addr;
int port;
SCM_VALIDATE_ULONG_COPY (which_arg, address, addr);
SCM_VALIDATE_CONS (which_arg + 1, *args);
port = scm_to_int (SCM_CAR (*args));
*args = SCM_CDR (*args);
soka = (struct sockaddr_in *) scm_malloc (sizeof (struct sockaddr_in));
memset (soka, '\0', sizeof (struct sockaddr_in));
#ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
soka->sin_len = sizeof (struct sockaddr_in);
#endif
soka->sin_family = AF_INET;
soka->sin_addr.s_addr = htonl (addr);
soka->sin_port = htons (port);
*size = sizeof (struct sockaddr_in);
return (struct sockaddr *) soka;
}
#ifdef HAVE_IPV6
case AF_INET6:
{
/* see RFC2553. */
int port;
struct sockaddr_in6 *soka;
unsigned long flowinfo = 0;
unsigned long scope_id = 0;
SCM_VALIDATE_CONS (which_arg + 1, *args);
port = scm_to_int (SCM_CAR (*args));
*args = SCM_CDR (*args);
if (scm_is_pair (*args))
{
SCM_VALIDATE_ULONG_COPY (which_arg + 2, SCM_CAR (*args), flowinfo);
*args = SCM_CDR (*args);
if (scm_is_pair (*args))
{
SCM_VALIDATE_ULONG_COPY (which_arg + 3, SCM_CAR (*args),
scope_id);
*args = SCM_CDR (*args);
}
}
soka = (struct sockaddr_in6 *) scm_malloc (sizeof (struct sockaddr_in6));
#ifdef HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
soka->sin6_len = sizeof (struct sockaddr_in6);
#endif
soka->sin6_family = AF_INET6;
scm_to_ipv6 (soka->sin6_addr.s6_addr, address);
soka->sin6_port = htons (port);
soka->sin6_flowinfo = flowinfo;
#ifdef HAVE_SIN6_SCOPE_ID
soka->sin6_scope_id = scope_id;
#endif
*size = sizeof (struct sockaddr_in6);
return (struct sockaddr *) soka;
}
#endif
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
case AF_UNIX:
{
struct sockaddr_un *soka;
int addr_size;
char *c_address;
scm_dynwind_begin (0);
c_address = scm_to_locale_string (address);
scm_dynwind_free (c_address);
/* the static buffer size in sockaddr_un seems to be arbitrary
and not necessarily a hard limit. e.g., the glibc manual
suggests it may be possible to declare it size 0. let's
ignore it. if the O/S doesn't like the size it will cause
connect/bind etc., to fail. sun_path is always the last
member of the structure. */
addr_size = sizeof (struct sockaddr_un)
+ max (0, strlen (c_address) + 1 - (sizeof soka->sun_path));
soka = (struct sockaddr_un *) scm_malloc (addr_size);
memset (soka, 0, addr_size); /* for sun_len: see sin_len above. */
soka->sun_family = AF_UNIX;
strcpy (soka->sun_path, c_address);
*size = SUN_LEN (soka);
scm_dynwind_end ();
return (struct sockaddr *) soka;
}
#endif
default:
scm_out_of_range (proc, scm_from_int (fam));
}
}
#undef FUNC_NAME
SCM_DEFINE (scm_connect, "connect", 2, 1, 1,
(SCM sock, SCM fam_or_sockaddr, SCM address, SCM args),
"Initiate a connection from a socket using a specified address\n"
"family to the address\n"
"specified by @var{address} and possibly @var{args}.\n"
"The format required for @var{address}\n"
"and @var{args} depends on the family of the socket.\n\n"
"For a socket of family @code{AF_UNIX},\n"
"only @var{address} is specified and must be a string with the\n"
"filename where the socket is to be created.\n\n"
"For a socket of family @code{AF_INET},\n"
"@var{address} must be an integer IPv4 host address and\n"
"@var{args} must be a single integer port number.\n\n"
"For a socket of family @code{AF_INET6},\n"
"@var{address} must be an integer IPv6 host address and\n"
"@var{args} may be up to three integers:\n"
"port [flowinfo] [scope_id],\n"
"where flowinfo and scope_id default to zero.\n\n"
"Alternatively, the second argument can be a socket address object "
"as returned by @code{make-socket-address}, in which case the "
"no additional arguments should be passed.\n\n"
"The return value is unspecified.")
#define FUNC_NAME s_scm_connect
{
int fd;
struct sockaddr *soka;
size_t size;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
if (scm_is_eq (address, SCM_UNDEFINED))
/* No third argument was passed to FAM_OR_SOCKADDR must actually be a
`socket address' object. */
soka = scm_to_sockaddr (fam_or_sockaddr, &size);
else
soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
&args, 3, FUNC_NAME, &size);
if (connect (fd, soka, size) == -1)
{
int save_errno = errno;
free (soka);
errno = save_errno;
SCM_SYSERROR;
}
free (soka);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_bind, "bind", 2, 1, 1,
(SCM sock, SCM fam_or_sockaddr, SCM address, SCM args),
"Assign an address to the socket port @var{sock}.\n"
"Generally this only needs to be done for server sockets,\n"
"so they know where to look for incoming connections. A socket\n"
"without an address will be assigned one automatically when it\n"
"starts communicating.\n\n"
"The format of @var{address} and @var{args} depends\n"
"on the family of the socket.\n\n"
"For a socket of family @code{AF_UNIX}, only @var{address}\n"
"is specified and must be a string with the filename where\n"
"the socket is to be created.\n\n"
"For a socket of family @code{AF_INET}, @var{address}\n"
"must be an integer IPv4 address and @var{args}\n"
"must be a single integer port number.\n\n"
"The values of the following variables can also be used for\n"
"@var{address}:\n\n"
"@defvar INADDR_ANY\n"
"Allow connections from any address.\n"
"@end defvar\n\n"
"@defvar INADDR_LOOPBACK\n"
"The address of the local host using the loopback device.\n"
"@end defvar\n\n"
"@defvar INADDR_BROADCAST\n"
"The broadcast address on the local network.\n"
"@end defvar\n\n"
"@defvar INADDR_NONE\n"
"No address.\n"
"@end defvar\n\n"
"For a socket of family @code{AF_INET6}, @var{address}\n"
"must be an integer IPv6 address and @var{args}\n"
"may be up to three integers:\n"
"port [flowinfo] [scope_id],\n"
"where flowinfo and scope_id default to zero.\n\n"
"Alternatively, the second argument can be a socket address object "
"as returned by @code{make-socket-address}, in which case the "
"no additional arguments should be passed.\n\n"
"The return value is unspecified.")
#define FUNC_NAME s_scm_bind
{
struct sockaddr *soka;
size_t size;
int fd;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
if (scm_is_eq (address, SCM_UNDEFINED))
/* No third argument was passed to FAM_OR_SOCKADDR must actually be a
`socket address' object. */
soka = scm_to_sockaddr (fam_or_sockaddr, &size);
else
soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
&args, 3, FUNC_NAME, &size);
if (bind (fd, soka, size) == -1)
{
int save_errno = errno;
free (soka);
errno = save_errno;
SCM_SYSERROR;
}
free (soka);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_listen, "listen", 2, 0, 0,
(SCM sock, SCM backlog),
"Enable @var{sock} to accept connection\n"
"requests. @var{backlog} is an integer specifying\n"
"the maximum length of the queue for pending connections.\n"
"If the queue fills, new clients will fail to connect until\n"
"the server calls @code{accept} to accept a connection from\n"
"the queue.\n\n"
"The return value is unspecified.")
#define FUNC_NAME s_scm_listen
{
int fd;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
if (listen (fd, scm_to_int (backlog)) == -1)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
/* Put the components of a sockaddr into a new SCM vector. */
static SCM_C_INLINE_KEYWORD SCM
_scm_from_sockaddr (const scm_t_max_sockaddr *address, unsigned addr_size,
const char *proc)
{
SCM result = SCM_EOL;
short int fam = ((struct sockaddr *) address)->sa_family;
switch (fam)
{
case AF_INET:
{
const struct sockaddr_in *nad = (struct sockaddr_in *) address;
result = scm_c_make_vector (3, SCM_UNSPECIFIED);
SCM_SIMPLE_VECTOR_SET(result, 0,
scm_from_short (fam));
SCM_SIMPLE_VECTOR_SET(result, 1,
scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
SCM_SIMPLE_VECTOR_SET(result, 2,
scm_from_ushort (ntohs (nad->sin_port)));
}
break;
#ifdef HAVE_IPV6
case AF_INET6:
{
const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
result = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr));
SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ushort (ntohs (nad->sin6_port)));
SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_uint32 (nad->sin6_flowinfo));
#ifdef HAVE_SIN6_SCOPE_ID
SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_ulong (nad->sin6_scope_id));
#else
SCM_SIMPLE_VECTOR_SET(result, 4, SCM_INUM0);
#endif
}
break;
#endif
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
case AF_UNIX:
{
const struct sockaddr_un *nad = (struct sockaddr_un *) address;
result = scm_c_make_vector (2, SCM_UNSPECIFIED);
SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
/* When addr_size is not enough to cover sun_path, do not try
to access it. */
if (addr_size <= offsetof (struct sockaddr_un, sun_path))
SCM_SIMPLE_VECTOR_SET(result, 1, SCM_BOOL_F);
else
SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
}
break;
#endif
default:
result = SCM_UNSPECIFIED;
scm_misc_error (proc, "unrecognised address family: ~A",
scm_list_1 (scm_from_int (fam)));
}
return result;
}
/* The publicly-visible function. Return a Scheme object representing
ADDRESS, an address of ADDR_SIZE bytes. */
SCM
scm_from_sockaddr (const struct sockaddr *address, unsigned addr_size)
{
return (_scm_from_sockaddr ((scm_t_max_sockaddr *) address,
addr_size, "scm_from_sockaddr"));
}
/* Convert ADDRESS, an address object returned by either
`scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
representation. On success, a non-NULL pointer is returned and
ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
address. The result must eventually be freed using `free ()'. */
struct sockaddr *
scm_to_sockaddr (SCM address, size_t *address_size)
#define FUNC_NAME "scm_to_sockaddr"
{
short int family;
struct sockaddr *c_address = NULL;
SCM_VALIDATE_VECTOR (1, address);
*address_size = 0;
family = scm_to_short (SCM_SIMPLE_VECTOR_REF (address, 0));
switch (family)
{
case AF_INET:
{
if (SCM_SIMPLE_VECTOR_LENGTH (address) != 3)
scm_misc_error (FUNC_NAME,
"invalid inet address representation: ~A",
scm_list_1 (address));
else
{
struct sockaddr_in c_inet;
memset (&c_inet, '\0', sizeof (struct sockaddr_in));
#ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
c_inet.sin_len = sizeof (struct sockaddr_in);
#endif
c_inet.sin_addr.s_addr =
htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address, 1)));
c_inet.sin_port =
htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
c_inet.sin_family = AF_INET;
*address_size = sizeof (c_inet);
c_address = scm_malloc (sizeof (c_inet));
memcpy (c_address, &c_inet, sizeof (c_inet));
}
break;
}
#ifdef HAVE_IPV6
case AF_INET6:
{
if (SCM_SIMPLE_VECTOR_LENGTH (address) != 5)
scm_misc_error (FUNC_NAME, "invalid inet6 address representation: ~A",
scm_list_1 (address));
else
{
struct sockaddr_in6 c_inet6;
scm_to_ipv6 (c_inet6.sin6_addr.s6_addr,
SCM_SIMPLE_VECTOR_REF (address, 1));
c_inet6.sin6_port =
htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
c_inet6.sin6_flowinfo =
scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address, 3));
#ifdef HAVE_SIN6_SCOPE_ID
c_inet6.sin6_scope_id =
scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address, 4));
#endif
c_inet6.sin6_family = AF_INET6;
*address_size = sizeof (c_inet6);
c_address = scm_malloc (sizeof (c_inet6));
memcpy (c_address, &c_inet6, sizeof (c_inet6));
}
break;
}
#endif
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
case AF_UNIX:
{
if (SCM_SIMPLE_VECTOR_LENGTH (address) != 2)
scm_misc_error (FUNC_NAME, "invalid unix address representation: ~A",
scm_list_1 (address));
else
{
SCM path;
size_t path_len = 0;
path = SCM_SIMPLE_VECTOR_REF (address, 1);
if (!scm_is_string (path) && !scm_is_false (path))
scm_misc_error (FUNC_NAME, "invalid unix address "
"path: ~A", scm_list_1 (path));
else
{
struct sockaddr_un c_unix;
if (scm_is_false (path))
path_len = 0;
else
path_len = scm_c_string_length (path);
#ifdef UNIX_PATH_MAX
if (path_len >= UNIX_PATH_MAX)
#else
/* We can hope that this limit will eventually vanish, at least on GNU.
However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
documents it has being limited to 108 bytes. */
if (path_len >= sizeof (c_unix.sun_path))
#endif
scm_misc_error (FUNC_NAME, "unix address path "
"too long: ~A", scm_list_1 (path));
else
{
if (path_len)
{
scm_to_locale_stringbuf (path, c_unix.sun_path,
#ifdef UNIX_PATH_MAX
UNIX_PATH_MAX);
#else
sizeof (c_unix.sun_path));
#endif
c_unix.sun_path[path_len] = '\0';
/* Sanity check. */
if (strlen (c_unix.sun_path) != path_len)
scm_misc_error (FUNC_NAME, "unix address path "
"contains nul characters: ~A",
scm_list_1 (path));
}
else
c_unix.sun_path[0] = '\0';
c_unix.sun_family = AF_UNIX;
*address_size = SUN_LEN (&c_unix);
c_address = scm_malloc (sizeof (c_unix));
memcpy (c_address, &c_unix, sizeof (c_unix));
}
}
}
break;
}
#endif
default:
scm_misc_error (FUNC_NAME, "unrecognised address family: ~A",
scm_list_1 (scm_from_ushort (family)));
}
return c_address;
}
#undef FUNC_NAME
/* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
an address of family FAMILY, with the family-specific parameters ARGS (see
the description of `connect' for details). The returned structure may be
freed using `free ()'. */
struct sockaddr *
scm_c_make_socket_address (SCM family, SCM address, SCM args,
size_t *address_size)
{
struct sockaddr *soka;
soka = scm_fill_sockaddr (scm_to_ushort (family), address, &args, 1,
"scm_c_make_socket_address", address_size);
return soka;
}
SCM_DEFINE (scm_make_socket_address, "make-socket-address", 2, 0, 1,
(SCM family, SCM address, SCM args),
"Return a Scheme address object that reflects @var{address}, "
"being an address of family @var{family}, with the "
"family-specific parameters @var{args} (see the description of "
"@code{connect} for details).")
#define FUNC_NAME s_scm_make_socket_address
{
SCM result = SCM_BOOL_F;
struct sockaddr *c_address;
size_t c_address_size;
c_address = scm_c_make_socket_address (family, address, args,
&c_address_size);
if (c_address != NULL)
{
result = scm_from_sockaddr (c_address, c_address_size);
free (c_address);
}
return result;
}
#undef FUNC_NAME
\f
SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
(SCM sock),
"Accept a connection on a bound, listening socket.\n"
"If there\n"
"are no pending connections in the queue, wait until\n"
"one is available unless the non-blocking option has been\n"
"set on the socket.\n\n"
"The return value is a\n"
"pair in which the @emph{car} is a new socket port for the\n"
"connection and\n"
"the @emph{cdr} is an object with address information about the\n"
"client which initiated the connection.\n\n"
"@var{sock} does not become part of the\n"
"connection and will continue to accept new requests.")
#define FUNC_NAME s_scm_accept
{
int fd;
int newfd;
SCM address;
SCM newsock;
socklen_t addr_size = MAX_ADDR_SIZE;
scm_t_max_sockaddr addr;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
newfd = accept (fd, (struct sockaddr *) &addr, &addr_size);
if (newfd == -1)
SCM_SYSERROR;
newsock = SCM_SOCK_FD_TO_PORT (newfd);
address = _scm_from_sockaddr (&addr, addr_size,
FUNC_NAME);
return scm_cons (newsock, address);
}
#undef FUNC_NAME
SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0,
(SCM sock),
"Return the address of @var{sock}, in the same form as the\n"
"object returned by @code{accept}. On many systems the address\n"
"of a socket in the @code{AF_FILE} namespace cannot be read.")
#define FUNC_NAME s_scm_getsockname
{
int fd;
socklen_t addr_size = MAX_ADDR_SIZE;
scm_t_max_sockaddr addr;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
if (getsockname (fd, (struct sockaddr *) &addr, &addr_size) == -1)
SCM_SYSERROR;
return _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
}
#undef FUNC_NAME
SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0,
(SCM sock),
"Return the address that @var{sock}\n"
"is connected to, in the same form as the object returned by\n"
"@code{accept}. On many systems the address of a socket in the\n"
"@code{AF_FILE} namespace cannot be read.")
#define FUNC_NAME s_scm_getpeername
{
int fd;
socklen_t addr_size = MAX_ADDR_SIZE;
scm_t_max_sockaddr addr;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
if (getpeername (fd, (struct sockaddr *) &addr, &addr_size) == -1)
SCM_SYSERROR;
return _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
}
#undef FUNC_NAME
SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
(SCM sock, SCM buf, SCM flags),
"Receive data from a socket port.\n"
"@var{sock} must already\n"
"be bound to the address from which data is to be received.\n"
"@var{buf} is a bytevector into which\n"
"the data will be written. The size of @var{buf} limits\n"
"the amount of\n"
"data which can be received: in the case of packet\n"
"protocols, if a packet larger than this limit is encountered\n"
"then some data\n"
"will be irrevocably lost.\n\n"
"The optional @var{flags} argument is a value or\n"
"bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
"The value returned is the number of bytes read from the\n"
"socket.\n\n"
"Note that the data is read directly from the socket file\n"
"descriptor:\n"
"any unread buffered port data is ignored.")
#define FUNC_NAME s_scm_recv
{
int rv, fd, flg;
SCM_VALIDATE_OPFPORT (1, sock);
if (SCM_UNBNDP (flags))
flg = 0;
else
flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock);
#if SCM_ENABLE_DEPRECATED == 1
if (SCM_UNLIKELY (scm_is_string (buf)))
{
SCM msg;
char *dest;
size_t len;
scm_c_issue_deprecation_warning
("Passing a string to `recv!' is deprecated, "
"use a bytevector instead.");
len = scm_i_string_length (buf);
msg = scm_i_make_string (len, &dest, 0);
SCM_SYSCALL (rv = recv (fd, dest, len, flg));
scm_string_copy_x (buf, scm_from_int (0),
msg, scm_from_int (0), scm_from_size_t (len));
}
else
#endif
{
SCM_VALIDATE_BYTEVECTOR (1, buf);
SCM_SYSCALL (rv = recv (fd,
SCM_BYTEVECTOR_CONTENTS (buf),
SCM_BYTEVECTOR_LENGTH (buf),
flg));
}
if (SCM_UNLIKELY (rv == -1))
SCM_SYSERROR;
scm_remember_upto_here (buf);
return scm_from_int (rv);
}
#undef FUNC_NAME
SCM_DEFINE (scm_send, "send", 2, 1, 0,
(SCM sock, SCM message, SCM flags),
"Transmit bytevector @var{message} on socket port @var{sock}.\n"
"@var{sock} must already be bound to a destination address. The\n"
"value returned is the number of bytes transmitted --\n"
"it's possible for\n"
"this to be less than the length of @var{message}\n"
"if the socket is\n"
"set to be non-blocking. The optional @var{flags} argument\n"
"is a value or\n"
"bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
"Note that the data is written directly to the socket\n"
"file descriptor:\n"
"any unflushed buffered port data is ignored.\n\n"
"This operation is defined only for strings containing codepoints\n"
"zero to 255.")
#define FUNC_NAME s_scm_send
{
int rv, fd, flg;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
if (SCM_UNBNDP (flags))
flg = 0;
else
flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock);
#if SCM_ENABLE_DEPRECATED == 1
if (SCM_UNLIKELY (scm_is_string (message)))
{
scm_c_issue_deprecation_warning
("Passing a string to `send' is deprecated, "
"use a bytevector instead.");
/* If the string is wide, see if it can be coerced into a narrow
string. */
if (!scm_i_is_narrow_string (message)
|| !scm_i_try_narrow_string (message))
SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
scm_list_1 (message));
SCM_SYSCALL (rv = send (fd,
scm_i_string_chars (message),
scm_i_string_length (message),
flg));
}
else
#endif
{
SCM_VALIDATE_BYTEVECTOR (1, message);
SCM_SYSCALL (rv = send (fd,
SCM_BYTEVECTOR_CONTENTS (message),
SCM_BYTEVECTOR_LENGTH (message),
flg));
}
if (rv == -1)
SCM_SYSERROR;
scm_remember_upto_here_1 (message);
return scm_from_int (rv);
}
#undef FUNC_NAME
SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
(SCM sock, SCM buf, SCM flags, SCM start, SCM end),
"Receive data from socket port @var{sock} (which must be already\n"
"bound), returning the originating address as well as the data.\n"
"This is usually for use on datagram sockets, but can be used on\n"
"stream-oriented sockets too.\n"
"\n"
"The data received is stored in bytevector @var{buf}, using\n"
"either the whole bytevector or just the region between the optional\n"
"@var{start} and @var{end} positions. The size of @var{buf}\n"
"limits the amount of data that can be received. For datagram\n"
"protocols, if a packet larger than this is received then excess\n"
"bytes are irrevocably lost.\n"
"\n"
"The return value is a pair. The @code{car} is the number of\n"
"bytes read. The @code{cdr} is a socket address object which is\n"
"where the data came from, or @code{#f} if the origin is\n"
"unknown.\n"
"\n"
"The optional @var{flags} argument is a or bitwise OR\n"
"(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
"@code{MSG_DONTROUTE} etc.\n"
"\n"
"Data is read directly from the socket file descriptor, any\n"
"buffered port data is ignored.\n"
"\n"
"On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
"all threads stop while a @code{recvfrom!} call is in progress.\n"
"An application may need to use @code{select}, @code{O_NONBLOCK}\n"
"or @code{MSG_DONTWAIT} to avoid this.")
#define FUNC_NAME s_scm_recvfrom
{
int rv, fd, flg;
SCM address;
size_t offset, cend;
socklen_t addr_size = MAX_ADDR_SIZE;
scm_t_max_sockaddr addr;
SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
if (SCM_UNBNDP (flags))
flg = 0;
else
SCM_VALIDATE_ULONG_COPY (3, flags, flg);
((struct sockaddr *) &addr)->sa_family = AF_UNSPEC;
#if SCM_ENABLE_DEPRECATED == 1
if (SCM_UNLIKELY (scm_is_string (buf)))
{
char *cbuf;
scm_c_issue_deprecation_warning
("Passing a string to `recvfrom!' is deprecated, "
"use a bytevector instead.");
scm_i_get_substring_spec (scm_i_string_length (buf),
start, &offset, end, &cend);
buf = scm_i_string_start_writing (buf);
cbuf = scm_i_string_writable_chars (buf);
SCM_SYSCALL (rv = recvfrom (fd, cbuf + offset,
cend - offset, flg,
(struct sockaddr *) &addr, &addr_size));
scm_i_string_stop_writing ();
}
else
#endif
{
SCM_VALIDATE_BYTEVECTOR (1, buf);
if (SCM_UNBNDP (start))
offset = 0;
else
offset = scm_to_size_t (start);
if (SCM_UNBNDP (end))
cend = SCM_BYTEVECTOR_LENGTH (buf);
else
{
cend = scm_to_size_t (end);
if (SCM_UNLIKELY (cend >= SCM_BYTEVECTOR_LENGTH (buf)
|| cend < offset))
scm_out_of_range (FUNC_NAME, end);
}
SCM_SYSCALL (rv = recvfrom (fd,
SCM_BYTEVECTOR_CONTENTS (buf) + offset,
cend - offset, flg,
(struct sockaddr *) &addr, &addr_size));
}
if (rv == -1)
SCM_SYSERROR;
/* `recvfrom' does not necessarily return an address. Usually nothing
is returned for stream sockets. */
if (((struct sockaddr *) &addr)->sa_family != AF_UNSPEC)
address = _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
else
address = SCM_BOOL_F;
scm_remember_upto_here_1 (buf);
return scm_cons (scm_from_int (rv), address);
}
#undef FUNC_NAME
SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
(SCM sock, SCM message, SCM fam_or_sockaddr, SCM address, SCM args_and_flags),
"Transmit bytevector @var{message} on socket port\n"
"@var{sock}. The\n"
"destination address is specified using the @var{fam},\n"
"@var{address} and\n"
"@var{args_and_flags} arguments, or just a socket address object "
"returned by @code{make-socket-address}, in a similar way to the\n"
"@code{connect} procedure. @var{args_and_flags} contains\n"
"the usual connection arguments optionally followed by\n"
"a flags argument, which is a value or\n"
"bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
"The value returned is the number of bytes transmitted --\n"
"it's possible for\n"
"this to be less than the length of @var{message} if the\n"
"socket is\n"
"set to be non-blocking.\n"
"Note that the data is written directly to the socket\n"
"file descriptor:\n"
"any unflushed buffered port data is ignored.\n"
"This operation is defined only for strings containing codepoints\n"
"zero to 255.")
#define FUNC_NAME s_scm_sendto
{
int rv, fd, flg;
struct sockaddr *soka;
size_t size;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_FPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
if (!scm_is_number (fam_or_sockaddr))
{
/* FAM_OR_SOCKADDR must actually be a `socket address' object. This
means that the following arguments, i.e. ADDRESS and those listed in
ARGS_AND_FLAGS, are the `MSG_' flags. */
soka = scm_to_sockaddr (fam_or_sockaddr, &size);
if (!scm_is_eq (address, SCM_UNDEFINED))
args_and_flags = scm_cons (address, args_and_flags);
}
else
soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
&args_and_flags, 3, FUNC_NAME, &size);
if (scm_is_null (args_and_flags))
flg = 0;
else
{
SCM_VALIDATE_CONS (5, args_and_flags);
flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
}
#if SCM_ENABLE_DEPRECATED == 1
if (SCM_UNLIKELY (scm_is_string (message)))
{
scm_c_issue_deprecation_warning
("Passing a string to `sendto' is deprecated, "
"use a bytevector instead.");
/* If the string is wide, see if it can be coerced into a narrow
string. */
if (!scm_i_is_narrow_string (message)
|| !scm_i_try_narrow_string (message))
SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
scm_list_1 (message));
SCM_SYSCALL (rv = sendto (fd,
scm_i_string_chars (message),
scm_i_string_length (message),
flg, soka, size));
}
else
#endif
{
SCM_VALIDATE_BYTEVECTOR (1, message);
SCM_SYSCALL (rv = sendto (fd,
SCM_BYTEVECTOR_CONTENTS (message),
SCM_BYTEVECTOR_LENGTH (message),
flg, soka, size));
}
if (rv == -1)
{
int save_errno = errno;
free (soka);
errno = save_errno;
SCM_SYSERROR;
}
free (soka);
scm_remember_upto_here_1 (message);
return scm_from_int (rv);
}
#undef FUNC_NAME
\f
void
scm_init_socket ()
{
/* protocol families. */
#ifdef AF_UNSPEC
scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC));
#endif
#ifdef AF_UNIX
scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX));
#endif
#ifdef AF_INET
scm_c_define ("AF_INET", scm_from_int (AF_INET));
#endif
#ifdef AF_INET6
scm_c_define ("AF_INET6", scm_from_int (AF_INET6));
#endif
#ifdef PF_UNSPEC
scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC));
#endif
#ifdef PF_UNIX
scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX));
#endif
#ifdef PF_INET
scm_c_define ("PF_INET", scm_from_int (PF_INET));
#endif
#ifdef PF_INET6
scm_c_define ("PF_INET6", scm_from_int (PF_INET6));
#endif
/* standard addresses. */
#ifdef INADDR_ANY
scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY));
#endif
#ifdef INADDR_BROADCAST
scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST));
#endif
#ifdef INADDR_NONE
scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE));
#endif
#ifdef INADDR_LOOPBACK
scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK));
#endif
/* socket types.
SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
packet(7) advise that it's obsolete and strongly deprecated. */
#ifdef SOCK_STREAM
scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM));
#endif
#ifdef SOCK_DGRAM
scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM));
#endif
#ifdef SOCK_SEQPACKET
scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET));
#endif
#ifdef SOCK_RAW
scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW));
#endif
#ifdef SOCK_RDM
scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM));
#endif
/* setsockopt level.
SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
instance NetBSD. We define IPPROTOs because that's what the posix spec
shows in its example at
http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
*/
#ifdef SOL_SOCKET
scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET));
#endif
#ifdef IPPROTO_IP
scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP));
#endif
#ifdef IPPROTO_TCP
scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP));
#endif
#ifdef IPPROTO_UDP
scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP));
#endif
/* setsockopt names. */
#ifdef SO_DEBUG
scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG));
#endif
#ifdef SO_REUSEADDR
scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR));
#endif
#ifdef SO_STYLE
scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE));
#endif
#ifdef SO_TYPE
scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE));
#endif
#ifdef SO_ERROR
scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR));
#endif
#ifdef SO_DONTROUTE
scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE));
#endif
#ifdef SO_BROADCAST
scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST));
#endif
#ifdef SO_SNDBUF
scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF));
#endif
#ifdef SO_RCVBUF
scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF));
#endif
#ifdef SO_KEEPALIVE
scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE));
#endif
#ifdef SO_OOBINLINE
scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE));
#endif
#ifdef SO_NO_CHECK
scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK));
#endif
#ifdef SO_PRIORITY
scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY));
#endif
#ifdef SO_LINGER
scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER));
#endif
/* recv/send options. */
#ifdef MSG_DONTWAIT
scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT));
#endif
#ifdef MSG_OOB
scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB));
#endif
#ifdef MSG_PEEK
scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK));
#endif
#ifdef MSG_DONTROUTE
scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE));
#endif
#ifdef __MINGW32__
scm_i_init_socket_Win32 ();
#endif
#ifdef IP_ADD_MEMBERSHIP
scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP));
scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP));
#endif
#ifdef IP_MULTICAST_TTL
scm_c_define ("IP_MULTICAST_TTL", scm_from_int ( IP_MULTICAST_TTL));
#endif
#ifdef IP_MULTICAST_IF
scm_c_define ("IP_MULTICAST_IF", scm_from_int ( IP_MULTICAST_IF));
#endif
scm_add_feature ("socket");
#include "libguile/socket.x"
}
/*
Local Variables:
c-file-style: "gnu"
End:
*/
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-01-30 18:23 bug#10664: 24.0.93; JIT font-lock infloops in a C file Eli Zaretskii
@ 2012-02-05 18:18 ` Eli Zaretskii
2012-02-06 11:09 ` Alan Mackenzie
0 siblings, 1 reply; 16+ messages in thread
From: Eli Zaretskii @ 2012-02-05 18:18 UTC (permalink / raw)
To: Alan Mackenzie; +Cc: 10664
> Date: Mon, 30 Jan 2012 20:23:49 +0200
> From: Eli Zaretskii <eliz@gnu.org>
Ping!
> This bug report will be sent to the Bug-GNU-Emacs mailing list
> and the GNU bug tracker at debbugs.gnu.org. Please check that
> the From: line contains a valid email address. After a delay of up
> to one day, you should receive an acknowledgement at that address.
>
> Please write in English if possible, as the Emacs maintainers
> usually do not have translators for other languages.
>
> Please describe exactly what actions triggered the bug, and
> the precise symptoms of the bug. If you can, give a recipe
> starting from `emacs -Q':
>
> I don't have a recipe starting from "emacs -Q", sorry.
>
> I left my freshly built Emacs 24.0.93 running, and when I returned to
> it a few hours later, I found it unresponsive, endlessly showing in
> the echo area "JIT lock socket.c", interspersed with GC messages
> (I have garbage-collection-messages set non-nil).
>
> Breaking into Emacs with a debugger produced the backtrace below (it's
> an optimized build, so the backtrace may be inaccurate, sorry). I
> attach the file socket.c (part of the Guile sources) as well.
>
> I still have that session in a debugger, so if someone wants me to
> look around and show some values, I can do that.
>
> #0 find_symbol_value (symbol=50731778) at data.c:1044
> 1044 return do_symval_forwarding (SYMBOL_FWD (sym));
> (gdb) bt
> #0 find_symbol_value (symbol=50731778) at data.c:1044
> #1 0x0100fb9b in specbind (symbol=50731778, value=50616370) at eval.c:3322
> #2 0x0109f6d5 in exec_byte_code (bytestr=50731778, vector=2,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:747
> #3 0x01011a8a in funcall_lambda (fun=69096517, nargs=1, arg_vector=0x82df24)
> at eval.c:3218
> #4 0x01011eed in Ffuncall (nargs=2, args=0x41e5445) at eval.c:3048
> #5 0x0109f68c in exec_byte_code (bytestr=50731778, vector=1,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:785
> #6 0x0109ff82 in Fbyte_code (bytestr=3, vector=3, maxdepth=3)
> at bytecode.c:423
> #7 0x01011227 in eval_sub (form=20240912) at eval.c:2341
> #8 0x0100eef0 in internal_catch (tag=3, func=0x1010ce6 <eval_sub>,
> arg=68864406) at eval.c:1257
> #9 0x0109ed60 in exec_byte_code (bytestr=50731778, vector=141,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:966
> #10 0x01011a8a in funcall_lambda (fun=68468261, nargs=1, arg_vector=0x82e2d4)
> at eval.c:3218
> #11 0x01011eed in Ffuncall (nargs=2, args=0x414be25) at eval.c:3048
> #12 0x0109f68c in exec_byte_code (bytestr=50731778, vector=1,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:785
> #13 0x01011a8a in funcall_lambda (fun=69603781, nargs=1, arg_vector=0x82e444)
> at eval.c:3218
> #14 0x01011eed in Ffuncall (nargs=2, args=0x42611c5) at eval.c:3048
> #15 0x0109f68c in exec_byte_code (bytestr=50731778, vector=1,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:785
> #16 0x01011a8a in funcall_lambda (fun=69603397, nargs=2, arg_vector=0x82e5b4)
> at eval.c:3218
> #17 0x01011eed in Ffuncall (nargs=3, args=0x4261045) at eval.c:3048
> #18 0x0109f68c in exec_byte_code (bytestr=50731778, vector=2,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:785
> #19 0x01011a8a in funcall_lambda (fun=69619589, nargs=1, arg_vector=0x82e72c)
> at eval.c:3218
> #20 0x01011eed in Ffuncall (nargs=2, args=0x4264f85) at eval.c:3048
> #21 0x0101257a in call1 (fn=3, arg1=3) at eval.c:2756
> #22 0x0103162e in mapcar1 (leni=1, vals=0x0, fn=69619589, seq=50731778)
> at fns.c:2346
> #23 0x010319d5 in Fmapc (function=3, sequence=71107830) at fns.c:2434
> #24 0x010120e8 in Ffuncall (nargs=3, args=0x134acf8) at eval.c:2990
> #25 0x0109f68c in exec_byte_code (bytestr=50731778, vector=2,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:785
> #26 0x01011a8a in funcall_lambda (fun=69619429, nargs=3, arg_vector=0x82e9e4)
> at eval.c:3218
> #27 0x01011eed in Ffuncall (nargs=4, args=0x4264ee5) at eval.c:3048
> #28 0x0109f68c in exec_byte_code (bytestr=50731778, vector=3,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:785
> #29 0x01011a8a in funcall_lambda (fun=19193997, nargs=2, arg_vector=0x82ec68)
> at eval.c:3218
> #30 0x01011eed in Ffuncall (nargs=3, args=0x124e08d) at eval.c:3048
> #31 0x01012618 in funcall_nil (nargs=3, args=0x3) at eval.c:2504
> #32 0x0100f5af in run_hook_with_args (nargs=3, args=0x82ec64,
> funcall=0x1012600 <funcall_nil>) at eval.c:2693
> #33 0x0100f6f3 in Frun_hook_with_args (nargs=3, args=0x3) at eval.c:2554
> #34 0x01012184 in Ffuncall (nargs=4, args=0x134a01d) at eval.c:2969
> #35 0x0109f68c in exec_byte_code (bytestr=50731778, vector=3,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:785
> #36 0x0109ff82 in Fbyte_code (bytestr=3, vector=3, maxdepth=3)
> at bytecode.c:423
> #37 0x01011227 in eval_sub (form=20240912) at eval.c:2341
> #38 0x01012fbf in internal_lisp_condition_case (var=50869346,
> bodyform=19206126, handlers=19206174) at eval.c:1454
> #39 0x0109ed1e in exec_byte_code (bytestr=50731778, vector=143,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:981
> #40 0x01011a8a in funcall_lambda (fun=19205877, nargs=2, arg_vector=0x82f034)
> at eval.c:3218
> #41 0x01011eed in Ffuncall (nargs=3, args=0x1250ef5) at eval.c:3048
> #42 0x0109f68c in exec_byte_code (bytestr=50731778, vector=2,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:785
> #43 0x01011a8a in funcall_lambda (fun=19206717, nargs=1, arg_vector=0x82f278)
> at eval.c:3218
> #44 0x01011eed in Ffuncall (nargs=2, args=0x125123d) at eval.c:3048
> #45 0x0101275e in Fapply (nargs=2, args=0x82f274) at eval.c:2439
> #46 0x01012184 in Ffuncall (nargs=3, args=0x134a065) at eval.c:2969
> #47 0x0109f68c in exec_byte_code (bytestr=50731778, vector=2,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:785
> #48 0x0109ff82 in Fbyte_code (bytestr=3, vector=3, maxdepth=3)
> at bytecode.c:423
> #49 0x01011227 in eval_sub (form=20240912) at eval.c:2341
> #50 0x01012fbf in internal_lisp_condition_case (var=50616346,
> bodyform=19235438, handlers=18612686) at eval.c:1454
> #51 0x0109ed1e in exec_byte_code (bytestr=50731778, vector=143,
> maxdepth=50731776, args_template=50616346, nargs=0, args=0x0)
> at bytecode.c:981
> #52 0x01011a8a in funcall_lambda (fun=19235277, nargs=1, arg_vector=0x82f64c)
> at eval.c:3218
> #53 0x01011eed in Ffuncall (nargs=2, args=0x12581cd) at eval.c:3048
> #54 0x0101257a in call1 (fn=3, arg1=3) at eval.c:2756
> #55 0x0101e391 in timer_check () at keyboard.c:4437
> #56 0x0101e5c2 in readable_events (flags=1) at keyboard.c:3388
> #57 0x010244ad in get_input_pending (addr=0x13c51b0, flags=1)
> at keyboard.c:6713
> #58 0x01024562 in detect_input_pending_run_timers (do_display=1)
> at keyboard.c:10480
> #59 0x0101984b in wait_reading_process_output (time_limit=0, microsecs=0,
> read_kbd=-1, do_display=1, wait_for_cell=50616346, wait_proc=0x0,
> just_wait_proc=0) at process.c:4733
> #60 0x01025c6a in read_char (commandflag=1, nmaps=2, maps=0x82fab0,
> prev_event=50616346, used_mouse_menu=0x82fbb8, end_time=0x0)
> at keyboard.c:3851
> #61 0x01027b26 in read_key_sequence (keybuf=0x82fcb0, bufsize=30,
> prompt=50616346, dont_downcase_last=0, can_return_switch_frame=1,
> fix_current_buffer=1) at keyboard.c:9300
> #62 0x01029a9f in command_loop_1 () at keyboard.c:1448
> #63 0x0100efbb in internal_condition_case (bfun=0x10298ff <command_loop_1>,
> handlers=50674074, hfun=0x102374d <cmd_error>) at eval.c:1500
> #64 0x0101cf0f in command_loop_2 (ignore=50616346) at keyboard.c:1159
> #65 0x0100eef0 in internal_catch (tag=3, func=0x101ceec <command_loop_2>,
> arg=50616346) at eval.c:1257
> #66 0x0101cdc2 in recursive_edit_1 () at keyboard.c:1138
> #67 0x0101ced6 in Frecursive_edit () at keyboard.c:822
> #68 0x01002f21 in main (argc=1, argv=0xa47ff0) at emacs.c:1715
>
> Lisp Backtrace:
> "c-in-knr-argdecl" (0x82df24)
> "byte-code" (0x82e030)
> "c-beginning-of-decl-1" (0x82e2d4)
> "c-set-fl-decl-start" (0x82e444)
> "c-context-set-fl-decl-start" (0x82e5b4)
> 0x4264f80 PVEC_COMPILED
> "mapc" (0x82e874)
> "c-font-lock-fontify-region" (0x82e9e4)
> "font-lock-fontify-region" (0x82ec68)
> "run-hook-with-args" (0x82ec64)
> "byte-code" (0x82ed60)
> "jit-lock-fontify-now" (0x82f034)
> "jit-lock-stealth-fontify" (0x82f278)
> "apply" (0x82f274)
> "byte-code" (0x82f370)
> "timer-event-handler" (0x82f64c)
> (gdb) p symbol
> $1 = 50731778
> (gdb) xtype
> Lisp_Symbol
> (gdb) xsymbol
> $2 = (struct Lisp_Symbol *) 0x3061b00
> "buffer-undo-list"
> (gdb)
>
>
>
> If Emacs crashed, and you have the Emacs process in the gdb debugger,
> please include the output from the following gdb commands:
> `bt full' and `xbacktrace'.
> For information about debugging Emacs, please read the file
> d:/usr/emacs/etc/DEBUG.
>
>
> In GNU Emacs 24.0.93.1 (i386-mingw-nt5.1.2600)
> of 2012-01-29 on HOME-C4E4A596F7
> Windowing system distributor `Microsoft Corp.', version 5.1.2600
> Configured using:
> `configure --with-gcc (3.4)'
>
> 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: ENU
> value of $XMODIFIERS: nil
> locale-coding-system: cp1255
> default enable-multibyte-characters: t
>
> Major mode: Mail
>
> Minor modes in effect:
> flyspell-mode: t
> diff-auto-refine-mode: t
> desktop-save-mode: t
> show-paren-mode: t
> display-time-mode: t
> tooltip-mode: t
> mouse-wheel-mode: t
> tool-bar-mode: t
> menu-bar-mode: t
> file-name-shadow-mode: t
> global-font-lock-mode: t
> font-lock-mode: t
> blink-cursor-mode: t
> auto-composition-mode: t
> auto-encryption-mode: t
> auto-compression-mode: t
> temp-buffer-resize-mode: t
> line-number-mode: t
> abbrev-mode: t
>
> Recent input:
> <delete> <delete> <delete> <delete> <delete> <delete>
> <delete> <delete> <delete> <delete> t h e SPC o t h
> e r SPC p o s s i b l e SPC r e a s i n SPC <backspace>
> <backspace> <backspace> o n SPC i s SPC t h a t M-q
> <C-right> <C-right> <C-right> M-d <C-right> <C-right>
> SPC ( n o t SPC i n s t a l l e d ) M-q <down> <down>
> <C-home> C-c C-s <switch-frame> d SPC M-z M-z M-z M-z
> M-z M-z M-z M-z M-z M-z M-z M-z M-z C-z C-z C-z C-z
> C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z
> C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z
> C-z C-z C-z C-z C-z C-z C-z C-z C-z C-z M-z n o G N
> U W <tab> <return> SPC M-z n d SPC SPC d SPC d p p
> p p p p p p n n n n n C-z C-z C-z C-z C-z C-z C-z C-z
> <switch-frame> <help-echo> <switch-frame> <help-echo>
> <switch-frame> <switch-frame> <C-home> f n e s s SPC
> <backspace> <down> <down> <down> <down> <down> C h
> e c k SPC t h i s SPC o u t . C-c C-s C-g C-x 1 <down>
> <down> <down> <down> <down> <down> <down> <down> <down>
> <down> <down> C-x <return> f <return> C-c C-s <switch-frame>
> n SPC o P O <tab> <return> SPC n p p p p p p p p p
> p p p n n n n n n n n n n n n n n n n n n n n n n n
> n n n n <help-echo> <switch-frame> <help-echo> <help-echo>
> <help-echo> <help-echo> <switch-frame> C-x C-s <switch-frame>
> M-x r e p o r t - e m <tab> <return>
>
> Recent messages:
> Quit
> Sending...
> Added to d:/usr/eli/rmail/SENT.MAIL
> Sending email
> Sending email done
> Sending...done
> Added to d:/usr/eli/rmail/PORTS.rmail
> No following nondeleted message [16 times]
> Saving file d:/usr/eli/rmail/INBOX...
> Wrote d:/usr/eli/rmail/INBOX [2 times]
>
> Load-path shadows:
> None found.
>
> Features:
> (shadow emacsbug find-func multi-isearch help-mode view dabbrev
> network-stream starttls tls smtpmail auth-source eieio assoc gnus-util
> password-cache mailalias sendmail rmailout ld-script sh-script
> executable dired-x dired tcl nxml-uchnm rng-xsd xsd-regexp rng-cmpct
> rng-nxml rng-valid rng-loc rng-uri rng-parse nxml-parse rng-match
> rng-dt rng-util rng-pttrn nxml-ns nxml-mode nxml-outln nxml-rap
> nxml-util nxml-glyph nxml-enc xmltok sgml-mode org-wl org-w3m org-vm
> org-rmail org-mhe org-mew org-irc org-jsinfo org-infojs org-html
> org-exp ob-exp org-exp-blocks org-agenda org-info org-gnus org-docview
> org-bibtex bibtex org-bbdb org byte-opt warnings bytecomp byte-compile
> cconv macroexp advice help-fns advice-preload ob-emacs-lisp ob-tangle
> ob-ref ob-lob ob-table org-footnote org-src ob-comint ob-keys ob
> ob-eval org-pcomplete pcomplete comint ring org-list org-faces
> org-compat org-entities org-macs cal-menu calendar cal-loaddefs
> noutline outline arc-mode archive-mode jka-compr flyspell ispell
> autorevert diff-mode easy-mmode make-mode conf-mode newcomment generic
> parse-time vc-cvs info vc-bzr cc-mode cc-fonts cc-guess cc-menus
> cc-cmds cc-styles cc-align cc-engine cc-vars cc-defs regexp-opt
> rmailsum qp rmailmm message format-spec rfc822 mml easymenu mml-sec
> mm-decode mm-bodies mm-encode mailabbrev gmm-utils mailheader
> mail-parse rfc2231 rmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr
> mail-utils desktop server filecache saveplace midnight generic-x paren
> battery time time-date tooltip ediff-hook vc-hooks lisp-float-type
> mwheel dos-w32 disp-table ls-lisp w32-win w32-vars tool-bar dnd
> fontset image fringe lisp-mode register page menu-bar rfn-eshadow
> timer select scroll-bar mouse jit-lock font-lock syntax facemenu
> font-core frame cham georgian utf-8-lang misc-lang vietnamese tibetan
> thai tai-viet lao korean japanese hebrew greek romanian slovak czech
> european ethiopic indian cyrillic chinese case-table epa-hook
> jka-cmpr-hook help simple abbrev minibuffer loaddefs button faces
> cus-face files text-properties overlay sha1 md5 base64 format env
> code-pages mule custom widget hashtable-print-readable backquote
> make-network-process multi-tty emacs)
>
>
> [2:application/octet-stream Show Save:socket.c (55kB)]
>
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-05 18:18 ` Eli Zaretskii
@ 2012-02-06 11:09 ` Alan Mackenzie
2012-02-06 14:39 ` Stefan Monnier
2012-02-06 17:04 ` Eli Zaretskii
0 siblings, 2 replies; 16+ messages in thread
From: Alan Mackenzie @ 2012-02-06 11:09 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 10664
Hi, Eli.
On Sun, Feb 05, 2012 at 08:18:58PM +0200, Eli Zaretskii wrote:
> > Date: Mon, 30 Jan 2012 20:23:49 +0200
> > From: Eli Zaretskii <eliz@gnu.org>
> > I don't have a recipe starting from "emacs -Q", sorry.
> > I left my freshly built Emacs 24.0.93 running, and when I returned to
> > it a few hours later, I found it unresponsive, endlessly showing in
> > the echo area "JIT lock socket.c", interspersed with GC messages
> > (I have garbage-collection-messages set non-nil).
> > Breaking into Emacs with a debugger produced the backtrace below (it's
> > an optimized build, so the backtrace may be inaccurate, sorry). I
> > attach the file socket.c (part of the Guile sources) as well.
I got something similar for this socket.c. I load it into emacs -Q, then
start scrolling downwards, a page at a time. The first five scrolls are
fine. Then it hangs on the sixth.
However, typing C-g (maybe twice) frees it up, and it does the scroll.
Careful perusal reveals that the fontification is incomplete. From now
on, most key sequences must be followed by C-g to perform their commands.
;-(.
Did you actually try C-g when your session hung?
I was able to run elp on this, and I've a fairly good idea where it's got
stuck, but not yet why.
> > I still have that session in a debugger, so if someone wants me to
> > look around and show some values, I can do that.
I'm not sure I'd be able to make much out of debugger results. I'm not
familiar enough with the internals of Emacs. :-(
Can you restart this Emacs session? If so, could you try out C-g
(assuming you haven't already done so).
> > Lisp Backtrace:
> > "c-in-knr-argdecl" (0x82df24)
> > "byte-code" (0x82e030)
> > "c-beginning-of-decl-1" (0x82e2d4)
> > "c-set-fl-decl-start" (0x82e444)
> > "c-context-set-fl-decl-start" (0x82e5b4)
> > 0x4264f80 PVEC_COMPILED
> > "mapc" (0x82e874)
> > "c-font-lock-fontify-region" (0x82e9e4)
> > "font-lock-fontify-region" (0x82ec68)
> > "run-hook-with-args" (0x82ec64)
> > "byte-code" (0x82ed60)
> > "jit-lock-fontify-now" (0x82f034)
> > "jit-lock-stealth-fontify" (0x82f278)
> > "apply" (0x82f274)
> > "byte-code" (0x82f370)
> > "timer-event-handler" (0x82f64c)
> > (gdb) p symbol
> > $1 = 50731778
> > (gdb) xtype
> > Lisp_Symbol
> > (gdb) xsymbol
> > $2 = (struct Lisp_Symbol *) 0x3061b00
> > "buffer-undo-list"
> > (gdb)
--
Alan Mackenzie (Nuremberg, Germany).
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-06 11:09 ` Alan Mackenzie
@ 2012-02-06 14:39 ` Stefan Monnier
2012-02-06 17:04 ` Eli Zaretskii
1 sibling, 0 replies; 16+ messages in thread
From: Stefan Monnier @ 2012-02-06 14:39 UTC (permalink / raw)
To: Alan Mackenzie; +Cc: 10664
>> > I don't have a recipe starting from "emacs -Q", sorry.
>> > I left my freshly built Emacs 24.0.93 running, and when I returned to
>> > it a few hours later, I found it unresponsive, endlessly showing in
>> > the echo area "JIT lock socket.c", interspersed with GC messages
>> > (I have garbage-collection-messages set non-nil).
>> > Breaking into Emacs with a debugger produced the backtrace below (it's
>> > an optimized build, so the backtrace may be inaccurate, sorry). I
>> > attach the file socket.c (part of the Guile sources) as well.
> I got something similar for this socket.c. I load it into emacs -Q, then
> start scrolling downwards, a page at a time. The first five scrolls are
> fine. Then it hangs on the sixth.
While not easy, it should be theoretically possible to reproduce the
problem with (setq font-lock-support-mode nil) which would make it much
easier to debug. If the problem doesn't appear right when enabling
font-lock, then it needs to be triggered by cutting and re-inserting
a chunk of text (and you need to find a chunk that triggers the problem).
Stefan
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-06 11:09 ` Alan Mackenzie
2012-02-06 14:39 ` Stefan Monnier
@ 2012-02-06 17:04 ` Eli Zaretskii
2012-02-07 17:30 ` Eli Zaretskii
2012-02-07 19:20 ` Alan Mackenzie
1 sibling, 2 replies; 16+ messages in thread
From: Eli Zaretskii @ 2012-02-06 17:04 UTC (permalink / raw)
To: Alan Mackenzie; +Cc: 10664
> Date: Mon, 6 Feb 2012 11:09:57 +0000
> Cc: 10664@debbugs.gnu.org
> From: Alan Mackenzie <acm@muc.de>
>
> I got something similar for this socket.c. I load it into emacs -Q, then
> start scrolling downwards, a page at a time. The first five scrolls are
> fine. Then it hangs on the sixth.
>
> However, typing C-g (maybe twice) frees it up, and it does the scroll.
> Careful perusal reveals that the fontification is incomplete. From now
> on, most key sequences must be followed by C-g to perform their commands.
> ;-(.
>
> Did you actually try C-g when your session hung?
I'm quite sure I did. But that was on Windows, where C-g is less
powerful than on Posix platforms (since keyboard input is not
interrupt driven). So it could be that what you can interrupt on
GNU/Linux, I cannot on Windows.
> I was able to run elp on this, and I've a fairly good idea where it's got
> stuck, but not yet why.
Let me know if you need any further help.
> > > I still have that session in a debugger, so if someone wants me to
> > > look around and show some values, I can do that.
>
> I'm not sure I'd be able to make much out of debugger results. I'm not
> familiar enough with the internals of Emacs. :-(
That's good, because I needed to kill that session in order to rebuild
Emacs.
> Can you restart this Emacs session?
No, but I can start another and do the same (i.e. wait for it to hang
in the same way). The problem is reproducible in my configuration.
But I think it would be better to wait for you to fix that problem you
are zeroing in, and then see if it also fixes my hangs.
Thanks.
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-06 17:04 ` Eli Zaretskii
@ 2012-02-07 17:30 ` Eli Zaretskii
2012-02-07 19:20 ` Alan Mackenzie
1 sibling, 0 replies; 16+ messages in thread
From: Eli Zaretskii @ 2012-02-07 17:30 UTC (permalink / raw)
To: acm, 10664
> Date: Mon, 06 Feb 2012 19:04:17 +0200
> From: Eli Zaretskii <eliz@gnu.org>
> Cc: 10664@debbugs.gnu.org
>
> > Date: Mon, 6 Feb 2012 11:09:57 +0000
> > Cc: 10664@debbugs.gnu.org
> > From: Alan Mackenzie <acm@muc.de>
> >
> > I got something similar for this socket.c. I load it into emacs -Q, then
> > start scrolling downwards, a page at a time. The first five scrolls are
> > fine. Then it hangs on the sixth.
> >
> > However, typing C-g (maybe twice) frees it up, and it does the scroll.
> > Careful perusal reveals that the fontification is incomplete. From now
> > on, most key sequences must be followed by C-g to perform their commands.
> > ;-(.
> >
> > Did you actually try C-g when your session hung?
>
> I'm quite sure I did. But that was on Windows, where C-g is less
> powerful than on Posix platforms (since keyboard input is not
> interrupt driven). So it could be that what you can interrupt on
> GNU/Linux, I cannot on Windows.
I'm now absolutely sure this is the case: the offending code runs with
inhibit-quit set, and that prevents Emacs on Windows from interrupting
that code. I know because attaching GDB and using the debugger to set
inhibit-quit to nil breaks the vicious circle and let me salvage my
session without killing Emacs.
Btw, this time the problem happened with main.c from the recent Gawk
4.0.0h pre-release.
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-06 17:04 ` Eli Zaretskii
2012-02-07 17:30 ` Eli Zaretskii
@ 2012-02-07 19:20 ` Alan Mackenzie
2012-02-07 20:58 ` Eli Zaretskii
1 sibling, 1 reply; 16+ messages in thread
From: Alan Mackenzie @ 2012-02-07 19:20 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 10664
Hi, Eli.
I've done a binary chop on this, and the following revision made this bug
apparent:
revno: 106729
committer: Alan Mackenzie <acm@muc.de>
branch nick: trunk
timestamp: Sat 2011-12-24 19:32:31 +0000
message:
Introduce a mechanism to widen the region used in context font locking.
Use this to protect declarations from losing their contexts.
I'll see what I can work out from this. At least it's one of mine. ;-)
--
Alan Mackenzie (Nuremberg, Germany).
On Mon, Feb 06, 2012 at 07:04:17PM +0200, Eli Zaretskii wrote:
> > Date: Mon, 6 Feb 2012 11:09:57 +0000
> > Cc: 10664@debbugs.gnu.org
> > From: Alan Mackenzie <acm@muc.de>
> > I got something similar for this socket.c. I load it into emacs -Q, then
> > start scrolling downwards, a page at a time. The first five scrolls are
> > fine. Then it hangs on the sixth.
> > However, typing C-g (maybe twice) frees it up, and it does the scroll.
> > Careful perusal reveals that the fontification is incomplete. From now
> > on, most key sequences must be followed by C-g to perform their commands.
> > ;-(.
> > Did you actually try C-g when your session hung?
> I'm quite sure I did. But that was on Windows, where C-g is less
> powerful than on Posix platforms (since keyboard input is not
> interrupt driven). So it could be that what you can interrupt on
> GNU/Linux, I cannot on Windows.
> > I was able to run elp on this, and I've a fairly good idea where it's got
> > stuck, but not yet why.
> Let me know if you need any further help.
> > > > I still have that session in a debugger, so if someone wants me to
> > > > look around and show some values, I can do that.
> > I'm not sure I'd be able to make much out of debugger results. I'm not
> > familiar enough with the internals of Emacs. :-(
> That's good, because I needed to kill that session in order to rebuild
> Emacs.
> > Can you restart this Emacs session?
> No, but I can start another and do the same (i.e. wait for it to hang
> in the same way). The problem is reproducible in my configuration.
> But I think it would be better to wait for you to fix that problem you
> are zeroing in, and then see if it also fixes my hangs.
> Thanks.
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-07 19:20 ` Alan Mackenzie
@ 2012-02-07 20:58 ` Eli Zaretskii
2012-02-07 21:34 ` Alan Mackenzie
0 siblings, 1 reply; 16+ messages in thread
From: Eli Zaretskii @ 2012-02-07 20:58 UTC (permalink / raw)
To: Alan Mackenzie; +Cc: 10664
> Date: Tue, 7 Feb 2012 19:20:33 +0000
> Cc: 10664@debbugs.gnu.org
> From: Alan Mackenzie <acm@muc.de>
>
> I've done a binary chop on this, and the following revision made this bug
> apparent:
>
> revno: 106729
> committer: Alan Mackenzie <acm@muc.de>
> branch nick: trunk
> timestamp: Sat 2011-12-24 19:32:31 +0000
> message:
> Introduce a mechanism to widen the region used in context font locking.
> Use this to protect declarations from losing their contexts.
>
> I'll see what I can work out from this. At least it's one of mine. ;-)
Great, thanks.
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-07 20:58 ` Eli Zaretskii
@ 2012-02-07 21:34 ` Alan Mackenzie
2012-02-07 23:39 ` Stefan Monnier
0 siblings, 1 reply; 16+ messages in thread
From: Alan Mackenzie @ 2012-02-07 21:34 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 10664
Hello, Eli.
On Tue, Feb 07, 2012 at 10:58:09PM +0200, Eli Zaretskii wrote:
> > Date: Tue, 7 Feb 2012 19:20:33 +0000
> > Cc: 10664@debbugs.gnu.org
> > From: Alan Mackenzie <acm@muc.de>
> > I've done a binary chop on this, and the following revision made this bug
> > apparent:
> > revno: 106729
> > committer: Alan Mackenzie <acm@muc.de>
> > branch nick: trunk
> > timestamp: Sat 2011-12-24 19:32:31 +0000
> > message:
> > Introduce a mechanism to widen the region used in context font locking.
> > Use this to protect declarations from losing their contexts.
> > I'll see what I can work out from this. At least it's one of mine. ;-)
> Great, thanks.
I understand what's happening, now. The new code (from 2011-12-24),
given a point, is calculating a "safe" position backwards from that point
to start fontifying from. This is a position which gives the correct
context for the original point.
For one particular fontification in socket.c, the "safe position" is 500
bytes back from the starting point, so jit-lock is pushed back these 500
bytes, fontifies the next 500 bytes (`jit-lock-chunk-size'), then has its
new start position set back 500 bytes, rinse, spin, repeat.
I don't understand yet why this isn't happening a lot more frequently.
I think it's got something to do with the safe position being _exactly_
500 bytes back.
I don't know what to do about this yet, but I'll think of something.
Good night!
--
Alan Mackenzie (Nuremberg, Germany).
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-07 21:34 ` Alan Mackenzie
@ 2012-02-07 23:39 ` Stefan Monnier
2012-02-08 11:47 ` Alan Mackenzie
0 siblings, 1 reply; 16+ messages in thread
From: Stefan Monnier @ 2012-02-07 23:39 UTC (permalink / raw)
To: Alan Mackenzie; +Cc: 10664
> For one particular fontification in socket.c, the "safe position" is 500
> bytes back from the starting point, so jit-lock is pushed back these 500
> bytes, fontifies the next 500 bytes (`jit-lock-chunk-size'), then has its
> new start position set back 500 bytes, rinse, spin, repeat.
Why is "jit-lock pushed back"?
Stefan
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-07 23:39 ` Stefan Monnier
@ 2012-02-08 11:47 ` Alan Mackenzie
2012-02-08 17:49 ` Eli Zaretskii
2012-02-08 19:28 ` Stefan Monnier
0 siblings, 2 replies; 16+ messages in thread
From: Alan Mackenzie @ 2012-02-08 11:47 UTC (permalink / raw)
To: Stefan Monnier; +Cc: 10664
Hi, Stefan.
On Tue, Feb 07, 2012 at 06:39:11PM -0500, Stefan Monnier wrote:
> > For one particular fontification in socket.c, the "safe position" is 500
> > bytes back from the starting point, so jit-lock is pushed back these 500
> > bytes, fontifies the next 500 bytes (`jit-lock-chunk-size'), then has its
> > new start position set back 500 bytes, rinse, spin, repeat.
> Why is "jit-lock pushed back"?
Build Emacs revision #106728. emacs -Q, then create the following C++
buffer:
#########################################################################
1 template <typename T>
2
3
4 void myfunc(T* p) {}
#########################################################################
This is fontified correctly. Type a space on L2. This is OK for half a
second, then context fontification messes up L4. The correct
fontification can only be restored by a change to L4.
Revision #106729 fixes this problem, after a space on L2, by making the
fontification start at L1 rather than L2.
The exact mechanism of why the problem happened is buried in my log, and
I could dredge it up if you're really interested.
The problem with this approach is demonstrated in Eli's socket.c:
SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
(SCM family, SCM address),
"Convert a string containing a printable network address to\n"
"an integer address. Note that unlike the C version of this\n"
"function,\n"
"the result is an integer with normal host byte ordering.\n"
"@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
"@lisp\n"
"(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
"(inet-pton AF_INET6 \"::1\") @result{} 1\n"
"@end lisp")
#define FUNC_NAME s_scm_inet_pton
{
A 500 byte chunk of fontification ends just before "@end lisp". For
this line, the start of the next chunk is "pushed back" to the
SCM_DEFINE line to get a proper context for "@end lisp". It then
repeatedly fontifies the same chunk.
Interestingly, EOL just before "@end lisp" is exactly 500 bytes after
the initial scm_inet_pton.
--
Alan Mackenzie (Nuremberg, Germany).
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-08 11:47 ` Alan Mackenzie
@ 2012-02-08 17:49 ` Eli Zaretskii
2012-02-08 19:28 ` Stefan Monnier
1 sibling, 0 replies; 16+ messages in thread
From: Eli Zaretskii @ 2012-02-08 17:49 UTC (permalink / raw)
To: Alan Mackenzie; +Cc: 10664
> Date: Wed, 8 Feb 2012 11:47:49 +0000
> Cc: Eli Zaretskii <eliz@gnu.org>, 10664@debbugs.gnu.org
> From: Alan Mackenzie <acm@muc.de>
>
> #########################################################################
> 1 template <typename T>
> 2
> 3
> 4 void myfunc(T* p) {}
> #########################################################################
>
> This is fontified correctly. Type a space on L2. This is OK for half a
> second, then context fontification messes up L4. The correct
> fontification can only be restored by a change to L4.
>
> Revision #106729 fixes this problem, after a space on L2, by making the
> fontification start at L1 rather than L2.
>
> The exact mechanism of why the problem happened is buried in my log, and
> I could dredge it up if you're really interested.
>
> The problem with this approach is demonstrated in Eli's socket.c:
>
> SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
> (SCM family, SCM address),
> "Convert a string containing a printable network address to\n"
> "an integer address. Note that unlike the C version of this\n"
> "function,\n"
> "the result is an integer with normal host byte ordering.\n"
> "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
> "@lisp\n"
> "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
> "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
> "@end lisp")
> #define FUNC_NAME s_scm_inet_pton
> {
>
> A 500 byte chunk of fontification ends just before "@end lisp". For
> this line, the start of the next chunk is "pushed back" to the
> SCM_DEFINE line to get a proper context for "@end lisp". It then
> repeatedly fontifies the same chunk.
>
> Interestingly, EOL just before "@end lisp" is exactly 500 bytes after
> the initial scm_inet_pton.
Thanks for explaining this.
Would it fix the problem if, when jit-lock is "pushed back" by N >= 500
characters, it will fontify N + n characters, where n > 0 ? (E.g., set
n = 100.)
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-08 11:47 ` Alan Mackenzie
2012-02-08 17:49 ` Eli Zaretskii
@ 2012-02-08 19:28 ` Stefan Monnier
2012-02-10 11:28 ` Alan Mackenzie
1 sibling, 1 reply; 16+ messages in thread
From: Stefan Monnier @ 2012-02-08 19:28 UTC (permalink / raw)
To: Alan Mackenzie; +Cc: 10664
>> > For one particular fontification in socket.c, the "safe position" is 500
>> > bytes back from the starting point, so jit-lock is pushed back these 500
>> > bytes, fontifies the next 500 bytes (`jit-lock-chunk-size'), then has its
>> > new start position set back 500 bytes, rinse, spin, repeat.
>> Why is "jit-lock pushed back"?
> Build Emacs revision #106728. emacs -Q, then create the following C++
> buffer:
> #########################################################################
> 1 template <typename T>
> 2
> 3
> 4 void myfunc(T* p) {}
> #########################################################################
> This is fontified correctly. Type a space on L2. This is OK for half a
> second, then context fontification messes up L4. The correct
> fontification can only be restored by a change to L4.
That explains why *font-lock* needs to be applied to "L1-L4", but now
why *jit-lock* needs to be affected.
Stefan
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-08 19:28 ` Stefan Monnier
@ 2012-02-10 11:28 ` Alan Mackenzie
2012-02-12 20:57 ` Eli Zaretskii
0 siblings, 1 reply; 16+ messages in thread
From: Alan Mackenzie @ 2012-02-10 11:28 UTC (permalink / raw)
To: Eli Zaretskii, Stefan Monnier; +Cc: 10664
Hi, Eli and Stefan.
On Wed, Feb 08, 2012 at 02:28:53PM -0500, Stefan Monnier wrote:
> >> > For one particular fontification in socket.c, the "safe position" is 500
> >> > bytes back from the starting point, so jit-lock is pushed back these 500
> >> > bytes, fontifies the next 500 bytes (`jit-lock-chunk-size'), then has its
> >> > new start position set back 500 bytes, rinse, spin, repeat.
> >> Why is "jit-lock pushed back"?
> > Build Emacs revision #106728. emacs -Q, then create the following C++
> > buffer:
> > #########################################################################
> > 1 template <typename T>
> > 2
> > 3
> > 4 void myfunc(T* p) {}
> > #########################################################################
> > This is fontified correctly. Type a space on L2. This is OK for half a
> > second, then context fontification messes up L4. The correct
> > fontification can only be restored by a change to L4.
> That explains why *font-lock* needs to be applied to "L1-L4", but now
> why *jit-lock* needs to be affected.
I was mistaken in my original diagnosis. What is really happening is
that CC Mode is trying to go out of nested parens/brackets to find the
beginning of a declaration.
c-beginning-of-decl-1 (which _never_ goes back outside of
parens/brackets/braces) was given a limit (- (point) 500) which took it
to just after a (. Then we went back out of the (. Then did
c-beginning-of-decl-1 again, which moved _forward_ to the limit. Repeat,
repeat, repeat ad infinitum.
The following patch should fix this. Eli, would you please try it out
and let me know if there are still problems with it.
*** orig/cc-mode.el 2012-02-10 10:55:54.000000000 +0000
--- cc-mode.el 2012-02-10 11:27:56.000000000 +0000
***************
*** 1140,1146 ****
(goto-char (c-point 'bol new-pos))
(when lit-limits ; Comment or string.
(goto-char (car lit-limits)))
! (setq bod-lim (max (- (point) 500) (point-min)))
(while
;; Go to a less nested declaration each time round this loop.
--- 1140,1146 ----
(goto-char (c-point 'bol new-pos))
(when lit-limits ; Comment or string.
(goto-char (car lit-limits)))
! (setq bod-lim (c-determine-limit 500))
(while
;; Go to a less nested declaration each time round this loop.
***************
*** 1158,1168 ****
;; Try and go out a level to search again.
(progn
(c-backward-syntactic-ws bod-lim)
! (or (memq (char-before) '(?\( ?\[))
! (and (eq (char-before) ?\<)
! (eq (c-get-char-property
! (1- (point)) 'syntax-table)
! c-<-as-paren-syntax))))
(not (bobp)))
(backward-char))
new-pos)) ; back over (, [, <.
--- 1158,1169 ----
;; Try and go out a level to search again.
(progn
(c-backward-syntactic-ws bod-lim)
! (and (> (point) bod-lim)
! (or (memq (char-before) '(?\( ?\[))
! (and (eq (char-before) ?\<)
! (eq (c-get-char-property
! (1- (point)) 'syntax-table)
! c-<-as-paren-syntax)))))
(not (bobp)))
(backward-char))
new-pos)) ; back over (, [, <.
> Stefan
--
Alan Mackenzie (Nuremberg, Germany).
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-10 11:28 ` Alan Mackenzie
@ 2012-02-12 20:57 ` Eli Zaretskii
2012-02-14 5:42 ` Chong Yidong
0 siblings, 1 reply; 16+ messages in thread
From: Eli Zaretskii @ 2012-02-12 20:57 UTC (permalink / raw)
To: Alan Mackenzie; +Cc: 10664
> Date: Fri, 10 Feb 2012 11:28:57 +0000
> Cc: 10664@debbugs.gnu.org
> From: Alan Mackenzie <acm@muc.de>
>
> The following patch should fix this. Eli, would you please try it out
> and let me know if there are still problems with it.
It seems to have cured the problem. At least I cannot reproduce it
anymore in two C files where it happened before.
Thanks!
^ permalink raw reply [flat|nested] 16+ messages in thread
* bug#10664: 24.0.93; JIT font-lock infloops in a C file
2012-02-12 20:57 ` Eli Zaretskii
@ 2012-02-14 5:42 ` Chong Yidong
0 siblings, 0 replies; 16+ messages in thread
From: Chong Yidong @ 2012-02-14 5:42 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: Alan Mackenzie, 10664
Eli Zaretskii <eliz@gnu.org> writes:
>> Date: Fri, 10 Feb 2012 11:28:57 +0000
>> Cc: 10664@debbugs.gnu.org
>> From: Alan Mackenzie <acm@muc.de>
>>
>> The following patch should fix this. Eli, would you please try it out
>> and let me know if there are still problems with it.
>
> It seems to have cured the problem. At least I cannot reproduce it
> anymore in two C files where it happened before.
>
> Thanks!
Alan's committed this (revno 107269); closing the bug.
^ permalink raw reply [flat|nested] 16+ messages in thread
end of thread, other threads:[~2012-02-14 5:42 UTC | newest]
Thread overview: 16+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-01-30 18:23 bug#10664: 24.0.93; JIT font-lock infloops in a C file Eli Zaretskii
2012-02-05 18:18 ` Eli Zaretskii
2012-02-06 11:09 ` Alan Mackenzie
2012-02-06 14:39 ` Stefan Monnier
2012-02-06 17:04 ` Eli Zaretskii
2012-02-07 17:30 ` Eli Zaretskii
2012-02-07 19:20 ` Alan Mackenzie
2012-02-07 20:58 ` Eli Zaretskii
2012-02-07 21:34 ` Alan Mackenzie
2012-02-07 23:39 ` Stefan Monnier
2012-02-08 11:47 ` Alan Mackenzie
2012-02-08 17:49 ` Eli Zaretskii
2012-02-08 19:28 ` Stefan Monnier
2012-02-10 11:28 ` Alan Mackenzie
2012-02-12 20:57 ` Eli Zaretskii
2012-02-14 5:42 ` Chong Yidong
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.