(FILECREATED " 8-Feb-86 15:27:31" {DSK}<LISPFILES2>IMPROVEDDCOMS>INTERRUPTS.;1 6126
previous date: " 4-Feb-86 13:47:14" {GOEDEL}<usr2/pds/updating/lisp>INTERRUPTS)
(* Copyright (c) 1985, 1986 by Quintus Computer Systems. All rights reserved.)
(PRETTYCOMPRINT INTERRUPTSCOMS)
(RPAQQ INTERRUPTSCOMS ((SCCS) (* This file contains functions dealing with D-machine interrupts,
including error handling.) (* QP.INTERRUPT.CHARCODES is a list of CHARCODEs of characters to cause a
Prolog interrupt. QP.INTERRUPT.CHARCODES.TO.DISABLE is a list of CHARCODEs of characters that Lisp
uses as interrupts, but we want turned off. This list should probably contain ↑B, at least.) (VARS (
QP.INTERRUPT.CHARCODES (LIST (LIST (CHARCODE ↑C) (FUNCTION QP.INTERRUPT.HANDLER)) (LIST (CHARCODE ↑Z)
(FUNCTION QP.END.OF.FILE)))) (QP.INTERRUPT.CHARCODES.TO.DISABLE NIL)
QP.LISP.ERROR.TO.PROLOG.ERROR.ALIST) (GLOBALVARS QP.INTERRUPT.CHARCODES
QP.INTERRUPT.CHARCODES.TO.DISABLE QP.LISP.ERROR.TO.PROLOG.ERROR.ALIST) (FNS QP.BLOCK.EVENTS
QP.END.OF.FILE QP.INSTALL.HANDLERS QP.INTERRUPT.HANDLER QP.LISP.ERROR QP.PROLOG.EVENT
QP.RESET.SOME.INTERRUPTS QP.TTYENTRYFN QP.TTYEXITFN QP.UNBLOCK.EVENTS) (P (QP.INSTALL.HANDLERS))))
(* %%G% %%W% )
(* This file contains functions dealing with D-machine interrupts, including error handling.)
(* QP.INTERRUPT.CHARCODES is a list of CHARCODEs of characters to cause a Prolog interrupt.
QP.INTERRUPT.CHARCODES.TO.DISABLE is a list of CHARCODEs of characters that Lisp uses as
interrupts, but we want turned off. This list should probably contain ↑B, at least.)
(RPAQ QP.INTERRUPT.CHARCODES (LIST (LIST (CHARCODE ↑C) (FUNCTION QP.INTERRUPT.HANDLER)) (LIST (
CHARCODE ↑Z) (FUNCTION QP.END.OF.FILE))))
(RPAQQ QP.INTERRUPT.CHARCODES.TO.DISABLE NIL)
(RPAQQ QP.LISP.ERROR.TO.PROLOG.ERROR.ALIST ((10 . 5) (48 . 5) (49 . 5) (50 . 5)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS QP.INTERRUPT.CHARCODES QP.INTERRUPT.CHARCODES.TO.DISABLE
QP.LISP.ERROR.TO.PROLOG.ERROR.ALIST)
)
(DEFINEQ
(QP.BLOCK.EVENTS
(LAMBDA (X) (* edited: "10-Nov-85 15:29") (* * Start running uninterruptably. This will turn off
keyboard interrupts; I'm not sure if that's good enough.) (INTERRUPTABLE NIL)))
(QP.END.OF.FILE
(LAMBDA NIL (* vince: "25-Nov-85 17:07") (BKSYSBUF (CONCAT (CHARACTER 4) (CHARACTER (CHARCODE EOL)))))
)
(QP.INSTALL.HANDLERS
(LAMBDA NIL (* pds: "21-Nov-85 11:21") (for PAIR in QP.LISP.ERROR.TO.PROLOG.ERROR.ALIST unless (ASSOC
(QUOTE QP.LISP.ERROR) (ASSOC (CAR PAIR) ERRORTYPELST)) do (PUTASSOC (CAR PAIR) (CONS (LIST (FUNCTION
QP.LISP.ERROR) (CDR PAIR)) (CDR (ASSOC (CAR PAIR) ERRORTYPELST))) ERRORTYPELST))))
(QP.INTERRUPT.HANDLER
(LAMBDA NIL (* pds: "22-Nov-85 19:29") (* * This function needs to be attached somehow to the
interrupt character, so it gets run when the user hits logical control-c. What key should it be by
default on d-machines?) (TERPRI T) (SELECTQ (PROG1 (RESETLST (RESETSAVE NIL (BQUOTE (
QP.RESET.SOME.INTERRUPTS , (for CH in QP.INTERRUPT.CHARCODES collect (INTERRUPTCHAR CH NIL))))) (
TERPRI T) (LET ((HELPTEXT
"
Prolog interrupt options:
continue - do nothing
trace - debugger will start creeping
debug - debugger will start leaping
abort - cause a Prolog abort
exit - irreversible exit from Prolog
help - this list
Prolog interruption (? for help)? ")) (ASKUSER NIL NIL "Prolog interruption (h for help)? " (QUOTE ((c
"ontinue") (t "race") (d "ebug") (a "bort") (e "xit" PROMPTCONFIRMFLG T))) NIL NIL (QUOTE (CONFIRMFLG
T MACROCHARS ((h PRIN1 HELPTEXT T) (H PRIN1 HELPTEXT T) (? PRIN1 HELPTEXT T))))))) (TERPRI T) (
CLEARBUF T)) (c NIL) (t (SETQ QP.TOP.TRACE.STATE 2) (SETQ QP.TRACE.STATE 2) (PRINTOUT T
"[The debugger will first creep -- showing everything (trace)]" T)) (d (SETQ QP.TOP.TRACE.STATE 3) (
SETQ QP.TRACE.STATE 3) (PRINTOUT T "[The debugger will first leap -- showing spypoints (debug)]" T)) (
a (QP.PROLOG.EVENT 8)) (e (QP.PROLOG.EVENT 3)) (SHOULDNT))))
(QP.LISP.ERROR
(LAMBDA (ERRNUM) (* pds: " 4-Feb-86 13:46") (LET ((OLDPOS (STKPOS (QUOTE QP.PROLOG) -1 ERRORPOS))) (if
OLDPOS then (* * We are running under PROLOG.) (if (STKPOS (QUOTE R.call.lisp) -1 ERRORPOS OLDPOS)
then (* * But it's user-called LISP under Prolog, so let someone else handle it.) (RELSTK OLDPOS) NIL
else (* * LISP error in Prolog system code: call our own handler.) (RELSTK ERRORPOS) (QP.PROLOG.EVENT
ERRNUM)) else (* * This has nothing to do with Prolog: pass it on.) NIL))))
(QP.PROLOG.EVENT
(LAMBDA (EVENT-NUMBER) (* pds: " 3-Feb-86 18:48") (* * Called when something happens within prolog,
e.g., prolog evaluates an abort goal. This function corresponds very roughly to events.ih in the C
world.) (RETFROM (QUOTE QP.PROLOG) EVENT-NUMBER T)))
(QP.RESET.SOME.INTERRUPTS
(LAMBDA (NEWINTERRUPTS SAVECURRENT?) (* pds: "13-Nov-85 19:09") (if SAVECURRENT? then (for X in
NEWINTERRUPTS collect (INTERRUPTCHAR X)) else (for X in NEWINTERRUPTS do (INTERRUPTCHAR X)))))
(QP.TTYENTRYFN
(LAMBDA (PROCESS) (* vince: "25-Nov-85 16:54") (* * Called each time the prolog process becomes the
TTY process. Enable the interrupt key.) (if (PROCESSP PROCESS) then (PROCESSPROP PROCESS (QUOTE
OLDINTERRUPTS) (NCONC (for CH in QP.INTERRUPT.CHARCODES.TO.DISABLE collect (INTERRUPTCHAR CH NIL)) (
for PAIR in QP.INTERRUPT.CHARCODES collect (INTERRUPTCHAR (CAR PAIR) (CDR PAIR))))))))
(QP.TTYEXITFN
(LAMBDA (PROCESS) (* vince: "25-Nov-85 15:44") (* * Called each time the prolog process ceases to be
the TTY process. Undo the work of QP.TTYENTRYFN.) (if (PROCESSP PROCESS) then (for X in (PROCESSPROP
PROCESS (QUOTE OLDINTERRUPTS)) do (INTERRUPTCHAR X)))))
(QP.UNBLOCK.EVENTS
(LAMBDA (X) (* edited: "10-Nov-85 15:29") (* * Start running interruptably again. This will turn
keyboard interrupts back on; if we modify QP.BLOCK.EVENTS to turn off any other interrupts, we had
certainly better modify this to turn them back on.) (INTERRUPTABLE T)))
)
(QP.INSTALL.HANDLERS)
(PUTPROPS INTERRUPTS COPYRIGHT ("Quintus Computer Systems" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2044 6011 (QP.BLOCK.EVENTS 2054 . 2252) (QP.END.OF.FILE 2254 . 2378) (
QP.INSTALL.HANDLERS 2380 . 2692) (QP.INTERRUPT.HANDLER 2694 . 4025) (QP.LISP.ERROR 4027 . 4531) (
QP.PROLOG.EVENT 4533 . 4807) (QP.RESET.SOME.INTERRUPTS 4809 . 5030) (QP.TTYENTRYFN 5032 . 5436) (
QP.TTYEXITFN 5438 . 5715) (QP.UNBLOCK.EVENTS 5717 . 6009)))))
STOP