hypercore-kb / opencog-kb / language-learning / mvp / benchmark-cogserver.scm

;;
;; benchmark-cogserver.scm - Test GPU performance through CogServer
;;
;; This tests the dispatch thread fix: each CogServer shell session
;; used to pay 16 seconds of OpenCL initialization. Now all kernel
;; creation happens in the dispatch thread, eliminating this overhead.
;;

(use-modules (opencog) (opencog exec))
(use-modules (ice-9 format))

;; Helper: time execution in milliseconds
(define (time-ms thunk)
  (let* ((start (get-internal-real-time))
         (result (thunk))
         (end (get-internal-real-time)))
    (values result (inexact->exact (round (* 1000.0 (/ (- end start) internal-time-units-per-second)))))))

(display "\n")
(display "═══════════════════════════════════════════════════════════════════\n")
(display "GPU Benchmark (through CogServer session)\n")
(display "═══════════════════════════════════════════════════════════════════\n\n")

(define *kernel-path* "/storage/projects/code/hypercore-kb/opencog-kb/language-learning/mvp/pmfg-kernel.cl")

;; ─────────────────────────────────────────────────────────────────────
;; Test 1: OpenclNode creation
;; ─────────────────────────────────────────────────────────────────────

(display "TEST 1: OpenclNode creation\n")
(display "─────────────────────────────────────────────────────────────────────\n\n")

(define gpu-node #f)
(call-with-values
  (lambda ()
    (time-ms (lambda ()
      (set! gpu-node (OpenclNode (string-append "opencl://:" *kernel-path*))))))
  (lambda (result ms)
    (format #t "  OpenclNode creation: ~a ms~%" ms)))

(format #t "  Node: ~a~%~%" (cog-name gpu-node))

;; ─────────────────────────────────────────────────────────────────────
;; Test 2: First GPU execution (tests dispatch thread fix)
;; ─────────────────────────────────────────────────────────────────────

(display "TEST 2: Kernel execution (dispatch thread fix)\n")
(display "─────────────────────────────────────────────────────────────────────\n\n")

(display "  BEFORE FIX: First execution would take 16+ seconds\n")
(display "  AFTER FIX: First execution should take <100ms\n\n")

(define test-input (Number 1 2 3 4))
(define result1 #f)

;; First GPU call (previously 16 seconds, now should be fast)
(call-with-values
  (lambda ()
    (time-ms (lambda ()
      (cog-set-value! gpu-node (Predicate "test")
        (Section (Item "test_simple")
                 (ConnectorSeq test-input (Number 0 0 0 0))))
      (set! result1 (cog-value gpu-node (Predicate "test"))))))
  (lambda (result ms)
    (format #t "  First GPU execution: ~a ms~%" ms)
    (if (> ms 5000)
        (display "  ⚠ SLOW! Dispatch thread fix may not be installed.\n")
        (display "  ✓ Fast - dispatch thread fix is working!\n"))))

(format #t "  Result (x*2+42 for 1,2,3,4): ~a~%~%" result1)

;; Second and third GPU calls
(define result2 #f)
(define result3 #f)

(call-with-values
  (lambda ()
    (time-ms (lambda ()
      (cog-set-value! gpu-node (Predicate "test")
        (Section (Item "test_simple")
                 (ConnectorSeq (Number 10 20 30 40) (Number 0 0 0 0))))
      (set! result2 (cog-value gpu-node (Predicate "test"))))))
  (lambda (result ms)
    (format #t "  Second GPU execution: ~a ms~%" ms)))

(call-with-values
  (lambda ()
    (time-ms (lambda ()
      (cog-set-value! gpu-node (Predicate "test")
        (Section (Item "test_simple")
                 (ConnectorSeq (Number 100 200 300 400) (Number 0 0 0 0))))
      (set! result3 (cog-value gpu-node (Predicate "test"))))))
  (lambda (result ms)
    (format #t "  Third GPU execution: ~a ms~%~%" ms)))

(format #t "  Results: ~a, ~a~%~%" result2 result3)

;; ─────────────────────────────────────────────────────────────────────
;; Test 3: PMFG kernel
;; ─────────────────────────────────────────────────────────────────────

(display "TEST 3: PMFG kernel (realistic workload)\n")
(display "─────────────────────────────────────────────────────────────────────\n\n")

;; Create mock MI matrix (10x10)
(define vocab-size 10)
(define mi-matrix
  (let ((vals '()))
    (do ((i 0 (+ i 1))) ((= i (* vocab-size vocab-size)))
      (set! vals (cons (random:uniform) vals)))
    (apply Number (reverse vals))))

(define test-sentence (Number 0 1 2 3 4))
(define n-words (Number 5))
(define vocab-arr (Number vocab-size))
(define pmfg-edges-out (Number 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
(define n-edges-out (Number 0))

(define pmfg-result #f)
(call-with-values
  (lambda ()
    (time-ms (lambda ()
      (cog-set-value! gpu-node (Predicate "pmfg")
        (Section (Item "pmfg_single")
                 (ConnectorSeq mi-matrix test-sentence n-words vocab-arr
                               pmfg-edges-out n-edges-out)))
      (set! pmfg-result (cog-value gpu-node (Predicate "pmfg"))))))
  (lambda (result ms)
    (format #t "  PMFG kernel execution: ~a ms~%" ms)))

(format #t "  PMFG result: ~a~%~%" pmfg-result)

;; ─────────────────────────────────────────────────────────────────────
;; Summary
;; ─────────────────────────────────────────────────────────────────────

(display "═══════════════════════════════════════════════════════════════════\n")
(display "SUMMARY\n")
(display "═══════════════════════════════════════════════════════════════════\n\n")

(display "Dispatch thread fix status:\n")
(display "  • If first execution was <100ms: Fix is working!\n")
(display "  • If first execution was 16+ seconds: Fix is NOT installed\n\n")

(display "To reinstall atomese-simd with fixes:\n")
(display "  cd repos/atomese-simd/build && sudo make install\n\n")