;;; -*- Mode:LISP; Package:SIM; Readtable:CL; Base:10 -*-

(define-asm first-loop ()
  (alu (active 0) <- (active 0) add (active 1))
  (jump always 0))

(define-asm loop2 ()
  (alu (active 0) <- (active 0) add (active 1))
  (sim sim-halt))

(defun setup-function (name)
  (reset-proc *proc*)
  (store-function-into-main-memory name 0)
  (setf (proc-pc *proc*) 0)
  (setf (proc-next-pc *proc*) (1+ (proc-pc *proc*)))
  (setf (proc-noop-next-bit *proc*) 0)
  (setf (aref (proc-frames *proc*) 1) 1))

(define-asm loop3 ()
begin
  (alu (active 0) <- (active 0) add (active 1))
  (jump always foo)
  (alu (active 2) <- (active 2) add (active 3))
  (jump always bar)
foo
  (alu (active 4) <- (active 4) add (active 5))
  (jump always begin)
bar
  (alu (active 6) <- (active 6) add (active 7))
  (jump always foo))

(define-asm add ()
  (alu (active 0) <- (active 0) add (active 1))
  (return))

(define-asm call-add ()
  (open)
  (alu (open 0) <- (active 0) set1 (active 0))
  (alu (open 1) <- (active 1) set1 (active 0))
  (call add)
  (sim sim-halt))

(defun load-functions (&rest functions)
  (reset-proc *proc*)
  (clear-symbols)
  (let ((adr 0))
    (dolist (f functions)
      (add-symbol f adr)
      (setq adr (store-function-into-main-memory f adr))))
  )

(defun setup-test ()
  (write-active 0 1)
  (write-active 1 2))


;***** CODE FOR TAK FOLLOWS ***** (X Y Z)
(define-asm tak ()
  (ALU (GLOBAL 0) <- (ACTIVE 1) SUB (ACTIVE 0))
  (JUMP LESS-THAN TRUE-BRANCH-7597)
  (ALU (active 0) <- (ACTIVE 2) SET-SOURCE-1 (GLOBAL 0))
  (RETURN)
TRUE-BRANCH-7597
  (TAIL-RECURSIVE-OPEN)
  (OPEN)
  (ALU (OPEN 0) <- (ACTIVE 0) M-MINUS-ONE (GLOBAL 0))
  (ALU (OPEN 1) <- (ACTIVE 1) SET-SOURCE-1 (GLOBAL 0))
  (ALU (OPEN 2) <- (ACTIVE 2) SET-SOURCE-1 (GLOBAL 0))
  (CALL TAK)
  (ALU (OPEN 0) <- (RETURN 0) SET-SOURCE-1 (GLOBAL 0))
  (OPEN)
  (ALU (OPEN 0) <- (ACTIVE 1) M-MINUS-ONE (GLOBAL 0))
  (ALU (OPEN 1) <- (ACTIVE 2) SET-SOURCE-1 (GLOBAL 0))
  (ALU (OPEN 2) <- (ACTIVE 0) SET-SOURCE-1 (GLOBAL 0))
  (CALL TAK)
  (ALU (OPEN 1) <- (RETURN 0) SET-SOURCE-1 (GLOBAL 0))
  (OPEN)
  (ALU (OPEN 0) <- (ACTIVE 2) M-MINUS-ONE (GLOBAL 0))
  (ALU (OPEN 1) <- (ACTIVE 0) SET-SOURCE-1 (GLOBAL 0))
  (ALU (OPEN 2) <- (ACTIVE 1) SET-SOURCE-1 (GLOBAL 0))
  (CALL TAK)
  (ALU (OPEN 2) <- (RETURN 0) SET-SOURCE-1 (GLOBAL 0))
  (TAIL-RECURSIVE-CALL TAK)
  )


(define-asm tak ()
  (ALU (GLOBAL 0) <- (ACTIVE 1) SUB (ACTIVE 0))
  (JUMP LESS-THAN TRUE-BRANCH-7597)
  (RETURN-xct-next)
 (ALU (active 0) <- (ACTIVE 2) SET-SOURCE-1 (GLOBAL 0))
TRUE-BRANCH-7597
  (TAIL-RECURSIVE-OPEN)
  (OPEN)
  (ALU (OPEN 0) <- (ACTIVE 0) M-MINUS-ONE (GLOBAL 0))
  (ALU (OPEN 1) <- (ACTIVE 1) SET-SOURCE-1 (GLOBAL 0))
  (CALL-xct-next TAK)
 (ALU (OPEN 2) <- (ACTIVE 2) SET-SOURCE-1 (GLOBAL 0))
  (ALU (OPEN 0) <- (RETURN 0) SET-SOURCE-1 (GLOBAL 0))
  (OPEN)
  (ALU (OPEN 0) <- (ACTIVE 1) M-MINUS-ONE (GLOBAL 0))
  (ALU (OPEN 1) <- (ACTIVE 2) SET-SOURCE-1 (GLOBAL 0))
  (CALL-xct-next TAK)
 (ALU (OPEN 2) <- (ACTIVE 0) SET-SOURCE-1 (GLOBAL 0))
  (ALU (OPEN 1) <- (RETURN 0) SET-SOURCE-1 (GLOBAL 0))
  (OPEN)
  (ALU (OPEN 0) <- (ACTIVE 2) M-MINUS-ONE (GLOBAL 0))
  (ALU (OPEN 1) <- (ACTIVE 0) SET-SOURCE-1 (GLOBAL 0))
  (CALL-xct-next TAK)
 (ALU (OPEN 2) <- (ACTIVE 1) SET-SOURCE-1 (GLOBAL 0))
  (TAIL-RECURSIVE-CALL-xct-next TAK)
 (ALU (OPEN 2) <- (RETURN 0) SET-SOURCE-1 (GLOBAL 0))
  )

(define-asm tak-driver ()
  (open)
  (alu (open 0) <- (active 0) set-source-1 (global 0))
  (alu (open 1) <- (active 1) set-source-1 (global 0))
  (alu (open 2) <- (active 2) set-source-1 (global 0))
  (call tak)
  (sim sim-halt))

(defun tak-test (&optional full-p)
  (reset-proc-all)
  (load-functions 'tak 'tak-driver)
  (setf (proc-next-pc *proc*) (symbol-lookup 'tak-driver))
  (setf (proc-noop-next-bit *proc*) 1)
  (cond ((null full-p)
	 (write-active 0 8)
	 (write-active 1 7)
	 (write-active 2 6))
	(t
	 (write-active 0 18.)
	 (write-active 1 12.)
	 (write-active 2 6)))
  (setq *number-of-instructions* 0)
  (setq *number-of-calls* 0)
  )

;(tak 18. 12. 6)
;                            (15 ENTER TAK: 9 7 6)
;                              (16 ENTER TAK: 8 7 6)
;                                (17 ENTER TAK: 7 7 6)
;                                (17 EXIT TAK: 6)
;                                (17 ENTER TAK: 6 6 8)
;                                (17 EXIT TAK: 8)
;                                (17 ENTER TAK: 5 8 7)
;                                (17 EXIT TAK: 7)
;                                (17 ENTER TAK: 6 8 7)
;                                (17 EXIT TAK: 7)
;                              (16 EXIT TAK: 7)
;                              (16 ENTER TAK: 6 6 9)
;                              (16 EXIT TAK: 9)
;                              (16 ENTER TAK: 5 9 7)
;                              (16 EXIT TAK: 7)
;                              (16 ENTER TAK: 7 9 7)
;                              (16 EXIT TAK: 7)
;                            (15 EXIT TAK: 7)
;                            (15 ENTER TAK: 6 6 10)
;                            (15 EXIT TAK: 10)
;                            (15 ENTER TAK: 5 10 7)
;                            (15 EXIT TAK: 7)
;                            (15 ENTER TAK: 7 10 7)
;                            (15 EXIT TAK: 7)


(defun tak (x y z)
       (cond ((not (< y x))	;xy
	      z)
	     (t (tak (tak (1- x) y z)
		     (tak (1- y) z x)
		     (tak (1- z) x y)))))