(FILECREATED " 1-Aug-85 16:31:24" {ERIS}<LISPCORE>SOURCES>AINTERRUPT.;27 26227
changes to: (FNS INTCHAR GETINTERRUPT SETINTERRUPT CONTROL-T \CONTROL-T.PRINTRATIO)
(MACROS \SYSTEMINTERRUPTP)
(VARS AINTERRUPTCOMS \SYSTEMINTERRUPTS)
previous date: "18-Jul-85 13:02:18" {ERIS}<LISPCORE>SOURCES>AINTERRUPT.;24)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT AINTERRUPTCOMS)
(RPAQQ AINTERRUPTCOMS ((COMS (* handling interrupts)
(FNS INTCHAR INTERRUPTCHAR INTERRUPTED LISPINTERRUPTS \DOHELPINTERRUPT
\DOHELPINTERRUPT1 \DOINTERRUPTHERE \DOSTACKFULLINTERRUPT
\PROC.FINDREALFRAME \SETPRINTLEVEL \SETRECLAIMMIN GETINTERRUPT
CURRENTINTERRUPTS SETINTERRUPT RESET.INTERRUPTS INTERRUPTABLE))
(COMS (* ↑T)
(FNS CONTROL-T \CONTROL-T.PRINTRATIO)
(INITVARS (\CONTROL-T.DEPTH 3)
(\CONTROL-T.BACKSLASH)
(LAST↑TTIMEBOX (CLOCK 0))
(LAST↑TSWAPTIME)
(LAST↑TDISKIOTIME 0)
(LAST↑TGCTIME 0)
(LAST↑TNETIOTIME 0))
(GLOBALVARS \CONTROL-T.DEPTH \CONTROL-T.BACKSLASH LAST↑TTIMEBOX LAST↑TSWAPTIME
LAST↑TDISKIOTIME LAST↑TNETIOTIME LAST↑TGCTIME \MISCSTATS)
(ADDVARS (\SYSTEMCACHEVARS LAST↑TSWAPTIME)))
[INITVARS (\CURRENTINTERRUPTS)
(\INTERRUPTABLE)
(INTERRUPTMENUFONT (QUOTE (GACHA 10]
(VARS \SYSTEMINTERRUPTS)
(DECLARE: EVAL@COMPILE DONTCOPY (ADDVARS (NOFIXFNSLST CONTROL-T))
(LOCALVARS . T)
(GLOBALVARS \CURRENTINTERRUPTS \SYSTEMINTERRUPTS INTERRUPTMENUFONT))
(DECLARE: EVAL@COMPILE (EXPORT (ADDVARS (SYSSPECVARS \INTERRUPTABLE))
(PROP INFO UNINTERRUPTABLY)
(PROP DMACRO UNINTERRUPTABLY)
(ALISTS (PRETTYPRINTMACROS UNINTERRUPTABLY)))
DONTCOPY
(EXPORT (RECORDS INTERRUPTSTATE)
(PROP DMACRO \TAKEINTERRUPT))
(MACROS \SYSTEMINTERRUPTP))))
(* handling interrupts)
(DEFINEQ
(INTCHAR
[LAMBDA (CHAR TYP/FORM HARDFLG TABLE) (* bvm: " 1-Aug-85 16:03")
(* this function is the non-undoable version of
INTERRUPTCHAR; INTERRUPTCHAR calls it)
(PROG (VAL SYSDEF OLDINT)
(SELECTQ CHAR
(NIL (* this is illegal, so don't do anything about it)
(RETURN))
(T (* (INTCHAR T) means restore interrupts to the
"standard" setting)
(UNINTERRUPTABLY
(for CHAR in (GETINTERRUPT NIL TABLE)
do (SETQ VAL (NCONC (INTCHAR CHAR NIL NIL TABLE)
VAL))) (* turn off all user interrupts -
(GETINTERRUPT) returns list of user interrupts)
[MAPC (LISPINTERRUPTS)
(FUNCTION (LAMBDA (LST)
(SETQ VAL (NCONC (INTCHAR (CAR LST)
(CADR LST)
(CADDR LST)
TABLE)
VAL] (* and reset all SYSTEM interrupts to default -
(LISPINTERRUPTS) returns a list of argument lists for
INTCHAR)
(* and VAL has been set to a valid arg list for
INTCHAR)
(RETURN VAL)))
NIL)
(COND
((LISTP CHAR) (* Call from undoing or resetform.
CHAR is a list of characters followed by typ/form
arguments.)
(while CHAR do (SETQ VAL (NCONC (INTCHAR (pop CHAR)
(pop CHAR)
(pop CHAR)
TABLE)
VAL)))
(RETURN VAL)))
[COND
((NOT (FIXP CHAR))
(COND
[(\SYSTEMINTERRUPTP CHAR)
(* CHAR can be an interrupt character class, meaning the character which is currently assigned to that interrupt -
this is most useful in, say, (INTCHAR (QUOTE HELP)) which says turn off the character whose class is HELP)
(SETQ CHAR (OR (GETINTERRUPT CHAR TABLE)
(ERRORX (LIST 27 CHAR]
(T (* turn single character into character code)
(SETQ CHAR (APPLY* (QUOTE CHARCODE)
CHAR]
[SETQ VAL (AND (SETQ OLDINT (GETINTERRUPT CHAR TABLE))
(LIST CHAR (CAR OLDINT)
(CADR OLDINT]
[COND
((EQ TYP/FORM T) (* just return value indicating what it was.)
(RETURN VAL))
((AND TYP/FORM (LITATOM TYP/FORM)
(SETQ SYSDEF (ASSOC TYP/FORM \SYSTEMINTERRUPTS)))
(* System interrupt -- get its default HARDFLG)
(OR HARDFLG (SETQ HARDFLG (CADR SYSDEF]
(COND
((AND (EQ (CAR OLDINT)
TYP/FORM)
(EQ (CADR OLDINT)
HARDFLG)) (* if the character is already set up, just return)
(RETURN)))
(COND
(OLDINT (SETINTERRUPT CHAR NIL TABLE)))
(COND
((NULL TYP/FORM) (* just leave character disabled)
)
(T (* make a user interrupt)
(COND
((AND SYSDEF (SETQ OLDINT (GETINTERRUPT TYP/FORM TABLE)))
(* if a system interrupt and there is another character
assigned to that channel, turn that character off)
(SETINTERRUPT OLDINT NIL TABLE)
(push VAL OLDINT TYP/FORM NIL)))
(SETINTERRUPT CHAR TYP/FORM TABLE HARDFLG)
(push VAL CHAR NIL NIL)))
(RETURN VAL])
(INTERRUPTCHAR
[LAMBDA (CHAR TYP/FORM HARDFLG TABLE) (* lmm "14-May-85 16:56")
(PROG ((VAL (INTCHAR CHAR TYP/FORM HARDFLG TABLE)))
(AND LISPXHIST (UNDOSAVE (LIST (QUOTE INTERRUPTCHAR)
VAL NIL NIL TABLE)))
(RETURN VAL])
(INTERRUPTED
[LAMBDA NIL (* bvm: "18-Jul-85 12:34")
(DECLARE (GLOBALVARS \INTERRUPTSTATE)
(USEDFREE \MOUSEBUSY \INTERRUPTABLE))
(COND
((NULL \INTERRUPTABLE)
(SETQ \PENDINGINTERRUPT T))
((fetch STORAGEFULL of \INTERRUPTSTATE)
(\DOSTORAGEFULLINTERRUPT))
((fetch STACKOVERFLOW of \INTERRUPTSTATE)
(\DOSTACKFULLINTERRUPT))
((fetch VMEMFULL of \INTERRUPTSTATE)
(\DOVMEMFULLINTERRUPT))
(T (LET* [(CH (fetch INTCHARCODE of \INTERRUPTSTATE))
(INTERRUPT (CDR (ASSOC CH (fetch (KEYACTION INTERRUPTLIST) of \CURRENTKEYACTION]
(COND
(INTERRUPT (LET* [(CLASS (CAR INTERRUPT))
(HARDFLG (CADR INTERRUPT))
(THISPROC (THIS.PROCESS))
(INTERRUPTED.PROC (COND
((OR (NULL THISPROC)
(EQ HARDFLG T))
THISPROC)
[(EQ HARDFLG (QUOTE MOUSE))
(LET ((MP THISPROC))
(* Interrupt MOUSE proc if it's busy, else the tty
process)
(COND
([COND
((EQ (PROCESSPROP MP
(QUOTE NAME))
(QUOTE MOUSE))
\MOUSEBUSY)
((SETQ MP (FIND.PROCESS
(QUOTE MOUSE)))
(PROCESS.EVALV MP (QUOTE
\MOUSEBUSY]
MP)
(T (TTY.PROCESS]
[(EQ HARDFLG (QUOTE WHICHW))
(* Interrupt the process that owns the window the mouse
is in)
(AND (GETD (QUOTE WHICHW))
(LET ((W (WHICHW)))
(AND W (WINDOWPROP W (QUOTE
PROCESS]
(T (TTY.PROCESS]
(COND
((EQ THISPROC INTERRUPTED.PROC)
(\DOINTERRUPTHERE CLASS))
((NULL INTERRUPTED.PROC)
(* Nobody qualified, so dismiss interrupt)
NIL)
((\PROCESS.MAKEFRAME INTERRUPTED.PROC (FUNCTION \DOINTERRUPTHERE)
(LIST CLASS CH HARDFLG)))
(T (* Couldn't build frame, so leave interrupt pending)
(SETQ \PENDINGINTERRUPT T])
(LISPINTERRUPTS
[LAMBDA NIL (* lmm " 1-Jul-85 20:19")
(QUOTE ((2 BREAK MOUSE)
(4 RESET MOUSE)
(5 ERROR MOUSE)
(8 HELP T)
(16 PRINTLEVEL)
(20 (CONTROL-T))
(127 RUBOUT T])
(\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])
(\DOINTERRUPTHERE
[LAMBDA (CLASS)
(DECLARE (USEDFREE \INTERRUPTABLE)) (* bvm: "18-Jul-85 12:37")
(* * Perform the CLASS interrupt in the currently running process)
(COND
((NOT \INTERRUPTABLE)
(SETQ \PENDINGINTERRUPT T))
(T (SELECTQ CLASS
(RESET (\CLEARSYSBUF T)
(RESET))
(ERROR (\CLEARSYSBUF T)
(SETERRORN 47)
(ERROR!))
(HELP (* Does a ↑B in process selected by user)
(\DOHELPINTERRUPT))
(BREAK (\DOHELPINTERRUPT1))
(CONTROL-T (CONTROL-T))
(STORAGE (\SETRECLAIMMIN))
(PRINTLEVEL (\SETPRINTLEVEL))
(RUBOUT (FLASHWINDOW)
(\CLEARSYSBUF T))
(RAID (RAID))
(COND
((LITATOM CLASS)
(SET CLASS T))
(T (\EVAL CLASS])
(\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: "18-Jul-85 13:00")
(* 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 \DOBUFFEREDTRANSITIONS \DOINTERRUPTHERE
\PROCESS.GO.TO.SLEEP BLOCK AWAIT.EVENT MONITOR.AWAIT.EVENT
GETMOUSESTATE)
NIL)
(RETURN $$VAL])
(\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 TABLE) (* bvm: " 1-Aug-85 15:55")
(OR TABLE (SETQ TABLE \CURRENTKEYACTION))
(SELECTQ CHAR
(NIL (* Non-system interrupts)
(for X in (fetch (KEYACTION INTERRUPTLIST)
TABLE)
unless (\SYSTEMINTERRUPTP (CADR X)) collect (CAR X)))
(T (* All system interrupts)
(for X in (fetch (KEYACTION INTERRUPTLIST)
TABLE)
collect (CAR X)))
(COND
[(NUMBERP CHAR)
(CDR (FASSOC CHAR (fetch (KEYACTION INTERRUPTLIST)
TABLE]
(T (for X in (fetch (KEYACTION INTERRUPTLIST)
TABLE)
when (EQ CHAR (CADR X))
do (* Find CHAR in system class.)
(RETURN (CAR X])
(CURRENTINTERRUPTS
[LAMBDA (TABLE) (* bvm: "18-Jul-85 12:37")
(APPEND (fetch (KEYACTION INTERRUPTLIST) of (OR TABLE \CURRENTKEYACTION])
(SETINTERRUPT
[LAMBDA (CHAR CLASS TABLE HARDFLG) (* bvm: " 1-Aug-85 16:09")
(OR TABLE (SETQ TABLE \CURRENTKEYACTION))
(LET (TEM) (* This code assumes that the variable
(FETCH (KEYACTION INTERRUPTLIST) TABLE) is an alist of
the form ((CHAR CLASS) ...))
(COND
((NULL CHAR) (* some mistake)
NIL)
((\SYSTEMINTERRUPTP CHAR) (* If this is a system interrupt, then this is turning
it off)
(SETINTERRUPT (GETINTERRUPT CHAR TABLE)
NIL TABLE))
[(SETQ TEM (FASSOC CHAR (fetch (KEYACTION INTERRUPTLIST)
TABLE))) (* CHAR is currently an interrupt)
(COND
((AND (EQ (CADR TEM)
CLASS)
(EQ (CADDR TEM)
HARDFLG)) (* No change)
)
((NULL CLASS) (* REMOVE FROM INTERRUPT CHARACTER SET)
(change (fetch (KEYACTION INTERRUPTLIST)
TABLE)
(DREMOVE TEM DATUM)))
(T (* Assign new interrupt to CHAR)
(change (CDR TEM)
(LIST CLASS HARDFLG]
((NULL CLASS))
(T (* Brand new interrupt)
(push (fetch (KEYACTION INTERRUPTLIST)
TABLE)
(LIST CHAR CLASS HARDFLG])
(RESET.INTERRUPTS
[LAMBDA (PermittedInterrupts SaveCurrent?)
(DECLARE (GLOBALVARS \DEFAULTKEYACTION)) (* bvm: "18-Jul-85 12:39")
(* 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 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 (fetch (KEYACTION INTERRUPTLIST) of \DEFAULTKEYACTION)
(FUNCTION (LAMBDA (CHAR)
(\INTCHAR (CAR CHAR] (* First, dis-arm all the current interrupts)
[COND
(SaveCurrent? (SETQ SaveCurrent? (APPEND (fetch (KEYACTION INTERRUPTLIST) of
\DEFAULTKEYACTION)
NIL]
(change (fetch (KEYACTION INTERRUPTLIST) of \DEFAULTKEYACTION)
(APPEND PermittedInterrupts)) (* Finally, "arm" and install the desired interrupts)
SaveCurrent?)])
(INTERRUPTABLE
[LAMBDA (FLAG) (* lmm "18-APR-82 13:52")
(PROG1 \INTERRUPTABLE (SETQ \INTERRUPTABLE FLAG])
)
(* ↑T)
(DEFINEQ
(CONTROL-T
[LAMBDA (POS) (* bvm: "31-Jul-85 19:20")
(* * 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 (* UNINTERRUPTABLY only so you can't type ↑T during ↑T)
(PROG ((STKI (COND
((STACKP POS)
0)
(T (SETQ POS)
-3)))
TEMP SWAPDELTA NETIODELTA DISKIODELTA GCDELTA KEYBOARDDELTA TOTALDELTA)
(SETQ TEMP (STKNTHNAME STKI POS))
[printout T (do (SELECTQ TEMP
((\INTERRUPTFRAME \INTERRUPTED INTERRUPTED \DOINTERRUPTHERE)
(* 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 (printout T " in "]
(SETQ TEMP (STKNTHNAME (add STKI -1)
POS)))
(COND
((NULL LAST↑TSWAPTIME) (* Just initialize the first time)
(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 (printout 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 TOTALDELTA (IPLUS (IMINUS LAST↑TTIMEBOX)
(SETQ LAST↑TTIMEBOX (CLOCK0 LAST↑TTIMEBOX]
(\CONTROL-T.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 "%% Util" T)
(\CONTROL-T.PRINTRATIO SWAPDELTA TOTALDELTA "%% Swap")
(\CONTROL-T.PRINTRATIO DISKIODELTA TOTALDELTA "%% DskIO")
(\CONTROL-T.PRINTRATIO NETIODELTA TOTALDELTA "%% Network")
(\CONTROL-T.PRINTRATIO GCDELTA TOTALDELTA "%% GC")))
(TERPRI T)))])
(\CONTROL-T.PRINTRATIO
[LAMBDA (N TOTAL LABEL NEWLINE) (* bvm: "31-Jul-85 19:04")
(COND
((NEQ N 0)
(COND
(NEWLINE (TERPRI T))
(T (printout T ", ")))
[COND
((OR (IGREATERP N TOTAL)
(ILESSP N 0))
(printout T "??"))
(T (printout T .I2 (IQUOTIENT (ITIMES N 100)
TOTAL]
(printout T LABEL])
)
(RPAQ? \CONTROL-T.DEPTH 3)
(RPAQ? \CONTROL-T.BACKSLASH )
(RPAQ? LAST↑TTIMEBOX (CLOCK 0))
(RPAQ? LAST↑TSWAPTIME )
(RPAQ? LAST↑TDISKIOTIME 0)
(RPAQ? LAST↑TGCTIME 0)
(RPAQ? LAST↑TNETIOTIME 0)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \CONTROL-T.DEPTH \CONTROL-T.BACKSLASH LAST↑TTIMEBOX LAST↑TSWAPTIME LAST↑TDISKIOTIME
LAST↑TNETIOTIME LAST↑TGCTIME \MISCSTATS)
)
(ADDTOVAR \SYSTEMCACHEVARS LAST↑TSWAPTIME)
(RPAQ? \CURRENTINTERRUPTS )
(RPAQ? \INTERRUPTABLE )
(RPAQ? INTERRUPTMENUFONT (QUOTE (GACHA 10)))
(RPAQQ \SYSTEMINTERRUPTS ((BREAK MOUSE)
(CONTROL-T)
(ERROR MOUSE)
(ERRORX)
(HELP T)
(OUTPUTBUFFER T)
(PRINTLEVEL)
(RAID T)
(RESET MOUSE)
(RUBOUT T)
(STORAGE)))
(DECLARE: EVAL@COMPILE DONTCOPY
(ADDTOVAR NOFIXFNSLST CONTROL-T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \CURRENTINTERRUPTS \SYSTEMINTERRUPTS INTERRUPTMENUFONT)
)
)
(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)
(DECLARE: EVAL@COMPILE
(PUTPROPS \SYSTEMINTERRUPTP MACRO ((KEY)
(ASSOC KEY \SYSTEMINTERRUPTS)))
)
)
(PUTPROPS AINTERRUPT COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1881 18985 (INTCHAR 1891 . 5894) (INTERRUPTCHAR 5896 . 6203) (INTERRUPTED 6205 . 8690)
(LISPINTERRUPTS 8692 . 8966) (\DOHELPINTERRUPT 8968 . 9664) (\DOHELPINTERRUPT1 9666 . 10675) (
\DOINTERRUPTHERE 10677 . 11597) (\DOSTACKFULLINTERRUPT 11599 . 11869) (\PROC.FINDREALFRAME 11871 .
12566) (\SETPRINTLEVEL 12568 . 13884) (\SETRECLAIMMIN 13886 . 14597) (GETINTERRUPT 14599 . 15579) (
CURRENTINTERRUPTS 15581 . 15793) (SETINTERRUPT 15795 . 17366) (RESET.INTERRUPTS 17368 . 18844) (
INTERRUPTABLE 18846 . 18983)) (19001 23778 (CONTROL-T 19011 . 23370) (\CONTROL-T.PRINTRATIO 23372 .
23776)))))
STOP