;;; -*- Mode:LISP; Package:USER; Base:10.; Readtable:CL -*-

(pkg-goto 'prims () user:*package*)
(global:export '(
		 defmacro
		 defsubst
		 define-modify-macro
		 byte
		 byte-size
		 byte-position
		 ))

(global:pkg-goto 'user:user () user:*package*)

(defmacro prims::define-modify-macro (name &rest stuff)
  `(PROGN (SETF::DEFINE-MODIFY-MACRO ,name ,@stuff)
	  (SETF (NLISP::MACRO-FUNCTION ',name)
		(MACRO-FUNCTION ',name))))

;;; Macros defined in K source files
;;; when compiled with the lambda compiler, will
;;; go both into the lambda environment and the
;;; new macro environment
;;; This macro definition is *not* seen by nlisp:compile-file
;;; -- It probably should be. -- JRM
;;; no, thats the point, this kluge is so that when
;;; something is compiled by the lambda compiler 
;;; (or evaled in a buffer) it will be seen in both environments
;;; The eval-when is an even worse kluge, but is the only way I can
;;; think of to allow nlisp:macroexpand to work later in the file
;;; (it is called by setf)
(defmacro prims:defmacro (name lambda-list &body body)
  `(PROGN
     (EVAL-WHEN (EVAL COMPILE LOAD)
       (DEFMACRO ,name ,lambda-list
	 ,@body)
       (SETF (NLISP::MACRO-FUNCTION ',name) (MACRO-FUNCTION ',name)))))

;;; this also is taken care of by a toplevel form handler
(pkg-goto 'prims nil user:*package*)
(global:defmacro defsubst (name &rest body)
  `(global:PROGN
     (NC:DEF-DECLARATION ,name SUBST '(NAMED-SUBST ,name . ,body))
     (DEFUN ,name . ,body)))
(global:pkg-goto 'user:user () user:*package*)

(defun prims:byte (size position)
  (global::dpb size (global:byte 5. 8.) ;vinc:%%byte-size
	      position))

(defun prims:byte-size (byte-spec)
  (global::ldb (global::byte 5. 8.) byte-spec)) ;vinc:%%byte-size


(defun prims:byte-position (byte-spec)
  (global::ldb (global::byte 8. 0.) byte-spec)) ;vinc:%byte-position

(setf (nlisp:macro-function 'prims:setf) (macro-function 'setf:setf))
(setf (nlisp:macro-function 'prims:defsetf) (macro-function 'setf:defsetf))
(setf (nlisp:macro-function 'prims:define-setf-method) (macro-function 'setf:define-setf-method))

(setf (nlisp:macro-function 'setf:defsetf) (macro-function 'setf:defsetf))
(setf (nlisp:macro-function 'setf:define-setf-method) (macro-function 'setf:define-setf-method))