;; 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

(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))
(def != (a b) () (if (= a b) 0 1))
(def <= (a b) () (if (> a b) 0 1))
(def >= (a b) () (if (< a b) 0 1))
(defm or (a b) () (if a 1 b))
(defm and (a b) () (if a b 0))

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

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

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

;; process descriptor
;;   field:
;;   next prev id value {ip,fp,sp} inbox awaitbox msg
;;   process state (value) :
;;    1 READY, 2 RUNNING, 3 WAIT, 4 DEAD, 5 SEND, 6 RECEIVE

(defm ei () () (sys 5))			;; enable int
(defm di () () (sys 6))			;; disable int
(defm blockp () () (sys 7))		;; 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 10))       ;; new pd
  (setNext p 0)
  (setPrev p 0)
  (setValue p 1)        ;; 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))

;; ---- 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))

;; -------- 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)))

(def wakeup (p) ()
  (do
  (setValue p 1)  ;; 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 3)   	;; WAIT, to wait-list
    (setslist s (appendDL (getslist s) p))
    (blockp))			;; block
    ;; else
    (setsval s (- v 1)))
  (ei)))

;;(def saveCstate (p) () ;; (sys 8 p))
;;  (do
;;  (setv p 4 fp)
;;  (setv p 5 sp)
;;  (setv p 6 ip)))

;;(def restoreCstate (p) () ;; (sys 9 p))
;;  (do
;;  (set fp (vec p 4))
;;  (set sp (vec p 5))
;;  (set ip (vec p 6))))

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

(def runnable (p) ()
  (do
  (setValue p 2)    ;; RUNNING
  (sys 9 p)))		;; restore C-state and ei

;; nos sim is responsible to save C-state
;; before running switchp
(def switchp () (nxt)
  (do
  (di)
  (if (or (= status 10) (= status 12))
    (do                 ;; time-out/blocked
    (set nxt (getNext activep))
    (if (= nxt activep)     ;; one process
      (runnable activep)
      ;; else				;; switch next
      (do
      (setValue activep 1)  ;; READY
      (set activep nxt)
      (runnable nxt))))
    ;; else			    ;; status 11, stopped
    (do
    (set activep (deleteDL activep))
    (if (!= activep 0)
      (runnable activep))))
  (ei)))

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

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

(defm getMbox (p) () (vec p 7))
(defm getAwait (p) () (vec p 8))
(defm getMsg (p) () (vec p 9))
(defm setMbox (p m) () (setv p 7 m))
(defm setAwait (p m) () (setv p 8 m))
(defm setMsg (p m) () (setv p 9 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 5) 	;; state 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 6)	;; state 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 -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 () (p)
  (do
  (di)
  (set activep 0)
  (set sseg 1000)
  (set pid 1)
  (set p1 (run (produce 10)))
  (set p2 (run (consume)))
  (bootnos)))