(;; SCCS   : @(#)DONOR.LSP	1.4 2/3/86
;;; File   : $xerox/donor.lsp
;;; Author : Richard A. O'Keefe
;;; Purpose: Access \{GET,PUT}BASE{,PTR}
PROGN
;;; ------------------------------------------------------------------------
;;
;;	WARNING: This material is CONFIDENTIAL and proprietary to Quintus
;;	Computer Systems Inc.  This notice is protection against inadvertent
;;	disclosure and does not constitute publication or reflect any intent
;;	to publish.
;;
;;	Copyright (C) 1985, by Quintus Computer Systems, Inc.
;;	All rights reserved.
;;
;;	CAVEAT LECTOR: This software is under development.  No warrantee is
;;	made that it is any use for anything at all.
;;
;;; ------------------------------------------------------------------------


;;  The name of this file is a joke because the contents aren't.
;;  The four extended instructions found in this file provide access
;;  to the Lisp primitives
;;
;;	\GETBASE		(get.word) = get←clause←word, get←proc←word
;;	\GETBASEPTR		(get.addr) = get←clause←addr, get←proc←addr
;;	\PUTBASE		(put.word) = put←clause←word, put←proc←word
;;	\PUTBASEPTR		(put.addr) = put←clause←addr, put←proc←addr
;;
;;  In chemistry, a "base" (a generalisation of "alkali") is an
;;  electron donor, hence "donor" is a mnemonic for "base".  (Just
;;  as "acceptor" would be a mnemonic for "acid", but Lisp has no
;;  \GETACID primitives.  Some of the primitives who made it may
;;  have been taking acid, however.)

;;  These instructions are like the "arg", "functor", and "compare"
;;  instructions.  Their arguments are put in A registers as if they
;;  were ordinary predicates, and then the instruction appears in
;;  place of a call.  In the case of these specific instructions,
;;  the first argument is always bound to a pointer to a block of
;;  storage (usually a procedure record or a clause record), but
;;  may need dereferencing, and the second argument is always a
;;  SMALLP which needs no dereferencing.  The third argument of the
;;  "put" instructions is bound to a constant, but may need to be
;;  dereferenced.  The interpreter uses the "get" instructions
;;  heavily, and consulting uses the "put" ones a lot, so they are
;;  coded to go as fast as I can make them in Lisp.  For now it is
;;  not important to micro-code them.  If we really wanted to be
;;  hairy about it, we could pass the offset, not in a register,
;;  but as a 16-bit constant following the instruction.

;;  NOTE THAT THESE INSTRUCTIONS DO NO REFERENCE COUNT MAINTENANCE.
;;  The objects pointers to which are manipulated by these opcodes
;;  are assumed to be nailed down by other references which Lisp can
;;  seen.  See in particular PROCS.LSP and SKEL.LSP.

;;  NOTE THAT if a variable is passed in A1 (or A3 for "put.xxxx")
;;  these instructions will loop forever; not a particularly good
;;  idea.  They are ONLY for use in COMPLETELY TRUSTED system code!


(def.both.mode get.word (extend)
    (while (EQ (tag.of A1) ref.tag.8)
	(put.24 R  (untag.ref A1))
	(put.32 A1 (get.cell R 0))
    )
    (put.32 T1 (tag.immed
	(\GETBASE (untag.anything A1) (untag.immed A2)) ))
    (put.32 T0 (get.Aval 3))
    (unify.and.continue 0)
)

(def.both.mode get.addr (extend)
    (while (EQ (tag.of A1) ref.tag.8)
	(put.24 R  (untag.ref A1))
	(put.32 A1 (get.cell R 0))
    )
    (put.32 T1 (tag.other
	(\GETBASEPTR (untag.anything A1) (untag.immed A2)) ))
    (put.32 T0 (get.Aval 3))
    (unify.and.continue 0)
)

(def.both.mode put.word (extend)
    (while (EQ (tag.of A1) ref.tag.8)
	(put.24 R  (untag.ref A1))
	(put.32 A1 (get.cell R 0))
    )
    (while (EQ (tag.of A3) ref.tag.8)
	(put.24 R  (untag.ref A3))
	(put.32 A3 (get.cell R 0))
    )
    (\PUTBASE (untag.anything A1) (untag.immed A2) (untag.immed A3))
    (continue 0)
)

(def.both.mode put.addr (extend)
    (while (EQ (tag.of A1) ref.tag.8)
	(put.24 R  (untag.ref A1))
	(put.32 A1 (get.cell R 0))
    )
    (while (EQ (tag.of A3) ref.tag.8)
	(put.24 R  (untag.ref A3))
	(put.32 A3 (get.cell R 0))
    )
    (\PUTBASEPTR (untag.anything A1) (untag.immed A2) (untag.anything A3))
    (continue 0)
)



;;  The following two instructions are a stop-gap to ensure that reading
;;  and writing global flags will not go through the full-scale Lisp call.
;;  I do not like the fact that they go through the arithmetic interface,
;;  and this was not my original intention, but it proved quickest to do
;;  this than to modify the compiler to generate what I really want, and
;;  this has the advantage that the existing Lisp interface can be kept.
;;  (Not that it is especially good, but it is a fair bit of work to put
;;  another version in its place.)  These two instructions are (atom) as
;;  there wasn't time to tell LOAD.LSP about (extend atom).

(def.both.mode gettopval (atom)
    (put.32 T1 (get.32 T0))
    (put.32 T0 (tag.other (GETTOPVAL (\VAG2 0 (get.code P 0)) )) )
    (continue 1)
)

(def.both.mode settopval (atom)
    (SETTOPVAL (\VAG2 0 (get.code P 0)) (untag.immed T0))
    (continue 1)
)


) STOP