(FILECREATED "17-AUG-83 13:05:05" {PHYLUM}<LISPCORE>SOURCES>PROC.;113 327165Q
changes to: (FNS PROCESSPROP PROCESS.TTY PROCESS.STATUS.WINDOW)
(VARS PROCCOMS)
previous date: "14-AUG-83 17:52:10" {PHYLUM}<LISPCORE>SOURCES>PROC.;111)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(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)
(FNS THIS.PROCESS TTY.PROCESS TTY.PROCESSP PROCESS.TTY GIVE.TTY.PROCESS
PROCESS.SWITCH.TO.WINDOW 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)
(* Temporary)
(FNS KILL.ME))
(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 PREEMPT.KEYBOARD WITHOUT.PROCESSES)
(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)
(MACROS AWAIT.CONDITION)
(INITVARS (\TTY.PROCESS.EVENT))
(GLOBALVARS \TTY.PROCESS.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 \PROCMOVEFRAME \RELEASE.PROCESS \PROCESS.BLOCK \MAYBEBLOCK
\PROC.ERROR \BACKGROUND.PROCESS \MOUSE.PROCESS \TIMER.PROCESS
\PROC.RESETRESTORE \PROC.AFTER.HARDRESET \PROCESS.UNWINDALL
\UNIQUE.PROCESS.NAME)
(COMS (FNS \START.PROCESSES \PROCESS.GO.TO.SLEEP \RUN.PROCESS \FLUSH.PROCESS
\SUSPEND.PROCESS \UNQUEUE.TIMER \ENQUEUE.TIMER \GET.PRIORITY.QUEUE)
(DECLARE: DONTCOPY (MACROS \RESCHEDULE)))
(COMS (FNS \PROCINIT \PROCESS.EVENTFN \PROC.AFTER.WINDOWWORLD \TURN.ON.PROCESSES)
(* Redefinitions)
(FNS \PROC.CODEFORTFRAME \PROC.REPEATEDLYEVALQT))
(COMS (* Temporary until this fix is in the system)
(FNS \SETFVARSLOT)
(DECLARE: DONTCOPY (* Fix this on LLSTK)
(RECORDS FVARSLOT)))
(COMS (* switching stacks)
(FNS BREAK.PROCESS \SELECTPROCESS \PROCESS.MAKEFRAME \PROCESS.MAKEFRAME0))
(INITVARS (#MYHANDLE#)
(\TTY.PROCESS)
(#SCHEDULER#)
(#INHIBIT.SCHEDULING#)
(\RUNNING.PROCESS)
(\PROCESSES)
(FUNNNYPROCS)
(PROCESS.MAXMOUSE 5)
(PROC.FREESPACESIZE 2000Q)
(AUTOPROCESSFLG T)
(BACKGROUNDFNS)
(\PROCUNWINDTHESE)
(\TIMERQHEAD)
(\HIGHEST.PRIORITY.QUEUE)
(PROC.DEFAULT.PRIORITY 2)
(\DEFAULTLINEBUF)
(\DEFAULTTTYDISPLAYSTREAM)
(TOPW))
(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
\PROCUNWINDTHESE \OLD.TTY.PROCESS)
(GLOBALVARS \TIMERQHEAD \HIGHEST.PRIORITY.QUEUE
PROC.DEFAULT.PRIORITY)
(MACROS ALIVEPROCP DEADPROCP IN.PROCESSP \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 500Q))
(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 (\PROCINIT)))
(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)
(NIL 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) (* 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)
(NIL 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))
(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)
))
]
(* User entries)
(DEFINEQ
(PROCESSWORLD
[LAMBDA (FLG) (* bvm: "31-JUL-83 17:21")
(* 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]
((IN.PROCESSP)
(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)))
[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 \PROCUNWINDTHESE)
[SETQ \PROCESSES (for P in \PROCESSES collect P
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)
(\RELEASE.PROCESS P)
T)
(T (COND
((OR (fetch PROCRESETVARSLST of P)
(fetch PROCDRIBBLEOFD of P))
(* Need to RESETRESTORE once processworld back on)
(push \PROCUNWINDTHESE P)))
(replace PROCDELETED of P with T)
(\RELEASE.PROCESS P)
NIL]
(for P in \PROCESSES
do (* Bring it back to life)
(\MAKE.PROCESS0 (fetch PROCFORM of P)
P)
(\RUN.PROCESS P))
(COND
((NOT (FIND.PROCESS (QUOTE BACKGROUND)))
(ADD.PROCESS (QUOTE (\BACKGROUND.PROCESS))
(QUOTE NAME)
(QUOTE BACKGROUND)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE SCHEDULE)
T)))
(COND
([AND TOPW (NOT (FIND.PROCESS (QUOTE MOUSE]
(ADD.PROCESS (QUOTE (\MOUSE.PROCESS))
(QUOTE NAME)
(QUOTE MOUSE)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE SCHEDULE)
T)))
(COND
((NOT (FIND.PROCESS (QUOTE TIMER)))
(SETQ \TIMERQHEAD (ADD.PROCESS (QUOTE (\TIMER.PROCESS))
(QUOTE NAME)
(QUOTE TIMER)
(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]
[SETQ \OLD.TTY.PROCESS (COND
((NOT (FMEMB \TTY.PROCESS \PROCESSES)) (* Old tty process died)
(PROG1 \TTY.PROCESS (SETQ \TTY.PROCESS EXECPROC]
(COND
((TYPENAMEP \TopLevelTtyWindow (QUOTE WINDOW))
(replace PROCWINDOW of \TTY.PROCESS with \TopLevelTtyWindow)
(WINDOWPROP \TopLevelTtyWindow (QUOTE PROCESS)
\TTY.PROCESS))) (* 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: "24-JUL-83 16:10")
(PROG ((FORM (ARG ARGS 1))
(PRIORITY PROC.DEFAULT.PRIORITY)
(CREATENOW (THIS.PROCESS))
RESTARTFLG SYSTEMP SUSPENDIT INFOHOOK WINDOW NAME AFTEREXIT PROC USERPROPS PROP VALUE
BEFOREEXIT TTYENTRYFN TTYEXITFN)
[COND
((EQ ARGS 2) (* Backward compatibility)
(SETQ NAME (ARG ARGS 2)))
((AND (EQ ARGS 3)
(FMEMB (ARG ARGS 3)
(QUOTE (SYSTEM NO T)))
(NEQ (ARG ARGS 2)
(QUOTE RESTARTABLE)))
(SETQ NAME (ARG ARGS 2))
(SETQ RESTARTFLG (ARG ARGS 3)))
(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))
(RESTARTABLE (SETQ RESTARTFLG VALUE))
(SCHEDULE (SETQ CREATENOW T))
(SUSPEND (SETQ SUSPENDIT VALUE))
(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)))
(SETQ PROC (create PROCESS
PROCNAME ←[\UNIQUE.PROCESS.NAME (OR NAME (CAR (LISTP FORM]
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))
(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: " 6-MAY-83 00:30")
(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 (* Diddle P's stack so that it looks like BLOCK will
return to \MAKE.PROCESS0)
(PROG ((FX (fetch PROCFX of P)))
SCNLP
(COND
((ZEROP (SETQ FX (fetch (FX CLINK) of FX)))
(LISPERROR "ILLEGAL STACK ARG" (QUOTE \MAKE.PROCESS0)))
((NEQ (fetch (FX FRAMENAME) of FX)
(QUOTE \MAKE.PROCESS0))
(GO SCNLP)))
(\MAKESTACKP (fetch MYSTACK of P)
FX))
(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])
)
(DEFINEQ
(THIS.PROCESS
[LAMBDA NIL (* bvm: " 4-MAY-83 13:47")
\RUNNING.PROCESS])
(TTY.PROCESS
[LAMBDA (PROC) (* bvm: "14-AUG-83 17:51")
(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
((OR (fetch PROCDELETED of NEWTTY)
(fetch PROCBEINGDELETED of NEWTTY))
(* Ordinarily would error, but this can easily happen
from a RESETFORM)
(RETURN)))
(COND
((NEQ NEWTTY OLDTTY)
[COND
(\CARET (* CARET currently global, but this will be fixed
sometime)
(COND
([AND (HASTTYWINDOWP OLDTTY)
(OPENWP (WFROMDS (SETQ OLDTTYDS (PROCESS.TTY OLDTTY]
(AND \CARETFLG (\SHOWCARET OLDTTYDS))
(SETQ \CARETDOWN T]
[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) (* bvm: "24-JUL-83 23:32")
(* default WINDOWENTRYFN which gives the tty to the
process associated with this window and calls its
BUTTONEVENTFN)
(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.SWITCH.TO.WINDOW
[LAMBDA (WINDOW DONTRETURN) (* bvm: "26-JUL-83 11:57")
(* OBSOLETE. This version only for feeble attempt at
backward compatibility)
(* Buttoneventfn for an idle window.
DONTRETURN means not to bother saving state of current
window, since it will go away)
(PROG (NEWPROC FN IDLEFN)
(COND
[WINDOW (SETQ NEWPROC (WINDOWPROP WINDOW (QUOTE PROCESS]
(T (TTY.PROCESS T)
(RETURN)))
[PROCESSPROP NEWPROC (QUOTE TTYEXITFN)
(FUNCTION (LAMBDA (PROCESS)
(PROG [(WINDOW (PROCESSPROP PROCESS (QUOTE WINDOW]
(AND WINDOW (APPLY* (OR (WINDOWPROP WINDOW (QUOTE PROCESS.EXITFN))
(FUNCTION NILL))
WINDOW]
[PROCESSPROP NEWPROC (QUOTE TTYENTRYFN)
(FUNCTION (LAMBDA (PROCESS)
(PROG [(WINDOW (PROCESSPROP PROCESS (QUOTE WINDOW]
(AND WINDOW (APPLY* (OR (WINDOWPROP WINDOW (QUOTE PROCESS.ENTRYFN))
(FUNCTION NILL))
WINDOW]
[WINDOWPROP WINDOW (QUOTE WINDOWENTRYFN)
(FUNCTION (LAMBDA (WINDOW)
(APPLY* (OR (WINDOWPROP WINDOW (QUOTE PROCESS.IDLEFN))
(FUNCTION GIVE.TTY.PROCESS))
WINDOW]
[COND
([AND (NEQ (SETQ FN (WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(WINDOWPROP WINDOW (QUOTE OLDBUTTONEVENTFN)
NIL)))
(QUOTE PROCESS.SWITCH.TO.WINDOW))
FN
(NEQ FN (WINDOWPROP WINDOW (QUOTE PROCESS.IDLEFN]
(* Oops, new window was not set up for this)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(COND
((EQ FN (QUOTE PROCESS.SWITCH.TO.WINDOW))
(* shouldn't happen, but confusion does occur...)
(QUOTE TOTOPW))
(T FN]
(COND
((NOT (AND (type? PROCESS NEWPROC)
(ALIVEPROCP NEWPROC)))
(RETURN)))
(TTY.PROCESS NEWPROC)
(RETURN WINDOW])
(PROCESS.PREPARE.FOR.INPUT
[LAMBDA NIL (* bvm: " 7-AUG-83 17:43")
(* * Ensures that current process can take input. Blocks if necesary until it becomes tty process)
(COND
((NEQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE))
(COND
((NOT (TTY.PROCESSP))
(\GETOFD T (QUOTE INPUT)) (* Make sure process has a tty window)
(TOTOPW (TTYDISPLAYSTREAM))
(WAIT.FOR.TTY)))
T)
(T (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])
(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: " 7-AUG-83 17:43")
(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 RESTARTABLE of MOUSEPROC with NIL)
(replace PROCSYSTEMP of MOUSEPROC with NIL)))
(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 NIL (* bvm: " 5-MAY-83 12:43")
(until (TTY.PROCESSP) do (AWAIT.EVENT \TTY.PROCESS.EVENT])
)
(DEFINEQ
(PROCESSPROP
[LAMBDA ARGS (* bvm: "17-AUG-83 13:04")
(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))
(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)))
[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))
(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 (CDDR 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 (FORM . PROPS&VALUES))
(* Temporary)
(DEFINEQ
(KILL.ME
[LAMBDA NIL (* bvm: "17-SEP-82 12:08")
(PROCESS.RETURN])
)
(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])
(PUTPROPS PREEMPT.KEYBOARD MACRO ((X . Y)
(RESETFORM (TTY.PROCESS (THIS.PROCESS))
X . Y)))
(PUTPROPS WITHOUT.PROCESSES MACRO ((X . Y)
([LAMBDA (#MYHANDLE# #INHIBIT.SCHEDULING#)
(* Rebind #MYHANDLE# to inhibit process switching)
(DECLARE (SPECVARS #MYHANDLE# #INHIBIT.SCHEDULING#))
(RESETVARS ((\RUNNING.PROCESS))
(RETURN (PROGN X . Y]
NIL T)))
)
(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: "31-JUL-83 16:58")
(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: "31-JUL-83 16:58")
(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
(ADDTOVAR 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)
))
]
(/DECLAREDATATYPE (QUOTE EVENT)
(QUOTE (FLAG (BITS 7)
POINTER POINTER)))
)
(/DECLAREDATATYPE (QUOTE EVENT)
(QUOTE (FLAG (BITS 7)
POINTER POINTER)))
[ADDTOVAR SYSTEMRECLST
(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)
))
]
(DEFINEQ
(CREATE.EVENT
[LAMBDA (NAME) (* bvm: " 5-MAY-83 11:00")
(create EVENT
EVENTNAME ← NAME])
(NOTIFY.EVENT
[LAMBDA (EVENT ONCEONLY) (* bvm: " 5-MAY-83 11:08")
(* 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 (fetch EVENTQUEUETAIL of EVENT))
(SETQ PROC (fetch PROCEVENTLINK of TAIL))
[COND
((EQ PROC TAIL)
(replace 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)
(replace 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: " 5-MAY-83 11:38")
(* Remove PROC from EVENT's queue. EVENT and MONITORLOCK queues consist of a pointer to the last item in the
queue, which in turn points to the first item)
(PROG ((TAIL (ffetch EVENTQUEUETAIL of EVENT))
NEXT)
[COND
((NOT TAIL)
(RAID "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 EVENTQUEUETAIL of EVENT with NIL))
(T (replace PROCEVENTLINK of TAIL with (fetch PROCEVENTLINK of PROC))
(COND
((EQ PROC (fetch EVENTQUEUETAIL of EVENT))
(freplace EVENTQUEUETAIL of EVENT with (fetch PROCEVENTLINK of PROC]
(replace PROCEVENTORLOCK of PROC with NIL)
(replace PROCEVENTLINK of PROC with NIL])
)
(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 )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \TTY.PROCESS.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) (* 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)
))
]
(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) (* bvm: " 8-MAY-83 15:59")
(COND
((EQ LOCK (QUOTE OLDVALUE)) (* Hack for RESETSAVE)
(SETQ LOCK OLDVALUE)))
(SETQ LOCK (\DTEST LOCK (QUOTE MONITORLOCK)))
(UNINTERRUPTABLY
[PROG ((OWNER (fetch MLOCKOWNER of LOCK))
(ME (THIS.PROCESS))
TAIL PREV NEXTPROC)
(COND
((OR (NULL OWNER)
(NEQ OWNER ME))
(RETURN)))
(replace MLOCKOWNER of LOCK with NIL) (* Now remove LOCK from my list of owned locks)
[COND
((EQ (SETQ PREV (fetch PROCOWNEDLOCKS of ME))
LOCK)
(replace PROCOWNEDLOCKS of ME with (fetch MLOCKLINK of LOCK)))
(T (do (COND
((NULL PREV)
(RETURN (RAID "Lock not found among owner's owned locks" LOCK)))
[(EQ (fetch MLOCKLINK of PREV)
LOCK)
(RETURN (replace MLOCKLINK of PREV with (fetch MLOCKLINK of LOCK]
(T (SETQ PREV (fetch MLOCKLINK of PREV]
(replace MLOCKLINK of LOCK with NIL)
(COND
((SETQ TAIL (fetch MLOCKQUEUETAIL of LOCK))
(SETQ NEXTPROC (fetch PROCEVENTLINK of TAIL))
[COND
((EQ NEXTPROC TAIL) (* Only one process in queue)
(replace 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: "31-JUL-83 16:43")
(DECLARE (LOCALVARS . T)
(SPECVARS #MYHANDLE# #FORM# HELPFLAG \CURRENTDISPLAYLINE \#DISPLAYLINES \LINEBUF.OFD
\PRIMIN.OFD \PRIMREADTABLE \PRIMTERMTABLE \PRIMTERMSA TtyDisplayStream
\TERM.OFD \TTYWINDOW \PRIMOUT.OFD \DRIBBLE.OFD)
(GLOBALVARS \DEFAULTLINEBUF \DEFAULTTTYDISPLAYSTREAM))
(PROG ((\INTERRUPTABLE T)
(#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)
\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 \PROCMOVEFRAME)) (* 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#)
LP [COND
((OR RESETVARSLST \DRIBBLE.OFD (fetch PROCOWNEDLOCKS of #MYHANDLE#))
(* Unwind anything left from last invocation)
(\PROCESS.UNWINDALL (QUOTE HARDRESET]
[COND
([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)))
((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])
(\PROCMOVEFRAME
[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) (* bvm: "31-JUL-83 16:30")
(PROG ((EVENT (fetch PROCEVENTORLOCK of PROC))
WINDOW)
(RELSTK (fetch MYSTACK of PROC))
(COND
(EVENT (\UNQUEUE.EVENT PROC EVENT)))
(COND
((fetch PROCTIMERSET of PROC)
(\UNQUEUE.TIMER PROC T)))
(COND
[KILLIT (SETQ NOCLEARSTKLST (DREMOVE (fetch MYSTACK of PROC)
NOCLEARSTKLST))
(SETQ \PROCESSES (DREMOVE PROC \PROCESSES))
(\INVALIDATE.PROCESS.WINDOW)
(replace PROCDELETED of PROC with T)
(replace PROCSTATUS of PROC with \PSTAT.DELETED)
(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])
(\PROCESS.BLOCK
[LAMBDA (MSECSWAIT TIMER) (* bvm: "24-JUL-83 15:46")
(\CALLME (QUOTE BLOCK))
(* 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))
(RAID "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)
(\NONPROCDISMISS MSECSWAIT)
NIL)
(T (AND TOPW (WINDOW.MOUSE.HANDLER))
(for FN in BACKGROUNDFNS do (SPREADAPPLY* FN))
NIL])
(\MAYBEBLOCK
[LAMBDA NIL (* bvm: "21-JUN-83 16:01")
(COND
(\INTERRUPTABLE (BLOCK])
(\PROC.ERROR
[LAMBDA (MESS1 MESS2 REST) (* bvm: "22-MAR-82 21:55")
(* For handling unexpected process errors. MESS1 and MESS2 are args to HELP. REST is an optional list elaborating
the error. Calls RAID, from which, if user types ↑T, we fall into a HELP break with process switching turned off)
(COND
([RAID (CONS MESS1 (AND (OR MESS2 REST)
(CONS MESS2 REST]
(WITHOUT.PROCESSES (HELP MESS1 MESS2])
(\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: "26-JUL-83 12:23")
(DECLARE (SPECVARS \OLDTTY))
(PROG (\OLDTTY)
LP (WINDOW.MOUSE.HANDLER)
(COND
((TTY.PROCESSP)
(TTY.PROCESS \OLDTTY)
(SETQ \OLDTTY)))
[COND
((NEQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE)) (* A new mouse process sprung up while we were hung)
(COND
((FIND.PROCESS (QUOTE MOUSE)) (* Quietly die)
(PROCESS.RETURN))
(T (replace PROCNAME of (THIS.PROCESS) with (QUOTE MOUSE]
(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: "22-JUL-83 16:21")
(\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)))
(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])
(\PROC.AFTER.HARDRESET
[LAMBDA NIL (* bvm: "31-JUL-83 17:16")
(DECLARE (LOCALVARS . T)
(SPECVARS \CURRENTDISPLAYLINE \#DISPLAYLINES \LINEBUF.OFD \PRIMIN.OFD \PRIMREADTABLE
\PRIMTERMTABLE \PRIMTERMSA TtyDisplayStream \TERM.OFD \PRIMOUT.OFD
\DRIBBLE.OFD)
(GLOBALVARS \DEFAULTLINEBUF \DEFAULTTTYDISPLAYSTREAM))
(* This fn takes care of unwinding the RESETxxx expressions of any process that did not survive a HARDRESET.
All these vars get bound here so that we look sort of like we're under \MAKE.PROCESS0)
(PROG ((\CURRENTDISPLAYLINE 0)
(\#DISPLAYLINES 40)
(\LINEBUF.OFD \DEFAULTLINEBUF)
(\PRIMREADTABLE \PRIMREADTABLE)
(\PRIMTERMTABLE \PRIMTERMTABLE)
(\PRIMTERMSA \PRIMTERMSA)
(TtyDisplayStream \DEFAULTTTYDISPLAYSTREAM)
(\PRIMIN.OFD \DEFAULTLINEBUF)
\PRIMOUT.OFD \TERM.OFD \DRIBBLE.OFD)
[SETQ \TERM.OFD (SETQ \PRIMOUT.OFD (\GETOFD TtyDisplayStream (QUOTE OUTPUT]
[COND
((AND \OLD.TTY.PROCESS (fetch PROCTTYEXITFN of \OLD.TTY.PROCESS))
(* TTY process before a HARDRESET might have had some
cleaning up to do)
(NLSETQ (APPLY* (fetch PROCTTYEXITFN of \OLD.TTY.PROCESS)
\OLD.TTY.PROCESS \TTY.PROCESS]
(while \PROCUNWINDTHESE
do
(* Unwind these guys that were implicitly DEL.PROCESS'ed by the HARDRESET. Do it here while processes are on,
since they might need such things as file operations)
(\PROC.RESETRESTORE (pop \PROCUNWINDTHESE])
(\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: "25-JUL-83 00:49")
(* * Coerces NAME to one not in use by any active process)
(OR (LITATOM NAME)
(SETQ NAME (MKATOM NAME)))
[COND
((OR (EQ NAME T)
(NULL NAME)
(FIND.PROCESS NAME))
(for I from 2 bind (FIRSTNAME ← NAME) while (FIND.PROCESS (SETQ NAME (PACK* FIRSTNAME
(QUOTE #)
I]
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: "22-JUN-83 10:42")
(* 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 (RAID "Inconsistent process queue state"]
(T (replace NEXTPROCHANDLE of PREV with (replace PQNEXT of HEAD
with (OR (fetch NEXTPROCHANDLE
of PROC)
(RAID
"Running process has no NEXT pointer"
PROC]
(replace NEXTPROCHANDLE of PROC with NIL)
(COND
(EVLOCK (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 EVENTQUEUETAIL of EVLOCK))
(PROG1 (fetch PROCEVENTLINK of TAIL)
(replace PROCEVENTLINK of TAIL with PROC)))
(T PROC)))
(freplace EVENTQUEUETAIL of EVLOCK with PROC)))
(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])])
(\RUN.PROCESS
[LAMBDA (PROC REASON BRUTALLY) (* bvm: " 5-MAY-83 11:29")
(* 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)
(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
(PREV (replace NEXTPROCHANDLE of PROC with (fetch NEXTPROCHANDLE of PREV))
(replace NEXTPROCHANDLE of PREV with PROC)
(replace PQLAST of PQUEUE with PROC))
(T (* 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]
(replace PROCSTATUS of PROC with \PSTAT.RUNNING)
(replace WAKEREASON of PROC with REASON))])
(\FLUSH.PROCESS
[LAMBDA (PROC) (* bvm: "25-JUL-83 00:49")
[COND
((EQ PROC (TTY.PROCESS))
(TTY.PROCESS (FIND.PROCESS (COND
((EQ (fetch PROCNAME of PROC)
(QUOTE EXEC))
(QUOTE MOUSE))
(T (QUOTE EXEC]
(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
((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) (* bvm: " 5-MAY-83 11:30")
(UNINTERRUPTABLY
[PROG (PQHEAD PREV EVENT 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)
(RAID "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 EVENT (fetch PROCEVENTORLOCK of PROC))
(\UNQUEUE.EVENT 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: " 1-AUG-83 15:54")
(* Place PROC on the timer queue.
Queue is ordered by timeout, so that the first item will
timeout first)
(UNINTERRUPTABLY
(PROG ((TIMER (fetch PROCWAKEUPTIMER of PROC))
(PREV \TIMERQHEAD)
NEXT)
LP (SETQ NEXT (fetch PROCTIMERLINK of PREV))
(COND
((AND NEXT (ILESSP (fetch PROCWAKEUPTIMER of NEXT)
TIMER)) (* NEXT will timeout before PROC, so keep going.
Problem: this fails when the clock wraps around)
(SETQ NEXT (fetch PROCTIMERLINK of (SETQ PREV NEXT)))
(GO LP)))
(* * 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) (* bvm: " 2-MAY-83 15:21")
(* 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)
(COND
(OLDPROC (SETQ FROMFX (fetch PROCFX of OLDPROC))
(COND
((NOT (fetch (FX INVALIDP)
of FROMFX))
(* Release (fetch MYSTACK of OLDPROC) if it hasn't been
yet)
(\DECUSECOUNT FROMFX)))
(replace PROCFX of OLDPROC
with (\MYALINK))
(replace PROCFX of PROC with 0)
(\RESUME TOFX))
(T (* no OLDPROC to resume later, just return to the new
proc)
(\SMASHLINK NIL TOFX TOFX]
(RETURN (fetch WAKEREASON of PROC)))
((SETQ PQUEUE (fetch PQLOWER of PQUEUE))
(GO LP))
(T (* nobody runnable, wait for events)
(RAID "No runnable process!!" OLDPROC)
(GO TOP])
)
)
(DEFINEQ
(\PROCINIT
[LAMBDA (DONTRESET) (* bvm: "24-JUL-83 17:36")
(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 DISMISS)
(QUOTE \NONPROCDISMISS))
(MOVD (QUOTE \PROCESS.BLOCK)
(QUOTE \BACKGROUND))
(MOVD (QUOTE \PROCESS.BLOCK)
(QUOTE BLOCK))
(MOVD (QUOTE \PROCESS.BLOCK)
(QUOTE DISMISS))
(OR DONTRESET (HARDRESET])
(\PROCESS.EVENTFN
[LAMBDA (DEV EVENTNAME) (* bvm: "22-JUN-83 10:28")
(SELECTQ EVENTNAME
[(AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS)
(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)
(COND
((NEQ (fetch PROCSTATUS of PROC)
\PSTAT.RUNNING)
(\RUN.PROCESS PROC)))
(PROCESS.APPLY PROC (FUNCTION \PROCESS.GO.TO.SLEEP)
(LIST ACTION)))
((fetch PROCTIMERSET of PROC)
(* If PROC had a timeout, run it, since time over exit is arbitrary. If we didn't do this, the clocks could be set
such that the timeout would look exceedingly large)
(\RUN.PROCESS PROC]
((BEFOREMAKESYS BEFORELOGOUT BEFORESYSOUT))
NIL])
(\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: "21-APR-83 13:42")
(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])
)
(* Redefinitions)
(DEFINEQ
(\PROC.CODEFORTFRAME
[LAMBDA NIL (* bvm: " 4-MAY-83 13:49")
(\CALLME T)
(SETQ \RUNNING.PROCESS)
(CLEARSTK (QUOTE **CLEAR**))
(\TURN.ON.PROCESSES)
(INITIALEVALQT)
(PROG NIL
LP (\REPEATEDLYEVALQT)
(GO LP])
(\PROC.REPEATEDLYEVALQT
[LAMBDA NIL (* bvm: "31-JUL-83 17:16")
(DECLARE (GLOBALVARS \TopLevelTtyWindow))
(\CALLME (QUOTE \REPEATEDLYEVALQT))
(INITIALEVALQT)
(PROG NIL
(COND
((OR \PROCUNWINDTHESE \OLD.TTY.PROCESS)
(\PROC.AFTER.HARDRESET)))
(TTYDISPLAYSTREAM \TopLevelTtyWindow)
(OUTPUT T)
(INPUT T)
LP (\RESETSYSTEMSTATE)
(EVALQT)
(GO LP])
)
(* Temporary until this fix is in the system)
(DEFINEQ
(\SETFVARSLOT
[LAMBDA (VAR NEWBINDING) (* bvm: "23-MAR-83 23:29")
(* Sets the freevar binding slot of VAR in caller's
frame to point at NEWBINDING)
(PROG ((FX (\MYALINK))
(ATOM# (\ATOMVALINDEX VAR))
NTSIZE A VARINFO NT)
(SETQ NT (fetch (FX NAMETABLE) of FX))
(SETQ NTSIZE (fetch (FNHEADER NTSIZE) of NT))
(SETQ NT (\ADDBASE NT (fetch (FNHEADER OVERHEADWORDS) of T)))
TABLELP
(COND
((ZEROP (SETQ A (\GETBASE NT 0))) (* End of name table)
(ERROR "Binding slot not found in caller's frame" VAR))
((AND (EQ A ATOM#)
(EQ (fetch (NAMETABLESLOT VARTYPE) of (SETQ VARINFO (\ADDBASE NT NTSIZE)))
\NT.FVAR))
(replace (FVARSLOT BINDINGPTR) of (ADDSTACKBASE (IPLUS (UNFOLD (fetch (NAMETABLESLOT
VAROFFSET)
of VARINFO)
WORDSPERCELL)
(fetch (FX FIRSTPVAR)
of FX)))
with NEWBINDING)
(RETURN NEWBINDING)))
(SETQ NT (\ADDBASE NT 1))
(GO TABLELP])
)
(DECLARE: DONTCOPY
(* Fix this on LLSTK)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD FVARSLOT ((BINDLO WORD)
(BINDHI1 BYTE)
(BINDHI2 BYTE))
[ACCESSFNS FVARSLOT ((LOOKEDUP (EVENP (fetch BINDLO of DATUM)))
(BINDINGPTR (\VAG2 (fetch BINDHI1 of DATUM)
(fetch BINDLO of DATUM))
(PROGN (replace BINDLO of DATUM with (\LOLOC NEWVALUE))
(replace BINDHI1 of DATUM
with (replace BINDHI2 of DATUM
with (\HILOC NEWVALUE])
]
)
(* 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: "21-JUN-83 16:53")
(* * 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))
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
((ZEROP FRAME)
(RAID "PROC confused: trying to call a fn in a nonexistent process" FN))
(T (RAID
"PROC confused: a process other than the running one is in uninterruptable region"
FRAME]
[OR (SETQ NEWFRAME (\MISCAPPLY*(FUNCTION \PROCESS.MAKEFRAME0)
FRAME
(CONS FN ARGS)))
(RETURN (COND
(FLG (RAID "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: "22-JUN-83 12:07")
(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 24Q WORDSPERCELL)
(* Extra slop)
))
FRAME))
(IPLUS FREE (fetch (FSB SIZE) of FREE))
FRAME FRAME ARGS)
(RAID "Failed to build frame for PROCESS use" FN])
)
(RPAQ? #MYHANDLE# )
(RPAQ? \TTY.PROCESS )
(RPAQ? #SCHEDULER# )
(RPAQ? #INHIBIT.SCHEDULING# )
(RPAQ? \RUNNING.PROCESS )
(RPAQ? \PROCESSES )
(RPAQ? FUNNNYPROCS )
(RPAQ? PROCESS.MAXMOUSE 5)
(RPAQ? PROC.FREESPACESIZE 2000Q)
(RPAQ? AUTOPROCESSFLG T)
(RPAQ? BACKGROUNDFNS )
(RPAQ? \PROCUNWINDTHESE )
(RPAQ? \TIMERQHEAD )
(RPAQ? \HIGHEST.PRIORITY.QUEUE )
(RPAQ? PROC.DEFAULT.PRIORITY 2)
(RPAQ? \DEFAULTLINEBUF )
(RPAQ? \DEFAULTTTYDISPLAYSTREAM )
(RPAQ? TOPW )
(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
(ADDTOVAR GLOBALVARS \RUNNING.PROCESS \TTY.PROCESS \PROC.RESTARTME \PROC.RESETME)
)
(* END EXPORTED DEFINITIONS)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \PROCESSES PROC.FREESPACESIZE NOCLEARSTKLST #SCHEDULER# PROCESS.MAXMOUSE
AUTOPROCESSFLG BACKGROUNDFNS \PROCUNWINDTHESE \OLD.TTY.PROCESS)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \TIMERQHEAD \HIGHEST.PRIORITY.QUEUE PROC.DEFAULT.PRIORITY)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS ALIVEPROCP MACRO ((p)
(NOT (DEADPROCP p))))
(PUTPROPS DEADPROCP MACRO ((p)
(fetch PROCDELETED of p)))
(PUTPROPS IN.PROCESSP MACRO (NIL (OR \RUNNING.PROCESS #INHIBIT.SCHEDULING#)))
(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 . T)
)
)
(* Debugging)
(DEFINEQ
(\CHECK.PQUEUE
[LAMBDA (P THISP) (* bvm: " 4-MAY-83 16:47")
[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))
(WITHOUT.PROCESSES (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: "17-AUG-83 12:46")
(* added WHERE as a means of specifying where the
initial window should go.)
(PROG ((PROCS (for P in \PROCESSES collect (fetch PROCNAME of P)))
HEIGHT WIDTH REG)
(COND
((WINDOWP PROCESS.STATUS.WINDOW)
(AND PROCMENU (DELETEMENU PROCMENU NIL PROCESS.STATUS.WINDOW))
(AND PROCOPMENU (DELETEMENU PROCOPMENU NIL PROCESS.STATUS.WINDOW))
(CLEARW PROCESS.STATUS.WINDOW)))
(SETQ PROCMENU (create MENU
ITEMS ← PROCS
WHENSELECTEDFN ←(QUOTE PROC.SELECTED)
MENUFONT ←(FONTCREATE (QUOTE GACHA)
12Q)
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 PROCMENU)
(fetch IMAGEHEIGHT of PROCOPMENU)
4)))
[SETQ WIDTH (WIDTHIFWINDOW (IMAX (fetch IMAGEWIDTH of PROCMENU)
(fetch IMAGEWIDTH of PROCOPMENU]
[COND
((WINDOWP PROCESS.STATUS.WINDOW)
[SETQ REG (COPY (WINDOWPROP PROCESS.STATUS.WINDOW (QUOTE REGION]
(replace WIDTH of REG with WIDTH)
(replace HEIGHT of REG with HEIGHT)
[COND
((IGREATERP (IPLUS (fetch BOTTOM of REG)
HEIGHT)
SCREENHEIGHT)
(replace BOTTOM of REG with (IDIFFERENCE SCREENHEIGHT HEIGHT]
(SHAPEW PROCESS.STATUS.WINDOW REG))
(T [SETQ WHERE (COND
((POSITIONP WHERE))
(T (GETBOXPOSITION WIDTH HEIGHT]
(SETQ PROCESS.STATUS.WINDOW (CREATEW (create REGION
LEFT ←(fetch XCOORD of WHERE)
BOTTOM ←(fetch YCOORD of WHERE)
WIDTH ← WIDTH
HEIGHT ← HEIGHT]
(ADDMENU PROCOPMENU PROCESS.STATUS.WINDOW (QUOTE (0 . 0)))
(ADDMENU PROCMENU PROCESS.STATUS.WINDOW (create POSITION
XCOORD ←(IQUOTIENT (IDIFFERENCE
WIDTH
(fetch IMAGEWIDTH
of PROCMENU))
2)
YCOORD ←(IPLUS (fetch IMAGEHEIGHT
of PROCOPMENU)
4)))
[COND
(SELECTEDPROC (COND
((FMEMB SELECTEDPROC PROCS)
(SHADEITEM SELECTEDPROC PROCMENU SELECTIONSHADE))
(T (SETQ SELECTEDPROC]
(WINDOWPROP PROCESS.STATUS.WINDOW (QUOTE PROCS)
PROCS])
(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: "21-JUN-82 17:50")
(PROG (OLDBUTTONFN)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(SETQ OLDBUTTONFN (WINDOWPROP WINDOW (QUOTE OLDBUTTONEVENTFN)
NIL))) (* 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 (DSPFILL NIL LIGHTGRAYSHADE (QUOTE INVERT)
PROCESS.STATUS.WINDOW))) (* 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 500Q)
(ADDTOVAR BackgroundMenuCommands ("PSW" (QUOTE (PROCESS.STATUS.WINDOW))
"Puts up a Process Status Window"))
(SETQQ BackgroundMenu)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS PROCESS.STATUS.WINDOW PROCMENU PROCOPMENU PROCOP.WAKEMENU PROCBACKTRACEHEIGHT
SELECTEDPROC BACKTRACEFONT PROCBACKTRACEWINDOW)
)
(DECLARE: EVAL@COMPILE
(RPAQQ LIGHTGRAYSHADE 1)
(RPAQQ SELECTIONSHADE 1010Q)
(CONSTANTS LIGHTGRAYSHADE SELECTIONSHADE)
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR WINDOWUSERFORMS (\PROC.AFTER.WINDOWWORLD))
(\PROCINIT)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA PROCESSPROP ADD.PROCESS)
)
(PUTPROPS PROC COPYRIGHT ("Xerox Corporation" 3676Q 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (36227Q 70042Q (PROCESSWORLD 36241Q . 50772Q) (ADD.PROCESS 50774Q . 56150Q) (DEL.PROCESS
56152Q . 56701Q) (PROCESS.RETURN 56703Q . 57570Q) (FIND.PROCESS 57572Q . 61041Q) (MAP.PROCESSES
61043Q . 61472Q) (PROCESSP 61474Q . 61734Q) (RELPROCESSP 61736Q . 62214Q) (RESTART.PROCESS 62216Q .
64326Q) (WAKE.PROCESS 64330Q . 65541Q) (SUSPEND.PROCESS 65543Q . 66260Q) (PROCESS.RESULT 66262Q .
67423Q) (PROCESS.FINISHEDP 67425Q . 70040Q)) (70043Q 110042Q (THIS.PROCESS 70055Q . 70261Q) (
TTY.PROCESS 70263Q . 73746Q) (TTY.PROCESSP 73750Q . 74261Q) (PROCESS.TTY 74263Q . 75077Q) (
GIVE.TTY.PROCESS 75101Q . 76426Q) (PROCESS.SWITCH.TO.WINDOW 76430Q . 102663Q) (
PROCESS.PREPARE.FOR.INPUT 102665Q . 104603Q) (ALLOW.BUTTON.EVENTS 104605Q . 105161Q) (SPAWN.MOUSE
105163Q . 107243Q) (\WAIT.FOR.TTY 107245Q . 107542Q) (WAIT.FOR.TTY 107544Q . 110040Q)) (110043Q
116517Q (PROCESSPROP 110055Q . 115023Q) (PROCESS.NAME 115025Q . 115511Q) (PROCESS.WINDOW 115513Q .
116515Q)) (116733Q 117151Q (KILL.ME 116745Q . 117147Q)) (117152Q 120124Q (EVAL.AS.PROCESS 117164Q .
117536Q) (EVAL.IN.TTY.PROCESS 117540Q . 120122Q)) (121761Q 130663Q (PROCESS.READ 121773Q . 123076Q) (
PROCESS.EVALV 123100Q . 124036Q) (PROCESS.EVAL 124040Q . 125467Q) (\PROCESS.EVAL1 125471Q . 126340Q) (
PROCESS.APPLY 126342Q . 130001Q) (\PROCESS.APPLY1 130003Q . 130661Q)) (133526Q 140671Q (CREATE.EVENT
133540Q . 133773Q) (NOTIFY.EVENT 133775Q . 136345Q) (AWAIT.EVENT 136347Q . 136644Q) (\UNQUEUE.EVENT
136646Q . 140667Q)) (144652Q 154203Q (OBTAIN.MONITORLOCK 144664Q . 147757Q) (CREATE.MONITORLOCK
147761Q . 150276Q) (RELEASE.MONITORLOCK 150300Q . 153540Q) (MONITOR.AWAIT.EVENT 153542Q . 154201Q)) (
155054Q 214316Q (\MAKE.PROCESS0 155066Q . 164615Q) (\PROCMOVEFRAME 164617Q . 173561Q) (
\RELEASE.PROCESS 173563Q . 176110Q) (\PROCESS.BLOCK 176112Q . 200710Q) (\MAYBEBLOCK 200712Q . 201137Q)
(\PROC.ERROR 201141Q . 202105Q) (\BACKGROUND.PROCESS 202107Q . 202463Q) (\MOUSE.PROCESS 202465Q .
203761Q) (\TIMER.PROCESS 203763Q . 205051Q) (\PROC.RESETRESTORE 205053Q . 206344Q) (
\PROC.AFTER.HARDRESET 206346Q . 211575Q) (\PROCESS.UNWINDALL 211577Q . 213351Q) (\UNIQUE.PROCESS.NAME
213353Q . 214314Q)) (214317Q 240123Q (\START.PROCESSES 214331Q . 214604Q) (\PROCESS.GO.TO.SLEEP
214606Q . 222242Q) (\RUN.PROCESS 222244Q . 225147Q) (\FLUSH.PROCESS 225151Q . 230006Q) (
\SUSPEND.PROCESS 230010Q . 233235Q) (\UNQUEUE.TIMER 233237Q . 234517Q) (\ENQUEUE.TIMER 234521Q .
236447Q) (\GET.PRIORITY.QUEUE 236451Q . 240121Q)) (244014Q 251762Q (\PROCINIT 244026Q . 245344Q) (
\PROCESS.EVENTFN 245346Q . 247642Q) (\PROC.AFTER.WINDOWWORLD 247644Q . 251047Q) (\TURN.ON.PROCESSES
251051Q . 251760Q)) (252015Q 253476Q (\PROC.CODEFORTFRAME 252027Q . 252510Q) (\PROC.REPEATEDLYEVALQT
252512Q . 253474Q)) (253565Q 256105Q (\SETFVARSLOT 253577Q . 256103Q)) (257225Q 266566Q (BREAK.PROCESS
257237Q . 257703Q) (\SELECTPROCESS 257705Q . 262021Q) (\PROCESS.MAKEFRAME 262023Q . 264362Q) (
\PROCESS.MAKEFRAME0 264364Q . 266564Q)) (272636Q 275367Q (\CHECK.PQUEUE 272650Q . 275365Q)) (275370Q
325130Q (PPROC 275402Q . 277364Q) (PPROCWINDOW 277366Q . 300425Q) (PPROCREPAINTFN 300427Q . 301650Q) (
PPROCRESHAPEFN 301652Q . 302301Q) (PPROCEXTENT 302303Q . 303062Q) (PPROC1 303064Q . 305713Q) (
PROCESS.STATUS.WINDOW 305715Q . 313163Q) (PROC.SELECTED 313165Q . 313622Q) (PROCOP.SELECTED 313624Q .
317202Q) (PROCESS.BACKTRACE 317204Q . 322273Q) (\INVALIDATE.PROCESS.WINDOW 322275Q . 323663Q) (
\UPDATE.PROCESS.WINDOW 323665Q . 325126Q)))))
STOP