(FILECREATED "15-Feb-85 14:23:04" {ERIS}<LISPCORE>SOURCES>AINTERRUPT.;8 21772
changes to: (VARS AINTERRUPTCOMS)
previous date: "15-Feb-85 01:22:42" {ERIS}<LISPCORE>SOURCES>AINTERRUPT.;7)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT AINTERRUPTCOMS)
(RPAQQ AINTERRUPTCOMS [(* handling interrupts)
(FNS INTERRUPTED \DOHELPINTERRUPT \DOHELPINTERRUPT1 \DOABORTINTERRUPT \DOABORTINTERRUPT1
\DOINTERRUPTINTTY \DOSTACKFULLINTERRUPT \PROC.FINDREALFRAME CONTROL-T PRINDEC
\PRINTRATIO \SETPRINTLEVEL \SETRECLAIMMIN GETINTERRUPT SETINTERRUPT RESET.INTERRUPTS
INTERRUPTABLE)
(INITVARS (\CONTROL-T.DEPTH 3)
(\CONTROL-T.BACKSLASH)
(LAST↑TTIMEBOX (CLOCK 0))
(LAST↑TKEYBOARDTIME)
(LAST↑TDISKIOTIME 0)
(LAST↑TSWAPTIME 0)
(LAST↑TGCTIME 0)
(LAST↑TNETIOTIME 0)
(\INTERRUPTABLE))
(GLOBALVARS \CONTROL-T.DEPTH)
(ADDVARS (\SYSTEMCACHEVARS LAST↑TKEYBOARDTIME))
(INITVARS (\CURRENTINTERRUPTS))
(VARS \SYSTEMINTERRUPTS)
(DECLARE: EVAL@COMPILE DONTCOPY (ADDVARS (NOFIXFNSLST CONTROL-T))
(LOCALVARS . T)
(GLOBALVARS \CURRENTINTERRUPTS \SYSTEMINTERRUPTS))
(DECLARE: EVAL@COMPILE (EXPORT (ADDVARS (SYSSPECVARS \INTERRUPTABLE))
(PROP INFO UNINTERRUPTABLY)
(PROP DMACRO UNINTERRUPTABLY)
(ALISTS (PRETTYPRINTMACROS UNINTERRUPTABLY)))
DONTCOPY
(EXPORT (RECORDS INTERRUPTSTATE)
(PROP DMACRO \TAKEINTERRUPT])
(* handling interrupts)
(DEFINEQ
(INTERRUPTED
[LAMBDA NIL (* bvm: "13-Feb-85 16:31")
(DECLARE (GLOBALVARS \INTERRUPTSTATE)
(USEDFREE \INTERRUPTABLE))
(COND
((NULL \INTERRUPTABLE)
(SETQ \PENDINGINTERRUPT T))
((fetch STORAGEFULL of \INTERRUPTSTATE)
(\DOSTORAGEFULLINTERRUPT))
((fetch STACKOVERFLOW of \INTERRUPTSTATE)
(\DOSTACKFULLINTERRUPT))
((fetch VMEMFULL of \INTERRUPTSTATE)
(\DOVMEMFULLINTERRUPT))
(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: "20-Apr-84 17: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 (COND
([COND
((EQ (fetch PROCNAME of (SETQ MOUSEPROC (THIS.PROCESS)))
(QUOTE MOUSE))
\MOUSEBUSY)
((SETQ MOUSEPROC (FIND.PROCESS (QUOTE MOUSE)))
(PROCESS.EVALV MOUSEPROC (QUOTE \MOUSEBUSY]
(* Mouse busy, interrupt it)
MOUSEPROC)
(T (TTY.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) (* lmm "27-Jan-85 02:19")
(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)))
(COND
((EQ CLASS (QUOTE RESET))
(RESET))
(T (SETERRORN 47)
(ERROR!])
(\DOINTERRUPTINTTY
[LAMBDA (CLASS CH) (* lmm "11-Sep-84 14:56")
(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 (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])
(\DOSTACKFULLINTERRUPT
[LAMBDA NIL (* bvm: "20-Apr-84 17:38")
(replace STACKOVERFLOW of \INTERRUPTSTATE with NIL)
(PROG ((HELPFLAG (QUOTE BREAK!)))
(LISPERROR "STACK OVERFLOW" NIL 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 (POS) (* JonL "22-May-84 18:09")
(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
(PROG ((STKI (if (STACKP POS)
then 0
else (SETQ POS)
-3))
TEMP SWAPDELTA NETIODELTA DISKIODELTA GCDELTA KEYBOARDDELTA TOTALDELTA)
(SETQ TEMP (STKNTHNAME STKI POS))
(DSPSOUT (do (SELECTQ TEMP
((\INTERRUPTFRAME \INTERRUPTED INTERRUPTED \DOINTERRUPTINTTY)
(* Skip over these)
(SETQ TEMP (STKNTHNAME (add STKI -1)
POS)))
((\GETCHAR \GETKEY \TTYBACKGROUND)
(SETQ TEMP (STKNTHNAME (add STKI -1)
POS))
(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)
POS))
(SETQ $$VAL "Waiting in "))
(RETURN (OR $$VAL "Running in ")))))
(bind (CNT ← 0)
do (COND
((AND (LITATOM TEMP)
(OR \CONTROL-T.BACKSLASH (NEQ (NTHCHARCODE TEMP 1)
(CHARCODE \))))
(PRIN2 TEMP T T)
(COND
((EQ (add CNT 1)
\CONTROL-T.DEPTH)
(RETURN))
(T (DSPSOUT " in ")))))
(SETQ TEMP (STKNTHNAME (add STKI -1)
POS)))
(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 ", ")
(TERPRI T) (* 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")))))
(TERPRI T)))))
(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) (* lmm " 8-May-84 10:00")
(COND
((IGREATERP (ABS PART)
(CONSTANT (IQUOTIENT MAX.FIXP 100)))
(DSPSOUT "{overflow}"))
(T (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 "11-Sep-84 14:30")
(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)
(RPLACA (CDR TEM)
CLASS)
(\INTCHAR CHAR T]
((NULL CLASS) (* JUST DISABLE INTERRUPT)
(\INTCHAR CHAR))
(T (* Brand new interrupt)
(\INTCHAR CHAR T)
(SETQ \CURRENTINTERRUPTS (CONS (LIST CHAR CLASS)
\CURRENTINTERRUPTS])
(RESET.INTERRUPTS
[LAMBDA (PermittedInterrupts SaveCurrent?)
(DECLARE (GLOBALVARS \CURRENTINTERRUPTS)) (* bvm: "15-Feb-85 01:21")
(* 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)
(\THINCHARCODEP (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 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? \CONTROL-T.DEPTH 3)
(RPAQ? \CONTROL-T.BACKSLASH )
(RPAQ? LAST↑TTIMEBOX (CLOCK 0))
(RPAQ? LAST↑TKEYBOARDTIME )
(RPAQ? LAST↑TDISKIOTIME 0)
(RPAQ? LAST↑TSWAPTIME 0)
(RPAQ? LAST↑TGCTIME 0)
(RPAQ? LAST↑TNETIOTIME 0)
(RPAQ? \INTERRUPTABLE )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \CONTROL-T.DEPTH)
)
(ADDTOVAR \SYSTEMCACHEVARS LAST↑TKEYBOARDTIME)
(RPAQ? \CURRENTINTERRUPTS )
(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)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \CURRENTINTERRUPTS \SYSTEMINTERRUPTS)
)
)
(DECLARE: EVAL@COMPILE
(* FOLLOWING DEFINITIONS EXPORTED)
(ADDTOVAR SYSSPECVARS \INTERRUPTABLE)
(PUTPROPS UNINTERRUPTABLY INFO EVAL)
(PUTPROPS UNINTERRUPTABLY DMACRO ((X . Y)
([LAMBDA (\INTERRUPTABLE)
(PROGN X . Y]
NIL)))
(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)
DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD INTERRUPTSTATE ((NIL BITS 4)
(VMEMFULL FLAG)
(STACKOVERFLOW FLAG)
(STORAGEFULL FLAG)
(WAITINGINTERRUPT FLAG)
(INTCHARCODE BYTE)))
]
(PUTPROPS \TAKEINTERRUPT DMACRO ((PREFORM POSTFORM)
(DECLARE (GLOBALVARS \PENDINGINTERRUPT))
(COND ((AND \PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK))
PREFORM
([LAMBDA (\INTERRUPTABLE)
(\CALLINTERRUPTED]
T)
POSTFORM))))
(* END EXPORTED DEFINITIONS)
)
(PUTPROPS AINTERRUPT COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1505 19667 (INTERRUPTED 1515 . 3003) (\DOHELPINTERRUPT 3005 . 3701) (\DOHELPINTERRUPT1
3703 . 4712) (\DOABORTINTERRUPT 4714 . 5884) (\DOABORTINTERRUPT1 5886 . 6519) (\DOINTERRUPTINTTY 6521
. 7315) (\DOSTACKFULLINTERRUPT 7317 . 7587) (\PROC.FINDREALFRAME 7589 . 8260) (CONTROL-T 8262 . 13152
) (PRINDEC 13154 . 13460) (\PRINTRATIO 13462 . 13741) (\SETPRINTLEVEL 13743 . 15059) (\SETRECLAIMMIN
15061 . 15772) (GETINTERRUPT 15774 . 16641) (SETINTERRUPT 16643 . 18010) (RESET.INTERRUPTS 18012 .
19526) (INTERRUPTABLE 19528 . 19665)))))
STOP