github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-19 01:37:23 +00:00
Code Issues Projects Releases Wiki Activity

SPY.POINTERS is always T (no 2-byte atoms) (#1293)

Browse Source 
* SPY.POINTERS is always T (no 2-byte atoms)

* Set SPY to not record entries when in \BACKGROUND-YIELD or (conditionally) backgroudn process

* Use \IGNORE.BACKGROUND as global variable, initially T; clean up declarations

* changes used DECLARE%%: incorrectly, now fixed
This commit is contained in:
Larry Masinter
2023-07-30 11:35:23 -07:00
committed by GitHub
parent 91305cc2c9
commit 94269303d0
6 changed files with 470 additions and 419 deletions
Download Patch File Download Diff File Expand all files Collapse all files

101
library/SPY
View File

@@ -1,18 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Jan-2022 14:09:48" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SPY.;2 63314 (FILECREATED "28-Jul-2023 20:13:45" {DSK}<home>larry>il>medley>library>SPY.;4 64149
:EDIT-BY "lmm"
:CHANGES-TO (VARS SPYCOMS) :CHANGES-TO (VARS SPYCOMS)
(FNS SPY.MAKE.TREE) (FNS \SPY.INTERRUPT SPY.BUFFER.ENTRY SPY.ADD.ENTRY)
:PREVIOUS-DATE "29-Apr-94 14:13:52" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SPY.;1 :PREVIOUS-DATE " 4-Jan-2022 14:09:48" {DSK}<home>larry>il>medley>library>SPY.;1)
)
(* ; "
Copyright (c) 1984-1985, 1987-1988, 1990-1991, 1993-1994 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT SPYCOMS) (PRETTYCOMPRINT SPYCOMS)
(RPAQQ SPYCOMS (RPAQQ SPYCOMS
@@ -33,12 +30,13 @@ Copyright (c) 1984-1985, 1987-1988, 1990-1991, 1993-1994 by Venue & Xerox Corpor
SPY.UPDATE.TITLE SPY.DELETE SPY.DRAWBOX SPY.BUFFER.ENTRY SPY.BUTTON SPY.END.ENTRY SPY.UPDATE.TITLE SPY.DELETE SPY.DRAWBOX SPY.BUFFER.ENTRY SPY.BUTTON SPY.END.ENTRY
SPY.START SPY.INIT \SPY.INTERRUPT SPY.DUMP.BUFFER SPY.START.ENTRY SPY.ADD.ENTRY SPY.START SPY.INIT \SPY.INTERRUPT SPY.DUMP.BUFFER SPY.START.ENTRY SPY.ADD.ENTRY
SPY.ORIGINAL SPY.OVERFLOW SPY.MERGE.CALLEES SPY.PRINT) SPY.ORIGINAL SPY.OVERFLOW SPY.MERGE.CALLEES SPY.PRINT)
(COMS (INITVARS (SPY.BUTTON)) (COMS (INITVARS (\BACKGROUND)
(SPY.BUTTON))
(VARS SPY.OPEN SPY.CLOSED)) (VARS SPY.OPEN SPY.CLOSED))
(VARIABLES SPY.POINTERS)
(GLOBALVARS SPY.OVERFLOWED \PERIODIC.INTERRUPT SPY.TREE SPY.BUFFER.SIZE SPY.NEXT (GLOBALVARS SPY.OVERFLOWED \PERIODIC.INTERRUPT SPY.TREE SPY.BUFFER.SIZE SPY.NEXT
SPY.BUFFER.THRESHOLD SPY.BUFFER SPY.FREQUENCY SPY.SHOW.THRESHOLD SPY.MAXLINES SPY.FONT SPY.BUFFER.THRESHOLD SPY.BUFFER SPY.FREQUENCY SPY.SHOW.THRESHOLD SPY.MAXLINES SPY.FONT
) )
(SPECVARS \BACKGROUND)
(MACROS WITH-SPY WITH.SPY) (MACROS WITH-SPY WITH.SPY)
(DECLARE%: DONTCOPY (RECORDS SPYRECORD SPYDATA)) (DECLARE%: DONTCOPY (RECORDS SPYRECORD SPYDATA))
(INITRECORDS SPYRECORD) (INITRECORDS SPYRECORD)
@@ -836,8 +834,11 @@ Copyright (c) 1984-1985, 1987-1988, 1990-1991, 1993-1994 by Venue & Xerox Corpor
) )
(SPY.BUFFER.ENTRY (SPY.BUFFER.ENTRY
(LAMBDA (N) (* ; "Edited 9-Sep-87 18:27 by Masinter") (COND (SPY.POINTERS (AND (ILEQ (SETQ N (LLSH N 1)) SPY.BUFFER.SIZE) (\GETBASEPTR SPY.BUFFER N))) ((ILEQ N SPY.BUFFER.SIZE) (\VAG2 0 (\GETBASE SPY.BUFFER N))))) [LAMBDA (N) (* ; "Edited 28-Jul-2023 08:16 by lmm")
) (* ; "Edited 9-Sep-87 18:27 by Masinter")
(AND (ILEQ (SETQ N (LLSH N 1))
SPY.BUFFER.SIZE)
(\GETBASEPTR SPY.BUFFER N])
(SPY.BUTTON (SPY.BUTTON
(LAMBDA (POS) (* gbn " 2-Jun-85 13:12") (PROG ((REG (if POS then (CREATEREGION (fetch XCOORD of POS) (fetch YCOORD of POS) (WIDTHIFWINDOW (BITMAPWIDTH SPY.CLOSED)) (HEIGHTIFWINDOW (BITMAPHEIGHT SPY.CLOSED))) else (GETBOXREGION (WIDTHIFWINDOW (BITMAPWIDTH SPY.CLOSED)) (HEIGHTIFWINDOW (BITMAPHEIGHT SPY.CLOSED)) NIL NIL NIL "Specify region for window %"Spy Control%"")))) (BITBLT SPY.CLOSED NIL NIL (SETQ SPY.BUTTON (CREATEW REG NIL NIL T))) (WINDOWPROP SPY.BUTTON (QUOTE BUTTONEVENTFN) (FUNCTION (LAMBDA (W) (AND (LASTMOUSESTATE UP) (SPY.TOGGLE))))))) (LAMBDA (POS) (* gbn " 2-Jun-85 13:12") (PROG ((REG (if POS then (CREATEREGION (fetch XCOORD of POS) (fetch YCOORD of POS) (WIDTHIFWINDOW (BITMAPWIDTH SPY.CLOSED)) (HEIGHTIFWINDOW (BITMAPHEIGHT SPY.CLOSED))) else (GETBOXREGION (WIDTHIFWINDOW (BITMAPWIDTH SPY.CLOSED)) (HEIGHTIFWINDOW (BITMAPHEIGHT SPY.CLOSED)) NIL NIL NIL "Specify region for window %"Spy Control%"")))) (BITBLT SPY.CLOSED NIL NIL (SETQ SPY.BUTTON (CREATEW REG NIL NIL T))) (WINDOWPROP SPY.BUTTON (QUOTE BUTTONEVENTFN) (FUNCTION (LAMBDA (W) (AND (LASTMOUSESTATE UP) (SPY.TOGGLE)))))))
@@ -855,8 +856,34 @@ Copyright (c) 1984-1985, 1987-1988, 1990-1991, 1993-1994 by Venue & Xerox Corpor
) )
(\SPY.INTERRUPT (\SPY.INTERRUPT
(LAMBDA NIL (* ; "Edited 9-Sep-87 18:32 by Masinter") (SETQ \PERIODIC.INTERRUPT) (* ; "turn off sampling while gathering sample") (PROG ((FRAME (fetch (FX CLINK) (\MYALINK)))) (COND ((IGEQ (if SPY.POINTERS then (LLSH SPY.NEXT 1) else SPY.NEXT) SPY.BUFFER.THRESHOLD) (COND (\INTERRUPTABLE (SPY.DUMP.BUFFER)) (T (* ; "this sample might overflow; just don't do it") (RETURN))))) (SPY.START.ENTRY) SAMPLELOOP (SPY.ADD.ENTRY (fetch (FX FRAMENAME) FRAME)) (COND ((NOT (fetch (FX INVALIDP) (SETQ FRAME (fetch (FX CLINK) FRAME)))) (GO SAMPLELOOP)) (T (SPY.END.ENTRY)))) (SETQ \PERIODIC.INTERRUPT (QUOTE \SPY.INTERRUPT))) [LAMBDA NIL (* ; "Edited 28-Jul-2023 08:59 by lmm")
) (* ; "Edited 9-Sep-87 18:32 by Masinter")
(DECLARE (SPECVARS \BACKGROUND))
[PROG [(FRAME (fetch (FX CLINK)
(\MYALINK]
(IF \BACKGROUND
THEN (RETURN))
(SETQ \PERIODIC.INTERRUPT) (* ;
 "turn off sampling while gathering sample")
[COND
((IGEQ (LLSH SPY.NEXT 1)
SPY.BUFFER.THRESHOLD)
(COND
(\INTERRUPTABLE (SPY.DUMP.BUFFER))
(T (* ;
 "this sample might overflow; just don't do it")
(RETURN]
(SPY.START.ENTRY)
SAMPLELOOP
(SPY.ADD.ENTRY (fetch (FX FRAMENAME)
FRAME))
(COND
([NOT (fetch (FX INVALIDP)
(SETQ FRAME (fetch (FX CLINK)
FRAME]
(GO SAMPLELOOP))
(T (SPY.END.ENTRY]
(SETQ \PERIODIC.INTERRUPT '\SPY.INTERRUPT])
(SPY.DUMP.BUFFER (SPY.DUMP.BUFFER
[LAMBDA NIL (* ; "Edited 28-Apr-94 14:00 by sybalsky") [LAMBDA NIL (* ; "Edited 28-Apr-94 14:00 by sybalsky")
@@ -885,8 +912,15 @@ Copyright (c) 1984-1985, 1987-1988, 1990-1991, 1993-1994 by Venue & Xerox Corpor
) )
(SPY.ADD.ENTRY (SPY.ADD.ENTRY
(LAMBDA (NAME) (* ; "Edited 9-Sep-87 18:29 by Masinter") (COND (SPY.POINTERS (\PUTBASEPTR SPY.BUFFER (LLSH SPY.NEXT 1) NAME) (COND ((IGEQ (LLSH (add SPY.NEXT 1) 1) SPY.BUFFER.SIZE) (SPY.OVERFLOW)))) (T (OR (LITATOM NAME) (SETQ NAME (QUOTE *FORM*))) (\PUTBASE SPY.BUFFER SPY.NEXT (\LOLOC NAME)) (COND ((IGEQ (add SPY.NEXT 1) SPY.BUFFER.SIZE) (SPY.OVERFLOW)))))) [LAMBDA (NAME) (* ; "Edited 28-Jul-2023 08:17 by lmm")
) (* ; "Edited 9-Sep-87 18:29 by Masinter")
(\PUTBASEPTR SPY.BUFFER (LLSH SPY.NEXT 1)
NAME)
(COND
((IGEQ (LLSH (add SPY.NEXT 1)
1)
SPY.BUFFER.SIZE)
(SPY.OVERFLOW])
(SPY.ORIGINAL (SPY.ORIGINAL
[LAMBDA (TREES) (* ; "Edited 28-Apr-94 14:00 by sybalsky") [LAMBDA (TREES) (* ; "Edited 28-Apr-94 14:00 by sybalsky")
@@ -951,6 +985,8 @@ Copyright (c) 1984-1985, 1987-1988, 1990-1991, 1993-1994 by Venue & Xerox Corpor
else (fetch (SPYRECORD NAME) of X]) else (fetch (SPYRECORD NAME) of X])
) )
(RPAQ? \BACKGROUND )
(RPAQ? SPY.BUTTON ) (RPAQ? SPY.BUTTON )
(RPAQQ SPY.OPEN #*(56 59)@@@@@@@@@@@@@@@@GLOLLC@@@@@@@@@@LFLFLC@@@@@@@@@@LFLFFF@@@@@@@@@@O@LFFF@@GLOL@@@@GLLFCL@@LFLF@@@@ANOLAH@@LFLF@@@@LFL@AH@@LFLF@@@@LFL@AH@@LFLF@@@@LFL@AH@@LFLF@@@@GLL@AH@@GLLF@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@IEGOOJ@@@@J@@HJ@@BOONHH@@BA@@@@HKOOOFNJHA@D@@HHBGOKNOEB@@@B@@@EDOMMBIGNJH@I@@@HBONJMEEKE@HA@@ECONMJB@KOOJCE@@@KOOJJHEAONHDJ@@KONJD@@@@AONIE@@GOMJH@@@BMOJEB@@FOB@@D@B@@AOEM@@GODDHA@@@AENMG@@KLH@@D@@@@BONM@@GM@HB@@@@BEFKG@@JJDBH@@@@@@INM@@ODA@DDD@@@BEOG@@@KJOMKB@@@AEEK@@JJEBNLIB@@DEOG@@DKNOKONHDDABFI@@BBKFOOMD@AAEFM@@IEIABEEOD@@@JJ@@EFLJKKGEB@EFEB@@J@@BOOHNHD@AEE@@EEEDONKEJ@EEBJ@@H@IOOOOOIEB@HD@@MDDOOOOMDHIEBJ@@BAOKOOOGONNJ@A@@HBKGOOOOOJKHBE@@DHLKMGMGOONJ@I@@@EMBOOJOOOKHBD@@BKDEOOJAOONJ@B@@BKIBOOHEOOOH@D@@HNDAONJBOJDDAA@@BO@DMGDEGOEB@A@@A@DBFJ@BL@@@@D@@@E@ICMAEOJDH@A@@B@@D@ADI@@@@BD@@HDA@JDBEFHH@@A@@@@@H@IDID@@B@D@@AA@A@@@B@A@@AA@@@@@D@@B@J@@A@A@@@@@H@@@D@@@@@J@@@A@@@D@AB@@@BA@@@@@@@@E@@@@@@D@@HH@@@B@@@@@@@B@@ (RPAQQ SPY.OPEN #*(56 59)@@@@@@@@@@@@@@@@GLOLLC@@@@@@@@@@LFLFLC@@@@@@@@@@LFLFFF@@@@@@@@@@O@LFFF@@GLOL@@@@GLLFCL@@LFLF@@@@ANOLAH@@LFLF@@@@LFL@AH@@LFLF@@@@LFL@AH@@LFLF@@@@LFL@AH@@LFLF@@@@GLL@AH@@GLLF@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@IEGOOJ@@@@J@@HJ@@BOONHH@@BA@@@@HKOOOFNJHA@D@@HHBGOKNOEB@@@B@@@EDOMMBIGNJH@I@@@HBONJMEEKE@HA@@ECONMJB@KOOJCE@@@KOOJJHEAONHDJ@@KONJD@@@@AONIE@@GOMJH@@@BMOJEB@@FOB@@D@B@@AOEM@@GODDHA@@@AENMG@@KLH@@D@@@@BONM@@GM@HB@@@@BEFKG@@JJDBH@@@@@@INM@@ODA@DDD@@@BEOG@@@KJOMKB@@@AEEK@@JJEBNLIB@@DEOG@@DKNOKONHDDABFI@@BBKFOOMD@AAEFM@@IEIABEEOD@@@JJ@@EFLJKKGEB@EFEB@@J@@BOOHNHD@AEE@@EEEDONKEJ@EEBJ@@H@IOOOOOIEB@HD@@MDDOOOOMDHIEBJ@@BAOKOOOGONNJ@A@@HBKGOOOOOJKHBE@@DHLKMGMGOONJ@I@@@EMBOOJOOOKHBD@@BKDEOOJAOONJ@B@@BKIBOOHEOOOH@D@@HNDAONJBOJDDAA@@BO@DMGDEGOEB@A@@A@DBFJ@BL@@@@D@@@E@ICMAEOJDH@A@@B@@D@ADI@@@@BD@@HDA@JDBEFHH@@A@@@@@H@IDID@@B@D@@AA@A@@@B@A@@AA@@@@@D@@B@J@@A@A@@@@@H@@@D@@@@@J@@@A@@@D@AB@@@BA@@@@@@@@E@@@@@@D@@HH@@@B@@@@@@@B@@
@@ -958,13 +994,15 @@ Copyright (c) 1984-1985, 1987-1988, 1990-1991, 1993-1994 by Venue & Xerox Corpor
(RPAQQ SPY.CLOSED #*(56 59)@@@@@@@@@@@@@@@@GLOLLC@@@@CHND@@LFLFLC@@@@FAHA@@LFLFFF@@@@FAH@@@O@LFFF@@GLOKNA@@GLLFCL@@LFFAH@@@ANOLAH@@LFFAHA@@LFL@AH@@LFFAH@@@LFL@AH@@LFFAHJ@@LFL@AH@@LFFAH@@@GLL@AH@@GLFAHB@@@@@@@@@@@@@@@D@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@A@@@@@IEGOOJ@@@@J@@HJ@@BOONHH@@BA@@@@HKOOOFNJHA@D@@HHBGOKNOEB@@@B@@@EDOMMBIGNJH@I@@@HBONJMEEKE@HA@@ECONMJB@KOOBCE@@@KOOJJHEAOOHDJ@@KONJD@@@@AONIE@@GOMJH@@@BMOJEB@@FOB@@D@B@@AOEM@@GODDHA@@@AENMG@@KLH@@D@@@@BONM@@GM@HB@@@@BEFKG@@JJDBH@@@@@@INM@@ODA@DDD@@@BEOG@@@KJOMKB@@@AEEK@@JJEBNLIB@@DEOG@@DKNOKONHDDABFI@@BBKFOOOD@AAEFM@@IEIABEGND@@@JJ@@EFLLDGGGB@EFEB@@J@@@@@IOHD@AEE@@EEAAEA@FI@EEBJ@@H@HDL@EAME@@HD@@MDEB@NHDJHDABJ@@BAB@@ABICF@J@A@@HB@KDDI@BLI@BE@@DID@A@@JHKDJ@I@@@D@DDDE@EBKEBD@@BAD@@@@A@OED@B@@BHAAAAA@CGNH@D@@H@D@@@@@MOE@AA@@BK@DDDDDGOJJ@A@@B@DA@B@CODFBBD@@EE@HBIAENK@@@A@@BLHBDDDON@@@BD@@KGDHJJIGJHB@@A@@BOBBECGOLB@B@D@@AAMLMKGOH@@@AA@@@GGONNON@H@A@A@@@IKKKKOLJ@@@@J@@@DFOKOO@D@@@BA@@@AEGMMD@A@@@@D@@HHBJMBLA@@@@@B@@ (RPAQQ SPY.CLOSED #*(56 59)@@@@@@@@@@@@@@@@GLOLLC@@@@CHND@@LFLFLC@@@@FAHA@@LFLFFF@@@@FAH@@@O@LFFF@@GLOKNA@@GLLFCL@@LFFAH@@@ANOLAH@@LFFAHA@@LFL@AH@@LFFAH@@@LFL@AH@@LFFAHJ@@LFL@AH@@LFFAH@@@GLL@AH@@GLFAHB@@@@@@@@@@@@@@@D@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@A@@@@@IEGOOJ@@@@J@@HJ@@BOONHH@@BA@@@@HKOOOFNJHA@D@@HHBGOKNOEB@@@B@@@EDOMMBIGNJH@I@@@HBONJMEEKE@HA@@ECONMJB@KOOBCE@@@KOOJJHEAOOHDJ@@KONJD@@@@AONIE@@GOMJH@@@BMOJEB@@FOB@@D@B@@AOEM@@GODDHA@@@AENMG@@KLH@@D@@@@BONM@@GM@HB@@@@BEFKG@@JJDBH@@@@@@INM@@ODA@DDD@@@BEOG@@@KJOMKB@@@AEEK@@JJEBNLIB@@DEOG@@DKNOKONHDDABFI@@BBKFOOOD@AAEFM@@IEIABEGND@@@JJ@@EFLLDGGGB@EFEB@@J@@@@@IOHD@AEE@@EEAAEA@FI@EEBJ@@H@HDL@EAME@@HD@@MDEB@NHDJHDABJ@@BAB@@ABICF@J@A@@HB@KDDI@BLI@BE@@DID@A@@JHKDJ@I@@@D@DDDE@EBKEBD@@BAD@@@@A@OED@B@@BHAAAAA@CGNH@D@@H@D@@@@@MOE@AA@@BK@DDDDDGOJJ@A@@B@DA@B@CODFBBD@@EE@HBIAENK@@@A@@BLHBDDDON@@@BD@@KGDHJJIGJHB@@A@@BOBBECGOLB@B@D@@AAMLMKGOH@@@AA@@@GGONNON@H@A@A@@@IKKKKOLJ@@@@J@@@DFOKOO@D@@@BA@@@AEGMMD@A@@@@D@@HHBJMBLA@@@@@B@@
) )
(DEFGLOBALVAR SPY.POINTERS T)
(DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SPY.OVERFLOWED \PERIODIC.INTERRUPT SPY.TREE SPY.BUFFER.SIZE SPY.NEXT SPY.BUFFER.THRESHOLD (GLOBALVARS SPY.OVERFLOWED \PERIODIC.INTERRUPT SPY.TREE SPY.BUFFER.SIZE SPY.NEXT SPY.BUFFER.THRESHOLD
SPY.BUFFER SPY.FREQUENCY SPY.SHOW.THRESHOLD SPY.MAXLINES SPY.FONT) SPY.BUFFER SPY.FREQUENCY SPY.SHOW.THRESHOLD SPY.MAXLINES SPY.FONT)
) )
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(SPECVARS \BACKGROUND)
)
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS WITH-SPY MACRO [(FORM) (PUTPROPS WITH-SPY MACRO [(FORM)
@@ -1014,19 +1052,18 @@ Copyright (c) 1984-1985, 1987-1988, 1990-1991, 1993-1994 by Venue & Xerox Corpor
) )
(MOVD? 'NILL 'MODERNWINDOW) (MOVD? 'NILL 'MODERNWINDOW)
(PUTPROPS SPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1987 1988 1990 1991 1993 1994))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (4753 7360 (SPYOBJ 4763 . 5052) (SPYOBJ.BUTTON 5054 . 5164) (SPYOBJ.SAVE 5166 . 5285) ( (FILEMAP (NIL (4707 7314 (SPYOBJ 4717 . 5006) (SPYOBJ.BUTTON 5008 . 5118) (SPYOBJ.SAVE 5120 . 5239) (
SPYOBJ.COPY 5287 . 5349) (SPYOBJ.GET 5351 . 5480) (SPYOBJ.IMAGEBOX 5482 . 6006) (SPYOBJ.DISPLAY 6008 SPYOBJ.COPY 5241 . 5303) (SPYOBJ.GET 5305 . 5434) (SPYOBJ.IMAGEBOX 5436 . 5960) (SPYOBJ.DISPLAY 5962
. 6307) (SPYOBJ.LABEL 6309 . 6445) (SPYOBJ.HEIGHT 6447 . 6660) (SPYOBJ.COPYIN 6662 . 6705) ( . 6261) (SPYOBJ.LABEL 6263 . 6399) (SPYOBJ.HEIGHT 6401 . 6614) (SPYOBJ.COPYIN 6616 . 6659) (
SPY.COPYBUTTON 6707 . 6799) (SPY.MERGEINFO 6801 . 7358)) (18202 59509 (SPY.FIND.TREE 18212 . 18621) ( SPY.COPYBUTTON 6661 . 6753) (SPY.MERGEINFO 6755 . 7312)) (18156 60387 (SPY.FIND.TREE 18166 . 18575) (
SPY.TOGGLE 18623 . 18813) (SPY.TREE 18815 . 19927) (SPY.LEGEND 19929 . 20279) (SPY.GRAPH.EDITOR 20281 SPY.TOGGLE 18577 . 18767) (SPY.TREE 18769 . 19881) (SPY.LEGEND 19883 . 20233) (SPY.GRAPH.EDITOR 20235
. 29846) (SPY.END 29848 . 30090) (SPY.MAKEGRAPHNODES 30092 . 32192) (SPY.MAX 32194 . 33077) ( . 29800) (SPY.END 29802 . 30044) (SPY.MAKEGRAPHNODES 30046 . 32146) (SPY.MAX 32148 . 33031) (
SPY.MERGE 33079 . 34510) (SPY.MERGE1 34512 . 40995) (SPY.MERGETREE 40997 . 43927) (SPY.NEXT.TREE 43929 SPY.MERGE 33033 . 34464) (SPY.MERGE1 34466 . 40949) (SPY.MERGETREE 40951 . 43881) (SPY.NEXT.TREE 43883
. 44603) (SPY.SUM 44605 . 45294) (SPY.TITLE 45296 . 45513) (SPY.MAKE.TREE 45515 . 47540) ( . 44557) (SPY.SUM 44559 . 45248) (SPY.TITLE 45250 . 45467) (SPY.MAKE.TREE 45469 . 47494) (
SPY.UPDATE.TITLE 47542 . 50118) (SPY.DELETE 50120 . 50655) (SPY.DRAWBOX 50657 . 51182) ( SPY.UPDATE.TITLE 47496 . 50072) (SPY.DELETE 50074 . 50609) (SPY.DRAWBOX 50611 . 51136) (
SPY.BUFFER.ENTRY 51184 . 51422) (SPY.BUTTON 51424 . 51993) (SPY.END.ENTRY 51995 . 52075) (SPY.START SPY.BUFFER.ENTRY 51138 . 51481) (SPY.BUTTON 51483 . 52052) (SPY.END.ENTRY 52054 . 52134) (SPY.START
52077 . 52361) (SPY.INIT 52363 . 52598) (\SPY.INTERRUPT 52600 . 53236) (SPY.DUMP.BUFFER 53238 . 54698) 52136 . 52420) (SPY.INIT 52422 . 52657) (\SPY.INTERRUPT 52659 . 54064) (SPY.DUMP.BUFFER 54066 . 55526)
(SPY.START.ENTRY 54700 . 54828) (SPY.ADD.ENTRY 54830 . 55212) (SPY.ORIGINAL 55214 . 56041) ( (SPY.START.ENTRY 55528 . 55656) (SPY.ADD.ENTRY 55658 . 56090) (SPY.ORIGINAL 56092 . 56919) (
SPY.OVERFLOW 56043 . 56144) (SPY.MERGE.CALLEES 56146 . 59182) (SPY.PRINT 59184 . 59507))))) SPY.OVERFLOW 56921 . 57022) (SPY.MERGE.CALLEES 57024 . 60060) (SPY.PRINT 60062 . 60385)))))
STOP STOP

BIN
library/SPY.LCOM
View File

Binary file not shown.

31
lispusers/BACKGROUND-YIELD
View File

@@ -1,21 +1,23 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Nov-2021 22:05:58" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;2 1597 (FILECREATED "28-Jul-2023 09:49:24" {DSK}<home>larry>il>medley>lispusers>BACKGROUND-YIELD.;2 1770
changes to%: (VARS BACKGROUND-YIELD) :EDIT-BY "lmm"
previous date%: "20-Sep-2021 11:37:28" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;1) :CHANGES-TO (FNS BACKGROUND-YIELD)
:PREVIOUS-DATE "14-Nov-2021 22:05:58" {DSK}<home>larry>il>medley>lispusers>BACKGROUND-YIELD.;1
)
(PRETTYCOMPRINT BACKGROUND-YIELDCOMS) (PRETTYCOMPRINT BACKGROUND-YIELDCOMS)
(RPAQQ BACKGROUND-YIELDCOMS ( (RPAQQ BACKGROUND-YIELDCOMS (
(* ;; (* ;; " Add a call to BACKGROUNDFNS to yield when not otherwise busy")
 " Add a call to BACKGROUNDFNS to yield when not otherwise busy")
(FNS BACKGROUND-YIELD INIT-YIELD) (FNS BACKGROUND-YIELD INIT-YIELD)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT-YIELD T))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT-YIELD T)))
(VARS BACKGROUND-YIELD))) (VARS BACKGROUND-YIELD)))
@@ -24,10 +26,13 @@
(DEFINEQ (DEFINEQ
(BACKGROUND-YIELD (BACKGROUND-YIELD
[LAMBDA NIL (* ; "Edited 20-Sep-2021 11:37 by larry") [LAMBDA NIL (* ; "Edited 28-Jul-2023 09:11 by lmm")
(IF (FIXP BACKGROUND-YIELD) (* ; "Edited 20-Sep-2021 11:37 by larry")
THEN (SUBRCALL YIELD BACKGROUND-YIELD) (LET ((\BACKGROUND T))
(SUBRCALL CAUSE-INTERRUPT]) (DECLARE (SPECVARS \BACKGROUND))
(IF (FIXP BACKGROUND-YIELD)
THEN (SUBRCALL YIELD BACKGROUND-YIELD)
(SUBRCALL CAUSE-INTERRUPT])
(INIT-YIELD (INIT-YIELD
[LAMBDA (ONP) (* ; "Edited 19-Sep-2021 13:32 by larry") [LAMBDA (ONP) (* ; "Edited 19-Sep-2021 13:32 by larry")
@@ -46,5 +51,5 @@
(RPAQQ BACKGROUND-YIELD 833333) (RPAQQ BACKGROUND-YIELD 833333)
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (833 1482 (BACKGROUND-YIELD 843 . 1098) (INIT-YIELD 1100 . 1480))))) (FILEMAP (NIL (806 1655 (BACKGROUND-YIELD 816 . 1271) (INIT-YIELD 1273 . 1653)))))
STOP STOP

BIN
lispusers/BACKGROUND-YIELD.LCOM
View File

Binary file not shown.

757
sources/PROC
View File

@@ -1,18 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Jun-99 21:58:52" {DSK}<project>medley3.5>sources>PROC.;2 173526
changes to%: (RECORDS MONITORLOCK) (FILECREATED "29-Jul-2023 11:47:41" {DSK}<home>larry>il>medley>sources>PROC.;7 176222
previous date%: "31-Jan-98 18:03:02" {DSK}<project>medley3.5>sources>PROC.;1) :EDIT-BY "lmm"
:CHANGES-TO (VARS PROCCOMS)
(FNS \BACKGROUND.PROCESS)
:PREVIOUS-DATE "28-Jul-2023 21:06:03" {DSK}<home>larry>il>medley>sources>PROC.;6)
(* ; "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1998, 1999 by Venue & 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) (PRETTYCOMPRINT PROCCOMS)
@@ -22,7 +18,7 @@ with the terms of said license.
(CONSTANTS \PSTAT.WAITING \PSTAT.RUNNING \PSTAT.DELETED)) (CONSTANTS \PSTAT.WAITING \PSTAT.RUNNING \PSTAT.DELETED))
(INITRECORDS PROCESS PROCESSQUEUE) (INITRECORDS PROCESS PROCESSQUEUE)
(SYSRECORDS PROCESS PROCESSQUEUE)) (SYSRECORDS PROCESS PROCESSQUEUE))
[COMS (* ; "User entries") [COMS (* ; "User entries")
(FNS PROCESSWORLD ADD.PROCESS DEL.PROCESS PROCESS.RETURN FIND.PROCESS MAP.PROCESSES (FNS PROCESSWORLD ADD.PROCESS DEL.PROCESS PROCESS.RETURN FIND.PROCESS MAP.PROCESSES
PROCESSP RELPROCESSP RESTART.PROCESS WAKE.PROCESS SUSPEND.PROCESS PROCESS.RESULT PROCESSP RELPROCESSP RESTART.PROCESS WAKE.PROCESS SUSPEND.PROCESS PROCESS.RESULT
PROCESS-STATUS PROCESS.FINISHEDP) PROCESS-STATUS PROCESS.FINISHEDP)
@@ -37,27 +33,27 @@ with the terms of said license.
(GLOBALVARS TTY.PROCESS.DEFAULT \TTY.PROCESS.EVENT \PROCESS.NAME.TABLE) (GLOBALVARS TTY.PROCESS.DEFAULT \TTY.PROCESS.EVENT \PROCESS.NAME.TABLE)
(FNS PROCESSPROP PROCESS.NAME PROCESS.WINDOW) (FNS PROCESSPROP PROCESS.NAME PROCESS.WINDOW)
(PROP ARGNAMES PROCESSPROP ADD.PROCESS) (PROP ARGNAMES PROCESSPROP ADD.PROCESS)
(COMS (* ; "Temporary") (COMS (* ; "Temporary")
(P (MOVD? 'PROCESS.RETURN 'KILL.ME NIL T] (P (MOVD? 'PROCESS.RETURN 'KILL.ME NIL T]
(COMS (FNS DISMISS BLOCK WAITFORINPUT \WAITFORSYSBUFP) (COMS (FNS DISMISS BLOCK WAITFORINPUT \WAITFORSYSBUFP)
(* ; "Used to be a GLOBALRESOURCES") (* ; "Used to be a GLOBALRESOURCES")
(DECLARE%: DONTCOPY (RESOURCES \DISMISSTIMER)) (DECLARE%: DONTCOPY (RESOURCES \DISMISSTIMER))
(INITRESOURCES \DISMISSTIMER)) (INITRESOURCES \DISMISSTIMER))
(COMS (FNS EVAL.AS.PROCESS EVAL.IN.TTY.PROCESS) (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") (* ;; "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) (MACROS PROCESS.WAIT)
(FNS PROCESS.READ PROCESS.EVALV PROCESS.EVAL \PROCESS.EVAL1 PROCESS.APPLY (FNS PROCESS.READ PROCESS.EVALV PROCESS.EVAL \PROCESS.EVAL1 PROCESS.APPLY
\PROCESS.APPLY1) \PROCESS.APPLY1)
(* ; (* ;
 "Standard values for WAKEREASON -- PSTAT.TIMEDOUT is the only public one")  "Standard values for WAKEREASON -- PSTAT.TIMEDOUT is the only public one")
(VARS (PSTAT.WAKEUP "default WakeUp") (VARS (PSTAT.WAKEUP "default WakeUp")
(PSTAT.TIMEDOUT "{time interval expired}") (PSTAT.TIMEDOUT "{time interval expired}")
(PSTAT.QUIT "Quit") (PSTAT.QUIT "Quit")
(\PSTAT.NORESULT "{no result yet}")) (\PSTAT.NORESULT "{no result yet}"))
(GLOBALVARS PSTAT.WAKEUP PSTAT.TIMEDOUT PSTAT.QUIT \PSTAT.NORESULT)) (GLOBALVARS PSTAT.WAKEUP PSTAT.TIMEDOUT PSTAT.QUIT \PSTAT.NORESULT))
(COMS (* ; "Event stuff") (COMS (* ; "Event stuff")
(DECLARE%: DONTCOPY (RECORDS EVENT)) (DECLARE%: DONTCOPY (RECORDS EVENT))
(INITRECORDS EVENT) (INITRECORDS EVENT)
(SYSRECORDS EVENT) (SYSRECORDS EVENT)
@@ -66,7 +62,7 @@ with the terms of said license.
(MACROS AWAIT.CONDITION) (MACROS AWAIT.CONDITION)
(INITVARS (\PROCESS.AFTEREXIT.EVENT)) (INITVARS (\PROCESS.AFTEREXIT.EVENT))
(GLOBALVARS \PROCESS.AFTEREXIT.EVENT)) (GLOBALVARS \PROCESS.AFTEREXIT.EVENT))
(COMS (* ; "Monitor stuff") (COMS (* ; "Monitor stuff")
(DECLARE%: DONTCOPY (RECORDS MONITORLOCK) (DECLARE%: DONTCOPY (RECORDS MONITORLOCK)
(MACROS .RELEASE.LOCK.)) (MACROS .RELEASE.LOCK.))
(INITRECORDS MONITORLOCK) (INITRECORDS MONITORLOCK)
@@ -74,7 +70,11 @@ with the terms of said license.
(FNS OBTAIN.MONITORLOCK CREATE.MONITORLOCK RELEASE.MONITORLOCK SI::MONITOR-UNWIND (FNS OBTAIN.MONITORLOCK CREATE.MONITORLOCK RELEASE.MONITORLOCK SI::MONITOR-UNWIND
MONITOR.AWAIT.EVENT \MONITORLOCK.DEFPRINT) MONITOR.AWAIT.EVENT \MONITORLOCK.DEFPRINT)
(MACROS WITH.MONITOR WITH.FAST.MONITOR)) (MACROS WITH.MONITOR WITH.FAST.MONITOR))
(COMS (FNS \MAKE.PROCESS0 \MAKE.PROCESS1 \PROCESS.MOVEFRAME \RELEASE.PROCESS \UNWIND.PROCESS (COMS (EXPORT (SPECVARS \BACKGROUND)
(GLOBALVARS \IGNORE.BACKGROUND))
(INITVARS (\BACKGROUND NIL)
(\IGNORE.BACKGROUND T))
(FNS \MAKE.PROCESS0 \MAKE.PROCESS1 \PROCESS.MOVEFRAME \RELEASE.PROCESS \UNWIND.PROCESS
\MAYBEBLOCK \BACKGROUND.PROCESS \MOUSE.PROCESS \TIMER.PROCESS \MAYBEBLOCK \BACKGROUND.PROCESS \MOUSE.PROCESS \TIMER.PROCESS
\PROCESS.RELEASE.LOCKS \SET.PROCESS.NAME \PROCESS.DEFPRINT) \PROCESS.RELEASE.LOCKS \SET.PROCESS.NAME \PROCESS.DEFPRINT)
(FNS \START.PROCESSES \PROCESS.GO.TO.SLEEP \PROC.RESUME \RUN.PROCESS \SUSPEND.PROCESS (FNS \START.PROCESSES \PROCESS.GO.TO.SLEEP \PROC.RESUME \RUN.PROCESS \SUSPEND.PROCESS
@@ -82,9 +82,9 @@ with the terms of said license.
(DECLARE%: DONTCOPY (MACROS \RESCHEDULE))) (DECLARE%: DONTCOPY (MACROS \RESCHEDULE)))
(COMS (FNS \PROCESS.INIT \PROCESS.EVENTFN \PROCESS.BEFORE.LOGOUT \PROCESS.AFTER.EXIT (COMS (FNS \PROCESS.INIT \PROCESS.EVENTFN \PROCESS.BEFORE.LOGOUT \PROCESS.AFTER.EXIT
\PROCESS.RESET.TIMERS \PROC.AFTER.WINDOWWORLD \TURN.ON.PROCESSES) \PROCESS.RESET.TIMERS \PROC.AFTER.WINDOWWORLD \TURN.ON.PROCESSES)
(* ; "Redefinitions") (* ; "Redefinitions")
(FNS \PROC.CODEFORTFRAME \PROC.REPEATEDLYEVALQT)) (FNS \PROC.CODEFORTFRAME \PROC.REPEATEDLYEVALQT))
(COMS (* ; "switching stacks") (COMS (* ; "switching stacks")
(FNS BREAK.PROCESS \SELECTPROCESS \PROCESS.MAKEFRAME \PROCESS.MAKEFRAME0)) (FNS BREAK.PROCESS \SELECTPROCESS \PROCESS.MAKEFRAME \PROCESS.MAKEFRAME0))
(INITVARS (%#MYHANDLE#) (INITVARS (%#MYHANDLE#)
(%#SCHEDULER#) (%#SCHEDULER#)
@@ -117,7 +117,7 @@ with the terms of said license.
PROC.DEFAULT.PRIORITY \PROC.RUN.NEXT.FLG \SYSTEMTIMERVARS) PROC.DEFAULT.PRIORITY \PROC.RUN.NEXT.FLG \SYSTEMTIMERVARS)
(MACROS ALIVEPROCP DEADPROCP \COERCE.TO.PROCESS) (MACROS ALIVEPROCP DEADPROCP \COERCE.TO.PROCESS)
(LOCALVARS . T))) (LOCALVARS . T)))
(COMS (* ; "Debugging") (COMS (* ; "Debugging")
(FNS \CHECK.PQUEUE) (FNS \CHECK.PQUEUE)
(FNS PPROC PPROCWINDOW PPROCREPAINTFN PPROCRESHAPEFN PPROCEXTENT PPROC1 (FNS PPROC PPROCWINDOW PPROCREPAINTFN PPROCRESHAPEFN PPROCEXTENT PPROC1
PROCESS.STATUS.WINDOW \PSW.SELECTED \PSWOP.SELECTED PROCESS.BACKTRACE PROCESS.STATUS.WINDOW \PSW.SELECTED \PSWOP.SELECTED PROCESS.BACKTRACE
@@ -139,8 +139,8 @@ with the terms of said license.
(P (DEFPRINT 'PROCESS (FUNCTION \PROCESS.DEFPRINT)) (P (DEFPRINT 'PROCESS (FUNCTION \PROCESS.DEFPRINT))
(DEFPRINT 'EVENT (FUNCTION \EVENT.DEFPRINT)) (DEFPRINT 'EVENT (FUNCTION \EVENT.DEFPRINT))
(DEFPRINT 'MONITORLOCK (FUNCTION \MONITORLOCK.DEFPRINT)) (DEFPRINT 'MONITORLOCK (FUNCTION \MONITORLOCK.DEFPRINT))
(* ; (* ;
 "\process.init must come last, since it does a HARDRESET")  "\process.init must come last, since it does a HARDRESET")
(\PROCESS.INIT))) (\PROCESS.INIT)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML) (NLAML)
@@ -149,80 +149,80 @@ with the terms of said license.
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DATATYPE PROCESS ((PROCFX0 WORD) (* ; (DATATYPE PROCESS ((PROCFX0 WORD) (* ;
 "= \STACKHI to make this look like a STACKP")  "= \STACKHI to make this look like a STACKP")
(PROCFX WORD) (* ; (PROCFX WORD) (* ;
 "Stack pointer to this context when it is asleep")  "Stack pointer to this context when it is asleep")
(PROCSTATUS BYTE) (* ; "Running or waiting") (PROCSTATUS BYTE) (* ; "Running or waiting")
(PROCNAME POINTER) (* ; (PROCNAME POINTER) (* ;
 "Name for convenience in type-in reference")  "Name for convenience in type-in reference")
(PROCPRIORITY BYTE) (* ; (PROCPRIORITY BYTE) (* ;
 "Priority level, 0-4. Not currently used.")  "Priority level, 0-4. Not currently used.")
(PROCQUEUE POINTER) (* ; (PROCQUEUE POINTER) (* ;
 "Queue of processes at the same priority")  "Queue of processes at the same priority")
(NIL BYTE) (NIL BYTE)
(NEXTPROCHANDLE POINTER) (* ; "Pointer to next one") (NEXTPROCHANDLE POINTER) (* ; "Pointer to next one")
(PROCTIMERSET FLAG) (* ; (PROCTIMERSET FLAG) (* ;
 "True if PROCWAKEUPTIMER has an interesting value")  "True if PROCWAKEUPTIMER has an interesting value")
(PROCBEINGDELETED FLAG) (* ; (PROCBEINGDELETED FLAG) (* ;
 "True if proc was deleted, but hasn't been removed from \PROCESSES yet")  "True if proc was deleted, but hasn't been removed from \PROCESSES yet")
(PROCDELETED FLAG) (PROCDELETED FLAG)
(PROCSYSTEMP FLAG) (PROCSYSTEMP FLAG)
(PROCNEVERSTARTED FLAG) (PROCNEVERSTARTED FLAG)
(NIL FLAG) (NIL FLAG)
(NIL FLAG) (NIL FLAG)
(NIL FLAG) (NIL FLAG)
(PROCWAKEUPTIMER POINTER) (* ; (PROCWAKEUPTIMER POINTER) (* ;
 "a largep recording the time this proc last went to sleep")  "a largep recording the time this proc last went to sleep")
(PROCTIMERLINK POINTER) (* ; "For linking proc in timer queue") (PROCTIMERLINK POINTER) (* ; "For linking proc in timer queue")
(PROCTIMERBOX POINTER) (* ; (PROCTIMERBOX POINTER) (* ;
 "Scratch box to use for PROCWAKEUPTIMER when user does not give one explicitly")  "Scratch box to use for PROCWAKEUPTIMER when user does not give one explicitly")
(WAKEREASON POINTER) (* ; (WAKEREASON POINTER) (* ;
 "Reason process is being run. From WAKE.PROCESS or timer or event wakeup; T from simple BLOCK")  "Reason process is being run. From WAKE.PROCESS or timer or event wakeup; T from simple BLOCK")
(PROCEVENTORLOCK POINTER) (* ; (PROCEVENTORLOCK POINTER) (* ;
 "EVENT or MONITOR lock that this proc is waiting for")  "EVENT or MONITOR lock that this proc is waiting for")
(PROCFORM POINTER) (* ; "Form to EVAL to start it going") (PROCFORM POINTER) (* ; "Form to EVAL to start it going")
(RESTARTABLE POINTER) (* ; (RESTARTABLE POINTER) (* ;
 "T = autorestart on error, HARDRESET = restart only on hard reset, NIL = never restart")  "T = autorestart on error, HARDRESET = restart only on hard reset, NIL = never restart")
(PROCWINDOW POINTER) (* ; (PROCWINDOW POINTER) (* ;
 "Window this process lives in, if any")  "Window this process lives in, if any")
(PROCFINISHED POINTER) (* ; (PROCFINISHED POINTER) (* ;
 "True if proc finished. Value is indication of how: NORMAL, DELETED, ERROR")  "True if proc finished. Value is indication of how: NORMAL, DELETED, ERROR")
(PROCRESULT POINTER) (* ; (PROCRESULT POINTER) (* ;
 "Value it returned if it finished normally")  "Value it returned if it finished normally")
(PROCFINISHEVENT POINTER) (* ; (PROCFINISHEVENT POINTER) (* ;
 "Optional EVENT to be notified when proc finishes")  "Optional EVENT to be notified when proc finishes")
(PROCMAILBOX POINTER) (* ; "Message queue") (PROCMAILBOX POINTER) (* ; "Message queue")
(PROCDRIBBLEOUTPUT POINTER) (* ; (PROCDRIBBLEOUTPUT POINTER) (* ;
 "Binding for *DRIBBLE-OUTPUT* in this process")  "Binding for *DRIBBLE-OUTPUT* in this process")
(PROCINFOHOOK POINTER) (* ; (PROCINFOHOOK POINTER) (* ;
 "Optional user fn that displays info about process")  "Optional user fn that displays info about process")
(PROCTYPEAHEAD POINTER) (* ; (PROCTYPEAHEAD POINTER) (* ;
 "Buffer of typeahead destined for this proc")  "Buffer of typeahead destined for this proc")
(PROCREMOTEINFO POINTER) (* ; "For Enterprise") (PROCREMOTEINFO POINTER) (* ; "For Enterprise")
(PROCUSERDATA POINTER) (* ; "For PROCESSPROP") (PROCUSERDATA POINTER) (* ; "For PROCESSPROP")
(PROCEVENTLINK POINTER) (* ; "Used to maintain EVENT queues") (PROCEVENTLINK POINTER) (* ; "Used to maintain EVENT queues")
(PROCAFTEREXIT POINTER) (* ; (PROCAFTEREXIT POINTER) (* ;
 "What to do with this process when coming back from a LOGOUT, etc")  "What to do with this process when coming back from a LOGOUT, etc")
(PROCBEFOREEXIT POINTER) (* ; "If DON'T, can't logout") (PROCBEFOREEXIT POINTER) (* ; "If DON'T, can't logout")
(PROCOWNEDLOCKS POINTER) (* ; (PROCOWNEDLOCKS POINTER) (* ;
 "Pointer to first lock I currently own")  "Pointer to first lock I currently own")
(PROCEVAPPLYRESULT POINTER) (* ; (PROCEVAPPLYRESULT POINTER) (* ;
 "For PROCESS.EVAL and PROCESS.APPLY when WAITFORRESULT is true")  "For PROCESS.EVAL and PROCESS.APPLY when WAITFORRESULT is true")
(PROCTTYENTRYFN POINTER) (* ; (PROCTTYENTRYFN POINTER) (* ;
 "Is applied to a process when it becomes the tty process")  "Is applied to a process when it becomes the tty process")
(PROCTTYEXITFN POINTER) (* ; (PROCTTYEXITFN POINTER) (* ;
 "Is applied to a process when it ceases to be the tty process")  "Is applied to a process when it ceases to be the tty process")
(PROCHARDRESETINFO POINTER) (* ; (PROCHARDRESETINFO POINTER) (* ;
 "HARDRESET stores info about unwind-protect cleanups here")  "HARDRESET stores info about unwind-protect cleanups here")
(PROCRESTARTFORM POINTER) (* ; (PROCRESTARTFORM POINTER) (* ;
 "use this instead of PROCFORM when restarting")  "use this instead of PROCFORM when restarting")
(PROCOLDTTYPROC POINTER) (* ; (PROCOLDTTYPROC POINTER) (* ;
 "Process that had the tty when we got it")  "Process that had the tty when we got it")
(NIL POINTER) (* ; "For expansion") (NIL POINTER) (* ; "For expansion")
) )
PROCTIMERBOX _ (CREATECELL \FIXP) PROCTIMERBOX _ (CREATECELL \FIXP)
PROCFX0 _ \STACKHI) PROCFX0 _ \STACKHI)
) )
(/DECLAREDATATYPE 'PROCESS (/DECLAREDATATYPE 'PROCESS
@@ -281,15 +281,15 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(DATATYPE PROCESSQUEUE ((PQPRIORITY BYTE) (* ; (DATATYPE PROCESSQUEUE ((PQPRIORITY BYTE) (* ;
 "Priority for the processes in thie queue.")  "Priority for the processes in thie queue.")
(PQHIGHER POINTER) (* ; "Next higher-prioirty queue") (PQHIGHER POINTER) (* ; "Next higher-prioirty queue")
(PQLOWER POINTER) (* ; "Next lower") (PQLOWER POINTER) (* ; "Next lower")
(PQNEXT POINTER) (* ; (PQNEXT POINTER) (* ;
 "The process currently running or runnable at this priority")  "The process currently running or runnable at this priority")
(PQLAST POINTER) (* ; (PQLAST POINTER) (* ;
 "The proc previous to it. PQNEXT might be redundant")  "The proc previous to it. PQNEXT might be redundant")
)) ))
) )
(/DECLAREDATATYPE 'PROCESSQUEUE '(BYTE POINTER POINTER POINTER POINTER) (/DECLAREDATATYPE 'PROCESSQUEUE '(BYTE POINTER POINTER POINTER POINTER)
@@ -374,55 +374,55 @@ with the terms of said license.
(ADDTOVAR SYSTEMRECLST (ADDTOVAR SYSTEMRECLST
(DATATYPE PROCESS ((PROCFX0 WORD) (DATATYPE PROCESS ((PROCFX0 WORD)
(PROCFX WORD) (PROCFX WORD)
(PROCSTATUS BYTE) (PROCSTATUS BYTE)
(PROCNAME POINTER) (PROCNAME POINTER)
(PROCPRIORITY BYTE) (PROCPRIORITY BYTE)
(PROCQUEUE POINTER) (PROCQUEUE POINTER)
(NIL BYTE) (NIL BYTE)
(NEXTPROCHANDLE POINTER) (NEXTPROCHANDLE POINTER)
(PROCTIMERSET FLAG) (PROCTIMERSET FLAG)
(PROCBEINGDELETED FLAG) (PROCBEINGDELETED FLAG)
(PROCDELETED FLAG) (PROCDELETED FLAG)
(PROCSYSTEMP FLAG) (PROCSYSTEMP FLAG)
(PROCNEVERSTARTED FLAG) (PROCNEVERSTARTED FLAG)
(NIL FLAG) (NIL FLAG)
(NIL FLAG) (NIL FLAG)
(NIL FLAG) (NIL FLAG)
(PROCWAKEUPTIMER POINTER) (PROCWAKEUPTIMER POINTER)
(PROCTIMERLINK POINTER) (PROCTIMERLINK POINTER)
(PROCTIMERBOX POINTER) (PROCTIMERBOX POINTER)
(WAKEREASON POINTER) (WAKEREASON POINTER)
(PROCEVENTORLOCK POINTER) (PROCEVENTORLOCK POINTER)
(PROCFORM POINTER) (PROCFORM POINTER)
(RESTARTABLE POINTER) (RESTARTABLE POINTER)
(PROCWINDOW POINTER) (PROCWINDOW POINTER)
(PROCFINISHED POINTER) (PROCFINISHED POINTER)
(PROCRESULT POINTER) (PROCRESULT POINTER)
(PROCFINISHEVENT POINTER) (PROCFINISHEVENT POINTER)
(PROCMAILBOX POINTER) (PROCMAILBOX POINTER)
(PROCDRIBBLEOUTPUT POINTER) (PROCDRIBBLEOUTPUT POINTER)
(PROCINFOHOOK POINTER) (PROCINFOHOOK POINTER)
(PROCTYPEAHEAD POINTER) (PROCTYPEAHEAD POINTER)
(PROCREMOTEINFO POINTER) (PROCREMOTEINFO POINTER)
(PROCUSERDATA POINTER) (PROCUSERDATA POINTER)
(PROCEVENTLINK POINTER) (PROCEVENTLINK POINTER)
(PROCAFTEREXIT POINTER) (PROCAFTEREXIT POINTER)
(PROCBEFOREEXIT POINTER) (PROCBEFOREEXIT POINTER)
(PROCOWNEDLOCKS POINTER) (PROCOWNEDLOCKS POINTER)
(PROCEVAPPLYRESULT POINTER) (PROCEVAPPLYRESULT POINTER)
(PROCTTYENTRYFN POINTER) (PROCTTYENTRYFN POINTER)
(PROCTTYEXITFN POINTER) (PROCTTYEXITFN POINTER)
(PROCHARDRESETINFO POINTER) (PROCHARDRESETINFO POINTER)
(PROCRESTARTFORM POINTER) (PROCRESTARTFORM POINTER)
(PROCOLDTTYPROC POINTER) (PROCOLDTTYPROC POINTER)
(NIL POINTER))) (NIL POINTER)))
(DATATYPE PROCESSQUEUE ((PQPRIORITY BYTE) (DATATYPE PROCESSQUEUE ((PQPRIORITY BYTE)
(PQHIGHER POINTER) (PQHIGHER POINTER)
(PQLOWER POINTER) (PQLOWER POINTER)
(PQNEXT POINTER) (PQNEXT POINTER)
(PQLAST POINTER))) (PQLAST POINTER)))
) )
@@ -1064,7 +1064,7 @@ with the terms of said license.
(RPAQ? \TTY.PROCESS ) (RPAQ? \TTY.PROCESS )
(RPAQ? \PROCESS.NAME.TABLE (HASHARRAY 30 NIL (FUNCTION STRING-EQUAL-HASHBITS) (RPAQ? \PROCESS.NAME.TABLE (HASHARRAY 30 NIL (FUNCTION STRING-EQUAL-HASHBITS)
(FUNCTION STRING-EQUAL))) (FUNCTION STRING-EQUAL)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TTY.PROCESS.DEFAULT \TTY.PROCESS.EVENT \PROCESS.NAME.TABLE) (GLOBALVARS TTY.PROCESS.DEFAULT \TTY.PROCESS.EVENT \PROCESS.NAME.TABLE)
@@ -1302,14 +1302,12 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS PROCESS.WAIT MACRO (PUTPROPS PROCESS.WAIT MACRO [(WAITCOND TIMEOUT)
[(WAITCOND TIMEOUT) (bind ($$TIMEOUT _ (AND TIMEOUT (SETUPTIMER TIMEOUT)))
(bind ($$TIMEOUT _ (AND TIMEOUT (SETUPTIMER TIMEOUT))) until (AND $$TIMEOUT ( until (AND $$TIMEOUT (TIMEREXPIRED? $$TIMEOUT))
TIMEREXPIRED? do (if (SETQ $$VAL WAITCOND)
$$TIMEOUT)) then (RETURN $$VAL)
do (if (SETQ $$VAL WAITCOND) else (BLOCK])
then (RETURN $$VAL)
else (BLOCK])
) )
(DEFINEQ (DEFINEQ
@@ -1452,20 +1450,19 @@ with the terms of said license.
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(DATATYPE EVENT ((EVENTWAKEUPPENDING FLAG) (* ; (DATATYPE EVENT ((EVENTWAKEUPPENDING FLAG) (* ;
 "True if this event was signaled with nobody waiting on it")  "True if this event was signaled with nobody waiting on it")
(NIL BITS 3) (NIL BITS 3)
(EVENTQUEUETAIL POINTER) (* ; (EVENTQUEUETAIL POINTER) (* ;
 "Pointer to last process waiting on this event")  "Pointer to last process waiting on this event")
(EVENTNAME POINTER) (* ; (EVENTNAME POINTER) (* ;
 "Optional name of EVENT for status window, debugging, etc")  "Optional name of EVENT for status window, debugging, etc")
) )
(ACCESSFNS EVENT ((EVLOCKQUEUETAIL (ffetch EVENTQUEUETAIL of DATUM) (ACCESSFNS EVENT ((EVLOCKQUEUETAIL (ffetch EVENTQUEUETAIL of DATUM)
(freplace EVENTQUEUETAIL of DATUM with (freplace EVENTQUEUETAIL of DATUM with NEWVALUE)))
NEWVALUE))) (* ;
(* ;  "Used by both EVENT and MONITORLOCK data")
 "Used by both EVENT and MONITORLOCK data") ))
))
) )
(/DECLAREDATATYPE 'EVENT '(FLAG (BITS 3) (/DECLAREDATATYPE 'EVENT '(FLAG (BITS 3)
@@ -1487,9 +1484,9 @@ with the terms of said license.
(ADDTOVAR SYSTEMRECLST (ADDTOVAR SYSTEMRECLST
(DATATYPE EVENT ((EVENTWAKEUPPENDING FLAG) (DATATYPE EVENT ((EVENTWAKEUPPENDING FLAG)
(NIL BITS 3) (NIL BITS 3)
(EVENTQUEUETAIL POINTER) (EVENTQUEUETAIL POINTER)
(EVENTNAME POINTER))) (EVENTNAME POINTER)))
) )
(DEFINEQ (DEFINEQ
@@ -1593,17 +1590,17 @@ with the terms of said license.
) )
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS AWAIT.CONDITION MACRO (PUTPROPS AWAIT.CONDITION MACRO [(CONDITION EVNT TIMEOUT TIMERP)
[(CONDITION EVNT TIMEOUT TIMERP) (PROG [($$TIMER TIMEOUT)
(PROG [($$TIMER TIMEOUT) ($$EV (\DTEST EVNT 'EVENT]
($$EV (\DTEST EVNT 'EVENT] (DECLARE (LOCALVARS $$TIMER $$EV))
(DECLARE (LOCALVARS $$TIMER $$EV)) LP (RETURN (OR CONDITION (COND
LP (RETURN (OR CONDITION (COND ((NEQ (\PROCESS.GO.TO.SLEEP $$EV
((NEQ (\PROCESS.GO.TO.SLEEP $$EV $$TIMER TIMERP) $$TIMER TIMERP)
$$EV) $$EV)
NIL) NIL)
(T (AND $$TIMER (SETQ $$TIMER T)) (T (AND $$TIMER (SETQ $$TIMER T))
(GO LP]) (GO LP])
) )
(RPAQ? \PROCESS.AFTEREXIT.EVENT ) (RPAQ? \PROCESS.AFTEREXIT.EVENT )
@@ -1620,17 +1617,16 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(DATATYPE MONITORLOCK ((NIL FLAG) (DATATYPE MONITORLOCK ((NIL FLAG)
(MLOCKPERPROCESS FLAG) (* ; (MLOCKPERPROCESS FLAG) (* ;
 "Monitor's use by anybody in process lets everyone in that proc use it, the normal case")  "Monitor's use by anybody in process lets everyone in that proc use it, the normal case")
(NIL BITS 2) (NIL BITS 2)
(MLOCKQUEUETAIL POINTER) (* ; (MLOCKQUEUETAIL POINTER) (* ;
 "Last process waiting for monitor to become available")  "Last process waiting for monitor to become available")
(MLOCKOWNER POINTER) (* ; "Process owning it") (MLOCKOWNER POINTER) (* ; "Process owning it")
(MLOCKNAME POINTER) (* ; (MLOCKNAME POINTER) (* ; "optional name, for debugging, etc")
 "optional name, for debugging, etc") (MLOCKLINK POINTER) (* ;
(MLOCKLINK POINTER) (* ;  "Link to next lock owned by my owner")
 "Link to next lock owned by my owner") ))
))
) )
(/DECLAREDATATYPE 'MONITORLOCK '(FLAG FLAG (BITS 2) (/DECLAREDATATYPE 'MONITORLOCK '(FLAG FLAG (BITS 2)
@@ -1646,46 +1642,48 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS .RELEASE.LOCK. MACRO (PUTPROPS .RELEASE.LOCK. MACRO [(LOCK EVENIFNOTMINE)
[(LOCK EVENIFNOTMINE) (UNINTERRUPTABLY
(UNINTERRUPTABLY [PROG ((OWNER (ffetch MLOCKOWNER of LOCK))
[PROG ((OWNER (ffetch MLOCKOWNER of LOCK)) TAIL PREV NEXTPROC)
TAIL PREV NEXTPROC) (COND
(COND ((OR (NULL OWNER)
((OR (NULL OWNER) (AND (NEQ OWNER (THIS.PROCESS))
(AND (NEQ OWNER (THIS.PROCESS)) (NOT EVENIFNOTMINE)))
(NOT EVENIFNOTMINE))) (RETURN)))
(RETURN))) (freplace MLOCKOWNER of LOCK with NIL)
(freplace MLOCKOWNER of LOCK with NIL) (* ;
(* ;  "Now remove LOCK from my list of owned locks")
 "Now remove LOCK from my list of owned locks") [COND
[COND ((EQ (SETQ PREV (fetch PROCOWNEDLOCKS of OWNER))
((EQ (SETQ PREV (fetch PROCOWNEDLOCKS of OWNER)) LOCK)
LOCK) (replace PROCOWNEDLOCKS of OWNER
(replace PROCOWNEDLOCKS of OWNER with (ffetch MLOCKLINK with (ffetch MLOCKLINK of LOCK)))
of LOCK))) (T (do (COND
(T (do (COND ((NULL PREV)
((NULL PREV) (RETURN (\MP.ERROR \MP.PROCERROR
(RETURN (\MP.ERROR \MP.PROCERROR "Lock not found among owner's owned locks"
"Lock not found among owner's owned locks" LOCK))) LOCK)))
[(EQ (fetch MLOCKLINK of PREV) [(EQ (fetch MLOCKLINK of PREV)
LOCK) LOCK)
(RETURN (replace MLOCKLINK of PREV (RETURN (replace MLOCKLINK of PREV
with (ffetch MLOCKLINK of LOCK] with (ffetch MLOCKLINK
(T (SETQ PREV (fetch MLOCKLINK of PREV] of LOCK]
(freplace MLOCKLINK of LOCK with NIL) (T (SETQ PREV (fetch MLOCKLINK of PREV]
(COND (freplace MLOCKLINK of LOCK with NIL)
((SETQ TAIL (ffetch MLOCKQUEUETAIL of LOCK)) (COND
(SETQ NEXTPROC (fetch PROCEVENTLINK of TAIL)) ((SETQ TAIL (ffetch MLOCKQUEUETAIL of LOCK))
[COND (SETQ NEXTPROC (fetch PROCEVENTLINK of TAIL))
((EQ NEXTPROC TAIL) (* ; "Only one process in queue") [COND
(freplace MLOCKQUEUETAIL of LOCK with NIL)) ((EQ NEXTPROC TAIL)
(T (replace PROCEVENTLINK of TAIL with (fetch PROCEVENTLINK (* ; "Only one process in queue")
of NEXTPROC] (freplace MLOCKQUEUETAIL of LOCK with NIL))
(replace PROCEVENTLINK of NEXTPROC with (replace PROCEVENTORLOCK (T (replace PROCEVENTLINK of TAIL
of NEXTPROC with with (fetch PROCEVENTLINK of NEXTPROC]
NIL)) (replace PROCEVENTLINK of NEXTPROC
(\RUN.PROCESS NEXTPROC LOCK])]) with (replace PROCEVENTORLOCK of NEXTPROC
with NIL))
(\RUN.PROCESS NEXTPROC LOCK])])
) )
) )
@@ -1702,12 +1700,12 @@ with the terms of said license.
(ADDTOVAR SYSTEMRECLST (ADDTOVAR SYSTEMRECLST
(DATATYPE MONITORLOCK ((NIL FLAG) (DATATYPE MONITORLOCK ((NIL FLAG)
(MLOCKPERPROCESS FLAG) (MLOCKPERPROCESS FLAG)
(NIL BITS 2) (NIL BITS 2)
(MLOCKQUEUETAIL POINTER) (MLOCKQUEUETAIL POINTER)
(MLOCKOWNER POINTER) (MLOCKOWNER POINTER)
(MLOCKNAME POINTER) (MLOCKNAME POINTER)
(MLOCKLINK POINTER))) (MLOCKLINK POINTER)))
) )
(DEFINEQ (DEFINEQ
@@ -1804,23 +1802,36 @@ with the terms of said license.
) )
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS WITH.MONITOR MACRO (PUTPROPS WITH.MONITOR MACRO [(LOCK . FORMS)
[(LOCK . FORMS) (LET (SI::*LOCKED-MONITOR* SI::*RESETFORMS*)
(LET (SI::*LOCKED-MONITOR* SI::*RESETFORMS*) (DECLARE (CL:SPECIAL SI::*LOCKED-MONITOR* SI::*RESETFORMS*))
(DECLARE (CL:SPECIAL SI::*LOCKED-MONITOR* SI::*RESETFORMS*)) (CL:UNWIND-PROTECT
(CL:UNWIND-PROTECT (PROGN (OBTAIN.MONITORLOCK LOCK NIL 'WITH.MONITOR) . FORMS)
(PROGN (OBTAIN.MONITORLOCK LOCK NIL 'WITH.MONITOR) . FORMS) (SI::MONITOR-UNWIND))])
(SI::MONITOR-UNWIND))])
(PUTPROPS WITH.FAST.MONITOR MACRO (PUTPROPS WITH.FAST.MONITOR MACRO [(LOCK . FORMS)
[(LOCK . FORMS) (UNINTERRUPTABLY
(UNINTERRUPTABLY ([LAMBDA (UNLOCK)
([LAMBDA (UNLOCK) (PROG1 (PROGN . FORMS)
(PROG1 (PROGN . FORMS) (AND (NEQ UNLOCK T)
(AND (NEQ UNLOCK T) (RELEASE.MONITORLOCK UNLOCK)))]
(RELEASE.MONITORLOCK UNLOCK)))] (OBTAIN.MONITORLOCK LOCK)))])
(OBTAIN.MONITORLOCK LOCK)))])
) )
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY
(SPECVARS \BACKGROUND)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IGNORE.BACKGROUND)
)
(* "END EXPORTED DEFINITIONS")
(RPAQ? \BACKGROUND NIL)
(RPAQ? \IGNORE.BACKGROUND T)
(DEFINEQ (DEFINEQ
(\MAKE.PROCESS0 (\MAKE.PROCESS0
@@ -2096,9 +2107,13 @@ with the terms of said license.
(\INTERRUPTABLE (BLOCK]) (\INTERRUPTABLE (BLOCK])
(\BACKGROUND.PROCESS (\BACKGROUND.PROCESS
[LAMBDA NIL (* bvm%: "24-JUL-83 15:35") [LAMBDA NIL (* ; "Edited 28-Jul-2023 21:01 by lmm")
(PROG NIL (* bvm%: "24-JUL-83 15:35")
LP (for FN in BACKGROUNDFNS do (SPREADAPPLY* FN)) (PROG ((\BACKGROUND \IGNORE.BACKGROUND))
(DECLARE (SPECVARS \BACKGROUND)
(GLOBALVARS \IGNORE.BACKGROUND))
LP (SETQ \BACKGROUND \IGNORE.BACKGROUND)
(for FN in BACKGROUNDFNS do (SPREADAPPLY* FN))
(BLOCK) (BLOCK)
(GO LP]) (GO LP])
@@ -2460,51 +2475,53 @@ with the terms of said license.
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS \RESCHEDULE MACRO (PUTPROPS \RESCHEDULE MACRO [LAMBDA (OLDPROC)
[LAMBDA (OLDPROC)
(* ;; "Causes process switch, saving current context in OLDPROC's handle, or nowhere if OLDPROC is NIL. Must be called uninterruptably!") (* ;; "Causes process switch, saving current context in OLDPROC's handle, or nowhere if OLDPROC is NIL. Must be called uninterruptably!")
(PROG (PQUEUE PROC) (PROG (PQUEUE PROC)
TOP TOP
(* ;; "Maybe check for events here?") (* ;; "Maybe check for events here?")
(SETQ PQUEUE \HIGHEST.PRIORITY.QUEUE) (SETQ PQUEUE \HIGHEST.PRIORITY.QUEUE)
LP (COND LP (COND
((SETQ PROC (fetch PQNEXT of PQUEUE)) ((SETQ PROC (fetch PQNEXT of PQUEUE))
[COND [COND
((NEQ PROC OLDPROC) (* ; ((NEQ PROC OLDPROC)
 "Yes, there is a process switch required here. Below is roughly the body of RESUME") (* ;
(LET ((TOFX (fetch PROCFX of PROC))  "Yes, there is a process switch required here. Below is roughly the body of RESUME")
FROMFX) (LET ((TOFX (fetch PROCFX of PROC))
(COND FROMFX)
((fetch (FX INVALIDP) of TOFX) (COND
(\MP.ERROR \MP.STACKRELEASED "Process's stack has been released!" PROC))) ((fetch (FX INVALIDP) of TOFX)
(SETQ \RUNNING.PROCESS PROC) (\MP.ERROR \MP.STACKRELEASED
(replace PROCFX of PROC with 0) "Process's stack has been released!" PROC
(\PROC.RESUME TOFX (COND )))
(OLDPROC (SETQ FROMFX (fetch PROCFX of OLDPROC) (SETQ \RUNNING.PROCESS PROC)
) (replace PROCFX of PROC with 0)
(COND (\PROC.RESUME
((NOT (fetch (FX INVALIDP) of FROMFX) TOFX
) (COND
(* ; (OLDPROC (SETQ FROMFX (fetch PROCFX of OLDPROC))
 "Release stack pointer of OLDPROC if it hasn't been yet. should never happen") (COND
(\DECUSECOUNT FROMFX))) ((NOT (fetch (FX INVALIDP)
(replace PROCFX of OLDPROC with of FROMFX))
(\MYALINK)) (* ;
NIL)  "Release stack pointer of OLDPROC if it hasn't been yet. should never happen")
(T (* ; (\DECUSECOUNT FROMFX)))
 "no OLDPROC to resume later, so jettison caller") (replace PROCFX of OLDPROC with (\MYALINK
(\MYALINK] ))
(RETURN (fetch WAKEREASON of PROC))) NIL)
((SETQ PQUEUE (fetch PQLOWER of PQUEUE)) (T (* ;
(GO LP))  "no OLDPROC to resume later, so jettison caller")
(T (* ; (\MYALINK]
 "nobody runnable, wait for events") (RETURN (fetch WAKEREASON of PROC)))
(\MP.ERROR \MP.PROCERROR "No runnable process!!" OLDPROC) ((SETQ PQUEUE (fetch PQLOWER of PQUEUE))
(GO TOP]) (GO LP))
(T (* ; "nobody runnable, wait for events")
(\MP.ERROR \MP.PROCERROR "No runnable process!!" OLDPROC)
(GO TOP])
) )
) )
(DEFINEQ (DEFINEQ
@@ -2848,22 +2865,19 @@ with the terms of said license.
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS THIS.PROCESS MACRO (PUTPROPS THIS.PROCESS MACRO (NIL \RUNNING.PROCESS))
(NIL \RUNNING.PROCESS))
(PUTPROPS TTY.PROCESS MACRO (PUTPROPS TTY.PROCESS MACRO [X (COND
[X (COND ((CAR X)
((CAR X) 'IGNOREMACRO)
'IGNOREMACRO) (T '\TTY.PROCESS])
(T '\TTY.PROCESS])
(PUTPROPS TTY.PROCESSP MACRO (PUTPROPS TTY.PROCESSP MACRO [X (COND
[X (COND ((CAR X)
((CAR X) 'IGNOREMACRO)
'IGNOREMACRO) (T '(OR (NULL (THIS.PROCESS))
(T '(OR (NULL (THIS.PROCESS)) (EQ (THIS.PROCESS)
(EQ (THIS.PROCESS) (TTY.PROCESS])
(TTY.PROCESS])
) )
(DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -2887,21 +2901,18 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS ALIVEPROCP MACRO (PUTPROPS ALIVEPROCP MACRO ((p)
((p) (NOT (DEADPROCP p))))
(NOT (DEADPROCP p))))
(PUTPROPS DEADPROCP MACRO (PUTPROPS DEADPROCP MACRO ((p)
((p) (fetch PROCDELETED of p)))
(fetch PROCDELETED of p)))
(PUTPROPS \COERCE.TO.PROCESS MACRO (PUTPROPS \COERCE.TO.PROCESS MACRO [OPENLAMBDA (P ERRORFLG)
[OPENLAMBDA (P ERRORFLG) (COND
(COND ((AND (type? PROCESS P)
((AND (type? PROCESS P) (NOT (fetch PROCDELETED of P)))
(NOT (fetch PROCDELETED of P))) P)
P) (T (FIND.PROCESS P ERRORFLG])
(T (FIND.PROCESS P ERRORFLG])
) )
(DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -3319,7 +3330,7 @@ with the terms of said license.
(RPAQ? PROCBACKTRACEHEIGHT 320) (RPAQ? PROCBACKTRACEHEIGHT 320)
(ADDTOVAR BackgroundMenuCommands ("PSW" '(PROCESS.STATUS.WINDOW) (ADDTOVAR BackgroundMenuCommands ("PSW" '(PROCESS.STATUS.WINDOW)
"Puts up a Process Status Window")) "Puts up a Process Status Window"))
(SETQQ BackgroundMenu) (SETQQ BackgroundMenu)
(DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE DONTCOPY
@@ -3350,8 +3361,8 @@ with the terms of said license.
(DEFPRINT 'MONITORLOCK (FUNCTION \MONITORLOCK.DEFPRINT)) (DEFPRINT 'MONITORLOCK (FUNCTION \MONITORLOCK.DEFPRINT))
(* ; (* ;
 "\process.init must come last, since it does a HARDRESET")  "\process.init must come last, since it does a HARDRESET")
(\PROCESS.INIT) (\PROCESS.INIT)
) )
@@ -3363,42 +3374,40 @@ with the terms of said license.
(ADDTOVAR LAMA PROCESSPROP ADD.PROCESS) (ADDTOVAR LAMA PROCESSPROP ADD.PROCESS)
) )
(PUTPROPS PROC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1990 1991
1992 1993 1998 1999))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (22392 42659 (PROCESSWORLD 22402 . 31747) (ADD.PROCESS 31749 . 35906) (DEL.PROCESS 35908 (FILEMAP (NIL (22096 42363 (PROCESSWORLD 22106 . 31451) (ADD.PROCESS 31453 . 35610) (DEL.PROCESS 35612
. 36855) (PROCESS.RETURN 36857 . 37004) (FIND.PROCESS 37006 . 37640) (MAP.PROCESSES 37642 . 37968) ( . 36559) (PROCESS.RETURN 36561 . 36708) (FIND.PROCESS 36710 . 37344) (MAP.PROCESSES 37346 . 37672) (
PROCESSP 37970 . 38138) (RELPROCESSP 38140 . 38322) (RESTART.PROCESS 38324 . 38893) (WAKE.PROCESS PROCESSP 37674 . 37842) (RELPROCESSP 37844 . 38026) (RESTART.PROCESS 38028 . 38597) (WAKE.PROCESS
38895 . 39625) (SUSPEND.PROCESS 39627 . 40014) (PROCESS.RESULT 40016 . 40994) (PROCESS-STATUS 40996 . 38599 . 39329) (SUSPEND.PROCESS 39331 . 39718) (PROCESS.RESULT 39720 . 40698) (PROCESS-STATUS 40700 .
42391) (PROCESS.FINISHEDP 42393 . 42657)) (42660 55867 (THIS.PROCESS 42670 . 42803) (TTY.PROCESS 42805 42095) (PROCESS.FINISHEDP 42097 . 42361)) (42364 55571 (THIS.PROCESS 42374 . 42507) (TTY.PROCESS 42509
. 49632) (TTY.PROCESSP 49634 . 49850) (PROCESS.TTY 49852 . 50202) (GIVE.TTY.PROCESS 50204 . 51014) ( . 49336) (TTY.PROCESSP 49338 . 49554) (PROCESS.TTY 49556 . 49906) (GIVE.TTY.PROCESS 49908 . 50718) (
ALLOW.BUTTON.EVENTS 51016 . 51260) (SPAWN.MOUSE 51262 . 53475) (\WAIT.FOR.TTY 53477 . 53667) ( ALLOW.BUTTON.EVENTS 50720 . 50964) (SPAWN.MOUSE 50966 . 53179) (\WAIT.FOR.TTY 53181 . 53371) (
WAIT.FOR.TTY 53669 . 55865)) (55868 58486 (RESET 55878 . 56710) (ERROR! 56712 . 58484)) (58851 64199 ( WAIT.FOR.TTY 53373 . 55569)) (55572 58190 (RESET 55582 . 56414) (ERROR! 56416 . 58188)) (58551 63899 (
PROCESSPROP 58861 . 63313) (PROCESS.NAME 63315 . 63620) (PROCESS.WINDOW 63622 . 64197)) (64401 69436 ( PROCESSPROP 58561 . 63013) (PROCESS.NAME 63015 . 63320) (PROCESS.WINDOW 63322 . 63897)) (64101 69136 (
DISMISS 64411 . 65226) (BLOCK 65228 . 67452) (WAITFORINPUT 67454 . 68683) (\WAITFORSYSBUFP 68685 . DISMISS 64111 . 64926) (BLOCK 64928 . 67152) (WAITFORINPUT 67154 . 68383) (\WAITFORSYSBUFP 68385 .
69434)) (69637 70134 (EVAL.AS.PROCESS 69647 . 69870) (EVAL.IN.TTY.PROCESS 69872 . 70132)) (70768 76552 69134)) (69337 69834 (EVAL.AS.PROCESS 69347 . 69570) (EVAL.IN.TTY.PROCESS 69572 . 69832)) (70423 76207
(PROCESS.READ 70778 . 71616) (PROCESS.EVALV 71618 . 72196) (PROCESS.EVAL 72198 . 73175) ( (PROCESS.READ 70433 . 71271) (PROCESS.EVALV 71273 . 71851) (PROCESS.EVAL 71853 . 72830) (
\PROCESS.EVAL1 73177 . 74280) (PROCESS.APPLY 74282 . 75266) (\PROCESS.APPLY1 75268 . 76550)) (78718 \PROCESS.EVAL1 72832 . 73935) (PROCESS.APPLY 73937 . 74921) (\PROCESS.APPLY1 74923 . 76205)) (78266
84023 (CREATE.EVENT 78728 . 78890) (NOTIFY.EVENT 78892 . 80400) (AWAIT.EVENT 80402 . 81024) ( 83571 (CREATE.EVENT 78276 . 78438) (NOTIFY.EVENT 78440 . 79948) (AWAIT.EVENT 79950 . 80572) (
\UNQUEUE.EVENT 81026 . 82501) (\ENQUEUE.EVENT/LOCK 82503 . 83796) (\EVENT.DEFPRINT 83798 . 84021)) ( \UNQUEUE.EVENT 80574 . 82049) (\ENQUEUE.EVENT/LOCK 82051 . 83344) (\EVENT.DEFPRINT 83346 . 83569)) (
89263 94254 (OBTAIN.MONITORLOCK 89273 . 92137) (CREATE.MONITORLOCK 92139 . 92358) (RELEASE.MONITORLOCK 90015 95006 (OBTAIN.MONITORLOCK 90025 . 92889) (CREATE.MONITORLOCK 92891 . 93110) (RELEASE.MONITORLOCK
92360 . 92694) (SI::MONITOR-UNWIND 92696 . 93282) (MONITOR.AWAIT.EVENT 93284 . 94018) ( 93112 . 93446) (SI::MONITOR-UNWIND 93448 . 94034) (MONITOR.AWAIT.EVENT 94036 . 94770) (
\MONITORLOCK.DEFPRINT 94020 . 94252)) (94863 117339 (\MAKE.PROCESS0 94873 . 102072) (\MAKE.PROCESS1 \MONITORLOCK.DEFPRINT 94772 . 95004)) (96210 118970 (\MAKE.PROCESS0 96220 . 103419) (\MAKE.PROCESS1
102074 . 103638) (\PROCESS.MOVEFRAME 103640 . 108189) (\RELEASE.PROCESS 108191 . 111241) ( 103421 . 104985) (\PROCESS.MOVEFRAME 104987 . 109536) (\RELEASE.PROCESS 109538 . 112588) (
\UNWIND.PROCESS 111243 . 111569) (\MAYBEBLOCK 111571 . 111726) (\BACKGROUND.PROCESS 111728 . 111969) ( \UNWIND.PROCESS 112590 . 112916) (\MAYBEBLOCK 112918 . 113073) (\BACKGROUND.PROCESS 113075 . 113600) (
\MOUSE.PROCESS 111971 . 114520) (\TIMER.PROCESS 114522 . 115078) (\PROCESS.RELEASE.LOCKS 115080 . \MOUSE.PROCESS 113602 . 116151) (\TIMER.PROCESS 116153 . 116709) (\PROCESS.RELEASE.LOCKS 116711 .
115494) (\SET.PROCESS.NAME 115496 . 117032) (\PROCESS.DEFPRINT 117034 . 117337)) (117340 131695 ( 117125) (\SET.PROCESS.NAME 117127 . 118663) (\PROCESS.DEFPRINT 118665 . 118968)) (118971 133326 (
\START.PROCESSES 117350 . 117523) (\PROCESS.GO.TO.SLEEP 117525 . 121279) (\PROC.RESUME 121281 . 121655 \START.PROCESSES 118981 . 119154) (\PROCESS.GO.TO.SLEEP 119156 . 122910) (\PROC.RESUME 122912 . 123286
) (\RUN.PROCESS 121657 . 124993) (\SUSPEND.PROCESS 124995 . 128056) (\UNQUEUE.TIMER 128058 . 128757) ( ) (\RUN.PROCESS 123288 . 126624) (\SUSPEND.PROCESS 126626 . 129687) (\UNQUEUE.TIMER 129689 . 130388) (
\ENQUEUE.TIMER 128759 . 130666) (\GET.PRIORITY.QUEUE 130668 . 131693)) (134377 141599 (\PROCESS.INIT \ENQUEUE.TIMER 130390 . 132297) (\GET.PRIORITY.QUEUE 132299 . 133324)) (136771 143993 (\PROCESS.INIT
134387 . 135013) (\PROCESS.EVENTFN 135015 . 136751) (\PROCESS.BEFORE.LOGOUT 136753 . 138272) ( 136781 . 137407) (\PROCESS.EVENTFN 137409 . 139145) (\PROCESS.BEFORE.LOGOUT 139147 . 140666) (
\PROCESS.AFTER.EXIT 138274 . 138582) (\PROCESS.RESET.TIMERS 138584 . 140113) (\PROC.AFTER.WINDOWWORLD \PROCESS.AFTER.EXIT 140668 . 140976) (\PROCESS.RESET.TIMERS 140978 . 142507) (\PROC.AFTER.WINDOWWORLD
140115 . 140800) (\TURN.ON.PROCESSES 140802 . 141597)) (141630 142859 (\PROC.CODEFORTFRAME 141640 . 142509 . 143194) (\TURN.ON.PROCESSES 143196 . 143991)) (144024 145253 (\PROC.CODEFORTFRAME 144034 .
142461) (\PROC.REPEATEDLYEVALQT 142463 . 142857)) (142893 149625 (BREAK.PROCESS 142903 . 143219) ( 144855) (\PROC.REPEATEDLYEVALQT 144857 . 145251)) (145287 152019 (BREAK.PROCESS 145297 . 145613) (
\SELECTPROCESS 143221 . 145661) (\PROCESS.MAKEFRAME 145663 . 147714) (\PROCESS.MAKEFRAME0 147716 . \SELECTPROCESS 145615 . 148055) (\PROCESS.MAKEFRAME 148057 . 150108) (\PROCESS.MAKEFRAME0 150110 .
149623)) (151838 153761 (\CHECK.PQUEUE 151848 . 153759)) (153762 172091 (PPROC 153772 . 155053) ( 152017)) (154660 156583 (\CHECK.PQUEUE 154670 . 156581)) (156584 174913 (PPROC 156594 . 157875) (
PPROCWINDOW 155055 . 155546) (PPROCREPAINTFN 155548 . 156262) (PPROCRESHAPEFN 156264 . 156527) ( PPROCWINDOW 157877 . 158368) (PPROCREPAINTFN 158370 . 159084) (PPROCRESHAPEFN 159086 . 159349) (
PPROCEXTENT 156529 . 157013) (PPROC1 157015 . 159033) (PROCESS.STATUS.WINDOW 159035 . 163117) ( PPROCEXTENT 159351 . 159835) (PPROC1 159837 . 161855) (PROCESS.STATUS.WINDOW 161857 . 165939) (
\PSW.SELECTED 163119 . 163413) (\PSWOP.SELECTED 163415 . 167315) (PROCESS.BACKTRACE 167317 . 170508) ( \PSW.SELECTED 165941 . 166235) (\PSWOP.SELECTED 166237 . 170137) (PROCESS.BACKTRACE 170139 . 173330) (
\INVALIDATE.PROCESS.WINDOW 170510 . 171244) (\UPDATE.PROCESS.WINDOW 171246 . 172089))))) \INVALIDATE.PROCESS.WINDOW 173332 . 174066) (\UPDATE.PROCESS.WINDOW 174068 . 174911)))))
STOP STOP

BIN
sources/PROC.LCOM
View File

Binary file not shown.