(FILECREATED " 2-Feb-86 17:08:44" {DSK}<LISPFILES2>BIND.LSP;2
 3504   

      changes to:  (VARS BINDCOMS))


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT BINDCOMS)

(RPAQQ BINDCOMS
 ((FNS QP.OVERFLOW)
		   (MACROS bind.either bind.global bind.local bind.safely bind.trail check.heap 
			   check.stack trail.safely)))
(DEFINEQ

(QP.OVERFLOW

  (LAMBDA (E)
    (
PROMPTPRINT
 (
SELECTQ
 E
			      (11 "Prolog stack overflow")
			      (12 "Prolog heap overflow")
			      (13 "Prolog trail overflow")
			      (20 "Term too big to assert or record")
			      (21 "Can't pass compound term or unbound variable to Lisp")
			      "Other Prolog error"))
    (
QP.PROLOG.EVENT
 E)))
)
(DECLARE: EVAL@COMPILE 
(PUTPROPS bind.either MACRO (X (APPLY (FUNCTION (LAMBDA
						  (Ptr Val)
						  (BQUOTE (PROGN (put.cell (\, Ptr)
									   0
									   (get.32 (\, Val)))
								 (if (if (waybefore H (\, Ptr))
									 then
									 (before (\, Ptr)
										 B)
									 else
									 (before (\, Ptr)
										 HB))
								     then
								     (decrement.cell.pointer TR)
								     (put.addr TR 0
									       (get.24 (\, Ptr)))
								     (if (NOT (waybefore H TR))
									 then
									 (QP.OVERFLOW 13)))))))
				      X)))
(PUTPROPS bind.global MACRO (X (APPLY (FUNCTION (LAMBDA
						  (Ptr Val)
						  (BQUOTE (PROGN (put.cell (\, Ptr)
									   0
									   (get.32 (\, Val)))
								 (if (before (\, Ptr)
									     HB)
								     then
								     (decrement.cell.pointer TR)
								     (put.addr TR 0
									       (get.24 (\, Ptr)))
								     (if (NOT (waybefore H TR))
									 then
									 (QP.OVERFLOW 13)))))))
				      X)))
(PUTPROPS bind.local MACRO (X (APPLY (FUNCTION (LAMBDA
						 (Ptr Val)
						 (BQUOTE (PROGN (put.cell (\, Ptr)
									  0
									  (get.32 (\, Val)))
								(if (before (\, Ptr)
									    B)
								    then
								    (decrement.cell.pointer TR)
								    (put.addr TR 0
									      (get.24 (\, Ptr)))
								    (if (NOT (waybefore H TR))
									then
									(QP.OVERFLOW 13)))))))
				     X)))
(PUTPROPS bind.safely MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr Val)
							(BQUOTE (PROGN (put.cell (\, Ptr)
										 0
										 (get.32
										   (\, Val)))
								       (trail.safely (\, Ptr))))))
				      X)))
(PUTPROPS bind.trail MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr Val)
						       (BQUOTE (PROGN (put.cell (\, Ptr)
										0
										(get.32 (\, Val)))
								      (decrement.cell.pointer TR)
								      (put.addr TR 0
										(get.24 (\, Ptr)))
								      (if (NOT (waybefore H TR))
									  then
									  (QP.OVERFLOW 13))))))
				     X)))
(PUTPROPS check.heap MACRO (X (PROGN (QUOTE (if (NOT (waybefore H TR))
						then
						(QP.OVERFLOW 12))))))
(PUTPROPS check.stack MACRO (X (APPLY (FUNCTION (LAMBDA (E)
							(BQUOTE (if (NOT (waybefore (\, E)
										    QP.memtop))
								    then
								    (QP.OVERFLOW 11)))))
				      X)))
(PUTPROPS trail.safely MACRO (X (APPLY (FUNCTION (LAMBDA (Ptr)
							 (BQUOTE (if (if (waybefore H (\, Ptr))
									 then
									 (before (\, Ptr)
										 B)
									 else
									 (before (\, Ptr)
										 HB))
								     then
								     (decrement.cell.pointer TR)
								     (put.addr TR 0
									       (get.24 (\, Ptr)))))))
				       X)))
)
(PUTPROPS BIND.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (377 748 (QP.OVERFLOW 387 . 746)))))
STOP