;;; -*- Mode: Common-Lisp; Base: 10.; Package: cold -*-
;;;
;;; These macros expand the opcode definitions in DEFOP into functions
;;; that provide the interpreted definitions of the function.

(Defmacro Defop (name mainop dest arglist . rest)
  (when (not (null (getf rest :lisp-function-p)))
    (cond ((consp name)
	   `(progn . ,(loop for fname in (cdr name)
			  collecting `(defun ,fname ,arglist ,(getf rest :documentation)
					(,fname . ,arglist)))))
	  (T `(defun ,name ,arglist ,(getf rest :documentation)
		(,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-Aux-Op (name auxopcode &Optional arglist . rest)
  (when (or (equal rest '(T)) (not (null (getf rest :lisp-function-p))))
    (cond ((consp name)
	   `(progn . ,(loop for fname in (cdr name)
			  collecting `(defun ,fname ,arglist ,(getf rest :documentation)
					(,fname . ,arglist)))))
	  (T `(defun ,name ,arglist ,(getf rest :documentation)
		(,name . ,arglist))))))

(Defmacro Def-Misc-Op (name miscopcode &Optional arglist . rest)
  (when (or (equal rest '(T)) (not (null (getf rest :lisp-function-p))))
    (cond ((consp name)
	   `(progn . ,(loop for fname in (cdr name)
			  collecting `(defun ,fname ,arglist ,(getf rest :documentation)
					(,fname . ,arglist)))))
	  (T `(defun ,name ,arglist ,(getf rest :documentation)
		(,name . ,arglist))))))

(Defmacro Def-Module-Op (name module opnum &optional arglist)
  name module opnum arglist
  nil)

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

(Defmacro Def-Ucode-Entry (name index arglist)
  name index arglist
  nil)

(Defvar lap-val-dummy)
(Defsubst Lap-Value (x)
  (ignore x)
  lap-val-dummy)