about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorKartik K. Agaram <vc@akkartik.com>2015-01-11 22:03:16 -0800
committerKartik K. Agaram <vc@akkartik.com>2015-01-11 22:03:16 -0800
commit337a099d35e0db9693ee1a53095dc8c96b030baa (patch)
tree3e8fd5fc67a727a13d31524dbb415c518fb4c42e
parente19e7820270a8b1342153bcabc9b23ba6fdfff2c (diff)
downloadmu-337a099d35e0db9693ee1a53095dc8c96b030baa.tar.gz
535 - reading keyboard input from a channel
The problem is that once main exits it takes two characters at minimum
to truly quit: one to fill the buffer and another to overflow it and
trigger the deadlock detector.

Not the cleanest way to exit in the world either, death by deadlock.
-rw-r--r--mu.arc25
-rw-r--r--stdin.mu26
2 files changed, 49 insertions, 2 deletions
diff --git a/mu.arc b/mu.arc
index 9afccfef..dee41c17 100644
--- a/mu.arc
+++ b/mu.arc
@@ -315,6 +315,7 @@
               (set sleeping-routines*.routine*))
         rep.routine*!error
           (do (trace "schedule" "done with dead routine " top.routine*!fn-name)
+;?               (prn rep.routine*)
               (push routine* completed-routines*))
         empty.routine*
           (do (trace "schedule" "done with routine")
@@ -477,7 +478,9 @@
 
                 ; comparison
                 equal
+;?                   (do (prn (m arg.0) " vs " (m arg.1))
                   (is (m arg.0) (m arg.1))
+;?                   )
                 not-equal
                   (~is (m arg.0) (m arg.1))
                 less-than
@@ -809,7 +812,7 @@
                 (die "writing invalid array @(tostring prn.val)"))
               ; size check for non-arrays
               (when (~is sizeof.loc n)
-                (die "writing to incorrect size @(tostring prn.val) => @loc")))
+                (die "writing to incorrect size @(tostring pr.val) => @loc")))
             (let addrs (addrs addr n)
               (each (dest src) (zip addrs rep.val)
                 (trace "setm" loc ": setting " dest " to " src)
@@ -1845,13 +1848,30 @@
   (reply result:string-address-array-address)
 )
 
+(init-fn send-keys-to-stdin
+  (default-space:space-address <- new space:literal 30:literal)
+  (stdin:channel-address <- next-input)
+  { begin
+    (c:character <- read-key)
+    (loop-unless c:character)
+;?     (print-primitive (("AAA " literal)))
+;?     (print-primitive c:character)
+    (curr:tagged-value <- save-type c:character)
+    (stdin:channel-address/deref <- write stdin:channel-address curr:tagged-value)
+;?     (print-primitive (("keyboard: stdin is " literal)))
+;?     (print-primitive stdin:channel-address)
+;?     (print-primitive (("\n" literal)))
+    (loop)
+  }
+)
+
 ; after all system software is loaded:
 (freeze system-function*)
 )  ; section 100 for system software
 
 ;; load all provided files and start at 'main'
 (reset)
-;? (new-trace "main")
+(new-trace "main")
 ;? (set dump-trace*)
 (awhen (pos "--" argv)
   (map add-code:readfile (cut argv (+ it 1)))
@@ -1863,6 +1883,7 @@
 ;?   (prn function*!factorial)
   (run 'main)
   (if ($.current-charterm) ($.close-charterm))
+  (when ($.graphics-open?) ($.close-viewport Viewport) ($.close-graphics))
   (prn "\nmemory: " int-canon.memory*)
   (each routine completed-routines*
     (aif rep.routine!error (prn "error - " it)))
diff --git a/stdin.mu b/stdin.mu
new file mode 100644
index 00000000..9f2baafb
--- /dev/null
+++ b/stdin.mu
@@ -0,0 +1,26 @@
+(function main [
+  (default-space:space-address <- new space:literal 30:literal)
+  (console-on)
+  (clear-screen)
+  ; hook up stdin
+  (stdin:channel-address <- init-channel 1:literal)
+;?   (print-primitive (("main: stdin is " literal)))
+;?   (print-primitive stdin:channel-address)
+;?   (print-primitive (("\n" literal)))
+  (fork send-keys-to-stdin:fn nil:literal/globals nil:literal/limit stdin:channel-address)
+  ; now read characters from stdin
+  (print-primitive (("? " literal)))
+  { begin
+    (x:tagged-value stdin:channel-address/deref <- read stdin:channel-address)
+    (c:character <- maybe-coerce x:tagged-value character:literal)
+;?     (print-primitive (("main: stdin is " literal)))
+;?     (print-primitive stdin:channel-address)
+;?     (print-primitive (("\n" literal)))
+;?     (print-primitive (("check: " literal)))
+;?     (print-primitive c:character)
+    (done?:boolean <- equal c:character ((#\q literal)))
+    (break-if done?:boolean)
+    (print-primitive c:character)
+    (loop)
+  }
+])