;; nos   nut operating system
;;

(def print (x) () (sys 1 x))
(def printc (c) () (sys 2 c))
(def nl () () (sys 2 10))
(def space () () (sys 2 32))
(def not (b) () (if b 0 1))
(def != (a b) () (if (= a b) 0 1))
(def <= (a b) () (if (> a b) 0 1))
(def >= (a b) () (if (< a b) 0 1))
(def or (a b) () (if a 1 b))

;; ---------------------
;; global var

;; activep  the active process
;; status   10 time-out, 11 stopped, 12 blocked
;; pid      number of process created

(let activep status pid psw)
(let sseg)			;; free stack segment

(enum 10 TIMEOUT STOPPED BLOCKED)

;; ----------------------

;; process descriptor
;;   field:
;;   0 next, 1 prev,                 double link
;;   2 id,   3 value,
;;   4 fp,   5 sp,   6 ip,  7 ts,    context
;;   8 inbox, 9 awaitbox, 10 msg     mail box
;;
;;   process state (value) :
;;    1 READY, 2 RUNNING, 3 WAIT, 4 DEAD, 5 SEND, 6 RECEIVE

(enum 1 READY RUNNING WAIT DEAD SEND RECEIVE)

(def ei () () (sys 20))			;; enable int
(def di () () (sys 21))			;; disable int
(def blockp () () (sys 22))		;; block current process

;; doubly linked list
(def getNext (a) () (vec a 0))
(def getPrev (a) () (vec a 1))
(def setNext (a v) () (setv a 0 v))
(def setPrev (a v) () (setv a 1 v))

;; append a2 to the end of a1
(def appendDL (a1 a2) (b)
  (if (= a1 0)
    (do
    (setNext a2 a2)  ;; only one item
    (setPrev a2 a2)
    a2)
    ;; else
    (do
    (set b (getPrev a1))
    (setNext a2 a1)
    (setPrev a1 a2)
    (setNext b a2)
    (setPrev a2 b)
    a1)))

(def deleteDL (b) (a c)
  (if (= b (getNext b))
    0    ;; delete singleton
    ;; else
    (do
    (set a (getPrev b))
    (set c (getNext b))
    (setNext a c)
    (setPrev c a)
    c)))

;; process descriptor access functions
(def getId (p) () (vec p 2))
(def getValue (p) () (vec p 3))
(def setId (p id) () (setv p 2 id))
(def setValue (p v) () (setv p 3 v))

(def newp () (p)
  (do
  (set p (new 11))          ;; new pdes
  (setNext p 0)
  (setPrev p 0)
  (setValue p READY)
  (setv p 4 sseg)           ;; set fp'
  (setv p 5 (+ sseg 1))     ;; set sp'
  (setv p 6 0)     	    	;; set ip'
  (set sseg (+ sseg 1000))
  (setv p 7 0)
  (setv p 8 0)
  p))

;; -------- process management -------

;; show process list a
(def showp (a) (p)
  (do
  (set p a)
  (while (!= p 0)
    (do
    (print (vec p 2)) (space)
    (print (vec p 4)) (space)
    (print (vec p 7)) (space)
    (print (vec p 8)) (space)
    (set p (getNext p))
    (if (= p a) (set p 0))))
  (nl)))

;; return p
(def run (ads) (p)
  (do
  (set p (newp))        ;; new pdes
  (setId p pid)
  (set pid (+ pid 1))
  (setv p 6 ads)     	;; set ip' to call.fun
  (set activep (appendDL activep p))
  p))

(def runnable (p) () (setValue p RUNNING))

;; nos sim is responsible to save C-state
;; before running switchp
(def switchp () ()
  (do
  (di)
  (if (or (= status TIMEOUT) (= status BLOCKED))
    (do
    (setValue activep READY)
    (set activep (getNext activep))  ;; switch next
    (runnable activep))
    ; else			     ;; status STOPPED
    (do
    (setValue activep DEAD)
    (set activep (deleteDL activep))
    (if (!= activep 0)
      (runnable activep))))))

(def bootnos () ()
  (runnable activep))

;; ---- semaphore ------------
;; field: sval(value) slist(wait-list)
;; semaphore access functions

(def getsval (s) () (vec s 0))
(def getslist (s) () (vec s 1))
(def setsval (s v) () (setv s 0 v))
(def setslist (s v) () (setv s 1 v))

(def initsem (v) (s1)
  (do
  (set s1 (new 2))
  (setsval s1 v)
  (setslist s1 0)	;; wait-list nil
  s1))

(def wakeup (p) ()
  (do
  (setValue p READY)
  (set activep (appendDL activep p))))

(def signal (s) (p)
  (do
  (di)
  (set p (getslist s))
  (if (!= p 0)
    (do
    (setslist s (deleteDL p))
    (wakeup p))
    ;; else
    (setsval s (+ (getsval s) 1)))
  (ei)))

(def wait (s) (v p)
  (do
  (di)
  (set v (getsval s))
  (if (<= v 0)
    (do              	;; block activep to WAIT
    (set p activep)
    (set activep (deleteDL activep))
    (setValue p WAIT)   ;; to wait-list
    (setslist s (appendDL (getslist s) p))
    (blockp))			;; block
    ;; else
    (setsval s (- v 1)))
  (ei)))

;; --------- mailbox ----------

(def getMbox (p) () (vec p 8))
(def getAwait (p) () (vec p 9))
(def getMsg (p) () (vec p 10))
(def setMbox (p m) () (setv p 8 m))
(def setAwait (p m) () (setv p 9 m))
(def setMsg (p m) () (setv p 10 m))

;; search mail p in the box
;; return mail if found else 0
(def findmail (p box) (x y)
  (do
  (set y 0)				;; ret value
  (set x box)
  (while (!= x 0)
    (if (= x p)
      (do
      (set y x)
      (set x 0))		;; exit
      ;; else
      (do
      (set x (getNext x))
      (if (= x box)
        (set x 0))))) 	;; not found
  y))

;; p is pointer to process
(def send (p mess) (m box)
  (do
  (di)
  (set box (getAwait activep))
  (set m (findmail p box))
  (if (= m 0)
    (do
    (set m activep)	;; self
    (setMsg m mess)
    (set activep (deleteDL activep))
    (setMbox p (appendDL (getMbox p) m))
    (setValue m SEND)
    (blockp))
    ;; else
    (do				;; p is waiting
    (setMsg p mess)
    (set m (deleteDL p))
    (if (= box p)
      (setAwait activep m))
    (wakeup p)))
  (ei)))

(def receive (p) (m box)
  (do
  (di)
  (set box (getMbox activep))
  (set m (findmail p box))
  (if (= m 0)
    (do				;; put to await p
    (set m activep)	;; self
    (set activep (deleteDL activep))
    (setAwait p (appendDL (getAwait p) m))
    (setValue m RECEIVE)
    (blockp)
    (getMsg m))		;; retrieve from self
    ;; else
    (do				;; already in mbox
    (set m (deleteDL p))
    (if (= box p)
      (setMbox activep m))
    (getMsg p)		;; retrieve mbox
    (wakeup p)))
  (ei)))

;; ---- application --------

(let p1 p2)

;; send 2..n to p2 ended with -1
(def produce (n) (i)
  (do
  (set i 2)
  (while (< i n)
    (do
    (printc 33) (print i) (space)
    (send p2 i)
    (set i (+ i 1))))
  (send p2 (- 0 1))))

;; receive 2..n from p1 ended with -1
(def consume () (m flag)
  (do
  (set flag 1)
  (while flag
    (do
    (set m (receive p1))
    (printc 34) (print m) (space)
    (if (< m 0)
      (set flag 0))))
  (nl)))

(def main () ()
  (do
  (di)
  (set activep 0)
  (set sseg 4000)
  (set pid 1)
  (set psw (run (switchp)))
  (set activep 0)
  (set p1 (run (produce 100)))
  (set p2 (run (consume)))
  (bootnos)))

; End