#!/usr/local/bin/txr
(defvar *regs* #H(nil))
(defvar *cpid* nil)
(defvar *nsent* 0)
(defvar *pc* 0)
(defvar *tx* nil)
(defvar *rx* nil)
(defvar *prg*
  (awk
   (:let (prg nil))
   (t (push (cons
             (cond
               ((equal (car f) "set") 'prg-set)
               ((equal (car f) "mod") 'prg-mod)
               (t (intern (car f))))
             (mapcar (lambda (s)
                       (cond
                         ((not (chr-isalpha [s 0]))
                          (int-str s))
                         (t (list 'quote (intern s)))))
                     (cdr f)))
            prg))
   (:end
    (vec-list (nreverse prg)))))

(defun cleanup ()
  (close-stream *tx*)
  (close-stream *rx*)
  (when *cpid*
    (format t "~a\n" *nsent*)
    (wait *cpid*))
  (exit 0))

(defun retr (v)
  (if (symbolp v) (or [*regs* v] 0) v))

(defun snd (x)
  (catch (format *tx* "~a\n" (retr x))
    (recover (e) (cleanup)))
  (flush-stream *tx*)
  (inc *nsent*)
  (inc *pc*))
(defun prg-set (x y)
  (set [*regs* x] (retr y))
  (inc *pc*))
(defun add (x y)
  (inc [*regs* x] (retr y))
  (inc *pc*))
(defun mul (x y)
  (set [*regs* x] (* (or [*regs* x] 0) (retr y)))
  (inc *pc*))
(defun prg-mod (x y)
  (set [*regs* x] (mod [*regs* x] (retr y)))
  (inc *pc*))
(defun rcv (x)
  (if (poll (list (cons *rx* poll-in)) 5000)
      (set [*regs* x] (int-str (or (get-line *rx*) (cleanup))))
      ;the or is in case the get-line returns nil, indicating end of stream
      (cleanup))
  (inc *pc*))
(defun jgz (x y)
  (if (> (retr x) 0)
      (inc *pc* (retr y))
      (inc *pc*)))

(let* ((cwrite (pipe))
       (pwrite (pipe))
       (pid (fork)))
  (unless (zerop pid)
    (set *cpid* pid))
  (let ((rp (if *cpid* cwrite pwrite))
        (wp (if *ischld* pwrite cwrite)))
    (set *tx* (open-fileno (cdr wp) "w"))
    (close-stream (open-fileno (car wp) "r"))
    (set *rx* (open-fileno (car rp) "r"))
    (close-stream (open-fileno (cdr rp) "w"))
    (set [*regs* 'p] (if *ischld* 0 1))))

(while (and (>= *pc* 0)
            (< *pc* (len *prg*)))
  (eval [*prg* *pc*]))

(cleanup)