(FILECREATED "23-Jan-86 10:23:13" {GOEDEL}</usr2/pds/updating/>TOPLEVEL
previous date: " 1-Dec-85 00:18:45" {FLOPPY}TOPLEVEL.;1)
(* Copyright (c) 1985, 1986 by Quintus Computer Systems. All rights reserved.)
(PRETTYCOMPRINT TOPLEVELCOMS)
(RPAQQ TOPLEVELCOMS ((SCCS)
(* Outer wrapper code for Prolog. QP.RUN.QUINTUS.PROLOG starts up the prolog
interpreter.)
(FNS CALL.PROLOG QP.CAREFUL.GETTOPVAL QP.FOREVER.DO.PROLOG
QP.RUN.QUINTUS.PROLOG)
(INITVARS (QP.TOP.TRACE.STATE 1)
(QP.TRACE.STATE 1)
(QP.PROLOG.MONITOR (CREATE.MONITORLOCK (QUOTE Prolog-monitor))))
(GLOBALVARS QP.TOP.TRACE.STATE QP.TRACE.STATE QP.PROLOG.MONITOR)))
(* %1/28/86 %@(#)TOPLEVEL 1.8 )
(* Outer wrapper code for Prolog. QP.RUN.QUINTUS.PROLOG starts up the prolog interpreter.)
(DEFINEQ
(CALL.PROLOG
(LAMBDA (PREDICATE ARGS WAITFLG) (* pds: "16-Jan-86 18:01")
(* * Call Xerox Quintus Prolog from INTERLISP. PREDICATE is the predicate to call, and ARGS are the arguments to
call it with. If *VALUE* is one of the ARGS, then a variable is passed in in its place, and the binding of that
variable when PREDICATE returns is returned from CALL.PROLOG. If there is no *VALUE* on the list, then T or NIL is
returned depending on whether the PREDICATE succeeds or fails. If there is more than 1 *VALUE*, it's an error.)
(* * If some process is running Prolog when CALL.PROLOG is called, an error is signaled unless WAITFLG it non-NIL,
in which case the CALL.PROLOG waits for the running Prolog to finish. If the running Prolog happens to be the
Prolog interpreter, then an error is signaled regardless of WAITFLG.)
(if (FIND.PROCESS QP.PROLOG.NAME)
then (ERROR "The Prolog interpreter is running, you can't call Prolog from LISP now.")
else (RESETLST (if (NOT (OBTAIN.MONITORLOCK QP.PROLOG.MONITOR (NOT WAITFLG)
T))
then (ERROR "Prolog is already running")
else (SETTOPVAL (QUOTE QP.LISP.CALL.PROLOG.PREDICATE)
PREDICATE)
(SETTOPVAL (QUOTE QP.LISP.CALL.PROLOG.NARGS)
(LENGTH ARGS))
(for I from 1 as ARG in ARGS
do (SETTOPVAL (PACK* (QUOTE QP.LISP.CALL.PROLOG.)
I)
ARG))
(LET ((RETURNVAL (PROLOG (QUOTE lisp←call←prolog)
0
(QUOTE si))))
(if (EQ RETURNVAL 3)
then (* 3 means Prolog exited cleanly, via halt.)
(GETTOPVAL (QUOTE QP.LISP.CALL.PROLOG.RESULT))
else (ERROR "Ungraceful exit from Prolog" RETURNVAL))))))
))
(QP.CAREFUL.GETTOPVAL
(LAMBDA (VAR) (* pds: "16-Jan-86 08:41")
(LET ((VAL (GETTOPVAL VAR)))
(if (EQ VAL (QUOTE NOBIND))
then (ERROR "UNBOUND ATOM" VAR)
else VAL))))
(QP.FOREVER.DO.PROLOG
(LAMBDA (EVENT-NUMBER) (* pds: "29-Nov-85 14:49")
(* * Start prolog in the appropriate place given the MODE argument. The name is really a misnomer;
it should be more like do.prolog.once.)
(* * Note that the interrupt and event handling code will RETFROM this function with the appropriate exit
condition. This is the only way out of PROLOG, which, we hope, is an infinite loop.)
(SELECTQ EVENT-NUMBER
(0 (* NULL)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(1 (* NOTHING)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(2 (* START)
(PROLOG (QUOTE first←top←level)
0
(QUOTE si)))
(3 (* DIE)
(QUOTE EXIT))
(4 (* ERROR)
(PROLOG (QUOTE error←top←level)
0
(QUOTE si)))
(5 (* ARITH)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(8 (* ABORT)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(9 (* REINIT)
(PROLOG (QUOTE reinit←top←level)
0
(QUOTE si)))
(10 (* RESTORE)
(PROLOG (QUOTE restore←top←level)
0
(QUOTE si)))
(11 (* OVSTACK)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(12 (* OVHEAP)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(13 (* OVTRAIL)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(14 (* OVPDL)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(15 (* OVATOMSYM)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(16 (* OVPROCSYM)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(17 (* OVCODE)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(18 (* BADEVAL)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(19 (* CONTROL←C)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(20 (* CLAUSE TOO BIG)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(21 (* CAN'T PASS TO LISP)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(3947188 (* NIRVANA)
(PROLOG (QUOTE abort←top←level)
0
(QUOTE si)))
(ERROR "Unrecognized event number" EVENT-NUMBER))))
(QP.RUN.QUINTUS.PROLOG
(LAMBDA (RESTARTFLG) (* pds: "16-Jan-86 17:59")
(* * The top level prolog interpreter kick-start function.)
(bind (EXITMODE ← (if RESTARTFLG
then 8
else 2))
do (SETQ EXITMODE (WITH.MONITOR QP.PROLOG.MONITOR (QP.FOREVER.DO.PROLOG EXITMODE)))
until (EQ EXITMODE 3) finally (PRINTOUT T "[ End of Prolog execution ]" T))))
)
(RPAQ? QP.TOP.TRACE.STATE 1)
(RPAQ? QP.TRACE.STATE 1)
(RPAQ? QP.PROLOG.MONITOR (CREATE.MONITORLOCK (QUOTE Prolog-monitor)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS QP.TOP.TRACE.STATE QP.TRACE.STATE QP.PROLOG.MONITOR)
)
(PUTPROPS TOPLEVEL COPYRIGHT ("Quintus Computer Systems" 1985 1986))
STOP