From 8c7f42e595449df8d9720e192462a82302ae37f9 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Sun, 26 Jun 2022 17:46:19 -0700 Subject: [PATCH] assume process streams are UTF-8 --- sources/UNIXCOMM | 460 ++++++++++++++++++++++++++++++++++++++++++ sources/UNIXCOMM.LCOM | 460 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 920 insertions(+) create mode 100644 sources/UNIXCOMM create mode 100644 sources/UNIXCOMM.LCOM diff --git a/sources/UNIXCOMM b/sources/UNIXCOMM new file mode 100644 index 00000000..28c3c812 --- /dev/null +++ b/sources/UNIXCOMM @@ -0,0 +1,460 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "26-Jun-2022 14:27:33" {DSK}larry>medley>library>UNIXCOMM.;2 19997 + + :CHANGES-TO (FNS CREATE-PROCESS-STREAM) + + :PREVIOUS-DATE "25-Apr-2018 07:31:56" {DSK}larry>medley>library>UNIXCOMM.;1) + + +(* ; " +Copyright (c) 1988-1990, 2018 by Venue & Xerox Corporation. +") + +(PRETTYCOMPRINT UNIXCOMMCOMS) + +(RPAQQ UNIXCOMMCOMS + [ + (* ;; "streams to UNIX processes & pseudo terminals") + + + (* ;; "this stuff should really be implemented in terms of {SHELL} and {PTY} devices") + + (COMS (* ; "Forking stuff") + (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)) + (ADDVARS (AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN] + (COMS (* ; + "Stuff for direct manipulation of Unix sockets") + (FNS CREATE-UNIX-SOCKET-STREAM ACCEPT-UNIX-SOCKET-STREAM)) + (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] + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA]) + + + +(* ;; "streams to UNIX processes & pseudo terminals") + + + + +(* ;; "this stuff should really be implemented in terms of {SHELL} and {PTY} devices") + + + + +(* ; "Forking stuff") + +(DEFINEQ + +(FORK-SHELL + [LAMBDA (TERMTYPE COMMAND) (* ; "Edited 14-Feb-90 14:27 by bvm") + (if (SUBRCALL UNIX-HANDLECOMM 8) + then (* ; + "Yes, lde supports this new version") + [SUBRCALL UNIX-HANDLECOMM 11 (if (NULL TERMTYPE) + then "" + elseif (TYPEP TERMTYPE 'ONED-ARRAY) + then TERMTYPE + else (\DTEST (LISP-TO-UNIX-TERMTYPE TERMTYPE) + 'ONED-ARRAY)) + (if (NULL COMMAND) + then "" + else (\DTEST COMMAND 'ONED-ARRAY] + elseif COMMAND + then (* ; + "have to use a different old call") + (FORK-UNIX COMMAND) + else (SUBRCALL UNIX-HANDLECOMM 4]) + +(FORK-UNIX + [LAMBDA (STR) (* ; "Edited 25-May-88 15:47 by drc:") + (SUBRCALL UNIX-HANDLECOMM 0 (\DTEST STR 'ONED-ARRAY]) + +(UNIX-KILL + [LAMBDA (CONN) (* ; "Edited 25-May-88 16:04 by drc:") + (if CONN + then (SUBRCALL UNIX-HANDLECOMM 3 CONN 0]) + +(UNIX-WRITE + [LAMBDA (CONN VAL) (* ; "Edited 24-Sep-90 11:27 by jds") + + (* ;; "Write a byte (VAL) to the outgoing pipe connection CONN. If the write fails for non-fatal reasons (i.e., would block), loop unitl it succeeds. If the write returns NIL (meaning total failure), pass that along to the caller.") + + (PROG (LENGTH-WRITTEN) + WRITE-LOOP + [SETQ LENGTH-WRITTEN (SUBRCALL UNIX-HANDLECOMM 1 (\DTEST CONN 'SMALLP) + (\DTEST VAL 'SMALLP] + (COND + ((AND LENGTH-WRITTEN (IEQP 0 LENGTH-WRITTEN)) + (BLOCK) + (GO WRITE-LOOP))) + (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*))) + (COND + (CHAN (LET ((STR (create STREAM + ACCESS _ 'BOTH + 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) + (STREAMPROP STR 'SENDSCREENPARAMS (FUNCTION UNIX.SENDSCREENPARAMS)) + (STREAMPROP STR 'SETDISPLAYTYPE (FUNCTION UNIX.SETDISPLAYTYPE)) + STR]) + +(CREATE-PROCESS-STREAM + [LAMBDA (COMM) (* ; "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 (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) + (\EXTERNALFORMAT STR ':UTF-8) + + (* ;; "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 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))) + ((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT) + + (* ;; + "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))) + do (CLOSEF STREAM))))]) +) + + + +(* ; "Operations on the shell device") + +(DEFINEQ + +(INITIALIZE-NEW-SHELL-DEVICE + [LAMBDA NIL (* ; "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]) + +(UNIX-GET-NEXT-BUFFER + [LAMBDA (STREAM WHATFOR NOERRORFLG) (* ; + "Edited 13-Jun-90 01:07 by mitani") + (CASE WHATFOR + (READ [PROG ([BUF (ffetch (STREAM CBUFPTR) of (\DTEST STREAM 'STREAM] + (CONN (UNIX-CHANNEL STREAM)) + LEN) + RETRY + (BLOCK) (* ; + "Just so other procs get to run when someone is pounding output at Chat") + (if [AND CONN (SETQ LEN (SUBRCALL UNIX-HANDLECOMM 9 (\DTEST CONN 'SMALLP) + (OR BUF (replace (STREAM CBUFPTR) + of STREAM + with (SETQ BUF + (NCREATE 'VMEMPAGEP] + then (if (EQ LEN T) + then (* ; + " no input available, but still alive") + (if NOERRORFLG + then (RETURN NIL) + else (* ; + "Called from BIN--wait and try again") + (GO RETRY)) + else (UNINTERRUPTABLY + (replace (STREAM COFFSET) of STREAM + with 0) + (replace (STREAM CBUFSIZE) of STREAM + with LEN)) + (RETURN T)) + else (RETURN (AND (NOT NOERRORFLG) + (\EOF.ACTION STREAM]) + (T (SHOULDNT)))]) + +(UNIX-BACKFILEPTR-NEW + [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)) + (T (ERROR "Can't back up this unix Stream" STREAM]) + +(UNIX-STREAM-EOFP-NEW + [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") + + (COND + ((AND (ffetch (STREAM CBUFPTR) of (\DTEST STREAM 'STREAM)) + (< (ffetch (STREAM COFFSET) of STREAM) + (ffetch (STREAM CBUFSIZE) of STREAM))) + NIL) + (T (NOT (UNIX-GET-NEXT-BUFFER STREAM 'READ T]) + +(UNIX-STREAM-OUT + [LAMBDA (STREAM CHAR) (* ; "Edited 12-Jun-90 12:58 by jrb:") + (OR (UNIX-WRITE (UNIX-CHANNEL STREAM) + (\DTEST CHAR 'SMALLP)) + (CL:ERROR 'XCL:STREAM-NOT-OPEN STREAM]) + +(UNIX-STREAM-CLOSE + [LAMBDA (STREAM) (* ; "Edited 12-Aug-88 13:24 by drc:") + (PROG1 (UNIX-KILL (UNIX-CHANNEL STREAM)) + (CL:SETF (UNIX-CHANNEL STREAM) + NIL) + (CL:SETF (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*) + (REMOVE STREAM (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*))))]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS *NEW-SHELL-DEVICE*) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(INITIALIZE-NEW-SHELL-DEVICE) + + +(ADDTOVAR AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN) +) + + + +(* ; "Stuff for direct manipulation of Unix sockets") + +(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] + (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]) + +(ACCEPT-UNIX-SOCKET-STREAM + [LAMBDA (SOCKSTREAM) (* ; "Edited 29-May-90 16:31 by jrb:") + (LET ((CHAN (UNIX-CHANNEL SOCKSTREAM)) + NEWCHAN) + (SELECTQ (SETQ NEWCHAN (SUBRCALL UNIX-HANDLECOMM 13 CHAN)) + ((-1 NIL) + NEWCHAN) + (LET ((NEWSTREAM (create STREAM + ACCESS _ 'BOTH + 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]) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS UNIX-CHANNEL MACRO ((STR) + (fetch (STREAM F1) of STR))) +) + + +(CHECKIMPORTS '(FILEIO LLSUBRS) + 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 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]) + +(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) +) +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA ) +) +(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018)) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (2648 8649 (FORK-SHELL 2658 . 3855) (FORK-UNIX 3857 . 4033) (UNIX-KILL 4035 . 4224) ( +UNIX-WRITE 4226 . 4937) (CREATE-SHELL-STREAM 4939 . 6255) (CREATE-PROCESS-STREAM 6257 . 7746) ( +UNIXCOMM-AROUNDEXITFN 7748 . 8647)) (8697 13685 (INITIALIZE-NEW-SHELL-DEVICE 8707 . 9800) ( +UNIX-GET-NEXT-BUFFER 9802 . 12002) (UNIX-BACKFILEPTR-NEW 12004 . 12483) (UNIX-STREAM-EOFP-NEW 12485 . +13031) (UNIX-STREAM-OUT 13033 . 13289) (UNIX-STREAM-CLOSE 13291 . 13683)) (13941 15806 ( +CREATE-UNIX-SOCKET-STREAM 13951 . 14812) (ACCEPT-UNIX-SOCKET-STREAM 14814 . 15804)) (16155 19334 ( +UNIX-BACKFILEPTR 16165 . 16663) (UNIX-READ 16665 . 17187) (INITIALIZE-SHELL-DEVICE 17189 . 17928) ( +UNIX-STREAM-IN 17930 . 18306) (UNIX-STREAM-EOFP 18308 . 19082) (UNIX-STREAM-PEEK 19084 . 19332))))) +STOP diff --git a/sources/UNIXCOMM.LCOM b/sources/UNIXCOMM.LCOM new file mode 100644 index 00000000..28c3c812 --- /dev/null +++ b/sources/UNIXCOMM.LCOM @@ -0,0 +1,460 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "26-Jun-2022 14:27:33" {DSK}larry>medley>library>UNIXCOMM.;2 19997 + + :CHANGES-TO (FNS CREATE-PROCESS-STREAM) + + :PREVIOUS-DATE "25-Apr-2018 07:31:56" {DSK}larry>medley>library>UNIXCOMM.;1) + + +(* ; " +Copyright (c) 1988-1990, 2018 by Venue & Xerox Corporation. +") + +(PRETTYCOMPRINT UNIXCOMMCOMS) + +(RPAQQ UNIXCOMMCOMS + [ + (* ;; "streams to UNIX processes & pseudo terminals") + + + (* ;; "this stuff should really be implemented in terms of {SHELL} and {PTY} devices") + + (COMS (* ; "Forking stuff") + (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)) + (ADDVARS (AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN] + (COMS (* ; + "Stuff for direct manipulation of Unix sockets") + (FNS CREATE-UNIX-SOCKET-STREAM ACCEPT-UNIX-SOCKET-STREAM)) + (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] + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA]) + + + +(* ;; "streams to UNIX processes & pseudo terminals") + + + + +(* ;; "this stuff should really be implemented in terms of {SHELL} and {PTY} devices") + + + + +(* ; "Forking stuff") + +(DEFINEQ + +(FORK-SHELL + [LAMBDA (TERMTYPE COMMAND) (* ; "Edited 14-Feb-90 14:27 by bvm") + (if (SUBRCALL UNIX-HANDLECOMM 8) + then (* ; + "Yes, lde supports this new version") + [SUBRCALL UNIX-HANDLECOMM 11 (if (NULL TERMTYPE) + then "" + elseif (TYPEP TERMTYPE 'ONED-ARRAY) + then TERMTYPE + else (\DTEST (LISP-TO-UNIX-TERMTYPE TERMTYPE) + 'ONED-ARRAY)) + (if (NULL COMMAND) + then "" + else (\DTEST COMMAND 'ONED-ARRAY] + elseif COMMAND + then (* ; + "have to use a different old call") + (FORK-UNIX COMMAND) + else (SUBRCALL UNIX-HANDLECOMM 4]) + +(FORK-UNIX + [LAMBDA (STR) (* ; "Edited 25-May-88 15:47 by drc:") + (SUBRCALL UNIX-HANDLECOMM 0 (\DTEST STR 'ONED-ARRAY]) + +(UNIX-KILL + [LAMBDA (CONN) (* ; "Edited 25-May-88 16:04 by drc:") + (if CONN + then (SUBRCALL UNIX-HANDLECOMM 3 CONN 0]) + +(UNIX-WRITE + [LAMBDA (CONN VAL) (* ; "Edited 24-Sep-90 11:27 by jds") + + (* ;; "Write a byte (VAL) to the outgoing pipe connection CONN. If the write fails for non-fatal reasons (i.e., would block), loop unitl it succeeds. If the write returns NIL (meaning total failure), pass that along to the caller.") + + (PROG (LENGTH-WRITTEN) + WRITE-LOOP + [SETQ LENGTH-WRITTEN (SUBRCALL UNIX-HANDLECOMM 1 (\DTEST CONN 'SMALLP) + (\DTEST VAL 'SMALLP] + (COND + ((AND LENGTH-WRITTEN (IEQP 0 LENGTH-WRITTEN)) + (BLOCK) + (GO WRITE-LOOP))) + (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*))) + (COND + (CHAN (LET ((STR (create STREAM + ACCESS _ 'BOTH + 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) + (STREAMPROP STR 'SENDSCREENPARAMS (FUNCTION UNIX.SENDSCREENPARAMS)) + (STREAMPROP STR 'SETDISPLAYTYPE (FUNCTION UNIX.SETDISPLAYTYPE)) + STR]) + +(CREATE-PROCESS-STREAM + [LAMBDA (COMM) (* ; "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 (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) + (\EXTERNALFORMAT STR ':UTF-8) + + (* ;; "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 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))) + ((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT) + + (* ;; + "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))) + do (CLOSEF STREAM))))]) +) + + + +(* ; "Operations on the shell device") + +(DEFINEQ + +(INITIALIZE-NEW-SHELL-DEVICE + [LAMBDA NIL (* ; "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]) + +(UNIX-GET-NEXT-BUFFER + [LAMBDA (STREAM WHATFOR NOERRORFLG) (* ; + "Edited 13-Jun-90 01:07 by mitani") + (CASE WHATFOR + (READ [PROG ([BUF (ffetch (STREAM CBUFPTR) of (\DTEST STREAM 'STREAM] + (CONN (UNIX-CHANNEL STREAM)) + LEN) + RETRY + (BLOCK) (* ; + "Just so other procs get to run when someone is pounding output at Chat") + (if [AND CONN (SETQ LEN (SUBRCALL UNIX-HANDLECOMM 9 (\DTEST CONN 'SMALLP) + (OR BUF (replace (STREAM CBUFPTR) + of STREAM + with (SETQ BUF + (NCREATE 'VMEMPAGEP] + then (if (EQ LEN T) + then (* ; + " no input available, but still alive") + (if NOERRORFLG + then (RETURN NIL) + else (* ; + "Called from BIN--wait and try again") + (GO RETRY)) + else (UNINTERRUPTABLY + (replace (STREAM COFFSET) of STREAM + with 0) + (replace (STREAM CBUFSIZE) of STREAM + with LEN)) + (RETURN T)) + else (RETURN (AND (NOT NOERRORFLG) + (\EOF.ACTION STREAM]) + (T (SHOULDNT)))]) + +(UNIX-BACKFILEPTR-NEW + [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)) + (T (ERROR "Can't back up this unix Stream" STREAM]) + +(UNIX-STREAM-EOFP-NEW + [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") + + (COND + ((AND (ffetch (STREAM CBUFPTR) of (\DTEST STREAM 'STREAM)) + (< (ffetch (STREAM COFFSET) of STREAM) + (ffetch (STREAM CBUFSIZE) of STREAM))) + NIL) + (T (NOT (UNIX-GET-NEXT-BUFFER STREAM 'READ T]) + +(UNIX-STREAM-OUT + [LAMBDA (STREAM CHAR) (* ; "Edited 12-Jun-90 12:58 by jrb:") + (OR (UNIX-WRITE (UNIX-CHANNEL STREAM) + (\DTEST CHAR 'SMALLP)) + (CL:ERROR 'XCL:STREAM-NOT-OPEN STREAM]) + +(UNIX-STREAM-CLOSE + [LAMBDA (STREAM) (* ; "Edited 12-Aug-88 13:24 by drc:") + (PROG1 (UNIX-KILL (UNIX-CHANNEL STREAM)) + (CL:SETF (UNIX-CHANNEL STREAM) + NIL) + (CL:SETF (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*) + (REMOVE STREAM (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*))))]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS *NEW-SHELL-DEVICE*) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(INITIALIZE-NEW-SHELL-DEVICE) + + +(ADDTOVAR AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN) +) + + + +(* ; "Stuff for direct manipulation of Unix sockets") + +(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] + (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]) + +(ACCEPT-UNIX-SOCKET-STREAM + [LAMBDA (SOCKSTREAM) (* ; "Edited 29-May-90 16:31 by jrb:") + (LET ((CHAN (UNIX-CHANNEL SOCKSTREAM)) + NEWCHAN) + (SELECTQ (SETQ NEWCHAN (SUBRCALL UNIX-HANDLECOMM 13 CHAN)) + ((-1 NIL) + NEWCHAN) + (LET ((NEWSTREAM (create STREAM + ACCESS _ 'BOTH + 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]) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS UNIX-CHANNEL MACRO ((STR) + (fetch (STREAM F1) of STR))) +) + + +(CHECKIMPORTS '(FILEIO LLSUBRS) + 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 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]) + +(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) +) +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA ) +) +(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018)) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (2648 8649 (FORK-SHELL 2658 . 3855) (FORK-UNIX 3857 . 4033) (UNIX-KILL 4035 . 4224) ( +UNIX-WRITE 4226 . 4937) (CREATE-SHELL-STREAM 4939 . 6255) (CREATE-PROCESS-STREAM 6257 . 7746) ( +UNIXCOMM-AROUNDEXITFN 7748 . 8647)) (8697 13685 (INITIALIZE-NEW-SHELL-DEVICE 8707 . 9800) ( +UNIX-GET-NEXT-BUFFER 9802 . 12002) (UNIX-BACKFILEPTR-NEW 12004 . 12483) (UNIX-STREAM-EOFP-NEW 12485 . +13031) (UNIX-STREAM-OUT 13033 . 13289) (UNIX-STREAM-CLOSE 13291 . 13683)) (13941 15806 ( +CREATE-UNIX-SOCKET-STREAM 13951 . 14812) (ACCEPT-UNIX-SOCKET-STREAM 14814 . 15804)) (16155 19334 ( +UNIX-BACKFILEPTR 16165 . 16663) (UNIX-READ 16665 . 17187) (INITIALIZE-SHELL-DEVICE 17189 . 17928) ( +UNIX-STREAM-IN 17930 . 18306) (UNIX-STREAM-EOFP 18308 . 19082) (UNIX-STREAM-PEEK 19084 . 19332))))) +STOP