X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=jars.git;a=blobdiff_plain;f=test.scm;fp=test.scm;h=0000000000000000000000000000000000000000;hp=178260d5ebd19e7d1b211ad251afc269f8ede895;hb=bebac0e359cb9ce7aa72aeb217dcc57301e26a51;hpb=865c1d7803580802c1f6048be60f7358e87b50e4

diff --git a/test.scm b/test.scm
deleted file mode 100644
index 178260d..0000000
--- a/test.scm
+++ /dev/null
@@ -1,67 +0,0 @@
-(import (chicken io)
-        mars visualizer parser)
-
-;; (define addressing-test
-;;   (make-prog 'at (list
-;;                   (make-instr 'DAT 'F 'immediate 42 'immediate 53)
-;;                   (make-instr 'DAT 'F 'immediate 123 'immediate 256)
-;;                   (make-instr 'MOV 'A 'indirect-B 4 'direct 7)
-;;                   (make-instr 'NOP 'I 'immediate 0 'immediate 0)
-;;                   (make-instr 'NOP 'I 'immediate 0 'immediate 0)
-;;                   (make-instr 'NOP 'I 'immediate 0 'immediate 0)
-;;                   (make-instr 'DAT 'F 'immediate -5 'immediate -6)) 2))
-
-;; (define imp
-;;   (make-prog 'imp (list (make-instr 'MOV 'I 'direct 0 'direct 1)) 0))
-
-;; (define dwarf
-;;   (make-prog 'dwarf (list
-;;                      (make-instr 'DAT 'F 'immediate 0 'immediate -1)
-;;                      (make-instr 'ADD 'AB 'immediate 5 'direct -1)
-;;                      (make-instr 'MOV 'I 'direct -2 'indirect-B -2)
-;;                      (make-instr 'JMP 'I 'immediate -2 'immediate 0)) 1))
-
-(condition-case
-    (vis 'destroy)
-  ((exn) #f))
-
-;; (define files '("dwarf.red"))
-(define files '("imp.red" "dwarf.red"))
-
-(define progs
-  (map
-   (lambda (fname)
-     (string->prog (with-input-from-file fname read-string)))
-   files))
-
-(define colors '("red" "blue" "green" "magenta" "cyan"))
-
-(define color-map
-  (let loop ((entries '())
-             (progs-left progs)
-             (colors-left colors))
-    (if (null? progs-left)
-        entries
-        (let ((this-prog (car progs-left))
-              (this-col (car colors-left)))
-          (loop (cons (cons (prog-name this-prog) this-col) entries)
-                (cdr progs-left)
-                (cdr colors-left))))))
-        
-(define vis (make-vis 640 480 8000 color-map))
-
-(define core (make-core 8000 (make-instr 'DAT 'F 'immediate 0 'immediate 0)
-                        (lambda (i n)
-                          (vis 'update-owner i n))))
-
-(define queues (install-progs core progs))
-
-(for-each dump-prog progs)
-
-(set! queues (run-mars core queues 10000))
-
-(for-each (lambda (q)
-            (print "Queue for " (queue-owner q) ":")
-            (dump-queue q core)
-            (print))
-          queues)