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

(global::eval-when (global::load global::eval)
  (global::import
    '(
;      ;type specifiers (only)
;      lisp:symbol
;      lisp:cons

      lisp:*
      lisp:+
      lisp:-
      lisp:<
      lisp:<=
      lisp:=
      lisp:>
      lisp:>=
      lisp:1+
      lisp:1-
      lisp:&aux
      lisp:&rest
      lisp:&body
      lisp:&environment
      lisp:&whole
      lisp:&optional
      lisp:&key  ;this shouldn't really be here
      lisp:aref
      lisp:ash
;      lisp:atom
      lisp:and
      lisp:append
;      lisp:apply
      lisp:block
;      lisp:byte
;      lisp:byte-size
;      lisp:byte-position
      lisp:case
;      lisp:car
;      lisp:cadr
;      lisp:caddr
      lisp:ceiling
;      lisp:cdr
;      lisp:cddr
      lisp:compile
      lisp:compiler-let
      lisp:cond
;      lisp:decf  ;???
      lisp:declare
      lisp:defconstant
;      lisp:define-setf-method
;      global:defsubst
 ;     lisp:defsetf
;      lisp:defsetf
;      lisp:defstruct
      lisp:defun
      lisp:defvar ;???
      lisp:defparameter ;???
      lisp:do
      lisp:do*
      lisp:dotimes
      lisp:eq
      lisp:eql 
      lisp:etypecase
      lisp:eval  ;only for eval-when, you can't call it
      lisp:eval-when
      lisp:export
      global:ferror
;      lisp:first
      lisp:flet
      lisp:floor
      lisp:funcall
      lisp:function
      lisp:go
      lisp:if
      lisp:ignore
      lisp:import
      lisp:in-package
;      lisp:incf
      lisp:lambda
      lisp:labels
;      lisp:list
      lisp:let
      lisp:let*
      lisp:load
      lisp:logand
      lisp:logandc1
      lisp:logandc2
      lisp:logeqv
      lisp:logior
      lisp:lognand
      lisp:lognor
      lisp:lognot
      lisp:logorc1
      lisp:logorc2
      lisp:logxor
      lisp:loop
      lisp:macrolet
;      lisp:mapcar
      lisp:max
      lisp:minusp
      lisp:mod
      lisp:multiple-value-bind
      lisp:multiple-value-setq
;      lisp:nconc
      lisp:nil
      lisp:null
      lisp:not
      lisp:or
      lisp:plusp
      lisp:proclaim
      lisp:prog
      lisp:prog1
      lisp:progn
      global:psetq
      lisp:quote
      global:remainder
      lisp:rest
      lisp:return
      lisp:return-from
;      lisp:second
      lisp:setf
;      lisp:setf
      lisp:setq
      lisp:t
      lisp:tagbody
      lisp:unless
      lisp:values
      lisp:when
      lisp:zerop
      
      )
    (find-package "PRIMITIVES" user:*package*)))

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

(global:export '(
		 defmacro
		 defsubst
  ;		 define-modify-macro
		 byte
		 byte-size
		 byte-position
		 ))

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

;this is the one to really use.  Defines things for both environments.
(defmacro prims::define-modify-macro (name &rest stuff)
  `(PROGN (SETF::DEFINE-MODIFY-MACRO-INTERNAL ,name ,@stuff)	;for LAMBDA
	  (SETF (NLISP::MACRO-FUNCTION ',name)
		(MACRO-FUNCTION ',name))))			;for K.

;;;; 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 () 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:*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))