(defconst *pendasm-commands*
  '(
    (add register register)
    (addu register register)
    (sub register register)
    (subu register register)
    (and_op register register)
    (or_op register register)
    (xor_op register register)
    (nor_op register register)
    (slt register register)
    (sltu register register)
    (sll register int)
    (srl register int)
    (sra register int)
    (sllv register register)
    (srlv register register)
    (srav register register)
    (rl register int)
    (rr register int)
    (rlv register register)
    (rrv register register)
    (j absolute-target)
    (jr register)
    (jal register relative-target)
    (jalr register relative-target)
    (bltz register relative-target)
    (bgez register relative-target)
    (bltzal register register relative-target)
    (bgezal register register relative-target)
    (beq register register relative-target)
    (bne register register relative-target)
    (blez register relative-target)
    (bgtz register relative-target)
    (cf)
    (addi register int)
    (addiu register int)
    (slti register int)
    (sltiu register int)
    (andi register int)
    (ori register int)
    (xori register int)
    (exchange register register)
    ))


(defvar *assm-errors* nil)
(defun add-assm-error (error)
  (setq *assm-errors* (cons error *assm-errors*)))
(defun clear-assm-errors ()
  (setq *assm-errors* nil))
(defun assm-errorsp ()
  *assm-errors*)
(defun princ-assm-errors ()
  (mapcar (function (lambda (err)
		      (princ err)
		      (terpri)))
	  (reverse *assm-errors*)))

;; returns (LABEL ASMLIST COMMENT-STRING)
(defun assm-process-unassm-line (line)
  (let ((label nil)
	(assmlist nil)
	(comment "")
	temp)
    ;; find the comment
    (if (setq temp (string-match "//" line))
	(progn
	  (setq comment (substring line temp))
	  (setq line (substring line 0 temp))))
    ;; find label (:)
    (if (setq temp (string-match ":" line))
	(progn
	  (if (> temp 0)
	      (setq label (car (read-from-string (substring line 0 temp)))))
	  (setq line (substring line (+ 1 temp)))))
    ;; rest had better be code or empty line!				   
    (if (setq temp (string-match "[ \t]*$" line))
	(setq line (substring line 0 temp)))
    (while (not (string= line ""))
      (setq temp (read-from-string line))
      (setq assmlist (cons (car temp) assmlist))
      (setq line (substring line (cdr temp))))
    (list label
	  (nreverse assmlist)
	  comment)))

(defun assm-register-to-number (arg linec)
  (let ((num (car (read-from-string (substring (symbol-name arg) 1)))))
    (cond ((not (integerp num))
	   (add-assm-error 
	    (format "%d:\tInvalid register name '%s'" linec arg))
	   arg)
	  ((or (< num 0) (> num 31))
	   (add-assm-error (format "%d:\tRegister out of range (%s)" linec arg))
	   arg)
	  (t
	   num))))

(defun assm-label-to-number (arg labels pc linec)
  (let ((label-pc (cdr (assoc arg labels))))
    (cond (label-pc 
	   (- label-pc (+ pc 1)))
	  (t
	   (add-assm-error (format "%d:\tUnknown label '%s'" linec arg))
	   arg))))

(defun assm-label-to-abs-number (arg labels pc linec)
  (let ((label-pc (cdr (assoc arg labels))))
    (cond (label-pc 
	   label-pc)
	  (t
	   (add-assm-error (format "%d:\tUnknown label '%s'" linec arg))
	   arg))))

(defun assm-process-assm-list (assml labels pc linec)
  (if assml
      (let ((command-syntax (assoc (car assml) *pendasm-commands*))
	    (argc 0))
	;; check for valid assembly function name
	(if command-syntax 
	    ;; check for valid number of arguments
	    (if (= (length assml) (length command-syntax))
		;; convert each label or register to a number
		(cons 
		 (car assml)
		 (mapcar 
		  (function 
		   (lambda (arg)
		     (setq command-syntax (cdr command-syntax))
		     (setq argc (+ argc 1))
		     (cond ((integerp arg)
			    (if (not (eq (car command-syntax) 'int))
				(add-assm-error 
				 (format "%d:\tArgument %d should be a %s" 
					 linec
					 argc
					 (assm-argtype-to-string (car command-syntax)))))
			    arg)
			   ((string= "$" (substring (symbol-name arg) 0 1))
			    (if (not (eq (car command-syntax) 'register))
				(add-assm-error 
				 (format "%d:\tArgument %d should be a %s" 
					 linec
					 argc
					 (assm-argtype-to-string (car command-syntax)))))
			    (assm-register-to-number arg linec))
			   (t
			    (if (not (or (eq (car command-syntax) 'relative-target)
					 (eq (car command-syntax) 'absolute-target)))
				(add-assm-error 
				 (format "%d:\tArgument %d should be a %s" 
					 linec
					 argc
					 (assm-argtype-to-string (car command-syntax)))))
			    (if (eq (car command-syntax) 'relative-target)
				(assm-label-to-number arg labels pc linec)
			      (assm-label-to-abs-number arg labels pc linec))))))
		  (cdr assml)))
	      (add-assm-error (format "%d:\tCommand '%s' takes %d argument(s)" 
				      linec (car assml) (length (cdr command-syntax)))))
	  (add-assm-error (format "%d:\tUnknown command '%s'" linec (car assml)))))))
	
(defun assm-argtype-to-string (type)
  (cond ((eq type 'int) "integer")
	((or (eq type 'absolute-target)
	     (eq type 'relative-target))
	 "label")
	(t (format "%s" type))))

(defun assm-process-assm-lines (lines labels)
  (let ((pc 0)
	(linec 1)
	temp)
    (mapcar 
     (function 
      (lambda (line)
	(setq temp (list (nth 0 line)
			 (assm-process-assm-list (nth 1 line) labels
						 pc linec)
			 (nth 2 line)))
	(if (nth 1 line)
	    (setq pc (+ pc 1)))
	(setq linec (+ linec 1))
	temp))
     lines)))


(defun assm-insert-lines (lines)
  (mapcar (function 
	   (lambda (line)
	     (if (nth 1 line)
		 (if (cdr (nth 1 line))
		     (insert (format "\t%s(%s,fchan)\t"
				     (car (nth 1 line))
				     (mapconcat 
				      (function
				       (lambda (symnum)
					 (format "%s" symnum)))
				      (cdr (nth 1 line))
				      ",")))
		   (insert (format "\t%s(fchan)\t"
				   (car (nth 1 line)))))
	       ;;(insert "\t")
	       )
	     (insert (nth 2 line))
	     (insert "\n")))
	  lines))

(defun assm-pendulum (filename)
  (interactive "Fsave assembled file as: \n")
  (let ((untreated-file (current-buffer))
	(oldpoint (point))
	(current-line "")
	(line-count 0)
	(pc 0)
	(assm-lines nil)
	(label-lines nil)
	)
    (clear-assm-errors)
    (save-excursion
      (goto-char (point-min))

      ;; read in lines and preprocess
      (while (not (eobp))
	;; returns (LABEL ASMLIST COMMENT-STRING)
	(setq assm-lines
	      (cons
	       (setq current-line 
		     (assm-process-unassm-line
		      (buffer-substring (point) (save-excursion (end-of-line) 
								(point)))))
	       assm-lines))
	(forward-line 1)
	;; notice how this lets labels appear lines before code
	(if (car current-line)
	    (setq label-lines (cons (cons (car current-line)
					  pc)
				    label-lines)))
	(if (nth 1 current-line)
	    (setq pc (+ pc 1)))
	(setq line-count (+ line-count 1)))

      ;; replace all labels/registers with numbers
      (setq assm-lines (assm-process-assm-lines (nreverse assm-lines)
						label-lines))
      
      ;; everything done; print stuff to file
      (if (assm-errorsp)
	(with-output-to-temp-buffer "*pendulum errors*"
	  (princ-assm-errors))
	(let* ((file-loaded (get-file-buffer filename))
	       (tmpbuf (or file-loaded (find-file filename))))
	  (set-buffer tmpbuf)
	  (erase-buffer)
	  (assm-insert-lines assm-lines)
	  (save-buffer)
	  (if (not file-loaded)
	      (kill-buffer tmpbuf))
	  (message "Assembled to %s" filename)))
      )))