;; ui.lisp

;; bintrans

;; Copyright (C) 2001 Mark Probst

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.

(defstruct state
  effect
  source)

(defvar *states* nil)

(defun show-states-from (num)
  (do ((states (nthcdr num *states*) (cdr states))
       (num num (1+ num)))
      ((null states))
    (let ((state (car states)))
      (format t "~A ~A = ~A~%" num (state-source state) (expr-to-sexp (first (state-effect state)))))))

(defun add-states (states)
  (let ((old-length (length *states*)))
    (setf *states* (nconc *states* states))
    (show-states-from old-length)))

(defun add-state (state)
  (add-states (list state)))

(defun the-state-expr (num)
  (first (state-effect (nth num *states*))))

(defun show ()
  (show-states-from 0)
  (values))

(defun clear ()
  (setf *states* nil)
  (values))

(defun insn (name)
  (add-states (mapcar #'(lambda (effect)
			  (make-state :effect (list effect) :source `(insn ,name)))
		      (insn-effect (find name (machine-insns *source-machine*) :key #'insn-name))))
  (values))

(defun intel-insn (name mode)
  (add-states (mapcar #'(lambda (effect)
			  (make-state :effect (list effect) :source `(intel-insn ,name ,mode)))
		      (intel-insn-effect (find-if #'(lambda (x) (and (eq (intel-insn-name x) name) (eq (intel-insn-mode x) mode)))
						  (machine-insns *source-machine*)))))
  (values))

(defun decompose (num)
  (let* ((state (nth num *states*))
	 (decomposed (decompose-effect (state-effect state) nil)))
    (add-states (mapcar #'(lambda (x) (make-state :effect (first x) :source `(decompose ,num))) decomposed)))
  (values))

(defun transform (num)
  (let* ((state (nth num *states*))
	 (expr (first (state-effect state))))
    (add-states (mapcar #'(lambda (x) (make-state :effect (list x)
						  :source `(transform ,num)))
			(remove expr (expr-alternatives expr)))))
  (values))

(defun matches (num)
  (let ((state (nth num *states*)))
    (mapcar #'(lambda (x)
		(list (insn-name (first x))
		      (position (second x) (insn-generators (first x)))))
	    (all-generator-matches (64bitify (first (state-effect state)))))))

(defun match (num insn-name generator-num)
  (let* ((state (nth num *states*))
	 (insn (find insn-name (machine-insns *target-machine*) :key #'insn-name))
	 (generator (nth generator-num (insn-generators insn))))
    (assert (= (length (car generator)) 1))
    (dolist (match (match-pattern (64bitify (first (state-effect state))) (caar generator)))
      (destructuring-bind (read-bindings write-bindings)
	  match
	(multiple-value-bind (text can-fail num-insns new-effects)
	    (generate-match-code insn generator read-bindings write-bindings nil :shallow t)
	  (add-states (mapcar #'(lambda (x) (make-state :effect x :source `(match ,num ,insn-name ,generator-num))) new-effects))
	  (format t "can ~:[not ~;~]fail~%" can-fail)))))
  (values))

(defun generator (name num)
  (let* ((insn (find name (machine-insns *target-machine*) :key #'insn-name))
	 (generator (nth num (insn-generators insn))))
    (expr-to-sexp (caar generator))))

(defun subinsn (num &rest indexes)
  (let* ((state (nth num *states*))
	 (expr (first (state-effect state))))
    (add-state (make-state :effect (list (do ((expr expr (nth (1- (car indexes)) (expr-operands expr)))
					      (indexes indexes (cdr indexes)))
					     ((null indexes) expr)))
			   :source `(subinsn ,num . ,indexes))))
  (values))