aboutsummaryrefslogtreecommitdiff
path: root/tests/discovery.scm
blob: 753e6a897972feb276e81abbcf2c7aef7db27c6a (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-discovery)
  #:use-module (guix discovery)
  #:use-module (guix build-system)
  #:use-module (guix utils)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match))

(define %top-srcdir
  (dirname (search-path %load-path "guix.scm")))

(test-begin "discovery")

(test-assert "scheme-modules"
  (match (map module-name (scheme-modules %top-srcdir "guix/import"))
    ((('guix 'import _ ...) ..1)
     #t)))

(test-assert "scheme-modules recurses in symlinks to directories"
  (call-with-temporary-directory
   (lambda (directory)
     (mkdir (string-append directory "/guix"))
     (symlink (string-append %top-srcdir "/guix/import")
              (string-append directory "/guix/import"))

     ;; DIRECTORY/guix/import is a symlink but we want to make sure
     ;; 'scheme-modules' recurses into it.
     (match (map module-name (scheme-modules directory))
       ((('guix 'import _ ...) ..1)
        #t)))))

(test-equal "scheme-modules, non-existent directory"
  '()
  (scheme-modules "/does/not/exist"))

(test-assert "all-modules"
  (match (map module-name
              (all-modules `((,%top-srcdir . "guix/build-system"))))
    ((('guix 'build-system names) ..1)
     names)))

(test-assert "fold-module-public-variables"
  (let ((modules (all-modules `((,%top-srcdir . "guix/build-system")))))
    (match (fold-module-public-variables (lambda (obj result)
                                           (if (build-system? obj)
                                               (cons obj result)
                                               result))
                                         '()
                                         modules)
      (((? build-system? bs) ..1)
       bs))))

(test-end "discovery")
class='ctx'> # Add other tests here if You need
TESTS := \
diff --git a/design/stack_machine.v b/design/stack_machine.v
index 150f6c7..b6c2706 100644
--- a/design/stack_machine.v
+++ b/design/stack_machine.v
@@ -220,6 +220,10 @@ module stack_machine_new
assign instr_mul = !set_im && !use_im && stack_shrinks_by_1 &&
instruction[11:0] == 12'd3;
+ wire instr_cond_jump;
+ assign instr_cond_jump = use_im && stack_shrinks_by_1 &&
+ instruction[11:7] == 5'd1;
+
reg halt; /* Set once a halt instruction is encountered */
assign finished = halt;
@@ -519,6 +523,13 @@ module stack_machine_new
if (instr_mul && arithmetic_uncompleted)
r1 <= r0 * r1;
+
+ if (instr_cond_jump && arithmetic_uncompleted) begin
+ r1 <= r0;
+
+ if (r1)
+ `SET_PC(im_effective);
+ end
end // case: STEP_EXECUTING
endcase // case (step)
end // else: !if(RST_I)
diff --git a/tclasm.tcl b/tclasm.tcl
index 1f716ee..cafe99f 100644
--- a/tclasm.tcl
+++ b/tclasm.tcl
@@ -195,3 +195,12 @@ proc div {} {
proc mul {} {
puts 0011000000000011
}
+
+
+proc _cond_jump {address_part} {
+ puts 011100001[__to_binary $address_part 7]
+}
+
+proc cond_jump {address} {
+ _with_im _cond_jump $address
+}
diff --git a/tests/stack_machine_cond_jump/instructions.s.tcl b/tests/stack_machine_cond_jump/instructions.s.tcl
new file mode 100755
index 0000000..d1d5809
--- /dev/null
+++ b/tests/stack_machine_cond_jump/instructions.s.tcl
@@ -0,0 +1,34 @@
+#!/usr/bin/env tclsh
+
+source tclasm.tcl
+
+## also look at stack_machine_jump test
+
+## we're going to write numbers from 0 to 7 to addresses h400 - h41C
+
+# this will translate to 1 16-bit instruction
+set_sp 0
+
+## set up the counter (1 16-bit instruction)
+const 0
+
+## this is the point we later jump to, address 4
+tee
+tee
+## compute address: counter * 4 + h400 and save counter to it
+const 4
+mul
+swap
+store+ h400
+
+## increase counter by 1
+const 1
+add
+## compare value of counter to 8
+tee
+const 8
+sub
+## loop if counter != 8
+cond_jump 4
+
+halt
diff --git a/tests/stack_machine_cond_jump/test.v b/tests/stack_machine_cond_jump/test.v
new file mode 120000
index 0000000..f5b6a59
--- /dev/null
+++ b/tests/stack_machine_cond_jump/test.v
@@ -0,0 +1 @@
+../stack_machine_store/test.v \ No newline at end of file
diff --git a/tests/stack_machine_cond_jump/words_to_verify.mem b/tests/stack_machine_cond_jump/words_to_verify.mem
new file mode 100644
index 0000000..aa047b5
--- /dev/null
+++ b/tests/stack_machine_cond_jump/words_to_verify.mem
@@ -0,0 +1,6 @@
+// address value
+ 00400 0 // verify the first number written
+
+ 00408 2 // verify a number in the middle
+
+ 0041C 7 // verify the last number