;;;; build-engine.scm


(use big-chicken miscmacros matchable)


(define addrmodes '())
(define ops '())

(define-syntax-rule (defaddrmode mode body ...)
  (push! (cons 'mode '(begin body ...)) addrmodes))

(define-syntax-rule (defop mnem variants body ...)
  (push! (list 'mnem 'variants '(begin body ...)) ops))

(load "6502.scm")

(define trace-mode #f)

(for-each
 (lambda (f)
   (pp `(begin ,@(read-file f))))
 (command-line-arguments))

(pp `(define (engine cycles M state)
       (let ((A (u8vector-ref state 0))
	     (X (u8vector-ref state 1))
	     (Y (u8vector-ref state 2))
	     (P (u8vector-ref state 3))
	     (S (u8vector-ref state 4))
	     (PC (lohi (u8vector-ref state 5) (u8vector-ref state 6)))
	     (T 0)
	     (c cycles))
	 (do () ((fx<= c 0))
	   (let ((b (peek M PC)))
	     (cond-expand
	       (trace-mode
		(format (current-error-port)
			"~4,'0x:~2,'0x A:~2,'0x X:~2,'0x Y:~2,'0x S=~2,'0x P=~2,'0x~%"
			PC b A X Y S P))
	       (else))
	     (incw! PC)
	     (case b
	       ,@(sort
		  (append-map
		   (match-lambda
		     ((mnem variants code)
		      (map (match-lambda
			     ((opcode cycles mode)
			      (let ((modecode (cdr (assq mode addrmodes))))
				`((,opcode)
				  (set! T ,cycles)
				  (let ((V ,modecode))
				    ,code)))))
			   variants)))
		   ops)
		  (lambda (c1 c2)
		    (< (caar c1) (caar c2)))))
	     (set! c (fx- c T))))
	 (u8vector-set! state 0 A)
	 (u8vector-set! state 1 X)
	 (u8vector-set! state 2 Y)
	 (u8vector-set! state 3 P)
	 (u8vector-set! state 4 S)
	 (u8vector-set! state 5 (lo PC))
	 (u8vector-set! state 6 (hi PC))
	 (+ cycles (- 0 c)))))