XEmacs-Patches April 2018

xemacs-patches@xemacs.org

3 participants
15 discussions

[COMMIT] Be more careful about non-Ichar values in fastmaps, regex.c 6 years, 8 months

Aidan Kehoe

This addresses an assertion failure with make check and unicode-internal APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1523351678 -3600 # Tue Apr 10 10:14:38 2018 +0100 # Node ID b2979b81a38663cd670146fe85967107dbe9d1eb # Parent f101d3bd2814d0d11a2ff4ea21f7b80790d508fb Be more careful about non-Ichar values in fastmaps, regex.c src/ChangeLog addition: 2018-04-10 Aidan Kehoe <kehoea(a)parhasard.net> * regex.c (compile_char_class): Use CHAR_CODE_LIMIT instead of MOST_POSITIVE_FIXNUM as the upper bound for characters in the PRINT, GRAPH, NONASCII classes. * regex.c (re_compile_fastmap): Don't attempt to set_itext_ichar() with a non-character value under Unicode internal. diff -r f101d3bd2814 -r b2979b81a386 src/ChangeLog --- a/src/ChangeLog Tue Apr 10 08:03:42 2018 +0100 +++ b/src/ChangeLog Tue Apr 10 10:14:38 2018 +0100 ＠＠ -1,3 +1,12 ＠＠ +2018-04-10 Aidan Kehoe <kehoea(a)parhasard.net> + + * regex.c (compile_char_class): + Use CHAR_CODE_LIMIT instead of MOST_POSITIVE_FIXNUM as the upper + bound for characters in the PRINT, GRAPH, NONASCII classes. + * regex.c (re_compile_fastmap): + Don't attempt to set_itext_ichar() with a non-character value + under Unicode internal. + 2018-04-10 Aidan Kehoe <kehoea(a)parhasard.net> * fileio.c (lisp_to_off_t): New function. diff -r f101d3bd2814 -r b2979b81a386 src/regex.c --- a/src/regex.c Tue Apr 10 08:03:42 2018 +0100 +++ b/src/regex.c Tue Apr 10 10:14:38 2018 +0100 ＠＠ -4191,17 +4191,17 ＠＠ case RECC_PRINT: put_range_table (rtab, ' ', 0x7e, Qt); - put_range_table (rtab, 0x80, MOST_POSITIVE_FIXNUM, Qt); + put_range_table (rtab, 0x80, CHAR_CODE_LIMIT, Qt); break; case RECC_GRAPH: put_range_table (rtab, '!', 0x7e, Qt); - put_range_table (rtab, 0x80, MOST_POSITIVE_FIXNUM, Qt); + put_range_table (rtab, 0x80, CHAR_CODE_LIMIT, Qt); break; case RECC_NONASCII: case RECC_MULTIBYTE: - put_range_table (rtab, 0x80, MOST_POSITIVE_FIXNUM, Qt); + put_range_table (rtab, 0x80, CHAR_CODE_LIMIT, Qt); break; case RECC_CNTRL: ＠＠ -4401,7 +4401,7 ＠＠ set_itext_ichar (strr, last); fastmap[*strr] = 1; } - else if (MOST_POSITIVE_FIXNUM == last) + else if (CHAR_CODE_LIMIT == last) { /* This is RECC_MULTIBYTE or RECC_NONASCII; true for all non-ASCII characters. */ ＠＠ -4422,7 +4422,7 ＠＠ { Ibyte strrlast[MAX_ICHAR_LEN]; set_itext_ichar (strr, first); - set_itext_ichar (strrlast, last); + set_itext_ichar (strrlast, min (last, CHAR_CODE_LIMIT - 1)); for (jj = *strr; jj <= *strrlast; jj++) fastmap[jj] = 1; } ＠＠ -4546,7 +4546,10 ＠＠ else { Ibyte strr[MAX_ICHAR_LEN]; - Bytecount slen = set_itext_ichar (strr, last); + Bytecount slen + = set_itext_ichar (strr, + min (last, + CHAR_CODE_LIMIT - 1)); int kk; /* Same as above but for the last character using our leading byte. */ -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Interpret a numeric APPEND as a position for lseek(), #'write-region-internal 6 years, 8 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1523343822 -3600 # Tue Apr 10 08:03:42 2018 +0100 # Node ID f101d3bd2814d0d11a2ff4ea21f7b80790d508fb # Parent f45199815d5daab32f0943a69987fdd686593289 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. diff -r f45199815d5d -r f101d3bd2814 lisp/ChangeLog --- a/lisp/ChangeLog Sat Apr 07 21:40:47 2018 +0100 +++ b/lisp/ChangeLog Tue Apr 10 08:03:42 2018 +0100 ＠＠ -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 Sat Apr 07 21:40:47 2018 +0100 +++ b/lisp/code-files.el Tue Apr 10 08:03:42 2018 +0100 ＠＠ -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 Sat Apr 07 21:40:47 2018 +0100 +++ b/src/ChangeLog Tue Apr 10 08:03:42 2018 +0100 ＠＠ -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 Sat Apr 07 21:40:47 2018 +0100 +++ b/src/fileio.c Tue Apr 10 08:03:42 2018 +0100 ＠＠ -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))); } } -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Handle bignum START, END values as appropriate, #'insert-file-contents-internal 6 years, 8 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1523133647 -3600 # Sat Apr 07 21:40:47 2018 +0100 # Node ID f45199815d5daab32f0943a69987fdd686593289 # Parent 3e52d0a8ca3db32b980c27ee9d8bbc4b979af68b 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. diff -r 3e52d0a8ca3d -r f45199815d5d src/ChangeLog --- a/src/ChangeLog Fri Apr 06 14:14:46 2018 +0100 +++ b/src/ChangeLog Sat Apr 07 21:40:47 2018 +0100 ＠＠ -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 Fri Apr 06 14:14:46 2018 +0100 +++ b/src/fileio.c Sat Apr 07 21:40:47 2018 +0100 ＠＠ -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 Fri Apr 06 14:14:46 2018 +0100 +++ b/src/insdel.c Sat Apr 07 21:40:47 2018 +0100 ＠＠ -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 Fri Apr 06 14:14:46 2018 +0100 +++ b/src/lstream.c Sat Apr 07 21:40:47 2018 +0100 ＠＠ -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 Fri Apr 06 14:14:46 2018 +0100 +++ b/src/lstream.h Sat Apr 07 21:40:47 2018 +0100 ＠＠ -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); -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Avoid blowing the ARG_MAX limit on environment size, os-tests.el 6 years, 8 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1523020486 -3600 # Fri Apr 06 14:14:46 2018 +0100 # Node ID 3e52d0a8ca3db32b980c27ee9d8bbc4b979af68b # Parent eb122f8fba85ba574e69d593e95994ca0e6d2532 Avoid blowing the ARG_MAX limit on environment size, os-tests.el src/ChangeLog addition: 2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net> * process-unix.c: * process-unix.c (child_setup): When execve() fails, print the associated error message. tests/ChangeLog addition: 2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net> * automated/os-tests.el (handle-call-process-cases): New. * automated/os-tests.el : Rework the call-process-region tests, making the Assert messages on failure more helpful, and not depending on #'executable-find. Be polite after the #'substitute-in-file-name tests, remove our unreasonably large values from the process environment. diff -r eb122f8fba85 -r 3e52d0a8ca3d src/ChangeLog --- a/src/ChangeLog Thu Jan 04 21:27:22 2018 +0000 +++ b/src/ChangeLog Fri Apr 06 14:14:46 2018 +0100 ＠＠ -1,3 +1,9 ＠＠ +2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net> + + * process-unix.c: + * process-unix.c (child_setup): + When execve() fails, print the associated error message. + 2018-01-04 Aidan Kehoe <kehoea(a)parhasard.net> Move the X GC cache to using the Lisp hash table structure (as diff -r eb122f8fba85 -r 3e52d0a8ca3d src/process-unix.c --- a/src/process-unix.c Thu Jan 04 21:27:22 2018 +0000 +++ b/src/process-unix.c Fri Apr 06 14:14:46 2018 +0100 ＠＠ -896,7 +896,7 ＠＠ Lisp_Object current_dir) { Ibyte **env; - Ibyte *pwd; + Ibyte *pwd, *errmess; #ifdef SET_EMACS_PRIORITY if (emacs_priority != 0) ＠＠ -1033,7 +1033,9 ＠＠ /* we've wrapped execve; it translates its arguments */ qxe_execve (new_argv[0], new_argv, env); - stdout_out ("Can't exec program %s\n", new_argv[0]); + GET_STRERROR (errmess, errno); + + stdout_out ("Can't exec program %s: %s\n", new_argv[0], errmess); _exit (1); } diff -r eb122f8fba85 -r 3e52d0a8ca3d tests/ChangeLog --- a/tests/ChangeLog Thu Jan 04 21:27:22 2018 +0000 +++ b/tests/ChangeLog Fri Apr 06 14:14:46 2018 +0100 ＠＠ -1,3 +1,12 ＠＠ +2018-04-06 Aidan Kehoe <kehoea(a)parhasard.net> + + * automated/os-tests.el (handle-call-process-cases): New. + * automated/os-tests.el : + Rework the call-process-region tests, making the Assert messages + on failure more helpful, and not depending on #'executable-find. + Be polite after the #'substitute-in-file-name tests, remove our + unreasonably large values from the process environment. + 2017-12-24 Aidan Kehoe <kehoea(a)parhasard.net> * automated/mule-tests.el: diff -r eb122f8fba85 -r 3e52d0a8ca3d tests/automated/os-tests.el --- a/tests/automated/os-tests.el Thu Jan 04 21:27:22 2018 +0000 +++ b/tests/automated/os-tests.el Fri Apr 06 14:14:46 2018 +0100 ＠＠ -34,60 +34,45 ＠＠ ;; in <b9yoeipvwn0.fsf(a)jpl.org>. ;; tac works by lines, unfortunately -;; #### The contortions around `executable-find' gag me, but I don't have time -;; to deal today. If we have `executable-find', we should use its value! -(let* ((original-string "a\nb\nc\nd\n") - ;; `executable-find' is in a package and may be unavailable. - (tac-cases (if (and (fboundp 'executable-find) (executable-find "tac")) - '((1 . "c\nb\na\nd\n") - (3 . "a\nc\nb\nd\n") - (5 . "a\nc\nb\nd\n") - (7 . "a\nc\nb\nd\n") - (9 . "a\nd\nc\nb\n")) - nil)) - (cat-cases (if (and (fboundp 'executable-find) (executable-find "cat")) - '((1 . "b\nc\na\nd\n") - (3 . "a\nb\nc\nd\n") - (5 . "a\nb\nc\nd\n") - (7 . "a\nb\nc\nd\n") - (9 . "a\nd\nb\nc\n")) - nil)) - cases case) - (with-temp-buffer - (Skip-Test-Unless tac-cases - "tac executable not found" - "Tests of call-process-region with region deleted after inserting +(macrolet + ((handle-call-process-cases (program &rest cases) + (cons + 'progn + (loop for (pos . result) in cases + nconc `((erase-buffer) + (insert "a\nb\nc\nd\n") + (goto-char ,pos) + (Assert (eql (call-process-region 3 7 ,program t t) 0) + ,(concat "failed calling " program)) + (goto-char (point-min)) + (Assert (equal (buffer-string) ,result) + ,(format "test call-process-region, %s, pos %d, " + program pos))))))) + (with-temp-buffer + (Skip-Test-Unless + (condition-case nil (call-process "tac") (process-error nil)) + "tac executable not found" + "Tests of call-process-region with region deleted after inserting tac process output." - (setq cases tac-cases) - (while cases - (setq case (car cases) - cases (cdr cases)) - (labels ((do-test (pos result) - (erase-buffer) - (insert original-string) - (goto-char pos) - (call-process-region 3 7 "tac" t t) - (goto-char (point-min)) - (Assert (looking-at result)))) - (do-test (car case) (cdr case))))) + (handle-call-process-cases "tac" + (1 . "c\nb\na\nd\n") + (3 . "a\nc\nb\nd\n") + (5 . "a\nc\nb\nd\n") + (7 . "a\nc\nb\nd\n") + (9 . "a\nd\nc\nb\n"))) ;; if you're in that much of a hurry you can blow cat off ;; if you've done tac, but I'm not going to bother - (Skip-Test-Unless cat-cases - "cat executable not found" - "Tests of call-process-region with region deleted after inserting + (Skip-Test-Unless + (condition-case nil (call-process "cat") (process-error nil)) + "cat executable not found" + "Tests of call-process-region with region deleted after inserting cat process output." - (setq cases cat-cases) - (while cases - (setq case (car cases) - cases (cdr cases)) - (labels ((do-test (pos result) - (erase-buffer) - (insert original-string) - (goto-char pos) - (call-process-region 3 7 "cat" t t) - (goto-char (point-min)) - (Assert (looking-at result)))) - (do-test (car case) (cdr case))))))) + (handle-call-process-cases "cat" + (1 . "b\nc\na\nd\n") + (3 . "a\nb\nc\nd\n") + (5 . "a\nb\nc\nd\n") + (7 . "a\nb\nc\nd\n") + (9 . "a\nd\nb\nc\n"))))) (loop with envvar-not-existing = (symbol-name (gensym "whatever")) ＠＠ -120,8 +105,10 ＠＠ (setenv envvar-existing envvar-existing-val)) for (pre post) in examples - do - (Assert (string= post (substitute-in-file-name pre)))) + do (Assert (string= post (substitute-in-file-name pre))) + ;; Be polite and don't overrun ARG_MAX for any processes called down + ;; the line. + finally (setenv envvar-existing nil t)) ;; Check some restrictions introduced to the ZONE argument to #'encode-time. -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Use Lisp hash table implementation, gccache-x.c 6 years, 8 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1515101242 0 # Thu Jan 04 21:27:22 2018 +0000 # Node ID eb122f8fba85ba574e69d593e95994ca0e6d2532 # Parent d6fdd3ac1276b343476887b4e12d0537c9370702 Use Lisp hash table implementation, gccache-x.c src/ChangeLog addition: 2018-01-04 Aidan Kehoe <kehoea(a)parhasard.net> Move the X GC cache to using the Lisp hash table structure (as part of a more general approach to remove hash.c). Improve its hashing algorithm, giving better performance. Incorporate it directly into the x_device struct, don't allocate it separately. * console-x-impl.h: * console-x-impl.h (struct x_device): Incorporate the x_gc_cache directly here, not a pointer to it. * console-x-impl.h (DEVICE_X_GC_CACHE): Update the macro to reflect this. * device-x.c: Provide a new gc-cache hash table test object. * device-x.c (x_data_device_description): Document that the GC cache hash table is reachable from the X device for the new GC. * device-x.c (x_init_device): Init the already-allocate X GC ccache. * device-x.c (x_mark_device): Mark the table. No need to mark the other fields of the GC cache struct. * device-x.c (x_delete_device): Free the GC cache on deletion. * device-x.c (syms_of_device_x): Init the hash table test object. * device-x.c (reinit_console_type_create_device_x): * elhash.c (vars_of_elhash): Can't make the assertion about the number of built-in hash table tests any more. * gccache-x.c: Rework this file to use the Lisp hash table infrastructure and a better hashing algorithm. * gccache-x.c (gc_cache_eql): Rework this to use the Lisp hash table calling conventtion. * gccache-x.c (gc_cache_hash): Ditto. * gccache-x.c (define_gc_cache_hash_table_test): New. Provide the gc-cache Lisp hash table test. * gccache-x.c (init_x_gc_cache): Replacement for make_gc_cache. * gccache-x.c (free_x_gc_cache_entries): Renamed; Nil out the hash table. * gccache-x.c (x_gc_cache_lookup): Rename to emphasise this is the X-specific cache. * gccache-x.c (describe_gc_cache): Adjust to reflect new structures. * gccache-x.h: Move the gc cache structure here, since it's now included in the X device structure. * gccache-x.h (GC_CACHE_SIZE): This is now here and remains 100. * redisplay-x.c (x_bevel_area): * redisplay-x.c (x_output_vertical_divider): * redisplay-x.c (x_flash): * redisplay-x.c (x_output_xlike_pixmap): Call x_gc_cache_lookup() in this file, rather than gc_cache_lookup(). * redisplay-xlike-inc.c (XLIKE_get_gc): Ditto. diff -r d6fdd3ac1276 -r eb122f8fba85 src/ChangeLog --- a/src/ChangeLog Sun Feb 18 21:18:52 2018 +0000 +++ b/src/ChangeLog Thu Jan 04 21:27:22 2018 +0000 ＠＠ -1,3 +1,62 ＠＠ +2018-01-04 Aidan Kehoe <kehoea(a)parhasard.net> + + Move the X GC cache to using the Lisp hash table structure (as + part of a more general approach to remove hash.c). + Improve its hashing algorithm, giving better performance. + Incorporate it directly into the x_device struct, don't allocate + it separately. + * console-x-impl.h: + * console-x-impl.h (struct x_device): + Incorporate the x_gc_cache directly here, not a pointer to it. + * console-x-impl.h (DEVICE_X_GC_CACHE): + Update the macro to reflect this. + * device-x.c: + Provide a new gc-cache hash table test object. + * device-x.c (x_data_device_description): + Document that the GC cache hash table is reachable from the X + device for the new GC. + * device-x.c (x_init_device): + Init the already-allocate X GC ccache. + * device-x.c (x_mark_device): + Mark the table. No need to mark the other fields of the GC cache + struct. + * device-x.c (x_delete_device): + Free the GC cache on deletion. + * device-x.c (syms_of_device_x): + Init the hash table test object. + * device-x.c (reinit_console_type_create_device_x): + * elhash.c (vars_of_elhash): + Can't make the assertion about the number of built-in hash table + tests any more. + * gccache-x.c: + Rework this file to use the Lisp hash table infrastructure and a + better hashing algorithm. + * gccache-x.c (gc_cache_eql): Rework this to use the Lisp hash + table calling conventtion. + * gccache-x.c (gc_cache_hash): Ditto. + * gccache-x.c (define_gc_cache_hash_table_test): New. Provide the + gc-cache Lisp hash table test. + * gccache-x.c (init_x_gc_cache): + Replacement for make_gc_cache. + * gccache-x.c (free_x_gc_cache_entries): + Renamed; Nil out the hash table. + * gccache-x.c (x_gc_cache_lookup): + Rename to emphasise this is the X-specific cache. + * gccache-x.c (describe_gc_cache): + Adjust to reflect new structures. + * gccache-x.h: + Move the gc cache structure here, since it's now included in the X + device structure. + * gccache-x.h (GC_CACHE_SIZE): + This is now here and remains 100. + * redisplay-x.c (x_bevel_area): + * redisplay-x.c (x_output_vertical_divider): + * redisplay-x.c (x_flash): + * redisplay-x.c (x_output_xlike_pixmap): + Call x_gc_cache_lookup() in this file, rather than gc_cache_lookup(). + * redisplay-xlike-inc.c (XLIKE_get_gc): + Ditto. + 2017-12-30 Stephen J. Turnbull <stephen(a)xemacs.org> * glyphs.c (print_image_instance): Use %p for subwindow id. diff -r d6fdd3ac1276 -r eb122f8fba85 src/console-x-impl.h --- a/src/console-x-impl.h Sun Feb 18 21:18:52 2018 +0000 +++ b/src/console-x-impl.h Thu Jan 04 21:27:22 2018 +0000 ＠＠ -36,6 +36,7 ＠＠ #include "console-impl.h" #include "console-x.h" +#include "gccache-x.h" DECLARE_CONSOLE_TYPE (x); ＠＠ -55,9 +56,6 ＠＠ /* Xt application info. */ Widget Xt_app_shell; - /* Cache of GC's for frames on this device. */ - struct gc_cache *gc_cache; - /* Selected visual, depth and colormap for this device */ Visual *visual; int depth; ＠＠ -161,6 +159,9 ＠＠ KeyCode last_downkey; Time release_time; Time modifier_release_time; + + /* Cache of GCs for frames on this device. */ + struct x_gc_cache gc_cache; }; #ifdef NEW_GC ＠＠ -183,7 +184,7 ＠＠ #define DEVICE_X_DEPTH(d) (DEVICE_X_DATA (d)->depth) #define DEVICE_X_COLORMAP(d) (DEVICE_X_DATA (d)->device_cmap) #define DEVICE_XT_APP_SHELL(d) (DEVICE_X_DATA (d)->Xt_app_shell) -#define DEVICE_X_GC_CACHE(d) (DEVICE_X_DATA (d)->gc_cache) +#define DEVICE_X_GC_CACHE(d) (&(DEVICE_X_DATA (d)->gc_cache)) #define DEVICE_X_GRAY_PIXMAP(d) (DEVICE_X_DATA (d)->gray_pixmap) #define DEVICE_X_WM_COMMAND_FRAME(d) (DEVICE_X_DATA (d)->WM_COMMAND_frame) #define DEVICE_X_MOUSE_TIMESTAMP(d) (DEVICE_X_DATA (d)->mouse_timestamp) diff -r d6fdd3ac1276 -r eb122f8fba85 src/device-x.c --- a/src/device-x.c Sun Feb 18 21:18:52 2018 +0000 +++ b/src/device-x.c Thu Jan 04 21:27:22 2018 +0000 ＠＠ -73,6 +73,8 ＠＠ Lisp_Object Vx_initial_argv_list; /* #### ugh! */ +Lisp_Object Vgc_cache_hash_table_test; + /* Shut up G++ 4.3. */ #define Xrm_ODR(option,resource,type,default) \ { (String) option, (String) resource, type, default } ＠＠ -105,6 +107,9 ＠＠ static const struct memory_description x_device_data_description_1 [] = { { XD_LISP_OBJECT, offsetof (struct x_device, x_keysym_map_hash_table) }, { XD_LISP_OBJECT, offsetof (struct x_device, WM_COMMAND_frame) }, + { XD_LISP_OBJECT, offsetof (struct x_device, WM_COMMAND_frame) }, + { XD_LISP_OBJECT, offsetof (struct x_device, gc_cache) + + offsetof (struct x_gc_cache, table) }, { XD_END } }; ＠＠ -904,7 +909,8 ＠＠ init_baud_rate (d); init_one_device (d); - DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow (app_shell)); + init_x_gc_cache (d); + DEVICE_X_GRAY_PIXMAP (d) = None; Xatoms_of_device_x (d); Xatoms_of_select_x (d); ＠＠ -923,6 +929,7 ＠＠ { mark_object (DEVICE_X_WM_COMMAND_FRAME (d)); mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table); + mark_object (DEVICE_X_GC_CACHE (d)->table); } ＠＠ -959,7 +966,7 ＠＠ disable_strict_free_check (); #endif - free_gc_cache (DEVICE_X_GC_CACHE (d)); + free_x_gc_cache_entries (d); if (DEVICE_X_DATA (d)->x_modifier_keymap) XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap); if (DEVICE_X_DATA (d)->x_keysym_map) ＠＠ -2079,6 +2086,9 ＠＠ #ifdef MULE DEFSYMBOL (Qget_coding_system_from_locale); #endif + + Vgc_cache_hash_table_test = define_gc_cache_hash_table_test (); + staticpro (&Vgc_cache_hash_table_test); } void diff -r d6fdd3ac1276 -r eb122f8fba85 src/elhash.c --- a/src/elhash.c Sun Feb 18 21:18:52 2018 +0000 +++ b/src/elhash.c Thu Jan 04 21:27:22 2018 +0000 ＠＠ -2960,7 +2960,6 ＠＠ assert (!NILP (Fassq (Qeql, weak_list_list))); assert (!NILP (Fassq (Qequal, weak_list_list))); assert (!NILP (Fassq (Qequalp, weak_list_list))); - assert (4 == XFIXNUM (Flength (weak_list_list))); Vhash_table_test_weak_list = make_weak_list (WEAK_LIST_KEY_ASSOC); XWEAK_LIST_LIST (Vhash_table_test_weak_list) = weak_list_list; diff -r d6fdd3ac1276 -r eb122f8fba85 src/gccache-x.c --- a/src/gccache-x.c Sun Feb 18 21:18:52 2018 +0000 +++ b/src/gccache-x.c Thu Jan 04 21:27:22 2018 +0000 ＠＠ -55,194 +55,258 ＠＠ #include "hash.h" #include "gccache-x.h" +#include "device-impl.h" +#include "console-x-impl.h" +#include "elhash.h" -#define GC_CACHE_SIZE 100 - -#define GCCACHE_HASH +static int +gc_cache_eql (const Hash_Table_Test * UNUSED (http), + Lisp_Object arg1, Lisp_Object arg2) +{ + return !memcmp (GET_VOID_FROM_LISP (arg1), GET_VOID_FROM_LISP (arg2), + sizeof (struct gcv_and_mask)); +} -struct gcv_and_mask { - XGCValues gcv; - unsigned long mask; -}; +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); + EMACS_UINT *longs = (EMACS_UINT *) &gcvm->gcv; + Hashcode hash = gcvm->mask; + unsigned i; -struct gc_cache_cell { - GC gc; - struct gcv_and_mask gcvm; - struct gc_cache_cell *prev, *next; -}; + /* Starting from the end of the XGCValues and moving to the beginning has + eliminated collisions on my machine as of 20170417, since the foreground + and background pixels are closest to the beginning, and they vary so much + more than the dash_offset, the dashes, the clip_x_origin and so on. -struct gc_cache { - Display *dpy; /* used only as arg to XCreateGC/XFreeGC */ - Window window; /* used only as arg to XCreateGC */ - int size; - struct gc_cache_cell *head; - struct gc_cache_cell *tail; -#ifdef GCCACHE_HASH - struct hash_table *table; + There was an old comment here, from revision zero, about possibly looking + at the mask and only hashing based on the used fields. That doesn't make + sense in today's world, where branches are relatively expensive. The + below (technically a use of Duff's device, but note the initial loop + counter is a compile-time constant, and so the usual criticisms don't + apply) translates into compile-time branchless inline code as of April + 2017 with -Ofast on GCC. I don't see any faster, or, really, smaller + alternative. Aidan Kehoe, 20170417. */ + switch ((i = (unsigned) (sizeof (gcvm->gcv) / SIZEOF_EMACS_INT)) + % SIZEOF_EMACS_INT) + { + do + { + case 0: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ +#if SIZEOF_EMACS_INT > 16 +#error "unimplemented, look at the below code and copy it" #endif - - int create_count; - int delete_count; -}; +#if SIZEOF_EMACS_INT > 8 + case 15: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 14: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 13: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 12: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 11: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 10: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 9: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 8: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ +#endif +#if SIZEOF_EMACS_INT > 4 + case 7: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 6: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 5: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 4: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ +#endif + case 3: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 2: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + case 1: + hash = (hash << 1) ^ longs[--i]; + /* FALLTHROUGH */ + } while (i); + } -#ifdef GCCACHE_HASH -static Hashcode -gc_cache_hash (const void *arg) -{ - const struct gcv_and_mask *gcvm = (const struct gcv_and_mask *) arg; - unsigned long *longs = (unsigned long *) &gcvm->gcv; - Hashcode hash = gcvm->mask; - int i; - /* This could look at the mask and only use the used slots in the - hash code. That would win in that we wouldn't have to initialize - every slot of the gcv when calling gc_cache_lookup. But we need - the hash function to be as fast as possible; some timings should - be done. */ - for (i = 0; i < (int) (sizeof (XGCValues) / sizeof (unsigned long)); i++) - hash = (hash << 1) ^ *longs++; return hash; } -#endif /* GCCACHE_HASH */ - -static int -gc_cache_eql (const void *arg1, const void *arg2) +Lisp_Object +define_gc_cache_hash_table_test () { - /* See comment in gc_cache_hash */ - return !memcmp (arg1, arg2, sizeof (struct gcv_and_mask)); + return define_hash_table_test (Qunbound, gc_cache_eql, gc_cache_hash, + Qnil, Qnil); } -struct gc_cache * -make_gc_cache (Display *dpy, Window window) +void +init_x_gc_cache (struct device *d) { - struct gc_cache *cache = xnew (struct gc_cache); - cache->dpy = dpy; - cache->window = window; - cache->size = 0; - cache->head = cache->tail = 0; - cache->create_count = cache->delete_count = 0; -#ifdef GCCACHE_HASH - cache->table = - make_general_hash_table (GC_CACHE_SIZE, gc_cache_hash, gc_cache_eql); -#endif - return cache; + struct x_gc_cache *cache = DEVICE_X_GC_CACHE (d); + xzero (*cache); + cache->table = make_general_lisp_hash_table (Vgc_cache_hash_table_test, + GC_CACHE_SIZE, -1.0, -1.0, + /* Don't mark the keys and + values, don't process them + for GC. Note that this + object is marked in + x_mark_device(). */ + HASH_TABLE_WEAK); } void -free_gc_cache (struct gc_cache *cache) +free_x_gc_cache_entries (struct device *d) { - struct gc_cache_cell *rest, *next; - rest = cache->head; - while (rest) + struct x_gc_cache *cache = DEVICE_X_GC_CACHE (d); + Display *dpy = DEVICE_X_DISPLAY (d); + unsigned ii = 0; + + while (ii < cache->count) { - XFreeGC (cache->dpy, rest->gc); - next = rest->next; - xfree (rest); - rest = next; + XFreeGC (dpy, cache->cells[ii++].gc); } -#ifdef GCCACHE_HASH - free_hash_table (cache->table); -#endif - xfree (cache); + + cache->table = Qnil; /* Let the entries be GC'd, there's no value to freeing + them explicitly, they are just fixnums. */ } -GC -gc_cache_lookup (struct gc_cache *cache, XGCValues *gcv, unsigned long mask) -{ - struct gc_cache_cell *cell, *next, *prev; - struct gcv_and_mask gcvm; +/* The hotspots of this function are (in decreasing order of frequency of call): + + a) When the requested GCV and MASK reflect the most-recently-used GC. + b) When the requested GCV and MASK reflect a recently-used, but not *the* + most-recently-used GC. + c) When the requested GCV and MASK require that an old GC be evicted and a + new GC be created, since the cache is full. -#ifdef DEBUG_XEMACS - (void) describe_gc_cache (cache, DGCCFLAG_DISABLE); -#endif - - assert ((!!cache->head) == (!!cache->tail)); - assert (!(cache->head && (cache->head->prev || cache->tail->next))); + Case B) could be made faster by using a tick counter and not bothering to + adjust the LRU list for the most recent GC_CACHE_SIZE / 2 items. I don't + seee any evident possible wins for the other two cases. */ +GC +x_gc_cache_lookup (struct device *d, XGCValues *gcv, unsigned long mask) +{ + struct x_gc_cache *cache = DEVICE_X_GC_CACHE (d); + struct gc_cache_cell *cell = NULL; + struct gcv_and_mask gcvm; + htentry *e; + int next_index, prev_index; gcvm.mask = mask; gcvm.gcv = *gcv; /* this copies... */ -#ifdef GCCACHE_HASH - - /* The intermediate cast fools gcc into not outputting strict-aliasing - complaints */ - if (gethash (&gcvm, cache->table, (const void **) (void *) &cell)) - -#else /* !GCCACHE_HASH */ - - cell = cache->tail; /* start at the end (most recently used) */ - while (cell) + e = find_htentry (STORE_VOID_IN_LISP (&gcvm), XHASH_TABLE (cache->table)); + if (!HTENTRY_CLEAR_P (e)) { - if (gc_cache_eql (&gcvm, &cell->gcvm)) - break; - else - cell = cell->prev; - } + cell = GET_VOID_FROM_LISP (e->value); - /* #### This whole file needs some serious overhauling. */ - if (!(mask | GCTile) && cell->gc->values.tile) - cell = 0; - else if (!(mask | GCStipple) && cell->gc->values.stipple) - cell = 0; + /* Found a cell. */ +#ifdef DEBUG_GC_CACHE + stderr_out ("Returning %scached GC: %08lx\n", + cell == cache->tail ? "most recently used " : "", + XE_GCONTEXT(cell)); +#endif - if (cell) + if (cell == cache->tail) + return cell->gc; /* Case a) above. */ -#endif /* !GCCACHE_HASH */ - - { - /* Found a cell. Move this cell to the end of the list, so that it - will be less likely to be collected than a cell that was accessed - less recently. - */ -#if 0 - debug_out ("Returning cached GC: %08lx\n", XE_GCONTEXT(cell)); -#endif - if (cell == cache->tail) - return cell->gc; + /* Case b) above. */ + /* Move this cell to the end of the list, so that it will be less likely + to be collected than a cell that was accessed less recently. */ + next_index = cell->next_index; + prev_index = cell->prev_index; + if (prev_index != -1) + { + cache->cells[prev_index].next_index = next_index; + } + if (next_index != -1) + { + cache->cells[next_index].prev_index = prev_index; + } + if (cache->head == cell) + { + cache->head = &((cache->cells)[next_index]); + } - next = cell->next; - prev = cell->prev; - if (prev) prev->next = next; - if (next) next->prev = prev; - if (cache->head == cell) cache->head = next; - cell->next = 0; - cell->prev = cache->tail; - cache->tail->next = cell; + cell->next_index = -1; + if (cache->tail) + { + assert (cache->tail >= cache->cells); + assert ((cache->tail - cache->cells) < GC_CACHE_SIZE); + cell->prev_index = (cache->tail - cache->cells); + } + else + { + cell->prev_index = -1; + } + + assert ((cell - cache->cells) < GC_CACHE_SIZE); + + cache->tail->next_index = cell - cache->cells; cache->tail = cell; + assert (cache->head != cell); - assert (!cell->next); - assert (!cache->head->prev); - assert (!cache->tail->next); + assert (cache->head->prev_index == -1); + assert (cache->tail->next_index == -1); + return cell->gc; } + assert ((!!cache->head) == (!!cache->tail)); + assert (!(cache->head && (cache->head->prev_index != -1 + || cache->tail->next_index != -1))); + +#ifdef DEBUG_GC_CACHE + (void) describe_gc_cache (cache, + DGCCFLAG_SUMMARY | DGCCFLAG_LIST_CELLS); +#endif + /* else, cache miss. */ - if (cache->size == GC_CACHE_SIZE) + if (cache->count == GC_CACHE_SIZE) /* Reuse the first cell on the list (least-recently-used). - Remove it from the list, and unhash it from the table. - */ + Remove it from the list, and unhash it from the table. */ { cell = cache->head; - cache->head = cell->next; - cache->head->prev = 0; + cache->head = &((cache->cells)[cell->next_index]); + cache->head->prev_index = -1; if (cache->tail == cell) cache->tail = 0; /* only one */ -#if 0 - debug_out ("Cache full, freeing GC: %08lx\n ", XE_GCONTEXT(cell)); +#ifdef DEBUG_XEMACS +#ifdef DEBUG_GC_CACHE + stderr_out ("Cache full, freeing GC: %08lx\n ", XE_GCONTEXT(cell)); #endif - XFreeGC (cache->dpy, cell->gc); cache->delete_count++; -#ifdef GCCACHE_HASH - remhash (&cell->gcvm, cache->table); #endif + XFreeGC (DEVICE_X_DISPLAY (d), cell->gc); + + Fremhash (STORE_VOID_IN_LISP (&gcvm), cache->table); } - else if (cache->size > GC_CACHE_SIZE) - ABORT (); else { - /* Allocate a new cell (don't put it in the list or table yet). */ - cell = xnew (struct gc_cache_cell); - cache->size++; + assert (cache->count < GC_CACHE_SIZE); + + /* Reserve a new cell (don't put it in the list or table yet). */ + cell = &(cache->cells[cache->count++]); } /* Now we've got a cell (new or reused). Fill it in. */ ＠＠ -250,26 +314,32 ＠＠ cell->gcvm.mask = mask; /* Put the cell on the end of the list. */ - cell->next = 0; - cell->prev = cache->tail; - if (cache->tail) cache->tail->next = cell; + cell->next_index = -1; + cell->prev_index = cache->tail ? (cache->tail - cache->cells) : -1; + if (cache->tail) cache->tail->next_index = (cell - cache->cells); cache->tail = cell; - if (! cache->head) cache->head = cell; + if (! (cache->head)) cache->head = cell; +#ifdef DEBUG_XEMACS cache->create_count++; -#ifdef GCCACHE_HASH - /* Hash it in the table */ - puthash (&cell->gcvm, cell, cache->table); #endif + /* Hash it in the table. */ + Fputhash (STORE_VOID_IN_LISP (&cell->gcvm), STORE_VOID_IN_LISP (cell), + cache->table); + /* Now make and return the GC. */ - cell->gc = XCreateGC (cache->dpy, cache->window, mask, gcv); + cell->gc = XCreateGC (DEVICE_X_DISPLAY (d), + XtWindow (DEVICE_XT_APP_SHELL (d)), + mask, gcv); +#ifdef DEBUG_XEMACS /* debug */ - assert (cell->gc == gc_cache_lookup (cache, gcv, mask)); + assert (cell->gc == x_gc_cache_lookup (d, gcv, mask)); -#if 0 - debug_out ("Returning new GC: %08lx\n ", XE_GCONTEXT(cell)); +#ifdef DEBUG_GC_CACHE + stderr_out ("Returning new GC: %08lx\n ", XE_GCONTEXT (cell)); +#endif #endif return cell->gc; } ＠＠ -289,30 +359,33 ＠＠ maintainers are currently interested in seeing. */ void -describe_gc_cache (struct gc_cache *cache, int flags) +describe_gc_cache (struct x_gc_cache *cache, int flags) { - int count = 0; + unsigned count = 0; struct gc_cache_cell *cell = cache->head; if (!(flags & DGCCFLAG_SUMMARY)) return; - stderr_out ("\nsize: %d", cache->size); - stderr_out ("\ncreated: %d", cache->create_count); - stderr_out ("\ndeleted: %d", cache->delete_count); + stderr_out ("\nsize: %u", cache->count); + stderr_out ("\ncreated: %u", cache->create_count); + stderr_out ("\ndeleted: %u", cache->delete_count); if (flags & DGCCFLAG_LIST_CELLS) while (cell) { struct gc_cache_cell *cell2; - int i = 0; - stderr_out ("\n%d:\t0x%lx GC: 0x%08lx hash: 0x%08lx\n", - count, (long) cell, (long) XE_GCONTEXT(cell), - gc_cache_hash (&cell->gcvm)); + unsigned i = 0; + stderr_out ("\n%u:\t%p GC: 0x%08lx hash: 0x%08lx\n", + count, cell, XE_GCONTEXT (cell), + gc_cache_hash (NULL, STORE_VOID_IN_LISP (&cell->gcvm))); - for (cell2 = cache->head; cell2; cell2 = cell2->next, i++) + for (cell2 = cache->head; cell2; + (cell2 = ((cell2->next_index == -1) ? NULL : + &(cache->cells[cell2->next_index]))), i++) if (count != i && - gc_cache_hash (&cell->gcvm) == gc_cache_hash (&cell2->gcvm)) - stderr_out ("\tHASH COLLISION with cell %d\n", i); + gc_cache_hash (NULL, STORE_VOID_IN_LISP (&cell->gcvm)) + == gc_cache_hash (NULL, STORE_VOID_IN_LISP (&cell2->gcvm))) + stderr_out ("\tHASH COLLISION with cell %u\n", i); stderr_out ("\tmask: %8lx\n", cell->gcvm.mask); if (flags & DGCCFLAG_CELL_DETAILS) ＠＠ -347,15 +420,16 ＠＠ } count++; - if (cell->next && cell == cache->tail) + if (cell->next_index != -1 && cell == cache->tail) stderr_out ("\nERROR! tail is here!\n\n"); - else if (!cell->next && cell != cache->tail) + else if (cell->next_index == -1 && cell != cache->tail) stderr_out ("\nERROR! tail is not at the end\n\n"); - cell = cell->next; + cell = (cell->next_index == -1) ? NULL : + &(cache->cells[cell->next_index]); } /* while (cell) */ - if (count != cache->size) - stderr_out ("\nERROR! count should be %d\n\n", cache->size); + if (count != cache->count) + stderr_out ("\nERROR! count should be %u\n\n", cache->count); } #endif /* DEBUG_XEMACS */ diff -r d6fdd3ac1276 -r eb122f8fba85 src/gccache-x.h --- a/src/gccache-x.h Sun Feb 18 21:18:52 2018 +0000 +++ b/src/gccache-x.h Thu Jan 04 21:27:22 2018 +0000 ＠＠ -26,16 +26,51 ＠＠ #include <X11/Xlib.h> -struct gc_cache; -struct gc_cache *make_gc_cache (Display *, Window); -void free_gc_cache (struct gc_cache *cache); -GC gc_cache_lookup (struct gc_cache *, XGCValues *, unsigned long mask); +#define GC_CACHE_SIZE 100 + +struct gcv_and_mask { + XGCValues gcv; + unsigned long mask; +}; + +struct gc_cache_cell { + struct gcv_and_mask gcvm; + GC gc; + INT_16_BIT prev_index, next_index; +}; + +struct x_gc_cache { + /* This is marked in x_mark_device(). */ + Lisp_Object table; + + struct gc_cache_cell *head; + struct gc_cache_cell *tail; + + Display *dpy; + Window window; + + UINT_16_BIT count; + +#ifdef DEBUG_XEMACS + UINT_16_BIT create_count; + UINT_16_BIT delete_count; +#endif + + struct gc_cache_cell cells[GC_CACHE_SIZE]; +}; + +void init_x_gc_cache (struct device *); +void free_x_gc_cache_entries (struct device *); +GC x_gc_cache_lookup (struct device *, XGCValues *, unsigned long mask); #define XE_GCONTEXT(cell) (XGContextFromGC(cell->gc)) +extern Lisp_Object Vgc_cache_hash_table_test; +extern Lisp_Object define_gc_cache_hash_table_test (void); + #ifdef DEBUG_XEMACS -void describe_gc_cache (struct gc_cache *cache, int flags); +void describe_gc_cache (struct x_gc_cache *, int flags); #define DGCCFLAG_DISABLE 0 #define DGCCFLAG_SUMMARY 1 << 0 ＠＠ -43,6 +78,7 ＠＠ #define DGCCFLAG_CELL_DETAILS 1 << 2 /* A combination of the flags above. */ #define DGCCFLAG_DEFAULT DGCCFLAG_SUMMARY | DGCCFLAG_LIST_CELLS -#endif + +#endif /* DEBUG_XEMACS */ #endif /* INCLUDED_gccache_x_h_ */ diff -r d6fdd3ac1276 -r eb122f8fba85 src/redisplay-x.c --- a/src/redisplay-x.c Sun Feb 18 21:18:52 2018 +0000 +++ b/src/redisplay-x.c Thu Jan 04 21:27:22 2018 +0000 ＠＠ -654,8 +654,8 ＠＠ /* this is needed because the GC draws with a pixmap here */ gcv.fill_style = FillOpaqueStippled; gcv.stipple = DEVICE_X_GRAY_PIXMAP (d); - top_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, - (mask | GCStipple | GCFillStyle)); + top_shadow_gc = x_gc_cache_lookup (d, &gcv, + (mask | GCStipple | GCFillStyle)); tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, findex); tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); ＠＠ -667,11 +667,11 ＠＠ else { gcv.foreground = top_shadow_pixel; - top_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); + top_shadow_gc = x_gc_cache_lookup (d, &gcv, mask); } gcv.foreground = bottom_shadow_pixel; - bottom_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); + bottom_shadow_gc = x_gc_cache_lookup (d, &gcv, mask); if (use_pixmap && flip_gcs) { ＠＠ -681,7 +681,7 ＠＠ } gcv.foreground = background_pixel; - background_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); + background_gc = x_gc_cache_lookup (d, &gcv, mask); /* possibly revert the GC's This will give a depressed look to the divider */ ＠＠ -958,7 +958,7 ＠＠ gcv.graphics_exposures = False; mask = XLIKE_GC_FOREGROUND | XLIKE_GC_BACKGROUND | XLIKE_GC_EXPOSURES; - background_gc = gc_cache_lookup (DEVICE_XLIKE_GC_CACHE (d), &gcv, mask); + background_gc = x_gc_cache_lookup (d, &gcv, mask); /* Clear the divider area first. This needs to be done when a window split occurs. */ ＠＠ -1046,7 +1046,7 ＠＠ XLIKE_SET_GC_PIXEL (gcv.foreground, tmp_fcolor ^ tmp_bcolor); gcv.function = XLIKE_GX_XOR; gcv.graphics_exposures = False; - gc = gc_cache_lookup (DEVICE_XLIKE_GC_CACHE (XDEVICE (f->device)), &gcv, + gc = x_gc_cache_lookup (XDEVICE (f->device), &gcv, XLIKE_GC_FOREGROUND | XLIKE_GC_FUNCTION | XLIKE_GC_EXPOSURES); default_face_width_and_height (frame, 0, &flash_height); ＠＠ -1322,7 +1322,7 ＠＠ */ } - gc = gc_cache_lookup (DEVICE_XLIKE_GC_CACHE (d), &gcv, pixmap_mask); + gc = x_gc_cache_lookup (d, &gcv, pixmap_mask); /* depth of 0 means it's a bitmap, not a pixmap, and we should use XCopyPlane (1 = current foreground color, 0 = background) instead diff -r d6fdd3ac1276 -r eb122f8fba85 src/redisplay-xlike-inc.c --- a/src/redisplay-xlike-inc.c Sun Feb 18 21:18:52 2018 +0000 +++ b/src/redisplay-xlike-inc.c Thu Jan 04 21:27:22 2018 +0000 ＠＠ -552,7 +552,7 ＠＠ #if 0 debug_out ("\nx_get_gc: calling gc_cache_lookup\n"); #endif - return gc_cache_lookup (DEVICE_XLIKE_GC_CACHE (d), &gcv, mask); + return x_gc_cache_lookup (d, &gcv, mask); } #endif -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches April 2018