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

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

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

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

(let ff empty)	;; shared variables
(let sem1)		;; semaphore

(def mon1 (cmd) ()
  (do
  (wait sem1)
  (if (= cmd 1)
    (if (= empty 0)
      (do
      (set ff (+ ff 1))
      (set empty 1)))
    ; else
    (if (= empty 1)
      (set empty 0)))
  ff
  (signal sem1)))

(def inc () (i n)
  (do
  (set i 0)
  (while (< i 20)
    (do
    (set n (mon1 1))
    (set i (+ i 1))))))

(def pff () (n)
  (do
  (set n (mon1 2))
  (print n)
  (while (< n 20)
    (do
    (set n (mon1 2))
    (print n)))))

(def main () (p1 p2)
  (do
  (di)
  (set activep 0)
  (set sseg 4000)
  (set pid 1)
  (set psw (run (switchp)))
  (set activep 0)
  (set ff 0)
  (set empty 0)
  (set sem1 (initsem 1))
  (set p1 (run (inc)))
  (set p2 (run (pff)))
  (bootnos)))