github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

UNIXCOMM: Eliminated the new shell device in favor of a single shell device (#1034)

Browse Source 
Also removed unused functions labeled as "obsolete" after Medley 2
This commit is contained in:
rmkaplan 2022-12-23 11:37:23 -08:00 committed by GitHub
parent 7eb12ee68b
commit bb637c5b73
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 86 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

312
library/UNIXCOMM
View File

@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 8-Oct-2022 16:06:36" {DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;2 20352
(FILECREATED "18-Dec-2022 11:55:01" {WMEDLEY}<library>UNIXCOMM.;11 14599
:CHANGES-TO (FNS CREATE-PROCESS-STREAM)
:CHANGES-TO (FNS INITIALIZE-SHELL-DEVICE UNIX-BACKFILEPTR UNIX-STREAM-EOFP)
(VARS UNIXCOMMCOMS)
:PREVIOUS-DATE " 7-Jul-2022 10:42:46"
{DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;1)
:PREVIOUS-DATE "25-Oct-2022 21:56:00" {WMEDLEY}<library>UNIXCOMM.;9)
(* ; "
@ -25,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-NEW-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR-NEW
UNIX-STREAM-EOFP-NEW UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
(GLOBALVARS *NEW-SHELL-DEVICE*)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-NEW-SHELL-DEVICE))
(FNS INITIALIZE-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR UNIX-STREAM-EOFP
UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
(GLOBALVARS *SHELL-DEVICE*)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE))
(ADDVARS (AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN]
(COMS (* ;
 "Stuff for direct manipulation of Unix sockets")
@ -36,14 +36,6 @@ 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)))
@ -107,24 +99,17 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(RETURN LENGTH-WRITTEN])
(CREATE-SHELL-STREAM
[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*)))
[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)))
(COND
(CHAN (LET ((STR (create STREAM
ACCESS _ 'BOTH
DEVICE _ SHELL-DEV)))
DEVICE _ *SHELL-DEVICE*)))
(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])
@ -132,49 +117,38 @@ 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* ((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])
(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])
(UNIXCOMM-AROUNDEXITFN
[LAMBDA (EVENT) (* ; "Edited 2-Jul-90 16:35 by jrb:")
[LAMBDA (EVENT) (* ; "Edited 25-Oct-2022 21:20 by lmm")
(* ; "Edited 11-Oct-2022 10:07 by lmm")
(* ; "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)))
((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)))
((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)))
@ -187,25 +161,27 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(DEFINEQ
(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])
(INITIALIZE-SHELL-DEVICE
[LAMBDA NIL (* ; "Edited 18-Dec-2022 11:53 by rmk")
(* ; "Edited 25-Oct-2022 21:54 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 _ (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)
BACKFILEPTR _ (FUNCTION UNIX-BACKFILEPTR)
GETNEXTBUFFER _ (FUNCTION UNIX-GET-NEXT-BUFFER)
BLOCKIN _ (FUNCTION \BUFFERED.BINS)
DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
(UNIX-GET-NEXT-BUFFER
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* ;
@ -240,22 +216,20 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(\EOF.ACTION STREAM])
(T (SHOULDNT)))])
(UNIX-BACKFILEPTR-NEW
[LAMBDA (STREAM) (* ;
 "Edited 13-Jun-90 01:07 by mitani")
(UNIX-BACKFILEPTR
[LAMBDA (STREAM) (* ; "Edited 13-Jun-90 01:07 by mitani")
(COND
((AND (fetch (STREAM CBUFPTR) of STREAM)
(> (fetch (STREAM COFFSET) of STREAM)
0))
(add (fetch (STREAM COFFSET) of STREAM)
-1))
-1))
(T (ERROR "Can't back up this unix Stream" STREAM])
(UNIX-STREAM-EOFP-NEW
[LAMBDA (STREAM) (* ;
 "Edited 13-Jun-90 01:07 by mitani")
(UNIX-STREAM-EOFP
[LAMBDA (STREAM) (* ; "Edited 13-Jun-90 01:07 by mitani")
(* ;;; "true if bsp STREAM is at end of file, i.e. is at a mark")
(* ;;; "true if bsp STREAM is at end of file, i.e. is at a mark")
(COND
((AND (ffetch (STREAM CBUFPTR) of (\DTEST STREAM 'STREAM))
@ -280,11 +254,11 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *NEW-SHELL-DEVICE*)
(GLOBALVARS *SHELL-DEVICE*)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(INITIALIZE-NEW-SHELL-DEVICE)
(INITIALIZE-SHELL-DEVICE)
(ADDTOVAR AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN)
@ -297,25 +271,23 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(DEFINEQ
(CREATE-UNIX-SOCKET-STREAM
[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]
[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]
(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])
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])
(ACCEPT-UNIX-SOCKET-STREAM
[LAMBDA (SOCKSTREAM) (* ; "Edited 29-May-90 16:31 by jrb:")
[LAMBDA (SOCKSTREAM) (* ; "Edited 11-Oct-2022 10:12 by lmm")
(* ; "Edited 29-May-90 16:31 by jrb:")
(LET ((CHAN (UNIX-CHANNEL SOCKSTREAM))
NEWCHAN)
(SELECTQ (SETQ NEWCHAN (SUBRCALL UNIX-HANDLECOMM 13 CHAN))
@ -323,15 +295,12 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
NEWCHAN)
(LET ((NEWSTREAM (create STREAM
ACCESS _ 'BOTH
DEVICE _ *NEW-SHELL-DEVICE*
DEVICE _ *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
@ -346,122 +315,13 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
T)
)
(* ;;
"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 FILETYPE COMPILE-FILE)
(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
(DECLARE%: DONTCOPY
(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)))))
(FILEMAP (NIL (1963 7028 (FORK-SHELL 1973 . 3170) (FORK-UNIX 3172 . 3348) (UNIX-KILL 3350 . 3539) (
UNIX-WRITE 3541 . 4252) (CREATE-SHELL-STREAM 4254 . 5138) (CREATE-PROCESS-STREAM 5140 . 5979) (
UNIXCOMM-AROUNDEXITFN 5981 . 7026)) (7076 12267 (INITIALIZE-SHELL-DEVICE 7086 . 8514) (
UNIX-GET-NEXT-BUFFER 8516 . 10716) (UNIX-BACKFILEPTR 10718 . 11130) (UNIX-STREAM-EOFP 11132 . 11613) (
UNIX-STREAM-OUT 11615 . 11871) (UNIX-STREAM-CLOSE 11873 . 12265)) (12515 14221 (
CREATE-UNIX-SOCKET-STREAM 12525 . 13331) (ACCEPT-UNIX-SOCKET-STREAM 13333 . 14219)))))
STOP

BIN
library/UNIXCOMM.LCOM
View File

Binary file not shown.