(;; SCCS   : @(#)CALL.LSP	3.6 2/5/86
;;; File   : $xerox/call.lsp
;;; Author : Richard A. O'Keefe
;;; Purpose: Define the procedure calling instructions.
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 (allocate) instruction
;;  allocates an environment, using the CP register to determine
;;  how big the previous environment was.

(def.both.mode allocate ()
    (* needed C)
    (put.24 R (get.24 E))		; R is "CE" in the Sun emulator
    (if (before E B) then
	(put.24 E (get.24 B))
	(put.addr E saved.B0 (get.24 B0))
    else
	(put.24 E (E.plus.env.size.from.CP))
	(put.addr E saved.B0 (get.24 B))
    )
    (put.addr E saved.CP (get.24 CP))
    (put.addr E saved.CE (get.24 R))	; R is "CE" in the Sun emulator
    (check.stack E)
    (continue 0)
)


;;  There is a system internal predicate called si:apply/3.
;;  Its first argument is an "other" Lisp object, namely a tagged
;;  24-bit pointer to a procedure record.
;;  Its second argument is a callable term.  The procedure which is
;;  called is defined by the first argument, but its arguments come
;;  from the second argument's arguments.
;;  Its third argument is 0, 1, or 2, saying (0) to execute the
;;  code of a compiled predicate, (1) to execute the code of an
;;  interpreted predicate, or (2) to execute the code of a single
;;  interpreted clause.
;;  The compiler NEVER generates this instruction.  Instead, we load
;;	(ASSEMBLE.CLAUSE (apply 3 si) 3
;;	    (apply)
;;	)
;;  and that sets up the desired connection between the Prolog code
;;  and the Lisp code.  The speed of this operation will matter when
;;  the interpreter is running, but it will have no effect on compiled
;;  code, i.e. for benchmarking we can leave it in Lisp for ages.

(def.both.mode apply ()
    ;;  Dereference the procedure or clause address.
    (put.32 T0 (get.Aval 1))
    (select.4 T0
	(ref.tag.8
	    (put.24 R  (untag.ref T0))
	    (put.32 T0 (get.cell R 0))
	    (reselect))			; ** cannot be unbound **
	(PROGN)
    )
    ;;  T0 is now an "other" cell containing a LISP pointer.
    (put.24 C (untag.immed T0))		; C was "PR"
				
    ;;  Dereference the "entry-point" argument
    ;;  and set R to the address to jump to
    (put.32 T0 (get.Aval 3))
    (select.4 T0
	(ref.tag.8
	    (put.24 R  (untag.ref T0))
	    (put.32 T0 (get.cell R 0))
	    (reselect))			; ** cannot be unbound **
	(immed.tag.8			; integer (SMALLP)
	    (put.24 R (untag.immed T0))
	    (SELECTQ (get.24 R)
		(0 (put.24 P (PROC.CLAUSES (get.24 C)) ))
		(1 (put.24 P (PROC.LASTCLAUSE (get.24 C)) ))
		(2 (put.24 P (get.24 C)))
		(PROGN (SHOULDNT)) ))
	(SHOULDNT)			; can't happen
    )

    ;;  Dereference and unpack the argument vector.
    ;;  This operation is
    ;;  invoked only in trusted code, so unbound variables
    ;;  and random constants can't actually occur.
    (put.32 T0 (get.Aval 2))
    (select.4 T0
	(ref.tag.8
	    (put.24 R  (untag.ref T0))
	    (put.32 T0 (get.cell R 0))
	    (reselect))			; ** cannot be unbound **
	(struct.tag.8
	    (put.24 R (untag.struct T0))
	    (put.16 I (arity.of.cell (get.24 R)))
	    (until (zero I)
		(put.Amem I (get.cell R (get.16 I)))
		(decrement.counter I)
	    )
	    (put.Aval 1 (get.Amem 1))
	    (put.Aval 2 (get.Amem 2))
	    (put.Aval 3 (get.Amem 3))
	    (put.Aval 4 (get.Amem 4)))
	(list.tag.8
	    (put.24 R (untag.list T0))
	    (put.Aval 1 (get.cell R 0))
	    (put.Aval 2 (get.cell R 1))
	    )
	(symbol.tag.8
	    )
	(SHOULDNT)			; un-callable constants
    )

    (check.heap)			; check room for head & 1st goal
    (put.24 B0 (get.24 B))		; save current choice-point
    (continue.at (get.24 P))		; first or only clause of C
)




;;  (deallocate)

(def.both.mode deallocate ()
    (put.24 CP (get.addr E saved.CP))
    (put.24 E  (get.addr E saved.CE))
    (continue.reading 0)
)



;;  (proceed)

(def.both.mode proceed ()
    (continue.at (add.code CP 1))
)



;;  (progress)

(def.both.mode progress ()
    (put.24 CP (get.addr E saved.CP))
    (put.24 E  (get.addr E saved.CE))
    (continue.at (add.code CP 1))
)



;;  The following instructions would go something like this:
;;  call:	CP <- ...
;;		goto execute
;;  depart:	CP <- ... E <- ...
;;  execute:	C <- ...
;;  do.execute: ...

;;  common code for versions of call

(def.open do.execute ()
    (check.heap)
    (put.24 B0 (get.24 B))
    (put.24 C (address.operand))		; address of procedure record
    (continue.at (PROC.CLAUSES (get.24 C)))	; 1st opcode of 1st clause
)


;;  (execute <address>)

(def.both.mode execute (address)
    (do.execute)
)



;;  (depart <address>)

(def.both.mode depart (address)
    (put.24 CP (get.addr E saved.CP))
    (put.24 E  (get.addr E saved.CE))
    (do.execute)
)



;;  (call <address> <envsize>)

(def.both.mode call (address size)
    (put.24 CP (add.code P 1))
    (do.execute)
)



) STOP