(FILECREATED " 4-Nov-85 17:59:23" {ERIS}<LISPCORE>SOURCES>AINTERRUPT.;32 26299
changes to: (FNS \DOSTACKFULLINTERRUPT)
(VARS AINTERRUPTCOMS)
previous date: "15-Oct-85 00:09:47" {ERIS}<LISPCORE>SOURCES>AINTERRUPT.;31)
(* 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 \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: " 3-Sep-85 21:33")
(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))
((fetch GCDISABLED of \INTERRUPTSTATE)
(\DOGCDISABLEDINTERRUPT))
(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 (* jds "30-Sep-85 12:35")
(* * Returns a list of the "standard" interrupt-character settings for Interlisp-D. These are used, e.g., in INTCHAR
to reset things to the default state.)
(QUOTE ((2 BREAK MOUSE)
(4 RESET MOUSE)
(5 ERROR MOUSE)
(7 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])
(\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)) (* gbn "14-Oct-85 21:17")
(* 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)
(CHARCODEP (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 3)
(GCDISABLED FLAG)
(VMEMFULL FLAG)
(STACKOVERFLOW FLAG)
(STORAGEFULL FLAG)
(WAITINGINTERRUPT FLAG)
(NIL BITS 8)
(INTCHARCODE WORD)))
]
(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 (1773 18933 (INTCHAR 1783 . 5786) (INTERRUPTCHAR 5788 . 6095) (INTERRUPTED 6097 . 8662)
(LISPINTERRUPTS 8664 . 9118) (\DOHELPINTERRUPT 9120 . 9816) (\DOHELPINTERRUPT1 9818 . 10827) (
\DOINTERRUPTHERE 10829 . 11749) (\PROC.FINDREALFRAME 11751 . 12446) (\SETPRINTLEVEL 12448 . 13764) (
\SETRECLAIMMIN 13766 . 14477) (GETINTERRUPT 14479 . 15459) (CURRENTINTERRUPTS 15461 . 15673) (
SETINTERRUPT 15675 . 17246) (RESET.INTERRUPTS 17248 . 18792) (INTERRUPTABLE 18794 . 18931)) (18949
23726 (CONTROL-T 18959 . 23318) (\CONTROL-T.PRINTRATIO 23320 . 23724)))))
STOP