From c2817dc93bdc6e1b459047f015bd2f3cfeed9938 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Thu, 16 Nov 2017 03:43:12 +0530 Subject: [PATCH 1/9] Convert `close' ref to xref. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/ref/api-io.texi (Ports): Convert `close' ref to xref. Signed-off-by: Ludovic Courtès --- doc/ref/api-io.texi | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index 9bd78d229..24890a12e 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -115,9 +115,8 @@ Return @code{#t} if @var{x} is an output port, otherwise return Close the specified port object. Return @code{#t} if it successfully closes a port or @code{#f} if it was already closed. An exception may be raised if an error occurs, for example when flushing buffered output. -@xref{Buffering}, for more on buffered output. See also @ref{Ports and -File Descriptors, close}, for a procedure which can close file -descriptors. +@xref{Buffering}, for more on buffered output. @xref{Ports and File +Descriptors, close}, for a procedure which can close file descriptors. @end deffn @deffn {Scheme Procedure} port-closed? port From 1be85ca008fd9f79a957ab033582f9b8b9ff587b Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Thu, 16 Nov 2017 18:48:37 +0530 Subject: [PATCH 2/9] Mention (ice-9 peg) module path. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/ref/api-peg.texi (PEG Parsing): Mention (ice-9 peg) module path. Signed-off-by: Ludovic Courtès --- doc/ref/api-peg.texi | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/doc/ref/api-peg.texi b/doc/ref/api-peg.texi index 0e16aab7e..cbe3edd34 100644 --- a/doc/ref/api-peg.texi +++ b/doc/ref/api-peg.texi @@ -17,11 +17,12 @@ Wikipedia has a clear and concise introduction to PEGs if you want to familiarize yourself with the syntax: @url{http://en.wikipedia.org/wiki/Parsing_expression_grammar}. -The module works by compiling PEGs down to lambda expressions. These -can either be stored in variables at compile-time by the define macros -(@code{define-peg-pattern} and @code{define-peg-string-patterns}) or calculated -explicitly at runtime with the compile functions -(@code{compile-peg-pattern} and @code{peg-string-compile}). +The @code{(ice-9 peg)} module works by compiling PEGs down to lambda +expressions. These can either be stored in variables at compile-time by +the define macros (@code{define-peg-pattern} and +@code{define-peg-string-patterns}) or calculated explicitly at runtime +with the compile functions (@code{compile-peg-pattern} and +@code{peg-string-compile}). They can then be used for either parsing (@code{match-pattern}) or searching (@code{search-for-pattern}). For convenience, @code{search-for-pattern} From f92888853439a8ded221f3423865c78de2a96a14 Mon Sep 17 00:00:00 2001 From: Sergei Trofimovich Date: Sun, 5 Nov 2017 09:30:45 +0000 Subject: [PATCH 3/9] ia64: Fix crash in thread context switch. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes and . Backtrace looks like that: Program terminated with signal SIGSEGV, Segmentation fault. #0 0x200000000014a5c0 in scm_ia64_longjmp (JB=0x6000000000817020, VAL=1) at continuations.c:372 372 t->pending_rbs_continuation->backing_store, [Current thread is 1 (Thread 0x2000000000049340 (LWP 8190))] (gdb) bt #0 0x200000000014a5c0 in scm_ia64_longjmp (JB=0x6000000000817020, VAL=1) at continuations.c:372 #1 0x2000000000148e00 in scm_c_abort (vm=0x60000000000edea0, tag=0x6000000000795ba0, n=0, argv=0x60000fffff7f0ce0, cookie=-1) at control.c:239 #2 0x2000000000149070 in scm_at_abort (tag=0x6000000000795ba0, args=0x304) at control.c:258 (gdb) print t $2 = (scm_i_thread *) 0x6000000000068000 (gdb) print t->pending_rbs_continuation $3 = (scm_t_contregs *) 0xffeb The problem here is the value of 't->pending_rbs_continuation' pointer. It's supposed to poin to a register stack pointer or be NULL if not yet backed up. The problem is it is never initialized to NULL at creation time and contained garbage on stack. Sometimes people are lucky and have zeros on stack and guile works. But sometimes there is something and guile crashes. The fix is trivial: initialize 'pending_rbs_continuation = NULL' at thread registration time (the same way other threads are registered). Reported-by: Matt Turner * libguile/threads.c (guilify_self_1): Initialize pending_rbs_continuation to avoid crash on ia64. Signed-off-by: Sergei Trofimovich Signed-off-by: Ludovic Courtès --- libguile/threads.c | 1 + 1 file changed, 1 insertion(+) diff --git a/libguile/threads.c b/libguile/threads.c index 9ceb5b88a..770f62c44 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -395,6 +395,7 @@ guilify_self_1 (struct GC_stack_base *base, int needs_unregister) t.base = base->mem_base; #ifdef __ia64__ t.register_backing_store_base = base->reg_base; + t.pending_rbs_continuation = 0; #endif t.continuation_root = SCM_EOL; t.continuation_base = t.base; From 3e7c80a62f760d2110dc19975eb588dd7526a326 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sat, 14 Oct 2017 12:16:54 -0400 Subject: [PATCH 4/9] scripts: help: Fix reference to the "Using Guile Tools" node. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . * module/scripts/help.scm (list-commands): Fix reference to the "Using Guile Tools" node. Signed-off-by: Ludovic Courtès --- module/scripts/help.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/module/scripts/help.scm b/module/scripts/help.scm index 4e0f47c32..34400db3a 100644 --- a/module/scripts/help.scm +++ b/module/scripts/help.scm @@ -115,7 +115,7 @@ For help on a specific command, try \"guild help COMMAND\". Report guild bugs to ~a GNU Guile home page: General help using GNU software: -For complete documentation, run: info guile 'Using Guile Tools' +For complete documentation, run: info '(guile)Using Guile Tools' " %guile-bug-report-address)) (define (module-commentary mod) From bb5d316b161add31612e6afe41e5a6ea5851c277 Mon Sep 17 00:00:00 2001 From: Matt Wette Date: Wed, 22 Nov 2017 16:32:39 +0100 Subject: [PATCH 5/9] foreign: Add 'uintptr_t' and 'intptr_t'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * libguile/foreign.c (scm_uintptr_t, scm_intptr_t): New variables. (scm_init_foreign): Define them. * module/system/foreign.scm: Export 'intptr_t' and 'uintptr_t'. * doc/ref/api-foreign.texi (Foreign Types): Document them. Co-authored-by: Ludovic Courtès --- doc/ref/api-foreign.texi | 2 ++ libguile/foreign.c | 22 ++++++++++++++++++++++ module/system/foreign.scm | 1 + 3 files changed, 25 insertions(+) diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi index bb93d6d1f..d99a33300 100644 --- a/doc/ref/api-foreign.texi +++ b/doc/ref/api-foreign.texi @@ -498,6 +498,8 @@ platform-dependent size: @defvrx {Scheme Variable} size_t @defvrx {Scheme Variable} ssize_t @defvrx {Scheme Variable} ptrdiff_t +@defvrx {Scheme Variable} intptr_t +@defvrx {Scheme Variable} uintptr_t Values exported by the @code{(system foreign)} module, representing C numeric types. For example, @code{long} may be @code{equal?} to @code{int64} on a 64-bit platform. diff --git a/libguile/foreign.c b/libguile/foreign.c index 17af10180..927c46fad 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -56,6 +56,8 @@ SCM_SYMBOL (sym_unsigned_long, "unsigned-long"); SCM_SYMBOL (sym_size_t, "size_t"); SCM_SYMBOL (sym_ssize_t, "ssize_t"); SCM_SYMBOL (sym_ptrdiff_t, "ptrdiff_t"); +SCM_SYMBOL (sym_intptr_t, "intptr_t"); +SCM_SYMBOL (sym_uintptr_t, "uintptr_t"); /* that's for pointers, you know. */ SCM_SYMBOL (sym_asterisk, "*"); @@ -1245,6 +1247,26 @@ scm_init_foreign (void) scm_from_uint8 (SCM_FOREIGN_TYPE_INT32) #else # error unsupported sizeof (scm_t_ptrdiff) +#endif + ); + + scm_define (sym_intptr_t, +#if SCM_SIZEOF_INTPTR_T == 8 + scm_from_uint8 (SCM_FOREIGN_TYPE_INT64) +#elif SCM_SIZEOF_INTPTR_T == 4 + scm_from_uint8 (SCM_FOREIGN_TYPE_INT32) +#else +# error unsupported sizeof (scm_t_intptr) +#endif + ); + + scm_define (sym_uintptr_t, +#if SCM_SIZEOF_UINTPTR_T == 8 + scm_from_uint8 (SCM_FOREIGN_TYPE_UINT64) +#elif SCM_SIZEOF_UINTPTR_T == 4 + scm_from_uint8 (SCM_FOREIGN_TYPE_UINT32) +#else +# error unsupported sizeof (scm_t_uintptr) #endif ); diff --git a/module/system/foreign.scm b/module/system/foreign.scm index 3304eb015..d1c2ceb96 100644 --- a/module/system/foreign.scm +++ b/module/system/foreign.scm @@ -30,6 +30,7 @@ uint16 int16 uint32 int32 uint64 int64 + intptr_t uintptr_t sizeof alignof From 48d42553ef5a9c2240bc2296d1b38dbfd5fca1ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 22 Nov 2017 16:46:11 +0100 Subject: [PATCH 6/9] ltdl wrappers now use a recursive mutex. Fixes . Reported by noxdafox . * libguile/dynl.c (scm_init_dynamic_linking): Add call to 'scm_i_pthread_mutex_init'. --- libguile/dynl.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/libguile/dynl.c b/libguile/dynl.c index b9497b1b3..2a25e5d2e 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -1,7 +1,7 @@ /* dynl.c - dynamic linking * * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002, - * 2003, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. + * 2003, 2008, 2009, 2010, 2011, 2017 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -66,10 +66,9 @@ maybe_drag_in_eprintf () #include -/* - From the libtool manual: "Note that libltdl is not threadsafe, - i.e. a multithreaded application has to use a mutex for libltdl.". -*/ +/* From the libtool manual: "Note that libltdl is not threadsafe, + i.e. a multithreaded application has to use a mutex for libltdl.". + Note: We initialize it as a recursive mutex below. */ static scm_i_pthread_mutex_t ltdl_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; /* LT_PATH_SEP-separated extension library search path, searched last */ @@ -401,6 +400,13 @@ scm_init_dynamic_linking () { scm_tc16_dynamic_obj = scm_make_smob_type ("dynamic-object", 0); scm_set_smob_print (scm_tc16_dynamic_obj, dynl_obj_print); + + /* Make LTDL_LOCK recursive so that a pre-unwind handler can still use + 'dynamic-link', as is the case at the REPL. See + . */ + scm_i_pthread_mutex_init (<dl_lock, + scm_i_pthread_mutexattr_recursive); + sysdep_dynl_init (); #include "libguile/dynl.x" } From 5f59e2812db7108ef9302f7bd862325572751b17 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 23 Nov 2017 18:13:56 +0100 Subject: [PATCH 7/9] Fix logand type inference * module/language/cps/types.scm (logand): We were computing the wrong ranges when either argument was negative; a terrible bug! (logsub): Also fix range when A is negative and B is non-negative. (ulogand): Tighten up range. --- module/language/cps/types.scm | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm index 8464a6502..c24f9b99d 100644 --- a/module/language/cps/types.scm +++ b/module/language/cps/types.scm @@ -1283,12 +1283,17 @@ minimum, and maximum." (define-type-inferrer (logand a b result) (define (logand-min a b) (if (and (negative? a) (negative? b)) - (min a b) + (let ((min (min a b))) + (if (inf? min) + -inf.0 + (- 1 (next-power-of-two (- min))))) 0)) (define (logand-max a b) - (if (and (positive? a) (positive? b)) - (min a b) - 0)) + (cond + ((or (and (positive? a) (positive? b)) + (and (negative? a) (negative? b))) + (min a b)) + (else (max a b)))) (restrict! a &exact-integer -inf.0 +inf.0) (restrict! b &exact-integer -inf.0 +inf.0) (define! result &exact-integer @@ -1299,7 +1304,7 @@ minimum, and maximum." (define-type-inferrer (ulogand a b result) (restrict! a &u64 0 &u64-max) (restrict! b &u64 0 &u64-max) - (define! result &u64 0 (max (&max/u64 a) (&max/u64 b)))) + (define! result &u64 0 (min (&max/u64 a) (&max/u64 b)))) (define-simple-type-checker (logsub &exact-integer &exact-integer)) (define-type-inferrer (logsub a b result) @@ -1315,7 +1320,7 @@ minimum, and maximum." (values min-a (if (negative? min-a) +inf.0 max-a))) ((negative? min-a) ;; Sign bit never set on B -- result will have the sign of A. - (values min-a (if (negative? max-a) -1 max-a))) + (values -inf.0 max-a)) (else ;; Sign bit never set on A and never set on B -- the nice case. (values 0 max-a)))) From 76d4608d7afb121ecb1e77a05ab14796ef10cd6a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 29 Nov 2017 19:57:11 +0100 Subject: [PATCH 8/9] Add nullary intmap and intset folders * module/language/cps/intmap.scm (intmap-fold, intmap-fold-right): * module/language/cps/intset.scm (intset-fold, intset-fold-right): Add nullary folders. --- module/language/cps/intmap.scm | 4 ++++ module/language/cps/intset.scm | 6 +++++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/module/language/cps/intmap.scm b/module/language/cps/intmap.scm index 3a4f51776..a52e2ba32 100644 --- a/module/language/cps/intmap.scm +++ b/module/language/cps/intmap.scm @@ -511,6 +511,8 @@ already, and always calls the meet procedure." (define intmap-fold (case-lambda + ((f map) + ((make-intmap-folder #t) f map)) ((f map seed) ((make-intmap-folder #t seed) f map seed)) ((f map seed0 seed1) @@ -520,6 +522,8 @@ already, and always calls the meet procedure." (define intmap-fold-right (case-lambda + ((f map) + ((make-intmap-folder #f) f map)) ((f map seed) ((make-intmap-folder #f seed) f map seed)) ((f map seed0 seed1) diff --git a/module/language/cps/intset.scm b/module/language/cps/intset.scm index 09af0eaa3..7b2a66aaf 100644 --- a/module/language/cps/intset.scm +++ b/module/language/cps/intset.scm @@ -1,5 +1,5 @@ ;;; Functional name maps -;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc. +;;; Copyright (C) 2014, 2015, 2017 Free Software Foundation, Inc. ;;; ;;; This library is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU Lesser General Public License as @@ -464,6 +464,8 @@ (define intset-fold (case-lambda + ((f set) + ((make-intset-folder #t) f set)) ((f set seed) ((make-intset-folder #t seed) f set seed)) ((f set s0 s1) @@ -473,6 +475,8 @@ (define intset-fold-right (case-lambda + ((f set) + ((make-intset-folder #f) f set)) ((f set seed) ((make-intset-folder #f seed) f set seed)) ((f set s0 s1) From 8e2314c46dc3aa98574d380a2c7cb782da643913 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 29 Nov 2017 19:57:48 +0100 Subject: [PATCH 9/9] Simplify live variable computation for graphs without loops * module/language/cps/slot-allocation.scm (compute-reverse-control-flow-order): For graphs without back-edges, use a simplified computation of reverse control flow order. --- module/language/cps/slot-allocation.scm | 40 ++++++++++++++++++------- 1 file changed, 29 insertions(+), 11 deletions(-) diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm index 6813a511f..fe20303cc 100644 --- a/module/language/cps/slot-allocation.scm +++ b/module/language/cps/slot-allocation.scm @@ -23,6 +23,7 @@ ;;; Code: (define-module (language cps slot-allocation) + #:use-module (ice-9 control) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -194,17 +195,34 @@ by a label, respectively." (define (compute-reverse-control-flow-order preds) "Return a LABEL->ORDER bijection where ORDER is a contiguous set of -integers starting from 0 and incrementing in sort order." - ;; This is more involved than forward control flow because not all - ;; live labels are reachable from the tail. - (persistent-intmap - (fold2 (lambda (component order n) - (intset-fold (lambda (label order n) - (values (intmap-add! order label n) - (1+ n))) - component order n)) - (reverse (compute-sorted-strongly-connected-components preds)) - empty-intmap 0))) +integers starting from 0 and incrementing in sort order. There is a +precondition that labels in PREDS are already renumbered in reverse post +order." + (define (has-back-edge? preds) + (let/ec return + (intmap-fold (lambda (label labels) + (intset-fold (lambda (pred) + (if (<= label pred) + (return #t) + (values))) + labels) + (values)) + preds) + #f)) + (if (has-back-edge? preds) + ;; This is more involved than forward control flow because not all + ;; live labels are reachable from the tail. + (persistent-intmap + (fold2 (lambda (component order n) + (intset-fold (lambda (label order n) + (values (intmap-add! order label n) + (1+ n))) + component order n)) + (reverse (compute-sorted-strongly-connected-components preds)) + empty-intmap 0)) + ;; Just reverse forward control flow. + (let ((max (intmap-prev preds))) + (intmap-map (lambda (label labels) (- max label)) preds)))) (define* (add-prompt-control-flow-edges conts succs #:key complete?) "For all prompts in DFG in the range [MIN-LABEL, MIN-LABEL +