;;;; 6502 module definition


(module sixtyfive-oh-two (execute!
			  reset!
			  interrupt!
			  make-processor
			  processor-memory
			  processor-memory-set!
			  processor-registers
			  processor-registers-set!
			  processor?)

  (import scheme chicken foreign)
  (use srfi-4)
  (import defstruct miscmacros)

  (cond-expand
    (trace-mode (use format))
    (else))

  (defstruct processor
    (memory (make-u8vector #x10000 #xff))
    (registers (u8vector 0 0 0 #x20 0 0 0))) ; A X Y P S PC(lo) PC(hi)

  (cond-expand
    (crunched
     (foreign-declare "#include \"engine.cpp\"")
     (foreign-code "init_engine();")
     (define engine
       (foreign-lambda* int ((int cycles) (u8vector m) (u8vector rs))
	 "C_return(engine(cycles, m, rs));")))
    (else
     (include "engine.scm")))

  (define (reset! p)
    (let ((regs (processor-registers p))
	  (mem (processor-memory p)))
      (u8vector-set! regs 0 0)		; A
      (u8vector-set! regs 1 0)		; X
      (u8vector-set! regs 2 0)		; Y
      (u8vector-set! regs 3 #x20)	; P
      (u8vector-set! regs 4 #xff)	; S
      (u8vector-set! regs 5 (u8vector-ref mem #xfffc)) ; PC(lo)
      (u8vector-set! regs 6 (u8vector-ref mem #xfffd)))) ; PC(hi)

  (define (interrupt! p vec)
    (let* ((regs (processor-registers p))
	   (mem (processor-memory p))
	   (S (u8vector-ref regs 4))
	   (PC (fx+ 1 (fxior (u8vector-ref regs 5) 
			     (fxshl (u8vector-ref regs 6) 8)))))
      (u8vector-set! mem (fx+ #x100 S) (fxshr PC 8))
      (u8vector-set! mem (fx+ #xff S) (fxand #xff PC))
      (u8vector-set! mem (fx+ #xfe S) (u8vector-ref regs 3)) ; push P
      (u8vector-set! regs 3 (fxior (u8vector-ref regs 3) #x04))	; set I flag
      (u8vector-set! regs 4 (fxand #xff (fx- S 3)))
      (u8vector-set! regs 5 (u8vector-ref mem vec)) ; PC(lo)
      (u8vector-set! regs 6 (u8vector-ref mem (fxand #xff (fx+ vec 1)))))) ; PC(hi)

  (define (execute! p #!key cycles)
    (let ((M (processor-memory p))
	  (regs (processor-registers p)))
      (let loop ()
	(let ((c2 (engine (or cycles 999999) M regs)))
	  (if cycles
	      c2
	      (loop))))))

)