commit/XEmacs: kehoea: Add a byte-compile method for #'ignore,
chiefly for generated code
6 years, 7 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/8a7f058930de/
Changeset: 8a7f058930de
User: kehoea
Date: 2018-04-27 21:05:22+00:00
Summary: Add a byte-compile method for #'ignore, chiefly for generated code
lisp/ChangeLog addition:
2018-04-27 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el:
* bytecomp.el (ignore):
* bytecomp.el (byte-compile-ignore): New.
Add a byte-compile method for #'ignore, marking all its arguments
as for-effect, and returning nil.
tests/ChangeLog addition:
2018-04-27 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
* automated/lisp-tests.el (null):
Test #'ignore and its newly-added byte-compile method.
Affected #: 4 files
diff -r fd1fdfb2c336 -r 8a7f058930de lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2018-04-27 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecomp.el:
+ * bytecomp.el (ignore):
+ * bytecomp.el (byte-compile-ignore): New.
+ Add a byte-compile method for #'ignore, marking all its arguments
+ as for-effect, and returning nil.
+
2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el (not): New.
diff -r fd1fdfb2c336 -r 8a7f058930de lisp/bytecomp.el
--- a/lisp/bytecomp.el
+++ b/lisp/bytecomp.el
@@ -4661,6 +4661,8 @@
(byte-defop-compiler-1 defalias)
(byte-defop-compiler-1 define-function)
+(byte-defop-compiler-1 ignore)
+
(defun byte-compile-defun (form)
;; This is not used for file-level defuns with doc strings.
(byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
@@ -4772,6 +4774,10 @@
(if calls
(setq byte-compile-unresolved-functions
(delete* calls byte-compile-unresolved-functions)))))
+
+(defun byte-compile-ignore (form)
+ (mapc #'byte-compile-form (cdr form) '#1=(t . #1#))
+ (unless for-effect (byte-compile-push-constant nil)))
;;; tags
diff -r fd1fdfb2c336 -r 8a7f058930de tests/ChangeLog
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
@@ -1,3 +1,9 @@
+2018-04-27 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ * automated/lisp-tests.el (null):
+ Test #'ignore and its newly-added byte-compile method.
+
2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r fd1fdfb2c336 -r 8a7f058930de tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el
+++ b/tests/automated/lisp-tests.el
@@ -3265,6 +3265,13 @@
(Assert (not (funcall (intern "eq") #'bookend #'refer-to-bookend))
"checking two mutually recursive functions compiled OK"))))
+(Assert (null (ignore)) "checking ignore gives nil, no arguments")
+(Assert (null (ignore 40 90.5 pi))
+ "checking ignore gives nil, three arguments")
+(let (value)
+ (Assert (eq 'hi (prog2 (ignore (setq value 'hi)) value))
+ "checking side-effecting statements not deleted, ignore"))
+
;; Test macroexpand's handling of the ENVIRONMENT argument. We augmented it
;; quietly for about four months, and this was incorrect.
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Remove lib-src/make-case-conv.py definitively.
6 years, 8 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/fd1fdfb2c336/
Changeset: fd1fdfb2c336
User: kehoea
Date: 2018-04-27 11:50:19+00:00
Summary: Remove lib-src/make-case-conv.py definitively.
lib-src/ChangeLog addition:
2018-04-27 Aidan Kehoe <kehoea(a)parhasard.net>
* make-case-conv.py:
Remove this file, replaced by lisp/mule/make-case-conv.el
Affected #: 2 files
diff -r 06e4b596dc40 -r fd1fdfb2c336 lib-src/ChangeLog
--- a/lib-src/ChangeLog
+++ b/lib-src/ChangeLog
@@ -1,3 +1,8 @@
+2018-04-27 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * make-case-conv.py:
+ Remove this file, replaced by lisp/mule/make-case-conv.el
+
2017-11-09 Aidan Kehoe <kehoea(a)parhasard.net>
* make-case-conv.py:
diff -r 06e4b596dc40 -r fd1fdfb2c336 lib-src/make-case-conv.py
--- a/lib-src/make-case-conv.py
+++ /dev/null
@@ -1,208 +0,0 @@
-#!/usr/bin/python
-
-### make-case-conv.py --- generate case-conversion info from the Unicode database
-
-## Copyright (C) 2010 Ben Wing.
-
-## Author: Ben Wing <ben(a)xemacs.org>
-## Maintainer: Ben Wing <ben(a)xemacs.org>
-## Current Version: 1.0, January 25, 2010
-
-## This file is part of XEmacs.
-
-## XEmacs is free software; you can redistribute it and/or modify it
-## under the terms of the GNU General Public License as published by
-## the Free Software Foundation; either version 2, or (at your option)
-## any later version.
-
-## XEmacs is distributed in the hope that it will be useful, but
-## WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-## General Public License for more details.
-
-## You should have received a copy of the GNU General Public License
-## along with XEmacs; see the file COPYING. If not, write to the Free
-## Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-## 02111-1307, USA.
-
-### Commentary:
-
-# This file parses the file CaseFolding.txt in Unicode's UNIDATA package,
-# and generates a Lisp file containing instructions to set all the case
-# mappings in the standard case table.
-
-# To run this file, redirect its stdout to the file mule/uni-case-conv.el
-# (or whatever else you have named it according to the variable
-# `output_filename').
-
-# #### Aidan Kehoe, Do 9 Nov 2017 21:32:14 GMT; this approach doesn't work,
-# since CaseFolding folds both upper and lower case characters to lower case,
-# without marking which is which. We need to parse UnicodeData.txt instead; I
-# do this in lisp/mule/make-case-conv.el. I will remove make-case-conv.py down
-# the line.
-
-### Code:
-
-import urllib2, re, sys
-#import fileinput
-
-# The URL holding the case-folding table at www.unicode.org.
-uni_casefold_url = 'http://www.unicode.org/Public/UNIDATA/CaseFolding.txt'
-
-# Path to this file, as will appear in the comments of the generated file
-our_filepath = 'lib-src/make-case-conv.py'
-
-# Name of the generated file (no directories in it)
-output_filename = 'uni-case-conv.el'
-
-def argformat(format, arg):
- if type(format) is str:
- return format % arg
- else:
- return str(format)
-
-# Write formatted arguments to stdout.
-def outout(format, *arg):
- sys.stdout.write(argformat(format, arg))
-
-# Write formatted arguments to stderr.
-def errout(format, *arg):
- sys.stderr.write(argformat(format, arg))
-
-
-
-print """\
-;;; %s --- Case-conversion support for Unicode
-
-;; Copyright (C) 2010 Ben Wing.
-
-;; Keywords: multilingual, case, uppercase, lowercase, Unicode
-
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Commentary:
-
-;; DO NOT MODIFY THIS FILE!!!!!!!!!!!!!!!!
-;; This file is autogenerated by %s. Modify that
-;; file instead.
-
-;;; Code:
-
-;; Hack: We nreverse the table below before applying it so that the more
-;; desirable mappings, which come early, override less desirable later ones.
-;; In particular, we definitely do not want the following bindings to work
-;; both ways:
-
-;; (?\u017F ?\u0073) ;; LATIN SMALL LETTER LONG S
-;; (?\u212A ?\u006B) ;; KELVIN SIGN
-;; (?\u212B ?\u00E5) ;; ANGSTROM SIGN
-
-;; The first two are especially bad as they will cause upcasing operations
-;; on lowercase s and k to give strange results. It's actually worse than
-;; that -- for unknown reasons, with the bad mappings in place, the byte-
-;; compiler produces broken code for some files, which results in a stack-
-;; underflow crash upon loadup in preparation for dumping.
-
-(loop
- for (upper lower)
- in (nreverse
- '(
-""" % (output_filename, our_filepath),
-
-#for line in fileinput.input():
-for line in urllib2.urlopen(uni_casefold_url):
-
- # Save original line
- saveline = line
-
- # Save comment then remove it
- m = re.match(r'.*#\s*(.*)', line)
- if m:
- comment = m.group(1)
- else:
- comment = ''
- line = re.sub('#.*', '', line)
-
- # Strip whitespace; if line blank, do next one
- line = line.strip()
- if not line:
- continue
-
- if re.match(r'([0-9A-F]+); F; (([0-9A-F]+)( [0-9A-F]+)*);$', line):
- errout("Warning: Can't handle full mapping: %s", saveline)
- outout(";;; WARNING: Unhandled full mapping:\n;;; %s", saveline)
- continue
- if re.match(r'([0-9A-F]+); T; ([0-9A-F]+);$', line):
- errout("Warning: Can't handle Turkish mapping: %s", saveline)
- outout(";;; WARNING: Unhandled Turkish mapping:\n;;; %s",
- saveline)
- continue
- m = re.match(r'([0-9A-F]+); [CS]; ([0-9A-F]+);$', line)
- if not m:
- errout("Warning: Unrecognized line: %s", saveline)
- outout(";;; WARNING: Unrecognized line:\n;;; %s", saveline)
- continue
-
- def tounichar(val):
- if val <= 0xFFFF:
- return r'?\u%04X' % val
- else:
- return r'?\U%08X' % val
- upper = tounichar(int(m.group(1), 16))
- lower = tounichar(int(m.group(2), 16))
- print r' (%s %s) ;; %s' % (upper, lower, comment)
-
-print """\
- ))
- with case-table = (standard-case-table)
- do
- (put-case-table-pair upper lower case-table))
-
-(provide '%s)
-
-;;; %s ends here""" % (output_filename.replace(".el",""), output_filename)
-
-## Another version, trying to diagnose byte-compiler underflow error caused
-## by these additions
-#print """\
-# )
-# with case-table = (standard-case-table)
-# do
-# (let* ((existing-lower (get-case-table 'downcase upper case-table))
-# (existing-lower (and (not (eq existing-lower upper)) existing-lower)))
-# ;;(when (not (eq (char-charset lower) (char-charset upper)))
-# ;; (princ (format "Upper %s (%s) not same charset as lower %s (%s)" upper (char-charset upper) lower (char-charset lower))))
-# (cond ((eq existing-lower lower)
-# ;;(princ (format "Already seen mapping %s for char %s" lower upper))
-# )
-# (existing-lower
-# ;;(princ (format "Existing mapping for char %s is %s, different from new %s?" upper existing-lower lower))
-# )
-# ((and (not (featurep 'unicode-internal))
-# (not (eq (char-charset lower) (char-charset upper))))
-# ;;(princ (format "Not adding cross-charset mapping %s -> %s" upper lower))
-# )
-# (t
-# ;;(princ (format "Adding mapping for upper %s -> lower %s" upper lower))
-# (put-case-table-pair upper lower case-table)
-# ))))
-#"""
-#print """\
-#(provide '%s)
-#
-#;;; %s ends here""" % (output_filename.replace(".el",""), output_filename)
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Handle non-numeric STATUS more gracefully,
make-docfile.el
6 years, 8 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/262dc5a418f5/
Changeset: 262dc5a418f5
User: kehoea
Date: 2018-04-25 07:14:02+00:00
Summary: Handle non-numeric STATUS more gracefully, make-docfile.el
lisp/ChangeLog addition:
2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net>
* make-docfile.el (docfile-out-of-date):
#'call-process can return a non-integer if the underlying process
signaled, and exited for that reason. Handle this more gracefully.
Affected #: 2 files
diff -r c5889f9bb7f4 -r 262dc5a418f5 lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2018-04-25 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * make-docfile.el (docfile-out-of-date):
+ #'call-process can return a non-integer if the underlying process
+ signaled, and exited for that reason. Handle this more gracefully.
+
2018-04-10 Aidan Kehoe <kehoea(a)parhasard.net>
* code-files.el (write-region):
diff -r c5889f9bb7f4 -r 262dc5a418f5 lisp/make-docfile.el
--- a/lisp/make-docfile.el
+++ b/lisp/make-docfile.el
@@ -245,16 +245,17 @@
;; (expand-file-name "make-docfile" build-lib-src)
"make-docfile"
nil
+ ;; Wouldn't it be nice to have streams as process input and
+ ;; output.
(list t standard-error)
nil
- (append options processed))))
- (if (equal status 0)
- (message "%sSpawning make-docfile ...done"
- (buffer-substring nil nil standard-error))
- (message "%sSpawning make-docfile ... error, failed with status %d."
- (buffer-substring nil nil standard-error)
- status))
- (kill-emacs status)))
+ (append options processed)))
+ (numeric-status (if (integerp status) status 1)))
+ (write-sequence (buffer-substring nil nil standard-error)
+ 'external-debugging-output)
+ (message "Spawning make-docfile ... %s"
+ (if (zerop numeric-status) "done" status))
+ (kill-emacs numeric-status)))
(kill-emacs)
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Quiet warnings with -Wnarrowing, GCC,
improving quality on 64 bit builds
6 years, 8 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/c5889f9bb7f4/
Changeset: c5889f9bb7f4
User: kehoea
Date: 2018-04-23 12:43:40+00:00
Summary: Quiet warnings with -Wnarrowing, GCC, improving quality on 64 bit builds
src/ChangeLog addition:
2018-04-23 Aidan Kehoe <kehoea(a)parhasard.net>
* abbrev.c (Fexpand_abbrev):
* alloc.c (struct):
* alloc.c (malloc_after):
* alloc.c (xmalloc):
* alloc.c (xcalloc):
* alloc.c (xrealloc):
* alloc.c (xstrdup):
* alloc.c (alloc_sized_lrecord_1):
* alloc.c (alloc_sized_lrecord_array):
* alloc.c (alloc_lrecord_array):
* alloc.c (copy_lisp_object):
* alloc.c (dbg_inhibit_dbg_symbol_deletion):
* alloc.c (make_uninit_vector):
* alloc.c (Fvector):
* alloc.c (bit_vector_equal):
* alloc.c (make_bit_vector):
* alloc.c (string_equal):
* alloc.c (resize_string):
* alloc.c (set_string_char):
* alloc.c (Fmake_string):
* alloc.c (Fstring):
* alloc.c (init_string_ascii_begin):
* alloc.c (make_string):
* alloc.c (dec_lrecord_stats):
* alloc.c (lrecord_stats_heap_size):
* alloc.c (pluralize_word):
* array.c (Dynarr_realloc):
* array.c (Dynarr_insert_many):
* array.c (Dynarr_delete_many):
* array.c (gap_array_move_gap):
* array.h:
* array.h (Dynarr_declare):
* array.h (Dynarr_delete_object):
* array.h (gap_array_marker):
* buffer.c (MARKED_SLOT):
* buffer.c (Fgenerate_new_buffer_name):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.h (struct buffer):
* bytecode.c (make_compiled_function_args):
* bytecode.c (UNUSED):
* callint.c (Fcall_interactively):
* casefiddle.c (casify_object):
* casefiddle.c (casify_region_internal):
* charset.h:
* chartab.c (clone_chartab_table):
* chartab.c (put_char_table):
* chartab.c (decode_char_table_range):
* cmds.c (Fpoint_at_bol):
* cmds.c (Fpoint_at_eol):
* cmds.c (internal_self_insert):
* console.c (delete_console_internal):
* console.c (Fset_input_mode):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.h:
* data.c (lisp_to_uint32_t):
* data.c (lisp_to_int32_t):
* data.c (rem_two_fixnum):
* data.c (Flsh):
* debug.c (FROB):
* device.c (Fmake_device):
* device.c (delete_device_internal):
* device.c (Fset_device_baud_rate):
* device.h:
* doc.c (extract_object_file_name):
* doc.c (Fsnarf_documentation):
* doc.c (verify_doc_mapper):
* doc.c (Fsubstitute_command_keys):
* doprnt.c (Fnumber_to_string):
* doprnt.c (emacs_doprnt):
* editfns.c (Finsert_char):
* editfns.c (save_restriction_restore):
* elhash.c (internal_array_hash):
* filelock.c (LOCK_PID_MAX):
* filelock.c (fill_in_lock_file_name):
* filelock.c (current_lock_owner):
* indent.c:
* indent.c (column_at_point):
* indent.c (string_column_at_point):
* indent.c (current_column):
* indent.c (Findent_to):
* indent.c (byte_spaces_at_point):
* indent.c (Fmove_to_column):
* indent.c (Fcompute_motion):
* indent.c (vertical_motion_1):
* indent.c (Fvertical_motion_pixels):
* lisp-disunion.h (XCHARVAL):
* lisp-disunion.h (wrap_pointer_1):
* lisp.h:
* lisp.h (ALLOCA):
* lisp.h (XSET_STRING_ASCII_BEGIN):
* lisp.h (CHECK_CHAR_COERCE_INT):
* lisp.h (LISP_HASH):
* lisp.h (struct gcpro):
* lisp.h (DECLARE_INLINE_HEADER):
* lrecord.h:
* lrecord.h (set_lheader_implementation):
* number.h:
* number.h (integer_signum):
* number.h (NATNUMP):
* print.c (debug_short_backtrace):
* search.c (find_before_next_newline):
* syntax.c (scan_words):
* syntax.h:
* sysdep.c:
* sysdep.c (wait_for_termination):
* sysdep.c (sys_subshell):
* sysdep.c (sys_suspend):
* sysdep.c (init_sigio_on_device):
* sysdep.c (qxe_readlink):
* sysfile.h:
* text.c (eifind_large_enough_buffer):
* text.h:
* text.h (ASSERT_ASCTEXT_ASCII_LEN):
* text.h (struct):
* text.h (EI_ALLOC):
* text.h (eicpy_lstr_off):
* text.h (eicpy_raw_fmt):
* text.h (eicpy_ascii_len):
* text.h (eicpy_ext_len):
* text.h (eimake_string_off):
* text.h (DECLARE_INLINE_HEADER):
* text.h (eicat_1):
* text.h (eicat_ascii):
* text.h (eicat_raw):
* text.h (eisub_1):
* text.h (eisub_ascii):
* text.h (EI_CASECHANGE):
* undo.c (truncate_undo_list):
* unicode.c (print_precedence_array):
Be more careful about integer types within the C code, e.g. not
using an int where a value represents a (possibly large) number of
bytes, or characters, especially relevant for values like fill
columns, which can usefully be set to most-positive-fixnum,
something the code up to now dealt with badly on a 64-bit build.
Issues flushed out using the -Wnarrowing GCC option.
* lisp.h (XCHAR_OR_CHAR_INT):
Provide an error-checking version of this to check uses with
fixnums where valid_ichar_p() is not true.
* lisp.h (GOOD_HASH):
Set this to a prime number just over 2^32 on sixty-four bit
architectures, of type Hashcode, an unsigned type, so modular
arithmetic is defined.
Affected #: 39 files
diff -r 046a3f85a39d -r c5889f9bb7f4 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,150 @@
+2018-04-23 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * abbrev.c (Fexpand_abbrev):
+ * alloc.c (struct):
+ * alloc.c (malloc_after):
+ * alloc.c (xmalloc):
+ * alloc.c (xcalloc):
+ * alloc.c (xrealloc):
+ * alloc.c (xstrdup):
+ * alloc.c (alloc_sized_lrecord_1):
+ * alloc.c (alloc_sized_lrecord_array):
+ * alloc.c (alloc_lrecord_array):
+ * alloc.c (copy_lisp_object):
+ * alloc.c (dbg_inhibit_dbg_symbol_deletion):
+ * alloc.c (make_uninit_vector):
+ * alloc.c (Fvector):
+ * alloc.c (bit_vector_equal):
+ * alloc.c (make_bit_vector):
+ * alloc.c (string_equal):
+ * alloc.c (resize_string):
+ * alloc.c (set_string_char):
+ * alloc.c (Fmake_string):
+ * alloc.c (Fstring):
+ * alloc.c (init_string_ascii_begin):
+ * alloc.c (make_string):
+ * alloc.c (dec_lrecord_stats):
+ * alloc.c (lrecord_stats_heap_size):
+ * alloc.c (pluralize_word):
+ * array.c (Dynarr_realloc):
+ * array.c (Dynarr_insert_many):
+ * array.c (Dynarr_delete_many):
+ * array.c (gap_array_move_gap):
+ * array.h:
+ * array.h (Dynarr_declare):
+ * array.h (Dynarr_delete_object):
+ * array.h (gap_array_marker):
+ * buffer.c (MARKED_SLOT):
+ * buffer.c (Fgenerate_new_buffer_name):
+ * buffer.c (DEFVAR_BUFFER_LOCAL_1):
+ * buffer.h (struct buffer):
+ * bytecode.c (make_compiled_function_args):
+ * bytecode.c (UNUSED):
+ * callint.c (Fcall_interactively):
+ * casefiddle.c (casify_object):
+ * casefiddle.c (casify_region_internal):
+ * charset.h:
+ * chartab.c (clone_chartab_table):
+ * chartab.c (put_char_table):
+ * chartab.c (decode_char_table_range):
+ * cmds.c (Fpoint_at_bol):
+ * cmds.c (Fpoint_at_eol):
+ * cmds.c (internal_self_insert):
+ * console.c (delete_console_internal):
+ * console.c (Fset_input_mode):
+ * console.c (DEFVAR_CONSOLE_LOCAL_1):
+ * console.h:
+ * data.c (lisp_to_uint32_t):
+ * data.c (lisp_to_int32_t):
+ * data.c (rem_two_fixnum):
+ * data.c (Flsh):
+ * debug.c (FROB):
+ * device.c (Fmake_device):
+ * device.c (delete_device_internal):
+ * device.c (Fset_device_baud_rate):
+ * device.h:
+ * doc.c (extract_object_file_name):
+ * doc.c (Fsnarf_documentation):
+ * doc.c (verify_doc_mapper):
+ * doc.c (Fsubstitute_command_keys):
+ * doprnt.c (Fnumber_to_string):
+ * doprnt.c (emacs_doprnt):
+ * editfns.c (Finsert_char):
+ * editfns.c (save_restriction_restore):
+ * elhash.c (internal_array_hash):
+ * filelock.c (LOCK_PID_MAX):
+ * filelock.c (fill_in_lock_file_name):
+ * filelock.c (current_lock_owner):
+ * indent.c:
+ * indent.c (column_at_point):
+ * indent.c (string_column_at_point):
+ * indent.c (current_column):
+ * indent.c (Findent_to):
+ * indent.c (byte_spaces_at_point):
+ * indent.c (Fmove_to_column):
+ * indent.c (Fcompute_motion):
+ * indent.c (vertical_motion_1):
+ * indent.c (Fvertical_motion_pixels):
+ * lisp-disunion.h (XCHARVAL):
+ * lisp-disunion.h (wrap_pointer_1):
+ * lisp.h:
+ * lisp.h (ALLOCA):
+ * lisp.h (XSET_STRING_ASCII_BEGIN):
+ * lisp.h (CHECK_CHAR_COERCE_INT):
+ * lisp.h (LISP_HASH):
+ * lisp.h (struct gcpro):
+ * lisp.h (DECLARE_INLINE_HEADER):
+ * lrecord.h:
+ * lrecord.h (set_lheader_implementation):
+ * number.h:
+ * number.h (integer_signum):
+ * number.h (NATNUMP):
+ * print.c (debug_short_backtrace):
+ * search.c (find_before_next_newline):
+ * syntax.c (scan_words):
+ * syntax.h:
+ * sysdep.c:
+ * sysdep.c (wait_for_termination):
+ * sysdep.c (sys_subshell):
+ * sysdep.c (sys_suspend):
+ * sysdep.c (init_sigio_on_device):
+ * sysdep.c (qxe_readlink):
+ * sysfile.h:
+ * text.c (eifind_large_enough_buffer):
+ * text.h:
+ * text.h (ASSERT_ASCTEXT_ASCII_LEN):
+ * text.h (struct):
+ * text.h (EI_ALLOC):
+ * text.h (eicpy_lstr_off):
+ * text.h (eicpy_raw_fmt):
+ * text.h (eicpy_ascii_len):
+ * text.h (eicpy_ext_len):
+ * text.h (eimake_string_off):
+ * text.h (DECLARE_INLINE_HEADER):
+ * text.h (eicat_1):
+ * text.h (eicat_ascii):
+ * text.h (eicat_raw):
+ * text.h (eisub_1):
+ * text.h (eisub_ascii):
+ * text.h (EI_CASECHANGE):
+ * undo.c (truncate_undo_list):
+ * unicode.c (print_precedence_array):
+ Be more careful about integer types within the C code, e.g. not
+ using an int where a value represents a (possibly large) number of
+ bytes, or characters, especially relevant for values like fill
+ columns, which can usefully be set to most-positive-fixnum,
+ something the code up to now dealt with badly on a 64-bit build.
+ Issues flushed out using the -Wnarrowing GCC option.
+
+ * lisp.h (XCHAR_OR_CHAR_INT):
+ Provide an error-checking version of this to check uses with
+ fixnums where valid_ichar_p() is not true.
+
+ * lisp.h (GOOD_HASH):
+ Set this to a prime number just over 2^32 on sixty-four bit
+ architectures, of type Hashcode, an unsigned type, so modular
+ arithmetic is defined.
+
2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
* data.c:
diff -r 046a3f85a39d -r c5889f9bb7f4 src/abbrev.c
--- a/src/abbrev.c
+++ b/src/abbrev.c
@@ -284,7 +284,7 @@
{
/* This function can GC */
struct buffer *buf = current_buffer;
- int oldmodiff = BUF_MODIFF (buf);
+ EMACS_INT oldmodiff = BUF_MODIFF (buf);
Lisp_Object pre_modiff_p;
Charbpos point; /* position of point */
Charbpos abbrev_start; /* position of abbreviation beginning */
diff -r 046a3f85a39d -r c5889f9bb7f4 src/alloc.c
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -150,9 +150,9 @@
static struct
{
- int instances_in_use;
- int bytes_in_use;
- int bytes_in_use_including_overhead;
+ Elemcount instances_in_use;
+ Bytecount bytes_in_use;
+ Bytecount bytes_in_use_including_overhead;
} lrecord_stats [countof (lrecord_implementations_table)];
#else /* not NEW_GC */
@@ -315,7 +315,7 @@
static void
malloc_after (void *val, Bytecount size)
{
- if (!val && size != 0)
+ if (size < 0 || (!val && size != 0))
memory_full ();
set_alloc_mins_and_maxes (val, size);
}
@@ -393,7 +393,7 @@
{
void *val;
MALLOC_BEGIN ();
- val = malloc (size);
+ val = malloc ((size_t) size);
MALLOC_END ();
malloc_after (val, size);
return val;
@@ -405,7 +405,7 @@
{
void *val;
MALLOC_BEGIN ();
- val= calloc (nelem, elsize);
+ val= calloc ((size_t) nelem, (size_t) elsize);
MALLOC_END ();
malloc_after (val, nelem * elsize);
return val;
@@ -422,7 +422,7 @@
xrealloc (void *block, Bytecount size)
{
FREE_OR_REALLOC_BEGIN (block);
- block = realloc (block, size);
+ block = realloc (block, (size_t) size);
MALLOC_END ();
malloc_after (block, size);
return block;
@@ -454,8 +454,10 @@
char *
xstrdup (const char *str)
{
- int len = strlen (str) + 1; /* for stupid terminating 0 */
- void *val = xmalloc (len);
+ size_t len = strlen (str) + 1; /* for stupid terminating 0 */
+ void *val;
+
+ val = xmalloc ((Bytecount) len);
if (val == 0) return 0;
return (char *) memcpy (val, str, len);
@@ -596,7 +598,7 @@
assert_proper_sizing (size);
- lheader = (struct lrecord_header *) mc_alloc (size);
+ lheader = (struct lrecord_header *) mc_alloc ((size_t) size);
gc_checking_assert (LRECORD_FREE_P (lheader));
set_lheader_implementation (lheader, implementation);
#ifdef ALLOC_TYPE_STATS
@@ -641,7 +643,7 @@
}
Lisp_Object
-alloc_sized_lrecord_array (Bytecount size, int elemcount,
+alloc_sized_lrecord_array (Bytecount size, Elemcount elemcount,
const struct lrecord_implementation *implementation)
{
struct lrecord_header *lheader;
@@ -671,7 +673,7 @@
}
Lisp_Object
-alloc_lrecord_array (int elemcount,
+alloc_lrecord_array (Elemcount elemcount,
const struct lrecord_implementation *implementation)
{
type_checking_assert (implementation->static_size > 0);
@@ -767,7 +769,7 @@
#ifdef NEW_GC
memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
(char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
- size - sizeof (struct lrecord_header));
+ size - (Bytecount) sizeof (struct lrecord_header));
#else /* not NEW_GC */
if (imp->frob_block_p)
memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
@@ -896,8 +898,8 @@
/* On some systems, the above definitions will be optimized away by
the compiler or linker unless they are referenced in some function. */
-long dbg_inhibit_dbg_symbol_deletion (void);
-long
+EMACS_UINT dbg_inhibit_dbg_symbol_deletion (void);
+EMACS_UINT
dbg_inhibit_dbg_symbol_deletion (void)
{
return
@@ -1857,7 +1859,7 @@
make_uninit_vector (Elemcount sizei)
{
/* no `next' field; we use lcrecords */
- EMACS_UINT sizeui = sizei;
+ EMACS_UINT sizeui = (EMACS_UINT) sizei;
EMACS_UINT sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object,
contents, sizeui);
Lisp_Object obj;
@@ -1910,7 +1912,7 @@
check_integer_range() does <=, adjust for this. */
make_fixnum (ARRAY_DIMENSION_LIMIT - 1));
result = make_uninit_vector (nargs);
- memcpy (XVECTOR_DATA (result), args, sizeof (Lisp_Object) * nargs);
+ memcpy (XVECTOR_DATA (result), args, sizeof (Lisp_Object) * (size_t) nargs);
return result;
}
@@ -2057,8 +2059,8 @@
return ((bit_vector_length (v1) == bit_vector_length (v2)) &&
!memcmp (v1->bits, v2->bits,
- BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) *
- sizeof (long)));
+ (size_t) BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1))
+ * sizeof (long)));
}
/* This needs to be algorithmically identical to internal_array_hash in
@@ -2156,15 +2158,18 @@
{
Lisp_Bit_Vector *p = make_bit_vector_internal (length);
Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (length);
+ size_t bcount = (size_t) num_longs * sizeof (long);
CHECK_BIT (bit);
+ structure_checking_assert ((bcount / (size_t) num_longs) == sizeof (long));
+
if (ZEROP (bit))
- memset (p->bits, 0, num_longs * sizeof (long));
+ memset (p->bits, 0, bcount);
else
{
Elemcount bits_in_last = length & (LONGBITS_POWER_OF_2 - 1);
- memset (p->bits, ~0, num_longs * sizeof (long));
+ memset (p->bits, ~0, bcount);
/* But we have to make sure that the unused bits in the
last long are 0, so that equal/hash is easy. */
if (bits_in_last)
@@ -2672,7 +2677,8 @@
return !lisp_strcasecmp_i18n (obj1, obj2);
else
return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) &&
- !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len));
+ !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2),
+ (size_t) len));
}
static const struct memory_description string_description[] = {
@@ -3056,14 +3062,16 @@
if (delta < 0 && pos >= 0)
memmove (XSTRING_DATA (s) + pos + delta,
- XSTRING_DATA (s) + pos, len);
+ /* LEN is guaranteed greater than zero. */
+ XSTRING_DATA (s) + pos, (size_t) len);
XSTRING_DATA_OBJECT (s) =
wrap_string_direct_data (mc_realloc (XPNTR (XSTRING_DATA_OBJECT (s)),
newfullsize));
if (delta > 0 && pos >= 0)
memmove (XSTRING_DATA (s) + pos + delta, XSTRING_DATA (s) + pos,
- len);
+ /* LEN is guaranteed greater than zero. */
+ (size_t) len);
#else /* not NEW_GC */
oldfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s));
@@ -3222,10 +3230,10 @@
/* XSTRING_DATA (ss) might have changed, reload it. */
data = XSTRING_DATA (ss) + bytoff;
- memcpy (data, newstr, newlen);
+ memcpy (data, newstr, (size_t) newlen);
if (oldlen != newlen)
{
- if (newlen > 1 && idx <= (Charcount) XSTRING_ASCII_BEGIN (ss))
+ if (newlen > 1 && idx < (Charcount) XSTRING_ASCII_BEGIN (ss))
/* Everything starting with the new char is no longer part of
ascii_begin */
XSET_STRING_ASCII_BEGIN (ss, idx);
@@ -3238,9 +3246,7 @@
if (!byte_ascii_p (XSTRING_DATA (ss)[jj]))
break;
}
- XSET_STRING_ASCII_BEGIN (ss,
- min (jj,
- (Bytecount) MAX_STRING_ASCII_BEGIN));
+ XSET_STRING_ASCII_BEGIN (ss, jj);
}
}
sledgehammer_check_ascii_begin (ss);
@@ -3269,9 +3275,9 @@
make_fixnum (STRING_BYTE_TOTAL_SIZE_LIMIT - 1));
val = make_uninit_string (XFIXNUM (length));
- memset (XSTRING_DATA (val), XCHAR (character), XSTRING_LENGTH (val));
- XSET_STRING_ASCII_BEGIN (val, min (MAX_STRING_ASCII_BEGIN,
- XSTRING_LENGTH (val)));
+ memset (XSTRING_DATA (val), XCHAR (character),
+ (size_t) XSTRING_LENGTH (val));
+ XSET_STRING_ASCII_BEGIN (val, XSTRING_LENGTH (val));
}
else if (FIXNUMP (length) && XREALFIXNUM (length) >= 0)
{
@@ -3304,7 +3310,7 @@
val = make_uninit_string ((Bytecount) product);
ptr = XSTRING_DATA (val);
- for (i = clen; i; i--)
+ for (i = (EMACS_INT) clen; i; i--)
{
Ibyte *init_ptr = init_str;
switch (onelen)
@@ -3350,7 +3356,7 @@
make_fixnum ((STRING_BYTE_TOTAL_SIZE_LIMIT - 1) /
MAX_ICHAR_LEN));
- storage = p = alloca_ibytes (nargs * MAX_ICHAR_LEN);
+ storage = p = alloca_ibytes ((size_t) nargs * MAX_ICHAR_LEN);
for (; nargs; nargs--, args++)
{
@@ -3400,10 +3406,9 @@
if (!byte_ascii_p (contents[i]))
break;
}
- XSET_STRING_ASCII_BEGIN (string, min (i, MAX_STRING_ASCII_BEGIN));
+ XSET_STRING_ASCII_BEGIN (string, i);
#else
- XSET_STRING_ASCII_BEGIN (string, min (XSTRING_LENGTH (string),
- MAX_STRING_ASCII_BEGIN));
+ XSET_STRING_ASCII_BEGIN (string, XSTRING_LENGTH (string));
#endif
sledgehammer_check_ascii_begin (string);
}
@@ -3421,7 +3426,7 @@
#endif
val = make_uninit_string (length);
- memcpy (XSTRING_DATA (val), contents, length);
+ memcpy (XSTRING_DATA (val), contents, (size_t) length);
init_string_ascii_begin (val);
sledgehammer_check_ascii_begin (val);
return val;
@@ -4196,7 +4201,7 @@
const struct lrecord_header *h)
{
int type_index = h->type;
- int size = detagged_lisp_object_size (h);
+ Bytecount size = detagged_lisp_object_size (h);
lrecord_stats[type_index].instances_in_use--;
lrecord_stats[type_index].bytes_in_use -= size;
@@ -4206,11 +4211,11 @@
DECREMENT_CONS_COUNTER (size);
}
-int
+Bytecount
lrecord_stats_heap_size (void)
{
int i;
- int size = 0;
+ Bytecount size = 0;
for (i = 0; i < countof (lrecord_implementations_table); i++)
size += lrecord_stats[i].bytes_in_use;
return size;
@@ -4395,7 +4400,7 @@
static void
pluralize_word (Ascbyte *buf)
{
- Bytecount len = strlen (buf);
+ size_t len = strlen (buf);
int upper = 0;
Ascbyte d, e;
diff -r 046a3f85a39d -r c5889f9bb7f4 src/array.c
--- a/src/array.c
+++ b/src/array.c
@@ -308,16 +308,27 @@
static void
Dynarr_realloc (Dynarr *dy, Elemcount new_size)
{
+ size_t bcount = (size_t) new_size * (size_t) (Dynarr_elsize (dy));
+
+ if ((bcount / (size_t) new_size) != (size_t) Dynarr_elsize (dy))
+ {
+ memory_full ();
+ }
+
if (DUMPEDP (dy->base))
{
- void *new_base = malloc (new_size * Dynarr_elsize (dy));
- memcpy (new_base, dy->base,
- (Dynarr_max (dy) < new_size ? Dynarr_max (dy) : new_size) *
- Dynarr_elsize (dy));
+ size_t copycount
+ = (size_t) (Dynarr_max (dy) < new_size ? Dynarr_max (dy) : new_size)
+ * (size_t) Dynarr_elsize (dy);
+ void *new_base = malloc (bcount);
+ memcpy (new_base, dy->base, copycount);
dy->base = new_base;
}
else
- dy->base = xrealloc (dy->base, new_size * Dynarr_elsize (dy));
+ {
+ malloc_checking_assert ((Bytecount) bcount >= 0);
+ dy->base = xrealloc (dy->base, bcount);
+ }
}
void *
@@ -407,28 +418,40 @@
if (pos != old_len)
{
+ size_t bcount = (size_t) (old_len - pos) * (size_t) Dynarr_elsize (dy);
+ if ((bcount / (size_t) ((old_len - pos))) \
+ != (size_t) Dynarr_elsize (dy))
+ {
+ /* Overflow */
+ memory_full ();
+ }
memmove ((Rawbyte *) dy->base + (pos + len)*Dynarr_elsize (dy),
- (Rawbyte *) dy->base + pos*Dynarr_elsize (dy),
- (old_len - pos)*Dynarr_elsize (dy));
+ (Rawbyte *) dy->base + pos*Dynarr_elsize (dy), bcount);
}
/* Some functions call us with a value of 0 to mean "reserve space but
don't write into it" */
if (base)
- memcpy ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), base,
- len*Dynarr_elsize (dy));
+ {
+ size_t bcount = (size_t) len * (size_t) (Dynarr_elsize (dy));
+ dynarr_checking_assert ((Bytecount) bcount >= 0);
+ memcpy ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), base, bcount);
+ }
}
void
Dynarr_delete_many (void *d, Elemcount pos, Elemcount len)
{
Dynarr *dy = Dynarr_verify_mod (d);
+ size_t bcount
+ = (size_t) (Dynarr_length (dy) - pos - len) * (size_t) Dynarr_elsize (dy);
dynarr_checking_assert (pos >= 0 && len >= 0 &&
pos + len <= Dynarr_length (dy));
+ /* Not checking on overflow for BCOUNT because we're reducing the size
+ used, we had to have overflowed already. */
memmove ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy),
- (Rawbyte *) dy->base + (pos + len)*Dynarr_elsize (dy),
- (Dynarr_length (dy) - pos - len)*Dynarr_elsize (dy));
+ (Rawbyte *) dy->base + (pos + len)*Dynarr_elsize (dy), bcount);
Dynarr_set_length_1 (dy, Dynarr_length (dy) - len);
}
@@ -771,17 +794,21 @@
if (pos < gap)
{
+ size_t bcount = (size_t) (gap - pos) * (size_t) (ga->elsize);
+ structure_checking_assert ((bcount / (size_t) (gap - pos))
+ == (size_t) (ga->elsize));
memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize),
- GAP_ARRAY_MEMEL_ADDR (ga, pos),
- (gap - pos)*ga->elsize);
+ GAP_ARRAY_MEMEL_ADDR (ga, pos), bcount);
gap_array_adjust_markers (ga, (Memxpos) pos, (Memxpos) gap,
gapsize);
}
else if (pos > gap)
{
+ size_t bcount = (size_t) (pos - gap) * (size_t) (ga->elsize);
+ structure_checking_assert ((bcount / (size_t) (pos - gap))
+ == (size_t) (ga->elsize));
memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap),
- GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize),
- (pos - gap)*ga->elsize);
+ GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize), bcount);
gap_array_adjust_markers (ga, (Memxpos) (gap + gapsize),
(Memxpos) (pos + gapsize), - gapsize);
}
diff -r 046a3f85a39d -r c5889f9bb7f4 src/array.h
--- a/src/array.h
+++ b/src/array.h
@@ -51,10 +51,10 @@
type *base; \
DECLARE_DYNARR_LISP_IMP () \
DECLARE_DYNARR_LOCKED () \
- int elsize_; \
- int len_; \
- int largest_; \
- int max_
+ Bytecount elsize_; \
+ Elemcount len_; \
+ Elemcount largest_; \
+ Elemcount max_
typedef struct dynarr
{
@@ -152,7 +152,7 @@
#ifdef ERROR_CHECK_DYNARR
DECLARE_INLINE_HEADER (
-int
+Elemcount
Dynarr_verify_pos_at (void *d, Elemcount pos, const Ascbyte *file, int line)
)
{
@@ -164,7 +164,7 @@
}
DECLARE_INLINE_HEADER (
-int
+Elemcount
Dynarr_verify_pos_atp (void *d, Elemcount pos, const Ascbyte *file, int line)
)
{
@@ -204,7 +204,7 @@
}
DECLARE_INLINE_HEADER (
-int
+Elemcount
Dynarr_verify_pos_atp_allow_end (void *d, Elemcount pos, const Ascbyte *file,
int line)
)
@@ -441,8 +441,9 @@
)
{
Dynarr *dy = Dynarr_verify_mod (d);
- memset ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), 0,
- len*Dynarr_elsize (dy));
+ size_t bcount = (size_t) len * (size_t) (Dynarr_elsize (dy));
+
+ memset ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), 0, bcount);
}
/* This is an optimization. This is like Dynarr_set_length_and_zero() but
@@ -543,8 +544,10 @@
Elemcount pos = Dynarr_length (dy);
Dynarr_increase_length (dy, Dynarr_length (dy) + len);
if (base)
- memcpy ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), base,
- len*Dynarr_elsize (dy));
+ {
+ size_t bcount = (size_t) len * (size_t) Dynarr_elsize (dy);
+ memcpy ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), base, bcount);
+ }
}
/* Insert LEN elements, currently pointed to by BASE, into dynarr D
@@ -606,7 +609,7 @@
#define Dynarr_delete_object(d, el) \
do \
{ \
- REGISTER int _ddo_i; \
+ REGISTER Elemcount _ddo_i; \
for (_ddo_i = Dynarr_length (d) - 1; _ddo_i >= 0; _ddo_i--) \
{ \
if (el == Dynarr_at (d, _ddo_i)) \
@@ -767,7 +770,7 @@
#ifdef NEW_GC
NORMAL_LISP_OBJECT_HEADER header;
#endif /* NEW_GC */
- int pos;
+ Elemcount pos;
struct gap_array_marker *next;
} Gap_Array_Marker;
diff -r 046a3f85a39d -r c5889f9bb7f4 src/buffer.c
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -749,7 +749,7 @@
/* For each slot that has a default value,
copy that into the slot. */
#define MARKED_SLOT(slot) \
- { int mask = XFIXNUM (buffer_local_flags.slot); \
+ { EMACS_INT mask = XFIXNUM (buffer_local_flags.slot); \
if ((mask > 0 || mask == -1 || mask == -3) \
&& (first_time \
|| NILP (Fget (XBUFFER (Vbuffer_local_symbols)->slot, \
@@ -811,7 +811,7 @@
}
csize = XSTRING_LENGTH (name) + DECIMAL_PRINT_SIZE (EMACS_INT)
- + sizeof ("<>");
+ + (Bytecount) (sizeof ("<>"));
candidate = alloca_ibytes (csize);
count = itext_ichar_eql (XSTRING_DATA (name), ' ') ? get_random () : 1;
@@ -954,7 +954,7 @@
{
struct buffer *syms = XBUFFER (Vbuffer_local_symbols);
#define MARKED_SLOT(slot) \
- { int mask = XFIXNUM (buffer_local_flags.slot); \
+ { EMACS_INT mask = XFIXNUM (buffer_local_flags.slot); \
if (mask == 0 || mask == -1 \
|| ((mask > 0) && (buf->local_var_flags & mask))) \
result = Fcons (Fcons (syms->slot, buf->slot), result); \
@@ -2221,8 +2221,8 @@
MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \
\
{ \
- int offset = ((char *)symbol_value_forward_forward (I_hate_C) - \
- (char *)&buffer_local_flags); \
+ ssize_t offset = ((char *)symbol_value_forward_forward (I_hate_C) - \
+ (char *)&buffer_local_flags); \
defvar_magic (lname, I_hate_C); \
\
*((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols))) \
diff -r 046a3f85a39d -r c5889f9bb7f4 src/buffer.h
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -239,7 +239,7 @@
/* Flags saying which DEFVAR_PER_BUFFER variables
are local to this buffer. */
- int local_var_flags;
+ EMACS_INT local_var_flags;
/* Set to the modtime of the visited file when read or written.
-1 means visited file was nonexistent.
diff -r 046a3f85a39d -r c5889f9bb7f4 src/bytecode.c
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -60,14 +60,16 @@
#ifdef NEW_GC
static Lisp_Object
-make_compiled_function_args (int totalargs)
+make_compiled_function_args (Elemcount totalargs)
{
+ size_t bcount
+ = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
+ Lisp_Object, args, (size_t) totalargs);
Lisp_Compiled_Function_Args *args;
+ structure_checking_assert ((Bytecount) bcount >= 0);
+
args = XCOMPILED_FUNCTION_ARGS
- (ALLOC_SIZED_LISP_OBJECT
- (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
- Lisp_Object, args, totalargs),
- compiled_function_args));
+ (ALLOC_SIZED_LISP_OBJECT ((Bytecount) bcount, compiled_function_args));
args->size = totalargs;
return wrap_compiled_function_args (args);
}
@@ -1470,7 +1472,7 @@
const Opbyte *UNUSED (program_ptr),
Opcode opcode)
{
- REGISTER int n;
+ REGISTER EMACS_INT n;
switch (opcode)
{
diff -r 046a3f85a39d -r c5889f9bb7f4 src/callint.c
--- a/src/callint.c
+++ b/src/callint.c
@@ -281,10 +281,10 @@
#endif
/* If SPECS is a string, we reset prompt_data to XSTRING_DATA (specs)
every time a GC might have occurred */
- const char *prompt_data = 0;
- int prompt_index = 0;
+ const Ibyte *prompt_data = 0;
+ Bytecount prompt_index = 0;
int argcount;
- int set_zmacs_region_stays = 0;
+ Boolint set_zmacs_region_stays = 0;
int mouse_event_count = 0;
if (!NILP (keys))
@@ -316,7 +316,7 @@
if (SUBRP (fun))
{
- prompt_data = XSUBR (fun)->prompt;
+ prompt_data = (const Ibyte *) XSUBR (fun)->prompt;
if (!prompt_data)
{
lose:
@@ -369,7 +369,7 @@
if (!STRINGP (specs) && prompt_data == 0)
{
struct gcpro gcpro1, gcpro2, gcpro3;
- int i = num_input_chars;
+ Charcount i = num_input_chars;
Lisp_Object input = specs;
GCPRO3 (function, specs, input);
@@ -466,7 +466,7 @@
for (;;)
{
if (STRINGP (specs))
- prompt_data = (const char *) XSTRING_DATA (specs);
+ prompt_data = (const Ibyte *) XSTRING_DATA (specs);
if (prompt_data[prompt_index] == '+')
syntax_error ("`+' is not used in `interactive' for ordinary commands", Qunbound);
@@ -527,7 +527,7 @@
us give to the function. */
argcount = 0;
{
- const char *tem;
+ const Ibyte *tem;
for (tem = prompt_data + prompt_index; *tem; )
{
/* 'r' specifications ("point and mark as 2 numeric args")
@@ -536,7 +536,7 @@
argcount += 2;
else
argcount += 1;
- tem = (const char *) strchr (tem + 1, '\n');
+ tem = qxestrchr (tem + 1, '\n');
if (!tem)
break;
tem++;
@@ -575,11 +575,11 @@
{
/* args[-1] is the function to call */
/* args[n] is the n'th argument to the function */
- int alloca_size = (1 /* function to call */
- + argcount /* actual arguments */
- + argcount /* visargs */
- + argcount /* varies */
- );
+ Bytecount alloca_size = (1 /* function to call */
+ + argcount /* actual arguments */
+ + argcount /* visargs */
+ + argcount /* varies */
+ );
Lisp_Object *args = alloca_array (Lisp_Object, alloca_size) + 1;
/* visargs is an array of either Qnil or user-friendlier versions (often
* strings) of previous arguments, to use in prompts for successive
@@ -590,7 +590,7 @@
its value in this call quoted in the command history. It should be
recorded as a call to the function named varies[i]]. */
Lisp_Object *varies = visargs + argcount;
- int arg_from_tty = 0;
+ Boolint arg_from_tty = 0;
REGISTER int argnum;
struct gcpro gcpro1, gcpro2;
@@ -606,12 +606,12 @@
for (argnum = 0; ; argnum++)
{
- const char *prompt_start = prompt_data + prompt_index + 1;
- const char *prompt_limit = (const char *) strchr (prompt_start, '\n');
- int prompt_length;
+ const Ibyte *prompt_start = prompt_data + prompt_index + 1;
+ const Ibyte *prompt_limit = qxestrchr (prompt_start, '\n');
+ Bytecount prompt_length;
prompt_length = ((prompt_limit)
? (prompt_limit - prompt_start)
- : (int) strlen (prompt_start));
+ : qxestrlen (prompt_start));
if (prompt_limit && prompt_limit[1] == 0)
{
prompt_limit = 0; /* "sfoo:\n" -- strip tailing return */
@@ -933,7 +933,7 @@
if (!prompt_limit)
break;
if (STRINGP (specs))
- prompt_data = (const char *) XSTRING_DATA (specs);
+ prompt_data = (const Ibyte *) XSTRING_DATA (specs);
prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */
}
unbind_to (speccount);
diff -r 046a3f85a39d -r c5889f9bb7f4 src/casefiddle.c
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -68,7 +68,7 @@
Ibyte *newp = storage;
Ibyte *oldp = XSTRING_DATA (string_or_char);
Ibyte *endp = oldp + XSTRING_LENGTH (string_or_char);
- int wordp = 0, wordp_prev;
+ Boolint wordp = 0, wordp_prev;
while (oldp < endp)
{
@@ -203,7 +203,7 @@
Charbpos pos, s, e;
Lisp_Object syntax_table = BUFFER_MIRROR_SYNTAX_TABLE (buf);
int mccount;
- int wordp = 0, wordp_prev;
+ Boolint wordp = 0, wordp_prev;
if (EQ (start, end))
/* Not modifying because nothing marked */
diff -r 046a3f85a39d -r c5889f9bb7f4 src/charset.h
--- a/src/charset.h
+++ b/src/charset.h
@@ -989,7 +989,7 @@
to the Dynarr. FAIL controls failure mode when charset conversion to
Unicode is not possible. */
DECLARE_INLINE_HEADER (
-int
+Bytecount
charset_codepoint_to_dynarr (Lisp_Object charset, int c1, int c2,
unsigned_char_dynarr *dst,
enum converr USED_IF_MULE (fail))
diff -r 046a3f85a39d -r c5889f9bb7f4 src/chartab.c
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -269,7 +269,6 @@
clone_chartab_table (Lisp_Object table, int level, int catp)
{
Lisp_Object newtab;
- Bytecount size;
check_chartab_invariants (table, level, catp);
@@ -280,10 +279,9 @@
return table;
}
- size = sizeof (Lisp_Object);
newtab = ALLOCATE_LEVEL_N_SUBTAB ();
memcpy (SUBTAB_ARRAY_FROM_SUBTAB (newtab), SUBTAB_ARRAY_FROM_SUBTAB (table),
- 256 * size);
+ 256 * sizeof (Lisp_Object));
{
int i;
@@ -506,7 +504,7 @@
int levels;
#ifndef MAXIMIZE_CHAR_TABLE_DEPTH
int code_levels;
- int catp = XCHAR_TABLE_CATEGORY_P (chartab);
+ Boolint catp = XCHAR_TABLE_CATEGORY_P (chartab);
#endif
/* DO NOT check to see whether START and END are valid Ichars. They
@@ -1217,8 +1215,6 @@
range);
outrange->type = CHARTAB_RANGE_ROW;
outrange->charset = Fget_charset (elts[0]);
- CHECK_FIXNUM (elts[1]);
- outrange->row = XFIXNUM (elts[1]);
if (XCHARSET_DIMENSION (outrange->charset) == 1)
sferror ("Charset in row vector must be multi-byte",
outrange->charset);
@@ -1229,6 +1225,7 @@
make_fixnum (XCHARSET_OFFSET (outrange->charset, 0) +
XCHARSET_CHARS (outrange->charset, 0) - 1));
}
+ outrange->row = (int) XFIXNUM (elts[1]);
}
else
{
diff -r 046a3f85a39d -r c5889f9bb7f4 src/cmds.c
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -170,7 +170,7 @@
(count, buffer))
{
struct buffer *b = decode_buffer (buffer, 1);
- REGISTER int orig, end;
+ REGISTER Charbpos orig, end;
buffer = wrap_buffer (b);
if (NILP (count))
@@ -228,7 +228,7 @@
}
return make_fixnum (find_before_next_newline (buf, BUF_PT (buf), 0,
- n - (n <= 0)));
+ n - (n <= 0)));
}
DEFUN ("end-of-line", Fend_of_line, 0, 2, "_p", /*
@@ -379,7 +379,7 @@
Lisp_Object overwrite;
Lisp_Object syntax_table;
struct buffer *buf = current_buffer;
- int tab_width;
+ Charcount tab_width;
overwrite = buf->overwrite_mode;
syntax_table = BUFFER_MIRROR_SYNTAX_TABLE (buf);
diff -r 046a3f85a39d -r c5889f9bb7f4 src/console.c
--- a/src/console.c
+++ b/src/console.c
@@ -681,8 +681,9 @@
*/
void
-delete_console_internal (struct console *con, int force,
- int called_from_kill_emacs, int from_io_error)
+delete_console_internal (struct console *con, Boolint force,
+ Boolint called_from_kill_emacs,
+ Boolint from_io_error)
{
/* This function can GC */
Lisp_Object console;
@@ -1115,10 +1116,10 @@
(UNUSED (ignored), USED_IF_TTY (flow), meta, quit, console))
{
struct console *con = decode_console (console);
- int meta_key = (!CONSOLE_TTY_P (con) ? 1 :
- EQ (meta, Qnil) ? 0 :
- EQ (meta, Qt) ? 1 :
- 2);
+ unsigned int meta_key = (!CONSOLE_TTY_P (con) ? 1 :
+ EQ (meta, Qnil) ? 0 :
+ EQ (meta, Qt) ? 1 :
+ 2);
if (!NILP (quit))
{
@@ -1133,7 +1134,7 @@
{
reset_one_console (con);
TTY_FLAGS (con).flow_control = !NILP (flow);
- TTY_FLAGS (con).meta_key = meta_key;
+ TTY_FLAGS (con).meta_key = meta_key & 0x2;
init_one_console (con);
MARK_FRAME_CHANGED (XFRAME (CONSOLE_SELECTED_FRAME (con)));
}
@@ -1337,7 +1338,7 @@
MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \
\
{ \
- int offset = ((char *)symbol_value_forward_forward (I_hate_C) \
+ size_t offset = ((char *)symbol_value_forward_forward (I_hate_C) \
- (char *)&console_local_flags); \
\
defvar_magic (lname, I_hate_C); \
diff -r 046a3f85a39d -r c5889f9bb7f4 src/console.h
--- a/src/console.h
+++ b/src/console.h
@@ -138,8 +138,9 @@
enum console_variant get_console_variant (Lisp_Object type);
-void delete_console_internal (struct console *con, int force,
- int from_kill_emacs, int from_io_error);
+void delete_console_internal (struct console *con, Boolint force,
+ Boolint from_kill_emacs,
+ Boolint from_io_error);
void io_error_delete_console (Lisp_Object console);
void set_console_last_nonminibuf_frame (struct console *con,
Lisp_Object frame);
diff -r 046a3f85a39d -r c5889f9bb7f4 src/data.c
--- a/src/data.c
+++ b/src/data.c
@@ -1200,7 +1200,8 @@
type_checking_assert (FIXNUMP (top) && FIXNUMP (bot));
- return (XFIXNUM (top) << 16) | (XFIXNUM (bot) & 0xffff);
+ return ((UINT_32_BIT) XFIXNUM (top) << 16) |
+ (UINT_32_BIT) (XFIXNUM (bot) & 0xffff);
}
}
@@ -1237,7 +1238,7 @@
return (INT_32_BIT) bignum_to_emacs_int (XBIGNUM_DATA (item));
}
#endif
- return XFIXNUM (item);
+ return (UINT_32_BIT) XFIXNUM (item);
}
else
{
@@ -2924,7 +2925,7 @@
val2 = EMACS_INT_ABS (number2);
- return make_fixnum ((EMACS_INT)((val1 % val2) * sign));
+ return make_fixnum ((EMACS_INT)(val1 % val2) * sign);
}
DEFUN ("%", Frem, 2, 2, 0, /*
@@ -3146,7 +3147,7 @@
{
args_out_of_range_3 (count,
make_bignum_ll (- (long long)(ULONG_MAX)),
- make_bignum_ll (ULONG_MAX));
+ make_bignum_ull (ULONG_MAX));
}
bignum_rshift (scratch_bignum2, XBIGNUM_DATA (value),
bignum_to_ulong (scratch_bignum));
@@ -3158,7 +3159,7 @@
{
args_out_of_range_3 (count,
make_bignum_ll (- (long long) (ULONG_MAX)),
- make_bignum_ll (ULONG_MAX));
+ make_bignum_ull (ULONG_MAX));
}
bignum_lshift (scratch_bignum2, XBIGNUM_DATA (value),
bignum_to_ulong (XBIGNUM_DATA (count)));
diff -r 046a3f85a39d -r c5889f9bb7f4 src/debug.c
--- a/src/debug.c
+++ b/src/debug.c
@@ -61,7 +61,7 @@
if (op == X_LIST || op == X_ACTIVE || op == X_INIT || EQ (class_, Q##item)) \
{ \
if (op == X_ADD || op == X_DELETE || op == X_INIT) \
- active_debug_classes.item = flag; \
+ active_debug_classes.item = flag & 1; \
else if (op == X_LIST \
|| (op == X_ACTIVE && active_debug_classes.item)) \
retval = Fcons (Q##item, retval); \
diff -r 046a3f85a39d -r c5889f9bb7f4 src/device.c
--- a/src/device.c
+++ b/src/device.c
@@ -621,7 +621,7 @@
specify different global resources (there's a property on each X
server's root window that holds some resources); tough luck for the
moment. */
- int first = NILP (get_default_device (type));
+ Boolint first = NILP (get_default_device (type));
GCPRO3 (device, console, name);
@@ -778,9 +778,9 @@
*/
void
-delete_device_internal (struct device *d, int force,
- int called_from_delete_console,
- int from_io_error)
+delete_device_internal (struct device *d, Boolint force,
+ Boolint called_from_delete_console,
+ Boolint from_io_error)
{
/* This function can GC */
struct console *c;
@@ -1031,7 +1031,8 @@
*/
(device, rate))
{
- CHECK_FIXNUM (rate);
+ /* Nothing greater than 30 bits, please.*/
+ check_integer_range (rate, Qzero, make_fixnum (0x3fffffff));
DEVICE_BAUD_RATE (decode_device (device)) = XFIXNUM (rate);
diff -r 046a3f85a39d -r c5889f9bb7f4 src/device.h
--- a/src/device.h
+++ b/src/device.h
@@ -101,9 +101,9 @@
void select_device_1 (Lisp_Object);
struct device *decode_device (Lisp_Object);
void handle_asynch_device_change (void);
-void delete_device_internal (struct device *d, int force,
- int called_from_delete_console,
- int from_io_error);
+void delete_device_internal (struct device *d, Boolint force,
+ Boolint called_from_delete_console,
+ Boolint from_io_error);
void io_error_delete_device (Lisp_Object device);
Lisp_Object find_nonminibuffer_frame_not_on_device (Lisp_Object device);
void set_device_selected_frame (struct device *d, Lisp_Object frame);
diff -r 046a3f85a39d -r c5889f9bb7f4 src/doc.c
--- a/src/doc.c
+++ b/src/doc.c
@@ -48,7 +48,7 @@
{
Ibyte buf[DOC_MAX_FILENAME_LENGTH+1];
Ibyte *buffer = buf;
- int buffer_size = sizeof (buf) - 1, space_left;
+ Bytecount buffer_size = sizeof (buf) - 1, space_left;
Ibyte *from, *to;
REGISTER Ibyte *p = buffer;
Lisp_Object return_me;
@@ -82,7 +82,7 @@
space_left = buffer_size - (p - buffer);
while (space_left > 0)
{
- int nread;
+ Bytecount nread;
nread = Lstream_read (XLSTREAM (instream), p, space_left);
if (nread < 0)
@@ -740,8 +740,8 @@
{
int fd;
Ibyte buf[1024 + 1];
- REGISTER int filled;
- REGISTER int pos;
+ REGISTER Bytecount filled;
+ REGISTER OFF_T pos;
REGISTER Ibyte *p, *end;
Lisp_Object sym, fun, tem;
Ibyte *name;
@@ -987,7 +987,7 @@
if (!NILP (Ffboundp (sym)))
{
- int doc = 0;
+ EMACS_INT doc = 0;
Lisp_Object fun = XSYMBOL (sym)->function;
if (CONSP (fun) &&
EQ (XCAR (fun), Qmacro))
@@ -1129,7 +1129,8 @@
strdata = XSTRING_DATA (string);
strlength = XSTRING_LENGTH (string);
strp = strdata + idx;
- backslashp = (const Ibyte *) memchr (strp, '\\', strlength - idx);
+ backslashp = (const Ibyte *) memchr (strp, '\\',
+ max (strlength - idx, 0));
partlen = backslashp ? backslashp - strp : strlength - idx;
if (changed)
@@ -1159,7 +1160,7 @@
idx += ichar_len ('[');
strp = strdata + idx;
- strp = (Ibyte *) memchr (strp, ']', strlength - idx);
+ strp = (Ibyte *) memchr (strp, ']', max (strlength - idx, 0));
if (!strp)
{
diff -r 046a3f85a39d -r c5889f9bb7f4 src/doprnt.c
--- a/src/doprnt.c
+++ b/src/doprnt.c
@@ -610,7 +610,14 @@
{
Bytecount size = ratio_size_in_base (XRATIO_DATA (number),
radixing), len;
- Ibyte *buffer = alloca_ibytes (size);
+ Ibyte *buffer;
+
+ if (size < 0)
+ {
+ out_of_memory ("cannot print supplied ratio", Qunbound);
+ }
+
+ buffer = alloca_ibytes (size);
len = ratio_to_string_1 (&buffer, size, XRATIO_DATA (number), radixing,
fixnum_to_char_table);
@@ -2404,6 +2411,10 @@
}
size = bignum_size_decimal (XBIGNUM_DATA (obj));
+ if (size < 0)
+ {
+ out_of_memory ("cannot print bignum in decimal", Qunbound);
+ }
to_print = alloca_ibytes (size);
end = to_print + size;
@@ -2452,6 +2463,11 @@
}
size = bignum_size_octal (XBIGNUM_DATA (obj));
+ if (size < 0)
+ {
+ out_of_memory ("cannot print bignum", Qunbound);
+ }
+
to_print = alloca_ibytes (size);
end = to_print + size;
@@ -2506,6 +2522,10 @@
}
size = bignum_size_binary (XBIGNUM_DATA (obj));
+ if (size < 0)
+ {
+ out_of_memory ("cannot print bignum in binary", Qunbound);
+ }
to_print = alloca_ibytes (size);
end = to_print + size;
@@ -2559,6 +2579,10 @@
}
size = bignum_size_hex (XBIGNUM_DATA (obj));
+ if (size < 0)
+ {
+ out_of_memory ("cannot print bignum in hex", Qunbound);
+ }
to_print = alloca_ibytes (size);
end = to_print + size;
@@ -2603,6 +2627,10 @@
}
size = ratio_size_in_base (XRATIO_DATA (obj), 10);
+ if (size < 0)
+ {
+ out_of_memory ("cannot print ratio in decimal", Qunbound);
+ }
to_print = alloca_ibytes (size);
end = to_print + size;
diff -r 046a3f85a39d -r c5889f9bb7f4 src/editfns.c
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1651,7 +1651,7 @@
REGISTER Bytecount charlen;
Ibyte str[MAX_ICHAR_LEN];
struct buffer *b = decode_buffer (buffer, 1);
- int cou;
+ Charcount cou;
CHECK_CHAR_COERCE_INT (character);
if (NILP (count))
@@ -2161,7 +2161,7 @@
{
struct buffer *buf;
Lisp_Object markers = XCDR (data);
- int local_clip_changed = 0;
+ Boolint local_clip_changed = 0;
buf = XBUFFER (XCAR (data));
/* someone could have killed the buffer in the meantime ... */
diff -r 046a3f85a39d -r c5889f9bb7f4 src/elhash.c
--- a/src/elhash.c
+++ b/src/elhash.c
@@ -2307,7 +2307,8 @@
/* Return a hash value for an array of Lisp_Objects of size SIZE. */
Hashcode
-internal_array_hash (Lisp_Object *arr, int size, int depth, Boolint equalp)
+internal_array_hash (Lisp_Object *arr, Elemcount size, int depth,
+ Boolint equalp)
{
int i;
Hashcode hash = 0;
diff -r 046a3f85a39d -r c5889f9bb7f4 src/filelock.c
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -89,7 +89,7 @@
/* When we read the info back, we might need this much more,
enough for decimal representation plus null. */
-#define LOCK_PID_MAX (4 * sizeof (pid_t))
+#define LOCK_PID_MAX (4 * (int) (sizeof (pid_t)))
/* Free the two dynamically-allocated pieces in PTR. */
#define FREE_LOCK_INFO(i) do { \
@@ -109,7 +109,7 @@
{
Ibyte *file_name = XSTRING_DATA (fn);
Ibyte *p;
- Bytecount dirlen;
+ size_t dirlen;
for (p = file_name + XSTRING_LENGTH (fn) - 1;
p > file_name && !IS_ANY_SEP (p[-1]);
@@ -173,11 +173,11 @@
current_lock_owner (lock_info_type *owner, Ibyte *lfname)
{
/* Does not GC. */
- int len, ret;
- int local_owner = 0;
+ Bytecount len;
+ int local_owner = 0, ret;
Ibyte *at, *dot;
Ibyte *lfinfo = 0;
- int bufsize = 50;
+ size_t bufsize = 50;
/* Read arbitrarily-long contents of symlink. Similar code in
file-symlink-p in fileio.c. */
do
@@ -186,7 +186,7 @@
lfinfo = (Ibyte *) xrealloc (lfinfo, bufsize);
len = qxe_readlink (lfname, lfinfo, bufsize);
}
- while (len >= bufsize);
+ while (len >= (Bytecount) bufsize);
/* If nonexistent lock file, all is well; otherwise, got strange error. */
if (len == -1)
diff -r 046a3f85a39d -r c5889f9bb7f4 src/indent.c
--- a/src/indent.c
+++ b/src/indent.c
@@ -49,7 +49,7 @@
Some things set last_known_column_point to -1
to mark the memoized value as invalid */
-static int last_known_column;
+static Charcount last_known_column;
/* Last buffer searched by current_column */
static struct buffer *last_known_column_buffer;
@@ -120,13 +120,13 @@
last_known_column_point = -1;
}
-int
-column_at_point (struct buffer *buf, Charbpos init_pos, int cur_col)
+Charcount
+column_at_point (struct buffer *buf, Charbpos init_pos, Charcount cur_col)
{
- int col;
- int tab_seen;
- int tab_width = XFIXNUM (buf->tab_width);
- int post_tab;
+ Charcount col;
+ Charcount tab_seen;
+ Charcount tab_width = XFIXNUM (buf->tab_width);
+ Charcount post_tab;
Charbpos pos = init_pos;
Ichar c;
@@ -187,12 +187,12 @@
return col;
}
-int
-string_column_at_point (Lisp_Object s, Charbpos init_pos, int tab_width)
+Charcount
+string_column_at_point (Lisp_Object s, Charbpos init_pos, Charcount tab_width)
{
- int col;
- int tab_seen;
- int post_tab;
+ Charcount col;
+ Charcount tab_seen;
+ Charcount post_tab;
Charbpos pos = init_pos;
Ichar c;
@@ -230,7 +230,7 @@
return col;
}
-int
+Charcount
current_column (struct buffer *buf)
{
if (buf == last_known_column_buffer
@@ -268,10 +268,10 @@
(column, minimum, buffer))
{
/* This function can GC */
- int mincol;
- int fromcol;
+ Charcount mincol;
+ Charcount fromcol;
struct buffer *buf = decode_buffer (buffer, 0);
- int tab_width = XFIXNUM (buf->tab_width);
+ Charcount tab_width = XFIXNUM (buf->tab_width);
Charbpos opoint = 0;
CHECK_FIXNUM (column);
@@ -305,7 +305,7 @@
if (indent_tabs_mode)
{
- int n = mincol / tab_width - fromcol / tab_width;
+ Charcount n = mincol / tab_width - fromcol / tab_width;
if (n != 0)
{
Finsert_char (make_char ('\t'), make_fixnum (n), Qnil, buffer);
@@ -328,13 +328,13 @@
return make_fixnum (mincol);
}
-int
+Charcount
byte_spaces_at_point (struct buffer *b, Bytebpos byte_pos)
{
Bytebpos byte_end = BYTE_BUF_ZV (b);
- int col = 0;
+ Charcount col = 0;
Ichar c;
- int tab_width = XFIXNUM (b->tab_width);
+ Charcount tab_width = XFIXNUM (b->tab_width);
if (tab_width <= 0 || tab_width > 1000)
tab_width = 8;
@@ -392,19 +392,26 @@
/* This function can GC */
Charbpos pos;
struct buffer *buf = decode_buffer (buffer, 0);
- int col = current_column (buf);
- int goal;
+ Charcount col = current_column (buf);
+ Charcount goal;
Charbpos end;
- int tab_width = XFIXNUM (buf->tab_width);
+ Charcount tab_width = XFIXNUM (buf->tab_width);
- int prev_col = 0;
+ Charcount prev_col = 0;
Ichar c = 0;
buffer = wrap_buffer (buf);
if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
- check_integer_range (column, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
- goal = XFIXNUM (column);
+ CHECK_NATNUM (column);
+ if (BIGNUMP (column))
+ {
+ goal = 1 + MOST_POSITIVE_FIXNUM;
+ }
+ else
+ {
+ goal = XFIXNUM (column);
+ }
retry:
pos = BUF_PT (buf);
@@ -526,7 +533,7 @@
{
Lisp_Object charbpos, hpos, vpos, prevhpos, contin;
struct position *pos;
- int hscroll, tab_offset;
+ Charcount hscroll, tab_offset;
struct window *w = decode_window (window);
CHECK_FIXNUM_COERCE_MARKER (from);
@@ -694,7 +701,7 @@
{
Charbpos charbpos;
Charbpos orig;
- int selected;
+ Boolint selected;
int *vpos, *vpix;
int value=0;
struct window *w;
@@ -877,9 +884,9 @@
{
Charbpos charbpos;
Charbpos orig;
- int selected;
+ Boolint selected;
int motion;
- int howto;
+ int howto = 0;
struct window *w;
if (NILP (window))
@@ -895,7 +902,19 @@
orig = selected ? BUF_PT (XBUFFER (w->buffer))
: marker_position (w->pointm[CURRENT_DISP]);
- howto = FIXNUMP (how) ? XFIXNUM (how) : 0;
+ if (INTEGERP (how))
+ {
+ if (FIXNUMP (how))
+ {
+ howto = XFIXNUM (how) < 0 ? -1 : (XFIXNUM (how) > 0);
+ }
+#ifdef HAVE_BIGNUM
+ else
+ {
+ howto = bignum_sign (XBIGNUM_DATA (how));
+ }
+#endif
+ }
charbpos = vmotion_pixels (window, orig, XFIXNUM (pixels), howto, &motion);
diff -r 046a3f85a39d -r c5889f9bb7f4 src/lisp-disunion.h
--- a/src/lisp-disunion.h
+++ b/src/lisp-disunion.h
@@ -83,7 +83,7 @@
#define XPNTRVAL(x) (x) /* This depends on Lisp_Type_Record == 0 */
/* A character is always >= 0, so get 30 bits out of it by treating it as
unsigned */
-#define XCHARVAL(x) ((EMACS_UINT)(x) >> GCBITS)
+#define XCHARVAL(x) ((EMACS_UINT)(x) >> (EMACS_UINT) GCBITS)
#define XREALFIXNUM(x) ((x) >> FIXNUM_GCBITS)
#define XUINT(x) ((EMACS_UINT)(x) >> FIXNUM_GCBITS)
diff -r 046a3f85a39d -r c5889f9bb7f4 src/lisp.h
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1447,7 +1447,7 @@
#ifdef USE_GCC_EXTENDED_EXPRESSION_SYNTAX
#define ALLOCA(size) \
- ({ Bytecount temp_alloca_size; \
+ ({ size_t temp_alloca_size; \
REGEX_MALLOC_CHECK (); \
temp_alloca_size = (size); \
temp_alloca_size > MAX_ALLOCA_VS_C_ALLOCA ? \
@@ -2848,7 +2848,7 @@
/* WARNING: If you modify an existing string, you must call
bump_string_modiff() afterwards. */
#define XSET_STRING_ASCII_BEGIN(s, val) \
- ((void) (XSTRING (s)->u.v.ascii_begin = (val)))
+ ((void) (XSTRING (s)->u.v.ascii_begin = (val) & MAX_STRING_ASCII_BEGIN))
#define XSTRING_FORMAT(s) FORMAT_DEFAULT
#define XSTRING_MODIFFP(s) (XSTRING (s)->u.v.modiffp + 0)
@@ -3277,12 +3277,27 @@
character. */
#define CHAR_OR_CHAR_INTP(x) (CHARP (x) || CHAR_INTP (x))
+#define XCHAR_OR_CHAR_INT(x) XCHAR_OR_CHAR_INT_1 (x, __FILE__, __LINE__)
+
DECLARE_INLINE_HEADER (
Ichar
-XCHAR_OR_CHAR_INT (Lisp_Object obj)
+XCHAR_OR_CHAR_INT_1 (Lisp_Object obj, const Ascbyte *file, int line)
)
{
- return CHARP (obj) ? XCHAR (obj) : XFIXNUM (obj);
+ if (CHARP (obj))
+ {
+ return XCHARVAL (obj);
+ }
+ if (FIXNUMP (obj))
+ {
+ EMACS_INT ival = XREALFIXNUM (obj);
+ if (valid_ichar_p (ival))
+ {
+ return (Ichar) ival;
+ }
+ }
+ assert_at_line (CHARP (obj) || CHAR_INTP (obj), file, line);
+ return (Ichar) -1;
}
/* Signal an error if CH is not a valid character or integer Lisp_Object.
@@ -3294,7 +3309,7 @@
if (CHARP (x)) \
; \
else if (CHAR_INTP (x)) \
- x = make_char (XFIXNUM (x)); \
+ x = make_char ((Ichar) XREALFIXNUM (x)); \
else \
x = wrong_type_argument (Qcharacterp, x); \
} while (0)
@@ -4003,8 +4018,14 @@
/* hashing */
/************************************************************************/
-/* #### for a 64-bit machine, we should substitute a prime just over 2^32 */
-#define GOOD_HASH 65599 /* prime number just over 2^16; Dragon book, p. 435 */
+#if SIZEOF_EMACS_INT < 8
+#define GOOD_HASH ((Hashcode) 65599) /* prime number just over 2^16;
+ Dragon book, p. 435 */
+
+#else
+#define GOOD_HASH ((Hashcode) 4294967311UL) /* prime number just over 2^32 */
+#endif
+
#define HASH2(a,b) (GOOD_HASH * (a) + (b))
#define HASH3(a,b,c) (GOOD_HASH * HASH2 (a,b) + (c))
#define HASH4(a,b,c,d) (GOOD_HASH * HASH3 (a,b,c) + (d))
@@ -4014,10 +4035,10 @@
#define HASH8(a,b,c,d,e,f,g,h) (GOOD_HASH * HASH7 (a,b,c,d,e,f,g) + (h))
#define HASH9(a,b,c,d,e,f,g,h,i) (GOOD_HASH * HASH8 (a,b,c,d,e,f,g,h) + (i))
-#define LISP_HASH(obj) ((unsigned long) STORE_LISP_IN_VOID (obj))
+#define LISP_HASH(obj) ((Hashcode) STORE_LISP_IN_VOID (obj))
Hashcode memory_hash (const void *xv, Bytecount size);
Hashcode internal_hash (Lisp_Object obj, int depth, Boolint equalp);
-Hashcode internal_array_hash (Lisp_Object *arr, int size, int depth,
+Hashcode internal_array_hash (Lisp_Object *arr, Elemcount size, int depth,
Boolint equalp);
@@ -4075,7 +4096,7 @@
{
struct gcpro *next;
const Lisp_Object *var; /* Address of first protected variable */
- int nvars; /* Number of consecutive protected variables */
+ Elemcount nvars; /* Number of consecutive protected variables */
#if defined (__cplusplus) && defined (ERROR_CHECK_GC)
/* Try to catch GCPRO without UNGCPRO, or vice-versa. G++ complains (at
least with sufficient numbers of warnings enabled, i.e. -Weffc++) if a
@@ -5632,10 +5653,10 @@
EXFUN (Findent_to, 3);
EXFUN (Fvertical_motion, 3);
-int byte_spaces_at_point (struct buffer *, Bytebpos);
-int column_at_point (struct buffer *, Charbpos, int);
-int string_column_at_point (Lisp_Object, Charbpos, int);
-int current_column (struct buffer *);
+Charcount byte_spaces_at_point (struct buffer *, Bytebpos);
+Charcount column_at_point (struct buffer *, Charbpos, Charcount);
+Charcount string_column_at_point (Lisp_Object, Charbpos, Charcount);
+Charcount current_column (struct buffer *);
void invalidate_current_column (void);
Charbpos vmotion (struct window *, Charbpos, int, int *);
Charbpos vmotion_pixels (Lisp_Object, Charbpos, int, int, int *);
@@ -5654,7 +5675,7 @@
if (*len < 0)
{
if (nonreloc)
- *len = strlen ((const Chbyte *) nonreloc) - offset;
+ *len = (Bytecount) strlen ((const Chbyte *) nonreloc) - offset;
else
*len = XSTRING_LENGTH (reloc) - offset;
}
@@ -5878,7 +5899,7 @@
void debug_print (Lisp_Object);
void debug_p4 (Lisp_Object obj);
void debug_p3 (Lisp_Object obj);
-void debug_short_backtrace (int);
+void debug_short_backtrace (EMACS_INT);
void debug_backtrace (void);
MODULE_API Bytecount write_lisp_string (Lisp_Object stream, Lisp_Object string,
Bytecount offset, Bytecount len);
@@ -5899,7 +5920,8 @@
{
/* This function can GC. We'd like to qxestrlen, but that's not yet
available in this file. */
- return write_string_1 (stream, str, strlen ((const char *) str));
+ return write_string_1 (stream, str,
+ (Bytecount) strlen ((const char *) str));
}
/* Same goes for this function. */
DECLARE_INLINE_HEADER (
@@ -5909,7 +5931,7 @@
/* This function can GC. We'd like to qxestrlen, but that's not yet
available in this file. */
return write_string_1 (stream, (const Ibyte *) str,
- strlen ((const char *) str));
+ (Bytecount) strlen ((const char *) str));
}
/* Same goes for this function. */
DECLARE_INLINE_HEADER (
@@ -5917,7 +5939,8 @@
)
{
/* This function can GC. */
- return write_string_1 (stream, (const Ibyte *) str, strlen ((char *) str));
+ return write_string_1 (stream, (const Ibyte *) str,
+ (Bytecount) strlen ((char *) str));
}
Bytecount write_eistring (Lisp_Object stream, const Eistring *ei);
@@ -6031,7 +6054,8 @@
Bytebpos byte_find_next_newline_no_quit (struct buffer *, Bytebpos, int);
Bytecount byte_find_next_ichar_in_string (Lisp_Object, Ichar, Bytecount,
EMACS_INT);
-Charbpos find_before_next_newline (struct buffer *, Charbpos, Charbpos, int);
+Charbpos find_before_next_newline (struct buffer *, Charbpos, Charbpos,
+ EMACS_INT);
struct re_pattern_buffer *compile_pattern (Lisp_Object pattern,
struct re_registers *regp,
Lisp_Object translate,
@@ -6125,7 +6149,7 @@
extern Lisp_Object Vobarray;
/* Defined in syntax.c */
-Charbpos scan_words (struct buffer *, Charbpos, int);
+Charbpos scan_words (struct buffer *, Charbpos, EMACS_INT);
EXFUN (Fchar_syntax, 2);
EXFUN (Fforward_word, 2);
extern Lisp_Object Vstandard_syntax_table;
@@ -6287,7 +6311,7 @@
DECLARE_INLINE_HEADER (Bytecount qxestrlen (const Ibyte *s))
{
- return strlen ((const Chbyte *) s);
+ return (Bytecount) strlen ((const Chbyte *) s);
}
DECLARE_INLINE_HEADER (Charcount qxestrcharlen (const Ibyte *s))
@@ -6566,7 +6590,7 @@
/* Defined in undo.c */
EXFUN (Fundo_boundary, 0);
-Lisp_Object truncate_undo_list (Lisp_Object, int, int);
+Lisp_Object truncate_undo_list (Lisp_Object, Fixnum, Fixnum);
void record_extent (Lisp_Object, int);
void record_insert (struct buffer *, Charbpos, Charcount);
void record_delete (struct buffer *, Charbpos, Charcount);
@@ -6732,7 +6756,7 @@
/* This function can GC */
str = ASCGETTEXT (str);
write_string_1 (stream, (const Ibyte *) str,
- strlen ((const Ascbyte *) str));
+ (Bytecount) strlen ((const Ascbyte *) str));
}
#define write_msg_string write_msg_ascstring
diff -r 046a3f85a39d -r c5889f9bb7f4 src/lrecord.h
--- a/src/lrecord.h
+++ b/src/lrecord.h
@@ -266,7 +266,7 @@
SLI_header->type = (imp)->lrecord_type_index; \
SLI_header->lisp_readonly = 0; \
SLI_header->free = 0; \
- SLI_header->uid = lrecord_uid_counter[(imp)->lrecord_type_index]++; \
+ SLI_header->uid = lrecord_uid_counter[(imp)->lrecord_type_index]++; \
} while (0)
#else /* not NEW_GC */
#define set_lheader_implementation(header,imp) do { \
@@ -671,7 +671,7 @@
void inc_lrecord_stats (Bytecount size, const struct lrecord_header *h);
void dec_lrecord_stats (Bytecount size_including_overhead,
const struct lrecord_header *h);
-int lrecord_stats_heap_size (void);
+Bytecount lrecord_stats_heap_size (void);
#endif /* ALLOC_TYPE_STATS */
/* Tell mc-alloc how to call a finalizer. */
@@ -2094,10 +2094,10 @@
MODULE_API Lisp_Object alloc_lrecord (const struct lrecord_implementation *imp);
Lisp_Object noseeum_alloc_lrecord (const struct lrecord_implementation *imp);
-MODULE_API Lisp_Object alloc_lrecord_array (int elemcount,
+MODULE_API Lisp_Object alloc_lrecord_array (Elemcount elemcount,
const struct lrecord_implementation *imp);
MODULE_API Lisp_Object alloc_sized_lrecord_array (Bytecount size,
- int elemcount,
+ Elemcount elemcount,
const struct lrecord_implementation *imp);
#endif /* NEW_GC */
diff -r 046a3f85a39d -r c5889f9bb7f4 src/number.h
--- a/src/number.h
+++ b/src/number.h
@@ -220,7 +220,7 @@
NATNUMP. */
#ifdef HAVE_BIGNUM
-#define NATNUMP(x) ((FIXNUMP (x) && XFIXNUM (x) >= 0) || \
+#define NATNUMP(x) ((FIXNUMP (x) && XREALFIXNUM (x) >= 0) || \
(BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0))
#else
#define NATNUMP(x) (FIXNUMP (x) && XFIXNUM (x) >= 0)
diff -r 046a3f85a39d -r c5889f9bb7f4 src/print.c
--- a/src/print.c
+++ b/src/print.c
@@ -2983,9 +2983,9 @@
/* Do a "short" backtrace. */
void
-debug_short_backtrace (int length)
+debug_short_backtrace (EMACS_INT length)
{
- int first = 1;
+ Fixnum first = 1;
struct backtrace *bt = backtrace_list;
debug_out (" [");
diff -r 046a3f85a39d -r c5889f9bb7f4 src/search.c
--- a/src/search.c
+++ b/src/search.c
@@ -924,7 +924,7 @@
find_next_newline (...)-1, because you might hit TO. */
Charbpos
find_before_next_newline (struct buffer *buf, Charbpos from, Charbpos to,
- int count)
+ EMACS_INT count)
{
EMACS_INT shortage;
Charbpos pos = scan_buffer (buf, '\n', from, to, count, &shortage, 1);
diff -r 046a3f85a39d -r c5889f9bb7f4 src/syntax.c
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -750,7 +750,7 @@
COUNT negative means scan backward and stop at word beginning. */
Charbpos
-scan_words (struct buffer *buf, Charbpos from, int count)
+scan_words (struct buffer *buf, Charbpos from, EMACS_INT count)
{
Charbpos limit = count > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
Ichar ch0, ch1;
diff -r 046a3f85a39d -r c5889f9bb7f4 src/syntax.h
--- a/src/syntax.h
+++ b/src/syntax.h
@@ -142,7 +142,7 @@
/* Return the syntax code for a particular character and mirror table. */
DECLARE_INLINE_HEADER (
-int
+EMACS_INT
SYNTAX_CODE (Lisp_Object table, Ichar c)
)
{
diff -r 046a3f85a39d -r c5889f9bb7f4 src/sysdep.c
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -204,7 +204,7 @@
#ifdef NEED_SYNC_PROCESS_CODE /* #### Used only on super-ancient systems */
static void
-wait_for_termination (int pid)
+wait_for_termination (pid_t pid)
{
/* #### With the new improved SIGCHLD handling stuff, there is much
less danger of race conditions and some of the comments below
@@ -608,7 +608,7 @@
#else /* not WIN32_NATIVE */
{
- int pid;
+ pid_t pid;
struct save_signal saved_handlers[5];
saved_handlers[0].code = SIGINT;
@@ -663,7 +663,7 @@
{
#if defined (SIGTSTP)
{
- int pgrp = EMACS_GET_PROCESS_GROUP ();
+ pid_t pgrp = EMACS_GET_PROCESS_GROUP ();
EMACS_KILLPG (pgrp, SIGTSTP);
}
@@ -681,9 +681,9 @@
void
sys_suspend_process (
#ifdef SIGTSTP
- int process
+ pid_t process
#else
- int UNUSED (process)
+ pid_t UNUSED (process)
#endif
)
{
@@ -929,7 +929,7 @@
#if defined (FIOSSAIOOWN)
{ /* HPUX stuff */
- int owner = getpid ();
+ pid_t owner = getpid ();
int ioctl_status;
if (DEVICE_TTY_P (d))
{
@@ -2904,10 +2904,10 @@
}
#if defined (HAVE_READLINK)
-int
+ssize_t
qxe_readlink (const Ibyte *path, Ibyte *buf, size_t bufsiz)
{
- int retval;
+ Bytecount retval;
Extbyte *pathout;
PATHNAME_CONVERT_OUT (path, pathout);
diff -r 046a3f85a39d -r c5889f9bb7f4 src/sysfile.h
--- a/src/sysfile.h
+++ b/src/sysfile.h
@@ -383,7 +383,7 @@
int qxe_access (const Ibyte *path, int mode);
int qxe_eaccess (const Ibyte *path, int mode);
int qxe_lstat (const Ibyte *path, struct stat *buf);
-int qxe_readlink (const Ibyte *path, Ibyte *buf, size_t bufsiz);
+ssize_t qxe_readlink (const Ibyte *path, Ibyte *buf, size_t bufsiz);
int qxe_fstat (int fd, struct stat *buf);
int qxe_stat (const Ibyte *path, struct stat *buf);
Ibyte *qxe_realpath (const Ibyte *path, Ibyte resolved_path [],
diff -r 046a3f85a39d -r c5889f9bb7f4 src/text.c
--- a/src/text.c
+++ b/src/text.c
@@ -2678,8 +2678,8 @@
return changedp ? newp - newdata : 0;
}
-int
-eifind_large_enough_buffer (int oldbufsize, int needed_size)
+Bytecount
+eifind_large_enough_buffer (Bytecount oldbufsize, Bytecount needed_size)
{
while (oldbufsize < needed_size)
{
This diff is so big that we needed to truncate the remainder.
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Better range checking, decoding Lisp values,
for underlying C integer types
6 years, 8 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/046a3f85a39d/
Changeset: 046a3f85a39d
User: kehoea
Date: 2018-04-21 15:49:20+00:00
Summary: Better range checking, decoding Lisp values, for underlying C integer types
src/ChangeLog addition:
2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
* data.c:
Provide macros to generalise the two-way conversion
between C integer types and Lisp values (fixnums, bignums, conses
of fixnums and, because GNU, floats).
Use these macros to generate conversion functions for OFF_T and
for uid_t. There may be scope down the line for further types, it
needs looking into.
* dired.c (Ffile_attributes):
Use OFF_T_to_lisp here.
* editfns.c:
* editfns.c (Ftemp_directory):
* editfns.c (Fuser_login_name):
* editfns.c (Fuser_uid):
* editfns.c (Fuser_real_uid):
Use lisp_to_uid_t, uid_t_to_lisp as appropriate in these
functions.
* fileio.c:
Remove the old lisp_to_off_t(). Use the new lisp_to_OFF_T.
* number.h:
Declare the new generated conversion functions for OFF_T and for
uid_t.
tests/ChangeLog addition:
2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/os-tests.el (two-to-the-thirty-second):
Check that (user-login-name 4294967296) no longer gives "root", as
it used to do on 64-bit builds.
Affected #: 8 files
diff -r 368318a5c386 -r 046a3f85a39d src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,27 @@
+2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * data.c:
+ Provide macros to generalise the two-way conversion
+ between C integer types and Lisp values (fixnums, bignums, conses
+ of fixnums and, because GNU, floats).
+ Use these macros to generate conversion functions for OFF_T and
+ for uid_t. There may be scope down the line for further types, it
+ needs looking into.
+ * dired.c (Ffile_attributes):
+ Use OFF_T_to_lisp here.
+ * editfns.c:
+ * editfns.c (Ftemp_directory):
+ * editfns.c (Fuser_login_name):
+ * editfns.c (Fuser_uid):
+ * editfns.c (Fuser_real_uid):
+ Use lisp_to_uid_t, uid_t_to_lisp as appropriate in these
+ functions.
+ * fileio.c:
+ Remove the old lisp_to_off_t(). Use the new lisp_to_OFF_T.
+ * number.h:
+ Declare the new generated conversion functions for OFF_T and for
+ uid_t.
+
2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (NUMBER_FITS_IN_A_FIXNUM, NUMBER_FITS_IN_A_FIXNUM):
diff -r 368318a5c386 -r 046a3f85a39d src/data.c
--- a/src/data.c
+++ b/src/data.c
@@ -4099,6 +4099,217 @@
return EPHEMERONP (object) ? Qt : Qnil;
}
+/****************** Converting to and from specific C types ******************/
+
+#ifdef HAVE_BIGNUM
+#define LISP_INTEGER_TO_C_TYPE(c_type, objekt) \
+ if (INTEGERP (objekt)) \
+ do \
+ { \
+ check_integer_range (objekt, make_integer (min_lisp_to_c_type), \
+ make_integer (max_lisp_to_c_type)); \
+ if (FIXNUMP (objekt)) \
+ { \
+ return (c_type) XREALFIXNUM (objekt); \
+ } \
+ else if (BIGNUMP (objekt)) \
+ { \
+ if (sizeof (c_type) >= SIZEOF_EMACS_INT && \
+ bignum_fits_emacs_int_p (XBIGNUM_DATA (objekt))) \
+ { \
+ return (c_type) bignum_to_emacs_int (XBIGNUM_DATA \
+ (objekt)); \
+ } \
+ \
+ if (sizeof (c_type) >= sizeof (long long) && \
+ bignum_fits_llong_p (XBIGNUM_DATA (objekt))) \
+ { \
+ return (c_type) bignum_to_llong (XBIGNUM_DATA (objekt)); \
+ } \
+ \
+ if (sizeof (c_type) >= sizeof (long long) && \
+ bignum_fits_ullong_p (XBIGNUM_DATA (objekt))) \
+ { \
+ return (c_type) bignum_to_ullong (XBIGNUM_DATA (objekt)); \
+ } \
+ \
+ signal_error (Qunimplemented, \
+ "cannot decode this " #c_type, \
+ objekt); \
+ RETURN_NOT_REACHED ((c_type) -1); \
+ } \
+ } while (0)
+#define C_TYPE_TO_LISP_INTEGER(c_type, value)\
+ return make_integer (value)
+#else
+#define LISP_INTEGER_TO_C_TYPE(c_type, objekt) \
+ if (FIXNUMP (objekt)) \
+ do \
+ { \
+ EMACS_INT ival = XREALFIXNUM (objekt); \
+ \
+ if (sizeof (c_type) >= sizeof (EMACS_INT) ? \
+ ((c_type) ival < min_lisp_to_c_type || \
+ (c_type) ival > max_lisp_to_c_type) : \
+ (ival < (EMACS_INT) min_lisp_to_c_type || \
+ ival > (EMACS_INT) max_lisp_to_c_type)) \
+ { \
+ args_out_of_range_3 (objekt, \
+ make_float (min_lisp_to_c_type), \
+ make_float (max_lisp_to_c_type)); \
+ } \
+ \
+ return (c_type) ival; \
+ } while (0)
+
+#define C_TYPE_TO_LISP_INTEGER(c_type, value) \
+ if (NUMBER_FITS_IN_A_FIXNUM (value)) \
+ { \
+ return make_fixnum (value); \
+ } \
+ else \
+ { \
+ Lisp_Object result = Fcons (make_fixnum (value & 0xFFFF), Qnil); \
+ Boolint negative = value < 0; \
+ \
+ /* Only the most significant 16 bits will be negative in the \
+ constructed cons. */ \
+ value = (value >> 16); \
+ if (negative) \
+ { \
+ value = -value; \
+ } \
+ \
+ while (value) \
+ { \
+ value = value >> 16; \
+ result = Fcons (make_fixnum (value & 0xFFFF), result); \
+ } \
+ \
+ if (negative) \
+ { \
+ XSETCAR (result, make_fixnum (- (XFIXNUM (XCAR (result))))); \
+ } \
+ \
+ return result; \
+ } \
+ RETURN_NOT_REACHED ((c_type)-1)
+#endif
+
+#define DEFINE_C_INTEGER_TYPE_LISP_CONVERSION(visibility, c_type) \
+ visibility c_type \
+ lisp_to_##c_type (Lisp_Object objeto) \
+ { \
+ c_type min_lisp_to_c_type, max_lisp_to_c_type, result = 0; \
+ double dval; \
+ \
+ if (((c_type) -1) < 0) /* Signed type? */ \
+ { \
+ if (sizeof (c_type) == SIZEOF_SHORT) \
+ { \
+ max_lisp_to_c_type = (c_type) ((unsigned short) -1) / 2; \
+ min_lisp_to_c_type \
+ = (c_type) ((unsigned short)(max_lisp_to_c_type) + 1); \
+ } \
+ else if (sizeof (c_type) == SIZEOF_INT) \
+ { \
+ max_lisp_to_c_type = (c_type) ((unsigned int) -1) / 2; \
+ min_lisp_to_c_type \
+ = (c_type) ((unsigned int)(max_lisp_to_c_type) + 1); \
+ } \
+ else if (sizeof (c_type) == SIZEOF_LONG) \
+ { \
+ max_lisp_to_c_type = (c_type) (((unsigned long) -1) / 2); \
+ min_lisp_to_c_type \
+ = (c_type) ((unsigned long)(max_lisp_to_c_type) + 1); \
+ } \
+ else if (sizeof (c_type) == SIZEOF_LONG_LONG) \
+ { \
+ max_lisp_to_c_type \
+ = (c_type) (((unsigned long long) -1) / 2); \
+ min_lisp_to_c_type \
+ = (c_type) ((unsigned long long)(max_lisp_to_c_type) + 1); \
+ } \
+ else \
+ { \
+ assert (0); /* Very very very unlikely. */ \
+ } \
+ } \
+ else \
+ { \
+ min_lisp_to_c_type = 0; \
+ max_lisp_to_c_type = (c_type)(-1); \
+ } \
+ \
+ LISP_INTEGER_TO_C_TYPE (c_type, objeto); \
+ \
+ if (CONSP (objeto)) \
+ { \
+ unsigned counter = 1; \
+ Lisp_Object orig = objeto; \
+ \
+ if ((c_type)-1 < 0) \
+ { \
+ check_integer_range (XCAR (objeto), make_fixnum (-32768), \
+ make_fixnum (32767)); \
+ } \
+ else \
+ { \
+ check_integer_range (XCAR (objeto), Qzero, \
+ make_fixnum (65535)); \
+ } \
+ \
+ result = XFIXNUM (XCAR (objeto)); \
+ objeto = XCDR (objeto); \
+ \
+ while (CONSP (objeto)) \
+ { \
+ check_integer_range (XCAR (objeto), Qzero, \
+ make_fixnum (65535)); \
+ counter++; \
+ if (counter > sizeof (c_type) / 2) \
+ { \
+ invalid_argument ("Too many bits supplied " \
+ "for " #c_type, \
+ orig); \
+ } \
+ result \
+ = (result << 16) | (XFIXNUM (XCAR (objeto)) & 0xFFFF); \
+ objeto = XCDR (objeto); \
+ } \
+ \
+ return result; \
+ } \
+ \
+ dval = extract_float (objeto); \
+ result = dval; \
+ \
+ if (result < min_lisp_to_c_type || result > max_lisp_to_c_type) \
+ { \
+ args_out_of_range_3 (objeto, make_float (min_lisp_to_c_type), \
+ make_float (max_lisp_to_c_type)); \
+ } \
+ \
+ if (dval != result) \
+ { \
+ invalid_argument ("Fractional or two wide " #c_type, \
+ objeto); \
+ } \
+ \
+ return result; \
+ } \
+ \
+ visibility Lisp_Object \
+ c_type##_to_lisp (c_type value) \
+ { \
+ C_TYPE_TO_LISP_INTEGER (c_type, value); \
+ } \
+ visibility Lisp_Object c_type##_to_lisp (c_type)
+
+DEFINE_C_INTEGER_TYPE_LISP_CONVERSION (extern, OFF_T);
+
+DEFINE_C_INTEGER_TYPE_LISP_CONVERSION (extern, uid_t);
+
/************************************************************************/
/* initialization */
/************************************************************************/
diff -r 368318a5c386 -r 046a3f85a39d src/dired.c
--- a/src/dired.c
+++ b/src/dired.c
@@ -838,13 +838,13 @@
Lisp_Object directory = Qnil;
struct stat s;
char modes[10];
- Lisp_Object handler, mode, modestring = Qnil, size, gid;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object handler, mode, modestring = Qnil, size = Qzero, gid;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object uidInfo = Qnil;
Lisp_Object gidInfo = Qnil;
- GCPRO3 (filename, directory, modestring);
+ GCPRO4 (filename, directory, modestring, size);
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
@@ -900,13 +900,7 @@
#endif
}
-#ifndef HAVE_BIGNUM
- size = make_fixnum (NUMBER_FITS_IN_A_FIXNUM (s.st_size) ?
- (EMACS_INT)s.st_size : -1);
-#else
- size = make_integer (s.st_size);
-#endif
-
+ size = OFF_T_to_lisp (s.st_size);
filemodestring (&s, modes);
modestring = make_string ((Ibyte *) modes, 10);
diff -r 368318a5c386 -r 046a3f85a39d src/editfns.c
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -604,7 +604,7 @@
if (!tmpdir)
{
struct stat st;
- int myuid = getuid ();
+ uid_t myuid = getuid ();
Ibyte *login_name = user_login_name (NULL);
DECLARE_EISTRING (eipath);
Ibyte *path;
@@ -614,7 +614,7 @@
path = eidata (eipath);
if (qxe_lstat (path, &st) < 0 && errno == ENOENT)
qxe_mkdir (path, 0700); /* ignore retval -- checked next anyway. */
- if (qxe_lstat (path, &st) == 0 && (int) st.st_uid == myuid
+ if (qxe_lstat (path, &st) == 0 && st.st_uid == myuid
&& S_ISDIR (st.st_mode))
tmpdir = path;
else
@@ -665,8 +665,7 @@
if (!NILP (uid))
{
- CHECK_FIXNUM (uid);
- local_uid = XFIXNUM (uid);
+ local_uid = lisp_to_uid_t (uid);
returned_name = user_login_name (&local_uid);
}
else
@@ -750,7 +749,7 @@
*/
())
{
- return make_fixnum (geteuid ());
+ return uid_t_to_lisp (geteuid ());
}
DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
@@ -758,7 +757,7 @@
*/
())
{
- return make_fixnum (getuid ());
+ return uid_t_to_lisp (getuid ());
}
DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
diff -r 368318a5c386 -r 046a3f85a39d src/fileio.c
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -166,54 +166,6 @@
}
return build_extstring (ret, Qstrerror_encoding);
}
-
-static OFF_T
-lisp_to_off_t (Lisp_Object offset)
-{
- OFF_T result;
- double v;
-
- if (FIXNUMP (offset))
- {
- type_checking_assert (FIXNUM_VALBITS <=
- (sizeof (OFF_T) * BITS_PER_CHAR));
- return XREALFIXNUM (offset);
- }
-#ifdef HAVE_BIGNUM
- if (BIGNUMP (offset))
- {
- if (bignum_fits_emacs_int_p (XBIGNUM_DATA (offset)))
- {
- type_checking_assert (BITS_PER_EMACS_INT <=
- (sizeof (OFF_T) * BITS_PER_CHAR));
- return bignum_to_emacs_int (XBIGNUM_DATA (offset));
- }
- else if (sizeof (OFF_T) == sizeof (long long)
- && bignum_fits_llong_p (XBIGNUM_DATA (offset)))
- {
- return bignum_to_llong (XBIGNUM_DATA (offset));
- }
- else if (sizeof (OFF_T) == sizeof (unsigned long long)
- && (OFF_T)(-1) != -1
- && bignum_fits_ullong_p (XBIGNUM_DATA (offset)))
- {
- return bignum_to_ullong (XBIGNUM_DATA (offset));
- }
- }
-#endif
-
- v = extract_float (offset);
- result = v;
-
- if (result == v) /* Value bits preserved? */
- {
- return result;
- }
-
- wtaerror ("Offset not supported", offset);
- RETURN_NOT_REACHED (-1);
-}
-
static Lisp_Object
close_file_unwind (Lisp_Object fd)
@@ -3025,7 +2977,7 @@
{
start = Qzero;
}
- else if (lisp_to_off_t (start) < 0)
+ else if (lisp_to_OFF_T (start) < 0)
{
start = wrong_type_argument (Qnatnump, start);
}
@@ -3207,7 +3159,7 @@
Lisp_Object args[] = { end, start };
Lisp_Object diff = Fminus (countof (args), args);
- total = lisp_to_off_t (diff);
+ total = lisp_to_OFF_T (diff);
if (total < 0)
{
@@ -3231,7 +3183,7 @@
where it should be. */
|| (!NILP (replace) && do_speedy_insert))
{
- if (lseek (fd, lisp_to_off_t (start), 0) < 0)
+ if (lseek (fd, lisp_to_OFF_T (start), 0) < 0)
report_file_error ("Setting file position", filename);
}
@@ -3567,7 +3519,7 @@
if (NUMBERP (append))
{
whence = SEEK_SET;
- offset = lisp_to_off_t (append);
+ offset = lisp_to_OFF_T (append);
if (offset < 0)
{
dead_wrong_type_argument (Qnatnump, append);
diff -r 368318a5c386 -r 046a3f85a39d src/number.h
--- a/src/number.h
+++ b/src/number.h
@@ -437,6 +437,12 @@
extern enum number_type get_number_type (Lisp_Object);
extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);
+extern Lisp_Object OFF_T_to_lisp (OFF_T);
+extern OFF_T lisp_to_OFF_T (Lisp_Object);
+
+extern Lisp_Object uid_t_to_lisp (uid_t);
+extern uid_t lisp_to_uid_t (Lisp_Object);
+
#ifdef WITH_NUMBER_TYPES
/* promote_args() *always* converts a marker argument to a fixnum.
diff -r 368318a5c386 -r 046a3f85a39d tests/ChangeLog
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
@@ -1,3 +1,9 @@
+2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/os-tests.el (two-to-the-thirty-second):
+ Check that (user-login-name 4294967296) no longer gives "root", as
+ it used to do on 64-bit builds.
+
2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/os-tests.el (handle-call-process-cases): New.
diff -r 368318a5c386 -r 046a3f85a39d tests/automated/os-tests.el
--- a/tests/automated/os-tests.el
+++ b/tests/automated/os-tests.el
@@ -119,4 +119,14 @@
'(22803 29256))) ;; "05/10/17 09:04:24 PM"
(Check-Error args-out-of-range (encode-time 24 4 20 11 5 2017 86401))
+(let ((two-to-the-thirty-second (expt 2 32)))
+ (Skip-Test-Unless (and (integerp two-to-the-thirty-second)
+ (> two-to-the-thirty-second 0))
+ "No integers greater than #x3fffffff"
+ "Testing bit width confusion with underlying uid_t"
+ (Assert
+ (not (equal (ignore-errors
+ (user-login-name two-to-the-thirty-second))
+ "root")))))
+
;;; end of os-tests.el
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Reduce narrowing warnings,
catch non-idempotent arguments to make_integer()
6 years, 8 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/368318a5c386/
Changeset: 368318a5c386
User: kehoea
Date: 2018-04-21 13:51:37+00:00
Summary: Reduce narrowing warnings, catch non-idempotent arguments to make_integer()
src/ChangeLog addition:
2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (NUMBER_FITS_IN_A_FIXNUM, NUMBER_FITS_IN_A_FIXNUM):
* number.h (make_integer, make_unsigned_integer):
If the GCC extended expression syntax is available, use it and
__typeof__ to catch non-idempotent arguments to these arguments,
and to silence type-narrowing warnings for non-EMACS_INT
arguments.
Affected #: 3 files
diff -r 1df45726e0d6 -r 368318a5c386 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lisp.h (NUMBER_FITS_IN_A_FIXNUM, NUMBER_FITS_IN_A_FIXNUM):
+ * number.h (make_integer, make_unsigned_integer):
+ If the GCC extended expression syntax is available, use it and
+ __typeof__ to catch non-idempotent arguments to these arguments,
+ and to silence type-narrowing warnings for non-EMACS_INT
+ arguments.
+
2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
* gccache-x.c (gc_cache_hash):
diff -r 1df45726e0d6 -r 368318a5c386 src/lisp.h
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1810,11 +1810,26 @@
#define MOST_POSITIVE_FIXNUM ((EMACS_INT) MOST_POSITIVE_FIXNUM_UNSIGNED)
#define MOST_NEGATIVE_FIXNUM (-(MOST_POSITIVE_FIXNUM) - 1)
/* WARNING: evaluates its arg twice. */
+#ifdef USE_GCC_EXTENDED_EXPRESSION_SYNTAX
+#define NUMBER_FITS_IN_A_FIXNUM(num) \
+ ({ __typeof__ (num) _num = (num); \
+ assert (_num == num); /* Catch any non-idempotent argument. */ \
+ (((__typeof__ (num))-1 < 0) ? /* Signed? */ \
+ ((sizeof (_num) * BITS_PER_CHAR) <= FIXNUM_VALBITS || \
+ (((__typeof__ (num)) MOST_NEGATIVE_FIXNUM <= _num) && \
+ _num <= ((__typeof__ (num)) MOST_POSITIVE_FIXNUM))) \
+ : ((sizeof (_num) * BITS_PER_CHAR) < FIXNUM_VALBITS || \
+ (((__typeof__ (num)) 0 <= _num) && \
+ _num <= ((__typeof__ (num)) MOST_POSITIVE_FIXNUM)))); })
+#define UNSIGNED_NUMBER_FITS_IN_A_FIXNUM(num) \
+ ((num) <= (__typeof__ (num)) MOST_POSITIVE_FIXNUM_UNSIGNED)
+#else
#define NUMBER_FITS_IN_A_FIXNUM(num) \
((num) <= MOST_POSITIVE_FIXNUM && (num) >= MOST_NEGATIVE_FIXNUM)
#define UNSIGNED_NUMBER_FITS_IN_A_FIXNUM(num) \
((num) <= MOST_POSITIVE_FIXNUM_UNSIGNED)
+#endif
#ifdef USE_UNION_TYPE
# include "lisp-union.h"
#else /* !USE_UNION_TYPE */
diff -r 1df45726e0d6 -r 368318a5c386 src/number.h
--- a/src/number.h
+++ b/src/number.h
@@ -172,7 +172,18 @@
} while (0)
#ifdef HAVE_BIGNUM
-#define make_integer(x) \
+#ifdef USE_GCC_EXTENDED_EXPRESSION_SYNTAX
+#define make_integer(x) \
+ ({ __typeof__ (x) _x = (x); \
+ assert (x == _x); /* Catch non-idempotent arguments. */ \
+ (NUMBER_FITS_IN_A_FIXNUM (_x) ? make_fixnum (_x) : \
+ (((__typeof__ (x))-1 < 0) ? \
+ (sizeof (_x) > SIZEOF_LONG ? make_bignum_ll (_x) : make_bignum (_x)) \
+ : (sizeof (_x) > SIZEOF_LONG ? make_bignum_ull (_x) \
+ : make_bignum_un (_x)))); })
+#define make_unsigned_integer make_integer
+#else
+#define make_integer(x) \
(NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x) \
: (sizeof (x) > SIZEOF_LONG ? make_bignum_ll (x) : \
make_bignum ((long) x)))
@@ -180,6 +191,7 @@
(UNSIGNED_NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x) \
: (sizeof (x) > SIZEOF_LONG ? make_bignum_ull (x) : \
make_bignum_un ((unsigned long) x)))
+#endif /* USE_GCC_EXTENDED_EXPRESSION_SYNTAX */
#else
#define make_integer(x) make_fixnum (x)
#define make_unsigned_integer(x) make_fixnum ((EMACS_INT) x)
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Fix the build with g++ 6.
6 years, 8 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/1df45726e0d6/
Changeset: 1df45726e0d6
User: kehoea
Date: 2018-04-21 13:14:56+00:00
Summary: Fix the build with g++ 6.
src/ChangeLog addition:
2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
* gccache-x.c (gc_cache_hash):
* gccache-x.c (x_gc_cache_lookup):
Add a couple of casts here to placate the C++ compiler.
* text.c (rep_bytes_by_first_byte):
Don't use hexadecimal notation for 0xDEADBEEF in this table,
that causes a compile problem with C++ on a thirty-two bit
machine.
Affected #: 3 files
diff -r 78f89a29541b -r 1df45726e0d6 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2018-04-21 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * gccache-x.c (gc_cache_hash):
+ * gccache-x.c (x_gc_cache_lookup):
+ Add a couple of casts here to placate the C++ compiler.
+ * text.c (rep_bytes_by_first_byte):
+ Don't use hexadecimal notation for 0xDEADBEEF in this table,
+ that causes a compile problem with C++ on a thirty-two bit
+ machine.
+
2018-04-16 Aidan Kehoe <kehoea(a)parhasard.net>
* fileio.c (Finsert_file_contents_internal):
diff -r 78f89a29541b -r 1df45726e0d6 src/gccache-x.c
--- a/src/gccache-x.c
+++ b/src/gccache-x.c
@@ -70,7 +70,8 @@
static Hashcode
gc_cache_hash (const Hash_Table_Test * UNUSED (http), Lisp_Object arg)
{
- const struct gcv_and_mask *gcvm = GET_VOID_FROM_LISP (arg);
+ const struct gcv_and_mask *gcvm
+ = (const struct gcv_and_mask *) GET_VOID_FROM_LISP (arg);
EMACS_UINT *longs = (EMACS_UINT *) &gcvm->gcv;
Hashcode hash = gcvm->mask;
unsigned i;
@@ -218,7 +219,7 @@
e = find_htentry (STORE_VOID_IN_LISP (&gcvm), XHASH_TABLE (cache->table));
if (!HTENTRY_CLEAR_P (e))
{
- cell = GET_VOID_FROM_LISP (e->value);
+ cell = (struct gc_cache_cell *) GET_VOID_FROM_LISP (e->value);
/* Found a cell. */
#ifdef DEBUG_GC_CACHE
diff -r 78f89a29541b -r 1df45726e0d6 src/text.c
--- a/src/text.c
+++ b/src/text.c
@@ -1285,23 +1285,40 @@
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
- /* 0x80 - 0xbf are not valid first bytes */
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
- 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF, 0xDEADBEEF,
+ /* 0x80 - 0xbf are not valid first bytes. A bare 0xDEADBEEF or
+ DEADBEEF_CONSTANT without the cast runs foul of the C++ compiler. */
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT),
/* 0xc0 - 0xdf for 2-byte sequences */
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
@@ -1312,7 +1329,8 @@
0xfc - 0xfd for 6-byte sequences;
0xfe, 0xff not allowed
*/
- 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 0xDEADBEEF, 0xDEADBEEF
+ 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6,
+ (Bytecount) (DEADBEEF_CONSTANT), (Bytecount) (DEADBEEF_CONSTANT)
};
#else
/* #### Maybe this table should be derived programmatically, at least
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/cc-mode: acm: Amend c-colon-type-list-re also to handle
compound identifiers
6 years, 8 months
Bitbucket
1 new commit in cc-mode:
https://bitbucket.org/xemacs/cc-mode/commits/fa0194a2d82b/
Changeset: fa0194a2d82b
User: acm
Date: 2018-04-19 20:20:01+00:00
Summary: Amend c-colon-type-list-re also to handle compound identifiers
* cc-langs.el (c-colong-type-list-re): Amend to recognize and skip over "::"
in C++ and "." in Java.
Affected #: 1 file
diff -r 72d6f4557fdb -r fa0194a2d82b cc-langs.el
--- a/cc-langs.el
+++ b/cc-langs.el
@@ -2444,7 +2444,11 @@
;; before the ":" that starts the inherit list after "class"
;; or "struct" in C++. (Also used as default for other
;; languages.)
- "[^\]\[{}();,/#=:]*:"))
+ (if (c-lang-const c-opt-identifier-concat-key)
+ (concat "\\([^\]\[{}();,/#=:]\\|"
+ (c-lang-const c-opt-identifier-concat-key)
+ "\\)*:")
+ "[^\]\[{}();,/#=:]*:")))
(c-lang-defvar c-colon-type-list-re (c-lang-const c-colon-type-list-re))
(c-lang-defconst c-paren-nontype-kwds
Repository URL: https://bitbucket.org/xemacs/cc-mode/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Quiet some compiler warnings, src/
6 years, 8 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/78f89a29541b/
Changeset: 78f89a29541b
User: kehoea
Date: 2018-04-16 08:39:19+00:00
Summary: Quiet some compiler warnings, src/
src/ChangeLog addition:
2018-04-16 Aidan Kehoe <kehoea(a)parhasard.net>
* fileio.c (Finsert_file_contents_internal):
Be clearer about not using an unitialised OFFSET in an lseek(2)
call here.
* regex.c (re_wctype):
Match the argument types used in the declaration in regex.h, to
placate the C++ compiler.
* text.c:
Only make unicode_internal_handle_bad_ichar_to_unicode() available
on unicode-internal builds.
* tls.h (tls_negotiate):
Rework this stub macro to mark its arguments as used.
* vdb.c (Ftest_vdb):
Quiet the compiler regarding one variable here.
Affected #: 6 files
diff -r fddc26a4bf70 -r 78f89a29541b src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,19 @@
+2018-04-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fileio.c (Finsert_file_contents_internal):
+ Be clearer about not using an unitialised OFFSET in an lseek(2)
+ call here.
+ * regex.c (re_wctype):
+ Match the argument types used in the declaration in regex.h, to
+ placate the C++ compiler.
+ * text.c:
+ Only make unicode_internal_handle_bad_ichar_to_unicode() available
+ on unicode-internal builds.
+ * tls.h (tls_negotiate):
+ Rework this stub macro to mark its arguments as used.
+ * vdb.c (Ftest_vdb):
+ Quiet the compiler regarding one variable here.
+
2018-04-10 Aidan Kehoe <kehoea(a)parhasard.net>
* config.h.in:
diff -r fddc26a4bf70 -r 78f89a29541b src/fileio.c
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -3231,14 +3231,7 @@
where it should be. */
|| (!NILP (replace) && do_speedy_insert))
{
- OFF_T starting;
-
- if (NUMBERP (start))
- {
- starting = lisp_to_off_t (start);
- }
-
- if (lseek (fd, starting, 0) < 0)
+ if (lseek (fd, lisp_to_off_t (start), 0) < 0)
report_file_error ("Setting file position", filename);
}
diff -r fddc26a4bf70 -r 78f89a29541b src/regex.c
--- a/src/regex.c
+++ b/src/regex.c
@@ -2211,7 +2211,7 @@
Return RECC_ERROR if STRP doesn't match a known character class. */
re_wctype_t
-re_wctype (const re_char *beg, int limit)
+re_wctype (const unsigned char *beg, int limit)
{
/* Sort tests in the length=five case by frequency the classes to minimize
number of times we fail the comparison. The frequencies of character class
diff -r fddc26a4bf70 -r 78f89a29541b src/text.c
--- a/src/text.c
+++ b/src/text.c
@@ -1857,7 +1857,7 @@
return -1;
}
-#endif /* not UNICODE_INTERNAL */
+#else /* if defined (UNICODE_INTERNAL) */
int
unicode_internal_handle_bad_ichar_to_unicode (Ichar chr, enum converr fail)
@@ -1892,6 +1892,8 @@
}
}
+#endif /* defined (UNICODE_INTERNAL) */
+
#endif /* MULE */
/* Take a possibly invalid Ichar value (must be >= 0) and move upwards as
diff -r fddc26a4bf70 -r 78f89a29541b src/tls.h
--- a/src/tls.h
+++ b/src/tls.h
@@ -82,7 +82,8 @@
#define TLS_SETUP_SOCK 1
#define tls_open(x,y) (signal_error (Qtls_error, "TLS support unavailable", \
Qnil), (tls_state_t *) NULL)
-#define tls_negotiate(x,y,z) ((tls_state_t *) NULL)
+#define tls_negotiate(x,y,z) (USED (x), USED (y), USED (z), \
+ (tls_state_t *) NULL)
#define make_tls_input_stream(x) (signal_error (Qtls_error, \
"TLS support unavailable", \
Qnil), Qnil)
diff -r fddc26a4bf70 -r 78f89a29541b src/vdb.c
--- a/src/vdb.c
+++ b/src/vdb.c
@@ -98,6 +98,7 @@
fprintf (stderr, "Attempt to read p[666]... ");
c = p[666];
fprintf (stderr, "read ok.\n");
+ USED (c); /* Quiet compiler. */
/* Test write. */
fprintf (stderr, "Attempt to write 42 to p[666]... ");
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: 2 new changesets
6 years, 8 months
Bitbucket
2 new commits in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/f45199815d5d/
Changeset: f45199815d5d
User: kehoea
Date: 2018-04-07 20:40:47+00:00
Summary: Handle bignum START, END values as appropriate, #'insert-file-contents-internal
src/ChangeLog addition:
2018-04-07 Aidan Kehoe <kehoea(a)parhasard.net>
* fileio.c (Fsubstitute_in_file_name): Fixup some whitespace here.
* fileio.c (Finsert_file_contents_internal):
Handle bignum values for START, END. Error if the difference
between START and END means the relevant buffer would become too
big to handle.
* insdel.c (buffer_insert_string_1):
Check the new buffer size in terms of characters, not bytes.
* lstream.c (make_filedesc_stream_1):
* lstream.c (make_filedesc_input_stream):
* lstream.c (make_filedesc_output_stream):
* lstream.h:
Use the OFF_T type for the OFFSET argument to these functions,
Bytecount for the COUNT argument, as has long been the most
reasonable approach.
Affected #: 5 files
diff -r 3e52d0a8ca3d -r f45199815d5d src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,20 @@
+2018-04-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fileio.c (Fsubstitute_in_file_name): Fixup some whitespace here.
+ * fileio.c (Finsert_file_contents_internal):
+ Handle bignum values for START, END. Error if the difference
+ between START and END means the relevant buffer would become too
+ big to handle.
+ * insdel.c (buffer_insert_string_1):
+ Check the new buffer size in terms of characters, not bytes.
+ * lstream.c (make_filedesc_stream_1):
+ * lstream.c (make_filedesc_input_stream):
+ * lstream.c (make_filedesc_output_stream):
+ * lstream.h:
+ Use the OFF_T type for the OFFSET argument to these functions,
+ Bytecount for the COUNT argument, as has long been the most
+ reasonable approach.
+
2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net>
* process-unix.c:
diff -r 3e52d0a8ca3d -r f45199815d5d src/fileio.c
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1495,10 +1495,7 @@
(filename))
{
/* This function can GC. GC checked 2000-07-28 ben. */
- Ibyte *nm;
-
- Ibyte *s, *p, *o, *x, *endp, *got;
- Ibyte *target = 0;
+ Ibyte *nm, *s, *p, *o, *x, *endp, *got, *target = 0;
int total = 0;
int substituted = 0, seen_braces;
Ibyte *xnm;
@@ -2897,17 +2894,17 @@
int speccount;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object val;
- int total;
+ Bytecount total;
Ibyte *read_buf = alloca_ibytes (READ_BUF_SIZE);
int mc_count;
struct buffer *buf = current_buffer;
Lisp_Object curbuf;
- int not_regular = 0;
- int do_speedy_insert =
+ Boolint not_regular = 0, do_speedy_insert =
coding_system_is_binary (Fget_coding_system (codesys));
if (buf->base_buffer && ! NILP (visit))
- invalid_operation ("Cannot do file visiting in an indirect buffer", Qunbound);
+ invalid_operation ("Cannot do file visiting in an indirect buffer",
+ Qunbound);
/* No need to call Fbarf_if_buffer_read_only() here.
That's called in begin_multiple_change() or wherever. */
@@ -2977,12 +2974,12 @@
#endif /* S_IFREG */
if (!NILP (start))
- CHECK_FIXNUM (start);
+ CHECK_NATNUM (start);
else
start = Qzero;
if (!NILP (end))
- CHECK_FIXNUM (end);
+ CHECK_NATNUM (end);
if (fd < 0)
{
@@ -2997,20 +2994,21 @@
record_unwind_protect (close_file_unwind, make_fixnum (fd));
- /* Supposedly happens on VMS. */
- if (st.st_size < 0)
- signal_error (Qfile_error, "File size is negative", Qunbound);
-
if (NILP (end))
{
if (!not_regular)
{
- end = make_fixnum (st.st_size);
- if (XFIXNUM (end) != st.st_size)
- out_of_memory ("Maximum buffer size exceeded", Qunbound);
+ end = make_integer (st.st_size);
+ CHECK_NATNUM (end);
}
}
+ /* Supposedly happens on VMS. */
+ if (NILP (end) && st.st_size < 0)
+ {
+ signal_error (Qfile_error, "File size is negative", Qunbound);
+ }
+
/* If requested, replace the accessible part of the buffer
with the file contents. Avoid replacing text at the
beginning or end of the buffer that matches the file contents;
@@ -3097,8 +3095,8 @@
match the text at the end of the buffer. */
while (1)
{
- int total_read, nread;
- Charcount charbpos, curpos, trial;
+ Bytecount total_read, nread;
+ OFF_T charbpos, curpos, trial;
/* At what file position are we now scanning? */
curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
@@ -3146,8 +3144,8 @@
same_at_end += overlap;
/* Arrange to read only the nonmatching middle part of the file. */
- start = make_fixnum (same_at_start - BUF_BEGV (buf));
- end = make_fixnum (st.st_size - (BUF_ZV (buf) - same_at_end));
+ start = make_integer (same_at_start - BYTE_BUF_BEGV (buf));
+ end = make_integer (st.st_size - (BYTE_BUF_ZV (buf) - same_at_end));
buffer_delete_range (buf, same_at_start, same_at_end,
!NILP (visit) ? INSDEL_NO_LOCKING : 0);
@@ -3158,24 +3156,75 @@
if (!not_regular)
{
- total = XFIXNUM (end) - XFIXNUM (start);
+ Lisp_Object args[] = { end, start };
+ Lisp_Object diff = Fminus (countof (args), args);
/* Make sure point-max won't overflow after this insertion. */
- if (total != XFIXNUM (make_fixnum (total)))
- out_of_memory ("Maximum buffer size exceeded", Qunbound);
+ if (FIXNUMP (diff))
+ {
+ total = XREALFIXNUM (diff);
+ }
+#ifdef HAVE_BIGNUM
+ else if (bignum_fits_emacs_int_p (XBIGNUM_DATA (diff)))
+ {
+ total = bignum_to_emacs_int (XBIGNUM_DATA (diff));
+ }
+#endif
+ else
+ {
+ /* Doesn't fit in an EMACS_INT, which means doesn't fit in a
+ Bytecount, which means we should error. */
+ goto unreasonably_large;
+ }
+
+ if ((total > ((Bytecount) (~((EMACS_UINT) 0) >> 1))))
+ {
+ unreasonably_large:
+ out_of_memory ("Maximum buffer byte size exceeded",
+ diff);
+ }
}
else
/* For a special file, all we can do is guess. The value of -1
will make the stream functions read as much as possible. */
total = -1;
- if (XFIXNUM (start) != 0
+ if (!(EQ (start, Qzero))
/* why was this here? asked jwz. The reason is that the replace-mode
connivings above will normally put the file pointer other than
where it should be. */
|| (!NILP (replace) && do_speedy_insert))
{
- if (lseek (fd, XFIXNUM (start), 0) < 0)
+ OFF_T starting;
+
+ if (FIXNUMP (start))
+ {
+ starting = XREALFIXNUM (start);
+ }
+#ifdef HAVE_BIGNUM
+ else if (bignum_fits_emacs_int_p (XBIGNUM_DATA (start)))
+ {
+ starting = bignum_to_emacs_int (XBIGNUM_DATA (start));
+ }
+ else if (sizeof (starting) == sizeof (long long)
+ && bignum_fits_llong_p (XBIGNUM_DATA (start)))
+ {
+ starting = bignum_to_llong (XBIGNUM_DATA (start));
+ }
+ else if (sizeof (starting) == sizeof (unsigned long long)
+ && bignum_fits_ullong_p (XBIGNUM_DATA (start)))
+ {
+ starting = bignum_to_ullong (XBIGNUM_DATA (start));
+ }
+#endif
+ else
+ {
+ signal_error (Qunimplemented,
+ "File offset not supported in this XEmacs",
+ start);
+ }
+
+ if (lseek (fd, starting, 0) < 0)
report_file_error ("Setting file position", filename);
}
diff -r 3e52d0a8ca3d -r f45199815d5d src/insdel.c
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1079,10 +1079,6 @@
is a string. */
#endif
- /* Make sure that point-max won't exceed the size of an emacs int. */
- if ((length + BUF_Z (buf)) > MOST_POSITIVE_FIXNUM)
- out_of_memory ("Maximum buffer size exceeded", Qunbound);
-
/* theoretically not necessary -- caller should GCPRO.
#### buffer_insert_from_buffer_1() doesn't! */
GCPRO1 (reloc);
@@ -1129,6 +1125,12 @@
#endif /* ERROR_CHECK_TEXT */
}
+ /* Make sure that point-max won't exceed the size of an emacs int. */
+ if ((MOST_POSITIVE_FIXNUM - 1) - BUF_Z (buf) < cclen)
+ {
+ out_of_memory ("Maximum buffer size exceeded", Qunbound);
+ }
+
/* &&#### Here we check if the text can't fit into the format of the buffer,
and if so convert it to another format (either default or 32-bit-fixed,
according to some flag; if no flag, use default). */
diff -r 3e52d0a8ca3d -r f45199815d5d src/lstream.c
--- a/src/lstream.c
+++ b/src/lstream.c
@@ -1232,7 +1232,7 @@
should start at. COUNT is the number of bytes to be read (it is
ignored when writing); -1 for unlimited. */
static Lisp_Object
-make_filedesc_stream_1 (int filedesc, int offset, int count, int flags,
+make_filedesc_stream_1 (int filedesc, OFF_T offset, Bytecount count, int flags,
tls_state_t *state)
{
Lstream *lstr = Lstream_new (lstream_filedesc,
@@ -1271,16 +1271,16 @@
*/
Lisp_Object
-make_filedesc_input_stream (int filedesc, int offset, int count, int flags,
- tls_state_t *state)
+make_filedesc_input_stream (int filedesc, OFF_T offset, Bytecount count,
+ int flags, tls_state_t *state)
{
return make_filedesc_stream_1 (filedesc, offset, count,
flags | LSTR_READ, state);
}
Lisp_Object
-make_filedesc_output_stream (int filedesc, int offset, int count, int flags,
- tls_state_t *state)
+make_filedesc_output_stream (int filedesc, OFF_T offset, Bytecount count,
+ int flags, tls_state_t *state)
{
return make_filedesc_stream_1 (filedesc, offset, count,
flags | LSTR_WRITE, state);
diff -r 3e52d0a8ca3d -r f45199815d5d src/lstream.h
--- a/src/lstream.h
+++ b/src/lstream.h
@@ -507,10 +507,12 @@
Lisp_Object make_stdio_input_stream (FILE *stream, int flags);
Lisp_Object make_stdio_output_stream (FILE *stream, int flags);
-Lisp_Object make_filedesc_input_stream (int filedesc, int offset, int count,
- int flags, tls_state_t *state);
-Lisp_Object make_filedesc_output_stream (int filedesc, int offset, int count,
- int flags, tls_state_t *state);
+Lisp_Object make_filedesc_input_stream (int filedesc, OFF_T offset,
+ Bytecount count, int flags,
+ tls_state_t *state);
+Lisp_Object make_filedesc_output_stream (int filedesc, OFF_T offset,
+ Bytecount count, int flags,
+ tls_state_t *state);
void filedesc_stream_set_pty_flushing (Lstream *stream,
int pty_max_bytes,
Ibyte eof_char);
https://bitbucket.org/xemacs/xemacs/commits/f101d3bd2814/
Changeset: f101d3bd2814
User: kehoea
Date: 2018-04-10 07:03:42+00:00
Summary: Interpret a numeric APPEND as a position for lseek(), #'write-region-internal
src/ChangeLog addition:
2018-04-10 Aidan Kehoe <kehoea(a)parhasard.net>
* fileio.c (lisp_to_off_t): New function.
Decode a Lisp_Object into an OFF_T. Accept floats as well as
integers, as does GNU (they have more need to, because they don't
have bignums)
* fileio.c (Finsert_file_contents_internal):
Use it here.
* fileio.c (Fwrite_region_internal):
Interpret a numeric APPEND argument as specifying a byte offset in
the output file to seek to before writing.
lisp/ChangeLog addition:
2018-04-10 Aidan Kehoe <kehoea(a)parhasard.net>
* code-files.el (write-region):
Document that APPEND can now be a numeric offset, indicating a
point to seek to.
Affected #: 4 files
diff -r f45199815d5d -r f101d3bd2814 lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2018-04-10 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * code-files.el (write-region):
+ Document that APPEND can now be a numeric offset, indicating a
+ point to seek to.
+
2018-02-18 Aidan Kehoe <kehoea(a)parhasard.net>
* simple.el (no-case-regexp-p):
diff -r f45199815d5d -r f101d3bd2814 lisp/code-files.el
--- a/lisp/code-files.el
+++ b/lisp/code-files.el
@@ -597,8 +597,8 @@
When called from a program, takes three required arguments:
START, END and FILENAME. START and END are buffer positions.
-APPEND, if non-nil, means append to existing file contents (if any), else
- the file's existing contents are replaced by the specified region.
+APPEND, if non-nil, means append to existing file contents (if any). If it is
+a byte file offset, seek to that point before writing.
VISIT, if non-nil, should be a string naming a file. The buffer is marked
as visiting VISIT. VISIT is also the file name to lock
and unlock for clash detection.
diff -r f45199815d5d -r f101d3bd2814 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,15 @@
+2018-04-10 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fileio.c (lisp_to_off_t): New function.
+ Decode a Lisp_Object into an OFF_T. Accept floats as well as
+ integers, as does GNU (they have more need to, because they don't
+ have bignums)
+ * fileio.c (Finsert_file_contents_internal):
+ Use it here.
+ * fileio.c (Fwrite_region_internal):
+ Interpret a numeric APPEND argument as specifying a byte offset in
+ the output file to seek to before writing.
+
2018-04-07 Aidan Kehoe <kehoea(a)parhasard.net>
* fileio.c (Fsubstitute_in_file_name): Fixup some whitespace here.
diff -r f45199815d5d -r f101d3bd2814 src/fileio.c
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -167,6 +167,54 @@
return build_extstring (ret, Qstrerror_encoding);
}
+static OFF_T
+lisp_to_off_t (Lisp_Object offset)
+{
+ OFF_T result;
+ double v;
+
+ if (FIXNUMP (offset))
+ {
+ type_checking_assert (FIXNUM_VALBITS <=
+ (sizeof (OFF_T) * BITS_PER_CHAR));
+ return XREALFIXNUM (offset);
+ }
+#ifdef HAVE_BIGNUM
+ if (BIGNUMP (offset))
+ {
+ if (bignum_fits_emacs_int_p (XBIGNUM_DATA (offset)))
+ {
+ type_checking_assert (BITS_PER_EMACS_INT <=
+ (sizeof (OFF_T) * BITS_PER_CHAR));
+ return bignum_to_emacs_int (XBIGNUM_DATA (offset));
+ }
+ else if (sizeof (OFF_T) == sizeof (long long)
+ && bignum_fits_llong_p (XBIGNUM_DATA (offset)))
+ {
+ return bignum_to_llong (XBIGNUM_DATA (offset));
+ }
+ else if (sizeof (OFF_T) == sizeof (unsigned long long)
+ && (OFF_T)(-1) != -1
+ && bignum_fits_ullong_p (XBIGNUM_DATA (offset)))
+ {
+ return bignum_to_ullong (XBIGNUM_DATA (offset));
+ }
+ }
+#endif
+
+ v = extract_float (offset);
+ result = v;
+
+ if (result == v) /* Value bits preserved? */
+ {
+ return result;
+ }
+
+ wtaerror ("Offset not supported", offset);
+ RETURN_NOT_REACHED (-1);
+}
+
+
static Lisp_Object
close_file_unwind (Lisp_Object fd)
{
@@ -2973,13 +3021,14 @@
}
#endif /* S_IFREG */
- if (!NILP (start))
- CHECK_NATNUM (start);
- else
- start = Qzero;
-
- if (!NILP (end))
- CHECK_NATNUM (end);
+ if (NILP (start))
+ {
+ start = Qzero;
+ }
+ else if (lisp_to_off_t (start) < 0)
+ {
+ start = wrong_type_argument (Qnatnump, start);
+ }
if (fd < 0)
{
@@ -3146,7 +3195,6 @@
/* Arrange to read only the nonmatching middle part of the file. */
start = make_integer (same_at_start - BYTE_BUF_BEGV (buf));
end = make_integer (st.st_size - (BYTE_BUF_ZV (buf) - same_at_end));
-
buffer_delete_range (buf, same_at_start, same_at_end,
!NILP (visit) ? INSDEL_NO_LOCKING : 0);
/* Insert from the file at the proper position. */
@@ -3159,29 +3207,17 @@
Lisp_Object args[] = { end, start };
Lisp_Object diff = Fminus (countof (args), args);
- /* Make sure point-max won't overflow after this insertion. */
- if (FIXNUMP (diff))
- {
- total = XREALFIXNUM (diff);
- }
-#ifdef HAVE_BIGNUM
- else if (bignum_fits_emacs_int_p (XBIGNUM_DATA (diff)))
+ total = lisp_to_off_t (diff);
+
+ if (total < 0)
{
- total = bignum_to_emacs_int (XBIGNUM_DATA (diff));
+ dead_wrong_type_argument (Qnatnump, make_integer (total));
}
-#endif
- else
- {
- /* Doesn't fit in an EMACS_INT, which means doesn't fit in a
- Bytecount, which means we should error. */
- goto unreasonably_large;
- }
-
+
+ /* Make sure point-max won't overflow after this insertion. */
if ((total > ((Bytecount) (~((EMACS_UINT) 0) >> 1))))
{
- unreasonably_large:
- out_of_memory ("Maximum buffer byte size exceeded",
- diff);
+ out_of_memory ("Maximum buffer byte size exceeded", diff);
}
}
else
@@ -3197,32 +3233,10 @@
{
OFF_T starting;
- if (FIXNUMP (start))
- {
- starting = XREALFIXNUM (start);
- }
-#ifdef HAVE_BIGNUM
- else if (bignum_fits_emacs_int_p (XBIGNUM_DATA (start)))
- {
- starting = bignum_to_emacs_int (XBIGNUM_DATA (start));
- }
- else if (sizeof (starting) == sizeof (long long)
- && bignum_fits_llong_p (XBIGNUM_DATA (start)))
+ if (NUMBERP (start))
{
- starting = bignum_to_llong (XBIGNUM_DATA (start));
- }
- else if (sizeof (starting) == sizeof (unsigned long long)
- && bignum_fits_ullong_p (XBIGNUM_DATA (start)))
- {
- starting = bignum_to_ullong (XBIGNUM_DATA (start));
+ starting = lisp_to_off_t (start);
}
-#endif
- else
- {
- signal_error (Qunimplemented,
- "File offset not supported in this XEmacs",
- start);
- }
if (lseek (fd, starting, 0) < 0)
report_file_error ("Setting file position", filename);
@@ -3424,6 +3438,7 @@
Lisp_Object annotations = Qnil;
struct buffer *given_buffer;
Charbpos start1, end1;
+ OFF_T offset = 0;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct gcpro ngcpro1, ngcpro2;
Lisp_Object curbuf = wrap_buffer (current_buffer);
@@ -3555,13 +3570,24 @@
if (!NILP (append))
{
- if (lseek (desc, 0, 2) < 0)
+ int whence = SEEK_END;
+ if (NUMBERP (append))
+ {
+ whence = SEEK_SET;
+ offset = lisp_to_off_t (append);
+ if (offset < 0)
+ {
+ dead_wrong_type_argument (Qnatnump, append);
+ }
+ }
+
+ if (lseek (desc, offset, whence) < 0)
{
#ifdef CLASH_DETECTION
if (!auto_saving) unlock_file (lockname);
#endif /* CLASH_DETECTION */
- report_file_error ("Lseek error",
- filename);
+ report_error_with_errno (Qfile_error, "Lseek error",
+ list2 (filename, make_integer (offset)));
}
}
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.