/* Lisp object printing and output streams.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
static Lisp_Object Qfloat_output_format;
#include <math.h>
-
-#if STDC_HEADERS
#include <float.h>
-#endif
#include <ftoastr.h>
/* Default to values appropriate for IEEE floating point. */
} \
else \
{ \
- print_buffer_size = 1000; \
- print_buffer = (char *) xmalloc (print_buffer_size); \
+ ptrdiff_t new_size = 1000; \
+ print_buffer = (char *) xmalloc (new_size); \
+ print_buffer_size = new_size; \
free_print_buffer = 1; \
} \
print_buffer_pos = 0; \
if (NILP (fun))
{
- if (print_buffer_pos_byte + len >= print_buffer_size)
- print_buffer = (char *) xrealloc (print_buffer,
- print_buffer_size *= 2);
+ if (print_buffer_size - len <= print_buffer_pos_byte)
+ {
+ ptrdiff_t new_size;
+ if (STRING_BYTES_BOUND / 2 < print_buffer_size)
+ string_overflow ();
+ new_size = print_buffer_size * 2;
+ print_buffer = (char *) xrealloc (print_buffer, new_size);
+ print_buffer_size = new_size;
+ }
memcpy (print_buffer + print_buffer_pos_byte, str, len);
print_buffer_pos += 1;
print_buffer_pos_byte += len;
if (NILP (printcharfun))
{
- if (print_buffer_pos_byte + size_byte > print_buffer_size)
+ if (print_buffer_size - size_byte < print_buffer_pos_byte)
{
- print_buffer_size = print_buffer_size * 2 + size_byte;
- print_buffer = (char *) xrealloc (print_buffer,
- print_buffer_size);
+ ptrdiff_t new_size;
+ if (STRING_BYTES_BOUND / 2 - size_byte < print_buffer_size)
+ string_overflow ();
+ new_size = print_buffer_size * 2 + size_byte;
+ print_buffer = (char *) xrealloc (print_buffer, new_size);
+ print_buffer_size = new_size;
}
memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
print_buffer_pos += size;
printcharfun = Vprin1_to_string_buffer;
PRINTPREPARE;
print (object, printcharfun, NILP (noescape));
- /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
+ /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
PRINTFINISH;
}
{
width = 0;
do
- width = (width * 10) + (*cp++ - '0');
+ {
+ width = (width * 10) + (*cp++ - '0');
+ if (DBL_DIG < width)
+ goto lose;
+ }
while (*cp >= '0' && *cp <= '9');
/* A precision of zero is valid only for %f. */
- if (width > DBL_DIG
- || (width == 0 && *cp != 'f'))
+ if (width == 0 && *cp != 'f')
goto lose;
}
Maybe a better way to do that is to copy elements to
a new hash table. */
struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
- int i;
+ EMACS_INT i;
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i))
static void
print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
{
- char buf[40];
+ char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
+ max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
+ 40))];
QUIT;
else
confusing = 0;
+ size_byte = SBYTES (name);
+
if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
{
PRINTCHAR ('#');
PRINTCHAR (':');
}
-
- size_byte = SBYTES (name);
+ else if (size_byte == 0)
+ {
+ PRINTCHAR ('#');
+ PRINTCHAR ('#');
+ break;
+ }
for (i = 0, i_byte = 0; i_byte < size_byte;)
{
{
if (c == '\"' || c == '\\' || c == '\''
|| c == ';' || c == '#' || c == '(' || c == ')'
- || c == ',' || c =='.' || c == '`'
+ || c == ',' || c == '.' || c == '`'
|| c == '[' || c == ']' || c == '?' || c <= 040
|| confusing)
PRINTCHAR ('\\'), confusing = 0;
PRINTCHAR ('(');
{
- EMACS_INT print_length;
- int i;
+ printmax_t i, print_length;
Lisp_Object halftail = obj;
/* Negative values of print-length are invalid in CL.
if (NATNUMP (Vprint_length))
print_length = XFASTINT (Vprint_length);
else
- print_length = 0;
+ print_length = TYPE_MAXIMUM (printmax_t);
i = 0;
while (CONSP (obj))
/* Detect circular list. */
if (NILP (Vprint_circle))
{
- /* Simple but imcomplete way. */
+ /* Simple but incomplete way. */
if (i != 0 && EQ (obj, halftail))
{
- sprintf (buf, " . #%d", i / 2);
+ sprintf (buf, " . #%"pMd, i / 2);
strout (buf, -1, -1, printcharfun);
goto end_of_list;
}
}
}
- if (i++)
+ if (i)
PRINTCHAR (' ');
- if (print_length && i > print_length)
+ if (print_length <= i)
{
strout ("...", 3, 3, printcharfun);
goto end_of_list;
}
+ i++;
print_object (XCAR (obj), printcharfun, escapeflag);
obj = XCDR (obj);
}
else if (BOOL_VECTOR_P (obj))
{
- register int i;
+ ptrdiff_t i;
register unsigned char c;
struct gcpro gcpro1;
EMACS_INT size_in_chars
PRINTCHAR (' ');
strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun);
PRINTCHAR (' ');
- sprintf (buf, "%ld/%ld", (long) h->count,
- (long) ASIZE (h->next));
+ sprintf (buf, "%"pI"d/%"pI"d", h->count, ASIZE (h->next));
strout (buf, -1, -1, printcharfun);
}
- sprintf (buf, " 0x%lx", (unsigned long) h);
+ sprintf (buf, " %p", h);
strout (buf, -1, -1, printcharfun);
PRINTCHAR ('>');
#endif
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
/* Always print the size. */
- sprintf (buf, "#s(hash-table size %ld",
- (long) ASIZE (h->next));
+ sprintf (buf, "#s(hash-table size %"pI"d", ASIZE (h->next));
strout (buf, -1, -1, printcharfun);
if (!NILP (h->test))
case Lisp_Misc_Save_Value:
strout ("#<save_value ", -1, -1, printcharfun);
- sprintf(buf, "ptr=%p int=%d",
- XSAVE_VALUE (obj)->pointer,
- XSAVE_VALUE (obj)->integer);
+ sprintf (buf, "ptr=%p int=%"pD"d",
+ XSAVE_VALUE (obj)->pointer,
+ XSAVE_VALUE (obj)->integer);
strout (buf, -1, -1, printcharfun);
PRINTCHAR ('>');
break;
if (MISCP (obj))
sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
else if (VECTORLIKEP (obj))
- sprintf (buf, "(PVEC 0x%08lx)", (unsigned long) ASIZE (obj));
+ sprintf (buf, "(PVEC 0x%08"pI"x)", ASIZE (obj));
else
sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
strout (buf, -1, -1, printcharfun);
void
syms_of_print (void)
{
- Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook");
- staticpro (&Qtemp_buffer_setup_hook);
+ DEFSYM (Qtemp_buffer_setup_hook, "temp-buffer-setup-hook");
DEFVAR_LISP ("standard-output", Vstandard_output,
doc: /* Output stream `print' uses by default for outputting a character.
or a marker (output is inserted and the marker is advanced)
or the symbol t (output appears in the echo area). */);
Vstandard_output = Qt;
- Qstandard_output = intern_c_string ("standard-output");
- staticpro (&Qstandard_output);
+ DEFSYM (Qstandard_output, "standard-output");
DEFVAR_LISP ("float-output-format", Vfloat_output_format,
doc: /* The format descriptor string used to print floats.
A value of nil means to use the shortest notation
that represents the number without losing information. */);
Vfloat_output_format = Qnil;
- Qfloat_output_format = intern_c_string ("float-output-format");
- staticpro (&Qfloat_output_format);
+ DEFSYM (Qfloat_output_format, "float-output-format");
DEFVAR_LISP ("print-length", Vprint_length,
doc: /* Maximum length of list to print before abbreviating.
defsubr (&Sredirect_debugging_output);
#endif
- Qexternal_debugging_output = intern_c_string ("external-debugging-output");
- staticpro (&Qexternal_debugging_output);
-
- Qprint_escape_newlines = intern_c_string ("print-escape-newlines");
- staticpro (&Qprint_escape_newlines);
-
- Qprint_escape_multibyte = intern_c_string ("print-escape-multibyte");
- staticpro (&Qprint_escape_multibyte);
-
- Qprint_escape_nonascii = intern_c_string ("print-escape-nonascii");
- staticpro (&Qprint_escape_nonascii);
+ DEFSYM (Qexternal_debugging_output, "external-debugging-output");
+ DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
+ DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
+ DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
print_prune_charset_plist = Qnil;
staticpro (&print_prune_charset_plist);
HCoop / bpt / emacs.git / blobdiff