Add VPI examples

examples/log2-vpi-common-vpi/.gitignore

@@ -0,0 +1,2 @@
+*.o
+*.vpi

examples/log2-vpi-common-vpi/utest.vh

@@ -0,0 +1,16 @@
+`ifndef UTEST_VERILOG_DEFINES
+ `define UTEST_VERILOG_DEFINES
+
+// Log level string prefixes for use with $display function.
+// Example usage: $display("%sError message", `LOG_ERR);
+ `define LOG_INFO "INFO#"
+ `define LOG_WARN "WARN#"
+ `define LOG_ERR  "FAIL#"
+
+// Dirty hacked redefine of $display function. Must be used with two parentheses.
+// Example usage: `log_info(("Information message"));
+ `define log_quiet(msg) begin $display({$sformatf msg}); end
+ `define log_info(msg)  begin $display({`LOG_INFO, $sformatf msg}); end
+ `define log_warn(msg)  begin $display({`LOG_WARN, $sformatf msg}); end
+ `define log_error(msg) begin $display({`LOG_ERR, $sformatf msg}); end
+`endif

examples/log2-vpi-common-vpi/vpi_log2.c

@@ -0,0 +1,67 @@
+#include <math.h>
+#include <stdlib.h>
+#include <vpi_user.h>
+
+/* --------------------------- VPI INTERFACE -------------------------------- */
+
+#define MAX_ARGS 8
+
+static int calltf(char *user_data)
+{
+    vpiHandle systfref, arg_iter;
+    vpiHandle arg_hndl[MAX_ARGS];
+    struct t_vpi_value argval;
+    int arg_cnt = 0;
+
+    for (int i = 0; i < MAX_ARGS; i++)
+        arg_hndl[i] = NULL;
+
+    systfref = vpi_handle(vpiSysTfCall, NULL);
+    arg_iter = vpi_iterate(vpiArgument, systfref);
+
+    /* ---- Get agruments ---- */
+    if (arg_iter != NULL)
+        while (arg_cnt < MAX_ARGS &&
+               NULL != (arg_hndl[arg_cnt] = vpi_scan(arg_iter)))
+            arg_cnt++;
+
+    // function $log2
+    if (arg_cnt != 1)
+        vpi_printf("ERROR: $log2() wrong argument count\n");
+    else {
+        double arg, ret;
+
+        // get argument
+        argval.format = vpiRealVal;
+        vpi_get_value(arg_hndl[0], &argval);
+        arg = argval.value.real;
+
+        ret = log2(arg);
+
+        // put return value
+        argval.format     = vpiRealVal;
+        argval.value.real = ret;
+        vpi_put_value(systfref, &argval, NULL, vpiNoDelay);
+    }
+
+    for (int i = 0; i < MAX_ARGS; i++)
+        if (arg_hndl[i]) vpi_free_object(arg_hndl[i]);
+
+    return 0;
+}
+
+static void register_interface(void)
+{
+    s_vpi_systf_data tf_data;
+
+    tf_data.type        = vpiSysFunc;
+    tf_data.sysfunctype = vpiRealFunc;
+    tf_data.compiletf   = 0;
+    tf_data.sizetf      = 0;
+    tf_data.calltf      = calltf;
+    tf_data.tfname      = "$log2";
+    vpi_register_systf(&tf_data);
+}
+
+typedef void (*stfunc)(void);
+stfunc vlog_startup_routines[] = {register_interface, 0};

examples/log2-vpi-common-vpi/vpi_log2.sv

@@ -0,0 +1,22 @@
+`timescale 1ps/1ps
+
+`include "utest.vh"
+
+module vpi_log2 #(parameter ARGUMENT = 1.0,
+                  parameter SIGMA = 1e-6);
+    real dut, gold;
+
+    initial begin
+        gold = $ln(ARGUMENT) / $ln(2);
+        dut  = $log2(ARGUMENT);
+
+        `log_info(("Gold: %0f", gold));
+        `log_info((" DUT: %0f", dut));
+
+        if ($abs(gold - dut) > SIGMA)
+          `log_error(("FAIL"));
+
+        $finish;
+    end
+
+endmodule // vpi_log2

examples/log2-vpi-common-vpi/vpi_log2.utest

@@ -0,0 +1,25 @@
+;; -*- scheme -*-
+
+;; Uses one common VPI module compiled in the testbench base directory
+
+(let ((top "vpi_log2"))
+  ;; compile VPI module in the base directory
+  (if (utest/iverilog-compile-vpi "vpi_log2.c"
+                                  #:output-dir (utest/base-path)
+                                  #:name top #:libs "m")
+      (map
+       (lambda (arg)
+         (utest/tb
+          ((format "log2_~a" arg))
+
+          (utest/run-simulation-iverilog
+           "vpi_log2.sv"
+           top
+
+           #:parameters          `((ARGUMENT ,arg))
+           #:vpimods             top
+           ;; VPI modules search path
+           #:vpipaths            (utest/base-path))))
+       (iota 20))
+
+      #f))

examples/log2-vpi/utest.vh

@@ -0,0 +1,16 @@
+`ifndef UTEST_VERILOG_DEFINES
+ `define UTEST_VERILOG_DEFINES
+
+// Log level string prefixes for use with $display function.
+// Example usage: $display("%sError message", `LOG_ERR);
+ `define LOG_INFO "INFO#"
+ `define LOG_WARN "WARN#"
+ `define LOG_ERR  "FAIL#"
+
+// Dirty hacked redefine of $display function. Must be used with two parentheses.
+// Example usage: `log_info(("Information message"));
+ `define log_quiet(msg) begin $display({$sformatf msg}); end
+ `define log_info(msg)  begin $display({`LOG_INFO, $sformatf msg}); end
+ `define log_warn(msg)  begin $display({`LOG_WARN, $sformatf msg}); end
+ `define log_error(msg) begin $display({`LOG_ERR, $sformatf msg}); end
+`endif

examples/log2-vpi/vpi_log2.c

@@ -0,0 +1,67 @@
+#include <math.h>
+#include <stdlib.h>
+#include <vpi_user.h>
+
+/* --------------------------- VPI INTERFACE -------------------------------- */
+
+#define MAX_ARGS 8
+
+static int calltf(char *user_data)
+{
+    vpiHandle systfref, arg_iter;
+    vpiHandle arg_hndl[MAX_ARGS];
+    struct t_vpi_value argval;
+    int arg_cnt = 0;
+
+    for (int i = 0; i < MAX_ARGS; i++)
+        arg_hndl[i] = NULL;
+
+    systfref = vpi_handle(vpiSysTfCall, NULL);
+    arg_iter = vpi_iterate(vpiArgument, systfref);
+
+    /* ---- Get agruments ---- */
+    if (arg_iter != NULL)
+        while (arg_cnt < MAX_ARGS &&
+               NULL != (arg_hndl[arg_cnt] = vpi_scan(arg_iter)))
+            arg_cnt++;
+
+    // function $log2
+    if (arg_cnt != 1)
+        vpi_printf("ERROR: $log2() wrong argument count\n");
+    else {
+        double arg, ret;
+
+        // get argument
+        argval.format = vpiRealVal;
+        vpi_get_value(arg_hndl[0], &argval);
+        arg = argval.value.real;
+
+        ret = log2(arg);
+
+        // put return value
+        argval.format     = vpiRealVal;
+        argval.value.real = ret;
+        vpi_put_value(systfref, &argval, NULL, vpiNoDelay);
+    }
+
+    for (int i = 0; i < MAX_ARGS; i++)
+        if (arg_hndl[i]) vpi_free_object(arg_hndl[i]);
+
+    return 0;
+}
+
+static void register_interface(void)
+{
+    s_vpi_systf_data tf_data;
+
+    tf_data.type        = vpiSysFunc;
+    tf_data.sysfunctype = vpiRealFunc;
+    tf_data.compiletf   = 0;
+    tf_data.sizetf      = 0;
+    tf_data.calltf      = calltf;
+    tf_data.tfname      = "$log2";
+    vpi_register_systf(&tf_data);
+}
+
+typedef void (*stfunc)(void);
+stfunc vlog_startup_routines[] = {register_interface, 0};

examples/log2-vpi/vpi_log2.sv

@@ -0,0 +1,22 @@
+`timescale 1ps/1ps
+
+`include "utest.vh"
+
+module vpi_log2 #(parameter ARGUMENT = 1.0,
+                  parameter SIGMA = 1e-6);
+    real dut, gold;
+
+    initial begin
+        gold = $ln(ARGUMENT) / $ln(2);
+        dut  = $log2(ARGUMENT);
+
+        `log_info(("Gold: %0f", gold));
+        `log_info((" DUT: %0f", dut));
+
+        if ($abs(gold - dut) > SIGMA)
+          `log_error(("FAIL"));
+
+        $finish;
+    end
+
+endmodule // vpi_log2

examples/log2-vpi/vpi_log2.utest

@@ -0,0 +1,19 @@
+;; -*- scheme -*-
+
+;; Compile VPI module for each test
+
+(let ((top "vpi_log2"))
+  (map
+   (lambda (arg)
+     (utest/tb
+      ((format "log2_~a" arg))
+
+      (if (utest/iverilog-compile-vpi "vpi_log2.c" #:name top #:libs "m")
+          (utest/run-simulation-iverilog
+           "vpi_log2.sv"
+           top
+           #:parameters          `((ARGUMENT ,arg))
+           #:vpimods             top)
+
+          #f)))
+   (iota 20)))

examples/simple-counter/.gitignore

@@ -0,0 +1 @@
+/work

utest.scm

@@ -358,13 +358,33 @@
        (format "~a/~a" (utest/base-path) base))
    follow-symlink))
 
+;;;
+;;; Get path relative to base
+;;;
+(define (utest/base-rel path)
+  (if (absolute-file-name? path)
+      path
+      (path->absolute
+       (if (string-null? path)
+           (utest/base-path)
+           (string-append (utest/base-path) "/" path)))))
+
+;;;
+;;; Get path relative to work
+;;;
+(define (utest/work-rel path)
+  (if (absolute-file-name? path)
+      path
+      (path->absolute
+       (if (string-null? path)
+           (utest/work-path)
+           (string-append (utest/work-path) "/" path)))))
+
 ;;;
 ;;; Find files in testbench base directory
+;;;
 (define* (utest/find-files rx #:key (base "") (follow-symlink #f))
-  (let* ((base (path->absolute
-                (if (string-null? base)
-                    (utest/base-path)
-                    (format "~a/~a" (utest/base-path) base))))
+  (let* ((base (utest/base-rel base))
          (ls (list-dir base)))
     (filter (lambda (f)
               (and (not (string=? f "."))
@@ -410,8 +430,9 @@
 ;;;
 ;;; Execute system command and capture stdout and stderr to string list
 ;;;
-(define (system-to-string-list cmd)
-  (let* ((cmd (string-append cmd " 2>&1;"))
+(define* (system-to-string-list cmd #:key (pwd #f))
+  (let* ((cmd (string-append cmd " 2>&1"))
+         (cmd (if pwd (format "cd ~a; ~a" pwd cmd) cmd))
          (p (open-input-pipe cmd))
          (out (get-string-all p)))
     (values
@@ -517,6 +538,74 @@
                (if (find (lambda (x) (string-prefix? "VCD Error: " x)) output) -1 status)))
           (values (= status 0) cmdline output))))))
 
+;;;
+;;; Call iverilog-vpi tool
+;;;
+(define* (iverilog-compile-vpi sources
+                               #:key
+                               (iverilog-vpi-executable "iverilog-vpi")
+                               (output-dir #f)
+                               (name #f)                ; --name
+                               (libs '())               ; -l
+                               (libdirs '())            ; -L
+                               (includes '())           ; -I
+                               (defines '()))           ; -D
+  (define (string-or-num-param x)
+    (if (number? x)
+        (format "~a" x)
+        (format "'\"~a\"'" x)))
+
+  (let ((opts
+         (cons
+          iverilog-vpi-executable
+          (append
+           (if (and name (not (string-null? name))) (list (format "--name=~a" name)))
+           (map (lambda (x) (format "-l~a" x)) (arg-to-list libs))
+           (map (lambda (x) (format "-L~a" x)) (arg-to-list libdirs))
+           (map (lambda (x) (format "-I~a" x)) (arg-to-list includes))
+           (map (lambda (x)
+                  (if (list? x)
+                      (format "-D~a=~a" (car x) (string-or-num-param (cadr x)))
+                      (format "-D~a" x)))
+                defines)
+           (arg-to-list sources)))))
+
+    (let* ((cmdline (fold (lambda (x s) (string-append s x " ")) "" opts)))
+      (let-values (((status output)
+                    (system-to-string-list cmdline #:pwd output-dir)))
+        (values (= status 0) cmdline output)))))
+
+;;;
+;;; VPI compiler wrapper for run inside tests
+;;;
+(define* (utest/iverilog-compile-vpi sources
+                                     #:key
+                                     (iverilog-vpi-executable "iverilog-vpi")
+                                     (output-dir #f)
+                                     (name #f)
+                                     (libs '())
+                                     (libdirs '())
+                                     (includes '())
+                                     (defines '()))
+  (let ((base-path (utest/base-path))
+        (work-path (utest/work-path)))
+    (let ((sources (map (lambda (x) (path->absolute x base-path)) (arg-to-list sources)))
+          (libdirs (map (lambda (x) (path->absolute x base-path)) (arg-to-list libdirs)))
+          (includes (map (lambda (x) (path->absolute x base-path)) (arg-to-list includes))))
+      (let-values (((succ cmdl output)
+                    (iverilog-compile-vpi sources
+                                          #:iverilog-vpi-executable iverilog-vpi-executable
+                                          #:output-dir (if output-dir output-dir work-path)
+                                          #:name name
+                                          #:libs libs
+                                          #:libdirs libdirs
+                                          #:includes includes
+                                          #:defines defines)))
+        ;; Print command line and output
+        (printf "$ ~a\n" cmdl)
+        (for-each println output)
+        succ))))
+
 ;;;
 ;;; Check log for errors or warnings
 ;;;
@@ -528,6 +617,24 @@
      ((find (lambda (x) (string-prefix? sim-warn-prefix x)) log) 'warning)
      (else #t))))
 
+;;;
+;;; Return list of UTEST_* defines
+;;;
+(define (utest-verilog-defines)
+  (append
+   `((UTEST_BASE_DIR ,(format "'\"~a\"'" (utest/base-path)))
+     (UTEST_WORK_DIR ,(format "'\"~a\"'" (utest/work-path))))
+
+   (fold (lambda (x l)
+           (if (car x)
+               (append l (cdr x))
+               l))
+         '()
+         `((,(utest/verbose)      UTEST_VERBOSE)
+           (,(utest/force-dump)   UTEST_FORCE_DUMP)
+           (,(utest/keep-output)  UTEST_KEEP_OUTPUT)
+           (,(utest/restart-dump) UTEST_RESTART_DUMP)))))
+
 ;;;
 ;;; Run compile and simulation with Icarus Verilog
 ;;;
@@ -564,16 +671,13 @@
       (let ((sources (append (map (lambda (x) (path->absolute x base-path))
                                   (arg-to-list sources))
                              (list timeout-module dump-module)))
-
-            (defines (append defines
-                             `((UTEST_BASE_DIR ,(format "'\"~a\"'" base-path))
-                               (UTEST_WORK_DIR ,(format "'\"~a\"'" work-path)))))
-
+            (defines (append defines (utest-verilog-defines)))
             (includes (append (map (lambda (x) (path->absolute x base-path)) (arg-to-list includes))
                               (list base-path)))
-
             (modpaths (map (lambda (x) (path->absolute x base-path)) (arg-to-list modpaths)))
-            (vpipaths (map (lambda (x) (path->absolute x base-path)) (arg-to-list vpipaths)))
+            (vpipaths (map (lambda (x) (path->absolute x base-path))
+                           (let ((vpipaths (arg-to-list vpipaths)))
+                             (if (null? vpipaths) (list work-path) vpipaths))))
             (execfile (format "~a/~a.vvp" work-path top)))
 
         (let ((succ
@@ -620,12 +724,23 @@
 (define (collect-test-procs files)
   (fold
    (lambda (f procs)
-     (let ((f (path->absolute f)))
+     (let* ((f (path->absolute f))
+            (base (dirname f)))
        (append
         procs
-        (map (lambda (proc) (list proc (dirname f) (basename f)))
-             (let ((procs (load f)))
-               (if (list? procs) procs (list procs)))))))
+        (filter
+         car
+         (map (lambda (proc) (list proc base (basename f)))
+              (let ((procs
+                     (parameterize ((utest/base-path base)
+                                    (utest/work-path #f))
+                       (load f))))
+                (if procs
+                    (if (list? procs) procs
+                        (if (procedure? procs)
+                            (list procs)
+                            '(#f)))
+                    '(#f))))))))
    '() files))
 
 ;;;
@@ -708,7 +823,7 @@
                                                (not (eq? pass #t))))
 
                       ;; Save log
-                      (with-output-to-file (format "~a/test-log.txt" work)
+                      (with-output-to-file (format "~a/log.txt" work)
                         (lambda () (print-log log #:colorize #f #:verbose #t)))
 
                       ;; Delete work dir if test pass and no need to keep directory