(FILECREATED " 5-Nov-85 11:24:51" {ERIS}<LISPCORE>SOURCES>PROC.;29 121813
changes to: (FNS DISMISS BLOCK AWAIT.EVENT MONITOR.AWAIT.EVENT \MAKE.PROCESS0
\PROCESS.RESET.TIMERS)
(VARS PROCCOMS)
previous date: " 9-Aug-85 13:11:58" {ERIS}<LISPCORE>SOURCES>PROC.;26)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved. The following
program was created in 1982 but has not been published within the meaning of the copyright law, is
furnished under license, and may not be used, copied and/or disclosed except in accordance with the
terms of said license.)
(PRETTYCOMPRINT PROCCOMS)
(RPAQQ PROCCOMS [(COMS (DECLARE: DONTCOPY (EXPORT (RECORDS PROCESS))
(RECORDS PROCESSQUEUE)
(CONSTANTS \PSTAT.WAITING \PSTAT.RUNNING \PSTAT.DELETED))
(INITRECORDS PROCESS PROCESSQUEUE)
(SYSRECORDS PROCESS PROCESSQUEUE))
[COMS (* User entries)
(FNS PROCESSWORLD ADD.PROCESS DEL.PROCESS PROCESS.RETURN FIND.PROCESS
MAP.PROCESSES PROCESSP RELPROCESSP RESTART.PROCESS WAKE.PROCESS
SUSPEND.PROCESS PROCESS.RESULT PROCESS.FINISHEDP)
(FNS THIS.PROCESS TTY.PROCESS TTY.PROCESSP PROCESS.TTY GIVE.TTY.PROCESS
PROCESS.PREPARE.FOR.INPUT ALLOW.BUTTON.EVENTS SPAWN.MOUSE \WAIT.FOR.TTY
WAIT.FOR.TTY)
(FNS PROCESSPROP PROCESS.NAME PROCESS.WINDOW)
(PROP ARGNAMES PROCESSPROP ADD.PROCESS)
(COMS (* Temporary)
(P (MOVD? (QUOTE PROCESS.RETURN)
(QUOTE KILL.ME]
(COMS (FNS DISMISS BLOCK WAITFORINPUT \WAITFORSYSBUFP)
(GLOBALRESOURCES \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
(PROCESSWORLD
[LAMBDA (FLG) (* bvm: " 9-Aug-85 11:40")
(* 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
([AND TOPW (NOT (FIND.PROCESS (QUOTE MOUSE]
(ADD.PROCESS (LIST (FUNCTION \MOUSE.PROCESS))
(QUOTE NAME)
(QUOTE MOUSE)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE SCHEDULE)
T)))
(COND
((NOT (FIND.PROCESS (QUOTE \TIMER.PROCESS)))
(SETQ \TIMERQHEAD (ADD.PROCESS (LIST (FUNCTION \TIMER.PROCESS))
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE SCHEDULE)
T)))
(T (replace PROCTIMERLINK of (\DTEST \TIMERQHEAD (QUOTE PROCESS)) with NIL)))
[COND
(EXECPROC (push \PROCESSES EXECPROC)
(\MAKE.PROCESS0 (fetch PROCFORM of EXECPROC)
EXECPROC)
(\RUN.PROCESS EXECPROC))
(T (SETQ EXECPROC (ADD.PROCESS (QUOTE (\PROC.REPEATEDLYEVALQT))
(QUOTE NAME)
(QUOTE EXEC)
(QUOTE RESTARTABLE)
(QUOTE ALWAYS)
(QUOTE SCHEDULE)
T]
(COND
((TYPENAMEP \TopLevelTtyWindow (QUOTE WINDOW))
(replace PROCWINDOW of EXECPROC with \TopLevelTtyWindow)
(WINDOWPROP \TopLevelTtyWindow (QUOTE PROCESS)
EXECPROC)))
(COND
((NOT (MEMB \TTY.PROCESS \PROCESSES))
(SETQ \TTY.PROCESS EXECPROC))) (* most of the action is in BLOCK, but we start here,
and occasionaly control comes back as well)
LP [ERSETQ (PROG (RESULT)
(replace NEXTPROCHANDLE of #SCHEDULER# with (CAR \PROCESSES))
(SETQ RESULT (\START.PROCESSES))
[COND
((EQ RESULT PSTAT.QUIT) (* from (PROCESSWORLD (QUOTE OFF)))
(RETFROM (QUOTE PROCESSWORLD]
(printout T T "??? Process mech. confused - strange RESULT in SCHEDULE"
, # (LVLPRINT RESULT NIL 2 6]
(GO LP])
(ADD.PROCESS
[LAMBDA ARGS (* bvm: " 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) (* bvm: "17-AUG-83 11:02")
(* returns the TTY for a process)
(COND
((OR (NULL PROC)
(EQ (SETQ PROC (\COERCE.TO.PROCESS PROC))
(THIS.PROCESS)))
TtyDisplayStream)
(PROC (PROCESS.EVALV PROC (QUOTE TtyDisplayStream])
(GIVE.TTY.PROCESS
[LAMBDA (WINDOW) (* rrb "16-Jul-84 17:53")
(* default WINDOWENTRYFN which gives the tty to the
process associated with this window and calls its
BUTTONEVENTFN)
(OR (WINDOWP WINDOW)
(\ILLEGAL.ARG WINDOW))
(PROG ((PROC (WINDOWPROP WINDOW (QUOTE PROCESS)))
FN)
[COND
(PROC (COND
((DEADPROCP PROC)
(WINDOWPROP WINDOW (QUOTE PROCESS)
NIL))
(T (TTY.PROCESS PROC]
(AND [SETQ FN (COND
((LASTMOUSESTATE (ONLY RIGHT))
(fetch RIGHTBUTTONFN of WINDOW))
(T (fetch BUTTONEVENTFN of WINDOW]
(APPLY* FN WINDOW])
(PROCESS.PREPARE.FOR.INPUT
[LAMBDA NIL (* bvm: "23-Jul-84 15:56")
(* * Ensures that current process can take input. Blocks if necesary until it becomes tty process)
(WAIT.FOR.TTY])
(ALLOW.BUTTON.EVENTS
[LAMBDA NIL (* bvm: "24-JUL-83 15:31")
(AND (EQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE))
(SPAWN.MOUSE (THIS.PROCESS])
(SPAWN.MOUSE
[LAMBDA (INTERNAL) (* bvm: " 4-Apr-84 12:08")
(UNINTERRUPTABLY
(PROG ([MOUSEPROC (COND
((AND INTERNAL (EQ (fetch PROCNAME of INTERNAL)
(QUOTE MOUSE)))
INTERNAL)
(T (FIND.PROCESS (QUOTE MOUSE]
NAME)
(COND
(MOUSEPROC [replace PROCNAME of MOUSEPROC
with (COND
((FIND.PROCESS (QUOTE OLDMOUSE))
(OR (for I from 2 to (COND
(INTERNAL PROCESS.MAXMOUSE)
(T MAX.SMALLP))
unless (FIND.PROCESS (SETQ NAME (PACK* (QUOTE OLDMOUSE)
(QUOTE #)
I)))
do (RETURN NAME))
(RETURN)))
(T (QUOTE OLDMOUSE]
(replace PROCSYSTEMP of MOUSEPROC with NIL)
(* Make non systemp in case user wants to kill it)
))
(ADD.PROCESS (LIST (QUOTE \MOUSE.PROCESS))
(QUOTE NAME)
(QUOTE MOUSE)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM))
(RETURN T)))])
(\WAIT.FOR.TTY
[LAMBDA NIL (* bvm: " 5-MAY-83 12:43")
(until (TTY.PROCESSP) do (AWAIT.EVENT \TTY.PROCESS.EVENT])
(WAIT.FOR.TTY
[LAMBDA (MSECS NEEDWINDOW) (* bvm: " 1-Aug-84 00:06")
(* * Ensures that current process can take input. Blocks if necesary until it becomes tty process)
(COND
((EQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE))
(SPAWN.MOUSE (THIS.PROCESS))
(* Background proc cannot take input, because if we block it, then nobody is listening to the mouse.
So spin off a new background process and relegate this one to the tty use)
(* Assume mouse-invoked action wants to have the tty)
[OR (TTY.PROCESSP)
(SETQ \OLDTTY (TTY.PROCESS (THIS.PROCESS]
T)
((TTY.PROCESSP)
T)
[(WINDOWWORLD)
(PROG (WINDOW TIMER)
[COND
(NEEDWINDOW (* Make sure process has a tty window)
(OR [OPENWP (SETQ WINDOW (WFROMDS (PROGN (\GETSTREAM T (QUOTE INPUT))
(TTYDISPLAYSTREAM]
(OPENW WINDOW]
[COND
(MSECS (* Put a time limit on the wait)
(SETQ TIMER (SETUPTIMER MSECS]
(RETURN (do (AWAIT.EVENT \TTY.PROCESS.EVENT TIMER TIMER)
(COND
((TTY.PROCESSP)
(RETURN T))
((AND TIMER (TIMEREXPIRED? TIMER))
(RETURN NIL]
(T (TTY.PROCESS (THIS.PROCESS))
T])
)
(DEFINEQ
(PROCESSPROP
[LAMBDA ARGS (* bvm: " 3-Apr-84 14:39")
(PROG ((P (\COERCE.TO.PROCESS (ARG ARGS 1)))
(PROP (ARG ARGS 2))
NEWVALUE OLDDATA OLDVALUE)
(RETURN (AND P (PROG1 (SELECTQ PROP
(WINDOW (fetch PROCWINDOW of P))
(PRIORITY (fetch PROCPRIORITY of P))
(NAME (fetch PROCNAME of P))
(RESTARTABLE (fetch RESTARTABLE of P))
(FORM (fetch PROCFORM of P))
(INFOHOOK (fetch PROCINFOHOOK of P))
(AFTEREXIT (fetch PROCAFTEREXIT of P))
(BEFOREEXIT (fetch PROCBEFOREEXIT of P))
(TTYENTRYFN (fetch PROCTTYENTRYFN of P))
(TTYEXITFN (fetch PROCTTYEXITFN of P))
(USERDATA (fetch PROCUSERDATA of P))
(RESTARTFORM (fetch PROCRESTARTFORM of P))
(SETQ OLDVALUE (LISTGET (SETQ OLDDATA (fetch PROCUSERDATA
of P))
PROP)))
(COND
((IGREATERP ARGS 2)
(SETQ NEWVALUE (ARG ARGS 3))
(SELECTQ PROP
(WINDOW (PROCESS.WINDOW P NEWVALUE))
(PRIORITY NIL)
(NAME (replace PROCNAME of P with (\UNIQUE.PROCESS.NAME
NEWVALUE))
(\INVALIDATE.PROCESS.WINDOW))
[RESTARTABLE (replace RESTARTABLE of P
with (SELECTQ NEWVALUE
((NIL NO NEVER)
NIL)
((T YES ALWAYS)
T)
(HARDRESET (QUOTE
HARDRESET))
(\ILLEGAL.ARG NEWVALUE]
(FORM)
(INFOHOOK (replace PROCINFOHOOK of P with NEWVALUE))
(AFTEREXIT (replace PROCAFTEREXIT of P with NEWVALUE))
(BEFOREEXIT (replace PROCBEFOREEXIT of P with NEWVALUE))
(TTYENTRYFN (replace PROCTTYENTRYFN of P with NEWVALUE))
(TTYEXITFN (replace PROCTTYEXITFN of P with NEWVALUE))
(USERDATA (replace PROCUSERDATA of P with NEWVALUE))
(RESTARTFORM (replace PROCRESTARTFORM of P with NEWVALUE)
)
(COND
[(NOT NEWVALUE)
(* Delete the old value, if any)
(COND
((EQ (CAR OLDDATA)
PROP)
(replace PROCUSERDATA of P with (CDDR OLDDATA)))
(T (for TAIL on (CDR OLDDATA) by (CDDR TAIL)
when (EQ (CADR TAIL)
PROP)
do (RPLACD TAIL (CDDDR TAIL))
(RETURN]
(OLDDATA (LISTPUT OLDDATA PROP NEWVALUE))
(T (replace PROCUSERDATA of P with (LIST PROP NEWVALUE]
)
(PROCESS.NAME
[LAMBDA (PROC NAME) (* bvm: "16-JUN-82 16:36")
(PROG ((P (\COERCE.TO.PROCESS PROC)))
(RETURN (AND P (PROG1 (fetch PROCNAME of P)
(COND
(NAME (replace PROCNAME of P with (\UNIQUE.PROCESS.NAME NAME])
(PROCESS.WINDOW
[LAMBDA (PROC WINDOW) (* bvm: "16-JUN-82 16:36")
(* Associates WINDOW with PROC, for exec switching)
(PROG ((P (\COERCE.TO.PROCESS PROC)))
(RETURN (COND
(P (PROG1 (fetch PROCWINDOW of P)
(COND
(WINDOW (replace PROCWINDOW of P with (SETQ WINDOW (\INSUREWINDOW
WINDOW)))
(WINDOWPROP WINDOW (QUOTE PROCESS)
P])
)
(PUTPROPS PROCESSPROP ARGNAMES (PROC PROP NEWVALUE))
(PUTPROPS ADD.PROCESS ARGNAMES (NIL (FORM . PROPS&VALUES) . U))
(* Temporary)
(MOVD? (QUOTE PROCESS.RETURN)
(QUOTE KILL.ME))
(DEFINEQ
(DISMISS
[LAMBDA (MSECSWAIT TIMER NOBLOCK) (* 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) (* bvm: " 5-Nov-85 10:54")
(* 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 TOPW (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: " 4-Nov-85 17:51")
(DECLARE (LOCALVARS . T)
(SPECVARS #MYHANDLE# #FORM# HELPFLAG \CURRENTDISPLAYLINE \#DISPLAYLINES \LINEBUF.OFD
\PRIMIN.OFD \PRIMREADTABLE \PRIMTERMTABLE \PRIMTERMSA TtyDisplayStream
\TERM.OFD \TTYWINDOW \PRIMOUT.OFD \DRIBBLE.OFD \INTERRUPTABLE)
(GLOBALVARS \DEFAULTLINEBUF \DEFAULTTTYDISPLAYSTREAM))
(PROG ((#MYHANDLE# HANDLE)
(#FORM# FORM)
(HELPFLAG (AND HELPFLAG (QUOTE BREAK!)))
(\CURRENTDISPLAYLINE 0)
(\#DISPLAYLINES 40)
(\LINEBUF.OFD (OR \DEFAULTLINEBUF \LINEBUF.OFD))
(\PRIMREADTABLE \PRIMREADTABLE)
(\PRIMTERMTABLE \PRIMTERMTABLE)
(\PRIMTERMSA \PRIMTERMSA)
(TtyDisplayStream \DEFAULTTTYDISPLAYSTREAM)
\INTERRUPTABLE \TERM.OFD \TTYWINDOW \PRIMOUT.OFD \PRIMIN.OFD RESULT)
(* HELPFLAG set to ensure breaks occur.
Proc can rebind if desired)
(* \TTYWINDOW is currently just a place to hold onto the WINDOW of the TtyDisplayStream in case user closes same
and then someone prints to TtyDisplayStream)
(\MISCAPPLY* (FUNCTION \PROCESS.MOVEFRAME)) (* Move me to the boonies)
[SETQ \TERM.OFD (SETQ \PRIMOUT.OFD (COND
(TtyDisplayStream (\GETOFD TtyDisplayStream (QUOTE OUTPUT)))
(T (* For init time, before LLDISPLAY sets up)
(GETTOPVAL (QUOTE \TERM.OFD]
(SETQ \PRIMIN.OFD \LINEBUF.OFD)
(\SETFVARSLOT (QUOTE RESETVARSLST)
(LOCF (fetch PROCRESETVARSLST of #MYHANDLE#)))
(* Make this proc use a piece of its PROCESS handle as the binding place for RESETVARSLST. This lets its survive a
HARDRESET and also makes it easier for DEL.PROCESS to get at)
(\SETFVARSLOT (QUOTE \DRIBBLE.OFD)
(LOCF (fetch PROCDRIBBLEOFD of #MYHANDLE#)))
(\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 (* bvm: " 4-Jan-85 12:35")
(DECLARE (SPECVARS \OLDTTY \MOUSEBUSY))
(PROG (\OLDTTY \MOUSEBUSY OTHERMOUSE)
LP [COND
((NEQ (fetch PROCNAME of (THIS.PROCESS))
(QUOTE MOUSE)) (* A new mouse process sprung up while we were hung)
(COND
((AND (SETQ OTHERMOUSE (FIND.PROCESS (QUOTE MOUSE)))
(PROCESS.EVALV OTHERMOUSE (QUOTE \MOUSEBUSY)))
(* The other mouse is still busy, so we can't kill it.
Die instead)
(PROCESS.RETURN))
(T (COND
(OTHERMOUSE (* Kill off the mouse process that took our place)
(DEL.PROCESS OTHERMOUSE)
(SETQ OTHERMOUSE) (* Don't inadvertantly hold a pointer to this dead
process)
))
(replace PROCSYSTEMP of (THIS.PROCESS) with T)
(replace PROCNAME of (THIS.PROCESS) with (QUOTE MOUSE]
(WINDOW.MOUSE.HANDLER)
(COND
((TTY.PROCESSP) (* Give up the tty if we still have it)
(TTY.PROCESS (COND
((NEQ \OLDTTY (THIS.PROCESS))
\OLDTTY)
(T T)))
(SETQ \OLDTTY)))
(replace PROCTYPEAHEAD of (THIS.PROCESS) with NIL)
(* No sense keeping around this typeahead)
(BLOCK)
(GO LP])
(\TIMER.PROCESS
[LAMBDA NIL (* bvm: " 1-AUG-83 15:17")
(* This process runs at default priority and tests for
processes that have timed out)
(PROG ((\INTERRUPTABLE NIL)
(HEAD \TIMERQHEAD)
PROC)
LP (COND
((AND (SETQ PROC (fetch PROCTIMERLINK of HEAD))
(TIMEREXPIRED? (fetch PROCWAKEUPTIMER of PROC)))
(\RUN.PROCESS PROC PSTAT.TIMEDOUT))
(T (BLOCK)))
(GO LP])
(\PROC.RESETRESTORE
[LAMBDA (PROC) (* bvm: "10-OCT-83 17:28")
(\SETFVARSLOT (QUOTE RESETVARSLST)
(LOCF (fetch PROCRESETVARSLST of PROC))) (* Make it use the actual binding of PROC's
RESETVARSLST, so that it is eaten up properly as things
are unwound)
(ERSETQ (RESETRESTORE NIL (QUOTE RESET)))
(while (fetch PROCOWNEDLOCKS of PROC) do (RELEASE.MONITORLOCK (fetch PROCOWNEDLOCKS of PROC)
T))
(COND
((fetch PROCDRIBBLEOFD of PROC)
(\SETFVARSLOT (QUOTE \DRIBBLE.OFD)
(LOCF (fetch PROCDRIBBLEOFD of PROC)))
(DRIBBLE))) (* Return this to make \SETFVARSLOT work)
(OR RESETVARSLST \DRIBBLE.OFD])
(\PROCESS.UNWINDALL
[LAMBDA (STATE) (* bvm: "31-JUL-83 16:43")
(* Called when the current process is being killed or restarted, to unwind any RESETxxx expressions and release any
locks. STATE is the value of RESETSTATE for the unwind)
(PROG ((ME (THIS.PROCESS)))
[repeatwhile (AND (fetch PROCRESETVARSLST of ME)
(NULL (NLSETQ (RESETRESTORE NIL STATE]
(while (fetch PROCOWNEDLOCKS of ME) do (RELEASE.MONITORLOCK (fetch PROCOWNEDLOCKS
of ME)))
(COND
((AND \DRIBBLE.OFD (NEQ STATE (QUOTE HARDRESET)))
(* Close any Dribble file. But don't close dribble file
if we are merely restarting after a reset)
(DRIBBLE])
(\UNIQUE.PROCESS.NAME
[LAMBDA (NAME) (* bvm: " 1-Aug-84 00:18")
(* * Coerces NAME to one not in use by any active process)
(PROG NIL
RETRY
(SELECTQ (TYPENAME NAME)
(LITATOM)
[STRINGP (COND
((ILESSP (NCHARS NAME)
128)
(SETQ NAME (MKATOM NAME]
(LISTP (SETQ NAME (CAR NAME))
(GO RETRY))
(RETURN NAME))
[COND
((OR (NULL NAME)
(EQ NAME T))
(SETQ NAME (ERROR "Illegal Process Name" NAME))
(GO RETRY))
((FIND.PROCESS NAME)
(for I from 2 bind (FIRSTNAME ← NAME) while (FIND.PROCESS (SETQ NAME
(PACK* FIRSTNAME
(QUOTE #)
I]
(RETURN NAME])
)
(DEFINEQ
(\START.PROCESSES
[LAMBDA NIL (* bvm: " 2-MAY-83 12:30")
(UNINTERRUPTABLY
(\RESCHEDULE #SCHEDULER#))])
(\PROCESS.GO.TO.SLEEP
[LAMBDA (EVLOCK TIMEOUT TIMERP DELETEFLG) (* bvm: " 3-Jan-85 12:34")
(* puts the current process to sleep. EVLOCK is a lock or event to wait on, or NIL for neither.
TIMEOUT is optional timeout to wake up if we haven't been woken any other way; monitor locks do not get timeouts.
TIMERP=T means TIMEOUT is an absolute timer rather than an interval. TIMEOUT=T means continue using the timer from
the last time we went to sleep. DELETEFLG means never to return.)
(UNINTERRUPTABLY
[PROG ((PROC (THIS.PROCESS))
HEAD TAIL PREV)
(OR PROC (RETURN (BLOCK)))
(COND
((AND (type? EVENT EVLOCK)
(fetch EVENTWAKEUPPENDING of EVLOCK))
(* Missed a wakeup for this event, take it now)
(replace EVENTWAKEUPPENDING of EVLOCK with NIL)
(RETURN EVLOCK)))
(replace PROCSTATUS of PROC with \PSTAT.WAITING)
(SETQ HEAD (fetch PROCQUEUE of PROC)) (* Now remove PROC from its run queue)
(SETQ PREV (fetch PQLAST of HEAD))
[COND
[(EQ PROC PREV) (* Nobody left at this level)
(COND
((EQ PROC (fetch PQNEXT of HEAD))
(replace PQLAST of HEAD with (replace PQNEXT of HEAD with NIL)))
(T (\MP.ERROR \MP.PROCERROR "Inconsistent process queue state"]
(T (replace NEXTPROCHANDLE of PREV with (replace PQNEXT of HEAD
with (OR (fetch NEXTPROCHANDLE
of PROC)
(\MP.ERROR \MP.PROCERROR
"Running process has no NEXT pointer"
PROC]
(replace NEXTPROCHANDLE of PROC with NIL)
(COND
(EVLOCK (\ENQUEUE.EVENT/LOCK PROC EVLOCK)))
(replace PROCTIMERSET of PROC
with (COND
(TIMEOUT [COND
((NEQ TIMEOUT T)
(replace PROCWAKEUPTIMER of PROC
with (COND
(TIMERP TIMEOUT)
(T (SETUPTIMER TIMEOUT (fetch PROCTIMERBOX
of PROC]
(\ENQUEUE.TIMER PROC)
T)))
(RETURN (\RESCHEDULE (COND
(DELETEFLG (\RELEASE.PROCESS PROC T)
NIL)
(T PROC])])
(\PROC.RESUME
[LAMBDA (FRAME OLDFX) (* bvm: " 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 (* 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: " 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) (* bvm: " 9-Aug-85 11:41")
(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)
(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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (15965 30538 (PROCESSWORLD 15975 . 21981) (ADD.PROCESS 21983 . 25217) (DEL.PROCESS 25219
. 25594) (PROCESS.RETURN 25596 . 26053) (FIND.PROCESS 26055 . 26778) (MAP.PROCESSES 26780 . 27067) (
PROCESSP 27069 . 27233) (RELPROCESSP 27235 . 27413) (RESTART.PROCESS 27415 . 28570) (WAKE.PROCESS
28572 . 29253) (SUSPEND.PROCESS 29255 . 29608) (PROCESS.RESULT 29610 . 30247) (PROCESS.FINISHEDP 30249
. 30536)) (30539 37420 (THIS.PROCESS 30549 . 30681) (TTY.PROCESS 30683 . 32461) (TTY.PROCESSP 32463
. 32680) (PROCESS.TTY 32682 . 33102) (GIVE.TTY.PROCESS 33104 . 33933) (PROCESS.PREPARE.FOR.INPUT
33935 . 34197) (ALLOW.BUTTON.EVENTS 34199 . 34447) (SPAWN.MOUSE 34449 . 35682) (\WAIT.FOR.TTY 35684 .
35873) (WAIT.FOR.TTY 35875 . 37418)) (37421 41176 (PROCESSPROP 37431 . 40292) (PROCESS.NAME 40294 .
40622) (PROCESS.WINDOW 40624 . 41174)) (41380 45188 (DISMISS 41390 . 42047) (BLOCK 42049 . 43555) (
WAITFORINPUT 43557 . 44607) (\WAITFORSYSBUFP 44609 . 45186)) (45365 45879 (EVAL.AS.PROCESS 45375 .
45625) (EVAL.IN.TTY.PROCESS 45627 . 45877)) (46293 50054 (PROCESS.READ 46303 . 46942) (PROCESS.EVALV
46944 . 47451) (PROCESS.EVAL 47453 . 48299) (\PROCESS.EVAL1 48301 . 48744) (PROCESS.APPLY 48746 .
49600) (\PROCESS.APPLY1 49602 . 50052)) (51753 55759 (CREATE.EVENT 51763 . 51918) (NOTIFY.EVENT 51920
. 53243) (AWAIT.EVENT 53245 . 53747) (\UNQUEUE.EVENT 53749 . 54875) (\ENQUEUE.EVENT/LOCK 54877 .
55757)) (57865 62263 (OBTAIN.MONITORLOCK 57875 . 59537) (CREATE.MONITORLOCK 59539 . 59748) (
RELEASE.MONITORLOCK 59750 . 61651) (MONITOR.AWAIT.EVENT 61653 . 62261)) (62655 78816 (\MAKE.PROCESS0
62665 . 66997) (\MAKE.PROCESS1 66999 . 68288) (\PROCESS.MOVEFRAME 68290 . 71989) (\RELEASE.PROCESS
71991 . 73451) (\MAYBEBLOCK 73453 . 73610) (\BACKGROUND.PROCESS 73612 . 73864) (\MOUSE.PROCESS 73866
. 75548) (\TIMER.PROCESS 75550 . 76144) (\PROC.RESETRESTORE 76146 . 77013) (\PROCESS.UNWINDALL 77015
. 77928) (\UNIQUE.PROCESS.NAME 77930 . 78814)) (78817 90293 (\START.PROCESSES 78827 . 78998) (
\PROCESS.GO.TO.SLEEP 79000 . 81443) (\PROC.RESUME 81445 . 81834) (\RUN.PROCESS 81836 . 83696) (
\FLUSH.PROCESS 83698 . 85291) (\SUSPEND.PROCESS 85293 . 87411) (\UNQUEUE.TIMER 87413 . 88129) (
\ENQUEUE.TIMER 88131 . 89417) (\GET.PRIORITY.QUEUE 89419 . 90291)) (91918 97329 (\PROCESS.INIT 91928
. 92553) (\PROCESS.EVENTFN 92555 . 93741) (\PROCESS.BEFORE.LOGOUT 93743 . 94671) (\PROCESS.AFTER.EXIT
94673 . 94986) (\PROCESS.RESET.TIMERS 94988 . 95904) (\PROC.AFTER.WINDOWWORLD 95906 . 96621) (
\TURN.ON.PROCESSES 96623 . 97327)) (97356 98495 (\PROC.CODEFORTFRAME 97366 . 98051) (
\PROC.REPEATEDLYEVALQT 98053 . 98493)) (98525 103685 (BREAK.PROCESS 98535 . 98847) (\SELECTPROCESS
98849 . 100633) (\PROCESS.MAKEFRAME 100635 . 102429) (\PROCESS.MAKEFRAME0 102431 . 103683)) (105771
107337 (\CHECK.PQUEUE 105781 . 107335)) (107338 120808 (PPROC 107348 . 108398) (PPROCWINDOW 108400 .
109022) (PPROCREPAINTFN 109024 . 109733) (PPROCRESHAPEFN 109735 . 110037) (PPROCEXTENT 110039 . 110446
) (PPROC1 110448 . 111975) (PROCESS.STATUS.WINDOW 111977 . 115030) (\PSW.SELECTED 115032 . 115341) (
\PSWOP.SELECTED 115343 . 117281) (PROCESS.BACKTRACE 117283 . 119169) (\INVALIDATE.PROCESS.WINDOW
119171 . 120003) (\UPDATE.PROCESS.WINDOW 120005 . 120806)))))
STOP