; eval.txt   n-code evaluator
;
;   eval in nut
;   partially implement only 12 operators
;   to run the test program "t2.txt"

; include lib.txt

; -------- header ----------

(enum 0 NIL)
(enum 3000 STKMAX)		; run-time stack

(enum 1
  xIF xWHILE xDO xUD1 xNEW xADD xSUB xMUL xDIV
  xEQ xLT xGT xCALL xGET xPUT xLIT xLDX xSTX xFUN
  xSYS xSET xSETV xVEC xUD2 xLD xST xLDY xSTY xUD3
  xUD4 xUD5 xSTR xBAND xSHR xSHL)

(let tok DP CS M)		; data pointer, code segment
(let SS SP FP)			; stack, stk pointer, frame pointer

(def init () ()
  (do
  (set M 0)				; base ads, absolute
  (set SS (new STKMAX))
  (set FP SS)
  (set SP SS)))

; ----- system --------

(def tokenise () ()
  (set tok (sys 3)))

(def prList e () (sys 10 e))

(def de_op x () (& (>> x 24) 127))
(def de_arg x () (& x 16777215))	; x & 0x0ffffff

(def isATOM e () (< e 0))	; MSB bit 1
(def mkATOM (op arg) ()
  (+ (<< (+ (& op 127) 128) 24) (& arg 16777215)))

; ------- load oject -----------

(let Start)		; ads of "main"

; read a token from stdin
; and convert it to a number
(def read () ()
  (do
  (tokenise)
  (atoi tok)))

; offset a by disp, code segment started at 2
(def shift (a disp) ()
  (if a
    (- (+ a disp) 2)
    0))

; relocate arg of an op
(def reName (op arg) ()
  (do
  (if (= op xCALL)
    (set arg (shift arg CS))
  (if (or (= op xLD) (= op xST))
    (set arg (shift arg DP))
  (if (or (= op xLDY) (= op STY))
    (set arg (shift arg DP))
  (if (= op xSTR)
    (set arg (shift arg DP))))))
  (mkATOM op arg)))

; load object, code segment, data segment
(def loadobj () (flag end a a2 ads ty op arg next)
  (do
  (set CS (sys 9))		; start of code segment
  (set Start (read))		; ads of "main"
  (set end (read))
  (set DP (+ (+ CS end) 2)) ;  start of data segment
  (set flag 1)
  (while flag
    (do
    (set ads (read))
    (set ty (read))
    (set op (read))
    (set arg (read))
    (set next (read))
    (if ty
      (set a (reName op arg))
      ; else dot-pair
      (set a (shift (+ (<< op 24) arg) CS)))
    (set a2 (new 2))
    (sethead a2 a)
    (settail a2 (shift next CS))
    (if (= ads end) (set flag 0))))

    ; load data segment
    (set a 0)
    (set end (read))
    (set a2 (new end))	; alloc the whole block
    (while (< a end)
      (do
      (setv a2 a (read))
      (set a (+ a 1))))))

(def listall () (i a op end)
  (do
  (set i CS)
  (set end (sys 9))
  (while (< i end)
    (do
    (set a (head i))
    (set op (de_op a))
    (if (= op xFUN)
      (do
      (print i) (space)
      (prList i) (nl)))
    (set i (+ i 2))))))

; --------- eval ----------

; push a value to run-time stack
(def push e ()
  (do
  (set SP (+ SP 1))
  (if (> SP (+ SS STKMAX))
    (error "stack overflow"))
  (setv M SP e)))

(def eval e () 0) 	; forward declaration

; system call, implement print, printc
(def syscall (arg e) (v a1)
  (do
  (set v NIL)
  (set a1 (eval (arg1 e)))
  (if (= arg 1) (sys 1 a1)
  (if (= arg 2) (sys 2 a1)
  ; else
  (error "undef sys")))
  v))

; fun.a.v no recode
(def funcall (arg e) (k v a)
  (do
  (set v (& arg 255))		; decode a, v
  (set a (>> arg 8))
  (set k (+ (- v a) 1))
  (setv M (+ SP k) FP)		; save old FP
  (set FP (+ SP k))			; new frame
  (set SP FP)
  (set v (eval (arg1 e)))	; eval body
  (set SP (- (- FP v) 1))	; delete frame
  (set FP (vec M FP))		; restore FP
  v))

; the main interpreter for n-code
; partially implement only 12 operators
(def eval e (e1 op arg v idx)
  (if (= e NIL)
    NIL
    ; else
    (do
    (if (not (isATOM e))	; if it is a list
      (do			; set e1 to arglist
      (set e1 (tail e))		; and e to operator
      (set e (head e))))
    (set op (de_op e))
    (set arg (de_arg e))	; decode operator
    (if (= op xIF)
      (if (eval (arg1 e1))
        (set v (eval (arg2 e1)))
        ; else
        (set v (eval (arg3 e1))))
    (if (= op xDO)
      (while e1
        (do
        (set v (eval (head e1)))
        (set e1 (tail e1))))
    (if (= op xADD)
      (set v (+ (eval (arg1 e1)) (eval (arg2 e1))))
    (if (= op xCALL)
      (do
      (while e1			; eval all arg
        (do			; and push it to stack
        (push (eval (head e1)))
        (set e1 (tail e1))))
      (set v (eval arg)))	; eval body of fun
    (if (= op xLIT)
      (set v arg)
    (if (= op xSTR)
      (set v arg)
    (if (= op xGET)
      (set v (vec M (- FP arg)))
    (if (= op xLD)
      (set v (vec M arg))
    (if (= op xST)
      (do
      (set v (eval (arg1 e1)))
      (setv M arg v))
    (if (= op xLDX)
      (do
      (set idx (eval (arg1 e1)))
      (set v (vec M (+ (vec M (- FP arg)) idx))))
    (if (= op xFUN)
      (set v (funcall arg e1))
    (if (= op xSYS)
      (set v (syscall arg e1))
    ; else
    (error "unknown op")))))))))))))
    v)))

(def main () ()
  (do
  (sys 11)		; readinfile
  (loadobj)
;  (listall)
  (init)
  (eval (shift Start CS))))

; End

;  t2.txt
;  input test file for eval.txt
;(enum 10 xAA xBB)
;(let gv tv)
;
;(def prints s ()
;  (if (vec s 0)
;    (do
;    (sys 2 (vec s 0))
;    (prints (+ s 1)))))
;
;(def add1 x () (+ x 1))
;
;(def main () (a)
;  (do
;  (set tv 5)
;  (setv a 1 22)
;  (vec a 2)
;  (setv gv 2 33)
;  (vec gv 3)
;  (prints "string")
;  (sys 1 (add1 xBB))))