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

Revert "Recompiled all FDEV creators to install *DEFAULT-EXTERNALFORMAT* (#458)"

Browse Source 
This reverts commit 2615140ede.
This commit is contained in:
Larry Masinter
2021-09-06 09:04:00 -07:00
committed by GitHub
parent 2615140ede
commit 4bb4457d55
40 changed files with 1799 additions and 4963 deletions
Download Patch File Download Diff File Expand all files Collapse all files

457
sources/UNIXCOMM
View File

@@ -1,457 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Sep-2021 08:25:13" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>UNIXCOMM.;1 19779
changes to%: (FNS INITIALIZE-NEW-SHELL-DEVICE INITIALIZE-SHELL-DEVICE)
previous date%: "25-Apr-2018 07:31:56"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNIXCOMM.;1)
(* ; "
Copyright (c) 1988-1990, 2018, 2021 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 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)
(* ;; "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 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2730 8402 (FORK-SHELL 2740 . 3937) (FORK-UNIX 3939 . 4115) (UNIX-KILL 4117 . 4306) (
UNIX-WRITE 4308 . 5019) (CREATE-SHELL-STREAM 5021 . 6337) (CREATE-PROCESS-STREAM 6339 . 7499) (
UNIXCOMM-AROUNDEXITFN 7501 . 8400)) (8450 13438 (INITIALIZE-NEW-SHELL-DEVICE 8460 . 9553) (
UNIX-GET-NEXT-BUFFER 9555 . 11755) (UNIX-BACKFILEPTR-NEW 11757 . 12236) (UNIX-STREAM-EOFP-NEW 12238 .
12784) (UNIX-STREAM-OUT 12786 . 13042) (UNIX-STREAM-CLOSE 13044 . 13436)) (13694 15559 (
CREATE-UNIX-SOCKET-STREAM 13704 . 14565) (ACCEPT-UNIX-SOCKET-STREAM 14567 . 15557)) (15916 19095 (
UNIX-BACKFILEPTR 15926 . 16424) (UNIX-READ 16426 . 16948) (INITIALIZE-SHELL-DEVICE 16950 . 17689) (
UNIX-STREAM-IN 17691 . 18067) (UNIX-STREAM-EOFP 18069 . 18843) (UNIX-STREAM-PEEK 18845 . 19093)))))
STOP