From be0399796da78eb0a65a6720a0868b077e619956 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Fri, 8 May 2026 00:59:13 +0200 Subject: [PATCH] Working racket lib ao async backend --- libao-async-ffi-racket.rkt | 212 ++++++++++++++++++++++--------------- libao.rkt | 6 ++ play-test.rkt | 10 +- 3 files changed, 140 insertions(+), 88 deletions(-) diff --git a/libao-async-ffi-racket.rkt b/libao-async-ffi-racket.rkt index 833ae98..88400ca 100644 --- a/libao-async-ffi-racket.rkt +++ b/libao-async-ffi-racket.rkt @@ -30,6 +30,7 @@ ao_set_volume_async ao_volume_async ao_reuse_buf_len + ao_sample_queue_len make-buffer-info make-BufferInfo_t ) @@ -127,6 +128,9 @@ (define-struct ao-handle (queue + in-queue + buf-size + paused ao-device @@ -139,36 +143,75 @@ mutex pause-mutex clear-mutex - buf-mutex - add-mutex play-thread at-second music-duration music-id - buf-size volume-in-10000 valid bufs - current-elem bytes-left ) #:mutable ) +;; ------------------------------------------------------------------------- +;; Internal memory structure, to be able to reuse allocated memory bytes +;; And prevent the GC from collecting this memory that is constantly reused +;; ------------------------------------------------------------------------- + +(define-struct mem + (size bytes allocated) #:mutable) + +(define (to-mem m) + (if (mem? m) + m + (if (bytes? m) + (make-mem (bytes-length m) m #f) + (error + (format + "Cannot convert m of other type than bytes? or mem?, got ~a" m))))) + +(define (m-memcpy dst from size . args) + (let ((offset (if (null? args) 0 from)) + (from* (if (null? args) from size)) + (size* (if (null? args) size (car args))) + ) + (let ((dst** (if (cpointer? dst) dst (mem-bytes (to-mem dst)))) + (from** (if (cpointer? from*) from* (mem-bytes (to-mem from*)))) + ) + (memcpy dst** offset from** size*) + ) + ) + ) + +;; ------------------------------------------------------------------------- +;; Playback buffer to send to libao in milliseconds +;; ------------------------------------------------------------------------- + (define ao-buf-ms 250) ;; Playback buffer of 0.25s +;; ------------------------------------------------------------------------- +;; Sample queue handling +;; ------------------------------------------------------------------------- + (define (get h ms-wait) (let ((el (if (<= ms-wait 0) (sync/timeout 0 (ao-handle-queue h)) (sync/timeout (/ ms-wait 1000.0) (ao-handle-queue h) )))) (if (eq? el #f) - (set-ao-handle-buf-size! h 0) ; no elements in queue => empty => no buffer with music samples - (set-ao-handle-buf-size! h (- (ao-handle-buf-size h) (queue-elem-buflen el)))) + (begin + (set-ao-handle-buf-size! h 0) ; no elements in queue => empty => no buffer with music samples + (set-ao-handle-in-queue! h 0)) + (begin + (set-ao-handle-buf-size! h (- (ao-handle-buf-size h) (queue-elem-buflen el))) + (set-ao-handle-in-queue! h (- (ao-handle-in-queue h) 1)) + )) el) ) @@ -190,18 +233,14 @@ (define (add h elem) - (mutex-lock (ao-handle-add-mutex h)) - (add* h elem) - (mutex-unlock (ao-handle-add-mutex h)) - ) - -(define (add* h elem) (if (eq? (queue-elem-command elem) 'stop) (begin (unless (eq? (ao-handle-current-elem h) #f) (async-channel-put (ao-handle-queue h) (ao-handle-current-elem h)) + (set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1)) (set-ao-handle-current-elem! h #f)) (async-channel-put (ao-handle-queue h) elem) + (set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1)) ) (let* ((cb (ao-handle-current-elem h))) (if (eq? cb #f) @@ -209,9 +248,8 @@ (set-ao-handle-current-elem! h elem) (set! cb elem) (let* ((ns (needed-bytes h)) - (new-buf (cadr (alloc-buf h ns)))) - (memcpy new-buf (queue-elem-buf cb) (queue-elem-buflen cb)) - ;(dbg-sound "Allocated new buffer of ~a bytes (~a samples) for elem size ~a" ns (bytes->samples h ns) (queue-elem-buflen cb)) + (new-buf (alloc-buf h ns))) + (m-memcpy new-buf (queue-elem-buf cb) (queue-elem-buflen cb)) (reuse-buf h (queue-elem-buf cb)) (set-queue-elem-buf! cb new-buf) (set-ao-handle-bytes-left! h (- ns (queue-elem-buflen cb))) @@ -222,18 +260,19 @@ (< (- (ao-handle-bytes-left h) (queue-elem-buflen elem)) 0)) (begin ; push this buffer and restart - ;(dbg-sound "Pushing sound buffer with ~a samples left" (ao-handle-bytes-left h)) (async-channel-put (ao-handle-queue h) cb) + (set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1)) (set-ao-handle-current-elem! h #f) - (add* h elem)) + (add h elem)) (let ((offset (queue-elem-buflen cb))) - (memcpy (queue-elem-buf cb) offset (queue-elem-buf elem) (queue-elem-buflen elem)) + (m-memcpy (queue-elem-buf cb) offset (queue-elem-buf elem) (queue-elem-buflen elem)) (set-queue-elem-buflen! cb (+ offset (queue-elem-buflen elem))) (set-ao-handle-bytes-left! h (- (ao-handle-bytes-left h) (queue-elem-buflen elem))) (set-ao-handle-buf-size! h (+ (ao-handle-buf-size h) (queue-elem-buflen elem))) (reuse-buf h (queue-elem-buf elem)) (when (= (ao-handle-bytes-left h) 0) (async-channel-put (ao-handle-queue h) cb) + (set-ao-handle-in-queue! h (+ ao-handle-in-queue h) 1) (set-ao-handle-current-elem! h #f)) ) ) @@ -243,14 +282,10 @@ ) (define (new-elem h command music-id at-second music-duration buflen buf) - ;(let ((new-buf (make-bytes buflen))) ;((new-buf (malloc buflen 'atomic))) - ; (memcpy new-buf buf buflen) - ;(make-queue-elem command new-buf buflen at-second music-duration music-id))) (make-queue-elem command buf buflen at-second music-duration music-id)) (define (del-elem h elem) (reuse-buf h (queue-elem-buf elem)) - ; does nothing #t) (define (clear h) @@ -265,7 +300,6 @@ (set! el (get h 0))) ; Clear the current element in processing - (mutex-lock (ao-handle-add-mutex h)) (unless (eq? (ao-handle-current-elem h) #f) (let* ((ce (ao-handle-current-elem h)) (cb (queue-elem-buf ce))) @@ -274,7 +308,6 @@ (set-ao-handle-current-elem! h #f) (set-ao-handle-bytes-left! h 0) (set-ao-handle-buf-size! h 0) - (mutex-unlock (ao-handle-add-mutex h)) (mutex-unlock (ao-handle-clear-mutex h)) (dbg-sound "~a elements cleared" count) @@ -302,15 +335,16 @@ (eq? le-a le-b))) + (define (alloc-buf h size) (let ((entry #f)) (letrec ((f (λ (entries min-size min-size-idx idx) (if (null? entries) min-size-idx (let ((e (car entries))) - (if (<= size (car e)) - (if (or (eq? min-size #f) (< (car e) min-size)) - (f (cdr entries) (car e) idx (+ idx 1)) + (if (<= size (mem-size e)) + (if (or (eq? min-size #f) (< (mem-size e) min-size)) + (f (cdr entries) (mem-size e) idx (+ idx 1)) (f (cdr entries) min-size min-size-idx (+ idx 1)) ) (f (cdr entries) min-size min-size-idx (+ idx 1)) @@ -319,24 +353,20 @@ ) ) )) - (mutex-lock (ao-handle-buf-mutex h)) (let ((bufs (ao-handle-bufs h)) (entry #f)) (unless (null? bufs) (let ((idx (f bufs #f #f 0))) (unless (eq? idx #f) (let ((e (list-ref bufs idx))) - ;(dbg-sound "Reusing index ~a, ~a for size ~a" idx (car e) size) (set! entry (list-ref bufs idx)) (set-ao-handle-bufs! h (append (take bufs idx) (drop bufs (+ idx 1)))) ) ) ) ) - (mutex-unlock (ao-handle-buf-mutex h)) - ;(dbg-sound "Alloc buf: ~a, got ~a" size (map (λ (e) (car e)) (ao-handle-bufs h))) (if (eq? entry #f) - (list size (make-bytes size)) + (make-mem size (make-bytes size) #t) entry) ) ) @@ -344,12 +374,8 @@ ) (define (reuse-buf h buf) - (unless (eq? buf #f) - (mutex-lock (ao-handle-buf-mutex h)) - (set-ao-handle-bufs! h (cons (list (bytes-length buf) buf) (ao-handle-bufs h))) - (when (> (length (ao-handle-bufs h)) 10) - (set-ao-handle-bufs! h (take (ao-handle-bufs h) 5))) - (mutex-unlock (ao-handle-buf-mutex h)) + (when (and (mem? buf) (mem-allocated buf)) + (set-ao-handle-bufs! h (cons buf (ao-handle-bufs h))) ) #t ) @@ -360,25 +386,35 @@ ;;; Volume -(define (adjust-volume h bs buf-size volume-in-10000) - ;; bs: bytes +(define (adjust-volume h bs volume-in-10000) + ;; bs: mem ;; buf-size: aantal geldige bytes in bs - (let* ([bits (ao-handle-dev-bits-per-sample h)] + (let* ([bs-bytes (mem-bytes bs)] + [buf-size (mem-size bs)] + [bits (ao-handle-dev-bits-per-sample h)] [bytes-per-sample (arithmetic-shift bits -3)] - [big? (is-big-endian? (ao-handle-dev-endianness h))]) + [big? (is-big-endian? (ao-handle-dev-endianness h))] + [min-sample (- (arithmetic-shift 1 (- bits 1)))] + [max-sample (- (arithmetic-shift 1 (- bits 1)) 1)] + [clip (λ (scaled) + (cond + [(< scaled min-sample) min-sample] + [(> scaled max-sample) max-sample] + [else scaled]))] + ) (unless (= volume-in-10000 10000) (for ([i (in-range 0 buf-size bytes-per-sample)]) - (let* ([sample (int-bytes->integer bs #t big? + (let* ([sample (int-bytes->integer bs-bytes #t big? i (+ i bytes-per-sample))] - [scaled (quotient (* sample volume-in-10000) 10000)]) + [scaled (clip (quotient (* sample volume-in-10000) 10000))]) (integer->int-bytes scaled bytes-per-sample #t big? - bs + bs-bytes i)))) #t)) @@ -386,16 +422,19 @@ ;;; planar -> intereleaved -(define (planar-to-interleaved h mem buf-size info) +(define (planar-to-interleaved h in-buf info) ;; mem: bytes ;; result: (list bytes output-size) - (let* ([type (buffer-info-type info)] + (let* ([in-bytes (mem-bytes in-buf)] + [buf-size (mem-size in-buf)] + [type (buffer-info-type info)] [bits (buffer-info-sample-bits info)] [channels (buffer-info-channels info)] [bytes (arithmetic-shift bits -3)] [out-size buf-size] - [out (cadr (alloc-buf h out-size))] + [out (alloc-buf h out-size)] + [out-bytes (mem-bytes out)] ) (unless (or (eq? type 'planar) (eq? type 'flac)) @@ -415,22 +454,25 @@ (* sample-index bytes))] [out-pos (* (+ (* sample-index channels) channel) bytes)]) - (bytes-copy! out out-pos mem in-pos (+ in-pos bytes))))) + (bytes-copy! out-bytes out-pos in-bytes in-pos (+ in-pos bytes))))) - (list out out-size)))) + out out-size))) ;;; requested bits to device bits -(define (convert-bits h buf buf-size in-bits in-endianness out-bits out-endianness) +(define (convert-bits h buf in-bits in-endianness out-bits out-endianness) ;; buf: bytes ;; returns: (list out-bytes out-size) (let* ([in-bytes (arithmetic-shift in-bits -3)] [out-bytes (arithmetic-shift out-bits -3)] + [in-buf (mem-bytes buf)] + [buf-size (mem-size buf)] [samples (quotient buf-size in-bytes)] [out-size (* samples out-bytes)] - [out (cadr (alloc-buf h out-size))] + [out (alloc-buf h out-size)] + [out-buf (mem-bytes out)] [shift (- out-bits in-bits)] [in-big? (is-big-endian? in-endianness)] [out-big? (is-big-endian? out-endianness)]) @@ -438,17 +480,17 @@ (for ([n (in-range samples)]) (let* ([in-pos (* n in-bytes)] [out-pos (* n out-bytes)] - [sample (int-bytes->integer buf #t in-big? in-pos (+ in-pos in-bytes))] + [sample (int-bytes->integer in-buf #t in-big? in-pos (+ in-pos in-bytes))] [converted (arithmetic-shift sample shift)]) - (integer->int-bytes converted out-bytes #t out-big? out out-pos))) - - (list out out-size #t))) + (integer->int-bytes converted out-bytes #t out-big? out-buf out-pos))) -(define (convert-req-bits-to-dev-bits h mem buf-size info) + (list out #t))) + +(define (convert-req-bits-to-dev-bits h mem info) (if (and (= (buffer-info-sample-bits info) (ao-handle-dev-bits-per-sample h)) (endian-eq? (buffer-info-endianness info) (ao-handle-dev-endianness h))) - (list mem buf-size #f) - (convert-bits h mem buf-size + (list mem #f) + (convert-bits h mem (buffer-info-sample-bits info) (buffer-info-endianness info) (ao-handle-dev-bits-per-sample h) @@ -475,7 +517,7 @@ (mutex-unlock (ao-handle-clear-mutex h)) (if (eq? elem #f) (begin - (dbg-sound "nothing in the queue") + ;(dbg-sound "nothing in the queue") (sleep 0.05)) (begin (if (eq? (queue-elem-command elem) 'stop) @@ -486,14 +528,15 @@ (set-ao-handle-music-id! h (queue-elem-music-id elem)) (unless (= (ao-handle-volume-in-10000 h) 10000) - (adjust-volume h (queue-elem-buf elem) (queue-elem-buflen elem) + (adjust-volume h (queue-elem-buf elem) (ao-handle-volume-in-10000 h))) - (let* ((size (queue-elem-buflen elem))) + (let* ((size (queue-elem-buflen elem)) + (el-buf (to-mem (queue-elem-buf elem)))) (when (> size buf-size) (set! buf (malloc size 'atomic-interior )) (set! buf-size size)) - (memcpy buf (queue-elem-buf elem) size) + (m-memcpy buf (mem-bytes el-buf) size) (ao_play (ao-handle-ao-device h) buf size) ) ) @@ -510,8 +553,6 @@ ) ) - - (define handle-admin-mutex (make-mutex)) (define num-of-handles 0) @@ -621,6 +662,9 @@ (define (ao_create_async bits rate channels byte-format wav-output-file) (let ((handle (make-ao-handle (make-async-channel) ; queue + 0 ; in-queue + 0 ; total buf size + #f ; paused #f ; ao-device @@ -633,8 +677,6 @@ (make-mutex) ; mutex (make-mutex) ; pause-mutex (make-mutex) ; clear-mutex - (make-mutex) ; buf-mutex - (make-mutex) ; add-mutex #f ; play-thread @@ -642,7 +684,6 @@ 0.0 ; music-duration 0 ; music-id - 0 ; total buf size 10000 ; volume-in-10000 #t ; valid handle @@ -651,7 +692,7 @@ #f ; current element 0 ; bytes left ))) - + (let ((ao-dev-bits (try-open-device bits rate channels byte-format wav-output-file))) (set-ao-handle-ao-device! handle (car ao-dev-bits)) (set-ao-handle-dev-bits-per-sample! handle (cadr ao-dev-bits)) @@ -697,31 +738,29 @@ h ) -(define (ao_play_async h music-id at-second music-duration buf-size mem info) +(define (ao_play_async h music-id at-second music-duration buf-size au-buf info) (let ((type (buffer-info-type info))) - (unless (bytes? mem) - (error "ao_play_async: paramater mem must be of type bytes")) + (unless (or (bytes? au-buf) (mem? au-buf)) + (error "ao_play_async: paramater au-buf must be of type bytes or mem?")) + + (set! au-buf (to-mem au-buf)) + (set-mem-size! au-buf buf-size) (when (or (eq? type 'planar) (eq? type 'flac)) - (dbg-sound "Converting from planar to interleaved") - (let ((m (planar-to-interleaved h mem buf-size info))) - (reuse-buf h mem) - (set! mem (car m)) - (set! buf-size (cadr m))) + (let ((m (planar-to-interleaved h au-buf info))) + (reuse-buf h au-buf) + (set! au-buf m) + (set! buf-size (mem-size m))) ) (let ((ao-size buf-size) - (ao-mem mem)) - (let ((m (convert-req-bits-to-dev-bits h mem buf-size info))) - (when (eq? (caddr m) #t) + (ao-mem au-buf)) + (let ((m (convert-req-bits-to-dev-bits h mem info))) + (when (eq? (cadr m) #t) (reuse-buf h mem) (set! ao-mem (car m)) - (set! ao-size (cadr m)))) - - (unless (bytes? ao-mem) - (error "Hey! this was unexpected!")) - + (set! ao-size (mem-size ao-mem)))) (let ((elem (new-elem h 'play music-id at-second music-duration ao-size ao-mem))) (add h elem)) @@ -782,3 +821,6 @@ (define (ao_reuse_buf_len h) (length (ao-handle-bufs h))) +(define (ao_sample_queue_len h) + (ao-handle-in-queue h)) + diff --git a/libao.rkt b/libao.rkt index 5672f36..2e40567 100644 --- a/libao.rkt +++ b/libao.rkt @@ -19,6 +19,7 @@ ao-at-music-id ao-bufsize-async ao-reuse-buf-len-async + ao-sample-queue-len-async ao-clear-async ao-pause ao-set-volume! @@ -208,6 +209,11 @@ (ffi:ao_reuse_buf_len (ao-handle-async-player handle)) ) +(rc:define/contract (ao-sample-queue-len-async handle) + (rc:-> ao-handle? integer?) + (ffi:ao_sample_queue_len (ao-handle-async-player handle)) + ) + (rc:define/contract (ao-set-volume! handle percentage) (rc:-> ao-handle? number? void?) (ffi:ao_set_volume_async (ao-handle-async-player handle) diff --git a/play-test.rkt b/play-test.rkt index 2f14119..1b00fd3 100644 --- a/play-test.rkt +++ b/play-test.rkt @@ -122,8 +122,10 @@ (second-printer buf-seconds) (cond-seek) (cond-volume) - (when (> buf-seconds 5) - (info-sound "Reuse buf: ~a" (ao-reuse-buf-len-async ao-h)) + (when (> buf-seconds 10) + (info-sound "Reuse buf/Sample queue: ~a/~a" + (ao-reuse-buf-len-async ao-h) + (ao-sample-queue-len-async ao-h)) (letrec ((waiter (λ () (let ((buf-seconds-left (exact->inexact (/ (ao-bufsize-async ao-h) @@ -139,7 +141,9 @@ (waiter))))) )) (waiter) - (info-sound "Reuse buf: ~a" (ao-reuse-buf-len-async ao-h)) + (info-sound "Reuse buf/Sample queue: ~a/~a" + (ao-reuse-buf-len-async ao-h) + (ao-sample-queue-len-async ao-h)) ))) ) )