Skip to content

Commit 647f89e

Browse files
mflattmflatt
committed
trigger interrupts after long vector operations
For operations that are atomic from the perspective of interrupts but that may work on large objects, such as `vector-append`, adjust the trap counter proportional to work done. That way, interrupts are dispatched in a more timely manner, especially GC interrupts. The change to "7.ms" is unrelated; wrapping that test with its smaller list size in a loop could provoke a failure befere these changes.
1 parent 0cd0ef0 commit 647f89e

File tree

6 files changed

+231
-32
lines changed

6 files changed

+231
-32
lines changed

‎mats/4.ms‎

Lines changed: 127 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4181,6 +4181,133 @@
41814181
(eqv?
41824182
(test6B/counter 125 (lambda () (spin n)))
41834183
n)))
4184+
4185+
;; check that some operations that end up calling `memmove`/`memcpy`
4186+
;; use a suitable amount of fuel
4187+
(begin
4188+
(define (check-uses-fuel make copy!)
4189+
(and (eq? (let ([vec (make 1024)])
4190+
((make-engine (lambda ()
4191+
(copy! vec 512)
4192+
'done))
4193+
4096
4194+
(lambda (fuel v) v)
4195+
(lambda (e) 'not-done)))
4196+
'done)
4197+
(eq? (let ([vec (make 4096)])
4198+
((make-engine (lambda ()
4199+
(copy! vec 2048)
4200+
'done))
4201+
256
4202+
(lambda (fuel v) v)
4203+
(lambda (e) 'not-done)))
4204+
'not-done)))
4205+
#t)
4206+
(check-uses-fuel make-bytevector
4207+
(lambda (src amt)
4208+
(bytevector-copy! src 0 src amt amt)))
4209+
(check-uses-fuel make-bytevector
4210+
(lambda (src amt)
4211+
(bytevector-copy src)))
4212+
(check-uses-fuel make-bytevector
4213+
(lambda (src amt)
4214+
(make-bytevector amt 0)))
4215+
(check-uses-fuel make-bytevector
4216+
(lambda (src amt)
4217+
(make-bytevector amt)))
4218+
(check-uses-fuel make-bytevector
4219+
(lambda (src amt)
4220+
(make-reference-bytevector amt)))
4221+
(check-uses-fuel make-bytevector
4222+
(lambda (src amt)
4223+
(make-immobile-reference-bytevector amt)))
4224+
(check-uses-fuel make-bytevector
4225+
(lambda (src amt)
4226+
(bytevector-fill! src 1)))
4227+
(check-uses-fuel make-vector
4228+
(lambda (src amt)
4229+
(vector-copy! src 0 src amt amt)))
4230+
(check-uses-fuel make-vector
4231+
(lambda (src amt)
4232+
(vector-copy src)))
4233+
(check-uses-fuel make-vector
4234+
(lambda (src amt)
4235+
(vector-append src src)))
4236+
(check-uses-fuel make-vector
4237+
(lambda (src amt)
4238+
(immutable-vector-append src src)))
4239+
(check-uses-fuel make-vector
4240+
(lambda (src amt)
4241+
(vector-set/copy src 0 1)))
4242+
(check-uses-fuel make-vector
4243+
(lambda (src amt)
4244+
(immutable-vector-set/copy src 0 1)))
4245+
(check-uses-fuel make-vector
4246+
(lambda (src amt)
4247+
(make-vector amt 0)))
4248+
(check-uses-fuel make-vector
4249+
(lambda (src amt)
4250+
(make-immobile-vector amt)))
4251+
(check-uses-fuel make-vector
4252+
(lambda (src amt)
4253+
(make-immobile-vector amt 0)))
4254+
(check-uses-fuel make-vector
4255+
(lambda (src amt)
4256+
(vector-fill! src 1)))
4257+
(check-uses-fuel make-flvector
4258+
(lambda (src amt)
4259+
(flvector-copy! src 0 src amt amt)))
4260+
(check-uses-fuel make-flvector
4261+
(lambda (src amt)
4262+
(flvector-copy src)))
4263+
(check-uses-fuel make-flvector
4264+
(lambda (src amt)
4265+
(make-flvector amt)))
4266+
(check-uses-fuel make-fxvector
4267+
(lambda (src amt)
4268+
(fxvector-copy! src 0 src amt amt)))
4269+
(check-uses-fuel make-fxvector
4270+
(lambda (src amt)
4271+
(fxvector-copy src)))
4272+
(check-uses-fuel make-fxvector
4273+
(lambda (src amt)
4274+
(make-fxvector amt)))
4275+
(check-uses-fuel make-string
4276+
(lambda (src amt)
4277+
(string-append src src)))
4278+
(check-uses-fuel make-string
4279+
(lambda (src amt)
4280+
(make-string amt)))
4281+
(check-uses-fuel make-string
4282+
(lambda (src amt)
4283+
(make-string amt #\x)))
4284+
(check-uses-fuel make-string
4285+
(lambda (src amt)
4286+
(string-fill! src #\x)))
4287+
4288+
;; list operations are not obligated to use fuel in unsafe mode
4289+
(check-uses-fuel make-list
4290+
(lambda (src amt)
4291+
(#2%length src)))
4292+
(check-uses-fuel make-list
4293+
(lambda (src amt)
4294+
(#2%list-tail src amt)))
4295+
(check-uses-fuel make-list
4296+
(lambda (src amt)
4297+
(#2%list-ref src amt)))
4298+
(check-uses-fuel make-list
4299+
(lambda (src amt)
4300+
(#2%memq 'not-there src)))
4301+
(check-uses-fuel (lambda (n) (make-list n '(here)))
4302+
(lambda (src amt)
4303+
(#2%assq 'not-there src)))
4304+
(check-uses-fuel make-list
4305+
(lambda (src amt)
4306+
(#2%append src src)))
4307+
(check-uses-fuel make-list
4308+
(lambda (src amt)
4309+
(#2%reverse src)))
4310+
41844311
)
41854312
41864313
;;; section 4-8:

‎mats/7.ms‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6195,8 +6195,8 @@ evaluating module init
61956195
(>= (bytes-deallocated) 0)
61966196
(let ([b (bytes-deallocated)] [c (collections)])
61976197
(with-interrupts-disabled ; ensure allocated list stays in generation 0 until printed
6198-
(let ([x (make-list 10 'a)])
6199-
(pretty-print x))
6198+
(let ([x (make-list 10000 'a)])
6199+
(pretty-print (list-tail x 9990)))
62006200
(collect))
62016201
(and (> (collections) c) (or (eq? (current-eval) interpret)
62026202
(> (bytes-deallocated) b))))

‎release_notes/release_notes.stex‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -116,6 +116,25 @@ Online versions of both books can be found at
116116
%-----------------------------------------------------------------------------
117117
\section{Functionality Changes}\label{section:functionality}
118118

119+
\subsection{Interrupts and Large-Vector Operations (10.4.0)}
120+
121+
Vector and string operations such as \scheme{make-vector},
122+
\scheme{make-bytevector}, \scheme{make-string},
123+
\scheme{string-append}, and \scheme{vector-append}---whose run times
124+
depend on the length of the vector, bytevector, or string---were
125+
treated for the purposes of scheduling interrupt checking as
126+
essentially constant-time operations. As a result, garbage collections
127+
and timer expirations could be too infrequent. These operations still
128+
will not be interrupted during their execution, but they are treated
129+
as taking time proportional to their work for the purpose of
130+
scheduling interrupts.
131+
132+
List operations such as \scheme{length}, \scheme{list-ref},
133+
\scheme{list-tail}, \scheme{append}, \scheme{reverse}, \scheme{assq},
134+
and \scheme{memq} suffer from the same problem only in unsafe mode.
135+
Direct use of these procedures in unsafe mode continues to be treated
136+
as essentialy constant-time.
137+
119138
\subsection{Type recovery improvements (10.4.0)}
120139

121140
The compiler now avoids moving predicates from tail position when they may raise an error,

‎s/cpprim.ss‎

Lines changed: 54 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -758,6 +758,13 @@
758758
(lambda (e)
759759
(%lea ,e (fx+ (constant inexactnum-imag-disp)
760760
(fx- (constant type-flonum) (constant typemod))))))
761+
(define build-use-trap-fuel
762+
(lambda (amt)
763+
(let ([fuel (make-tmp 'fuel 'uptr)])
764+
`(let ([,fuel ,(%inline - ,(ref-reg %trap) ,amt)])
765+
(if ,(%inline > ,fuel (immediate 0))
766+
(set! ,(ref-reg %trap) ,fuel)
767+
,(build-libcall #f #f #f event))))))
761768
(define make-build-fill
762769
(lambda (elt-bytes data-disp)
763770
(define ptr-bytes (constant ptr-bytes))
@@ -843,7 +850,9 @@
843850
(set! ,(%mref ,e-vec ,(fx+ data-disp n)) ,e-fill)
844851
,(if (fx= n 0) e-vec (f n)))))))]
845852
[else
846-
(let ([Ltop (make-local-label 'Ltop)] [t (make-assigned-tmp 't 'uptr)])
853+
(let ([Ltop (make-local-label 'Ltop)]
854+
[t (make-assigned-tmp 't 'uptr)]
855+
[orig-t (make-tmp 'orig-t 'uptr)])
847856
(bind #t ([e-fill (super-size e-fill)])
848857
`(let ([,t ,(if (fx>= elt-bytes ptr-bytes)
849858
e-bytes
@@ -856,13 +865,16 @@
856865
,e-bytes
857866
(immediate ,(fx- ptr-bytes 1)))
858867
(immediate ,(fx- ptr-bytes)))]))])
859-
(label ,Ltop
860-
(if ,(%inline eq? ,t (immediate 0))
861-
,e-vec
862-
,(%seq
863-
(set! ,t ,(%inline - ,t (immediate ,ptr-bytes)))
864-
(set! ,(%mref ,e-vec ,t ,data-disp) ,e-fill)
865-
(goto ,Ltop)))))))]))))
868+
(let ([,orig-t ,t])
869+
(label ,Ltop
870+
(if ,(%inline eq? ,t (immediate 0))
871+
(seq
872+
,(build-use-trap-fuel orig-t)
873+
,e-vec)
874+
,(%seq
875+
(set! ,t ,(%inline - ,t (immediate ,ptr-bytes)))
876+
(set! ,(%mref ,e-vec ,t ,data-disp) ,e-fill)
877+
(goto ,Ltop))))))))]))))
866878

867879
;; NOTE: integer->ptr and unsigned->ptr DO NOT handle 64-bit integers on a 32-bit machine.
868880
;; this is okay for $object-ref and $object-set!, which do not support moving 64-bit values
@@ -6852,7 +6864,9 @@
68526864
(constant type-bytevector))))
68536865
,(if maybe-e-fill
68546866
(build-bytevector-fill t `(immediate ,n) maybe-e-fill)
6855-
t)))))
6867+
`(seq
6868+
,(build-use-trap-fuel `(immediate ,(fxsrl n (constant ptr-bytes))))
6869+
,t))))))
68566870
(bind #t (e-length)
68576871
(let ([t-bytes (make-tmp 'tbytes 'uptr)] [t-vec (make-tmp 'tvec)])
68586872
`(if ,(%inline eq? ,e-length (immediate 0))
@@ -6872,7 +6886,9 @@
68726886
(constant bytevector-length-offset)))
68736887
,(if maybe-e-fill
68746888
(build-bytevector-fill t-vec t-bytes maybe-e-fill)
6875-
t-vec))))))))))
6889+
`(seq
6890+
,(build-use-trap-fuel (build-unfix t-bytes))
6891+
,t-vec)))))))))))
68766892
(let ()
68776893
(define valid-length?
68786894
(lambda (e-length)
@@ -7403,7 +7419,9 @@
74037419
(constant type-string))))
74047420
,(if maybe-e-fill
74057421
(build-string-fill t `(immediate ,bytes) maybe-e-fill)
7406-
t))))))
7422+
(%seq
7423+
,(build-use-trap-fuel `(immediate ,(fxsll bytes (constant ptr-bytes))))
7424+
,t)))))))
74077425
(bind #t (e-length)
74087426
(let ([t-bytes (make-tmp 'tsize 'uptr)] [t-str (make-tmp 'tstr)])
74097427
`(if ,(%inline eq? ,e-length (immediate 0))
@@ -7425,7 +7443,9 @@
74257443
(constant string-length-offset)))
74267444
,(if maybe-e-fill
74277445
(build-string-fill t-str t-bytes maybe-e-fill)
7428-
t-str))))))))))
7446+
(%seq
7447+
,(build-use-trap-fuel (build-unfix t-bytes))
7448+
,t-str)))))))))))
74297449
(define default-fill `(immediate ,(ptr->imm #\nul)))
74307450
(define-inline 3 $make-uninitialized-string
74317451
[(e-length) (do-make-string e-length #f)])
@@ -7656,14 +7676,17 @@
76567676
(label ,Ltop
76577677
(if ,(%inline eq? ,t ,e-len)
76587678
,(cond
7659-
[(not e-elem) vec]
7679+
[(not e-elem) (%seq
7680+
,(build-use-trap-fuel (build-unfix e-len))
7681+
,vec)]
76607682
[(nanopass-case (L7 Expr) n-elem
76617683
[(immediate ,imm) (guard (eqv? imm (fix 1))) #t]
76627684
[(quote ,d) (guard (eqv? d 1)) #t]
76637685
[else #f])
76647686
(let ([idx (if prefix-elem? `(immediate 0) e-len)])
76657687
(%seq
76667688
(set! ,(%mref ,vec ,idx ,(constant vector-data-disp)) ,e-elem)
7689+
,(build-use-trap-fuel (build-unfix idx))
76677690
,vec))]
76687691
[else
76697692
(let ([Lfill (make-local-label 'Lfill)]
@@ -7675,7 +7698,9 @@
76757698
(set! ,t (immediate 0))
76767699
(label ,Lfill
76777700
(if ,(%inline eq? ,t ,n-elem)
7678-
,vec
7701+
(seq
7702+
,(build-use-trap-fuel (build-unfix idx))
7703+
,vec)
76797704
,(%seq
76807705
(set! ,(%mref ,vec ,idx ,(constant vector-data-disp)) ,e-elem)
76817706
(set! ,t ,(%inline + ,t (immediate ,(constant ptr-bytes))))
@@ -7700,15 +7725,18 @@
77007725
(lambda (type e-vec e-idx e-val)
77017726
(let ([Ltop (make-local-label 'Ltop)]
77027727
[vec (make-tmp 'vec 'ptr)]
7703-
[t (make-assigned-tmp 't 'uptr)])
7728+
[t (make-assigned-tmp 't 'uptr)]
7729+
[orig-t (make-tmp 'orig-t 'uptr)])
77047730
(bind #t (e-vec e-idx)
77057731
(bind #f (e-val)
77067732
`(let ([,t ,(extract-vector-length e-vec)])
7707-
(let ([,vec ,(do-make-vector type t #f)])
7733+
(let ([,vec ,(do-make-vector type t #f)]
7734+
[,orig-t ,t])
77087735
(label ,Ltop
77097736
(if ,(%inline eq? ,t (immediate 0))
77107737
,(%seq
77117738
(set! ,(%mref ,vec ,e-idx ,(constant vector-data-disp)) ,e-val)
7739+
,(build-use-trap-fuel (build-unfix orig-t))
77127740
,vec)
77137741
,(%seq
77147742
(set! ,t ,(%inline - ,t (immediate ,(constant ptr-bytes))))
@@ -7717,7 +7745,7 @@
77177745
(goto ,Ltop)))))))))))
77187746
(define build-vector-append
77197747
(lambda (type e-vecs)
7720-
(let loop ([e-vecs e-vecs] [len `(immediate 0)])
7748+
(let loop ([e-vecs e-vecs] [len `(immediate 0)] [use-fuel? #t])
77217749
(cond
77227750
[(null? e-vecs)
77237751
(do-make-vector type len #f)]
@@ -7730,14 +7758,18 @@
77307758
(bind #t (e-vec)
77317759
`(let ([,t ,len]
77327760
[,e-len ,(extract-vector-length e-vec)])
7733-
(let ([,d-vec ,(loop (cdr e-vecs) (%inline + ,t ,e-len))])
7761+
(let ([,d-vec ,(loop (cdr e-vecs) (%inline + ,t ,e-len) #f)])
77347762
(label ,Ltop
77357763
(if ,(%inline eq? ,e-len (immediate 0))
7736-
,d-vec
7764+
,(if use-fuel?
7765+
`(seq
7766+
,(build-use-trap-fuel (extract-vector-length d-vec))
7767+
,d-vec)
7768+
d-vec)
77377769
,(%seq
77387770
(set! ,e-len ,(%inline - ,e-len (immediate ,(constant ptr-bytes))))
77397771
(set! ,(%mref ,d-vec ,(%inline + ,t ,e-len) ,(constant vector-data-disp))
7740-
,(%mref ,e-vec ,e-len ,(constant vector-data-disp)))
7772+
,(%mref ,e-vec ,e-len ,(constant vector-data-disp)))
77417773
(goto ,Ltop))))))))]))))
77427774
(define (okay-make-vector? pr e1)
77437775
(and (eq? (primref-name pr) 'make-vector)
@@ -8402,6 +8434,8 @@
84028434
,t)))])
84038435
(define-inline 3 $get-timer
84048436
[() (build-fix (ref-reg %trap))])
8437+
(define-inline 3 $use-trap-fuel
8438+
[(n) (build-use-trap-fuel n)])
84058439
(constant-case architecture
84068440
[(pb) (void)]
84078441
[else

‎s/primdata.ss‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2514,6 +2514,7 @@
25142514
($unknown-undefined-violation [flags abort-op])
25152515
($update-mark [flags pure discard unrestricted single-valued alloc])
25162516
($untrace [flags single-valued])
2517+
($use-trap-fuel [flags single-valued])
25172518
($unwrap-ftype-pointer [flags single-valued])
25182519
($value [sig [(ptr) -> (ptr)]] [flags pure unrestricted discard cp02])
25192520
($vector-ref-check? [sig [(ptr ptr) -> (boolean)]] [flags unrestricted pure])

0 commit comments

Comments
 (0)