github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-25 20:06:44 +00:00
Code Issues Projects Releases Wiki Activity

Revert "Lmm cleanup new shell device (#1006)" (#1033)

Browse Source 
This reverts commit 97cb04be46.
This commit is contained in:
Larry Masinter
2022-12-17 17:22:41 -08:00
committed by GitHub
parent 97cb04be46
commit 7eb12ee68b
2 changed files with 216 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files

295
library/UNIXCOMM
View File

@@ -1,12 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-Oct-2022 10:18:47" {DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;4 14580
(FILECREATED " 8-Oct-2022 16:06:36" {DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;2 20352
:CHANGES-TO (FNS CREATE-SHELL-STREAM CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN
CREATE-UNIX-SOCKET-STREAM ACCEPT-UNIX-SOCKET-STREAM INITIALIZE-SHELL-DEVICE)
(VARS UNIXCOMMCOMS)
:CHANGES-TO (FNS CREATE-PROCESS-STREAM)
:PREVIOUS-DATE " 8-Oct-2022 16:06:36"
:PREVIOUS-DATE " 7-Jul-2022 10:42:46"
{DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;1)
@@ -27,10 +25,10 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(FNS FORK-SHELL FORK-UNIX UNIX-KILL UNIX-WRITE CREATE-SHELL-STREAM
CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN))
[COMS (* ; "Operations on the shell device")
(FNS INITIALIZE-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR-NEW
(FNS INITIALIZE-NEW-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR-NEW
UNIX-STREAM-EOFP-NEW UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
(GLOBALVARS *SHELL-DEVICE*)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE))
(GLOBALVARS *NEW-SHELL-DEVICE*)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-NEW-SHELL-DEVICE))
(ADDVARS (AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN]
(COMS (* ;
 "Stuff for direct manipulation of Unix sockets")
@@ -38,6 +36,14 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-CHANNEL)
(P (CHECKIMPORTS '(FILEIO LLSUBRS)
T)))
[COMS
(* ;; "Obsolete stuff. This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device")
(FNS UNIX-BACKFILEPTR UNIX-READ INITIALIZE-SHELL-DEVICE UNIX-STREAM-IN UNIX-STREAM-EOFP
UNIX-STREAM-PEEK)
(GLOBALVARS *SHELL-DEVICE*)
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-PEEKEDCHAR UNIX-LASTCHAR))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE]
(PROP FILETYPE UNIXCOMM)))
@@ -101,17 +107,24 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(RETURN LENGTH-WRITTEN])
(CREATE-SHELL-STREAM
[LAMBDA (TERMTYPE COMMAND) (* ; "Edited 11-Oct-2022 09:56 by lmm")
(* ; "Edited 21-May-90 15:39 by jrb:")
(LET ((CHAN (FORK-SHELL TERMTYPE COMMAND)))
[LAMBDA (TERMTYPE COMMAND) (* ; "Edited 21-May-90 15:39 by jrb:")
(LET ((CHAN (FORK-SHELL TERMTYPE COMMAND))
(SHELL-DEV (if (SUBRCALL UNIX-HANDLECOMM 8)
then (* ;
 "SUBRCALL tests that this is supported")
*NEW-SHELL-DEVICE*
else *SHELL-DEVICE*)))
(COND
(CHAN (LET ((STR (create STREAM
ACCESS _ 'BOTH
DEVICE _ *SHELL-DEVICE*)))
DEVICE _ SHELL-DEV)))
(CL:SETF (UNIX-CHANNEL STR)
CHAN)
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
STR)
STR)
(STREAMPROP STR 'SENDSCREENPARAMS (FUNCTION UNIX.SENDSCREENPARAMS))
(STREAMPROP STR 'SETDISPLAYTYPE (FUNCTION UNIX.SETDISPLAYTYPE))
STR])
@@ -119,40 +132,49 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(CREATE-PROCESS-STREAM
[LAMBDA (COMM)
(* ;; "Edited 11-Oct-2022 10:05 by lmm")
(* ;; "Edited 8-Oct-2022 16:04 by lmm")
(* ;; "Edited 3-Jul-2022 16:04 by rmk: Removed external format here, the device has the environmental defaultg")
(* ;; "Edited 26-Jun-2022 13:52 by larry")
(* ;; "Edited 26-Jun-2022 13:31 by lmm - set external format of shell stream to utf-8 ??")
(* ;; "Edited 21-May-90 15:39 by jrb:")
(LET ((CHAN (FORK-UNIX COMM)))
(if CHAN
then (LET ((STR (create STREAM
ACCESS _ 'BOTH
DEVICE _ *SHELL-DEVICE*
EOLCONVENTION _ LF.EOLC)))
(CL:SETF (UNIX-CHANNEL STR)
CHAN)
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
STR)
STR])
(LET* ((SHELL-DEV (if (AND (BOUNDP '*NEW-SHELL-DEVICE*)
(SUBRCALL UNIX-HANDLECOMM 8))
then (* ;
 "SUBRCALL tests that this is supported")
*NEW-SHELL-DEVICE*
else *SHELL-DEVICE*))
(STR (create STREAM
ACCESS _ 'BOTH
DEVICE _ SHELL-DEV
EOLCONVENTION _ LF.EOLC))
(CHAN (FORK-UNIX COMM)))
(if CHAN
then (CL:SETF (UNIX-CHANNEL STR)
CHAN)
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
STR)
STR
else NIL])
(UNIXCOMM-AROUNDEXITFN
[LAMBDA (EVENT) (* ; "Edited 11-Oct-2022 10:07 by lmm")
(* ;;
 "only using *NEW-SHELL-DEVICE* for creation; *SHELL-DEVICE* -- will cleanup in another pass")
 (* ; "Edited 2-Jul-90 16:35 by jrb:")
[LAMBDA (EVENT) (* ; "Edited 2-Jul-90 16:35 by jrb:")
(CASE EVENT
((AFTERLOGOUT AFTERMAKESYS AFTERSAVEVM AFTERSYSOUT)
(for STREAM in (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*) do (CLOSEF STREAM))
(REPLACE (FDEV DEFAULTEXTERNALFORMAT) OF *SHELL-DEVICE* WITH (SYSTEM-EXTERNALFORMAT)))
((AFTERLOGOUT AFTERMAKESYS AFTERSAVEVM AFTERSYSOUT) (for STREAM
in (fetch (FDEV OPENFILELST)
of *SHELL-DEVICE*)
do (CLOSEF STREAM)))
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT)
(* ;;
 "Make sure any Unix sockets get closed here, so their file system handles get closed as well")
(* ;;
 "Make sure any Unix sockets get closed here, so their file system handles get closed as well")
(for STREAM in (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
when (EQ -3 (SUBRCALL UNIX-HANDLECOMM 14 (UNIX-CHANNEL STREAM)))
@@ -165,24 +187,25 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(DEFINEQ
(INITIALIZE-SHELL-DEVICE
[LAMBDA NIL (* ; "Edited 11-Oct-2022 09:35 by lmm")
(* ;; "only using for holding open list")
 (* ; "Edited 3-Jul-2022 16:15 by rmk")
(* ; "Edited 14-Dec-88 10:45 by bane")
(SETQ *SHELL-DEVICE* (create FDEV
NODIRECTORIES _ T
DEVICENAME _ 'UNIX-PTY
BIN _ 'UNIX-STREAM-IN
BOUT _ 'UNIX-STREAM-OUT
PEEKBIN _ 'UNIX-STREAM-PEEK
CLOSEFILE _ 'UNIX-STREAM-CLOSE
GETFILEINFO _ 'NILL
SETFILEINFO _ 'NILL
EOFP _ 'UNIX-STREAM-EOFP
BACKFILEPTR _ 'UNIX-BACKFILEPTR
DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
(INITIALIZE-NEW-SHELL-DEVICE
[LAMBDA NIL (* ; "Edited 7-Jul-2022 10:41 by rmk")
(* ; "Edited 3-Jul-2022 16:04 by rmk")
(* ; "Edited 12-Feb-90 17:00 by bvm")
(SETQ *NEW-SHELL-DEVICE* (create FDEV
FDBINABLE _ T
NODIRECTORIES _ T
DEVICENAME _ (FUNCTION UNIX-PTY-NEW)
BIN _ (FUNCTION \BUFFERED.BIN)
BOUT _ (FUNCTION UNIX-STREAM-OUT)
PEEKBIN _ (FUNCTION \BUFFERED.PEEKBIN)
CLOSEFILE _ (FUNCTION UNIX-STREAM-CLOSE)
GETFILEINFO _ (FUNCTION NILL)
SETFILEINFO _ (FUNCTION NILL)
EOFP _ (FUNCTION UNIX-STREAM-EOFP-NEW)
BACKFILEPTR _ (FUNCTION UNIX-BACKFILEPTR-NEW)
GETNEXTBUFFER _ (FUNCTION UNIX-GET-NEXT-BUFFER)
BLOCKIN _ (FUNCTION \BUFFERED.BINS)
DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
(UNIX-GET-NEXT-BUFFER
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* ;
@@ -257,11 +280,11 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *SHELL-DEVICE*)
(GLOBALVARS *NEW-SHELL-DEVICE*)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(INITIALIZE-SHELL-DEVICE)
(INITIALIZE-NEW-SHELL-DEVICE)
(ADDTOVAR AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN)
@@ -274,23 +297,25 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(DEFINEQ
(CREATE-UNIX-SOCKET-STREAM
[LAMBDA (PATHNAME) (* ; "Edited 11-Oct-2022 10:11 by lmm")
(* ; "Edited 29-May-90 16:23 by jrb:")
(LET [(CHAN (SUBRCALL UNIX-HANDLECOMM 12 (\DTEST PATHNAME 'ONED-ARRAY]
[LAMBDA (PATHNAME) (* ; "Edited 29-May-90 16:23 by jrb:")
(LET [(STR (create STREAM
ACCESS _ 'BOTH
DEVICE _ *NEW-SHELL-DEVICE*
EOLCONVENTION _ LF.EOLC))
(CHAN (SUBRCALL UNIX-HANDLECOMM 12 (\DTEST PATHNAME 'ONED-ARRAY]
(if CHAN
then (LET ((STR (create STREAM
ACCESS _ 'BOTH
DEVICE _ *SHELL-DEVICE*
EOLCONVENTION _ LF.EOLC)))
(CL:SETF (UNIX-CHANNEL STR)
CHAN)
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
STR)
STR])
then (CL:SETF (UNIX-CHANNEL STR)
CHAN)
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
STR)
STR
else NIL])
(ACCEPT-UNIX-SOCKET-STREAM
[LAMBDA (SOCKSTREAM) (* ; "Edited 11-Oct-2022 10:12 by lmm")
(* ; "Edited 29-May-90 16:31 by jrb:")
[LAMBDA (SOCKSTREAM) (* ; "Edited 29-May-90 16:31 by jrb:")
(LET ((CHAN (UNIX-CHANNEL SOCKSTREAM))
NEWCHAN)
(SELECTQ (SETQ NEWCHAN (SUBRCALL UNIX-HANDLECOMM 13 CHAN))
@@ -298,12 +323,15 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
NEWCHAN)
(LET ((NEWSTREAM (create STREAM
ACCESS _ 'BOTH
DEVICE _ *SHELL-DEVICE*
DEVICE _ *NEW-SHELL-DEVICE*
EOLCONVENTION _ LF.EOLC)))
(CL:SETF (UNIX-CHANNEL NEWSTREAM)
NEWCHAN)
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
NEWSTREAM)
NEWSTREAM)
NEWSTREAM])
)
(DECLARE%: EVAL@COMPILE DONTCOPY
@@ -318,13 +346,122 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
T)
)
(PUTPROPS UNIXCOMM FILETYPE COMPILE-FILE)
(* ;;
"Obsolete stuff. This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device"
)
(DEFINEQ
(UNIX-BACKFILEPTR
[LAMBDA (STREAM) (* ; "Edited 14-Dec-88 09:52 by bane")
(* ;; "The trick here is to use the existing mechanisms for UNIX-PEEKCHAR")
(COND
((UNIX-PEEKEDCHAR STREAM)
(ERROR "Can only back up one character" STREAM))
((NOT (UNIX-LASTCHAR STREAM))
(ERROR "Can't back up past beginning of stream" STREAM))
(T (CL:SETF (UNIX-PEEKEDCHAR STREAM)
(UNIX-LASTCHAR STREAM])
(UNIX-READ
[LAMBDA (STREAM NO-ERROR) (* ; "Edited 14-Dec-88 09:18 by bane")
(LET* [(CONN (UNIX-CHANNEL STREAM))
(CH (AND CONN (SUBRCALL UNIX-HANDLECOMM 2 (\DTEST CONN 'SMALLP)
0]
(COND
((EQ CH T)
NIL)
[(EQ CH NIL)
(COND
(NO-ERROR NIL)
(T (\EOF.ACTION STREAM]
(T (CL:SETF (UNIX-LASTCHAR STREAM)
CH])
(INITIALIZE-SHELL-DEVICE
[LAMBDA NIL (* ; "Edited 3-Jul-2022 16:15 by rmk")
(* ; "Edited 14-Dec-88 10:45 by bane")
(SETQ *SHELL-DEVICE* (create FDEV
NODIRECTORIES _ T
DEVICENAME _ 'UNIX-PTY
BIN _ 'UNIX-STREAM-IN
BOUT _ 'UNIX-STREAM-OUT
PEEKBIN _ 'UNIX-STREAM-PEEK
CLOSEFILE _ 'UNIX-STREAM-CLOSE
GETFILEINFO _ 'NILL
SETFILEINFO _ 'NILL
EOFP _ 'UNIX-STREAM-EOFP
BACKFILEPTR _ 'UNIX-BACKFILEPTR
DEFAULTEXTERNALFORMAT _ (AND (STRPOS ".UTF-8" (UNIX-GETENV "LANG"))
:UTF-8])
(UNIX-STREAM-IN
[LAMBDA (STREAM) (* ; "Edited 9-May-88 15:05 by ")
(LET (CH)
(if (SETQ CH (UNIX-PEEKEDCHAR STREAM))
then (CL:SETF (UNIX-PEEKEDCHAR STREAM)
NIL)
else (while (NOT (SETQ CH (UNIX-READ STREAM))) do (BLOCK)))
CH])
(UNIX-STREAM-EOFP
[LAMBDA (STREAM) (* ; "Edited 2-Apr-90 11:51 by jds")
(* ;; "EOFP method for unix-shell streams. Notices when there are chars yet to read and doesn't set EOFP.")
(AND (NOT (UNIX-PEEKEDCHAR STREAM))
(LET* [(CONN (UNIX-CHANNEL STREAM))
(CH (AND CONN (SUBRCALL UNIX-HANDLECOMM 2 (\DTEST CONN 'SMALLP)
0]
(COND
((EQ CH T)
NIL)
((EQ CH NIL)
T)
(T (CL:SETF (UNIX-PEEKEDCHAR STREAM)
CH)
(CL:SETF (UNIX-LASTCHAR STREAM)
CH)
NIL])
(UNIX-STREAM-PEEK
[LAMBDA (STREAM NO-ERROR) (* ; "Edited 24-Jun-88 15:07 by drc:")
(OR (UNIX-PEEKEDCHAR STREAM)
(CL:SETF (UNIX-PEEKEDCHAR STREAM)
(UNIX-READ STREAM NO-ERROR])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *SHELL-DEVICE*)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(PUTPROPS UNIX-PEEKEDCHAR MACRO ((STR)
(FETCH (STREAM F2) OF STR)))
(PUTPROPS UNIX-LASTCHAR MACRO ((STR)
(FETCH (STREAM F3) OF STR)))
)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(INITIALIZE-SHELL-DEVICE)
)
(PUTPROPS UNIXCOMM FILETYPE FAKE-COMPILE-FILE)
(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2139 7214 (FORK-SHELL 2149 . 3346) (FORK-UNIX 3348 . 3524) (UNIX-KILL 3526 . 3715) (
UNIX-WRITE 3717 . 4428) (CREATE-SHELL-STREAM 4430 . 5314) (CREATE-PROCESS-STREAM 5316 . 6155) (
UNIXCOMM-AROUNDEXITFN 6157 . 7212)) (7262 12248 (INITIALIZE-SHELL-DEVICE 7272 . 8363) (
UNIX-GET-NEXT-BUFFER 8365 . 10565) (UNIX-BACKFILEPTR-NEW 10567 . 11046) (UNIX-STREAM-EOFP-NEW 11048 .
11594) (UNIX-STREAM-OUT 11596 . 11852) (UNIX-STREAM-CLOSE 11854 . 12246)) (12496 14202 (
CREATE-UNIX-SOCKET-STREAM 12506 . 13312) (ACCEPT-UNIX-SOCKET-STREAM 13314 . 14200)))))
(FILEMAP (NIL (2467 8489 (FORK-SHELL 2477 . 3674) (FORK-UNIX 3676 . 3852) (UNIX-KILL 3854 . 4043) (
UNIX-WRITE 4045 . 4756) (CREATE-SHELL-STREAM 4758 . 6074) (CREATE-PROCESS-STREAM 6076 . 7586) (
UNIXCOMM-AROUNDEXITFN 7588 . 8487)) (8537 13831 (INITIALIZE-NEW-SHELL-DEVICE 8547 . 9946) (
UNIX-GET-NEXT-BUFFER 9948 . 12148) (UNIX-BACKFILEPTR-NEW 12150 . 12629) (UNIX-STREAM-EOFP-NEW 12631 .
13177) (UNIX-STREAM-OUT 13179 . 13435) (UNIX-STREAM-CLOSE 13437 . 13829)) (14087 15952 (
CREATE-UNIX-SOCKET-STREAM 14097 . 14958) (ACCEPT-UNIX-SOCKET-STREAM 14960 . 15950)) (16301 19761 (
UNIX-BACKFILEPTR 16311 . 16809) (UNIX-READ 16811 . 17333) (INITIALIZE-SHELL-DEVICE 17335 . 18355) (
UNIX-STREAM-IN 18357 . 18733) (UNIX-STREAM-EOFP 18735 . 19509) (UNIX-STREAM-PEEK 19511 . 19759)))))
STOP

BIN
library/UNIXCOMM.LCOM
View File

Binary file not shown.