From: plugd <plugd@thelambdalab.xyz>
Date: Thu, 14 Nov 2019 23:29:23 +0000 (+0100)
Subject: Removed some debug code.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=943e709157da251d669a5a5e59f470a1d6672f79;p=jars.git

Removed some debug code.
---

diff --git a/mars.scm b/mars.scm
index d7a0de2..5ea1fba 100644
--- a/mars.scm
+++ b/mars.scm
@@ -10,18 +10,13 @@
 ;;; Constants
 ;;
 
-(define core-size 8000)
+(define core-size 20)
 (define max-steps 10000)
 
 
 ;;; Instructions
 ;;
 
-(define ((blah x y) . args)
-  (match args
-    (('x q) (+ x q) q)
-    (('y q) y)))
-
 (define ((make-instr opcode modifier A-mode A-num B-mode B-num name) . args)
   (match args
     (('copy n) (make-instr opcode modifier A-mode A-num B-mode B-num n))
@@ -33,10 +28,10 @@
     (('B-num) B-num)
     (('name) name)
     (('print) (print opcode
-                     (if (null? modifier) "" (concat "." modifier))
+                     (if (null? modifier) "" (conc "." modifier))
                      " " (mode-string A-mode) A-num
                      ", " (mode-string B-mode) B-num
-                     (if (null? name) "" (concat " ; " name))))
+                     (if (null? name) "" (conc " ; " name))))
     (('set-opcode! x n) (set! opcode x) (set! name n))
     (('set-modifier! x n) (set! modifier x) (set! name n))
     (('set-A-mode! x n) (set! A-mode x) (set! name n))
@@ -58,6 +53,7 @@
 (define initial-instruction
   (make-instr 'DAT '() 'immediate 0 'immediate 0 '()))
 
+
 ;;; Memory setup and addressing
 ;;
 
@@ -65,10 +61,16 @@
 
 (define (initialize-core)
   (let loop ((i 0))
-    (unless (< i core-size)
+    (unless (>= i core-size)
       (vector-set! core i (initial-instruction 'copy '()))
       (loop (+ i 1)))))
 
+(define (core-dump)
+  (let loop ((i 0))
+    (unless (>= i core-size)
+      ((vector-ref core i) 'print)
+      (loop (+ i 1)))))
+
 (define (addr+ . args)
   (foldl (lambda (a b)
            (modulo (+ a b core-size) core-size))
@@ -78,7 +80,7 @@
 ;;
 
 (define (make-prog name instrs offset)
-  (list name instructions offset))
+  (list name instrs offset))
 
 (define (prog-name prog) (list-ref prog 0))
 (define (prog-instrs prog) (list-ref prog 1))
@@ -88,7 +90,7 @@
   (let loop ((ptr addr)
              (instrs (prog-instrs prog)))
     (unless (null? instrs)
-      (vector-set! core ptr (instr-copy (car instrs)))
+      (vector-set! core ptr ((car instrs) 'copy (prog-name prog)))
       (loop (addr+ ptr 1) (cdr instrs))))
   (make-player (prog-name prog)
                (addr+ addr (prog-offset prog))))
@@ -98,10 +100,10 @@
              (remaining prog-len))
     (if (= remaining 0)
         #t
-        (if ((vector-ref core ptr) 'name)
-            #f
+        (if (null? ((vector-ref core ptr) 'name))
             (loop (addr+ ptr 1)
-                  (- remaining 1))))))
+                  (- remaining 1))
+            #f))))
 
 (define (install-progs progs)
   (let loop ((players '())