From 1debdb2ba8cc48d17925286bae245d01682acfd6 Mon Sep 17 00:00:00 2001
From: d_m <d_m@plastic-idolatry.com>
Date: Tue, 4 Feb 2025 23:11:58 -0500
Subject: [PATCH] add -raw mode for vm.scm

---
 vm.scm | 95 +++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 65 insertions(+), 30 deletions(-)

diff --git a/vm.scm b/vm.scm
index 48939a0..1d0a7b0 100644
--- a/vm.scm
+++ b/vm.scm
@@ -7,15 +7,18 @@
 ;; === implementation-dependent functions; uncomment one stanza
 
 ;; chicken scheme
-(import (chicken bitwise) (chicken process-context) (chicken time posix))
-(define (get-u8 port)
-  (let ((c (read-char port))) (if (eof-object? c) c (char->integer c))))
+(import (chicken bitwise))
+(import (chicken file))
+(import (chicken process))
+(import (chicken process-context))
+(import (chicken time posix))
+(import (chicken io))
+(define (get-u8 port) (read-byte port))
 (define (open-rom path) (open-input-file path #:binary))
 (define (get-date-time)
   (let* ((v (seconds->local-time))
          (y (vector-ref v 5)))
-    (vector-set! v 5 (+ y 1900))
-    v))
+    (vector-set! v 5 (+ y 1900)) v))
 
 ;; ;; guile, invoke with guile vm.scm ROM ...
 ;; (use-modules (srfi srfi-60) (ice-9 binary-ports))
@@ -69,6 +72,8 @@
 (define rst (cons 0 (make-vector 256 0)))
 (define pc 256)
 (define done #f)
+(define raw-tty #f)
+(define saved-tty '())
 
 ;; instruction modes
 (define _2 #f)
@@ -245,8 +250,8 @@
    ((= 4 port) (set-car! wst byte))
    ((= 5 port) (set-car! rst byte))
    ((= 14 port) (u:debug))
-   ((= 24 port) (write-char (integer->char byte) (current-output-port)))
-   ((= 25 port) (write-char (integer->char byte) (current-error-port)))
+   ((= 24 port) (write-byte byte (current-output-port)))
+   ((= 25 port) (write-byte byte (current-error-port)))
    (* '())))
 
 (define (u:debug)
@@ -345,26 +350,28 @@
         (fn)
         (u:eval))))
 
+(define (u:exit n) (u:restore-tty) (exit n))
+
 (define (u:run addr)
   (set! done #f)
   (set! pc addr)
   (u:eval)
   (let ((n (vector-ref dev 15)))
     (if (= n 0) '()
-        (exit (bitwise-and n 127)))))
+        (u:exit (bitwise-and n 127)))))
 
 (define (u:read-args args)
   (if (null? args)
-      (u:send-input #\newline 4)
+      (u:send-input 10 4)
       (begin
         (u:read-arg (string->list (car args)))
-        (if (null? (cdr args)) '() (u:send-input #\newline 3))
+        (if (null? (cdr args)) '() (u:send-input 10 3))
         (u:read-args (cdr args)))))
 
 (define (u:read-arg chars)
   (if (null? chars) '()
       (begin
-        (u:send-input (car chars) 2)
+        (u:send-input (char->integer (car chars)) 2)
         (u:read-arg (cdr chars)))))
 
 ;; send a character of console input with type
@@ -373,22 +380,22 @@
 ;; - 2 argument data
 ;; - 3 spacer between arguments
 ;; - 4 spacer after arguments, or end of stdin
-(define (u:send-input c type)
+(define (u:send-input n type)
   (let* ((hi (vector-ref dev 16))
          (lo (vector-ref dev 17))
          (addr (hilo->u16 hi lo)))
     (if (= 0 addr) '()
         (begin
-          (vector-set! dev 18 (u8 (char->integer c)))
+          (vector-set! dev 18 (u8 n))
           (vector-set! dev 23 (u8 type))
           (u:run addr)))))
 
 (define (u:read-stdin port)
-  (let ((c (read-char port)))
-    (if (eof-object? c)
-        (u:send-input #\newline 4)
+  (let ((byte (read-byte port)))
+    (if (eof-object? byte)
+        (u:send-input 10 4)
         (begin
-          (u:send-input c 1)
+          (u:send-input byte 1)
           (u:read-stdin port)))))
 
 ;; load a ROM from a file, byte-by-byte
@@ -399,16 +406,44 @@
         (begin (vector-set! mem addr (u8 byte))
                (u:load-rom rom (+ addr 1))))))
 
-(let ((prog-args (command-line-arguments)))
-  (if (null? prog-args)
-      (begin (display "usage: ./vm ROM [ARGS...]\n") (exit))
-      (let* ((rom-path (car prog-args))
-             (rom-args (cdr prog-args))
-             (rom (open-rom rom-path))
-             (start 256))
-        (vector-set! dev 23 (if (null? rom-args) 0 1))
-        (u:load-rom rom start)
-        (u:run start)
-        (if (null? rom-args) '() (u:read-args rom-args))
-        (u:read-stdin (current-input-port))
-        (exit 0))))
+(define (u:read-cmd cmd)
+  (with-input-from-pipe cmd (lambda () (read-string #f (current-input-port)))))
+
+(define (u:usage)
+  (display "usage: ./vm [-raw] ROM [ARGS...]\n")
+  (exit))
+
+(define (u:parse-args args)
+  (if (null? args) (u:usage))
+  (if (equal? (car args) "-raw")
+      (begin (set! raw-tty #t)
+             (u:parse-args (cdr args)))
+      args))
+
+(define (u:check-rom path)
+  (if (and (file-exists? path) (file-readable? path)) '()
+      (begin (display "ERROR: cannot open ROM '")
+             (display path)
+             (display "'\n")
+             (u:usage))))
+
+(define (u:set-tty)
+  (if raw-tty (begin (set! saved-tty (u:read-cmd "stty -g"))
+                     (system* "stty raw -echo"))))
+
+(define (u:restore-tty)
+  (if raw-tty (system* (string-append "stty " saved-tty))))
+
+(let* ((prog-args (u:parse-args (command-line-arguments)))
+       (_ (u:set-tty))
+       (rom-path (car prog-args))
+       (rom-args (cdr prog-args))
+       (_ (u:check-rom rom-path))
+       (rom (open-rom rom-path))
+       (start 256))
+  (vector-set! dev 23 (if (null? rom-args) 0 1))
+  (u:load-rom rom start)
+  (u:run start)
+  (if (null? rom-args) '() (u:read-args rom-args))
+  (u:read-stdin (current-input-port))
+  (u:exit 0))