Merge branch 'master' into PDFSTREAM
This commit is contained in:
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Jun-2023 13:12:06" {WMEDLEY}<sources>LLREAD.;104 90176
|
||||
(FILECREATED "30-Jul-2023 17:42:27" {WMEDLEY}<sources>LLREAD.;105 90277
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS LLREADCOMS CHARACTERNAMES)
|
||||
:CHANGES-TO (FNS \SUBREAD)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2022 23:36:54" {WMEDLEY}<sources>LLREAD.;102)
|
||||
:PREVIOUS-DATE "17-Jun-2023 13:12:06" {WMEDLEY}<sources>LLREAD.;104)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -629,6 +629,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(\SUBREAD
|
||||
[LAMBDA (STRM SA READTYPE PNSTR CASEBASE EOF-SUPPRESS EOF-VALUE CHAR PRESERVE-WHITESPACE)
|
||||
(* ; "Edited 30-Jul-2023 17:42 by rmk")
|
||||
(* ; "Edited 19-Jul-2022 23:36 by rmk")
|
||||
(* ; "Edited 6-Aug-2021 21:40 by rmk:")
|
||||
|
||||
@@ -674,7 +675,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
then (* ;
|
||||
"caller specified eof-error-p of NIL. Happens only on top-level calls")
|
||||
(RETURN EOF-VALUE)) (* ; "By Skipping Separator Characters,Happens CHARSET-Mode Exchanging. (Solution of AR#114 in FX, edited by tt [Jan-22-'90])")
|
||||
(repeatwhile (EQ [SETQ SNX (\SYNCODE SA (SETQ CH (\INCCODE STRM]
|
||||
(repeatwhile (EQ [SETQ SNX (\SYNCODE SA (SETQ CH (\INCCODE.EOLC STRM]
|
||||
SEPRCHAR.RC))
|
||||
(COND
|
||||
((EQ CH CHAR) (* ;
|
||||
@@ -782,7 +783,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(if (AND EOF-POSSIBILITY (SETQ AT-EOF (\EOFP STRM)))
|
||||
then (* ; "EOF terminates atoms at top level")
|
||||
(GO FINISHATOM)
|
||||
elseif (EQ [SETQ SNX (\SYNCODE SA (SETQ CH (\INCCODE STRM]
|
||||
elseif (EQ [SETQ SNX (\SYNCODE SA (SETQ CH (\INCCODE.EOLC STRM]
|
||||
OTHER.RC)
|
||||
then (* ;
|
||||
"normal case tested first--another vanilla constituent char, so keep accumulating atom chars")
|
||||
@@ -1663,17 +1664,17 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(PUTPROPS LLREAD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
|
||||
1991 1993 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3460 11904 (LASTC 3470 . 3776) (PEEKC 3778 . 4166) (PEEKCCODE 4168 . 4579) (RATOM 4581
|
||||
. 5662) (READ 5664 . 6224) (READC 6226 . 6867) (READCCODE 6869 . 7628) (READP 7630 . 8182) (
|
||||
SETREADMACROFLG 8184 . 8483) (SKIPSEPRCODES 8485 . 9565) (SKIPSEPRS 9567 . 9953) (SKREAD 9955 . 11902)
|
||||
) (11950 20559 (CL:READ 11960 . 12509) (CL:READ-PRESERVING-WHITESPACE 12511 . 13233) (
|
||||
CL:READ-DELIMITED-LIST 13235 . 14150) (CL:PARSE-INTEGER 14152 . 20557)) (20652 33129 (RSTRING 20662 .
|
||||
21394) (READ-EXTENDED-TOKEN 21396 . 25268) (\RSTRING2 25270 . 33127)) (33165 63779 (\TOP-LEVEL-READ
|
||||
33175 . 35158) (\SUBREAD 35160 . 60195) (\SUBREADCONCAT 60197 . 60820) (\ORIG-READ.SYMBOL 60822 .
|
||||
61890) (\ORIG-INVALID.SYMBOL 61892 . 62791) (\APPLYREADMACRO 62793 . 63209) (INREADMACROP 63211 .
|
||||
63777)) (63938 64113 (READQUOTE 63948 . 64111)) (64138 76042 (READVBAR 64148 . 65479) (READHASHMACRO
|
||||
65481 . 71291) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71293 . 71513) (DIGITBASEP 71515 . 72249) (
|
||||
READNUMBERINBASE 72251 . 74137) (ESTIMATE-DIMENSIONALITY 74139 . 74464) (SKIP.HASH.COMMENT 74466 .
|
||||
75434) (CMLREAD.FEATURE.PARSER 75436 . 76040)) (76086 82430 (CHARACTER.READ 76096 . 77350) (
|
||||
CHARCODE.DECODE 77352 . 82428)) (82431 85601 (HEXNUM? 82441 . 84784) (OCTALNUM? 84786 . 85599)))))
|
||||
(FILEMAP (NIL (3442 11886 (LASTC 3452 . 3758) (PEEKC 3760 . 4148) (PEEKCCODE 4150 . 4561) (RATOM 4563
|
||||
. 5644) (READ 5646 . 6206) (READC 6208 . 6849) (READCCODE 6851 . 7610) (READP 7612 . 8164) (
|
||||
SETREADMACROFLG 8166 . 8465) (SKIPSEPRCODES 8467 . 9547) (SKIPSEPRS 9549 . 9935) (SKREAD 9937 . 11884)
|
||||
) (11932 20541 (CL:READ 11942 . 12491) (CL:READ-PRESERVING-WHITESPACE 12493 . 13215) (
|
||||
CL:READ-DELIMITED-LIST 13217 . 14132) (CL:PARSE-INTEGER 14134 . 20539)) (20634 33111 (RSTRING 20644 .
|
||||
21376) (READ-EXTENDED-TOKEN 21378 . 25250) (\RSTRING2 25252 . 33109)) (33147 63880 (\TOP-LEVEL-READ
|
||||
33157 . 35140) (\SUBREAD 35142 . 60296) (\SUBREADCONCAT 60298 . 60921) (\ORIG-READ.SYMBOL 60923 .
|
||||
61991) (\ORIG-INVALID.SYMBOL 61993 . 62892) (\APPLYREADMACRO 62894 . 63310) (INREADMACROP 63312 .
|
||||
63878)) (64039 64214 (READQUOTE 64049 . 64212)) (64239 76143 (READVBAR 64249 . 65580) (READHASHMACRO
|
||||
65582 . 71392) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71394 . 71614) (DIGITBASEP 71616 . 72350) (
|
||||
READNUMBERINBASE 72352 . 74238) (ESTIMATE-DIMENSIONALITY 74240 . 74565) (SKIP.HASH.COMMENT 74567 .
|
||||
75535) (CMLREAD.FEATURE.PARSER 75537 . 76141)) (76187 82531 (CHARACTER.READ 76197 . 77451) (
|
||||
CHARCODE.DECODE 77453 . 82529)) (82532 85702 (HEXNUM? 82542 . 84885) (OCTALNUM? 84887 . 85700)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,56 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Jan-2023 20:34:02" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;3 2095
|
||||
|
||||
:CHANGES-TO (FNS Apps.RemoveBackgroundMenuItem)
|
||||
|
||||
:PREVIOUS-DATE "17-Jan-2023 20:29:39" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;2
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-APPSCOMS)
|
||||
|
||||
(RPAQQ LOADUP-APPSCOMS ((GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
|
||||
(FNS Apps.LOADUP Apps.RemoveBackgroundMenuItem)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(Apps.LOADUP
|
||||
[LAMBDA NIL (* ; "Edited 12-Nov-2022 14:03 by FGH")
|
||||
(PROGN
|
||||
(* ;; " Delete button(s) that are created when lispusers/BUTTONS is loaded")
|
||||
|
||||
(for B in *ALL-BUTTONS* do (DELETE-BUTTON B))
|
||||
|
||||
(* ;; " Remove the BUTTONS BackgroundMenu item")
|
||||
|
||||
(Apps.RemoveBackgroundMenuItem "Button Control")
|
||||
|
||||
(* ;; " Remove the NoteCards Background Menu Item")
|
||||
|
||||
(Apps.RemoveBackgroundMenuItem 'NoteCards)
|
||||
|
||||
(* ;; " Remove the CLOS Background Menu Item")
|
||||
|
||||
(Apps.RemoveBackgroundMenuItem 'BrowseClass)
|
||||
(RPLACA [CAR (LIST '(A B C]
|
||||
NIL])
|
||||
|
||||
(Apps.RemoveBackgroundMenuItem
|
||||
[LAMBDA (ItemStringOrAtom)
|
||||
(DECLARE (GLOBALVARS Apps.SBG)) (* ; "Edited 17-Jan-2023 20:33 by FGH")
|
||||
(* ; "Edited 12-Nov-2022 14:07 by FGH")
|
||||
(LET (SAVEX)
|
||||
(SETQ BackgroundMenuCommands (REMOVE (SETQ SAVEX (SASSOC ItemStringOrAtom
|
||||
BackgroundMenuCommands))
|
||||
BackgroundMenuCommands))
|
||||
(SETQ BackgroundMenu NIL)
|
||||
(SETQ Apps.SBG (APPEND (LIST SAVEX)
|
||||
Apps.SBG])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (647 2072 (Apps.LOADUP 657 . 1400) (Apps.RemoveBackgroundMenuItem 1402 . 2070)))))
|
||||
STOP
|
||||
@@ -1 +0,0 @@
|
||||
"
|
||||
Binary file not shown.
@@ -1,92 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Jan-2023 16:23:36" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;2 4636
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-FULL)
|
||||
|
||||
:PREVIOUS-DATE "12-Aug-2022 12:30:09" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;1
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-FULLCOMS)
|
||||
|
||||
(RPAQQ LOADUP-FULLCOMS ((FNS LOADFULLFONTS LOADUP-FULL FIXMETA)
|
||||
(P (FIXMETA))))
|
||||
(DEFINEQ
|
||||
|
||||
(LOADFULLFONTS
|
||||
[LAMBDA NIL (* ; "Edited 13-Feb-2021 22:51 by larry")
|
||||
|
||||
(* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q")
|
||||
|
||||
(PRINTOUT T "Loading FULL fonts..." T)
|
||||
(SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT STRIKE))
|
||||
(SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT)
|
||||
(RESETVARS ((MISSINGDISPLAYFONTCOERCIONS NIL)
|
||||
(MISSINGCHARSETDISPLAYFONTCOERCIONS NIL)) (* ;
|
||||
"Don't let the font loader substitute just because a server went catatonic on us")
|
||||
(for FAMILY in '(CLASSIC MODERN TERMINAL)
|
||||
do (PRINTOUT T " Loading " FAMILY " ")
|
||||
[for SIZE in '(8 10 12)
|
||||
do (PRINTOUT T SIZE " ")
|
||||
(for FACE in '(MRR BRR MIR)
|
||||
do (for CSET in '(0 33 34 35 238 239 241)
|
||||
do (NLSETQ (FONTCREATE FAMILY SIZE FACE NIL 'DISPLAY NIL CSET]
|
||||
(PRINTOUT T T))
|
||||
(PRINTOUT T " Loading postscript fonts" T)
|
||||
(for F in (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES)
|
||||
">c0>*.*")) do (PSCFONT.READFONT F))
|
||||
(PRINTOUT T "FULL fonts loaded" T])
|
||||
|
||||
(LOADUP-FULL
|
||||
[LAMBDA NIL (* ; "Edited 18-Jan-2023 16:22 by FGH")
|
||||
(* ; "Edited 12-Aug-2022 11:17 by lmm")
|
||||
(* ; "Edited 14-Jul-2022 12:32 by rmk")
|
||||
(* ; "Edited 12-Jul-2022 21:57 by rmk")
|
||||
(* ; "Edited 7-Mar-2022 21:06 by larry")
|
||||
(* ; "Edited 2-Mar-2022 13:58 by larry")
|
||||
(* ; "Edited 15-Jan-2022 15:48 ")
|
||||
(* ; "Edited 29-Apr-2021 22:27 by rmk:")
|
||||
(* ;
|
||||
"Edited 14-May-2018 15:01 by kaplan")
|
||||
(* ; "Edited 28-Sep-2020 12:35 by rmk:")
|
||||
(* ; "Edited 21-Apr-2018 07:27 by rmk:")
|
||||
(* ; "Edited 23-Feb-94 15:04 by bvm")
|
||||
(PROGN (SETQ MEDLEYDIR)
|
||||
(CNDIR (MEDLEYDIR)))
|
||||
(MEDLEY-INIT-VARS)
|
||||
(SETQ MAKESYSFILENAME (MEDLEYDIR "tmp" "full.sysout" T))
|
||||
(SETQ MAKESYSNAME :MEDLEY)
|
||||
(DRIBBLE (MEDLEYDIR "tmp" "full.dribble" T))
|
||||
|
||||
(* ;; "BKSYSBUF stops page holding ")
|
||||
|
||||
(BKSYSBUF " ")
|
||||
(PRINTOUT T T "Full loadup started at " (DATE)
|
||||
" while connected to "
|
||||
(DIRECTORYNAME T)
|
||||
T T)
|
||||
(LOADUP '(POSTSCRIPTSTREAM)) (* ; " to get PSCFONT.READFONT")
|
||||
(LOADFULLFONTS)
|
||||
(LISTPUT IDLE.PROFILE 'TIMEOUT 0)
|
||||
(SETQQ *DEFAULT-CLEANUP-COMPILER* BCOMPL)
|
||||
(LOADUP '(CHAT PRESS INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER
|
||||
THINFILES GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT
|
||||
ISO8859IO HELPSYS DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE
|
||||
UNIXCOMM UNIXCHAT UNIXYCD UNIXUTILS))
|
||||
(COND
|
||||
((WINDOWP *WHO-LINE*)
|
||||
(CLOSEW *WHO-LINE*)))
|
||||
(DRIBBLE])
|
||||
|
||||
(FIXMETA
|
||||
[LAMBDA NIL (* ; "Edited 25-Jun-2017 17:12 by rmk:")
|
||||
(KEYACTION 'BLANK-TOP '(METADOWN . METAUP)
|
||||
\CURRENTKEYACTION)
|
||||
(KEYACTION 'BLANK-TOP '(METADOWN . METAUP])
|
||||
)
|
||||
|
||||
(FIXMETA)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (467 4598 (LOADFULLFONTS 477 . 1918) (LOADUP-FULL 1920 . 4348) (FIXMETA 4350 . 4596)))))
|
||||
STOP
|
||||
@@ -1 +0,0 @@
|
||||
"
|
||||
Binary file not shown.
@@ -1,19 +0,0 @@
|
||||
(* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh")
|
||||
|
||||
(LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM"))
|
||||
(CNDIR (MEDLEYDIR "tmp"))
|
||||
(DRIBBLE "init.dribble")
|
||||
|
||||
(UNADVISE)
|
||||
(ADVISE 'PAGEFULLFN '(RETURN))
|
||||
(ADVISE '(ERROR IN \DO-DEFINE-FILE-INFO) '(RETURN))
|
||||
(MOVD? 'NILL 'SETTEMPLATE)
|
||||
(DEFINEQ (RRE (LAMBDA (X Y) Y)))
|
||||
(MOVD? 'RRE 'READ-READER-ENVIRONMENT)
|
||||
|
||||
(LOAD (MEDLEYDIR "sources" "MAKEINIT.LCOM"))
|
||||
(MAKEINITGREET)
|
||||
(DRIBBLE)
|
||||
(LOGOUT T)
|
||||
STOP
|
||||
|
||||
@@ -1,128 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "27-Feb-2023 17:15:53" |{DSK}<home>larry>il>medley>sources>LOADUP-LISP.;2| 5263
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-LISP)
|
||||
|
||||
:PREVIOUS-DATE "12-Aug-2022 12:29:57" |{DSK}<home>larry>il>medley>sources>LOADUP-LISP.;1|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
||||
|
||||
(RPAQQ LOADUP-LISPCOMS ((FNS LOADUP-LISP)
|
||||
(INITVARS (FILING.ENUMERATION.DEPTH 1))
|
||||
(FILES MEDLEYDIR)
|
||||
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS
|
||||
USERRECLST)))
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-LISP
|
||||
(LAMBDA NIL (* \; "Edited 26-Feb-2023 12:17 by lmm")
|
||||
(* \; "Edited 13-Jul-2022 14:09 by rmk")
|
||||
(* \; "Edited 4-Mar-2022 19:13 by larry")
|
||||
(* \; "Edited 29-Apr-2021 22:30 by rmk:")
|
||||
(SETQQ COMPILE.EXT LCOM)
|
||||
(MEDLEY-INIT-VARS) (* \; "should be set earlier")
|
||||
(DRIBBLE (MEDLEYDIR "tmp" "lisp.dribble" T))
|
||||
(FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES)
|
||||
(PRINTOUT T X " bootloaded" T)
|
||||
(SETQ SYSFILES (CONS X SYSFILES))))
|
||||
(SETQ BOOTLOADEDFILES NIL)
|
||||
(IF (NOT (BOUNDP 'DIRECTORIES))
|
||||
THEN (SETQ DIRECTORIES LOADUPDIRECTORIES))
|
||||
|
||||
(* |;;| "following files are really loaded earlier, this call to LOADUP just cleans up")
|
||||
|
||||
(LOADUP '(ACODE MACHINEINDEPENDENT))
|
||||
|
||||
(* |;;| "establish all package exports early")
|
||||
|
||||
(LOADUP '(LISP-PACKAGE FASL-PACKAGE D-ASSEM-PACKAGE COMPILER-PACKAGE))
|
||||
|
||||
(* |;;| "load FASL loader here, so we can load DFASLs earlier in loadup")
|
||||
|
||||
(LOADUP '(ERROR-RUNTIME CMLARITH CONDITION-HIERARCHY CMLHASH D-ASSEM FASLOAD))
|
||||
|
||||
(* |;;| "These are needed by any FASL files")
|
||||
|
||||
(LOADUP '(DEFFER-RUNTIME CMLPRINT CLSTREAMS CMLSTRING CMLSYMBOL CMLTYPES CMLSEQCOMMON
|
||||
CMLSEQMAPPERS CMLPATHNAME CMLFILESYS))
|
||||
|
||||
(* |;;;| "* 'FASL files may be loaded after this point' * * *")
|
||||
|
||||
(LOADUP '(CMLDEFFER ERROR-RUNTIME-AFTER-FASL WRAPPERS))
|
||||
|
||||
(* |;;| "early runtime support for Common Lisp and (temporarily) debugger")
|
||||
|
||||
(LOADUP '(STACKFNS CMLMVS MACROS MACROAUX UNWINDMACROS))
|
||||
(LOADUP '(COMMON XCLC-RUNTIME CMLTYPES CL-ERROR))
|
||||
(LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF FONTPROFILE SPELLFILE PRINTFN LOADFNS
|
||||
DMISC DIRECTORY SPELLFILE FILEPKG RESOURCE))
|
||||
|
||||
(* |;;| "needed for makesys")
|
||||
|
||||
(* |;;| "The Byte Compiler (DLAP, BYTECOMPILER, COMPILER) used to be here. Moved after XCL Compiler so that one byte compiler init will work. JDS 10/11/89")
|
||||
|
||||
(LOADUP '(HIST UNDO SPELL DWIM WTFIX CLISP DWIMIFY CLISPIFY RECORD))
|
||||
(LOADUP '(GAINSPACE COROUTINE ARGLIST ASKUSER SYSPRETTY COMMON COMPARE))
|
||||
(DWIM 'C)
|
||||
|
||||
(* |;;| "Kernel Common Lisp files")
|
||||
|
||||
(LOADUP '(CMLSTEP CMLDOC CMLPARSE CMLSETF CMLPRED CMLREAD WALKER CMLSEQFINDER CMLSEQMODIFY
|
||||
CMLSORT DEFSTRUCT CMLMISCIO CMLCOMPILE CMLDESTRUCT CL-ERROR CMLFORMAT
|
||||
CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES))
|
||||
(LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT))
|
||||
(LOADUP '(ADDARITH))
|
||||
(LOADUP '(UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW
|
||||
WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE
|
||||
CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
|
||||
(LOADUP '(BREAK-AND-TRACE))
|
||||
(LOADUP '(FASDUMP XCL-COMPILER ADVISE))
|
||||
|
||||
(* |;;| "the bytecompiler and Interlisp compiler interface functions")
|
||||
|
||||
(LOADUP '(DLAP BYTECOMPILER COMPILE))
|
||||
(LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT))
|
||||
(LOADUP '(TIME))
|
||||
(LOADUP '(BRKDWN))
|
||||
(LOADUP '(LOGOW IDLER HARDCOPY ICONW FREEMENU SEDIT))
|
||||
(LOADUP '(XCL-EXTRAS))
|
||||
|
||||
(* |;;| "CMLPACKAGE pushes onto INSPECTMACROS")
|
||||
|
||||
(LOADUP '(CMLPACKAGE))
|
||||
|
||||
(* |;;| "Puts ARGNAME properties on CL and XCL functions that IL:SMARTARGLIST can't hack. Keep this last so everything will be defined when it runs")
|
||||
|
||||
(LOADUP '(CMLSMARTARGS))
|
||||
(LOADUP '(IMPLICIT-KEY-HASH CLOSURE-CACHE))
|
||||
|
||||
(* |;;| " not sure what this depends on, so putting it here")
|
||||
|
||||
(LOADUP '(BIGBITMAPS))
|
||||
|
||||
(* |;;| "Already enabled, but this time fixes tables that weren't defined in the init")
|
||||
|
||||
(PACKAGE-ENABLE)
|
||||
|
||||
(* |;;| " networking code -- should make it optional but too many cross dependencies")
|
||||
|
||||
(LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP
|
||||
NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER))
|
||||
(DRIBBLE)
|
||||
(SETQ MAKESYSNAME :MEDLEY)))
|
||||
)
|
||||
|
||||
(RPAQ? FILING.ENUMERATION.DEPTH 1)
|
||||
|
||||
(FILESLOAD MEDLEYDIR)
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (654 5057 (LOADUP-LISP 664 . 5055)))))
|
||||
STOP
|
||||
@@ -1 +0,0 @@
|
||||
"
|
||||
Binary file not shown.
1080
sources/MAKEINIT
1080
sources/MAKEINIT
File diff suppressed because it is too large
Load Diff
Binary file not shown.
757
sources/PROC
757
sources/PROC
@@ -1,18 +1,14 @@
|
||||
(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)
|
||||
|
||||
@@ -22,7 +18,7 @@ with the terms of said license.
|
||||
(CONSTANTS \PSTAT.WAITING \PSTAT.RUNNING \PSTAT.DELETED))
|
||||
(INITRECORDS PROCESS PROCESSQUEUE)
|
||||
(SYSRECORDS PROCESS PROCESSQUEUE))
|
||||
[COMS (* ; "User entries")
|
||||
[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-STATUS PROCESS.FINISHEDP)
|
||||
@@ -37,27 +33,27 @@ with the terms of said license.
|
||||
(GLOBALVARS TTY.PROCESS.DEFAULT \TTY.PROCESS.EVENT \PROCESS.NAME.TABLE)
|
||||
(FNS PROCESSPROP PROCESS.NAME PROCESS.WINDOW)
|
||||
(PROP ARGNAMES PROCESSPROP ADD.PROCESS)
|
||||
(COMS (* ; "Temporary")
|
||||
(COMS (* ; "Temporary")
|
||||
(P (MOVD? 'PROCESS.RETURN 'KILL.ME NIL T]
|
||||
(COMS (FNS DISMISS BLOCK WAITFORINPUT \WAITFORSYSBUFP)
|
||||
(* ; "Used to be a GLOBALRESOURCES")
|
||||
(* ; "Used to be a GLOBALRESOURCES")
|
||||
(DECLARE%: DONTCOPY (RESOURCES \DISMISSTIMER))
|
||||
(INITRESOURCES \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")
|
||||
(* ;; "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")
|
||||
(* ;
|
||||
"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")
|
||||
(COMS (* ; "Event stuff")
|
||||
(DECLARE%: DONTCOPY (RECORDS EVENT))
|
||||
(INITRECORDS EVENT)
|
||||
(SYSRECORDS EVENT)
|
||||
@@ -66,7 +62,7 @@ with the terms of said license.
|
||||
(MACROS AWAIT.CONDITION)
|
||||
(INITVARS (\PROCESS.AFTEREXIT.EVENT))
|
||||
(GLOBALVARS \PROCESS.AFTEREXIT.EVENT))
|
||||
(COMS (* ; "Monitor stuff")
|
||||
(COMS (* ; "Monitor stuff")
|
||||
(DECLARE%: DONTCOPY (RECORDS MONITORLOCK)
|
||||
(MACROS .RELEASE.LOCK.))
|
||||
(INITRECORDS MONITORLOCK)
|
||||
@@ -74,7 +70,11 @@ with the terms of said license.
|
||||
(FNS OBTAIN.MONITORLOCK CREATE.MONITORLOCK RELEASE.MONITORLOCK SI::MONITOR-UNWIND
|
||||
MONITOR.AWAIT.EVENT \MONITORLOCK.DEFPRINT)
|
||||
(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
|
||||
\PROCESS.RELEASE.LOCKS \SET.PROCESS.NAME \PROCESS.DEFPRINT)
|
||||
(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)))
|
||||
(COMS (FNS \PROCESS.INIT \PROCESS.EVENTFN \PROCESS.BEFORE.LOGOUT \PROCESS.AFTER.EXIT
|
||||
\PROCESS.RESET.TIMERS \PROC.AFTER.WINDOWWORLD \TURN.ON.PROCESSES)
|
||||
(* ; "Redefinitions")
|
||||
(* ; "Redefinitions")
|
||||
(FNS \PROC.CODEFORTFRAME \PROC.REPEATEDLYEVALQT))
|
||||
(COMS (* ; "switching stacks")
|
||||
(COMS (* ; "switching stacks")
|
||||
(FNS BREAK.PROCESS \SELECTPROCESS \PROCESS.MAKEFRAME \PROCESS.MAKEFRAME0))
|
||||
(INITVARS (%#MYHANDLE#)
|
||||
(%#SCHEDULER#)
|
||||
@@ -117,7 +117,7 @@ with the terms of said license.
|
||||
PROC.DEFAULT.PRIORITY \PROC.RUN.NEXT.FLG \SYSTEMTIMERVARS)
|
||||
(MACROS ALIVEPROCP DEADPROCP \COERCE.TO.PROCESS)
|
||||
(LOCALVARS . T)))
|
||||
(COMS (* ; "Debugging")
|
||||
(COMS (* ; "Debugging")
|
||||
(FNS \CHECK.PQUEUE)
|
||||
(FNS PPROC PPROCWINDOW PPROCREPAINTFN PPROCRESHAPEFN PPROCEXTENT PPROC1
|
||||
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))
|
||||
(DEFPRINT 'EVENT (FUNCTION \EVENT.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)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
@@ -149,80 +149,80 @@ with the terms of said license.
|
||||
(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 or waiting")
|
||||
(PROCNAME POINTER) (* ;
|
||||
"Name for convenience in type-in reference")
|
||||
(PROCPRIORITY BYTE) (* ;
|
||||
"Priority level, 0-4. Not currently used.")
|
||||
(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")
|
||||
(PROCDRIBBLEOUTPUT POINTER) (* ;
|
||||
"Binding for *DRIBBLE-OUTPUT* 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) (* ; "If DON'T, can't logout")
|
||||
(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")
|
||||
(PROCHARDRESETINFO POINTER) (* ;
|
||||
"HARDRESET stores info about unwind-protect cleanups here")
|
||||
(PROCRESTARTFORM POINTER) (* ;
|
||||
"use this instead of PROCFORM when restarting")
|
||||
(PROCOLDTTYPROC POINTER) (* ;
|
||||
"Process that had the tty when we got it")
|
||||
(NIL POINTER) (* ; "For expansion")
|
||||
)
|
||||
PROCTIMERBOX _ (CREATECELL \FIXP)
|
||||
PROCFX0 _ \STACKHI)
|
||||
(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 or waiting")
|
||||
(PROCNAME POINTER) (* ;
|
||||
"Name for convenience in type-in reference")
|
||||
(PROCPRIORITY BYTE) (* ;
|
||||
"Priority level, 0-4. Not currently used.")
|
||||
(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")
|
||||
(PROCDRIBBLEOUTPUT POINTER) (* ;
|
||||
"Binding for *DRIBBLE-OUTPUT* 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) (* ; "If DON'T, can't logout")
|
||||
(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")
|
||||
(PROCHARDRESETINFO POINTER) (* ;
|
||||
"HARDRESET stores info about unwind-protect cleanups here")
|
||||
(PROCRESTARTFORM POINTER) (* ;
|
||||
"use this instead of PROCFORM when restarting")
|
||||
(PROCOLDTTYPROC POINTER) (* ;
|
||||
"Process that had the tty when we got it")
|
||||
(NIL POINTER) (* ; "For expansion")
|
||||
)
|
||||
PROCTIMERBOX _ (CREATECELL \FIXP)
|
||||
PROCFX0 _ \STACKHI)
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'PROCESS
|
||||
@@ -281,15 +281,15 @@ with the terms of said license.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE PROCESSQUEUE ((PQPRIORITY BYTE) (* ;
|
||||
"Priority for the processes in thie queue.")
|
||||
(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")
|
||||
))
|
||||
(DATATYPE PROCESSQUEUE ((PQPRIORITY BYTE) (* ;
|
||||
"Priority for the processes in thie queue.")
|
||||
(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 'PROCESSQUEUE '(BYTE POINTER POINTER POINTER POINTER)
|
||||
@@ -374,55 +374,55 @@ with the terms of said license.
|
||||
(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)
|
||||
(PROCDRIBBLEOUTPUT POINTER)
|
||||
(PROCINFOHOOK POINTER)
|
||||
(PROCTYPEAHEAD POINTER)
|
||||
(PROCREMOTEINFO POINTER)
|
||||
(PROCUSERDATA POINTER)
|
||||
(PROCEVENTLINK POINTER)
|
||||
(PROCAFTEREXIT POINTER)
|
||||
(PROCBEFOREEXIT POINTER)
|
||||
(PROCOWNEDLOCKS POINTER)
|
||||
(PROCEVAPPLYRESULT POINTER)
|
||||
(PROCTTYENTRYFN POINTER)
|
||||
(PROCTTYEXITFN POINTER)
|
||||
(PROCHARDRESETINFO POINTER)
|
||||
(PROCRESTARTFORM POINTER)
|
||||
(PROCOLDTTYPROC POINTER)
|
||||
(NIL POINTER)))
|
||||
(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)
|
||||
(PROCDRIBBLEOUTPUT POINTER)
|
||||
(PROCINFOHOOK POINTER)
|
||||
(PROCTYPEAHEAD POINTER)
|
||||
(PROCREMOTEINFO POINTER)
|
||||
(PROCUSERDATA POINTER)
|
||||
(PROCEVENTLINK POINTER)
|
||||
(PROCAFTEREXIT POINTER)
|
||||
(PROCBEFOREEXIT POINTER)
|
||||
(PROCOWNEDLOCKS POINTER)
|
||||
(PROCEVAPPLYRESULT POINTER)
|
||||
(PROCTTYENTRYFN POINTER)
|
||||
(PROCTTYEXITFN POINTER)
|
||||
(PROCHARDRESETINFO POINTER)
|
||||
(PROCRESTARTFORM POINTER)
|
||||
(PROCOLDTTYPROC POINTER)
|
||||
(NIL POINTER)))
|
||||
|
||||
(DATATYPE PROCESSQUEUE ((PQPRIORITY BYTE)
|
||||
(PQHIGHER POINTER)
|
||||
(PQLOWER POINTER)
|
||||
(PQNEXT POINTER)
|
||||
(PQLAST POINTER)))
|
||||
(PQHIGHER POINTER)
|
||||
(PQLOWER POINTER)
|
||||
(PQNEXT POINTER)
|
||||
(PQLAST POINTER)))
|
||||
)
|
||||
|
||||
|
||||
@@ -1064,7 +1064,7 @@ with the terms of said license.
|
||||
(RPAQ? \TTY.PROCESS )
|
||||
|
||||
(RPAQ? \PROCESS.NAME.TABLE (HASHARRAY 30 NIL (FUNCTION STRING-EQUAL-HASHBITS)
|
||||
(FUNCTION STRING-EQUAL)))
|
||||
(FUNCTION STRING-EQUAL)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TTY.PROCESS.DEFAULT \TTY.PROCESS.EVENT \PROCESS.NAME.TABLE)
|
||||
@@ -1302,14 +1302,12 @@ with the terms of said license.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PROCESS.WAIT MACRO
|
||||
[(WAITCOND TIMEOUT)
|
||||
(bind ($$TIMEOUT _ (AND TIMEOUT (SETUPTIMER TIMEOUT))) until (AND $$TIMEOUT (
|
||||
TIMEREXPIRED?
|
||||
$$TIMEOUT))
|
||||
do (if (SETQ $$VAL WAITCOND)
|
||||
then (RETURN $$VAL)
|
||||
else (BLOCK])
|
||||
(PUTPROPS 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
|
||||
|
||||
@@ -1452,20 +1450,19 @@ with the terms of said license.
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE EVENT ((EVENTWAKEUPPENDING FLAG) (* ;
|
||||
"True if this event was signaled with nobody waiting on it")
|
||||
(NIL BITS 3)
|
||||
(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")
|
||||
))
|
||||
(DATATYPE EVENT ((EVENTWAKEUPPENDING FLAG) (* ;
|
||||
"True if this event was signaled with nobody waiting on it")
|
||||
(NIL BITS 3)
|
||||
(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 'EVENT '(FLAG (BITS 3)
|
||||
@@ -1487,9 +1484,9 @@ with the terms of said license.
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE EVENT ((EVENTWAKEUPPENDING FLAG)
|
||||
(NIL BITS 3)
|
||||
(EVENTQUEUETAIL POINTER)
|
||||
(EVENTNAME POINTER)))
|
||||
(NIL BITS 3)
|
||||
(EVENTQUEUETAIL POINTER)
|
||||
(EVENTNAME POINTER)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1593,17 +1590,17 @@ with the terms of said license.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS AWAIT.CONDITION MACRO
|
||||
[(CONDITION EVNT TIMEOUT TIMERP)
|
||||
(PROG [($$TIMER TIMEOUT)
|
||||
($$EV (\DTEST EVNT '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])
|
||||
(PUTPROPS AWAIT.CONDITION MACRO [(CONDITION EVNT TIMEOUT TIMERP)
|
||||
(PROG [($$TIMER TIMEOUT)
|
||||
($$EV (\DTEST EVNT '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? \PROCESS.AFTEREXIT.EVENT )
|
||||
@@ -1620,17 +1617,16 @@ with the terms of said license.
|
||||
(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 2)
|
||||
(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")
|
||||
))
|
||||
(MLOCKPERPROCESS FLAG) (* ;
|
||||
"Monitor's use by anybody in process lets everyone in that proc use it, the normal case")
|
||||
(NIL BITS 2)
|
||||
(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 'MONITORLOCK '(FLAG FLAG (BITS 2)
|
||||
@@ -1646,46 +1642,48 @@ with the terms of said license.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .RELEASE.LOCK. MACRO
|
||||
[(LOCK EVENIFNOTMINE)
|
||||
(UNINTERRUPTABLY
|
||||
[PROG ((OWNER (ffetch MLOCKOWNER of LOCK))
|
||||
TAIL PREV NEXTPROC)
|
||||
(COND
|
||||
((OR (NULL OWNER)
|
||||
(AND (NEQ OWNER (THIS.PROCESS))
|
||||
(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])])
|
||||
(PUTPROPS .RELEASE.LOCK. MACRO [(LOCK EVENIFNOTMINE)
|
||||
(UNINTERRUPTABLY
|
||||
[PROG ((OWNER (ffetch MLOCKOWNER of LOCK))
|
||||
TAIL PREV NEXTPROC)
|
||||
(COND
|
||||
((OR (NULL OWNER)
|
||||
(AND (NEQ OWNER (THIS.PROCESS))
|
||||
(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])])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -1702,12 +1700,12 @@ with the terms of said license.
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE MONITORLOCK ((NIL FLAG)
|
||||
(MLOCKPERPROCESS FLAG)
|
||||
(NIL BITS 2)
|
||||
(MLOCKQUEUETAIL POINTER)
|
||||
(MLOCKOWNER POINTER)
|
||||
(MLOCKNAME POINTER)
|
||||
(MLOCKLINK POINTER)))
|
||||
(MLOCKPERPROCESS FLAG)
|
||||
(NIL BITS 2)
|
||||
(MLOCKQUEUETAIL POINTER)
|
||||
(MLOCKOWNER POINTER)
|
||||
(MLOCKNAME POINTER)
|
||||
(MLOCKLINK POINTER)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1804,23 +1802,36 @@ with the terms of said license.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS WITH.MONITOR MACRO
|
||||
[(LOCK . FORMS)
|
||||
(LET (SI::*LOCKED-MONITOR* SI::*RESETFORMS*)
|
||||
(DECLARE (CL:SPECIAL SI::*LOCKED-MONITOR* SI::*RESETFORMS*))
|
||||
(CL:UNWIND-PROTECT
|
||||
(PROGN (OBTAIN.MONITORLOCK LOCK NIL 'WITH.MONITOR) . FORMS)
|
||||
(SI::MONITOR-UNWIND))])
|
||||
(PUTPROPS WITH.MONITOR MACRO [(LOCK . FORMS)
|
||||
(LET (SI::*LOCKED-MONITOR* SI::*RESETFORMS*)
|
||||
(DECLARE (CL:SPECIAL SI::*LOCKED-MONITOR* SI::*RESETFORMS*))
|
||||
(CL:UNWIND-PROTECT
|
||||
(PROGN (OBTAIN.MONITORLOCK LOCK NIL 'WITH.MONITOR) . FORMS)
|
||||
(SI::MONITOR-UNWIND))])
|
||||
|
||||
(PUTPROPS WITH.FAST.MONITOR MACRO
|
||||
[(LOCK . FORMS)
|
||||
(UNINTERRUPTABLY
|
||||
([LAMBDA (UNLOCK)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(AND (NEQ UNLOCK T)
|
||||
(RELEASE.MONITORLOCK UNLOCK)))]
|
||||
(OBTAIN.MONITORLOCK LOCK)))])
|
||||
(PUTPROPS WITH.FAST.MONITOR MACRO [(LOCK . FORMS)
|
||||
(UNINTERRUPTABLY
|
||||
([LAMBDA (UNLOCK)
|
||||
(PROG1 (PROGN . FORMS)
|
||||
(AND (NEQ UNLOCK T)
|
||||
(RELEASE.MONITORLOCK UNLOCK)))]
|
||||
(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
|
||||
|
||||
(\MAKE.PROCESS0
|
||||
@@ -2096,9 +2107,13 @@ with the terms of said license.
|
||||
(\INTERRUPTABLE (BLOCK])
|
||||
|
||||
(\BACKGROUND.PROCESS
|
||||
[LAMBDA NIL (* bvm%: "24-JUL-83 15:35")
|
||||
(PROG NIL
|
||||
LP (for FN in BACKGROUNDFNS do (SPREADAPPLY* FN))
|
||||
[LAMBDA NIL (* ; "Edited 28-Jul-2023 21:01 by lmm")
|
||||
(* bvm%: "24-JUL-83 15:35")
|
||||
(PROG ((\BACKGROUND \IGNORE.BACKGROUND))
|
||||
(DECLARE (SPECVARS \BACKGROUND)
|
||||
(GLOBALVARS \IGNORE.BACKGROUND))
|
||||
LP (SETQ \BACKGROUND \IGNORE.BACKGROUND)
|
||||
(for FN in BACKGROUNDFNS do (SPREADAPPLY* FN))
|
||||
(BLOCK)
|
||||
(GO LP])
|
||||
|
||||
@@ -2460,51 +2475,53 @@ with the terms of said license.
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \RESCHEDULE MACRO
|
||||
[LAMBDA (OLDPROC)
|
||||
(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!")
|
||||
(* ;; "Causes process switch, saving current context in OLDPROC's handle, or nowhere if OLDPROC is NIL. Must be called uninterruptably!")
|
||||
|
||||
(PROG (PQUEUE PROC)
|
||||
TOP
|
||||
(PROG (PQUEUE PROC)
|
||||
TOP
|
||||
|
||||
(* ;; "Maybe check for events here?")
|
||||
(* ;; "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])
|
||||
(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
|
||||
@@ -2848,22 +2865,19 @@ with the terms of said license.
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS THIS.PROCESS MACRO
|
||||
(NIL \RUNNING.PROCESS))
|
||||
(PUTPROPS THIS.PROCESS MACRO (NIL \RUNNING.PROCESS))
|
||||
|
||||
(PUTPROPS TTY.PROCESS MACRO
|
||||
[X (COND
|
||||
((CAR X)
|
||||
'IGNOREMACRO)
|
||||
(T '\TTY.PROCESS])
|
||||
(PUTPROPS TTY.PROCESS MACRO [X (COND
|
||||
((CAR X)
|
||||
'IGNOREMACRO)
|
||||
(T '\TTY.PROCESS])
|
||||
|
||||
(PUTPROPS TTY.PROCESSP MACRO
|
||||
[X (COND
|
||||
((CAR X)
|
||||
'IGNOREMACRO)
|
||||
(T '(OR (NULL (THIS.PROCESS))
|
||||
(EQ (THIS.PROCESS)
|
||||
(TTY.PROCESS])
|
||||
(PUTPROPS TTY.PROCESSP MACRO [X (COND
|
||||
((CAR X)
|
||||
'IGNOREMACRO)
|
||||
(T '(OR (NULL (THIS.PROCESS))
|
||||
(EQ (THIS.PROCESS)
|
||||
(TTY.PROCESS])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -2887,21 +2901,18 @@ with the terms of said license.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS ALIVEPROCP MACRO
|
||||
((p)
|
||||
(NOT (DEADPROCP p))))
|
||||
(PUTPROPS ALIVEPROCP MACRO ((p)
|
||||
(NOT (DEADPROCP p))))
|
||||
|
||||
(PUTPROPS DEADPROCP MACRO
|
||||
((p)
|
||||
(fetch PROCDELETED of 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])
|
||||
(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
|
||||
@@ -3319,7 +3330,7 @@ with the terms of said license.
|
||||
(RPAQ? PROCBACKTRACEHEIGHT 320)
|
||||
|
||||
(ADDTOVAR BackgroundMenuCommands ("PSW" '(PROCESS.STATUS.WINDOW)
|
||||
"Puts up a Process Status Window"))
|
||||
"Puts up a Process Status Window"))
|
||||
|
||||
(SETQQ BackgroundMenu)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -3350,8 +3361,8 @@ with the terms of said license.
|
||||
|
||||
(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)
|
||||
)
|
||||
@@ -3363,42 +3374,40 @@ with the terms of said license.
|
||||
|
||||
(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
|
||||
(FILEMAP (NIL (22392 42659 (PROCESSWORLD 22402 . 31747) (ADD.PROCESS 31749 . 35906) (DEL.PROCESS 35908
|
||||
. 36855) (PROCESS.RETURN 36857 . 37004) (FIND.PROCESS 37006 . 37640) (MAP.PROCESSES 37642 . 37968) (
|
||||
PROCESSP 37970 . 38138) (RELPROCESSP 38140 . 38322) (RESTART.PROCESS 38324 . 38893) (WAKE.PROCESS
|
||||
38895 . 39625) (SUSPEND.PROCESS 39627 . 40014) (PROCESS.RESULT 40016 . 40994) (PROCESS-STATUS 40996 .
|
||||
42391) (PROCESS.FINISHEDP 42393 . 42657)) (42660 55867 (THIS.PROCESS 42670 . 42803) (TTY.PROCESS 42805
|
||||
. 49632) (TTY.PROCESSP 49634 . 49850) (PROCESS.TTY 49852 . 50202) (GIVE.TTY.PROCESS 50204 . 51014) (
|
||||
ALLOW.BUTTON.EVENTS 51016 . 51260) (SPAWN.MOUSE 51262 . 53475) (\WAIT.FOR.TTY 53477 . 53667) (
|
||||
WAIT.FOR.TTY 53669 . 55865)) (55868 58486 (RESET 55878 . 56710) (ERROR! 56712 . 58484)) (58851 64199 (
|
||||
PROCESSPROP 58861 . 63313) (PROCESS.NAME 63315 . 63620) (PROCESS.WINDOW 63622 . 64197)) (64401 69436 (
|
||||
DISMISS 64411 . 65226) (BLOCK 65228 . 67452) (WAITFORINPUT 67454 . 68683) (\WAITFORSYSBUFP 68685 .
|
||||
69434)) (69637 70134 (EVAL.AS.PROCESS 69647 . 69870) (EVAL.IN.TTY.PROCESS 69872 . 70132)) (70768 76552
|
||||
(PROCESS.READ 70778 . 71616) (PROCESS.EVALV 71618 . 72196) (PROCESS.EVAL 72198 . 73175) (
|
||||
\PROCESS.EVAL1 73177 . 74280) (PROCESS.APPLY 74282 . 75266) (\PROCESS.APPLY1 75268 . 76550)) (78718
|
||||
84023 (CREATE.EVENT 78728 . 78890) (NOTIFY.EVENT 78892 . 80400) (AWAIT.EVENT 80402 . 81024) (
|
||||
\UNQUEUE.EVENT 81026 . 82501) (\ENQUEUE.EVENT/LOCK 82503 . 83796) (\EVENT.DEFPRINT 83798 . 84021)) (
|
||||
89263 94254 (OBTAIN.MONITORLOCK 89273 . 92137) (CREATE.MONITORLOCK 92139 . 92358) (RELEASE.MONITORLOCK
|
||||
92360 . 92694) (SI::MONITOR-UNWIND 92696 . 93282) (MONITOR.AWAIT.EVENT 93284 . 94018) (
|
||||
\MONITORLOCK.DEFPRINT 94020 . 94252)) (94863 117339 (\MAKE.PROCESS0 94873 . 102072) (\MAKE.PROCESS1
|
||||
102074 . 103638) (\PROCESS.MOVEFRAME 103640 . 108189) (\RELEASE.PROCESS 108191 . 111241) (
|
||||
\UNWIND.PROCESS 111243 . 111569) (\MAYBEBLOCK 111571 . 111726) (\BACKGROUND.PROCESS 111728 . 111969) (
|
||||
\MOUSE.PROCESS 111971 . 114520) (\TIMER.PROCESS 114522 . 115078) (\PROCESS.RELEASE.LOCKS 115080 .
|
||||
115494) (\SET.PROCESS.NAME 115496 . 117032) (\PROCESS.DEFPRINT 117034 . 117337)) (117340 131695 (
|
||||
\START.PROCESSES 117350 . 117523) (\PROCESS.GO.TO.SLEEP 117525 . 121279) (\PROC.RESUME 121281 . 121655
|
||||
) (\RUN.PROCESS 121657 . 124993) (\SUSPEND.PROCESS 124995 . 128056) (\UNQUEUE.TIMER 128058 . 128757) (
|
||||
\ENQUEUE.TIMER 128759 . 130666) (\GET.PRIORITY.QUEUE 130668 . 131693)) (134377 141599 (\PROCESS.INIT
|
||||
134387 . 135013) (\PROCESS.EVENTFN 135015 . 136751) (\PROCESS.BEFORE.LOGOUT 136753 . 138272) (
|
||||
\PROCESS.AFTER.EXIT 138274 . 138582) (\PROCESS.RESET.TIMERS 138584 . 140113) (\PROC.AFTER.WINDOWWORLD
|
||||
140115 . 140800) (\TURN.ON.PROCESSES 140802 . 141597)) (141630 142859 (\PROC.CODEFORTFRAME 141640 .
|
||||
142461) (\PROC.REPEATEDLYEVALQT 142463 . 142857)) (142893 149625 (BREAK.PROCESS 142903 . 143219) (
|
||||
\SELECTPROCESS 143221 . 145661) (\PROCESS.MAKEFRAME 145663 . 147714) (\PROCESS.MAKEFRAME0 147716 .
|
||||
149623)) (151838 153761 (\CHECK.PQUEUE 151848 . 153759)) (153762 172091 (PPROC 153772 . 155053) (
|
||||
PPROCWINDOW 155055 . 155546) (PPROCREPAINTFN 155548 . 156262) (PPROCRESHAPEFN 156264 . 156527) (
|
||||
PPROCEXTENT 156529 . 157013) (PPROC1 157015 . 159033) (PROCESS.STATUS.WINDOW 159035 . 163117) (
|
||||
\PSW.SELECTED 163119 . 163413) (\PSWOP.SELECTED 163415 . 167315) (PROCESS.BACKTRACE 167317 . 170508) (
|
||||
\INVALIDATE.PROCESS.WINDOW 170510 . 171244) (\UPDATE.PROCESS.WINDOW 171246 . 172089)))))
|
||||
(FILEMAP (NIL (22096 42363 (PROCESSWORLD 22106 . 31451) (ADD.PROCESS 31453 . 35610) (DEL.PROCESS 35612
|
||||
. 36559) (PROCESS.RETURN 36561 . 36708) (FIND.PROCESS 36710 . 37344) (MAP.PROCESSES 37346 . 37672) (
|
||||
PROCESSP 37674 . 37842) (RELPROCESSP 37844 . 38026) (RESTART.PROCESS 38028 . 38597) (WAKE.PROCESS
|
||||
38599 . 39329) (SUSPEND.PROCESS 39331 . 39718) (PROCESS.RESULT 39720 . 40698) (PROCESS-STATUS 40700 .
|
||||
42095) (PROCESS.FINISHEDP 42097 . 42361)) (42364 55571 (THIS.PROCESS 42374 . 42507) (TTY.PROCESS 42509
|
||||
. 49336) (TTY.PROCESSP 49338 . 49554) (PROCESS.TTY 49556 . 49906) (GIVE.TTY.PROCESS 49908 . 50718) (
|
||||
ALLOW.BUTTON.EVENTS 50720 . 50964) (SPAWN.MOUSE 50966 . 53179) (\WAIT.FOR.TTY 53181 . 53371) (
|
||||
WAIT.FOR.TTY 53373 . 55569)) (55572 58190 (RESET 55582 . 56414) (ERROR! 56416 . 58188)) (58551 63899 (
|
||||
PROCESSPROP 58561 . 63013) (PROCESS.NAME 63015 . 63320) (PROCESS.WINDOW 63322 . 63897)) (64101 69136 (
|
||||
DISMISS 64111 . 64926) (BLOCK 64928 . 67152) (WAITFORINPUT 67154 . 68383) (\WAITFORSYSBUFP 68385 .
|
||||
69134)) (69337 69834 (EVAL.AS.PROCESS 69347 . 69570) (EVAL.IN.TTY.PROCESS 69572 . 69832)) (70423 76207
|
||||
(PROCESS.READ 70433 . 71271) (PROCESS.EVALV 71273 . 71851) (PROCESS.EVAL 71853 . 72830) (
|
||||
\PROCESS.EVAL1 72832 . 73935) (PROCESS.APPLY 73937 . 74921) (\PROCESS.APPLY1 74923 . 76205)) (78266
|
||||
83571 (CREATE.EVENT 78276 . 78438) (NOTIFY.EVENT 78440 . 79948) (AWAIT.EVENT 79950 . 80572) (
|
||||
\UNQUEUE.EVENT 80574 . 82049) (\ENQUEUE.EVENT/LOCK 82051 . 83344) (\EVENT.DEFPRINT 83346 . 83569)) (
|
||||
90015 95006 (OBTAIN.MONITORLOCK 90025 . 92889) (CREATE.MONITORLOCK 92891 . 93110) (RELEASE.MONITORLOCK
|
||||
93112 . 93446) (SI::MONITOR-UNWIND 93448 . 94034) (MONITOR.AWAIT.EVENT 94036 . 94770) (
|
||||
\MONITORLOCK.DEFPRINT 94772 . 95004)) (96210 118970 (\MAKE.PROCESS0 96220 . 103419) (\MAKE.PROCESS1
|
||||
103421 . 104985) (\PROCESS.MOVEFRAME 104987 . 109536) (\RELEASE.PROCESS 109538 . 112588) (
|
||||
\UNWIND.PROCESS 112590 . 112916) (\MAYBEBLOCK 112918 . 113073) (\BACKGROUND.PROCESS 113075 . 113600) (
|
||||
\MOUSE.PROCESS 113602 . 116151) (\TIMER.PROCESS 116153 . 116709) (\PROCESS.RELEASE.LOCKS 116711 .
|
||||
117125) (\SET.PROCESS.NAME 117127 . 118663) (\PROCESS.DEFPRINT 118665 . 118968)) (118971 133326 (
|
||||
\START.PROCESSES 118981 . 119154) (\PROCESS.GO.TO.SLEEP 119156 . 122910) (\PROC.RESUME 122912 . 123286
|
||||
) (\RUN.PROCESS 123288 . 126624) (\SUSPEND.PROCESS 126626 . 129687) (\UNQUEUE.TIMER 129689 . 130388) (
|
||||
\ENQUEUE.TIMER 130390 . 132297) (\GET.PRIORITY.QUEUE 132299 . 133324)) (136771 143993 (\PROCESS.INIT
|
||||
136781 . 137407) (\PROCESS.EVENTFN 137409 . 139145) (\PROCESS.BEFORE.LOGOUT 139147 . 140666) (
|
||||
\PROCESS.AFTER.EXIT 140668 . 140976) (\PROCESS.RESET.TIMERS 140978 . 142507) (\PROC.AFTER.WINDOWWORLD
|
||||
142509 . 143194) (\TURN.ON.PROCESSES 143196 . 143991)) (144024 145253 (\PROC.CODEFORTFRAME 144034 .
|
||||
144855) (\PROC.REPEATEDLYEVALQT 144857 . 145251)) (145287 152019 (BREAK.PROCESS 145297 . 145613) (
|
||||
\SELECTPROCESS 145615 . 148055) (\PROCESS.MAKEFRAME 148057 . 150108) (\PROCESS.MAKEFRAME0 150110 .
|
||||
152017)) (154660 156583 (\CHECK.PQUEUE 154670 . 156581)) (156584 174913 (PPROC 156594 . 157875) (
|
||||
PPROCWINDOW 157877 . 158368) (PPROCREPAINTFN 158370 . 159084) (PPROCRESHAPEFN 159086 . 159349) (
|
||||
PPROCEXTENT 159351 . 159835) (PPROC1 159837 . 161855) (PROCESS.STATUS.WINDOW 161857 . 165939) (
|
||||
\PSW.SELECTED 165941 . 166235) (\PSWOP.SELECTED 166237 . 170137) (PROCESS.BACKTRACE 170139 . 173330) (
|
||||
\INVALIDATE.PROCESS.WINDOW 173332 . 174066) (\UPDATE.PROCESS.WINDOW 174068 . 174911)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,6 +0,0 @@
|
||||
"
|
||||
(MOVD? (QUOTE NILL) (QUOTE PROMPTPRINT))
|
||||
(MOVD? (QUOTE NILL) (QUOTE CURSORP))
|
||||
(MOVD? (QUOTE NILL) (QUOTE CHANGEBACKGROUNDBORDER))
|
||||
(LOGOUT)
|
||||
"
|
||||
Reference in New Issue
Block a user