(FILECREATED " 8-Feb-86 15:28:50" {DSK}<LISPFILES2>IMPROVEDDCOMS>TOPLEVEL.;1 5190
previous date: " 5-Feb-86 11:30:54" {GOEDEL}<usr2/pds/updating/lisp>TOPLEVEL)
(* 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 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))) QP.LISP.CALL.PROLOG.GOAL QP.LISP.CALL.PROLOG.RESULT) (GLOBALVARS QP.TOP.TRACE.STATE
QP.TRACE.STATE QP.PROLOG.MONITOR QP.LISP.CALL.PROLOG.GOAL QP.LISP.CALL.PROLOG.RESULT) (VARS
QP.LISP.CALL.PROLOG.GOAL)))
(* %%G% %%W% )
(* Outer wrapper code for Prolog. QP.RUN.QUINTUS.PROLOG starts up the prolog interpreter.)
(DEFINEQ
(PROLOG
(LAMBDA (PREDICATE ARGS WAITFLG) (* pds: " 4-Feb-86 14:09") (* * Call Xerox Quintus Prolog from
INTERLISP. PREDICATE is the predicate to call, and ARGS are the arguments to call it with. Each
occurrance of *VALUE* on ARGS then is passed to Prolog as a variable, and the bindings of those
variables are returned from PROLOG as a list if PREDICATE returns. If PREDICATE fails, NIL is
returned. If there is no *VALUE* on the list and PREDICATE succeeds, then T is returned.) (* * If some
process is running Prolog when PROLOG is called, an error is signaled unless WAITFLG it non-NIL, in
which case the 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.GOAL) (CONS PREDICATE ARGS)) (
LET ((RETURNVAL (QP.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: " 4-Feb-86 12:46") (* * 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 QP.PROLOG with the appropriate exit condition. This
is the only way out of QP.PROLOG, which, we hope, is an infinite loop.) (SELECTQ EVENT-NUMBER (0 (*
NULL) (QP.PROLOG (QUOTE abort←top←level) 0 (QUOTE si))) (1 (* NOTHING) (QP.PROLOG (QUOTE
abort←top←level) 0 (QUOTE si))) (2 (* START) (QP.PROLOG (QUOTE first←top←level) 0 (QUOTE si))) (3 (*
DIE) (QUOTE EXIT)) (4 (* ERROR) (QP.PROLOG (QUOTE error←top←level) 0 (QUOTE si))) (5 (* ARITH) (
QP.PROLOG (QUOTE abort←top←level) 0 (QUOTE si))) (8 (* ABORT) (QP.PROLOG (QUOTE abort←top←level) 0 (
QUOTE si))) (9 (* REINIT) (QP.PROLOG (QUOTE reinit←top←level) 0 (QUOTE si))) (10 (* RESTORE) (
QP.PROLOG (QUOTE restore←top←level) 0 (QUOTE si))) (11 (* OVSTACK) (QP.PROLOG (QUOTE abort←top←level)
0 (QUOTE si))) (12 (* OVHEAP) (QP.PROLOG (QUOTE abort←top←level) 0 (QUOTE si))) (13 (* OVTRAIL) (
QP.PROLOG (QUOTE abort←top←level) 0 (QUOTE si))) (14 (* OVPDL) (QP.PROLOG (QUOTE abort←top←level) 0 (
QUOTE si))) (15 (* OVATOMSYM) (QP.PROLOG (QUOTE abort←top←level) 0 (QUOTE si))) (16 (* OVPROCSYM) (
QP.PROLOG (QUOTE abort←top←level) 0 (QUOTE si))) (17 (* OVCODE) (QP.PROLOG (QUOTE abort←top←level) 0 (
QUOTE si))) (18 (* BADEVAL) (QP.PROLOG (QUOTE abort←top←level) 0 (QUOTE si))) (19 (* CONTROL←C) (
QP.PROLOG (QUOTE abort←top←level) 0 (QUOTE si))) (20 (* CLAUSE TOO BIG) (QP.PROLOG (QUOTE
abort←top←level) 0 (QUOTE si))) (21 (* CAN'T PASS TO LISP) (QP.PROLOG (QUOTE abort←top←level) 0 (QUOTE
si))) (3947188 (* NIRVANA) (QP.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)))
(RPAQ? QP.LISP.CALL.PROLOG.GOAL NIL)
(RPAQ? QP.LISP.CALL.PROLOG.RESULT NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS QP.TOP.TRACE.STATE QP.TRACE.STATE QP.PROLOG.MONITOR QP.LISP.CALL.PROLOG.GOAL
QP.LISP.CALL.PROLOG.RESULT)
)
(RPAQQ QP.LISP.CALL.PROLOG.GOAL (length (a b c) *VALUE*))
(PUTPROPS TOPLEVEL COPYRIGHT ("Quintus Computer Systems" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (929 4656 (PROLOG 939 . 2281) (QP.CAREFUL.GETTOPVAL 2283 . 2452) (QP.FOREVER.DO.PROLOG
2454 . 4304) (QP.RUN.QUINTUS.PROLOG 4306 . 4654)))))
STOP