From 20c2cc89d9e45faf3ec51c30b260c62bc2fdc9ce Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Wed, 16 Sep 2020 13:02:46 +0200 Subject: [PATCH] Don't re-use argvector when the CPS call's arguments use rest-ops (#1703) Code using restops can be compiled to C code essentially like this: av2 = av; av2[0]=*((C_word*)lf[0]+1); av2[1]=t1; av2[2]=t2; av2[3]=C_get_rest_arg(c,2,av,2,t0); tp(4,av2); But this means the get_rest_arg is taking the newly-written value from av2 instead of from the original av. It would be better if we could assign the argument to a temporary instead so that it precedes the call, but that would require a restructure of the CPS call itself, which is quite complicated. For now this workaround should be fine, as the situation is relatively rare anyway. --- NEWS | 4 ++++ c-backend.scm | 13 ++++++++++++- tests/compiler-tests.scm | 9 ++++++++- 3 files changed, 24 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 7164df42..87587eeb 100644 --- a/NEWS +++ b/NEWS @@ -34,6 +34,10 @@ - At program cleanup, finalizers are only forced when the live finalizer count is non-zero +- Compiler + - Avoid re-using argvector when inline rest operations are being + used in CPS calls (#1703, thanks to Jakob L. Keuze). + - Build system - Auto-configure at build time on most platforms. Cross-compilation still requires PLATFORM to be set, and it can still be provided diff --git a/c-backend.scm b/c-backend.scm index 1753fea5..67f83691 100644 --- a/c-backend.scm +++ b/c-backend.scm @@ -553,6 +553,16 @@ (expr (car xs) i) (loop (cdr xs))))) + (define (contains-restop? args) + (let loop ((args args)) + (if (null? args) + #f + (let ((node (car args))) + ;; Only rest-car accesses av + (or (eq? (node-class node) '##core#rest-car) + (contains-restop? (node-subexpressions node)) + (loop (cdr args))))))) + (define (push-args args i selfarg) (let* ((n (length args)) (avl (+ n (if selfarg 1 0))) @@ -567,7 +577,8 @@ (cond ((or (not caller-has-av?) ; Argvec missing or (and (< caller-argcount avl) ; known to be too small? - (eq? caller-rest-mode 'none))) + (eq? caller-rest-mode 'none)) + (contains-restop? args)) ; Restops work on original av (gen #t "C_word av2[" avl "];")) ((>= caller-argcount avl) ; Argvec known to be re-usable? (gen #t "C_word *av2=av;")) ; Re-use our own argvector diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm index 53275a62..9cda75ef 100644 --- a/tests/compiler-tests.scm +++ b/tests/compiler-tests.scm @@ -461,4 +461,11 @@ (append-map (lambda (a b) (assert (and (= a 3) (= b 4)))) x y)) (outer 3 4) - + +; #1703: argvector re-use interfered with rest-arg optimization +(define reduce (lambda (_l ini) (+ ini 1))) + +(print ((lambda xs (reduce xs (car xs))) 1 2 3)) ;; prints 2 + +(define fold- (lambda xs (reduce xs (car xs)))) +(print (fold- 1 2 3)) -- 2.20.1