; -*- Mode:Common-Lisp; Package:GENASYS; Base:10 -*-

;;;
;;; Instructions:
;;;
;;;
;;; 1) Use this on a release 3 system or a release 2 system
;;;    that has compiler 2.  DO NOT USE IN A SYSTEM WITH GENASYS BUILT.
;;;
;;; 2) Compile this file in a buffer.
;;; 
;;; 3) Make sure the Defop you want to compile is loaded into the environment
;;;    (V2:LOAD-FOR-TARGET <defop-file> 'elroy)  on Release 2
;;;    (LOAD <deflop-file>)                      on Release 3
;;;
;;; 4) Execute (COMPILE-FILE <defop-file> :VERBOSE T :PACKAGE 'GENASYS)                    on Release 3
;;;    or      (V2:COMPILE-FILE <defop-file> :TARGET 'ELROY :VERBOSE T :PACKAGE 'GENASYS)  on Release 2
;;;
;;; 5) Watch for warnings.  If you see something like "Warning: function FOO calls itself unconditionally"
;;;    you have done something wrong (probably omitted step 3).
;;;

(defun get-package-right (s)
  (if (eq (symbol-package s) (find-package 'Genasys))
      (intern s 'si)
      s))
(defun get-package-right-call (s)
  (if (eq (symbol-package s) (find-package 'Genasys))
      (if (GET (intern s 'si) 'compiler:misc-val) ; compiler knows to compile this into an instruction
	  (intern s 'si)
	  (intern s 'compiler))
;;;;      (format t "~% ~s ~s" s (symbol-package s))
      s))


(Defmacro Defop (name mainop dest arglist . rest)
  mainop
  dest
  (when (not (null (getf rest :lisp-function-p)))
    (cond ((consp name)
	   `(progn . ,(loop for fname in (cdr name)
			  collecting `(defun ,(get-package-right fname) ,arglist ,(getf rest :documentation)
					(,(get-package-right-call fname) . ,arglist)))))
	  (T `(defun ,(get-package-right name) ,arglist ,(getf rest :documentation)
		(,(get-package-right-call name) . ,arglist))))))

(Defmacro Def-CallOp (name opcode arglist)
  name opcode arglist
  nil)

(Defmacro Def-Branch-Op (test sense else-pop opcode . rest)
  test sense else-pop opcode rest
  nil)

(Defmacro Def-Misc-Op (name miscopcode &Optional arglist &key lisp-function-p
		       (Interpreter-Definition lisp-function-p )
		       documentation &allow-other-keys)
  miscopcode
  (when Interpreter-Definition 
    (cond ((consp name)
	   `(progn . ,(loop for fname in (cdr name)
			  collecting `(defun ,(get-package-right fname) ,arglist ,documentation
					(,(get-package-right-call fname) . ,arglist)))))
	  (T `(defun ,(get-package-right name) ,arglist ,documentation
		(,(get-package-right-call name) . ,arglist))))))

(Defmacro Def-Aux-Op (name Auxopcode &Optional arglist &key lisp-function-p
		       (Interpreter-Definition lisp-function-p )
		       documentation &allow-other-keys)
  auxopcode
  (when Interpreter-Definition 
    (cond ((consp name)
	   `(progn . ,(loop for fname in (cdr name)
			  collecting `(defun ,(get-package-right fname) ,arglist ,documentation
					(,(get-package-right-call fname) . ,arglist)))))
	  (T `(defun ,(get-package-right name) ,arglist ,documentation
		(,(get-package-right-call name) . ,arglist))))   ))


(Defmacro Def-Module-Op (name module opnum &Optional arglist &key (lisp-function-p t)
		       (Interpreter-Definition lisp-function-p )
		       documentation &allow-other-keys)
  opnum module
  (when Interpreter-Definition 
    (cond ((consp name)
	   `(progn . ,(loop for fname in (cdr name)
			  collecting `(defun ,(get-package-right fname) ,arglist ,documentation
					(,(get-package-right-call fname) . ,arglist)))))
	  (T `(defun ,(get-package-right name) ,arglist ,documentation
		(,(get-package-right-call name) . ,arglist))))))

(Defmacro Def-Module (name &optional num)
  name num
  nil)

(Defmacro Def-Ucode-Entry (name index arglist &rest ignore)
 name index arglist
 nil)

(DEFUN COMPILE-INTERPRETED-DEFINITIONS (FILE)
  (WITH-COMMON-LISP-ON (COMPILE-FILE FILE :VERBOSE T :PACKAGE 'GENASYS)))