(FILECREATED "26-Apr-86 16:53:42" {ERIS}<LISPCORE>SOURCES>PROC.;37 162990
changes to: (FNS \MAKE.PROCESS0)
previous date: " 4-Feb-86 14:54:35" {ERIS}<LISPCORE>SOURCES>PROC.;36)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 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 PROCESS-STATUS 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
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 \DISMISSTIMER))
(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 \MAKE.PROCESS1 \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
\PROCESS.RESET.TIMERS \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)
(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)
(\SYSTEMTIMERVARS (\LASTUSERACTION SECONDS)))
(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 #SCHEDULER# PROCESS.MAXMOUSE
AUTOPROCESSFLG BACKGROUNDFNS \TopLevelTtyWindow \PROC.READY)
(GLOBALVARS \TIMERQHEAD \PROCTIMER.SCRATCH \HIGHEST.PRIORITY.QUEUE
PROC.DEFAULT.PRIORITY \PROC.RUN.NEXT.FLG \SYSTEMTIMERVARS)
(MACROS ALIVEPROCP DEADPROCP \COERCE.TO.PROCESS)
(LOCALVARS . T)))
(COMS (* Debugging)
(FNS \CHECK.PQUEUE)
(FNS PPROC PPROCWINDOW PPROCREPAINTFN PPROCRESHAPEFN PPROCEXTENT PPROC1
PROCESS.STATUS.WINDOW \PSW.SELECTED \PSWOP.SELECTED PROCESS.BACKTRACE
\INVALIDATE.PROCESS.WINDOW \UPDATE.PROCESS.WINDOW)
(INITVARS (PROCMENU)
(PROCOPMENU)
(PROCOP.WAKEMENU)
(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)
(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 ((PROCFX0 WORD) (* = \STACKHI to make this look like a
STACKP)
(PROCFX WORD) (* 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)
(PROCNEVERSTARTED FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(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)
)
PROCTIMERBOX ←(CREATECELL \FIXP)
PROCFX0 ← \STACKHI)
]
(/DECLAREDATATYPE (QUOTE PROCESS)
(QUOTE (WORD WORD BYTE POINTER BYTE POINTER BYTE POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG
FLAG 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))
(QUOTE ((PROCESS 0 (BITS . 15))
(PROCESS 1 (BITS . 15))
(PROCESS 2 (BITS . 7))
(PROCESS 2 POINTER)
(PROCESS 4 (BITS . 7))
(PROCESS 4 POINTER)
(PROCESS 6 (BITS . 7))
(PROCESS 6 POINTER)
(PROCESS 8 (FLAGBITS . 0))
(PROCESS 8 (FLAGBITS . 16))
(PROCESS 8 (FLAGBITS . 32))
(PROCESS 8 (FLAGBITS . 48))
(PROCESS 8 (FLAGBITS . 64))
(PROCESS 8 (FLAGBITS . 80))
(PROCESS 8 (FLAGBITS . 96))
(PROCESS 8 (FLAGBITS . 112))
(PROCESS 8 POINTER)
(PROCESS 10 POINTER)
(PROCESS 12 POINTER)
(PROCESS 14 POINTER)
(PROCESS 16 POINTER)
(PROCESS 18 POINTER)
(PROCESS 20 POINTER)
(PROCESS 22 POINTER)
(PROCESS 24 POINTER)
(PROCESS 26 POINTER)
(PROCESS 28 POINTER)
(PROCESS 30 POINTER)
(PROCESS 32 POINTER)
(PROCESS 34 POINTER)
(PROCESS 36 POINTER)
(PROCESS 38 POINTER)
(PROCESS 40 POINTER)
(PROCESS 42 POINTER)
(PROCESS 44 POINTER)
(PROCESS 46 POINTER)
(PROCESS 48 POINTER)
(PROCESS 50 POINTER)
(PROCESS 52 POINTER)
(PROCESS 54 POINTER)
(PROCESS 56 POINTER)
(PROCESS 58 POINTER)
(PROCESS 60 POINTER)
(PROCESS 62 POINTER)))
(QUOTE 64))
(* 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))
(QUOTE ((PROCESSQUEUE 0 (BITS . 7))
(PROCESSQUEUE 0 POINTER)
(PROCESSQUEUE 2 POINTER)
(PROCESSQUEUE 4 POINTER)
(PROCESSQUEUE 6 POINTER)))
(QUOTE 8))
(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 (WORD WORD BYTE POINTER BYTE POINTER BYTE POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG
FLAG 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))
(QUOTE ((PROCESS 0 (BITS . 15))
(PROCESS 1 (BITS . 15))
(PROCESS 2 (BITS . 7))
(PROCESS 2 POINTER)
(PROCESS 4 (BITS . 7))
(PROCESS 4 POINTER)
(PROCESS 6 (BITS . 7))
(PROCESS 6 POINTER)
(PROCESS 8 (FLAGBITS . 0))
(PROCESS 8 (FLAGBITS . 16))
(PROCESS 8 (FLAGBITS . 32))
(PROCESS 8 (FLAGBITS . 48))
(PROCESS 8 (FLAGBITS . 64))
(PROCESS 8 (FLAGBITS . 80))
(PROCESS 8 (FLAGBITS . 96))
(PROCESS 8 (FLAGBITS . 112))
(PROCESS 8 POINTER)
(PROCESS 10 POINTER)
(PROCESS 12 POINTER)
(PROCESS 14 POINTER)
(PROCESS 16 POINTER)
(PROCESS 18 POINTER)
(PROCESS 20 POINTER)
(PROCESS 22 POINTER)
(PROCESS 24 POINTER)
(PROCESS 26 POINTER)
(PROCESS 28 POINTER)
(PROCESS 30 POINTER)
(PROCESS 32 POINTER)
(PROCESS 34 POINTER)
(PROCESS 36 POINTER)
(PROCESS 38 POINTER)
(PROCESS 40 POINTER)
(PROCESS 42 POINTER)
(PROCESS 44 POINTER)
(PROCESS 46 POINTER)
(PROCESS 48 POINTER)
(PROCESS 50 POINTER)
(PROCESS 52 POINTER)
(PROCESS 54 POINTER)
(PROCESS 56 POINTER)
(PROCESS 58 POINTER)
(PROCESS 60 POINTER)
(PROCESS 62 POINTER)))
(QUOTE 64))
(/DECLAREDATATYPE (QUOTE PROCESSQUEUE)
(QUOTE (BYTE POINTER POINTER POINTER POINTER))
(QUOTE ((PROCESSQUEUE 0 (BITS . 7))
(PROCESSQUEUE 0 POINTER)
(PROCESSQUEUE 2 POINTER)
(PROCESSQUEUE 4 POINTER)
(PROCESSQUEUE 6 POINTER)))
(QUOTE 8))
[ADDTOVAR SYSTEMRECLST
(DATATYPE PROCESS ((PROCFX0 WORD)
(PROCFX WORD)
(PROCSTATUS BYTE)
(PROCNAME POINTER)
(PROCPRIORITY BYTE)
(PROCQUEUE POINTER)
(NIL BYTE)
(NEXTPROCHANDLE POINTER)
(PROCTIMERSET FLAG)
(PROCBEINGDELETED FLAG)
(PROCDELETED FLAG)
(PROCSYSTEMP FLAG)
(PROCNEVERSTARTED FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(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
(PROCESS-STATUS
[LAMBDA (POS) (* lmm " 9-Jan-86 13:29")
(LET ((POS (if POS
then (if (LITATOM POS)
then (FIND.PROCESS POS)
else POS)
else 2)))
(AND POS (LET ((STKI (\STACKARGPTR POS)))
(do (SELECTQ (fetch (FX FRAMENAME) of STKI)
((\INTERRUPTFRAME \INTERRUPTED INTERRUPTED \DOINTERRUPTHERE
\PERIODIC.INTERRUPTFRAME ERRORSET)
(* Skip over these)
(SETQ STKI (fetch (FX CLINK) of STKI)))
((\GETCHAR \GETKEY \TTYBACKGROUND GETMOUSESTATE MENU.HANDLER)
(RETURN (QUOTE IO.WAIT)))
((BLOCK \BACKGROUND AWAIT.EVENT MONITOR.AWAIT.EVENT
\PROCESS.GO.TO.SLEEP)
(* Forms of blocking)
(RETURN (QUOTE WAITING)))
(RETURN (QUOTE RUNNING])
(PROCESSWORLD
[LAMBDA (FLG) (* kbr: "31-Jan-86 15:35")
(* 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# (NEQ 0 (fetch PROCFX of #SCHEDULER#)))
(RETTO (PROG1 #SCHEDULER# (SETQ #SCHEDULER#))
PSTAT.QUIT T]
(\RUNNING.PROCESS (QUOTE (Processes are already on)))
(T (PROG (EXECPROC)
(COND
((NOT (type? PROCESS #SCHEDULER#))
(SETQ #SCHEDULER# (create PROCESS)))
(T (replace PROCFX of #SCHEDULER# with 0)))
(* 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)
((fetch PROCNEVERSTARTED of P)
(* Process got created when scheduling
was off)
(replace PROCNEVERSTARTED of P with NIL)
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
((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: " 9-Jun-85 16:44")
(PROG ((CREATENOW (THIS.PROCESS))
(PRIORITY PROC.DEFAULT.PRIORITY)
FORM RESTARTFLG SYSTEMP SUSPENDIT INFOHOOK RESTARTFORM WINDOW NAME AFTEREXIT PROC
USERPROPS PROP VALUE BEFOREEXIT TTYENTRYFN TTYEXITFN)
[COND
([OR (EQ ARGS 0)
(NLISTP (SETQ FORM (ARG ARGS 1]
(RETURN (\ILLEGAL.ARG FORM]
[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)))
[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)))
(T (replace PROCNEVERSTARTED of PROC with T))))
(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: " 8-Jun-85 23:03")
(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 P FX))
((fetch (FX INVALIDP) of (SETQ FX (fetch (FX CLINK) of FX)))
(ERROR "Process's stack is malformed" P))
(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])
)
(DEFINEQ
(THIS.PROCESS
[LAMBDA NIL (* bvm: " 4-MAY-83 13:47")
\RUNNING.PROCESS])
(TTY.PROCESS
[LAMBDA (PROC) (* lmm "21-Apr-85 15:55")
(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]
(LET ((KEYACTION (OR (PROCESSPROP NEWTTY (QUOTE KEYACTION))
\DEFAULTKEYACTION)))
(UNINTERRUPTABLY
(COND
((SETQ FN (fetch PROCTTYEXITFN of OLDTTY))
(APPLY* FN OLDTTY NEWTTY)))
(SETQ \TTY.PROCESS NEWTTY)
(SETQ \CURRENTKEYACTION KEYACTION)
(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) (* lmm "20-Jan-86 23:51")
(* returns the TTY for a process)
(COND
((OR (NULL PROC)
(EQ (SETQ PROC (\COERCE.TO.PROCESS PROC))
(THIS.PROCESS)))
\TERM.OFD)
(PROC (PROCESS.EVALV PROC (QUOTE \TERM.OFD])
(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])
(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) (* kbr: "29-Jan-86 12:59")
(* * 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) (* bvm: " 5-Nov-85 10:52")
(PROG (DTIMER)
[SETQ DTIMER (COND
[MSECSWAIT (SETUPTIMER (IMIN MSECSWAIT MAX.FIXP)
(OR TIMER (GETRESOURCE \DISMISSTIMER]
(TIMER (\DTEST TIMER (QUOTE FIXP)))
(T (RETURN (BLOCK]
(COND
((NOT (THIS.PROCESS)) (* Process world off)
(SETQ NOBLOCK T)))
(do (OR NOBLOCK (\PROCESS.GO.TO.SLEEP NIL DTIMER T)) until (TIMEREXPIRED? DTIMER))
(OR TIMER (FREERESOURCE \DISMISSTIMER DTIMER)))
MSECSWAIT])
(BLOCK
[LAMBDA (MSECSWAIT TIMER) (* kbr: " 1-Feb-86 12:12")
(* 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)))
((FIXP MSECSWAIT)
(IMIN MSECSWAIT MAX.FIXP)))
(NEQ TIMER NIL]
((FIXP MSECSWAIT) (* Not scheduling; act like DISMISS)
(DISMISS MSECSWAIT T)
NIL)
(T (AND \WINDOWWORLD (WINDOW.MOUSE.HANDLER))
(for FN in BACKGROUNDFNS do (SPREADAPPLY* FN))
NIL])
(WAITFORINPUT
[LAMBDA (N) (* bvm: "24-Jul-85 12:21")
(COND
[(FIXP N)
(GLOBALRESOURCE (\DISMISSTIMER)
(PROG ((NOW (\CLOCK0 \DISMISSTIMER))
(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 (STREAM ←(\GETSTREAM N (QUOTE INPUT))) until (OR (READP T)
(READP STREAM)) do (\TTYBACKGROUND))
)
(T (until (READP T) do (\TTYBACKGROUND])
(\WAITFORSYSBUFP
[LAMBDA (N) (* bvm: "24-Jul-85 12:22")
(COND
[(FIXP N)
(GLOBALRESOURCE (\DISMISSTIMER)
(PROG ((NOW (\CLOCK0 \DISMISSTIMER)))
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 \DISMISSTIMER)
(QUOTE RESOURCES)
(QUOTE (NEW (SETUPTIMER 0]
)
)
(/SETTOPVAL (QUOTE \\DISMISSTIMER.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: " 8-Jun-85 23:08")
(LET ((P (\COERCE.TO.PROCESS PROC T))
ME)
(COND
((OR (NULL (\DTEST VAR (QUOTE LITATOM)))
(EQ VAR T))
VAR)
(T [COND
((NEQ P (THIS.PROCESS))
(SETQ ME (\MYALINK))
(\SMASHLINK NIL (fetch PROCFX of P]
(PROG1 (\GETBASEPTR (\STKSCAN VAR)
0)
(AND ME (\SMASHLINK NIL ME])
(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))
(QUOTE ((EVENT 0 (FLAGBITS . 0))
(EVENT 0 (BITS . 22))
(EVENT 0 POINTER)
(EVENT 2 POINTER)))
(QUOTE 4))
)
(/DECLAREDATATYPE (QUOTE EVENT)
(QUOTE (FLAG (BITS 7)
POINTER POINTER))
(QUOTE ((EVENT 0 (FLAGBITS . 0))
(EVENT 0 (BITS . 22))
(EVENT 0 POINTER)
(EVENT 2 POINTER)))
(QUOTE 4))
[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: " 5-Nov-85 11:09")
[COND
(TIMEOUT (* Check args before going
uninterruptable)
(SETQ TIMEOUT (COND
(TIMERP (\DTEST TIMEOUT (QUOTE FIXP)))
((TYPENAMEP TIMEOUT (QUOTE BIGNUM))
MAX.FIXP)
(T (FIX TIMEOUT]
(\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))
(QUOTE ((MONITORLOCK 0 (FLAGBITS . 0))
(MONITORLOCK 0 (FLAGBITS . 16))
(MONITORLOCK 0 (BITS . 37))
(MONITORLOCK 0 POINTER)
(MONITORLOCK 2 POINTER)
(MONITORLOCK 4 POINTER)
(MONITORLOCK 6 POINTER)))
(QUOTE 8))
)
(/DECLAREDATATYPE (QUOTE MONITORLOCK)
(QUOTE (FLAG FLAG (BITS 6)
POINTER POINTER POINTER POINTER))
(QUOTE ((MONITORLOCK 0 (FLAGBITS . 0))
(MONITORLOCK 0 (FLAGBITS . 16))
(MONITORLOCK 0 (BITS . 37))
(MONITORLOCK 0 POINTER)
(MONITORLOCK 2 POINTER)
(MONITORLOCK 4 POINTER)
(MONITORLOCK 6 POINTER)))
(QUOTE 8))
[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: " 5-Nov-85 11:10")
[COND
(TIMEOUT (* Check args before going
uninterruptable)
(SETQ TIMEOUT (COND
(TIMERP (\DTEST TIMEOUT (QUOTE FIXP)))
((TYPENAMEP TIMEOUT (QUOTE BIGNUM))
MAX.FIXP)
(T (FIX TIMEOUT]
(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: "26-Apr-86 16:46")
(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 READBUF)
(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)
(\TTYWINDOW)
(READBUF)
\TERM.OFD \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#)))
(\MAKE.PROCESS1 #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 (COND
((EQ RESULT \PROC.RESETME)
(* From RESET)
(QUOTE RESET))
(T (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])
(\MAKE.PROCESS1
[LAMBDA (PROC) (* bvm: " 8-Jun-85 23:14")
(* * Called by \MAKE.PROCESS0 to set up PROC's initial handle and then return
to its caller, usually ADD.PROCESS -
we have here a partial exchange of stack pointers: PROC gets pointer to
\MAKE.PROCESS0 frame, \MAKE.PROCESS0 points to T, we return to former parent of
\MAKE.PROCESS0; the only use count that changes is the T frame, which now has
one more user)
(UNINTERRUPTABLY
(LET ((MP0 (\MYALINK))
(TOP (\STACKARGPTR T))
MP0CALLER)
[COND
((NEQ 0 (fetch PROCFX of PROC)) (* Should never happen, but let's be
consistent with stackp use)
(\DECUSECOUNT (fetch PROCFX of PROC]
(SETQ MP0CALLER (fetch (FX ALINK) of MP0))
(replace PROCFX of PROC with MP0) (* Fix proc handle to return to
\MAKE.PROCESS0)
(replace (FX ACLINK) of MP0 with TOP) (* Detach \MAKE.PROCESS0 from the
ADD.PROCESS stack)
(\INCUSECOUNT TOP)
(\RESUME MP0CALLER) (* Make me return to the caller of
\MAKE.PROCESS0)
NIL))])
(\PROCESS.MOVEFRAME
[LAMBDA NIL (* bvm: " 8-Jun-85 22:30")
(* 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 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: " 9-Aug-85 11:49")
(PROG ((EVENT (fetch PROCEVENTORLOCK of PROC))
(FX (fetch PROCFX of PROC))
WINDOW)
[COND
((NEQ FX 0)
(UNINTERRUPTABLY
(\DECUSECOUNT FX)
(replace PROCFX of PROC with 0))]
(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 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 (* kbr: "29-Jan-86 12:59")
(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]
(COND
(\WINDOWWORLD (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: " 5-Jun-85 17:09")
(* 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 ACLINK) 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)
(LET ((TOFX (fetch PROCFX of PROC))
FROMFX)
(COND ((fetch (FX INVALIDP)
of TOFX)
(\MP.ERROR \MP.STACKRELEASED
"Process's stack has been released!"
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])
(\PROCESS.RESET.TIMERS
[LAMBDA NIL (* bvm: " 4-Nov-85 17:12")
(* Called when the time is up in the
air -- clears timers on
\SYSTEMTIMERVARS and wakes any process
waiting only on a timer)
(for TIMER in \SYSTEMTIMERVARS bind UNITS do [COND
((LISTP TIMER)
(SETQ UNITS (CADR TIMER))
(SETQ TIMER (CAR TIMER]
(SETUPTIMER 0 (COND
((LITATOM TIMER)
(GETTOPVAL TIMER))
(T TIMER))
UNITS))
(for PROC in \PROCESSES when (AND (EQ (fetch PROCSTATUS of PROC)
\PSTAT.WAITING)
(fetch PROCTIMERSET of PROC)
(NOT (fetch PROCEVENTORLOCK of PROC)))
do (\RUN.PROCESS PROC])
(\PROC.AFTER.WINDOWWORLD
[LAMBDA NIL (* kbr: " 1-Feb-86 12:12")
(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 \WINDOWWORLD (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: " 8-Jun-85 23:17")
(for P in \PROCESSES do
(* * CLEARSTK after HARDRESET did not get the process handles, so smash them
now)
(replace PROCFX of P with 0))
(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: " 1-Aug-85 16:28")
(PROG ((TTYNAME (fetch PROCNAME of (TTY.PROCESS)))
(ME (fetch PROCNAME of (THIS.PROCESS)))
PROCNAMES NAME)
(* * Construct list of all processes. Put the running process and the tty
process at the top for ease of recognition)
(SETQ PROCNAMES (CONS TTYNAME (for PROC in \PROCESSES
unless [OR (EQ (SETQ NAME (fetch PROCNAME of PROC))
TTYNAME)
(EQ NAME ME)
(AND (fetch PROCSYSTEMP of PROC)
(NEQ NAME (QUOTE MOUSE] collect NAME)))
(COND
((NEQ ME TTYNAME)
(push PROCNAMES ME)))
(NCONC PROCNAMES (for PROC in \PROCESSES collect (fetch PROCNAME of PROC)
unless (FMEMB (fetch PROCNAME of PROC)
PROCNAMES)))
[PROGN (* Tag the running and tty procs)
(RPLACA PROCNAMES (LIST (CONCAT ME " *run")
(LIST (QUOTE QUOTE)
ME)))
(COND
((NEQ ME TTYNAME)
(RPLACA (CDR PROCNAMES)
(LIST (CONCAT TTYNAME " *tty")
(LIST (QUOTE QUOTE)
TTYNAME]
(RETURN (COND
((SETQ NAME (MENU (create MENU
ITEMS ←(CONS (QUOTE %[Spawn% Mouse%])
PROCNAMES)
TITLE ← TITLE
CENTERFLG ← T
MENUFONT ← INTERRUPTMENUFONT)))
(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? 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)
(ADDTOVAR \SYSTEMTIMERVARS (\LASTUSERACTION SECONDS))
(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 #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 \SYSTEMTIMERVARS)
)
(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 . T)
)
)
(* 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 32000 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 32000 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: " 9-Jun-85 16:58")
(* 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 ←(FUNCTION \PSW.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 ←(FUNCTION \PSWOP.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])
(\PSW.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])
(\PSWOP.SELECTED
[LAMBDA (ITEM MENU BUTTON) (* bvm: " 9-Jun-85 16:58")
(COND
((NULL (THIS.PROCESS))
(PROMPTPRINT "Processes are off!"))
[(EQ ITEM (QUOTE WHO?))
(COND
((TTY.PROCESS)
(\PSW.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) (* jds " 4-Feb-86 14:52")
(PROG (DSP PLACE REGION)
[COND
([NOT (WINDOWP (OR WINDOW (SETQ WINDOW (CAR (ATTACHEDWINDOWS PROCESS.STATUS.WINDOW]
(SETQ REGION (WINDOWPROP PROCESS.STATUS.WINDOW (QUOTE REGION)))
(SETQ DSP (WINDOWPROP (SETQ WINDOW (CREATEW (create REGION
LEFT ←(fetch (REGION LEFT)
of REGION)
BOTTOM ←(COND
((ILESSP
(fetch (REGION BOTTOM)
of REGION)
PROCBACKTRACEHEIGHT)
(SETQ PLACE (QUOTE
TOP))
(fetch (REGION TOP)
of REGION))
(T
(SETQ PLACE (QUOTE
BOTTOM))
(IDIFFERENCE
(fetch (REGION BOTTOM)
of REGION)
PROCBACKTRACEHEIGHT)))
WIDTH ←(fetch (REGION WIDTH)
of REGION)
HEIGHT ← PROCBACKTRACEHEIGHT)
"Process backtrace" NIL T))
(QUOTE DSP)))
(ATTACHWINDOW WINDOW PROCESS.STATUS.WINDOW PLACE (QUOTE JUSTIFY)
(QUOTE LOCALCLOSE))
(DSPSCROLL (QUOTE OFF)
DSP)
(WINDOWPROP WINDOW (QUOTE PASSTOMAINCOMS)
(QUOTE (MOVEW SHRINKW BURYW)))
(DSPFONT (OR BACKTRACEFONT (FONTCREATE (QUOTE GACHA)
8))
DSP))
(T (SETQ DSP (WINDOWPROP WINDOW (QUOTE DSP]
(DSPRESET DSP)
(LET ((PLVLFILEFLG T)
(FX (fetch (PROCESS PROCFX) of PROC))
STKP)
(BAKTRACE [COND
((EQ FX 0) (* The currently active proc!)
(QUOTE \PSWOP.SELECTED))
(T (SETQ STKP (\MAKESTACKP NIL FX]
NIL NIL (SELECTQ CMD
(BT 0)
(BTV 1)
(BTV* 7)
(BTV! 39)
0)
DSP)
(AND STKP (RELSTK STKP])
(\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? 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)
)
(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 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (22483 42890 (PROCESS-STATUS 22493 . 23788) (PROCESSWORLD 23790 . 32419) (ADD.PROCESS
32421 . 36466) (DEL.PROCESS 36468 . 36928) (PROCESS.RETURN 36930 . 37443) (FIND.PROCESS 37445 . 38331)
(MAP.PROCESSES 38333 . 38643) (PROCESSP 38645 . 38816) (RELPROCESSP 38818 . 39003) (RESTART.PROCESS
39005 . 40652) (WAKE.PROCESS 40654 . 41425) (SUSPEND.PROCESS 41427 . 41817) (PROCESS.RESULT 41819 .
42606) (PROCESS.FINISHEDP 42608 . 42888)) (42891 52132 (THIS.PROCESS 42901 . 43037) (TTY.PROCESS 43039
. 45739) (TTY.PROCESSP 45741 . 45960) (PROCESS.TTY 45962 . 46372) (GIVE.TTY.PROCESS 46374 . 47480) (
ALLOW.BUTTON.EVENTS 47482 . 47736) (SPAWN.MOUSE 47738 . 49738) (\WAIT.FOR.TTY 49740 . 49933) (
WAIT.FOR.TTY 49935 . 52130)) (52133 57950 (PROCESSPROP 52143 . 56775) (PROCESS.NAME 56777 . 57146) (
PROCESS.WINDOW 57148 . 57948)) (58154 63058 (DISMISS 58164 . 58907) (BLOCK 58909 . 60957) (
WAITFORINPUT 60959 . 62313) (\WAITFORSYSBUFP 62315 . 63056)) (63247 63779 (EVAL.AS.PROCESS 63257 .
63512) (EVAL.IN.TTY.PROCESS 63514 . 63777)) (64483 68852 (PROCESS.READ 64493 . 65387) (PROCESS.EVALV
65389 . 65977) (PROCESS.EVAL 65979 . 66953) (\PROCESS.EVAL1 66955 . 67406) (PROCESS.APPLY 67408 .
68390) (\PROCESS.APPLY1 68392 . 68850)) (71010 75824 (CREATE.EVENT 71020 . 71185) (NOTIFY.EVENT 71187
. 72768) (AWAIT.EVENT 72770 . 73415) (\UNQUEUE.EVENT 73417 . 74674) (\ENQUEUE.EVENT/LOCK 74676 .
75822)) (79005 84427 (OBTAIN.MONITORLOCK 79015 . 81089) (CREATE.MONITORLOCK 81091 . 81312) (
RELEASE.MONITORLOCK 81314 . 83666) (MONITOR.AWAIT.EVENT 83668 . 84425)) (85069 105164 (\MAKE.PROCESS0
85079 . 90542) (\MAKE.PROCESS1 90544 . 92200) (\PROCESS.MOVEFRAME 92202 . 96714) (\RELEASE.PROCESS
96716 . 98406) (\MAYBEBLOCK 98408 . 98566) (\BACKGROUND.PROCESS 98568 . 98812) (\MOUSE.PROCESS 98814
. 100991) (\TIMER.PROCESS 100993 . 101734) (\PROC.RESETRESTORE 101736 . 102876) (\PROCESS.UNWINDALL
102878 . 103999) (\UNIQUE.PROCESS.NAME 104001 . 105162)) (105165 120241 (\START.PROCESSES 105175 .
105350) (\PROCESS.GO.TO.SLEEP 105352 . 108707) (\PROC.RESUME 108709 . 109124) (\RUN.PROCESS 109126 .
111496) (\FLUSH.PROCESS 111498 . 113555) (\SUSPEND.PROCESS 113557 . 116462) (\UNQUEUE.TIMER 116464 .
117216) (\ENQUEUE.TIMER 117218 . 119209) (\GET.PRIORITY.QUEUE 119211 . 120239)) (123849 131021 (
\PROCESS.INIT 123859 . 124577) (\PROCESS.EVENTFN 124579 . 126067) (\PROCESS.BEFORE.LOGOUT 126069 .
127475) (\PROCESS.AFTER.EXIT 127477 . 127814) (\PROCESS.RESET.TIMERS 127816 . 129345) (
\PROC.AFTER.WINDOWWORLD 129347 . 130141) (\TURN.ON.PROCESSES 130143 . 131019)) (131048 132157 (
\PROC.CODEFORTFRAME 131058 . 131749) (\PROC.REPEATEDLYEVALQT 131751 . 132155)) (132187 139167 (
BREAK.PROCESS 132197 . 132516) (\SELECTPROCESS 132518 . 134980) (\PROCESS.MAKEFRAME 134982 . 137530) (
\PROCESS.MAKEFRAME0 137532 . 139165)) (141655 143573 (\CHECK.PQUEUE 141665 . 143571)) (143574 161945 (
PPROC 143584 . 144914) (PPROCWINDOW 144916 . 145507) (PPROCREPAINTFN 145509 . 146271) (PPROCRESHAPEFN
146273 . 146564) (PPROCEXTENT 146566 . 147058) (PPROC1 147060 . 149104) (PROCESS.STATUS.WINDOW 149106
. 153019) (\PSW.SELECTED 153021 . 153318) (\PSWOP.SELECTED 153320 . 156320) (PROCESS.BACKTRACE 156322
. 160048) (\INVALIDATE.PROCESS.WINDOW 160050 . 161112) (\UPDATE.PROCESS.WINDOW 161114 . 161943)))))
STOP