(FILECREATED " 5-Feb-85 17:55:04" {ERIS}<LISPCORE>SOURCES>PROC.;19 111623
changes to: (FNS RESTART.PROCESS \MAKE.PROCESS0 \PROCESS.MAKEFRAME \TURN.ON.PROCESSES
\PROC.CODEFORTFRAME)
previous date: " 4-Jan-85 13:03:50" {ERIS}<LISPCORE>SOURCES>PROC.;18)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved. The following
program was created in 1982 but has not been published within the meaning of the copyright law, is
furnished under license, and may not be used, copied and/or disclosed except in accordance with the
terms of said license.)
(PRETTYCOMPRINT PROCCOMS)
(RPAQQ PROCCOMS [(COMS (DECLARE: DONTCOPY (EXPORT (RECORDS PROCESS))
(RECORDS PROCESSQUEUE)
(CONSTANTS \PSTAT.WAITING \PSTAT.RUNNING \PSTAT.DELETED))
(INITRECORDS PROCESS PROCESSQUEUE)
(SYSRECORDS PROCESS PROCESSQUEUE))
[COMS (* User entries)
(FNS PROCESSWORLD ADD.PROCESS DEL.PROCESS PROCESS.RETURN FIND.PROCESS
MAP.PROCESSES PROCESSP RELPROCESSP RESTART.PROCESS WAKE.PROCESS
SUSPEND.PROCESS PROCESS.RESULT PROCESS.FINISHEDP)
(INITVARS (NOCLEARSTKLST NIL (* in case it is not initialized)))
(FNS THIS.PROCESS TTY.PROCESS TTY.PROCESSP PROCESS.TTY GIVE.TTY.PROCESS
PROCESS.PREPARE.FOR.INPUT ALLOW.BUTTON.EVENTS SPAWN.MOUSE \WAIT.FOR.TTY
WAIT.FOR.TTY)
(FNS PROCESSPROP PROCESS.NAME PROCESS.WINDOW)
(PROP ARGNAMES PROCESSPROP ADD.PROCESS)
(COMS (* Temporary)
(P (MOVD? (QUOTE PROCESS.RETURN)
(QUOTE KILL.ME]
(COMS (FNS DISMISS BLOCK WAITFORINPUT \WAITFORSYSBUFP)
(GLOBALRESOURCES \DISMISSBOX \DISMISSTIMER \DISMISSTIMER-100))
(COMS (FNS EVAL.AS.PROCESS EVAL.IN.TTY.PROCESS)
(* The PROCESS.WAIT macro is an augmentation to BLOCK, waiting for a condition
to come true, or a timeout, or a wakeup)
(MACROS PROCESS.WAIT)
(FNS PROCESS.READ PROCESS.EVALV PROCESS.EVAL \PROCESS.EVAL1 PROCESS.APPLY
\PROCESS.APPLY1)
(* Standard values for WAKEREASON -- PSTAT.TIMEDOUT is the only public one)
(VARS (PSTAT.WAKEUP "default WakeUp")
(PSTAT.TIMEDOUT "{time interval expired}")
(PSTAT.QUIT "Quit")
(\PSTAT.NORESULT "{no result yet}"))
(GLOBALVARS PSTAT.WAKEUP PSTAT.TIMEDOUT PSTAT.QUIT \PSTAT.NORESULT))
(COMS (* Event stuff)
(DECLARE: DONTCOPY (RECORDS EVENT))
(INITRECORDS EVENT)
(SYSRECORDS EVENT)
(FNS CREATE.EVENT NOTIFY.EVENT AWAIT.EVENT \UNQUEUE.EVENT \ENQUEUE.EVENT/LOCK)
(MACROS AWAIT.CONDITION)
(INITVARS (\TTY.PROCESS.EVENT)
(\PROCESS.AFTEREXIT.EVENT))
(GLOBALVARS \TTY.PROCESS.EVENT \PROCESS.AFTEREXIT.EVENT))
(COMS (* Monitor stuff)
(DECLARE: DONTCOPY (RECORDS MONITORLOCK))
(INITRECORDS MONITORLOCK)
(SYSRECORDS MONITORLOCK)
(FNS OBTAIN.MONITORLOCK CREATE.MONITORLOCK RELEASE.MONITORLOCK
MONITOR.AWAIT.EVENT)
(MACROS WITH.MONITOR WITH.FAST.MONITOR))
(FNS \MAKE.PROCESS0 \PROCESS.MOVEFRAME \RELEASE.PROCESS \MAYBEBLOCK
\BACKGROUND.PROCESS \MOUSE.PROCESS \TIMER.PROCESS \PROC.RESETRESTORE
\PROCESS.UNWINDALL \UNIQUE.PROCESS.NAME)
(COMS (FNS \START.PROCESSES \PROCESS.GO.TO.SLEEP \PROC.RESUME \RUN.PROCESS
\FLUSH.PROCESS \SUSPEND.PROCESS \UNQUEUE.TIMER \ENQUEUE.TIMER
\GET.PRIORITY.QUEUE)
(DECLARE: DONTCOPY (MACROS \RESCHEDULE)))
(COMS (FNS \PROCESS.INIT \PROCESS.EVENTFN \PROCESS.BEFORE.LOGOUT \PROCESS.AFTER.EXIT
\PROC.AFTER.WINDOWWORLD \TURN.ON.PROCESSES)
(* Redefinitions)
(FNS \PROC.CODEFORTFRAME \PROC.REPEATEDLYEVALQT))
(COMS (* switching stacks)
(FNS BREAK.PROCESS \SELECTPROCESS \PROCESS.MAKEFRAME \PROCESS.MAKEFRAME0))
(INITVARS (#MYHANDLE#)
(\TTY.PROCESS)
(#SCHEDULER#)
(\RUNNING.PROCESS)
(\PROCESSES)
(FUNNNYPROCS)
(PROCESS.MAXMOUSE 5)
(PROC.FREESPACESIZE 1024)
(AUTOPROCESSFLG T)
(BACKGROUNDFNS)
(\TIMERQHEAD)
(\HIGHEST.PRIORITY.QUEUE)
(PROC.DEFAULT.PRIORITY 2)
(\DEFAULTLINEBUF)
(\DEFAULTTTYDISPLAYSTREAM)
(\PROCTIMER.SCRATCH (NCREATE (QUOTE FIXP)))
(TOPW)
(\PROC.RUN.NEXT.FLG)
(\PROC.READY T))
(ADDVARS (\SYSTEMCACHEVARS \PROC.READY))
(COMS (VARS (\PROC.RESTARTME "{restart flag}")
(\PROC.RESETME "{reset flag}"))
(DECLARE: DONTCOPY (EXPORT (MACROS THIS.PROCESS TTY.PROCESS TTY.PROCESSP)
(GLOBALVARS \RUNNING.PROCESS \TTY.PROCESS
\PROC.RESTARTME \PROC.RESETME))
(GLOBALVARS \PROCESSES PROC.FREESPACESIZE NOCLEARSTKLST #SCHEDULER#
PROCESS.MAXMOUSE AUTOPROCESSFLG BACKGROUNDFNS
\TopLevelTtyWindow \PROC.READY)
(GLOBALVARS \TIMERQHEAD \PROCTIMER.SCRATCH \HIGHEST.PRIORITY.QUEUE
PROC.DEFAULT.PRIORITY \PROC.RUN.NEXT.FLG)
(MACROS ALIVEPROCP DEADPROCP \COERCE.TO.PROCESS)
(LOCALVARS . T)))
(COMS (* Debugging)
(FNS \CHECK.PQUEUE)
(FNS PPROC PPROCWINDOW PPROCREPAINTFN PPROCRESHAPEFN PPROCEXTENT PPROC1
PROCESS.STATUS.WINDOW PROC.SELECTED PROCOP.SELECTED PROCESS.BACKTRACE
\INVALIDATE.PROCESS.WINDOW \UPDATE.PROCESS.WINDOW)
(INITVARS (PROCMENU)
(PROCOPMENU)
(PROCOP.WAKEMENU)
(PROCBACKTRACEWINDOW)
(PROCESS.STATUS.WINDOW)
(SELECTEDPROC)
(PROCBACKTRACEHEIGHT 320))
(ADDVARS (BackgroundMenuCommands ("PSW" (QUOTE (PROCESS.STATUS.WINDOW))
"Puts up a Process Status Window")))
(P (SETQQ BackgroundMenu))
(DECLARE: EVAL@COMPILE DONTCOPY
(GLOBALVARS PROCESS.STATUS.WINDOW PROCMENU PROCOPMENU
PROCOP.WAKEMENU PROCBACKTRACEHEIGHT SELECTEDPROC
BACKTRACEFONT PROCBACKTRACEWINDOW)
(CONSTANTS LIGHTGRAYSHADE SELECTIONSHADE)))
(DECLARE: DONTEVAL@LOAD DOCOPY (ADDVARS (WINDOWUSERFORMS (\PROC.AFTER.WINDOWWORLD)))
(P (\PROCESS.INIT)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA PROCESSPROP ADD.PROCESS])
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(DATATYPE PROCESS ((NIL BYTE)
(MYSTACK POINTER) (* Stack pointer to this context when it is asleep)
(PROCSTATUS BYTE) (* Running, waiting)
(PROCNAME POINTER) (* Name for convenience in type-in reference)
(PROCPRIORITY BYTE) (* Priority level, 0-4)
(PROCQUEUE POINTER) (* Queue of processes at the same priority)
(NIL BYTE)
(NEXTPROCHANDLE POINTER) (* Pointer to next one)
(PROCTIMERSET FLAG) (* True if PROCWAKEUPTIMER has an interesting value)
(PROCBEINGDELETED FLAG) (* True if proc was deleted, but hasn't been removed
from \PROCESSES yet)
(PROCDELETED FLAG)
(PROCSYSTEMP FLAG)
(NIL BITS 4)
(PROCWAKEUPTIMER POINTER) (* a largep recording the time this proc last went to
sleep)
(PROCTIMERLINK POINTER) (* For linking proc in timer queue)
(PROCTIMERBOX POINTER) (* Scratch box to use for PROCWAKEUPTIMER when user
does not give one explicitly)
(WAKEREASON POINTER) (* Reason process is being run.
From WAKE.PROCESS or timer or event wakeup;
T from simple BLOCK)
(PROCEVENTORLOCK POINTER) (* EVENT or MONITOR lock that this proc is waiting for)
(PROCFORM POINTER) (* Form to EVAL to start it going)
(RESTARTABLE POINTER) (* T = autorestart on error, HARDRESET = restart only
on hard reset, NIL = never restart)
(PROCWINDOW POINTER) (* Window this process lives in, if any)
(PROCFINISHED POINTER) (* True if proc finished. Value is indication of how:
NORMAL, DELETED, ERROR)
(PROCRESULT POINTER) (* Value it returned if it finished normally)
(PROCFINISHEVENT POINTER) (* Optional EVENT to be notified when proc finishes)
(PROCMAILBOX POINTER) (* Message queue)
(PROCRESETVARSLST POINTER) (* Binding for RESETVARSLST in this process)
(PROCINFOHOOK POINTER) (* Optional user fn that displays info about process)
(PROCTYPEAHEAD POINTER) (* Buffer of typeahead destined for this proc)
(PROCREMOTEINFO POINTER) (* For Enterprise)
(PROCUSERDATA POINTER) (* For PROCESSPROP)
(PROCEVENTLINK POINTER) (* Used to maintain EVENT queues)
(PROCAFTEREXIT POINTER) (* What to do with this process when coming back from a
LOGOUT, etc)
(PROCBEFOREEXIT POINTER) (* For expansion)
(PROCOWNEDLOCKS POINTER) (* Pointer to first lock I currently own)
(PROCEVAPPLYRESULT POINTER) (* For PROCESS.EVAL and PROCESS.APPLY when
WAITFORRESULT is true)
(PROCTTYENTRYFN POINTER) (* Is applied to a process when it becomes the tty
process)
(PROCTTYEXITFN POINTER) (* Is applied to a process when it ceases to be the tty
process)
(PROCDRIBBLEOFD POINTER)
(PROCRESTARTFORM POINTER)
(NIL POINTER)
(NIL POINTER) (* For expansion)
)
[ACCESSFNS PROCESS ((PROCFX (fetch EDFXP of (fetch MYSTACK of DATUM))
(replace EDFXP of (fetch MYSTACK of DATUM)
with NEWVALUE]
PROCTIMERBOX ←(CREATECELL \FIXP))
]
(/DECLAREDATATYPE (QUOTE PROCESS)
(QUOTE (BYTE POINTER BYTE POINTER BYTE POINTER BYTE POINTER FLAG FLAG FLAG FLAG
(BITS 4)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER)))
(* END EXPORTED DEFINITIONS)
[DECLARE: EVAL@COMPILE
(DATATYPE PROCESSQUEUE ((PQPRIORITY BYTE)
(PQHIGHER POINTER) (* Next higher-prioirty queue)
(PQLOWER POINTER) (* Next lower)
(PQNEXT POINTER) (* The process currently running or runnable at this
priority)
(PQLAST POINTER) (* The proc previous to it. PQNEXT might be redundant)
))
]
(/DECLAREDATATYPE (QUOTE PROCESSQUEUE)
(QUOTE (BYTE POINTER POINTER POINTER POINTER)))
(DECLARE: EVAL@COMPILE
(RPAQQ \PSTAT.WAITING 0)
(RPAQQ \PSTAT.RUNNING 1)
(RPAQQ \PSTAT.DELETED 2)
(CONSTANTS \PSTAT.WAITING \PSTAT.RUNNING \PSTAT.DELETED)
)
)
(/DECLAREDATATYPE (QUOTE PROCESS)
(QUOTE (BYTE POINTER BYTE POINTER BYTE POINTER BYTE POINTER FLAG FLAG FLAG FLAG
(BITS 4)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE PROCESSQUEUE)
(QUOTE (BYTE POINTER POINTER POINTER POINTER)))
[ADDTOVAR SYSTEMRECLST
(DATATYPE PROCESS ((NIL BYTE)
(MYSTACK POINTER)
(PROCSTATUS BYTE)
(PROCNAME POINTER)
(PROCPRIORITY BYTE)
(PROCQUEUE POINTER)
(NIL BYTE)
(NEXTPROCHANDLE POINTER)
(PROCTIMERSET FLAG)
(PROCBEINGDELETED FLAG)
(PROCDELETED FLAG)
(PROCSYSTEMP FLAG)
(NIL BITS 4)
(PROCWAKEUPTIMER POINTER)
(PROCTIMERLINK POINTER)
(PROCTIMERBOX POINTER)
(WAKEREASON POINTER)
(PROCEVENTORLOCK POINTER)
(PROCFORM POINTER)
(RESTARTABLE POINTER)
(PROCWINDOW POINTER)
(PROCFINISHED POINTER)
(PROCRESULT POINTER)
(PROCFINISHEVENT POINTER)
(PROCMAILBOX POINTER)
(PROCRESETVARSLST POINTER)
(PROCINFOHOOK POINTER)
(PROCTYPEAHEAD POINTER)
(PROCREMOTEINFO POINTER)
(PROCUSERDATA POINTER)
(PROCEVENTLINK POINTER)
(PROCAFTEREXIT POINTER)
(PROCBEFOREEXIT POINTER)
(PROCOWNEDLOCKS POINTER)
(PROCEVAPPLYRESULT POINTER)
(PROCTTYENTRYFN POINTER)
(PROCTTYEXITFN POINTER)
(PROCDRIBBLEOFD POINTER)
(PROCRESTARTFORM POINTER)
(NIL POINTER)
(NIL POINTER)))
(DATATYPE PROCESSQUEUE ((PQPRIORITY BYTE)
(PQHIGHER POINTER)
(PQLOWER POINTER)
(PQNEXT POINTER)
(PQLAST POINTER)))
]
(* User entries)
(DEFINEQ
(PROCESSWORLD
[LAMBDA (FLG) (* bvm: "22-Jun-84 16:48")
(* get started with multi-processing)
(COND
[(EQ FLG (QUOTE OFF)) (* Turn them off)
(* Release the stack space used by the procs, but keep
the handles around for possible unwinding;
normally processworld is never turned off.)
(for P in \PROCESSES do (\RELEASE.PROCESS P))
(SETQ \TTY.PROCESS)
(COND
((TYPENAMEP \TopLevelTtyWindow (QUOTE WINDOW))
(WINDOWPROP \TopLevelTtyWindow (QUOTE PROCESS)
NIL)))
(SETQ \RUNNING.PROCESS)
(COND
([AND #SCHEDULER# (NOT (RELSTKP (fetch MYSTACK of #SCHEDULER#]
(RETTO (PROG1 (fetch MYSTACK of #SCHEDULER#)
(SETQ NOCLEARSTKLST (DREMOVE (fetch MYSTACK of #SCHEDULER#)
NOCLEARSTKLST))
(SETQ #SCHEDULER#))
PSTAT.QUIT T]
(\RUNNING.PROCESS (QUOTE (Processes are already on)))
(T (PROG (EXECPROC)
[COND
((NOT (type? PROCESS #SCHEDULER#))
(SETQ #SCHEDULER# (create PROCESS
MYSTACK ←(STKNTH 0 T)))
(SETQ NOCLEARSTKLST (CONS (fetch MYSTACK of #SCHEDULER#)
NOCLEARSTKLST]
(* First wander thru any old processes, checking for
unwind info and processes that said they want to restart
on HARDRESET)
(SETQ \TTY.PROCESS.EVENT (CREATE.EVENT (QUOTE TTY)))
(SETQ \PROCESS.AFTEREXIT.EVENT (CREATE.EVENT "After Exit"))
[COND
((type? PROCESSQUEUE \HIGHEST.PRIORITY.QUEUE)
(* Empty out the queues)
(for (PQ ← \HIGHEST.PRIORITY.QUEUE) by (fetch PQLOWER of PQ) while PQ
do (replace PQNEXT of PQ with (replace PQLAST of PQ with NIL]
(SETQ \PROCESSES (for P in \PROCESSES when (COND
((EQ (fetch PROCNAME of P)
(QUOTE EXEC))
(* Save the EXEC to run last)
(\RELEASE.PROCESS P)
(SETQ EXECPROC P)
NIL)
((NULL (fetch MYSTACK of P))
(* Process got created when scheduling was off)
T)
((fetch RESTARTABLE of P)
(* Stack of this process got flushed by a hard reset)
T)
((OR (AND (EQ P \TTY.PROCESS)
(fetch PROCTTYEXITFN
of P))
(fetch PROCRESETVARSLST
of P)
(fetch PROCDRIBBLEOFD of P))
(* Need to RESETRESTORE once processworld back on)
(replace PROCFINISHED of P
with (QUOTE DELETED))
T)
(T (replace PROCDELETED of P
with T)
(\RELEASE.PROCESS P T T)
NIL))
collect (PROGN (\RELEASE.PROCESS P)
(* Take it off any queues etc it was on)
P)))
(for P in \PROCESSES
do (* Bring it back to life)
(\MAKE.PROCESS0 (OR (fetch PROCRESTARTFORM of P)
(fetch PROCFORM of P))
P)
(\RUN.PROCESS P))
(COND
((NOT (FIND.PROCESS (QUOTE BACKGROUND)))
(ADD.PROCESS (LIST (FUNCTION \BACKGROUND.PROCESS))
(QUOTE NAME)
(QUOTE BACKGROUND)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE SCHEDULE)
T)))
(COND
([AND TOPW (NOT (FIND.PROCESS (QUOTE MOUSE]
(ADD.PROCESS (LIST (FUNCTION \MOUSE.PROCESS))
(QUOTE NAME)
(QUOTE MOUSE)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE SCHEDULE)
T)))
(COND
((NOT (FIND.PROCESS (QUOTE \TIMER.PROCESS)))
(SETQ \TIMERQHEAD (ADD.PROCESS (LIST (FUNCTION \TIMER.PROCESS))
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE SCHEDULE)
T)))
(T (replace PROCTIMERLINK of (\DTEST \TIMERQHEAD (QUOTE PROCESS)) with NIL)))
[COND
(EXECPROC (push \PROCESSES EXECPROC)
(\MAKE.PROCESS0 (fetch PROCFORM of EXECPROC)
EXECPROC)
(\RUN.PROCESS EXECPROC))
(T (SETQ EXECPROC (ADD.PROCESS (QUOTE (\PROC.REPEATEDLYEVALQT))
(QUOTE NAME)
(QUOTE EXEC)
(QUOTE RESTARTABLE)
(QUOTE ALWAYS)
(QUOTE SCHEDULE)
T]
(COND
((TYPENAMEP \TopLevelTtyWindow (QUOTE WINDOW))
(replace PROCWINDOW of EXECPROC with \TopLevelTtyWindow)
(WINDOWPROP \TopLevelTtyWindow (QUOTE PROCESS)
EXECPROC)))
(COND
((NOT (MEMB \TTY.PROCESS \PROCESSES))
(SETQ \TTY.PROCESS EXECPROC))) (* most of the action is in BLOCK, but we start here,
and occasionaly control comes back as well)
LP [ERSETQ (PROG (RESULT)
(replace NEXTPROCHANDLE of #SCHEDULER# with (CAR \PROCESSES))
(SETQ RESULT (\START.PROCESSES))
[COND
((EQ RESULT PSTAT.QUIT) (* from (PROCESSWORLD (QUOTE OFF)))
(RETFROM (QUOTE PROCESSWORLD]
(printout T T "??? Process mech. confused - strange RESULT in SCHEDULE"
, # (LVLPRINT RESULT NIL 2 6]
(GO LP])
(ADD.PROCESS
[LAMBDA ARGS (* bvm: " 3-Apr-84 14:41")
(PROG ((FORM (ARG ARGS 1))
(PRIORITY PROC.DEFAULT.PRIORITY)
(CREATENOW (THIS.PROCESS))
RESTARTFLG SYSTEMP SUSPENDIT INFOHOOK RESTARTFORM WINDOW NAME AFTEREXIT PROC USERPROPS
PROP VALUE BEFOREEXIT TTYENTRYFN TTYEXITFN)
[COND
((EQ ARGS 2) (* Backward compatibility)
(SETQ NAME (ARG ARGS 2)))
(T (for I from 2 to ARGS by 2
do (SETQ VALUE (ARG ARGS (ADD1 I)))
(SELECTQ (SETQ PROP (ARG ARGS I))
(WINDOW (SETQ WINDOW (\INSUREWINDOW VALUE)))
[PRIORITY (SETQ PRIORITY (\DTEST VALUE (QUOTE SMALLP]
(NAME (SETQ NAME VALUE))
(AFTEREXIT (SETQ AFTEREXIT VALUE))
(BEFOREEXIT (SETQ BEFOREEXIT VALUE))
(TTYENTRYFN (SETQ TTYENTRYFN VALUE))
(TTYEXITFN (SETQ TTYEXITFN VALUE))
(INFOHOOK (SETQ INFOHOOK VALUE))
(RESTARTFORM (SETQ RESTARTFORM VALUE))
(RESTARTABLE (SETQ RESTARTFLG VALUE))
(SCHEDULE (SETQ CREATENOW T))
(SUSPEND (SETQ SUSPENDIT VALUE))
(COND
([AND (EQ ARGS 3)
(FMEMB VALUE (QUOTE (SYSTEM NO T]
(* Backward compatibility: arglist used to be
(FORM NAME RESTARTFLG))
(SETQ NAME PROP)
(SETQ RESTARTFLG VALUE))
(T (push USERPROPS PROP VALUE]
(SETQ RESTARTFLG (SELECTQ RESTARTFLG
(SYSTEM (SETQ SYSTEMP T))
((NIL NO NEVER)
NIL)
((T YES ALWAYS)
T)
(HARDRESET (QUOTE HARDRESET))
(\ILLEGAL.ARG RESTARTFLG)))
(OR (LISTP FORM)
(\ILLEGAL.ARG FORM))
[SETQ NAME (\UNIQUE.PROCESS.NAME (OR NAME (CAR FORM]
(SETQ PROC
(create PROCESS
PROCNAME ← NAME
PROCTIMERSET ← NIL
WAKEREASON ← T
PROCFORM ← FORM
RESTARTABLE ← RESTARTFLG
PROCPRIORITY ← PRIORITY
PROCSTATUS ← \PSTAT.WAITING
PROCSYSTEMP ← SYSTEMP
PROCAFTEREXIT ← AFTEREXIT
PROCBEFOREEXIT ← BEFOREEXIT
PROCTTYENTRYFN ← TTYENTRYFN
PROCTTYEXITFN ← TTYEXITFN
PROCWINDOW ← WINDOW
PROCINFOHOOK ← INFOHOOK
PROCUSERDATA ← USERPROPS
PROCRESTARTFORM ← RESTARTFORM))
(COND
(WINDOW (WINDOWPROP WINDOW (QUOTE PROCESS)
PROC)))
(replace PROCQUEUE of PROC with (\GET.PRIORITY.QUEUE (fetch PROCPRIORITY of PROC)))
(UNINTERRUPTABLY
(SETQ \PROCESSES (CONS PROC \PROCESSES))
(\INVALIDATE.PROCESS.WINDOW)
[COND
(CREATENOW (* Only create it if we are actually scheduling)
(\MAKE.PROCESS0 FORM PROC)
(OR SUSPENDIT (\RUN.PROCESS PROC])
(RETURN PROC])
(DEL.PROCESS
[LAMBDA (PROC INTERNAL) (* bvm: "22-JUL-83 15:54")
(PROG ((P (\COERCE.TO.PROCESS PROC)))
(RETURN (COND
(P [COND
((EQ (fetch PROCNAME of P)
(QUOTE EXEC))
(OR INTERNAL (ERROR "Can't kill EXEC" P]
(\FLUSH.PROCESS P)
T])
(PROCESS.RETURN
[LAMBDA (VALUE) (* bvm: " 4-MAY-83 12:35")
(PROG ((ME (THIS.PROCESS)))
(RETURN (COND
((type? PROCESS ME)
(replace PROCFINISHED of ME with (QUOTE NORMAL))
(replace PROCRESULT of ME with VALUE)
(DEL.PROCESS ME T))
(T (ERROR "PROCESS.RETURN called from outside of ProcessWorld" VALUE])
(FIND.PROCESS
[LAMBDA (PROC ERRORFLG) (* bvm: "31-JUL-83 16:59")
(* Coerces PROC to a process handle, returning handle if okay; otherwise, if ERRORFLG is set, causes an error,
else returns NIL. If ERRORFLG is true, also causes error if proc is not alive)
(PROG [(P (COND
((type? PROCESS PROC)
(AND (NOT (fetch PROCDELETED of PROC))
PROC))
(T (find P in \PROCESSES suchthat (EQ (fetch PROCNAME of P)
PROC]
(RETURN (COND
((AND P (OR (NOT ERRORFLG)
(ALIVEPROCP P)))
P)
(ERRORFLG (ERROR PROC "not a live process"])
(MAP.PROCESSES
[LAMBDA (MAPFN) (* bvm: "16-JUN-82 16:22")
(for P in (APPEND \PROCESSES) do (APPLY* MAPFN P (fetch PROCNAME of P)
(fetch PROCFORM of P))
unless (DEADPROCP P])
(PROCESSP
[LAMBDA (PROC) (* bvm: " 6-JUL-82 17:30")
(AND (type? PROCESS PROC)
(ALIVEPROCP PROC])
(RELPROCESSP
[LAMBDA (PROCHANDLE) (* bvm: "13-JUN-82 14:39")
(AND (type? PROCESS PROCHANDLE)
(DEADPROCP PROCHANDLE])
(RESTART.PROCESS
[LAMBDA (PROC) (* bvm: " 5-Feb-85 13:09")
(PROG ((P (\COERCE.TO.PROCESS PROC)))
[COND
(P (UNINTERRUPTABLY
(replace WAKEREASON of P with \PROC.RESTARTME)
[COND
((EQ P (THIS.PROCESS))
(RETTO (QUOTE \MAKE.PROCESS0)
\PROC.RESTARTME))
(T [PROG ((FX (fetch PROCFX of P)))
SCNLP
(COND
((EQ (fetch (FX FRAMENAME) of FX)
(QUOTE \MAKE.PROCESS0))
(* Diddle P's stack so that it looks like BLOCK will
return to \MAKE.PROCESS0)
(\MAKESTACKP (fetch MYSTACK of P)
FX))
((fetch (FX INVALIDP) of (SETQ FX (fetch (FX CLINK) of FX)))
(LISPERROR "ILLEGAL STACK ARG" (QUOTE \MAKE.PROCESS0)))
(T (GO SCNLP]
(COND
((EQ (fetch PROCSTATUS of P)
\PSTAT.RUNNING)
(replace WAKEREASON of P with \PROC.RESTARTME))
(T (\RUN.PROCESS P \PROC.RESTARTME])]
(RETURN P])
(WAKE.PROCESS
[LAMBDA (PROC STATUS) (* bvm: " 4-MAY-83 14:58")
(* cause a (possibly) sleeping process to run -
Note that the STATUS will be returned as the value of the BLOCK that put the process to sleep)
(DECLARE (GLOBALVARS PSTAT.WAKEUP))
(PROG ((P (\COERCE.TO.PROCESS PROC)))
(COND
(P (UNINTERRUPTABLY
[COND
((NEQ (fetch PROCSTATUS of P)
\PSTAT.RUNNING)
(\RUN.PROCESS P (OR STATUS PSTAT.WAKEUP)))
(T (replace WAKEREASON of P with (OR STATUS PSTAT.WAKEUP])
(RETURN T])
(SUSPEND.PROCESS
[LAMBDA (PROC) (* bvm: " 4-MAY-83 12:37")
(PROG [(P (COND
(PROC (\COERCE.TO.PROCESS PROC T))
(T (THIS.PROCESS]
(COND
((EQ P (THIS.PROCESS))
(\PROCESS.GO.TO.SLEEP))
(T (\SUSPEND.PROCESS P)))
(RETURN P])
(PROCESS.RESULT
[LAMBDA (PROCESS WAITFORRESULT) (* bvm: " 1-JUN-83 22:26")
(SETQ PROCESS (\DTEST PROCESS (QUOTE PROCESS)))
(COND
((DEADPROCP PROCESS)
(fetch PROCRESULT of PROCESS))
(WAITFORRESULT (bind [EVENT ←(OR (fetch PROCFINISHEVENT of PROCESS)
(replace PROCFINISHEVENT of PROCESS
with (CREATE.EVENT (CONCAT (fetch PROCNAME of PROCESS)
"#Finish"]
until (DEADPROCP PROCESS) do (AWAIT.EVENT EVENT)
finally (RETURN (fetch PROCRESULT of PROCESS])
(PROCESS.FINISHEDP
[LAMBDA (PROCESS) (* bvm: "17-SEP-82 11:53")
(SETQ PROCESS (\DTEST PROCESS (QUOTE PROCESS)))
(COND
((fetch PROCFINISHED of PROCESS))
((DEADPROCP PROCESS)
(QUOTE ERROR])
)
(RPAQ? NOCLEARSTKLST NIL (* in case it is not initialized))
(DEFINEQ
(THIS.PROCESS
[LAMBDA NIL (* bvm: " 4-MAY-83 13:47")
\RUNNING.PROCESS])
(TTY.PROCESS
[LAMBDA (PROC) (* lmm " 3-May-84 10:00")
(PROG1 (AND (type? PROCESS \TTY.PROCESS)
\TTY.PROCESS)
(COND
(PROC (PROG ([NEWTTY (COND
[(EQ PROC T)
(OR (FIND.PROCESS (QUOTE EXEC))
(FIND.PROCESS (QUOTE MOUSE]
((type? PROCESS PROC)
PROC)
(T (FIND.PROCESS PROC T]
(OLDTTY \TTY.PROCESS)
OLDTTYDS TYPEAHEAD FN)
(COND
((fetch PROCDELETED of NEWTTY) (* Ordinarily would error, but this can easily happen
from a RESETFORM)
(RETURN)))
(COND
((NEQ NEWTTY OLDTTY)
(\CHECKCARET) (* gonna switch TTY, take down caret wherever it is)
[COND
((SETQ TYPEAHEAD (bind C while (SETQ C (\GETSYSBUF)) collect C))
(* Save any typeahead that was done while old proc had
the tty)
(replace PROCTYPEAHEAD of OLDTTY
with (NCONC (fetch PROCTYPEAHEAD of OLDTTY)
TYPEAHEAD]
(UNINTERRUPTABLY
(COND
((SETQ FN (fetch PROCTTYEXITFN of OLDTTY))
(APPLY* FN OLDTTY NEWTTY)))
(SETQ \TTY.PROCESS NEWTTY)
(COND
((SETQ FN (fetch PROCTTYENTRYFN of NEWTTY))
(APPLY* FN NEWTTY OLDTTY)))
(NOTIFY.EVENT \TTY.PROCESS.EVENT))])
(TTY.PROCESSP
[LAMBDA (PROC) (* bvm: " 5-MAY-83 18:14")
(OR (NULL (THIS.PROCESS))
(EQ (OR PROC (THIS.PROCESS))
(TTY.PROCESS])
(PROCESS.TTY
[LAMBDA (PROC) (* bvm: "17-AUG-83 11:02")
(* returns the TTY for a process)
(COND
((OR (NULL PROC)
(EQ (SETQ PROC (\COERCE.TO.PROCESS PROC))
(THIS.PROCESS)))
TtyDisplayStream)
(PROC (PROCESS.EVALV PROC (QUOTE TtyDisplayStream])
(GIVE.TTY.PROCESS
[LAMBDA (WINDOW) (* rrb "16-Jul-84 17:53")
(* default WINDOWENTRYFN which gives the tty to the
process associated with this window and calls its
BUTTONEVENTFN)
(OR (WINDOWP WINDOW)
(\ILLEGAL.ARG WINDOW))
(PROG ((PROC (WINDOWPROP WINDOW (QUOTE PROCESS)))
FN)
[COND
(PROC (COND
((DEADPROCP PROC)
(WINDOWPROP WINDOW (QUOTE PROCESS)
NIL))
(T (TTY.PROCESS PROC]
(AND [SETQ FN (COND
((LASTMOUSESTATE (ONLY RIGHT))
(fetch RIGHTBUTTONFN of WINDOW))
(T (fetch BUTTONEVENTFN of WINDOW]
(APPLY* FN WINDOW])
(PROCESS.PREPARE.FOR.INPUT
[LAMBDA NIL (* bvm: "23-Jul-84 15:56")
(* * Ensures that current process can take input. Blocks if necesary until it becomes tty process)
(WAIT.FOR.TTY])
(ALLOW.BUTTON.EVENTS
[LAMBDA NIL (* bvm: "24-JUL-83 15:31")
(AND (EQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE))
(SPAWN.MOUSE (THIS.PROCESS])
(SPAWN.MOUSE
[LAMBDA (INTERNAL) (* bvm: " 4-Apr-84 12:08")
(UNINTERRUPTABLY
(PROG ([MOUSEPROC (COND
((AND INTERNAL (EQ (fetch PROCNAME of INTERNAL)
(QUOTE MOUSE)))
INTERNAL)
(T (FIND.PROCESS (QUOTE MOUSE]
NAME)
(COND
(MOUSEPROC [replace PROCNAME of MOUSEPROC
with (COND
((FIND.PROCESS (QUOTE OLDMOUSE))
(OR (for I from 2 to (COND
(INTERNAL PROCESS.MAXMOUSE)
(T MAX.SMALLP))
unless (FIND.PROCESS (SETQ NAME (PACK* (QUOTE OLDMOUSE)
(QUOTE #)
I)))
do (RETURN NAME))
(RETURN)))
(T (QUOTE OLDMOUSE]
(replace PROCSYSTEMP of MOUSEPROC with NIL)
(* Make non systemp in case user wants to kill it)
))
(ADD.PROCESS (LIST (QUOTE \MOUSE.PROCESS))
(QUOTE NAME)
(QUOTE MOUSE)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM))
(RETURN T)))])
(\WAIT.FOR.TTY
[LAMBDA NIL (* bvm: " 5-MAY-83 12:43")
(until (TTY.PROCESSP) do (AWAIT.EVENT \TTY.PROCESS.EVENT])
(WAIT.FOR.TTY
[LAMBDA (MSECS NEEDWINDOW) (* bvm: " 1-Aug-84 00:06")
(* * Ensures that current process can take input. Blocks if necesary until it becomes tty process)
(COND
((EQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE))
(SPAWN.MOUSE (THIS.PROCESS))
(* Background proc cannot take input, because if we block it, then nobody is listening to the mouse.
So spin off a new background process and relegate this one to the tty use)
(* Assume mouse-invoked action wants to have the tty)
[OR (TTY.PROCESSP)
(SETQ \OLDTTY (TTY.PROCESS (THIS.PROCESS]
T)
((TTY.PROCESSP)
T)
[(WINDOWWORLD)
(PROG (WINDOW TIMER)
[COND
(NEEDWINDOW (* Make sure process has a tty window)
(OR [OPENWP (SETQ WINDOW (WFROMDS (PROGN (\GETSTREAM T (QUOTE INPUT))
(TTYDISPLAYSTREAM]
(OPENW WINDOW]
[COND
(MSECS (* Put a time limit on the wait)
(SETQ TIMER (SETUPTIMER MSECS]
(RETURN (do (AWAIT.EVENT \TTY.PROCESS.EVENT TIMER TIMER)
(COND
((TTY.PROCESSP)
(RETURN T))
((AND TIMER (TIMEREXPIRED? TIMER))
(RETURN NIL]
(T (TTY.PROCESS (THIS.PROCESS))
T])
)
(DEFINEQ
(PROCESSPROP
[LAMBDA ARGS (* bvm: " 3-Apr-84 14:39")
(PROG ((P (\COERCE.TO.PROCESS (ARG ARGS 1)))
(PROP (ARG ARGS 2))
NEWVALUE OLDDATA OLDVALUE)
(RETURN (AND P (PROG1 (SELECTQ PROP
(WINDOW (fetch PROCWINDOW of P))
(PRIORITY (fetch PROCPRIORITY of P))
(NAME (fetch PROCNAME of P))
(RESTARTABLE (fetch RESTARTABLE of P))
(FORM (fetch PROCFORM of P))
(INFOHOOK (fetch PROCINFOHOOK of P))
(AFTEREXIT (fetch PROCAFTEREXIT of P))
(BEFOREEXIT (fetch PROCBEFOREEXIT of P))
(TTYENTRYFN (fetch PROCTTYENTRYFN of P))
(TTYEXITFN (fetch PROCTTYEXITFN of P))
(USERDATA (fetch PROCUSERDATA of P))
(RESTARTFORM (fetch PROCRESTARTFORM of P))
(SETQ OLDVALUE (LISTGET (SETQ OLDDATA (fetch PROCUSERDATA
of P))
PROP)))
(COND
((IGREATERP ARGS 2)
(SETQ NEWVALUE (ARG ARGS 3))
(SELECTQ PROP
(WINDOW (PROCESS.WINDOW P NEWVALUE))
(PRIORITY NIL)
(NAME (replace PROCNAME of P with (\UNIQUE.PROCESS.NAME
NEWVALUE))
(\INVALIDATE.PROCESS.WINDOW))
[RESTARTABLE (replace RESTARTABLE of P
with (SELECTQ NEWVALUE
((NIL NO NEVER)
NIL)
((T YES ALWAYS)
T)
(HARDRESET (QUOTE
HARDRESET))
(\ILLEGAL.ARG NEWVALUE]
(FORM)
(INFOHOOK (replace PROCINFOHOOK of P with NEWVALUE))
(AFTEREXIT (replace PROCAFTEREXIT of P with NEWVALUE))
(BEFOREEXIT (replace PROCBEFOREEXIT of P with NEWVALUE))
(TTYENTRYFN (replace PROCTTYENTRYFN of P with NEWVALUE))
(TTYEXITFN (replace PROCTTYEXITFN of P with NEWVALUE))
(USERDATA (replace PROCUSERDATA of P with NEWVALUE))
(RESTARTFORM (replace PROCRESTARTFORM of P with NEWVALUE)
)
(COND
[(NOT NEWVALUE)
(* Delete the old value, if any)
(COND
((EQ (CAR OLDDATA)
PROP)
(replace PROCUSERDATA of P with (CDDR OLDDATA)))
(T (for TAIL on (CDR OLDDATA) by (CDDR TAIL)
when (EQ (CADR TAIL)
PROP)
do (RPLACD TAIL (CDDDR TAIL))
(RETURN]
(OLDDATA (LISTPUT OLDDATA PROP NEWVALUE))
(T (replace PROCUSERDATA of P with (LIST PROP NEWVALUE]
)
(PROCESS.NAME
[LAMBDA (PROC NAME) (* bvm: "16-JUN-82 16:36")
(PROG ((P (\COERCE.TO.PROCESS PROC)))
(RETURN (AND P (PROG1 (fetch PROCNAME of P)
(COND
(NAME (replace PROCNAME of P with (\UNIQUE.PROCESS.NAME NAME])
(PROCESS.WINDOW
[LAMBDA (PROC WINDOW) (* bvm: "16-JUN-82 16:36")
(* Associates WINDOW with PROC, for exec switching)
(PROG ((P (\COERCE.TO.PROCESS PROC)))
(RETURN (COND
(P (PROG1 (fetch PROCWINDOW of P)
(COND
(WINDOW (replace PROCWINDOW of P with (SETQ WINDOW (\INSUREWINDOW
WINDOW)))
(WINDOWPROP WINDOW (QUOTE PROCESS)
P])
)
(PUTPROPS PROCESSPROP ARGNAMES (PROC PROP NEWVALUE))
(PUTPROPS ADD.PROCESS ARGNAMES (NIL (FORM . PROPS&VALUES) . U))
(* Temporary)
(MOVD? (QUOTE PROCESS.RETURN)
(QUOTE KILL.ME))
(DEFINEQ
(DISMISS
[LAMBDA (MSECSWAIT TIMER NOBLOCK) (* lmm "18-Sep-84 13:28")
(PROG (DTIMER)
[SETQ DTIMER (if TIMER
then (\DTEST TIMER (QUOTE FIXP))
elseif MSECSWAIT
then (SETUPTIMER MSECSWAIT (GETRESOURCE \DISMISSTIMER))
else (RETURN (BLOCK]
(if (AND (NOT NOBLOCK)
(THIS.PROCESS))
then (do (\PROCESS.GO.TO.SLEEP NIL DTIMER T) until (TIMEREXPIRED? DTIMER))
else (until (TIMEREXPIRED? DTIMER)))
(OR TIMER (FREERESOURCE \DISMISSTIMER DTIMER)))
MSECSWAIT])
(BLOCK
[LAMBDA (MSECSWAIT TIMER) (* bvm: " 3-Jan-85 12:33")
(* Waits for MSECSWAIT or forever if MSECSWAIT=T. Yields if MSECSWAIT is NIL. TIMER can be given as an alternative
for specifying how long to wait.)
(PROG ((PROC (THIS.PROCESS))
PQUEUE)
(RETURN (COND
[(type? PROCESS PROC)
(COND
((AND (NULL MSECSWAIT)
(NULL TIMER)) (* Only yielding, not going to sleep)
(UNINTERRUPTABLY
(SETQ PQUEUE (fetch PROCQUEUE of PROC))
(COND
((NEQ PROC (fetch PQNEXT of PQUEUE))
(\MP.ERROR \MP.PROCERROR "Current process is not its queue's NEXT"
PROC)))
(replace WAKEREASON of PROC with T)
(replace PQNEXT of PQUEUE with (fetch NEXTPROCHANDLE of PROC))
(replace PQLAST of PQUEUE with PROC)
(\RESCHEDULE PROC)))
(T (\PROCESS.GO.TO.SLEEP NIL (COND
(TIMER (\DTEST TIMER (QUOTE FIXP)))
(T (FIXP MSECSWAIT)))
(NEQ TIMER NIL]
((FIXP MSECSWAIT) (* Not scheduling; act like DISMISS)
(DISMISS MSECSWAIT T)
NIL)
(T (AND TOPW (WINDOW.MOUSE.HANDLER))
(for FN in BACKGROUNDFNS do (SPREADAPPLY* FN))
NIL])
(WAITFORINPUT
[LAMBDA (N) (* bvm: "17-Dec-83 22:21")
(COND
[(FIXP N)
(GLOBALRESOURCE (\DISMISSBOX)
(PROG ((NOW (\CLOCK0 \DISMISSBOX))
(N-100 (IDIFFERENCE N 100))
ELAPSED)
LP (COND
((READP T)
(RETURN T))
((NOT (\CLOCKGREATERP NOW N-100))
(* only run background task if at least 100 msecs left)
(\TTYBACKGROUND))
((\CLOCKGREATERP NOW N) (* Time's up, return with no input)
(RETURN)))
(GO LP]
(N (* Getting OFD avoids time wasted in directory search,
leaves more time for \TTYBACKGROUND)
(bind (OFD ←(\GETOFD N (QUOTE INPUT))) until (OR (READP T)
(READP OFD))
do (\TTYBACKGROUND)))
(T (until (READP T) do (\TTYBACKGROUND])
(\WAITFORSYSBUFP
[LAMBDA (N) (* bvm: "17-Dec-83 22:32")
(COND
[(FIXP N)
(GLOBALRESOURCE (\DISMISSBOX)
(PROG ((NOW (\CLOCK0 \DISMISSBOX)))
LP (COND
((\SYSBUFP)
(RETURN T))
((NOT (TTY.PROCESSP))
(\WAIT.FOR.TTY))
((\CLOCKGREATERP NOW N) (* Time's up, return with no input)
(RETURN))
(T (BLOCK)))
(GO LP]
(T (until (\SYSBUFP)
do (BLOCK)
(\WAIT.FOR.TTY])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTDEF (QUOTE \DISMISSBOX)
(QUOTE RESOURCES)
(QUOTE (NEW (SETUPTIMER 0]
[PUTDEF (QUOTE \DISMISSTIMER)
(QUOTE RESOURCES)
(QUOTE (NEW (SETUPTIMER 0]
[PUTDEF (QUOTE \DISMISSTIMER-100)
(QUOTE RESOURCES)
(QUOTE (NEW (SETUPTIMER 0]
)
)
(/SETTOPVAL (QUOTE \\DISMISSBOX.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\DISMISSTIMER.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\DISMISSTIMER-100.GLOBALRESOURCE))
(DEFINEQ
(EVAL.AS.PROCESS
[LAMBDA (FORM) (* bvm: "20-MAY-83 12:00")
(COND
((THIS.PROCESS)
(ADD.PROCESS FORM (QUOTE RESTARTABLE)
(QUOTE NO)))
(T (\EVAL FORM])
(EVAL.IN.TTY.PROCESS
[LAMBDA (FORM WAITFORRESULT) (* bvm: " 5-MAY-83 18:14")
(COND
((TTY.PROCESSP)
(\EVAL FORM))
(T (PROCESS.EVAL (TTY.PROCESS)
FORM WAITFORRESULT])
)
(* The PROCESS.WAIT macro is an augmentation to BLOCK, waiting for a condition to come true, or
a timeout, or a wakeup)
(DECLARE: EVAL@COMPILE
(PUTPROPS PROCESS.WAIT MACRO [(WAITCOND TIMEOUT)
(bind ($$TIMEOUT ←(AND TIMEOUT (SETUPTIMER TIMEOUT)))
until (AND $$TIMEOUT (TIMEREXPIRED? $$TIMEOUT))
do (if (SETQ $$VAL WAITCOND)
then (RETURN $$VAL)
else (BLOCK])
)
(DEFINEQ
(PROCESS.READ
[LAMBDA (WINDOW PROMPT CLEAR?) (* bvm: " 5-MAY-83 12:54")
(* Special case of PREEMPT.KEYBOARD)
(PROG ((OLDTTY (TTY.PROCESS))
OLDW)
(RETURN (PROG1 (NLSETQ (PROGN (TTY.PROCESS (THIS.PROCESS))
[COND
(WINDOW (SETQ OLDW (TTYDISPLAYSTREAM WINDOW))
(COND
(CLEAR? (CLEARW WINDOW]
(COND
(PROMPT (PRIN1 PROMPT T)))
(READ T T)))
(TTY.PROCESS OLDTTY)
(AND OLDW (TTYDISPLAYSTREAM OLDW])
(PROCESS.EVALV
[LAMBDA (PROC VAR) (* bvm: " 4-MAY-83 12:37")
(PROG ((P (\COERCE.TO.PROCESS PROC T)))
(RETURN (COND
((OR (NULL (\DTEST VAR (QUOTE LITATOM)))
(EQ VAR T))
VAR)
(T [OR (EQ P (THIS.PROCESS))
(\SMASHLINK NIL (fetch (STACKP EDFXP) of (\DTEST (fetch MYSTACK
of P)
(QUOTE STACKP]
(\GETBASEPTR (\STKSCAN VAR)
0])
(PROCESS.EVAL
[LAMBDA (PROC FORM WAITFORRESULT) (* bvm: " 3-Apr-84 15:56")
(DECLARE (LOCALVARS . T))
(PROG ((P (\COERCE.TO.PROCESS PROC T))
(ME (THIS.PROCESS)))
[COND
((EQ P ME)
(RETURN (\EVAL FORM]
(COND
(WAITFORRESULT (replace PROCEVAPPLYRESULT of ME with \PSTAT.NORESULT)))
(\PROCESS.MAKEFRAME P (QUOTE \PROCESS.EVAL1)
(LIST FORM ME WAITFORRESULT)
T)
(RETURN (COND
(WAITFORRESULT (do (\PROCESS.GO.TO.SLEEP) until (NEQ (fetch PROCEVAPPLYRESULT
of ME)
\PSTAT.NORESULT))
(PROG1 (fetch PROCEVAPPLYRESULT of ME)
(replace PROCEVAPPLYRESULT of ME with \PSTAT.NORESULT])
(\PROCESS.EVAL1
[LAMBDA (FORM PROC WAITFORRESULT)
(DECLARE (LOCALVARS . T)) (* bvm: " 6-MAY-83 16:39")
(replace PROCEVAPPLYRESULT of PROC with (\EVAL FORM))
(COND
((NOT WAITFORRESULT)
(replace PROCEVAPPLYRESULT of PROC with \PSTAT.NORESULT))
((NEQ (fetch PROCSTATUS of PROC)
\PSTAT.RUNNING)
(\RUN.PROCESS PROC])
(PROCESS.APPLY
[LAMBDA (PROC FN ARGS WAITFORRESULT) (* bvm: " 3-Apr-84 15:57")
(DECLARE (LOCALVARS . T))
(PROG ((P (\COERCE.TO.PROCESS PROC T))
(ME (THIS.PROCESS)))
[COND
((EQ P ME)
(RETURN (APPLY FN ARGS]
(COND
(WAITFORRESULT (replace PROCEVAPPLYRESULT of ME with \PSTAT.NORESULT)))
(\PROCESS.MAKEFRAME P (QUOTE \PROCESS.APPLY1)
(LIST FN ARGS ME WAITFORRESULT)
T)
(RETURN (COND
(WAITFORRESULT (do (\PROCESS.GO.TO.SLEEP) until (NEQ (fetch PROCEVAPPLYRESULT
of ME)
\PSTAT.NORESULT))
(PROG1 (fetch PROCEVAPPLYRESULT of ME)
(replace PROCEVAPPLYRESULT of ME with \PSTAT.NORESULT])
(\PROCESS.APPLY1
[LAMBDA (FN ARGS PROC WAITFORRESULT)
(DECLARE (LOCALVARS . T)) (* bvm: " 6-MAY-83 16:39")
(replace PROCEVAPPLYRESULT of PROC with (APPLY FN ARGS))
(COND
((NOT WAITFORRESULT)
(replace PROCEVAPPLYRESULT of PROC with \PSTAT.NORESULT))
((NEQ (fetch PROCSTATUS of PROC)
\PSTAT.RUNNING)
(\RUN.PROCESS PROC])
)
(* Standard values for WAKEREASON -- PSTAT.TIMEDOUT is the only public one)
(RPAQ PSTAT.WAKEUP "default WakeUp")
(RPAQ PSTAT.TIMEDOUT "{time interval expired}")
(RPAQ PSTAT.QUIT "Quit")
(RPAQ \PSTAT.NORESULT "{no result yet}")
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PSTAT.WAKEUP PSTAT.TIMEDOUT PSTAT.QUIT \PSTAT.NORESULT)
)
(* Event stuff)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE EVENT ((EVENTWAKEUPPENDING FLAG) (* True if this event was signaled with nobody waiting
on it)
(NIL BITS 7)
(EVENTQUEUETAIL POINTER) (* Pointer to last process waiting on this event)
(EVENTNAME POINTER) (* Optional name of EVENT for status window, debugging,
etc)
)
(ACCESSFNS EVENT ((EVLOCKQUEUETAIL (ffetch EVENTQUEUETAIL of DATUM)
(freplace EVENTQUEUETAIL of DATUM with NEWVALUE)))
(* Used by both EVENT and MONITORLOCK data)
))
]
(/DECLAREDATATYPE (QUOTE EVENT)
(QUOTE (FLAG (BITS 7)
POINTER POINTER)))
)
(/DECLAREDATATYPE (QUOTE EVENT)
(QUOTE (FLAG (BITS 7)
POINTER POINTER)))
[ADDTOVAR SYSTEMRECLST
(DATATYPE EVENT ((EVENTWAKEUPPENDING FLAG)
(NIL BITS 7)
(EVENTQUEUETAIL POINTER)
(EVENTNAME POINTER)))
]
(DEFINEQ
(CREATE.EVENT
[LAMBDA (NAME) (* bvm: " 5-MAY-83 11:00")
(create EVENT
EVENTNAME ← NAME])
(NOTIFY.EVENT
[LAMBDA (EVENT ONCEONLY) (* bvm: " 3-Jan-85 12:10")
(* Wake up any process waiting for EVENT, or only the
first one if ONCEONLY is true)
(SETQ EVENT (\DTEST EVENT (QUOTE EVENT)))
(PROG (PROC SUCCESS TAIL)
LP (UNINTERRUPTABLY
(COND
((SETQ TAIL (ffetch EVENTQUEUETAIL of EVENT))
(SETQ PROC (fetch PROCEVENTLINK of TAIL))
[COND
((EQ PROC TAIL)
(freplace EVENTQUEUETAIL of EVENT with (SETQ TAIL NIL)))
(T (replace PROCEVENTLINK of TAIL with (fetch PROCEVENTLINK of PROC]
(replace PROCEVENTLINK of PROC with (replace PROCEVENTORLOCK of PROC with NIL))
(\RUN.PROCESS PROC EVENT)
(SETQ SUCCESS T))
((NOT SUCCESS)
(* Indicate that a wakeup was signaled, even though nobody was waiting. Handles most cases where the wakeup would
otherwise be lost by occurring between a process's testing a condition and waiting on the event)
(freplace EVENTWAKEUPPENDING of EVENT with T))))
(COND
((AND TAIL (NOT ONCEONLY))
(GO LP])
(AWAIT.EVENT
[LAMBDA (EVENT TIMEOUT TIMERP) (* bvm: "29-APR-83 17:55")
(\PROCESS.GO.TO.SLEEP (\DTEST EVENT (QUOTE EVENT))
TIMEOUT TIMERP])
(\UNQUEUE.EVENT
[LAMBDA (PROC EVENT) (* bvm: " 3-Jan-85 12:34")
(* Remove PROC from EVENT's queue. EVENT is an EVENT or MONITORLOCK. Their queues consist of a pointer to the last
item in the queue, which in turn points to the first item)
(PROG ((TAIL (ffetch EVLOCKQUEUETAIL of EVENT))
NEXT)
[COND
((NOT TAIL)
(\MP.ERROR \MP.PROCERROR "Process not on its EVENT/MONITOR queue" PROC))
(T (while (NEQ PROC (SETQ NEXT (ffetch PROCEVENTLINK of TAIL))) do (SETQ TAIL NEXT))
(COND
((EQ PROC TAIL)
(freplace EVLOCKQUEUETAIL of EVENT with NIL))
(T (replace PROCEVENTLINK of TAIL with (fetch PROCEVENTLINK of PROC))
(COND
((EQ PROC (fetch EVLOCKQUEUETAIL of EVENT))
(freplace EVLOCKQUEUETAIL of EVENT with (fetch PROCEVENTLINK of PROC]
(replace PROCEVENTORLOCK of PROC with NIL)
(replace PROCEVENTLINK of PROC with NIL])
(\ENQUEUE.EVENT/LOCK
[LAMBDA (PROC EVLOCK) (* bvm: " 3-Jan-85 12:15")
(* * Enqueue process PROC on EVLOCK's waiting queue. EVLOCK is either an EVENT or a MONITORLOCK)
(PROG (TAIL)
(replace PROCEVENTORLOCK of PROC with EVLOCK)
(* Put PROC at end of event or monitorlock's queue. Queue tail is pointed to by a common field in EVENT and
MONITORLOCK. The tail itself points at the first item in the queue)
(freplace PROCEVENTLINK of PROC with (COND
((SETQ TAIL (ffetch EVLOCKQUEUETAIL of EVLOCK))
(PROG1 (fetch PROCEVENTLINK of TAIL)
(freplace PROCEVENTLINK of TAIL
with PROC)))
(T PROC)))
(freplace EVLOCKQUEUETAIL of EVLOCK with PROC])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS AWAIT.CONDITION MACRO [(CONDITION EVNT TIMEOUT TIMERP)
(PROG [($$TIMER TIMEOUT)
($$EV (\DTEST EVNT (QUOTE EVENT]
(DECLARE (LOCALVARS $$TIMER $$EV))
LP (RETURN (OR CONDITION (COND
((NEQ (\PROCESS.GO.TO.SLEEP $$EV $$TIMER TIMERP)
$$EV)
NIL)
(T (AND $$TIMER (SETQ $$TIMER T))
(GO LP])
)
(RPAQ? \TTY.PROCESS.EVENT )
(RPAQ? \PROCESS.AFTEREXIT.EVENT )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TTY.PROCESS.EVENT \PROCESS.AFTEREXIT.EVENT)
)
(* Monitor stuff)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE MONITORLOCK ((NIL FLAG)
(MLOCKPERPROCESS FLAG) (* Monitor's use by anybody in process lets everyone in
that proc use it, the normal case)
(NIL BITS 6)
(MLOCKQUEUETAIL POINTER) (* Last process waiting for monitor to become
available)
(MLOCKOWNER POINTER) (* Process owning it)
(MLOCKNAME POINTER) (* optional name, for debugging, etc)
(MLOCKLINK POINTER) (* Link to next lock owned by my owner)
))
]
(/DECLAREDATATYPE (QUOTE MONITORLOCK)
(QUOTE (FLAG FLAG (BITS 6)
POINTER POINTER POINTER POINTER)))
)
(/DECLAREDATATYPE (QUOTE MONITORLOCK)
(QUOTE (FLAG FLAG (BITS 6)
POINTER POINTER POINTER POINTER)))
[ADDTOVAR SYSTEMRECLST
(DATATYPE MONITORLOCK ((NIL FLAG)
(MLOCKPERPROCESS FLAG)
(NIL BITS 6)
(MLOCKQUEUETAIL POINTER)
(MLOCKOWNER POINTER)
(MLOCKNAME POINTER)
(MLOCKLINK POINTER)))
]
(DEFINEQ
(OBTAIN.MONITORLOCK
[LAMBDA (LOCK DONTWAIT UNWINDSAVE) (* bvm: "11-AUG-83 11:59")
(* Attempts to acquire lock. If lock is busy, waits until it is available, unless DONTWAIT is true, in which case
it returns NIL immediately. Returns LOCK if it grabbed the lock, T if the current process already had the lock.
If UNWINDSAVE is true, does the appropriate RESETSAVE to release the lock on exit of the surrounding RESETLST)
(SETQ LOCK (\DTEST LOCK (QUOTE MONITORLOCK)))
(PROG ((PROC (THIS.PROCESS))
(WASINTERRUPTABLE \INTERRUPTABLE)
(\INTERRUPTABLE))
LP (RETURN (COND
((NULL (fetch MLOCKOWNER of LOCK)) (* Lock is idle)
[COND
(UNWINDSAVE (RESETSAVE (PROGN LOCK)
(QUOTE (RELEASE.MONITORLOCK OLDVALUE]
(replace MLOCKOWNER of LOCK with PROC)
(replace MLOCKLINK of LOCK with (fetch PROCOWNEDLOCKS of PROC))
(* Link lock into list of those owned by this process)
(replace PROCOWNEDLOCKS of PROC with LOCK)
LOCK)
[(EQ (fetch MLOCKOWNER of LOCK)
PROC) (* My process already owns it)
(COND
((fetch MLOCKPERPROCESS of LOCK)
T)
(T (ERROR "Trying to acquire lock exclusively owned already by this process"
LOCK]
((NOT DONTWAIT)
(PROG ((\INTERRUPTABLE WASINTERRUPTABLE))
(\PROCESS.GO.TO.SLEEP LOCK))
(GO LP])
(CREATE.MONITORLOCK
[LAMBDA (NAME EXCLUSIVE) (* bvm: "17-MAY-83 17:58")
(create MONITORLOCK
MLOCKPERPROCESS ←(NOT EXCLUSIVE)
MLOCKNAME ← NAME])
(RELEASE.MONITORLOCK
[LAMBDA (LOCK EVENIFNOTMINE) (* bvm: " 3-Jan-85 12:34")
(COND
((EQ LOCK (QUOTE OLDVALUE)) (* Hack for RESETSAVE)
(SETQ LOCK OLDVALUE)))
(SETQ LOCK (\DTEST LOCK (QUOTE MONITORLOCK)))
(UNINTERRUPTABLY
[PROG ((OWNER (ffetch MLOCKOWNER of LOCK))
(ME (THIS.PROCESS))
TAIL PREV NEXTPROC)
(COND
((OR (NULL OWNER)
(AND (NEQ OWNER ME)
(NOT EVENIFNOTMINE)))
(RETURN)))
(freplace MLOCKOWNER of LOCK with NIL) (* Now remove LOCK from my list of owned locks)
[COND
((EQ (SETQ PREV (fetch PROCOWNEDLOCKS of OWNER))
LOCK)
(replace PROCOWNEDLOCKS of OWNER with (ffetch MLOCKLINK of LOCK)))
(T (do (COND
((NULL PREV)
(RETURN (\MP.ERROR \MP.PROCERROR
"Lock not found among owner's owned locks"
LOCK)))
[(EQ (fetch MLOCKLINK of PREV)
LOCK)
(RETURN (replace MLOCKLINK of PREV with (ffetch MLOCKLINK of LOCK]
(T (SETQ PREV (fetch MLOCKLINK of PREV]
(freplace MLOCKLINK of LOCK with NIL)
(COND
((SETQ TAIL (ffetch MLOCKQUEUETAIL of LOCK))
(SETQ NEXTPROC (fetch PROCEVENTLINK of TAIL))
[COND
((EQ NEXTPROC TAIL) (* Only one process in queue)
(freplace MLOCKQUEUETAIL of LOCK with NIL))
(T (replace PROCEVENTLINK of TAIL with (fetch PROCEVENTLINK of NEXTPROC]
(replace PROCEVENTLINK of NEXTPROC with (replace PROCEVENTORLOCK of NEXTPROC
with NIL))
(\RUN.PROCESS NEXTPROC LOCK])])
(MONITOR.AWAIT.EVENT
[LAMBDA (RELEASELOCK EVENT TIMEOUT TIMERP) (* bvm: " 8-MAY-83 16:02")
(RELEASE.MONITORLOCK RELEASELOCK)
(PROG1 (\PROCESS.GO.TO.SLEEP (\DTEST EVENT (QUOTE EVENT))
TIMEOUT TIMERP)
(OBTAIN.MONITORLOCK RELEASELOCK])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS WITH.MONITOR MACRO ((LOCK . FORMS)
(RESETLST (OBTAIN.MONITORLOCK LOCK NIL T)
(PROGN . FORMS))))
(PUTPROPS WITH.FAST.MONITOR MACRO [(LOCK . FORMS)
(UNINTERRUPTABLY
([LAMBDA (UNLOCK)
(PROG1 (PROGN . FORMS)
(AND (NEQ UNLOCK T)
(RELEASE.MONITORLOCK UNLOCK]
(OBTAIN.MONITORLOCK LOCK)))])
)
(DEFINEQ
(\MAKE.PROCESS0
[LAMBDA (FORM HANDLE) (* bvm: " 5-Feb-85 13:06")
(DECLARE (LOCALVARS . T)
(SPECVARS #MYHANDLE# #FORM# HELPFLAG \CURRENTDISPLAYLINE \#DISPLAYLINES \LINEBUF.OFD
\PRIMIN.OFD \PRIMREADTABLE \PRIMTERMTABLE \PRIMTERMSA TtyDisplayStream
\TERM.OFD \TTYWINDOW \PRIMOUT.OFD \DRIBBLE.OFD \INTERRUPTABLE)
(GLOBALVARS \DEFAULTLINEBUF \DEFAULTTTYDISPLAYSTREAM))
(PROG ((#MYHANDLE# HANDLE)
(#FORM# FORM)
(HELPFLAG (AND HELPFLAG (QUOTE BREAK!)))
(\CURRENTDISPLAYLINE 0)
(\#DISPLAYLINES 40)
(\LINEBUF.OFD (OR \DEFAULTLINEBUF \LINEBUF.OFD))
(\PRIMREADTABLE \PRIMREADTABLE)
(\PRIMTERMTABLE \PRIMTERMTABLE)
(\PRIMTERMSA \PRIMTERMSA)
(TtyDisplayStream \DEFAULTTTYDISPLAYSTREAM)
\INTERRUPTABLE \TERM.OFD \TTYWINDOW \PRIMOUT.OFD \PRIMIN.OFD RESULT)
(* HELPFLAG set to ensure breaks occur.
Proc can rebind if desired)
(* \TTYWINDOW is currently just a place to hold onto the WINDOW of the TtyDisplayStream in case user closes same and
then someone prints to TtyDisplayStream)
(\MISCAPPLY* (FUNCTION \PROCESS.MOVEFRAME)) (* Move me to the boonies)
[SETQ \TERM.OFD (SETQ \PRIMOUT.OFD (COND
(TtyDisplayStream (\GETOFD TtyDisplayStream (QUOTE OUTPUT)))
(T (* For init time, before LLDISPLAY sets up)
(GETTOPVAL (QUOTE \TERM.OFD]
(SETQ \PRIMIN.OFD \LINEBUF.OFD)
(\SETFVARSLOT (QUOTE RESETVARSLST)
(LOCF (fetch PROCRESETVARSLST of #MYHANDLE#)))
(* Make this proc use a piece of its PROCESS handle as the binding place for RESETVARSLST. This lets its survive a
HARDRESET and also makes it easier for DEL.PROCESS to get at)
(\SETFVARSLOT (QUOTE \DRIBBLE.OFD)
(LOCF (fetch PROCDRIBBLEOFD of #MYHANDLE#)))
(RESUME (OR (fetch MYSTACK of #MYHANDLE#)
(replace MYSTACK of #MYHANDLE# with (STKNTH 0 T)))
(PROG1 (STKNTH -1 (QUOTE \MAKE.PROCESS0))
(PROG ((TOP (\STACKARGPTR T)))
(\SMASHLINK NIL TOP TOP)) (* Detach us from stack)
(SETQ NOCLEARSTKLST (CONS (fetch MYSTACK of #MYHANDLE#)
NOCLEARSTKLST)))
#MYHANDLE#)
(SETQ \INTERRUPTABLE T) (* Safe to go interruptable now)
LP [COND
((OR RESETVARSLST \DRIBBLE.OFD (fetch PROCOWNEDLOCKS of #MYHANDLE#))
(* Unwind anything left from last invocation)
(\PROCESS.UNWINDALL (QUOTE HARDRESET]
[COND
((fetch PROCFINISHED of #MYHANDLE#) (* Happens after a HARDRESET -- proc was restarted only
long enough to clean up after itself)
)
([LISTP (SETQ RESULT (ERSETQ (\EVAL #FORM#] (* #FORM# returned without killing itself;
let scheduler kill it)
(replace PROCRESULT of #MYHANDLE# with (CAR RESULT))
(replace PROCFINISHED of #MYHANDLE# with (QUOTE NORMAL)))
(T (SETQ #FORM# (OR (fetch PROCRESTARTFORM of #MYHANDLE#)
#FORM#)) (* If we're going to restart, use form given)
(COND
((EQ RESULT \PROC.RESTARTME) (* Explicit restart)
(GO LP))
((EQ (fetch RESTARTABLE of #MYHANDLE#)
T) (* Autorestart on errors)
(GO LP))
(T (* Error occurred in #FORM#)
(printout PROMPTWINDOW (fetch PROCNAME of #MYHANDLE#)
" aborted." T)
(replace PROCFINISHED of #MYHANDLE# with (QUOTE ERROR]
[COND
((OR RESETVARSLST \DRIBBLE.OFD (fetch PROCOWNEDLOCKS of #MYHANDLE#))
(* Unwind anything left from "top-level" RESETSAVE's)
(\PROCESS.UNWINDALL (COND
((NULL RESULT)
(QUOTE ERROR))
((EQ RESULT \PROC.RESETME)
(* From RESET)
(QUOTE RESET]
(\FLUSH.PROCESS (THIS.PROCESS])
(\PROCESS.MOVEFRAME
[LAMBDA NIL (* bvm: "17-JAN-83 17:26")
(* Called in misc context to move a frame to a big free
area)
(FLIPCURSORBAR 12)
(PROG ((OLDFRAME (fetch MiscFXP of \InterfacePage))
NXT NEW FRAMESIZE BFSIZE RESIDUAL FREESIZE FXSIZE BLINK INITSIZE)
(SETQ BLINK (fetch (FX DUMMYBF) of OLDFRAME))
[SETQ FRAMESIZE (IPLUS (SETQ FXSIZE (fetch (FX SIZE) of OLDFRAME))
(SETQ BFSIZE (COND
((OR (fetch (BF RESIDUAL) of BLINK)
(SETQ RESIDUAL (NEQ (fetch (BF USECNT) of BLINK)
0)))
WORDSPERCELL)
(T (fetch (BF SIZE) of BLINK]
(SETQ NEW (\FREESTACKBLOCK (SETQ FREESIZE (IPLUS FRAMESIZE PROC.FREESPACESIZE))
OLDFRAME)) (* Find a free stack block)
[COND
((type? FSB (SETQ NXT (IPLUS NEW FREESIZE))) (* \FREESTACKBLOCK normally sticks a free block after
the block it returns. We will massage them together)
(add FREESIZE (fetch (FSB SIZE) of NXT]
(SETQ INITSIZE (FLOOR (LRSH (IDIFFERENCE FREESIZE FRAMESIZE)
1)
WORDSPERCELL)) (* Size of free block to go before)
(COND
((EVENP (IPLUS NEW INITSIZE BFSIZE)
WORDSPERQUAD) (* FX must be odd-quad aligned)
(add INITSIZE WORDSPERCELL)))
(\MAKEFREEBLOCK NEW INITSIZE)
(add NEW INITSIZE)
(SETQ FREESIZE (IDIFFERENCE FREESIZE INITSIZE))
(\BLT (ADDSTACKBASE NEW)
(ADDSTACKBASE (IDIFFERENCE OLDFRAME BFSIZE))
FRAMESIZE) (* Copy FX and BF into middle of new free area)
(COND
(RESIDUAL (replace (BF RESIDUAL) of NEW with T))
((NOT (fetch (BF RESIDUAL) of BLINK)) (* Point new BF at itself)
(replace (BF IVAR) of (IPLUS NEW (IDIFFERENCE BFSIZE WORDSPERCELL)) with NEW)))
(add NEW BFSIZE) (* now NEW points to the FX)
(replace (FX NEXTBLOCK) of NEW with (SETQ NXT (IPLUS NEW FXSIZE)))
(replace (FX FASTP) of NEW with NIL)
[replace (FX #BLINK) of NEW with (COND
(RESIDUAL (* Point at real bf)
(fetch (FX BLINK) of OLDFRAME))
(T (IDIFFERENCE NEW WORDSPERCELL]
[COND
((AND (fetch (FX VALIDNAMETABLE) of NEW)
(EQ (fetch (FX NAMETABHI) of NEW)
\STACKHI))
(CHECK ([LAMBDA (N)
(AND (IGREATERP N OLDFRAME)
(ILESSP N (fetch (FX NEXTBLOCK) of OLDFRAME]
(fetch (FX NAMETABLO) of OLDFRAME)))
(add (fetch (FX NAMETABLO) of NEW)
(IDIFFERENCE NEW OLDFRAME]
(\MAKEFREEBLOCK NXT (IDIFFERENCE FREESIZE FRAMESIZE))
(* Install free block after frame)
(COND
(RESIDUAL (\MAKEFREEBLOCK OLDFRAME (IDIFFERENCE FRAMESIZE WORDSPERCELL)))
(T (\MAKEFREEBLOCK (IDIFFERENCE OLDFRAME BFSIZE)
FRAMESIZE))) (* Finally free up the original frame)
OUT (replace MiscFXP of \InterfacePage with NEW)
(FLIPCURSORBAR 12) (* Restore cursor)
(RETURN NEW])
(\RELEASE.PROCESS
[LAMBDA (PROC KILLIT RESTARTFLG) (* bvm: "21-Jun-84 12:31")
(PROG ((EVENT (fetch PROCEVENTORLOCK of PROC))
(STKP (fetch MYSTACK of PROC))
WINDOW)
[COND
(STKP (RELSTK STKP)
(SETQ NOCLEARSTKLST (DREMOVE STKP NOCLEARSTKLST]
(COND
(EVENT (\UNQUEUE.EVENT PROC EVENT)))
(COND
((fetch PROCTIMERSET of PROC)
(\UNQUEUE.TIMER PROC T)))
(COND
[KILLIT (OR RESTARTFLG (SETQ \PROCESSES (DREMOVE PROC \PROCESSES)))
(\INVALIDATE.PROCESS.WINDOW)
(replace PROCDELETED of PROC with T)
(replace PROCSTATUS of PROC with \PSTAT.DELETED)
[replace PROCFORM of PROC with (replace PROCRESTARTFORM of PROC
with (replace PROCQUEUE of PROC
with (replace MYSTACK of PROC
with NIL]
(COND
((SETQ WINDOW (fetch PROCWINDOW of PROC))
(* Break link to proc's window)
(replace PROCWINDOW of PROC with NIL)
(WINDOWPROP WINDOW (QUOTE PROCESS)
NIL]
(T (replace PROCSTATUS of PROC with \PSTAT.WAITING)
(replace PROCTIMERSET of PROC with NIL)))
(replace NEXTPROCHANDLE of PROC with NIL])
(\MAYBEBLOCK
[LAMBDA NIL (* bvm: "21-JUN-83 16:01")
(COND
(\INTERRUPTABLE (BLOCK])
(\BACKGROUND.PROCESS
[LAMBDA NIL (* bvm: "24-JUL-83 15:35")
(PROG NIL
LP (for FN in BACKGROUNDFNS do (SPREADAPPLY* FN))
(BLOCK)
(GO LP])
(\MOUSE.PROCESS
[LAMBDA NIL (* bvm: " 4-Jan-85 12:35")
(DECLARE (SPECVARS \OLDTTY \MOUSEBUSY))
(PROG (\OLDTTY \MOUSEBUSY OTHERMOUSE)
LP [COND
((NEQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE)) (* A new mouse process sprung up while we were hung)
(COND
((AND (SETQ OTHERMOUSE (FIND.PROCESS (QUOTE MOUSE)))
(PROCESS.EVALV OTHERMOUSE (QUOTE \MOUSEBUSY)))
(* The other mouse is still busy, so we can't kill it.
Die instead)
(PROCESS.RETURN))
(T (COND
(OTHERMOUSE (* Kill off the mouse process that took our place)
(DEL.PROCESS OTHERMOUSE)
(SETQ OTHERMOUSE) (* Don't inadvertantly hold a pointer to this dead
process)
))
(replace PROCSYSTEMP of (THIS.PROCESS) with T)
(replace PROCNAME of (THIS.PROCESS) with (QUOTE MOUSE]
(WINDOW.MOUSE.HANDLER)
(COND
((TTY.PROCESSP) (* Give up the tty if we still have it)
(TTY.PROCESS (COND
((NEQ \OLDTTY (THIS.PROCESS))
\OLDTTY)
(T T)))
(SETQ \OLDTTY)))
(replace PROCTYPEAHEAD of (THIS.PROCESS) with NIL)
(* No sense keeping around this typeahead)
(BLOCK)
(GO LP])
(\TIMER.PROCESS
[LAMBDA NIL (* bvm: " 1-AUG-83 15:17")
(* This process runs at default priority and tests for
processes that have timed out)
(PROG ((\INTERRUPTABLE NIL)
(HEAD \TIMERQHEAD)
PROC)
LP (COND
((AND (SETQ PROC (fetch PROCTIMERLINK of HEAD))
(TIMEREXPIRED? (fetch PROCWAKEUPTIMER of PROC)))
(\RUN.PROCESS PROC PSTAT.TIMEDOUT))
(T (BLOCK)))
(GO LP])
(\PROC.RESETRESTORE
[LAMBDA (PROC) (* bvm: "10-OCT-83 17:28")
(\SETFVARSLOT (QUOTE RESETVARSLST)
(LOCF (fetch PROCRESETVARSLST of PROC))) (* Make it use the actual binding of PROC's
RESETVARSLST, so that it is eaten up properly as things
are unwound)
(ERSETQ (RESETRESTORE NIL (QUOTE RESET)))
(while (fetch PROCOWNEDLOCKS of PROC) do (RELEASE.MONITORLOCK (fetch PROCOWNEDLOCKS of PROC)
T))
(COND
((fetch PROCDRIBBLEOFD of PROC)
(\SETFVARSLOT (QUOTE \DRIBBLE.OFD)
(LOCF (fetch PROCDRIBBLEOFD of PROC)))
(DRIBBLE))) (* Return this to make \SETFVARSLOT work)
(OR RESETVARSLST \DRIBBLE.OFD])
(\PROCESS.UNWINDALL
[LAMBDA (STATE) (* bvm: "31-JUL-83 16:43")
(* Called when the current process is being killed or restarted, to unwind any RESETxxx expressions and release
any locks. STATE is the value of RESETSTATE for the unwind)
(PROG ((ME (THIS.PROCESS)))
[repeatwhile (AND (fetch PROCRESETVARSLST of ME)
(NULL (NLSETQ (RESETRESTORE NIL STATE]
(while (fetch PROCOWNEDLOCKS of ME) do (RELEASE.MONITORLOCK (fetch PROCOWNEDLOCKS
of ME)))
(COND
((AND \DRIBBLE.OFD (NEQ STATE (QUOTE HARDRESET)))
(* Close any Dribble file. But don't close dribble file
if we are merely restarting after a reset)
(DRIBBLE])
(\UNIQUE.PROCESS.NAME
[LAMBDA (NAME) (* bvm: " 1-Aug-84 00:18")
(* * Coerces NAME to one not in use by any active process)
(PROG NIL
RETRY
(SELECTQ (TYPENAME NAME)
(LITATOM)
[STRINGP (COND
((ILESSP (NCHARS NAME)
128)
(SETQ NAME (MKATOM NAME]
(LISTP (SETQ NAME (CAR NAME))
(GO RETRY))
(RETURN NAME))
[COND
((OR (NULL NAME)
(EQ NAME T))
(SETQ NAME (ERROR "Illegal Process Name" NAME))
(GO RETRY))
((FIND.PROCESS NAME)
(for I from 2 bind (FIRSTNAME ← NAME) while (FIND.PROCESS (SETQ NAME
(PACK* FIRSTNAME
(QUOTE #)
I]
(RETURN NAME])
)
(DEFINEQ
(\START.PROCESSES
[LAMBDA NIL (* bvm: " 2-MAY-83 12:30")
(UNINTERRUPTABLY
(\RESCHEDULE #SCHEDULER#))])
(\PROCESS.GO.TO.SLEEP
[LAMBDA (EVLOCK TIMEOUT TIMERP DELETEFLG) (* bvm: " 3-Jan-85 12:34")
(* puts the current process to sleep. EVLOCK is a lock or event to wait on, or NIL for neither.
TIMEOUT is optional timeout to wake up if we haven't been woken any other way; monitor locks do not get timeouts.
TIMERP=T means TIMEOUT is an absolute timer rather than an interval. TIMEOUT=T means continue using the timer from
the last time we went to sleep. DELETEFLG means never to return.)
(UNINTERRUPTABLY
[PROG ((PROC (THIS.PROCESS))
HEAD TAIL PREV)
(OR PROC (RETURN (BLOCK)))
(COND
((AND (type? EVENT EVLOCK)
(fetch EVENTWAKEUPPENDING of EVLOCK))
(* Missed a wakeup for this event, take it now)
(replace EVENTWAKEUPPENDING of EVLOCK with NIL)
(RETURN EVLOCK)))
(replace PROCSTATUS of PROC with \PSTAT.WAITING)
(SETQ HEAD (fetch PROCQUEUE of PROC)) (* Now remove PROC from its run queue)
(SETQ PREV (fetch PQLAST of HEAD))
[COND
[(EQ PROC PREV) (* Nobody left at this level)
(COND
((EQ PROC (fetch PQNEXT of HEAD))
(replace PQLAST of HEAD with (replace PQNEXT of HEAD with NIL)))
(T (\MP.ERROR \MP.PROCERROR "Inconsistent process queue state"]
(T (replace NEXTPROCHANDLE of PREV with (replace PQNEXT of HEAD
with (OR (fetch NEXTPROCHANDLE
of PROC)
(\MP.ERROR \MP.PROCERROR
"Running process has no NEXT pointer"
PROC]
(replace NEXTPROCHANDLE of PROC with NIL)
(COND
(EVLOCK (\ENQUEUE.EVENT/LOCK PROC EVLOCK)))
(replace PROCTIMERSET of PROC
with (COND
(TIMEOUT [COND
((NEQ TIMEOUT T)
(replace PROCWAKEUPTIMER of PROC
with (COND
(TIMERP TIMEOUT)
(T (SETUPTIMER TIMEOUT (fetch PROCTIMERBOX
of PROC]
(\ENQUEUE.TIMER PROC)
T)))
(RETURN (\RESCHEDULE (COND
(DELETEFLG (\RELEASE.PROCESS PROC T)
NIL)
(T PROC])])
(\PROC.RESUME
[LAMBDA (FRAME OLDFX) (* bvm: "15-Aug-84 10:44")
(* Diddles caller so that it returns to FRAME. If OLDFX is non-NIL, it is released. Do it in this order so that
the current stack is always valid)
(replace (FX ALINK) of (\MYALINK) with FRAME)
(replace (FX CLINK) of (\MYALINK) with FRAME)
(AND OLDFX (\DECUSECOUNT OLDFX])
(\RUN.PROCESS
[LAMBDA (PROC REASON BRUTALLY) (* bvm: "23-Jul-84 17:11")
(* Cause PROC to be placed in the runnable state, with
REASON as the value to return from the call to a waiting
function)
(PROG ((PQUEUE (fetch PROCQUEUE of PROC))
(EVENT (fetch PROCEVENTORLOCK of PROC))
PREV NEXT)
(COND
((AND (EQ (fetch PROCSTATUS of PROC)
\PSTAT.RUNNING)
(NOT BRUTALLY))
(ERROR "Attempt to run already running process" PROC)))
(UNINTERRUPTABLY
(COND
(EVENT (\UNQUEUE.EVENT PROC EVENT)))
(COND
((fetch PROCTIMERSET of PROC)
(\UNQUEUE.TIMER PROC)))
(SETQ PREV (fetch PQLAST of PQUEUE))
(COND
[(NOT PREV) (* PROC will be the only process at this level)
(replace PQNEXT of PQUEUE with (replace PQLAST of PQUEUE
with (replace NEXTPROCHANDLE of PROC
with PROC]
[\PROC.RUN.NEXT.FLG (SETQ NEXT (fetch PQNEXT of PQUEUE))
(replace NEXTPROCHANDLE of PROC with (fetch NEXTPROCHANDLE
of NEXT))
(replace NEXTPROCHANDLE of NEXT with PROC)
(COND
((EQ NEXT PREV)
(replace PQLAST of PQUEUE with PROC]
(T (replace NEXTPROCHANDLE of PROC with (fetch NEXTPROCHANDLE of PREV))
(replace NEXTPROCHANDLE of PREV with PROC)
(replace PQLAST of PQUEUE with PROC)))
(replace PROCSTATUS of PROC with \PSTAT.RUNNING)
(replace WAKEREASON of PROC with REASON))])
(\FLUSH.PROCESS
[LAMBDA (PROC) (* bvm: "26-OCT-83 12:32")
(COND
((EQ PROC (TTY.PROCESS))
(TTY.PROCESS T)))
(OR (fetch PROCFINISHED of PROC)
(replace PROCFINISHED of PROC with (QUOTE DELETED)))
(PROG ((EVENT (fetch PROCFINISHEVENT of PROC)))
(AND EVENT (NOTIFY.EVENT EVENT)))
(COND
((OR (NOT (fetch PROCBEINGDELETED of PROC))
(EQ PROC (THIS.PROCESS)))
(replace PROCBEINGDELETED of PROC with T)
(PROG NIL
[COND
((OR (fetch PROCRESETVARSLST of PROC)
(fetch PROCOWNEDLOCKS of PROC)) (* Need to do some cleanup first)
[COND
((NEQ PROC (THIS.PROCESS)) (* Delete proc in its own context, so that
(THIS.PROCESS) is correct during the unwind)
(RETURN (\PROCESS.MAKEFRAME PROC (FUNCTION \FLUSH.PROCESS)
(LIST PROC]
(\PROCESS.UNWINDALL (QUOTE RESET]
(COND
((EQ PROC (TTY.PROCESS)) (* It is possible that while unwinding, someone made
this the tty process, so check again)
(TTY.PROCESS T)))
(COND
((NEQ PROC (THIS.PROCESS))
(\SUSPEND.PROCESS PROC)
(\RELEASE.PROCESS PROC T))
(T (* Kill current process right now;
don't return)
(\PROCESS.GO.TO.SLEEP NIL NIL NIL T])
(\SUSPEND.PROCESS
[LAMBDA (PROC EVENT) (* bvm: " 3-Jan-85 12:35")
(* * Suspends PROC, not the running process, waiting on EVENT, or forever if EVENT = NIL)
(UNINTERRUPTABLY
[PROG (PQHEAD PREV OLDEVENT NEXT LAST)
[COND
((EQ (fetch PROCSTATUS of PROC)
\PSTAT.RUNNING) (* PROC is now running, so put it to sleep with no
reason to wake. This is a simplification of
\PROCESS.GO.TO.SLEEP)
(replace PROCSTATUS of PROC with \PSTAT.WAITING)
(SETQ PQHEAD (fetch PROCQUEUE of PROC)) (* Now remove PROC from its run queue)
(SETQ PREV (SETQ LAST (fetch PQLAST of PQHEAD)))
[do (SETQ NEXT (fetch NEXTPROCHANDLE of PREV))
(COND
((EQ NEXT PROC)
[COND
[(NEQ NEXT PREV)
(replace NEXTPROCHANDLE of PREV with (fetch NEXTPROCHANDLE
of PROC))
(COND
((EQ PROC (fetch PQLAST of PQHEAD))
(replace PQLAST of PQHEAD with PREV]
(T (* Nobody left at this level)
(replace PQLAST of PQHEAD with (replace PQNEXT of PQHEAD with NIL]
(RETURN)))
(COND
((EQ (SETQ PREV NEXT)
LAST)
(\MP.ERROR \MP.PROCERROR "Can't find running process in its queue"]
(replace NEXTPROCHANDLE of PROC with NIL))
(T (* Not running, so just keep it from waking up)
(COND
((fetch PROCTIMERSET of PROC)
(\UNQUEUE.TIMER PROC)))
(COND
((SETQ OLDEVENT (fetch PROCEVENTORLOCK of PROC))
(COND
((NEQ OLDEVENT EVENT)
(\UNQUEUE.EVENT PROC OLDEVENT))
(T (* Already queued for proper event)
(SETQ EVENT]
(COND
(EVENT (\ENQUEUE.EVENT/LOCK PROC EVENT])])
(\UNQUEUE.TIMER
[LAMBDA (PROC NOERROR) (* bvm: "31-JUL-83 16:29")
(* Remove PROC from the timer queue)
(PROG ((PREV \TIMERQHEAD))
LP (COND
((EQ (fetch PROCTIMERLINK of PREV)
PROC)
(replace PROCTIMERLINK of PREV with (fetch PROCTIMERLINK of PROC)))
((SETQ PREV (fetch PROCTIMERLINK of PREV))
(GO LP))
((NULL NOERROR)
(ERROR "Process not found on timer queue" PROC)))
(replace PROCTIMERLINK of PROC with NIL)
(replace PROCTIMERSET of PROC with NIL])
(\ENQUEUE.TIMER
[LAMBDA (PROC) (* bvm: " 7-SEP-83 13:48")
(* Place PROC on the timer queue.
Queue is ordered by timeout, so that the first item will
timeout first)
(UNINTERRUPTABLY
(PROG ((PREV \TIMERQHEAD)
(NEXT (fetch PROCTIMERLINK of \TIMERQHEAD)))
[COND
(NEXT (bind (TIMER ← \PROCTIMER.SCRATCH) first (\BOXIPLUS (\BOXIDIFFERENCE TIMER
TIMER)
(fetch PROCWAKEUPTIMER
of PROC))
while (AND NEXT (IGREATERP (\BOXIDIFFERENCE TIMER (fetch PROCWAKEUPTIMER
of NEXT))
0))
do (* NEXT will timeout before PROC, so keep going.)
(\BOXIPLUS TIMER (fetch PROCWAKEUPTIMER of NEXT))
(* Restore TIMER)
(SETQ NEXT (fetch PROCTIMERLINK of (SETQ PREV NEXT]
(* * PROC goes between PREV and NEXT)
(replace PROCTIMERLINK of PROC with NEXT)
(replace PROCTIMERLINK of PREV with PROC)))])
(\GET.PRIORITY.QUEUE
[LAMBDA (PRIORITY) (* bvm: "29-APR-83 18:37")
(PROG ((HEAD \HIGHEST.PRIORITY.QUEUE)
PREV PQ)
[COND
((NULL HEAD)
(RETURN (SETQ \HIGHEST.PRIORITY.QUEUE (create PROCESSQUEUE
PQPRIORITY ← PRIORITY]
LP (COND
((EQ (fetch PQPRIORITY of HEAD)
PRIORITY)
(RETURN HEAD))
((IGREATERP (fetch PQPRIORITY of HEAD)
PRIORITY)
(SETQ HEAD (fetch PQLOWER of (SETQ PREV HEAD)))
(GO LP)))
(SETQ PQ (create PROCESSQUEUE
PQPRIORITY ← PRIORITY
PQHIGHER ← PREV
PQLOWER ← HEAD))
(COND
(PREV (replace PQLOWER of PREV with PQ))
(T (SETQ \HIGHEST.PRIORITY.QUEUE PQ)))
(RETURN PQ])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \RESCHEDULE MACRO [LAMBDA (OLDPROC) (* Causes process switch, saving current context in
OLDPROC's handle, or nowhere if OLDPROC is NIL.
Must be called uninterruptably!)
(PROG (PQUEUE PROC)
TOP
(* * Maybe check for events here?)
(SETQ PQUEUE \HIGHEST.PRIORITY.QUEUE)
LP (COND
((SETQ PROC (fetch PQNEXT of PQUEUE))
[COND
((NEQ PROC OLDPROC)
(* Yes, there is a process switch required here.
Below is roughly the body of RESUME)
(PROG ((TOFX (fetch PROCFX of PROC))
FROMFX)
[COND
((fetch (FX INVALIDP) of TOFX)
(LISPERROR "STACK PTR HAS BEEN RELEASED"
(fetch MYSTACK of PROC]
(SETQ \RUNNING.PROCESS PROC)
(replace PROCFX of PROC with 0)
(\PROC.RESUME
TOFX
(COND
(OLDPROC (SETQ FROMFX (fetch PROCFX
of OLDPROC))
(COND
((NOT (fetch (FX INVALIDP)
of FROMFX))
(* Release stack pointer of OLDPROC if it hasn't been
yet. should never happen)
(\DECUSECOUNT FROMFX)))
(replace PROCFX of OLDPROC
with (\MYALINK))
NIL)
(T (* no OLDPROC to resume later, so jettison caller)
(\MYALINK]
(RETURN (fetch WAKEREASON of PROC)))
((SETQ PQUEUE (fetch PQLOWER of PQUEUE))
(GO LP))
(T (* nobody runnable, wait for events)
(\MP.ERROR \MP.PROCERROR "No runnable process!!" OLDPROC)
(GO TOP])
)
)
(DEFINEQ
(\PROCESS.INIT
[LAMBDA (DONTRESET) (* lmm "13-Sep-84 15:03")
(COND
((CCODEP (QUOTE \PROC.CODEFORTFRAME))
(\DEFINEDEVICE NIL (create FDEV
DEVICENAME ←(QUOTE PROCESS)
EVENTFN ←(FUNCTION \PROCESS.EVENTFN)
DIRECTORYNAMEP ←(QUOTE NILL)
HOSTNAMEP ←(QUOTE NILL)))
(\LOCKFN (QUOTE \PROC.CODEFORTFRAME))
(/PUTD (QUOTE \CODEFORTFRAME)
(GETD (QUOTE \PROC.CODEFORTFRAME))
T)
(MOVD (QUOTE BLOCK)
(QUOTE \BACKGROUND))
(OR DONTRESET (HARDRESET])
(\PROCESS.EVENTFN
[LAMBDA (DEV EVENTNAME) (* bvm: " 3-Apr-84 12:01")
(SELECTQ EVENTNAME
[(AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
(for PROC in (APPEND \PROCESSES) when (AND (ALIVEPROCP PROC)
(NEQ PROC (THIS.PROCESS)))
bind ACTION
do (* What does this process want done for it after exit?)
(SELECTQ (SETQ ACTION (fetch PROCAFTEREXIT of PROC))
(DELETE (DEL.PROCESS PROC))
(SUSPEND (SUSPEND.PROCESS PROC))
(COND
((type? EVENT ACTION) (* Cause PROC to wait on this event)
(\SUSPEND.PROCESS PROC ACTION))
((NEQ (fetch PROCNAME of PROC)
(QUOTE \TIMER.PROCESS))
(* Suspend process until system after exit events have run. This also has the side effect of eventually waking any
process waiting on a timer, important since the timer is garbage over exit)
(\SUSPEND.PROCESS PROC \PROCESS.AFTEREXIT.EVENT]
((BEFOREMAKESYS BEFORELOGOUT BEFORESYSOUT))
NIL])
(\PROCESS.BEFORE.LOGOUT
[LAMBDA NIL (* bvm: " 4-OCT-83 11:30")
(* * Make sure we don't log out until processes that asked to run to completion actually finish)
(RESETLST (PROG (W)
RETRY
(for PROC in \PROCESSES
do (COND
((EQ (fetch PROCBEFOREEXIT of PROC)
(QUOTE DON'T))
[COND
((NOT W)
(RESETSAVE NIL (LIST (QUOTE CLOSEW)
(SETQ W (CREATEW (QUOTE (260 247 453 173))
"Waiting for process(es) to finish"]
(printout W T "Waiting for process " (fetch PROCNAME of PROC)
" to finish..." T
" [Use the process status window to kill it
if you really don't want to wait]"
T)
(PROCESS.RESULT PROC T) (* Wait for it to finish)
(GO RETRY])
(\PROCESS.AFTER.EXIT
[LAMBDA (FLG) (* bvm: " 4-Jan-85 12:49")
(* * Stuff to do after the system after exit eventfns are finished but before we release to the user)
(NOTIFY.EVENT \PROCESS.AFTEREXIT.EVENT)
(SETQ \PROC.READY T])
(\PROC.AFTER.WINDOWWORLD
[LAMBDA NIL (* bvm: "24-JUL-83 16:20")
(PROG [(EXECPROC (FIND.PROCESS (QUOTE EXEC]
(COND
((AND EXECPROC (TYPENAMEP \TopLevelTtyWindow (QUOTE WINDOW)))
(replace PROCWINDOW of EXECPROC with \TopLevelTtyWindow)
(WINDOWPROP \TopLevelTtyWindow (QUOTE PROCESS)
EXECPROC)))
(COND
([AND TOPW (NOT (FIND.PROCESS (QUOTE MOUSE]
(ADD.PROCESS (QUOTE (\MOUSE.PROCESS))
(QUOTE NAME)
(QUOTE MOUSE)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE SCHEDULE)
T])
(\TURN.ON.PROCESSES
[LAMBDA NIL (* bvm: " 5-Feb-85 17:04")
(COND
((OR AUTOPROCESSFLG (EQ (ASKUSER NIL NIL "↑D -- run process scheduler? " NIL)
(QUOTE Y)))
[COND
((LISTP RESETVARSLST) (* Better unwind these now, since this RESETVARSLST
binding will become invisible)
(RESETRESTORE NIL (QUOTE RESET]
(PROCESSWORLD T)))
(QUOTE OK])
)
(* Redefinitions)
(DEFINEQ
(\PROC.CODEFORTFRAME
[LAMBDA NIL (* bvm: " 5-Feb-85 17:05")
(\CALLME T)
(SETQ \RUNNING.PROCESS)
(CLEARSTK (QUOTE **CLEAR**))
[COND
((NEQ (\TURN.ON.PROCESSES)
(QUOTE OK))
(while T do (\MP.ERROR \MP.TOPUNWOUND "Unexpected (RETTO T)"]
(* * Normally never get here. There's a hack in \TURN.ON.PROCESSES that lets you run without processes, but I'm not
sure you can even do that any more. The OK test is to catch inadvertant (RETTO T) calls)
(INITIALEVALQT)
(PROG NIL
LP (\REPEATEDLYEVALQT)
(GO LP])
(\PROC.REPEATEDLYEVALQT
[LAMBDA NIL (* bvm: "20-Jun-84 17:15")
(DECLARE (GLOBALVARS \TopLevelTtyWindow))
(\CALLME (QUOTE \REPEATEDLYEVALQT))
(INITIALEVALQT)
(PROG NIL
(TTYDISPLAYSTREAM \TopLevelTtyWindow)
(OUTPUT T)
(INPUT T)
LP (\RESETSYSTEMSTATE)
(EVALQT)
(GO LP])
)
(* switching stacks)
(DEFINEQ
(BREAK.PROCESS
[LAMBDA (PROC) (* bvm: "25-JUL-83 17:36")
(PROG ((P (\COERCE.TO.PROCESS PROC)))
(COND
((EQ P (THIS.PROCESS))
(\DOHELPINTERRUPT1))
(T (\PROCESS.MAKEFRAME P (FUNCTION \DOHELPINTERRUPT1])
(\SELECTPROCESS
[LAMBDA (TITLE) (* bvm: "27-JUL-83 18:39")
(PROG ((TTYNAME (fetch PROCNAME of (TTY.PROCESS)))
PROCNAMES NAME)
(SETQ PROCNAMES (CONS TTYNAME (for PROC in \PROCESSES
unless [OR (EQ (SETQ NAME (fetch PROCNAME of PROC))
TTYNAME)
(AND (fetch PROCSYSTEMP of PROC)
(NEQ NAME (QUOTE MOUSE]
collect NAME)))
(NCONC PROCNAMES (for PROC in \PROCESSES collect (fetch PROCNAME of PROC)
unless (FMEMB (fetch PROCNAME of PROC)
PROCNAMES)))
(RPLACA PROCNAMES (LIST (CONCAT TTYNAME " *")
(LIST (QUOTE QUOTE)
TTYNAME)))
(RETURN (COND
([SETQ NAME (MENU (create MENU
ITEMS ←(CONS (QUOTE %[Spawn% Mouse%])
PROCNAMES)
TITLE ← TITLE
CENTERFLG ← T
MENUFONT ←(QUOTE (GACHA 10]
(COND
((EQ NAME (QUOTE %[Spawn% Mouse%]))
(SPAWN.MOUSE)
NIL)
(T (FIND.PROCESS NAME])
(\PROCESS.MAKEFRAME
[LAMBDA (PROC FN ARGS FLG) (* bvm: " 5-Feb-85 13:09")
(* * Builds a frame to call FN with ARGS on top of PROC. Returns NIL if it can't right now. FN must have no pvars or
fvars)
(UNINTERRUPTABLY
(PROG ((FRAME (fetch PROCFX of PROC))
(FN&ARGS (CONS FN ARGS))
NEWFRAME)
[COND
((ILESSP FRAME (fetch (IFPAGE StackBase) of \InterfacePage))
(* This is the test used in \CAUSEINTERRUPT, but
actually, we could afford to test \INTERRUPTABLE here)
(RETURN (COND
((EQ FRAME 0)
(\MP.ERROR \MP.PROCERROR
"PROC confused: trying to call a fn in a nonexistent process"
FN))
(T (\MP.ERROR \MP.PROCERROR
"PROC confused: a process other than the running one is in uninterruptable region"
FRAME]
[COND
((SETQ NEWFRAME (\MISCAPPLY* (FUNCTION \PROCESS.MAKEFRAME0)
FRAME FN&ARGS))
(* Note that FN&ARGS was consed up before entering
\MISCAPPLY* in case the CONS causes a NEWPAGE, which
uses the misc context also)
)
(T (* Should never happen -- error occurs inside
\PROCESS.MAKEFRAME0 first)
(RETURN (COND
(FLG (\MP.ERROR \MP.PROCERROR "Can't build frame for process call" FN]
(COND
((NEQ (fetch PROCSTATUS of PROC)
\PSTAT.RUNNING)
(\RUN.PROCESS PROC)))
(replace PROCFX of PROC with NEWFRAME)
(RETURN T)))])
(\PROCESS.MAKEFRAME0
[LAMBDA (FRAME FN&ARGS) (* bvm: " 3-Jan-85 12:37")
(PROG ((ARGS (CDR FN&ARGS))
(FN (CAR FN&ARGS))
FREE NXT NXTEND)
(SETQ NXT (fetch (FX NEXTBLOCK) of FRAME))
(CHECK (fetch (FX CHECKED) of FRAME)
(type? FSB NXT))
(SETQ NXTEND (IPLUS NXT (fetch (FSB SIZE) of NXT)))
[while (type? FSB NXTEND) do (SETQ NXTEND (IPLUS NXTEND (fetch (FSB SIZE) of NXTEND]
(RETURN (OR (\MAKEFRAME FN NXT NXTEND FRAME FRAME ARGS)
(\MAKEFRAME FN (SETQ FREE (\FREESTACKBLOCK
(IPLUS (PROG1 (fetch (FNHEADER STKMIN)
of (fetch (LITATOM DEFPOINTER) of FN))
(* Stack needed to call this fn)
)
(PROG1 (UNFOLD 20 WORDSPERCELL)
(* Extra slop)
))
FRAME))
(IPLUS FREE (fetch (FSB SIZE) of FREE))
FRAME FRAME ARGS)
(\MP.ERROR \MP.PROCNOFRAME "Failed to build frame for PROCESS use" FN])
)
(RPAQ? #MYHANDLE# )
(RPAQ? \TTY.PROCESS )
(RPAQ? #SCHEDULER# )
(RPAQ? \RUNNING.PROCESS )
(RPAQ? \PROCESSES )
(RPAQ? FUNNNYPROCS )
(RPAQ? PROCESS.MAXMOUSE 5)
(RPAQ? PROC.FREESPACESIZE 1024)
(RPAQ? AUTOPROCESSFLG T)
(RPAQ? BACKGROUNDFNS )
(RPAQ? \TIMERQHEAD )
(RPAQ? \HIGHEST.PRIORITY.QUEUE )
(RPAQ? PROC.DEFAULT.PRIORITY 2)
(RPAQ? \DEFAULTLINEBUF )
(RPAQ? \DEFAULTTTYDISPLAYSTREAM )
(RPAQ? \PROCTIMER.SCRATCH (NCREATE (QUOTE FIXP)))
(RPAQ? TOPW )
(RPAQ? \PROC.RUN.NEXT.FLG )
(RPAQ? \PROC.READY T)
(ADDTOVAR \SYSTEMCACHEVARS \PROC.READY)
(RPAQ \PROC.RESTARTME "{restart flag}")
(RPAQ \PROC.RESETME "{reset flag}")
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS THIS.PROCESS MACRO (NIL \RUNNING.PROCESS))
(PUTPROPS TTY.PROCESS MACRO [X (COND
((CAR X)
(QUOTE IGNOREMACRO))
(T (QUOTE \TTY.PROCESS])
(PUTPROPS TTY.PROCESSP MACRO [X (COND
((CAR X)
(QUOTE IGNOREMACRO))
(T (QUOTE (OR (NULL (THIS.PROCESS))
(EQ (THIS.PROCESS)
(TTY.PROCESS])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RUNNING.PROCESS \TTY.PROCESS \PROC.RESTARTME \PROC.RESETME)
)
(* END EXPORTED DEFINITIONS)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \PROCESSES PROC.FREESPACESIZE NOCLEARSTKLST #SCHEDULER# PROCESS.MAXMOUSE AUTOPROCESSFLG
BACKGROUNDFNS \TopLevelTtyWindow \PROC.READY)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TIMERQHEAD \PROCTIMER.SCRATCH \HIGHEST.PRIORITY.QUEUE PROC.DEFAULT.PRIORITY
\PROC.RUN.NEXT.FLG)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS ALIVEPROCP MACRO ((p)
(NOT (DEADPROCP p))))
(PUTPROPS DEADPROCP MACRO ((p)
(fetch PROCDELETED of p)))
(PUTPROPS \COERCE.TO.PROCESS MACRO [OPENLAMBDA (P ERRORFLG)
(COND
((AND (type? PROCESS P)
(NOT (fetch PROCDELETED of P)))
P)
(T (FIND.PROCESS P ERRORFLG])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
)
(* Debugging)
(DEFINEQ
(\CHECK.PQUEUE
[LAMBDA (P THISP) (* bvm: "21-Jun-84 11:41")
[COND
((type? PROCESS P)
(SETQ P (fetch PROCQUEUE of P]
(OR (PROG ((PREV (fetch PQLAST of P))
(NEXT (fetch PQNEXT of P))
X)
[COND
((NULL PREV)
(RETURN (COND
((NULL NEXT)
T)
(T (printout T P " has a LAST = " PREV " but no NEXT" T)
NIL]
(COND
((NEQ (fetch NEXTPROCHANDLE of PREV)
NEXT)
(printout T "Last=" PREV " points at " (fetch NEXTPROCHANDLE of PREV)
" but NEXT=" NEXT T)
(RETURN)))
(COND
((AND THISP (NEQ NEXT (THIS.PROCESS)))
(printout T "NEXT=" NEXT " but running process = " (THIS.PROCESS)
T)
(RETURN)))
(SETQ X (fetch NEXTPROCHANDLE of NEXT))
(SETQ PREV NEXT)
LP (COND
((NULL X)
(printout T "Successor of " PREV " is NIL" T)
(RETURN)))
(COND
((EQ X NEXT) (* The end)
(COND
((NEQ PREV (fetch PQLAST of P))
(printout T "Predecessor of NEXT = " NEXT " is " PREV " which is not LAST" T)
(RETURN)))
(RETURN T)))
(SETQ X (fetch NEXTPROCHANDLE of (SETQ PREV X)))
(GO LP))
(RESETVARS ((\RUNNING.PROCESS)) (* Inhibit process switch)
(RETURN (HELP])
)
(DEFINEQ
(PPROC
[LAMBDA (PROC FILE) (* bvm: "10-MAY-83 22:59")
(* show a process, or many)
(COND
(PROC (PPROC1 PROC FILE))
(T (PROG ((NOW (CLOCK 0))
(PQ \HIGHEST.PRIORITY.QUEUE)
DONE P1)
(printout FILE " name" .FR 21 "prty" " state (run reason)" T)
LP [COND
((SETQ P1 (fetch PQNEXT of PQ))
(for (P ← P1)
do (PPROC1 P FILE NOW)
(push DONE P)
repeatuntil (EQ (SETQ P (fetch NEXTPROCHANDLE of P))
P1]
(COND
((SETQ PQ (fetch PQLOWER of PQ))
(GO LP)))
(printout FILE " - - -" T 22 "TimeLeft WakeCondition" T)
(for (P ← \TIMERQHEAD) while (SETQ P (fetch PROCTIMERLINK of P))
do (PPROC1 P FILE NOW)
(push DONE P))
(for P in \PROCESSES unless (FMEMB P DONE) do (PPROC1 P FILE NOW])
(PPROCWINDOW
[LAMBDA (W) (* bvm: " 6-MAY-83 13:05")
(OR W (SETQ W (CREATEW NIL "Detailed process status")))
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(FUNCTION PPROCREPAINTFN))
(WINDOWPROP W (QUOTE REPAINTFN)
(FUNCTION PPROCREPAINTFN))
(WINDOWPROP W (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(WINDOWPROP W (QUOTE RESHAPEFN)
(FUNCTION PPROCRESHAPEFN))
(WINDOWPROP W (QUOTE PPROCHEIGHT)
(WINDOWPROP W (QUOTE HEIGHT)))
(DSPRIGHTMARGIN 76400Q W)
W])
(PPROCREPAINTFN
[LAMBDA (WINDOW REGION) (* bvm: " 4-MAY-83 12:06")
[COND
(REGION (* As repaintfn)
(MOVETO 0 (WINDOWPROP WINDOW (QUOTE PPROCSTART))
WINDOW)
(DSPFILL NIL 0 NIL WINDOW)
(PPROC NIL WINDOW))
(T (* As buttoneventfn)
(COND
((LASTMOUSESTATE (NOT UP))
(CLEARW WINDOW)
(WINDOWPROP WINDOW (QUOTE PPROCSTART)
(DSPYPOSITION NIL WINDOW))
(PPROC NIL WINDOW]
(WINDOWPROP WINDOW (QUOTE EXTENT)
(PPROCEXTENT WINDOW])
(PPROCRESHAPEFN
[LAMBDA (WINDOW OLDCONTENTS REGION) (* bvm: "22-JUN-83 10:24")
(WINDOWPROP WINDOW (QUOTE PPROCHEIGHT)
(WINDOWPROP WINDOW (QUOTE HEIGHT)))
(DSPRIGHTMARGIN 76400Q WINDOW)
(RESHAPEBYREPAINTFN WINDOW OLDCONTENTS REGION])
(PPROCEXTENT
[LAMBDA (WINDOW) (* bvm: "10-MAY-83 22:59")
(PROG [(H (ITIMES (IPLUS 3 (LENGTH \PROCESSES))
(IMINUS (DSPLINEFEED NIL WINDOW]
(RETURN (create REGION
LEFT ← 0
BOTTOM ←(IDIFFERENCE (WINDOWPROP WINDOW (QUOTE PPROCHEIGHT))
H)
WIDTH ← -1
HEIGHT ← H])
(PPROC1
[LAMBDA (PROC FILE NOW) (* bvm: "10-MAY-83 22:58")
(PROG (EVLOCK TIMELEFT NAME)
(PRIN1 (COND
((DEADPROCP PROC)
(QUOTE *))
((EQ PROC (TTY.PROCESS))
(QUOTE #))
(T " "))
FILE)
(PRIN1 (COND
((fetch PROCSYSTEMP of PROC)
(QUOTE +))
(T " "))
FILE)
(printout FILE (fetch PROCNAME of PROC)
20
(fetch PROCPRIORITY of PROC)
,)
[COND
((EQ PROC (THIS.PROCESS))
(printout FILE "running "))
((EQ (fetch PROCSTATUS of PROC)
\PSTAT.RUNNING)
(printout FILE "runnable (" (fetch WAKEREASON of PROC)
")"))
(T (COND
((NOT (fetch PROCTIMERSET of PROC))
(PRIN1 "(forever)" FILE))
((IGEQ [SETQ TIMELEFT (IDIFFERENCE (fetch PROCWAKEUPTIMER of PROC)
(OR NOW (SETQ NOW (CLOCK 0]
0)
(printout FILE .I8 TIMELEFT))
(T (PRIN1 "(expired)" FILE)))
(TAB 32 T FILE)
(COND
((SETQ EVLOCK (fetch PROCEVENTORLOCK of PROC))
(printout FILE (COND
((type? MONITORLOCK EVLOCK)
(SETQ NAME (fetch MLOCKNAME of EVLOCK))
"lock ")
(T (SETQ NAME (fetch EVENTNAME of EVLOCK))
"event "))
(OR NAME "unnamed")))
(T (printout FILE "blocked"]
(TERPRI FILE])
(PROCESS.STATUS.WINDOW
[LAMBDA (WHERE) (* bvm: " 3-Apr-84 14:31")
(* added WHERE as a means of specifying where the
initial window should go.)
(PROG ((PROCS (for P in \PROCESSES collect (fetch PROCNAME of P)))
PMENU HEIGHT WIDTH LEFT BOTTOM REG)
(SETQ PMENU (create MENU
ITEMS ← PROCS
WHENSELECTEDFN ←(QUOTE PROC.SELECTED)
MENUFONT ←(FONTCREATE (QUOTE GACHA)
10)
CENTERFLG ← T))
(OR PROCOPMENU
(SETQ PROCOPMENU
(create MENU
ITEMS ←(QUOTE (BT WHO? KILL BTV KBD← RESTART BTV* INFO WAKE BTV! BREAK
SUSPEND))
WHENSELECTEDFN ←(QUOTE PROCOP.SELECTED)
CENTERFLG ← T
MENUCOLUMNS ← 3)))
(SETQ HEIGHT (HEIGHTIFWINDOW (IPLUS (fetch IMAGEHEIGHT of PMENU)
(fetch IMAGEHEIGHT of PROCOPMENU)
4)))
[SETQ WIDTH (WIDTHIFWINDOW (IMAX (fetch IMAGEWIDTH of PMENU)
(fetch IMAGEWIDTH of PROCOPMENU]
[COND
[(AND (WINDOWP PROCESS.STATUS.WINDOW)
(EQ WHERE T))
(SETQ REG (WINDOWPROP PROCESS.STATUS.WINDOW (QUOTE REGION)))
(SETQ LEFT (fetch LEFT of REG))
(COND
((IGREATERP (IPLUS (SETQ BOTTOM (fetch BOTTOM of REG))
HEIGHT)
SCREENHEIGHT)
(SETQ BOTTOM (IDIFFERENCE SCREENHEIGHT HEIGHT]
(T [SETQ WHERE (COND
((POSITIONP WHERE))
(T (GETBOXPOSITION WIDTH HEIGHT]
(SETQ LEFT (fetch XCOORD of WHERE))
(SETQ BOTTOM (fetch YCOORD of WHERE]
(COND
((WINDOWP PROCESS.STATUS.WINDOW)
(CLOSEW PROCESS.STATUS.WINDOW)))
(SETQ PROCESS.STATUS.WINDOW
(CREATEW (create REGION
LEFT ← LEFT
BOTTOM ← BOTTOM
WIDTH ← WIDTH
HEIGHT ← HEIGHT)))
(ADDMENU PROCOPMENU PROCESS.STATUS.WINDOW (QUOTE (0 . 0)))
(ADDMENU (SETQ PROCMENU PMENU)
PROCESS.STATUS.WINDOW
(create POSITION
XCOORD ←(IQUOTIENT (IDIFFERENCE WIDTH (fetch IMAGEWIDTH of PMENU))
2)
YCOORD ←(IPLUS (fetch IMAGEHEIGHT of PROCOPMENU)
4))) (* Don't set PROCMENU globally until after old psw is
closed)
[COND
(SELECTEDPROC (COND
((FMEMB SELECTEDPROC PROCS)
(SHADEITEM SELECTEDPROC PMENU SELECTIONSHADE))
(T (SETQ SELECTEDPROC]
(WINDOWPROP PROCESS.STATUS.WINDOW (QUOTE PROCS)
PROCS)
(WINDOWPROP PROCESS.STATUS.WINDOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (WINDOW)
(COND
((EQ WINDOW PROCESS.STATUS.WINDOW)
(SETQ PROCMENU (SETQ PROCESS.STATUS.WINDOW))
(AND (WINDOWP PROCBACKTRACEWINDOW)
(CLOSEW PROCBACKTRACEWINDOW])
(PROC.SELECTED
[LAMBDA (ITEM MENU BUTTON) (* bvm: " 6-JUN-82 21:03")
(COND
((AND SELECTEDPROC (NEQ ITEM SELECTEDPROC))
(SHADEITEM SELECTEDPROC MENU WHITESHADE)))
(SHADEITEM ITEM MENU SELECTIONSHADE)
(SETQ SELECTEDPROC ITEM])
(PROCOP.SELECTED
[LAMBDA (ITEM MENU BUTTON) (* bvm: "11-AUG-83 12:10")
(COND
((NULL (THIS.PROCESS))
(PROMPTPRINT "Processes are off!"))
[(EQ ITEM (QUOTE WHO?))
(COND
((TTY.PROCESS)
(PROC.SELECTED (fetch PROCNAME of (TTY.PROCESS))
PROCMENU))
(T (PROMPTPRINT "No process has the tty!!!"]
(SELECTEDPROC
(PROG ((P (FIND.PROCESS SELECTEDPROC))
VALUE)
(OR P (RETURN (printout T "Can't find process " SELECTEDPROC T)))
(SELECTQ
ITEM
(KBD← (TTY.PROCESS P))
((BT BTV BTV* BTV!)
(PROCESS.BACKTRACE P ITEM))
[INFO (COND
((NOT (SETQ VALUE (fetch PROCINFOHOOK of P)))
(PROMPTPRINT "No info program supplied for this process"))
((AND (LISTP VALUE)
(NOT (FMEMB (CAR VALUE)
LAMBDASPLST)))
(PROCESS.EVAL P VALUE))
(T (PROCESS.APPLY P VALUE (LIST P BUTTON]
[KILL (COND
((EQ P (TTY.PROCESS))
(PROMPTPRINT "Can't kill the TTY process"))
((fetch PROCSYSTEMP of P)
(PROMPTPRINT "Can't kill system process"))
(T (DEL.PROCESS P]
(RESTART (RESTART.PROCESS P))
[WAKE (PROG (VALUE)
(WAKE.PROCESS P
(SELECTQ
[MENU (OR PROCOP.WAKEMENU
(SETQ PROCOP.WAKEMENU
(create MENU
ITEMS ←(QUOTE ((NIL (QUOTE NULL))
T Other))
TITLE ← "WakeUp Value"
CENTERFLG ← T]
(NIL (RETURN))
(NULL NIL)
(T T)
[Other (CAR (OR (LISTP (PROCESS.READ
"Value to return to woken process: "))
(RETURN]
NIL]
(BREAK (BREAK.PROCESS P))
(SUSPEND (AND (NEQ P (THIS.PROCESS))
(\SUSPEND.PROCESS P)))
NIL])
(PROCESS.BACKTRACE
[LAMBDA (PROC CMD WINDOW) (* bvm: "11-AUG-83 12:20")
(PROG (DSP HANDLE REGION)
[COND
([NOT (WINDOWP (OR WINDOW (SETQ WINDOW PROCBACKTRACEWINDOW]
(SETQ REGION (WINDOWPROP PROCESS.STATUS.WINDOW (QUOTE REGION)))
(SETQ DSP (WINDOWPROP (SETQ PROCBACKTRACEWINDOW
(CREATEW (create REGION
LEFT ←(fetch LEFT of REGION)
BOTTOM ←(COND
((ILESSP (fetch BOTTOM of REGION)
PROCBACKTRACEHEIGHT)
(fetch TOP of REGION))
(T (IDIFFERENCE (fetch BOTTOM of REGION)
PROCBACKTRACEHEIGHT)))
WIDTH ←(fetch WIDTH of REGION)
HEIGHT ← PROCBACKTRACEHEIGHT)
"Process backtrace"))
(QUOTE DSP)))
[WINDOWPROP PROCBACKTRACEWINDOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W)
(AND (EQ W PROCBACKTRACEWINDOW)
(SETQ PROCBACKTRACEWINDOW]
(DSPSCROLL (QUOTE OFF)
DSP)
(DSPFONT (OR BACKTRACEFONT (FONTCREATE (QUOTE GACHA)
10Q))
DSP))
(T (SETQ DSP (WINDOWPROP PROCBACKTRACEWINDOW (QUOTE DSP]
(DSPRESET DSP)
(PROG ((PLVLFILEFLG T))
(BAKTRACE (COND
((RELSTKP (SETQ HANDLE (fetch MYSTACK of PROC)))
(* The currently active proc!)
(QUOTE PROCOP.SELECTED))
(T HANDLE))
NIL NIL (SELECTQ CMD
(BT 0)
(BTV 1)
(BTV* 7)
(BTV! 47Q)
0)
DSP])
(\INVALIDATE.PROCESS.WINDOW
[LAMBDA NIL (* bvm: "21-JUN-82 17:50")
(* If process window is active and correct, grays it out
and makes its buttoneventfn be something to update it)
(PROG (OLDBUTTONFN)
(COND
((AND PROCESS.STATUS.WINDOW (ACTIVEWP PROCESS.STATUS.WINDOW)
(NEQ (SETQ OLDBUTTONFN (WINDOWPROP PROCESS.STATUS.WINDOW (QUOTE BUTTONEVENTFN)
(QUOTE \UPDATE.PROCESS.WINDOW)))
(QUOTE \UPDATE.PROCESS.WINDOW)))
(WINDOWPROP PROCESS.STATUS.WINDOW (QUOTE OLDBUTTONEVENTFN)
OLDBUTTONFN)
(DSPFILL NIL LIGHTGRAYSHADE (QUOTE INVERT)
PROCESS.STATUS.WINDOW])
(\UPDATE.PROCESS.WINDOW
[LAMBDA (WINDOW) (* bvm: " 4-OCT-83 11:54")
(PROG (OLDBUTTONFN) (* Restore proper button fn)
(COND
((for P in \PROCESSES as NAME in (WINDOWPROP WINDOW (QUOTE PROCS))
thereis (NEQ NAME (fetch PROCNAME of P)))
(PROCESS.STATUS.WINDOW T))
(T (DSPFILL NIL LIGHTGRAYSHADE (QUOTE INVERT)
PROCESS.STATUS.WINDOW)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(SETQ OLDBUTTONFN (WINDOWPROP WINDOW (QUOTE OLDBUTTONEVENTFN)
NIL)))
(* Now invoke the real fn)
(APPLY* OLDBUTTONFN WINDOW])
)
(RPAQ? PROCMENU )
(RPAQ? PROCOPMENU )
(RPAQ? PROCOP.WAKEMENU )
(RPAQ? PROCBACKTRACEWINDOW )
(RPAQ? PROCESS.STATUS.WINDOW )
(RPAQ? SELECTEDPROC )
(RPAQ? PROCBACKTRACEHEIGHT 320)
(ADDTOVAR BackgroundMenuCommands ("PSW" (QUOTE (PROCESS.STATUS.WINDOW))
"Puts up a Process Status Window"))
(SETQQ BackgroundMenu)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PROCESS.STATUS.WINDOW PROCMENU PROCOPMENU PROCOP.WAKEMENU PROCBACKTRACEHEIGHT
SELECTEDPROC BACKTRACEFONT PROCBACKTRACEWINDOW)
)
(DECLARE: EVAL@COMPILE
(RPAQQ LIGHTGRAYSHADE 1)
(RPAQQ SELECTIONSHADE 520)
(CONSTANTS LIGHTGRAYSHADE SELECTIONSHADE)
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR WINDOWUSERFORMS (\PROC.AFTER.WINDOWWORLD))
(\PROCESS.INIT)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA PROCESSPROP ADD.PROCESS)
)
(PUTPROPS PROC COPYRIGHT ("Xerox Corporation" T 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (13038 26880 (PROCESSWORLD 13048 . 18811) (ADD.PROCESS 18813 . 21714) (DEL.PROCESS 21716
. 22059) (PROCESS.RETURN 22061 . 22498) (FIND.PROCESS 22500 . 23179) (MAP.PROCESSES 23181 . 23460) (
PROCESSP 23462 . 23622) (RELPROCESSP 23624 . 23798) (RESTART.PROCESS 23800 . 25012) (WAKE.PROCESS
25014 . 25663) (SUSPEND.PROCESS 25665 . 25998) (PROCESS.RESULT 26000 . 26609) (PROCESS.FINISHEDP 26611
. 26878)) (26946 33236 (THIS.PROCESS 26956 . 27088) (TTY.PROCESS 27090 . 28589) (TTY.PROCESSP 28591
. 28792) (PROCESS.TTY 28794 . 29190) (GIVE.TTY.PROCESS 29192 . 29965) (PROCESS.PREPARE.FOR.INPUT
29967 . 30229) (ALLOW.BUTTON.EVENTS 30231 . 30467) (SPAWN.MOUSE 30469 . 31602) (\WAIT.FOR.TTY 31604 .
31793) (WAIT.FOR.TTY 31795 . 33234)) (33237 36800 (PROCESSPROP 33247 . 35972) (PROCESS.NAME 35974 .
36282) (PROCESS.WINDOW 36284 . 36798)) (37004 40629 (DISMISS 37014 . 37668) (BLOCK 37670 . 39148) (
WAITFORINPUT 39150 . 40100) (\WAITFORSYSBUFP 40102 . 40627)) (41066 41556 (EVAL.AS.PROCESS 41076 .
41310) (EVAL.IN.TTY.PROCESS 41312 . 41554)) (42017 45545 (PROCESS.READ 42027 . 42606) (PROCESS.EVALV
42608 . 43086) (PROCESS.EVAL 43088 . 43882) (\PROCESS.EVAL1 43884 . 44307) (PROCESS.APPLY 44309 .
45111) (\PROCESS.APPLY1 45113 . 45543)) (46965 50658 (CREATE.EVENT 46975 . 47130) (NOTIFY.EVENT 47132
. 48455) (AWAIT.EVENT 48457 . 48646) (\UNQUEUE.EVENT 48648 . 49774) (\ENQUEUE.EVENT/LOCK 49776 .
50656)) (52434 56440 (OBTAIN.MONITORLOCK 52444 . 54039) (CREATE.MONITORLOCK 54041 . 54246) (
RELEASE.MONITORLOCK 54248 . 56149) (MONITOR.AWAIT.EVENT 56151 . 56438)) (56901 71623 (\MAKE.PROCESS0
56911 . 61497) (\PROCESS.MOVEFRAME 61499 . 65057) (\RELEASE.PROCESS 65059 . 66484) (\MAYBEBLOCK 66486
. 66635) (\BACKGROUND.PROCESS 66637 . 66873) (\MOUSE.PROCESS 66875 . 68557) (\TIMER.PROCESS 68559 .
69125) (\PROC.RESETRESTORE 69127 . 69963) (\PROCESS.UNWINDALL 69965 . 70839) (\UNIQUE.PROCESS.NAME
70841 . 71621)) (71624 82871 (\START.PROCESSES 71634 . 71805) (\PROCESS.GO.TO.SLEEP 71807 . 74250) (
\PROC.RESUME 74252 . 74694) (\RUN.PROCESS 74696 . 76499) (\FLUSH.PROCESS 76501 . 78002) (
\SUSPEND.PROCESS 78004 . 80122) (\UNQUEUE.TIMER 80124 . 80812) (\ENQUEUE.TIMER 80814 . 82059) (
\GET.PRIORITY.QUEUE 82061 . 82869)) (84887 88955 (\PROCESS.INIT 84897 . 85446) (\PROCESS.EVENTFN 85448
. 86597) (\PROCESS.BEFORE.LOGOUT 86599 . 87479) (\PROCESS.AFTER.EXIT 87481 . 87794) (
\PROC.AFTER.WINDOWWORLD 87796 . 88439) (\TURN.ON.PROCESSES 88441 . 88953)) (88982 90081 (
\PROC.CODEFORTFRAME 88992 . 89677) (\PROC.REPEATEDLYEVALQT 89679 . 90079)) (90111 94567 (BREAK.PROCESS
90121 . 90413) (\SELECTPROCESS 90415 . 91515) (\PROCESS.MAKEFRAME 91517 . 93311) (\PROCESS.MAKEFRAME0
93313 . 94565)) (96749 98203 (\CHECK.PQUEUE 96759 . 98201)) (98204 110566 (PPROC 98214 . 99224) (
PPROCWINDOW 99226 . 99769) (PPROCREPAINTFN 99771 . 100428) (PPROCRESHAPEFN 100430 . 100709) (
PPROCEXTENT 100711 . 101078) (PPROC1 101080 . 102511) (PROCESS.STATUS.WINDOW 102513 . 105397) (
PROC.SELECTED 105399 . 105684) (PROCOP.SELECTED 105686 . 107460) (PROCESS.BACKTRACE 107462 . 109053) (
\INVALIDATE.PROCESS.WINDOW 109055 . 109813) (\UPDATE.PROCESS.WINDOW 109815 . 110564)))))
STOP