;; nos   nut operating system
;;
;;  start                   12 Jan 2005
;;  run a single thread     21 Jan 2005
;;  run multi thread        24 Jan 2005
;;  signal wait, working    27 Jan 2005
;;  send, receive           20 Feb 2005

;;  nos0 a multi thread, no semaphore
;;  update to nut compiler  13 Aug 2006
;;  update to new noss      20 Aug 2006
;;  semaphore               20 Aug 2006
;;  mail-box                20 Aub 2006

(defm print (x) () (sys 1 x))
(defm printc (c) () (sys 2 c))
(defm nl () () (sys 2 10))
(defm space () () (sys 2 32))
(defm not (b) () (if b 0 1))
(defm != (a b) () (if (= a b) 0 1))
(defm <= (a b) () (if (> a b) 0 1))
(defm >= (a b) () (if (< a b) 0 1))
(defm 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)

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

;; doubly linked list
(defm getNext (a) () (vec a 0))
(defm getPrev (a) () (vec a 1))
(defm setNext (a v) () (setv a 0 v))
(defm 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
(defm getId (p) () (vec p 2))
(defm getValue (p) () (vec p 3))
(defm setId (p id) () (setv p 2 id))
(defm 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))

(defm 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))))))

(defm bootnos () ()
  (runnable activep))

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

(defm getsval (s) () (vec s 0))
(defm getslist (s) () (vec s 1))
(defm setsval (s v) () (setv s 0 v))
(defm 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 ----------

(defm getMbox (p) () (vec p 8))
(defm getAwait (p) () (vec p 9))
(defm getMsg (p) () (vec p 10))
(defm setMbox (p m) () (setv p 8 m))
(defm setAwait (p m) () (setv p 9 m))
(defm 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)))

