(FILECREATED " 2-Feb-84 15:25:28" {PHYLUM}<LISPCORE>SOURCES>AINTERRUPT.;35 21427
changes to: (FNS RESET.INTERRUPTS)
previous date: "11-AUG-83 12:23:20" {PHYLUM}<LISPCORE>SOURCES>AINTERRUPT.;34)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT AINTERRUPTCOMS)
(RPAQQ AINTERRUPTCOMS [(* handling interrupts)
(FNS INTERRUPTED \DOHELPINTERRUPT \DOHELPINTERRUPT1 \DOABORTINTERRUPT \DOABORTINTERRUPT1
\DOINTERRUPTINTTY \PROC.FINDREALFRAME CONTROL-T PRINDEC \PRINTRATIO \SETPRINTLEVEL
\SETRECLAIMMIN GETINTERRUPT SETINTERRUPT RESET.INTERRUPTS INTERRUPTABLE)
(VARS (LAST↑TTIMEBOX (CLOCK 0))
(LAST↑TKEYBOARDTIME)
(LAST↑TDISKIOTIME 0)
(LAST↑TSWAPTIME 0)
(LAST↑TGCTIME 0)
(LAST↑TNETIOTIME 0)
(\INTERRUPTABLE))
(ADDVARS (\SYSTEMCACHEVARS LAST↑TKEYBOARDTIME))
(INITVARS (\CURRENTINTERRUPTS)
(\SAVED.INTERRUPTS))
(VARS \SYSTEMINTERRUPTS)
(DECLARE: EVAL@COMPILE DONTCOPY (ADDVARS (NOFIXFNSLST CONTROL-T))
(LOCALVARS . T)
(GLOBALVARS \CURRENTINTERRUPTS \SAVED.INTERRUPTS \SYSTEMINTERRUPTS))
(DECLARE: EVAL@COMPILE (EXPORT (PROP INFO UNINTERRUPTABLY)
(ADDVARS (SYSSPECVARS \INTERRUPTABLE))
(PROP DMACRO UNINTERRUPTABLY \TAKEINTERRUPT)
(DECLARE: DONTCOPY (PROP DMACRO \CHARCODEP)
(ALISTS (PRETTYPRINTMACROS UNINTERRUPTABLY])
(* handling interrupts)
(DEFINEQ
(INTERRUPTED
[LAMBDA NIL (* bvm: "25-JUL-83 18:03")
(DECLARE (GLOBALVARS \INTERRUPTSTATE)
(USEDFREE \INTERRUPTABLE))
(COND
((NULL \INTERRUPTABLE)
(SETQ \PENDINGINTERRUPT T))
((fetch STORAGEFULL of \INTERRUPTSTATE)
(replace STORAGEFULL of \INTERRUPTSTATE with NIL)
(PROG ((HELPFLAG (QUOTE BREAK!)))
(LISPERROR "STORAGE FULL" (QUOTE "save your work & reload a.s.a.p.")
T)))
((fetch STACKOVERFLOW of \INTERRUPTSTATE)
(replace STACKOVERFLOW of \INTERRUPTSTATE with NIL)
(PROG ((HELPFLAG (QUOTE BREAK!)))
(LISPERROR "STACK OVERFLOW" NIL T)))
(T (PROG ((CH (fetch INTCHARCODE of \INTERRUPTSTATE))
TMP CLASS)
(SETQ CLASS (CADR (FASSOC CH \CURRENTINTERRUPTS)))
(SELECTQ CLASS
(NIL (printout PROMPTWINDOW "Undefined interrupt - " .P2 CH " - disabling " T)
(\INTCHAR CH NIL))
(RAID (RAID "↑C interrupt"))
((RESET ERROR) (* RESET OR ERROR!)
(\DOABORTINTERRUPT CLASS))
(HELP (* Treat ↑B same as ↑H. BREAK interrupt used to just do
a (ERRORX (LIST 18 NIL)))
(\DOHELPINTERRUPT))
((CONTROL-T BREAK INTERRUPT ERRORX PRINTLEVEL STORAGE)
(\DOINTERRUPTINTTY CLASS CH))
(RUBOUT (FLASHWINDOW)
(\CLEARSYSBUF T))
(OUTPUTBUFFER (* No need to clear it. It doesn't exist)
NIL)
(COND
((LITATOM CLASS)
(SET CLASS T))
(T (SHOULDNT])
(\DOHELPINTERRUPT
[LAMBDA NIL (* bvm: "27-JUL-83 18:37")
(PROG (PROC)
(COND
((NULL (THIS.PROCESS))
(FLASHWINDOW)
(\DOHELPINTERRUPT1))
([NULL (SETQ PROC (PROGN (FLASHWINDOW)
(\SELECTPROCESS "Interrupt which process?"]
(* Interrupt declined)
NIL)
((EQ PROC (THIS.PROCESS))
(\DOHELPINTERRUPT1))
((\PROCESS.MAKEFRAME PROC (FUNCTION \DOHELPINTERRUPT1)))
(T (* Couldn't build frame, so leave interrupt pending)
(SETQ \PENDINGINTERRUPT T])
(\DOHELPINTERRUPT1
[LAMBDA NIL (* bvm: "11-AUG-83 11:56")
(* Does HELP/BREAK interrupt in the current process. We treat ↑B same as ↑H, except that former always occurs in
tty process. BREAK interrupt used to just do a (ERRORX (LIST 22Q NIL)) instead of calling INTERRUPT)
(COND
((NULL \INTERRUPTABLE) (* Unlikely, but could occur if someone blocked while
uninterruptable)
(FLASHWINDOW))
(T (PROG (OLDTTY)
[OR (TTY.PROCESSP)
(SETQ OLDTTY (TTY.PROCESS (THIS.PROCESS]
[COND
((EQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE))
(SPAWN.MOUSE (THIS.PROCESS]
(CLEARBUF T T) (* Find name of a real frame before INTERRUPTED, so
break message can be nice.)
(INTERRUPT (\PROC.FINDREALFRAME)
NIL 2)
(COND
(OLDTTY (TTY.PROCESS OLDTTY])
(\DOABORTINTERRUPT
[LAMBDA (CLASS) (* bvm: "24-JUL-83 23:34")
(* * Handle ERROR and RESET interrupts. Current philosophy: abort the mouse proc if it is doing anything
interesting, else abort the tty process)
(PROG (MOUSEPROC PROC)
(COND
((OR (NULL (THIS.PROCESS))
(NULL TOPW)) (* Non-process world, or no mouse process)
(\DOABORTINTERRUPT1 CLASS))
((EQ [SETQ PROC (SELECTQ [\PROC.FINDREALFRAME (AND (NEQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE))
(fetch MYSTACK
of (SETQ MOUSEPROC
(FIND.PROCESS (QUOTE MOUSE]
((\MOUSE.PROCESS WINDOW.MOUSE.HANDLER)
(* Mouse not doing anything interesting, interrupt the
tty process)
(TTY.PROCESS))
(OR MOUSEPROC (THIS.PROCESS]
(THIS.PROCESS))
(\DOABORTINTERRUPT1 CLASS))
((\PROCESS.MAKEFRAME PROC (FUNCTION \DOABORTINTERRUPT1)
(LIST CLASS)))
(T (* Couldn't build frame, so leave interrupt pending)
(SETQ \PENDINGINTERRUPT T])
(\DOABORTINTERRUPT1
[LAMBDA (CLASS) (* bvm: " 1-AUG-83 18:11")
(COND
((NULL \INTERRUPTABLE) (* Unlikely, but could occur if someone blocked while
uninterruptable)
(SETQ \PENDINGINTERRUPT T))
(T (COND
((AND (NEQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE))
(NEQ TtyDisplayStream \DEFAULTTTYDISPLAYSTREAM))
(CLEARBUF T T)
(TERPRI T)))
(COND
((EQ CLASS (QUOTE RESET))
(RESET))
(T (SETERRORN 57Q)
(ERROR!])
(\DOINTERRUPTINTTY
[LAMBDA (CLASS CH) (* bvm: "25-JUL-83 18:03")
(COND
((NULL \INTERRUPTABLE)
(SETQ \PENDINGINTERRUPT T))
((TTY.PROCESSP)
(SELECTQ CLASS
(CONTROL-T (CONTROL-T))
(STORAGE (\SETRECLAIMMIN))
(PRINTLEVEL (\SETPRINTLEVEL))
(BREAK (\DOHELPINTERRUPT1))
(ERRORX (CLEARBUF T T) (* Hard interrupt)
(ERRORX (LIST 43 CH)))
(INTERRUPT (CLEARBUF T T) (* Soft interrupt)
(\BOUT \TERM.OFD (CHARCODE BELL))
(INTERRUPT (QUOTE NILL)
NIL
(IPLUS CH 64)))
NIL))
((\PROCESS.MAKEFRAME (TTY.PROCESS)
(FUNCTION \DOINTERRUPTINTTY)
(LIST CLASS CH)))
(T (* Couldn't build frame, so leave interrupt pending)
(SETQ \PENDINGINTERRUPT T])
(\PROC.FINDREALFRAME
[LAMBDA (POS) (* bvm: "27-JUL-83 23:36")
(* Returns the name of the first interesting frame
before POS, or the caller if POS = NIL)
(for I from (COND
(POS 0)
(T -2))
by -1 do (SELECTQ (SETQ $$VAL (STKNTHNAME I POS))
((INTERRUPTED \INTERRUPTFRAME \INTERRUPTED \DOHELPINTERRUPT
\DOHELPINTERRUPT1 \DOABORTINTERRUPT \DOINTERRUPTINTTY
\PROCESS.GO.TO.SLEEP BLOCK AWAIT.EVENT MONITOR.AWAIT.EVENT
GETMOUSESTATE)
NIL)
(RETURN $$VAL])
(CONTROL-T
[LAMBDA NIL (* bvm: "24-JUL-83 23:04")
(DECLARE (GLOBALVARS LAST↑TTIMEBOX LAST↑TKEYBOARDTIME \MISCSTATS LAST↑TDISKIOTIME LAST↑TNETIOTIME
LAST↑TSWAPTIME LAST↑TGCTIME))
(* * better definition:
"(PROG ((NONKEYBOARDTIME (STKNTHNAME -1 (QUOTE INTERRUPTED)))
(POS (POSITION T)))
(printout T T (COND
((EQ NONKEYBOARDTIME (QUOTE \GETCHAR))
%"IO WAIT IN %")
(T %"RUNNING IN %"))
.P2 NONKEYBOARDTIME %" IN %" .P2 (STKNTHNAME -2 (QUOTE INTERRUPTED))
%" IN %"
(STKNTHNAME -3 (QUOTE INTERRUPTED))
%", %" .I2
(IQUOTIENT (ITIMES [IDIFFERENCE [SETQ NONKEYBOARDTIME
(IPLUS (IMINUS LAST↑TTIMEBOX)
(SETQ LAST↑TTIMEBOX
(IDIFFERENCE (CLOCK0 LAST↑TTIMEBOX)
(fetch KEYBOARDWAITTIME of \MISCSTATS]
(IPLUS (IMINUS LAST↑TDISKTIME)
(SETQ LAST↑TDISKTIME (fetch DISKTRANSFERTIME of \MISCSTATS]
144Q)
NONKEYBOARDTIME)
%"%%%% UTIL%" T)
(POSITION T POS))")
(UNINTERRUPTABLY (* Uninterruptable only so that messages don't trash
eachother)
(PROG ((TEMP (STKNTHNAME -3))
(STKI -3)
SWAPDELTA NETIODELTA DISKIODELTA GCDELTA KEYBOARDDELTA TOTALDELTA)
[DSPSOUT (do (SELECTQ TEMP
[(\INTERRUPTFRAME \INTERRUPTED INTERRUPTED \DOINTERRUPTINTTY)
(* Skip over these)
(SETQ TEMP (STKNTHNAME (add STKI -1]
((\GETCHAR \GETKEY)
(SETQ TEMP (STKNTHNAME (add STKI -1)))
(SETQ $$VAL "IO wait in "))
((BLOCK \BACKGROUND AWAIT.EVENT MONITOR.AWAIT.EVENT
\PROCESS.GO.TO.SLEEP)
(* Forms of blocking)
(SETQ TEMP (STKNTHNAME (add STKI -1)))
(SETQ $$VAL "Waiting in "))
(RETURN (OR $$VAL "Running in "]
[bind (CNT ← 0)
do [COND
((LITATOM TEMP)
(DSPSOUT TEMP)
(COND
((EQ (add CNT 1)
3)
(RETURN))
(T (DSPSOUT " in "]
(SETQ TEMP (STKNTHNAME (SETQ STKI (SUB1 STKI]
[COND
((NULL LAST↑TKEYBOARDTIME) (* Just initialize the first time)
(SETQ LAST↑TKEYBOARDTIME (fetch KEYBOARDWAITTIME of \MISCSTATS))
(SETQ LAST↑TTIMEBOX (CLOCK0 LAST↑TTIMEBOX))
(SETQ LAST↑TSWAPTIME (fetch SWAPWAITTIME of \MISCSTATS))
(SETQ LAST↑TDISKIOTIME (fetch DISKIOTIME of \MISCSTATS))
(SETQ LAST↑TNETIOTIME (fetch NETIOTIME of \MISCSTATS))
(SETQ LAST↑TGCTIME (fetch GCTIME of \MISCSTATS)))
(T (DSPSOUT ", ")
(\BOUT \TERM.OFD (CHARCODE CR)) (* calculates the amount of time spent not in disk wait
since the last control-T. Considers only time outside of
key board wait.)
[SETQ KEYBOARDDELTA (IPLUS (IMINUS LAST↑TKEYBOARDTIME)
(SETQ LAST↑TKEYBOARDTIME (fetch KEYBOARDWAITTIME
of \MISCSTATS]
[SETQ TOTALDELTA (IPLUS (IMINUS LAST↑TTIMEBOX)
(SETQ LAST↑TTIMEBOX (CLOCK0 LAST↑TTIMEBOX]
(\PRINTRATIO [IDIFFERENCE TOTALDELTA (IPLUS [SETQ SWAPDELTA
(IPLUS (IMINUS LAST↑TSWAPTIME)
(SETQ LAST↑TSWAPTIME
(fetch SWAPWAITTIME
of \MISCSTATS]
[SETQ DISKIODELTA
(IPLUS (IMINUS LAST↑TDISKIOTIME)
(SETQ LAST↑TDISKIOTIME
(fetch DISKIOTIME
of \MISCSTATS]
[SETQ NETIODELTA
(IPLUS (IMINUS LAST↑TNETIOTIME)
(SETQ LAST↑TNETIOTIME
(fetch NETIOTIME
of \MISCSTATS]
(SETQ GCDELTA
(IPLUS (IMINUS LAST↑TGCTIME)
(SETQ LAST↑TGCTIME
(fetch GCTIME of \MISCSTATS]
TOTALDELTA)
(DSPSOUT "%% Util")
(COND
((NEQ SWAPDELTA 0)
(DSPSOUT ", ")
(\PRINTRATIO SWAPDELTA TOTALDELTA)
(DSPSOUT "%% Swap")))
(COND
((NEQ DISKIODELTA 0)
(DSPSOUT ", ")
(\PRINTRATIO DISKIODELTA TOTALDELTA)
(DSPSOUT "%% DskIO")))
(COND
((NEQ NETIODELTA 0)
(DSPSOUT ", ")
(\PRINTRATIO NETIODELTA TOTALDELTA)
(DSPSOUT "%% Network")))
(COND
((NEQ GCDELTA 0)
(DSPSOUT ", ")
(\PRINTRATIO GCDELTA TOTALDELTA)
(DSPSOUT "%% GC")))
(COND
((NEQ KEYBOARDDELTA 0)
(DSPSOUT "; +")
(\PRINTRATIO KEYBOARDDELTA TOTALDELTA)
(DSPSOUT "%% Key"]
(\BOUT \TERM.OFD (CHARCODE CR))))])
(PRINDEC
[LAMBDA (N) (* rrb "21-JUL-83 07:09")
(COND
[(ILESSP N 10)
(COND
((ILESSP N 0)
(DSPSOUT "{negative}"))
(T (\BOUT \TERM.OFD (IPLUS N (CHARCODE 0]
(T (PRINDEC (IQUOTIENT N 10))
(PRINDEC (IREMAINDER N 10])
(\PRINTRATIO
[LAMBDA (PART WHOLE) (* bvm: " 3-SEP-81 15:49")
(PRINDEC (IQUOTIENT (ITIMES PART 100)
WHOLE])
(\SETPRINTLEVEL
[LAMBDA NIL (* rrb "22-JUL-83 10:19")
(DECLARE (GLOBALVARS \TCARPRINTLEVEL \TCDRPRINTLEVEL))
(PROG (BUF OLB OSB CARN)
(\BOUT \TERM.OFD (CHARCODE BELL))
(SETQ OLB (LINBUF T))
(SETQ OSB (SYSBUF T))
(CLEARBUF T T)
(DSPSOUT "set printlevel to: ")
(PROG ((N 0)
CH)
LP (SELCHARQ (SETQ CH (\GETCHAR))
((0 1 2 3 4 5 6 7 8 9)
[SETQ N (IPLUS (ITIMES N 10)
(IDIFFERENCE CH (CHARCODE 0]
(GO LP))
[(%. !) (* CARN is set if we've already seen a comma)
(COND
(CARN (SETQ \TCARPRINTLEVEL CARN)
(SETQ \TCDRPRINTLEVEL N))
(T (SETQ \TCARPRINTLEVEL N)))
(COND
((EQ CH (CHARCODE !)) (* Make it permanent)
(PRINTLEVEL \TCARPRINTLEVEL \TCDRPRINTLEVEL]
[, (COND
((NOT CARN)
(SETQ CARN N) (* This is the first comma)
(SETQ N 0)
(GO LP]
NIL) (* Restore buffers cleared with CLEARBUF)
)
(COND
((SETQ BUF (SYSBUF T))
(BKSYSBUF BUF)))
(SETQ \SYSBUF OSB)
(AND (SETQ BUF (LINBUF T))
(LINBUF))
(SETQ \LINBUF OLB])
(\SETRECLAIMMIN
[LAMBDA NIL (* rrb "22-JUL-83 10:19")
(PROG (BUF OLB OSB CH)
(\BOUT \TERM.OFD (CHARCODE BELL))
(SETQ OLB (LINBUF T))
(SETQ OSB (SYSBUF T))
(CLEARBUF T T)
(DSPSOUT "set RECLAIMMIN to: ")
(PROG ((N 0))
LP (SELCHARQ (SETQ CH (\GETCHAR))
((0 1 2 3 4 5 6 7 8 9)
[SETQ N (IPLUS (ITIMES N 10)
(IDIFFERENCE CH (CHARCODE 0]
(GO LP))
(%. (RECLAIMMIN N))
NIL))
(COND
((SETQ BUF (SYSBUF T))
(BKSYSBUF BUF)))
(SETQ \SYSBUF OSB)
(AND (SETQ BUF (LINBUF T))
(LINBUF))
(SETQ \LINBUF OLB])
(GETINTERRUPT
[LAMBDA (CHAR) (* rmk: " 8-MAR-82 21:53")
(DECLARE (GLOBALVARS \SYSTEMINTERRUPTS \CURRENTINTERRUPTS))
(SELECTQ CHAR
(NIL (* Non-system interrupts)
(for X in \CURRENTINTERRUPTS unless (FMEMB (CADR X)
\SYSTEMINTERRUPTS)
collect (CAR X)))
(T (* All system interrupts)
(for X in \CURRENTINTERRUPTS collect (CAR X)))
(COND
((NUMBERP CHAR)
(CADR (FASSOC CHAR \CURRENTINTERRUPTS)))
((FMEMB CHAR \SYSTEMINTERRUPTS)
(for X in \CURRENTINTERRUPTS when (EQ CHAR (CADR X)) do
(* Find CHAR in system class.)
(RETURN (CAR X])
(SETINTERRUPT
[LAMBDA (CHAR CLASS) (* lmm " 5-DEC-82 21:01")
(PROG (TEM)
(* This code assumes that the variable \CURRENTINTERRUPTS is an alist of the form ((CHAR CLASS) ...) and that all
system interrupts are members of the list \SYSTEMINTERRUPTS)
(COND
((NULL CHAR))
((FMEMB CHAR \SYSTEMINTERRUPTS)
(* If this is a system interrupt, then this is turning it off)
(SETINTERRUPT (GETINTERRUPT CHAR)))
[(SETQ TEM (FASSOC CHAR \CURRENTINTERRUPTS))
(* CHAR is currently an interrupt)
(COND
((EQ (CADR TEM)
CLASS) (* No change)
)
((NULL CLASS) (* REMOVE FROM INTERRUPT CHARACTER SET)
(\INTCHAR CHAR)
(SETQ \CURRENTINTERRUPTS (DREMOVE TEM \CURRENTINTERRUPTS)))
(T (* Assign new interrupt to CHAR)
[COND
((FMEMB CLASS \SYSTEMINTERRUPTS)
(SETINTERRUPT (GETINTERRUPT CLASS]
(RPLACA (CDR TEM)
CLASS)
(\INTCHAR CHAR T]
((NULL CLASS) (* JUST DISABLE INTERRUPT)
(\INTCHAR CHAR))
((AND (FMEMB CLASS \SYSTEMINTERRUPTS)
(SETQ TEM (FASSOC (GETINTERRUPT CLASS)
\CURRENTINTERRUPTS)))
(* CHAR not enabled, but there exists a character that has the CLASS interrupt)
(\INTCHAR (CAR TEM))
(* Turn off old CLASS interrupt)
(RPLACA TEM CHAR)
(\INTCHAR CHAR T))
(T (* Brand new interrupt)
(\INTCHAR CHAR T)
(SETQ \CURRENTINTERRUPTS (CONS (LIST CHAR CLASS)
\CURRENTINTERRUPTS])
(RESET.INTERRUPTS
[LAMBDA (PermittedInterrupts SaveCurrent?)
(DECLARE (GLOBALVARS \CURRENTINTERRUPTS)) (* JonL " 6-MAY-83 02:57")
(* Returns list of previous settings, for use by RESETFORM but only when 2nd arg is non-NIL.
That way, there is no consing on the exit from the RESETLST * Note that \CURRENTINTERRUPTS is a list of 2-lists,
and the first element of each 2-list is the charcode of the character determined.)
(OR (NULL PermittedInterrupts)
[AND (LISTP PermittedInterrupts)
(NOT (thereis X in PermittedInterrupts suchthat (NOT (AND (LISTP X)
(\CHARCODEP (CAR X]
(\ILLEGAL.ARG PermittedInterrupts)) (* Do the validity checking first, so that we don't get
an error under the UNINTERRUPTABLY)
(UNINTERRUPTABLY
[MAPC \CURRENTINTERRUPTS (FUNCTION (LAMBDA (CHAR)
(\INTCHAR (CAR CHAR] (* First, dis-arm all the current interrupts)
[if SaveCurrent?
then (SETQ \SAVED.INTERRUPTS (SETQ SaveCurrent? (APPEND \CURRENTINTERRUPTS NIL]
[if PermittedInterrupts
then (MAPC (SETQ PermittedInterrupts (APPEND PermittedInterrupts NIL))
(FUNCTION (LAMBDA (CHAR)
(\INTCHAR (CAR CHAR)
T]
(SETQ \CURRENTINTERRUPTS PermittedInterrupts) (* Finally, "arm" and install the desired interrupts)
SaveCurrent?)])
(INTERRUPTABLE
[LAMBDA (FLAG) (* lmm "18-APR-82 13:52")
(PROG1 \INTERRUPTABLE (SETQ \INTERRUPTABLE FLAG])
)
(RPAQ LAST↑TTIMEBOX (CLOCK 0))
(RPAQQ LAST↑TKEYBOARDTIME NIL)
(RPAQQ LAST↑TDISKIOTIME 0)
(RPAQQ LAST↑TSWAPTIME 0)
(RPAQQ LAST↑TGCTIME 0)
(RPAQQ LAST↑TNETIOTIME 0)
(RPAQQ \INTERRUPTABLE NIL)
(ADDTOVAR \SYSTEMCACHEVARS LAST↑TKEYBOARDTIME)
(RPAQ? \CURRENTINTERRUPTS )
(RPAQ? \SAVED.INTERRUPTS )
(RPAQQ \SYSTEMINTERRUPTS (BREAK CONTROL-T ERROR ERRORX HELP OUTPUTBUFFER PRINTLEVEL RAID RESET RUBOUT
STORAGE))
(DECLARE: EVAL@COMPILE DONTCOPY
(ADDTOVAR NOFIXFNSLST CONTROL-T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \CURRENTINTERRUPTS \SAVED.INTERRUPTS \SYSTEMINTERRUPTS)
)
)
(DECLARE: EVAL@COMPILE
(* FOLLOWING DEFINITIONS EXPORTED)
(PUTPROPS UNINTERRUPTABLY INFO EVAL)
(ADDTOVAR SYSSPECVARS \INTERRUPTABLE)
(PUTPROPS UNINTERRUPTABLY DMACRO ((X . Y)
([LAMBDA (\INTERRUPTABLE)
(PROGN X . Y]
NIL)))
(PUTPROPS \TAKEINTERRUPT DMACRO ((PREFORM POSTFORM)
(DECLARE (GLOBALVARS \PENDINGINTERRUPT))
(COND
((AND \PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK))
PREFORM
([LAMBDA (\INTERRUPTABLE)
(\CALLINTERRUPTED]
T)
POSTFORM))))
(DECLARE: DONTCOPY
(PUTPROPS \CHARCODEP DMACRO (OPENLAMBDA (X)
[AND (SMALLP X)
(IGEQ X 0)
(ILEQ X (CONSTANT (SUB1 (EXPT 2 BITSPERBYTE]))
(ADDTOVAR PRETTYPRINTMACROS (UNINTERRUPTABLY
LAMBDA (FORM)
(PROG [(POS (IPLUS 4 (POSITION]
(PRIN1 "(")
(PRIN2 (CAR FORM))
(OR [EQ COMMENTFLG (CAAR (SETQ FORM (CDR FORM]
(TAB POS 0))
(PRINTDEF FORM POS T T FNSLST)
(PRIN1 ")"))))
)
(* END EXPORTED DEFINITIONS)
)
(PUTPROPS AINTERRUPT COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1406 19585 (INTERRUPTED 1416 . 3014) (\DOHELPINTERRUPT 3016 . 3712) (\DOHELPINTERRUPT1
3714 . 4723) (\DOABORTINTERRUPT 4725 . 6010) (\DOABORTINTERRUPT1 6012 . 6600) (\DOINTERRUPTINTTY 6602
. 7501) (\PROC.FINDREALFRAME 7503 . 8174) (CONTROL-T 8176 . 12892) (PRINDEC 12894 . 13200) (
\PRINTRATIO 13202 . 13366) (\SETPRINTLEVEL 13368 . 14684) (\SETRECLAIMMIN 14686 . 15397) (GETINTERRUPT
15399 . 16266) (SETINTERRUPT 16268 . 18004) (RESET.INTERRUPTS 18006 . 19444) (INTERRUPTABLE 19446 .
19583)))))
STOP