MEDLEY-UILS loadup-db run-medley fixes (#808)
* MEDLEY-UILS loadup-db run-medley fixes * UNIXCOMM compile to DFASL; only set UTF-8 if getenv(LANG). loadup-db no lisp.virtualmem
This commit is contained in:
Larry Masinter
GitHub
@@ -1,29 +1,30 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "31-May-2022 09:37:37" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;3| 12695
|
||||
(FILECREATED "25-Jun-2022 17:17:53" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;4| 15853
|
||||
|
||||
:CHANGES-TO (FNS HCFILES)
|
||||
:CHANGES-TO (FNS PICK)
|
||||
|
||||
:PREVIOUS-DATE "12-Mar-2022 12:46:25" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
|
||||
:PREVIOUS-DATE "25-Jun-2022 10:57:30" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;3|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
|
||||
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
(VARS MEDLEY-FIX-DIRS)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)
|
||||
|
||||
(* |;;| "hardcopy files")
|
||||
(RPAQQ MEDLEY-UTILSCOMS
|
||||
((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES PICK)
|
||||
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)
|
||||
|
||||
(* |;;| "hardcopy files")
|
||||
|
||||
(FNS HCFILES)
|
||||
(INITVARS (HCFILES))))
|
||||
(FNS HCFILES BADFILE)
|
||||
(INITVARS (HCFILES)
|
||||
(BADFILES))
|
||||
(COMMANDS "pick")))
|
||||
(DEFINEQ
|
||||
|
||||
(GATHER-INFO
|
||||
(LAMBDA (PHASE) (* \;
|
||||
"Edited 26-Dec-2021 18:56 by larry")
|
||||
(* \;
|
||||
"Edited 24-Oct-2021 09:43 by larry")
|
||||
(LAMBDA (PHASE) (* \; "Edited 26-Dec-2021 18:56 by larry")
|
||||
(* \; "Edited 24-Oct-2021 09:43 by larry")
|
||||
(SELECTQ PHASE
|
||||
(ALL (|for| I |from| 0 |to| 4 |do| (GATHER-INFO I)))
|
||||
(0 (SETQ SYSFILES (UNION SYSFILES FILELST))
|
||||
@@ -105,34 +106,78 @@
|
||||
(-4 "No queries yet")
|
||||
(HELP))))
|
||||
|
||||
(MAKE-FULLER-DB
|
||||
(LAMBDA NIL (* \; "Edited 20-Jun-2022 17:23 by larry")
|
||||
(FILESLOAD (SOURCE)
|
||||
FILESETS)
|
||||
(DRIBBLE (MEDLEYDIR "tmp" "fuller.dribble" T T))
|
||||
(DOFILESLOAD (APPEND OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL))
|
||||
(GATHER-INFO 'ALL)
|
||||
(MASTERSCOPE '(WHO CALLS XYZZY))
|
||||
(DUMPDATABASE NIL (MKATOM (MEDLEYDIR "tmp" "fuller.database" T T)))
|
||||
(DRIBBLE)
|
||||
(MAKESYS (MEDLEYDIR "tmp" "fuller.sysout" T T)
|
||||
"Welcome to Fuller sysout")))
|
||||
|
||||
(MEDLEY-FIX-LINKS
|
||||
(LAMBDA (UNIXPATH) (* \;
|
||||
"Edited 18-Jan-2021 12:01 by larry")
|
||||
(LAMBDA (UNIXPATH) (* \; "Edited 18-Jan-2021 12:01 by larry")
|
||||
(OR UNIXPATH (SETQ UNIXPATH (UNIX-GETENV "MEDLEYDIR"))
|
||||
(ERROR "No Directory")) (* \;
|
||||
"Edited 18-Jan-2021 11:45 by larry")
|
||||
(ERROR "No Directory")) (* \; "Edited 18-Jan-2021 11:45 by larry")
|
||||
(|ShellCommand| (CONCAT "cd " UNIXPATH " && /bin/sh scripts/fixlinks && /bin/sh /tmp/doit"))))
|
||||
|
||||
(MEDLEY-FIX-DATES
|
||||
(LAMBDA (DIRS) (* \;
|
||||
"Edited 28-Jan-2021 12:15 by larry")
|
||||
(|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES
|
||||
(MEDLEYDIR (PRINT X T))))))
|
||||
(LAMBDA (DIRS) (* \; "Edited 28-Jan-2021 12:15 by larry")
|
||||
(|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T))))))
|
||||
|
||||
(PICK
|
||||
(LAMBDA (TYPE CHOICES) (* \; "Edited 25-Jun-2022 16:58 by larry")
|
||||
(SELECTQ (MKATOM (U-CASE (MKSTRING TYPE)))
|
||||
(NIL (PICK (PICK 'ONEOF '(FILE ISSUE PROJECT))))
|
||||
(ISSUE (LET ((ISSUE (PICK 'ONEOF (OR CHOICES (GIT-COMMAND
|
||||
"gh issue list -L 5000 -R interlisp/medley | sed 's/\\([0-9]*\\).*/\\1/'"
|
||||
))))
|
||||
(STR (OPENTEXTSTREAM)))
|
||||
(|for| S |in| (GIT-COMMAND (CL:FORMAT NIL "gh issue view ~a" ISSUE))
|
||||
|do| (CL:FORMAT STR "~a~&" S)
|
||||
|finally| (TEDIT STR NIL NIL `(READONLY T TITLE ,(CL:FORMAT NIL "Issue #~a"
|
||||
ISSUE))))))
|
||||
(DIR (PICK 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL)))
|
||||
(FILE (PICK 'ONEOF (DIRECTORY (MEDLEYDIR (PICK 'DIR)))))
|
||||
(PROJECT (PICK 'ONEOF '(CLOS ROOMS LOOPS NOTECARDS ONLINE TEST GITBOOK COMMUNITY ENVOS)))
|
||||
(ONEOF (CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES)))))
|
||||
(HELP TYPE "Unknown type"))))
|
||||
)
|
||||
|
||||
(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))
|
||||
|
||||
(RPAQQ OKSOURCES (RENAMEFNS VMEM READSYS CASH-FILE HASH-FILE MEDLEYDIR MAKEINIT))
|
||||
|
||||
(RPAQQ OKLIBRARY
|
||||
(POSTSCRIPTSTREAM CHATTERMINAL DMCHAT CHAT PRESS TEDITDCL PCTREE TEXTOFD TEDITCOMMAND
|
||||
TEDITSCREEN TEDITABBREV TEDITLOOKS TEDITFIND TEDITHISTORY TEDITFILE TEDITWINDOW
|
||||
TEDITSELECTION READNUMBER EDITBITMAP IMAGEOBJ TFBRAVO TEDITHCPY TEDITPAGE TEDITMENU
|
||||
TEDITFNKEYS TEDIT HRULE TEDITCHAT TABLEBROWSER FILEBROWSER GRAPHER SPY WHERE-IS
|
||||
COPYFILES MSANALYZE MSPARSE MSCOMMON MASTERSCOPE UNIXCOMM UNIXPRINT UNICODE HASH
|
||||
CLIPBOARD UNIXCHAT VT100KP VTCHAT SKETCH SKETCHBMELT SCALEBITMAP SKETCHOBJ SKETCHEDIT
|
||||
SKETCHELEMENTS SKETCHOPS MATMULT SAMEDIR))
|
||||
|
||||
(RPAQQ OKLISPUSERS (THINFILES ISO8859IO DINFO HELPSYS MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE
|
||||
BACKGROUND-YIELD OBJECTWINDOW REGIONMANAGER COMPARETEXT EXAMINEDEFS
|
||||
COMPARESOURCES COMPAREDIRECTORIES PSEUDOHOSTS DATEFORMAT-EDITOR DOC-OBJECTS
|
||||
EQUATIONS BICLOCK FILEWATCH LIFE IDLEHAX GITFNS TMAX IMTOOLS))
|
||||
|
||||
(RPAQQ OKINTERNAL (MEDLEY-UTILS))
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-EXPORTS-ALL
|
||||
(LAMBDA NIL (* \;
|
||||
"Edited 9-Mar-2021 16:11 by larry")
|
||||
(LAMBDA NIL (* \; "Edited 9-Mar-2021 16:11 by larry")
|
||||
(* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME")
|
||||
(*
|
||||
"Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")
|
||||
"Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")
|
||||
(*
|
||||
"Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")
|
||||
"Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")
|
||||
(*
|
||||
"Edited September 29, 1986 by van Melle")
|
||||
"Edited September 29, 1986 by van Melle")
|
||||
(CNDIR (MEDLEYDIR "sources"))
|
||||
(LOAD 'FILESETS)
|
||||
(GATHEREXPORTS EXPORTFILES (MEDLEYDIR "tmp" "exports.all" T))))
|
||||
@@ -159,7 +204,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(HCFILES
|
||||
(LAMBDA (TFILE DEST REDOFLG TOPDIRLEN) (* \; "Edited 31-May-2022 09:31 by larry")
|
||||
(LAMBDA (TFILE DEST REDOFLG TOPDIRLEN) (* \; "Edited 21-Jun-2022 22:59 by larry")
|
||||
(* \; "Edited 31-May-2022 09:31 by larry")
|
||||
(* \; "Edited 20-Feb-2022 12:16 by larry")
|
||||
(* \; "Edited 21-Aug-2021 20:56 by larry")
|
||||
(DECLARE (SPECVARS TFILE))
|
||||
@@ -217,6 +263,8 @@
|
||||
|elseif| (EQ REDOFLG 'TEST)
|
||||
|then| (PRINTOUT T TFILE "-> " PSFILE T)
|
||||
(CLOSEF (OPENTEXTSTREAM TFILE))
|
||||
ELSEIF (MEMBER TFILE BADFILES)
|
||||
THEN (PRINTOUT T "Skipping " TFILE " on BADFILES")
|
||||
|else| (PRINTOUT T "Converting " TFILE " to " PSFILE "...")
|
||||
(TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
|
||||
PSFILE T NIL NIL NIL (|if| (EQ REDOFLG 'IP)
|
||||
@@ -225,11 +273,25 @@
|
||||
(|printout| T " DONE" T)
|
||||
(CLOSEF? TEXTSTREAM))))
|
||||
(T (PRINTOUT T "no such file " T)))))
|
||||
|
||||
(BADFILE
|
||||
(LAMBDA NIL (* \; "Edited 22-Jun-2022 09:40 by larry")
|
||||
(PUSHNEW BADFILES TFILE)
|
||||
(LET ((STR (OPENSTREAM "BADFILES.TXT" 'APPEND)))
|
||||
(SETFILEPTR STR -1)
|
||||
(PRINT TFILE STR)
|
||||
(CLOSEF STR))
|
||||
(RETFROM 'HCFILES)))
|
||||
)
|
||||
|
||||
(RPAQ? HCFILES )
|
||||
|
||||
(RPAQ? BADFILES )
|
||||
|
||||
(DEFCOMMAND "pick" (FIRST . REST)
|
||||
(PICK FIRST REST))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (699 7147 (GATHER-INFO 709 . 6249) (MEDLEY-FIX-LINKS 6251 . 6774) (MEDLEY-FIX-DATES 6776
|
||||
. 7145)) (7246 9096 (MAKE-EXPORTS-ALL 7256 . 8272) (MAKE-WHEREIS-HASH 8274 . 9094)) (9131 12650 (
|
||||
HCFILES 9141 . 12648)))))
|
||||
(FILEMAP (NIL (724 8547 (GATHER-INFO 734 . 6144) (MAKE-FULLER-DB 6146 . 6684) (MEDLEY-FIX-LINKS 6686
|
||||
. 7083) (MEDLEY-FIX-DATES 7085 . 7327) (PICK 7329 . 8545)) (9823 11616 (MAKE-EXPORTS-ALL 9833 . 10792
|
||||
) (MAKE-WHEREIS-HASH 10794 . 11614)) (11651 15716 (HCFILES 11661 . 15401) (BADFILE 15403 . 15714)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1
internal/test/printing/BADFILES.TEST
Normal file
1
internal/test/printing/BADFILES.TEST
Normal file
@@ -0,0 +1 @@
|
||||
(HCFILES "{DSK}<home>larry>ilisp>envos>" "{DSK}<home>larry>medley>tmp>psfiles>")
|
||||
66
internal/test/printing/BADFILES.TXT
Normal file
66
internal/test/printing/BADFILES.TXT
Normal file
@@ -0,0 +1,66 @@
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>PUBS>admin>doc-dirs>ERIS-DOC-WO-LOOPS.TEDIT;2
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley1.2>RS6000>keybaord-layout.tedit;3
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley2.0>final>ug>APP-D-DIFFERENCES.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>printers>recommendation.tedit;3
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>1982BUGS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>BRIEFINGBLURB-DRAFT.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>CHAT-GENERIC.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>HELLO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>IDDESCRIPTION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>LISPARFIELDS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>NSCHARACTERS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>SOURCEFILES.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>COLOROBJ.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>DSKTEST.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>BOONE-V-COE.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>NCPLOTCARD.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>GC>HAND-AUX>ADVDICT-N-Z.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>Library>TEdit>Hand-Aux>AR10063.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>i>o>Hardcopy>Hand>testfiles>04PARA.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEDELTA.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEIMPL.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>Manual>LAFITEMANUAL-INDEXINTERNAL.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>lispusers>2.0>src>EQUATIONEXAMPLES.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>03-SOFTWARE-INSTALLATION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>05-NOTECARDS-BASICS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>11-SYSTEM-CARDS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>2.0>src>library>BOONE-V-COE.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDEMO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>DDLCOLORHAX.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>LUCASFILMFORMAT.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>basics>INVOICE.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV-CHOICE.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDEMO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>ADVERTS>Cherry-RidgeWFH.TEdit;5
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Adv-Committee>Defns>ADVDEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Board>CALLERLAB-BYLAWCHANGE.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1-NEW-DEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1DEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C2DEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>NUMBERART.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-A-M.TEDIT;13
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-N-Z.TEDIT;9
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-I-R.TEDIT;9
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-S.TEDIT;7
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-T-Z.TEDIT;9
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-A-E.TEDIT;11
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-F-O.TEDIT;5
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-P-S.TEDIT;6
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-T-Z.TEDIT;6
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>DICT-PREFACE.TEDIT;14
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>leftover-calls.tedit;3
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>FRA>ARRANGEMENTS.TEDIT;28
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>venue>ads>aaai>top-rapid-dev.TEdit;4
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>24-STREAMS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>25-IO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>27-GRAPHICS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>28-WINDOWS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>29-HARDCOPY.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-ETHERNET.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-TERMINAL.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>31-ETHERNET.TEDIT;1
|
||||
{DSK}<home>larry>medley>lispusers>ACE>ACE-MAINTAINERS-NOTES.TEDIT;1
|
||||
{DSK}<home>larry>medley>lispusers>EQUATIONEXAMPLES.TEDIT;1
|
||||
113
library/PCTREE
113
library/PCTREE
@@ -1,33 +1,33 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-Apr-2018 12:19:49" {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>PCTREE.;4 28288
|
||||
|
||||
changes to%: (VARS PCTREECOMS)
|
||||
(FILECREATED "22-Jun-2022 10:29:01" {DSK}<home>larry>medley>library>PCTREE.;2 28282
|
||||
|
||||
previous date%: "29-Jan-99 17:33:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>PCTREE.;3)
|
||||
:CHANGES-TO (FNS \INSERTTREE)
|
||||
|
||||
:PREVIOUS-DATE "19-Apr-2018 12:19:49" {DSK}<home>larry>medley>library>PCTREE.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1990, 1991, 1993, 1994, 1995, 1999, 2018 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PCTREECOMS)
|
||||
|
||||
(RPAQQ PCTREECOMS
|
||||
[
|
||||
(* ;; "Balanced tree PIECE TABLE supporting functions")
|
||||
(* ;; "Balanced tree PIECE TABLE supporting functions")
|
||||
|
||||
(FILES TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(* ;; "\WORDSINBTREEMAIN = # of words in the child-pointers & offsets section of the node -- everything before SPARE5 (the overflow place).")
|
||||
(* ;; "\WORDSINBTREEMAIN = # of words in the child-pointers & offsets section of the node -- everything before SPARE5 (the overflow place).")
|
||||
|
||||
|
||||
(* ;;
|
||||
"\BTREEMAXCOUNT = number of children in a full node = maximum value for a node's COUNT field.")
|
||||
(* ;;
|
||||
"\BTREEMAXCOUNT = number of children in a full node = maximum value for a node's COUNT field.")
|
||||
|
||||
|
||||
(* ;; "\BTREELASTREALOFFSET = offset of last real space for a child entry in the node ( = \WORDSINBTREEMAIN - 4)")
|
||||
(* ;; "\BTREELASTREALOFFSET = offset of last real space for a child entry in the node ( = \WORDSINBTREEMAIN - 4)")
|
||||
|
||||
(CONSTANTS (\BTREEMAXENTRIES 8)
|
||||
(\BTREEMAXCOUNT 8)
|
||||
@@ -65,10 +65,10 @@ Copyright (c) 1990, 1991, 1993, 1994, 1995, 1999, 2018 by Venue & Xerox Corporat
|
||||
(RPAQ \WORDSINBTREEMAIN (UNFOLD \BTREEMAXENTRIES 4))
|
||||
|
||||
(RPAQ \BTREELASTREALOFFSET (UNFOLD (SUB1 \BTREEMAXENTRIES)
|
||||
4))
|
||||
4))
|
||||
|
||||
(RPAQ \BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1)
|
||||
4))
|
||||
4))
|
||||
|
||||
|
||||
(CONSTANTS (\BTREEMAXENTRIES 8)
|
||||
@@ -174,9 +174,9 @@ Copyright (c) 1990, 1991, 1993, 1994, 1995, 1999, 2018 by Venue & Xerox Corporat
|
||||
1))])
|
||||
|
||||
(\INSERTTREE
|
||||
[LAMBDA (NEW OLD PCNODE NEW-PREVLEN NEW-OLDLEN PREV)
|
||||
(* ;
|
||||
"Edited 21-Mar-95 15:29 by sybalsky:mv:envos")
|
||||
[LAMBDA (NEW OLD PCNODE NEW-PREVLEN NEW-OLDLEN PREV) (* ; "Edited 21-Jun-2022 23:39 by larry")
|
||||
(* ;
|
||||
"Edited 21-Mar-95 15:29 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "inserts NEW in front of OLD in PCNODE. NEW/OLD are either pieces or tree nodes.")
|
||||
|
||||
@@ -193,9 +193,8 @@ Copyright (c) 1990, 1991, 1993, 1994, 1995, 1999, 2018 by Venue & Xerox Corporat
|
||||
(* ;; "Find OLD, and insert the NEW piece (and length) in front of it.")
|
||||
|
||||
(for old ITEM# from 0 to (LLSH (SUB1 NODE-COUNT)
|
||||
2) by 4
|
||||
when (EQ OLD (\GETBASEPTR PCNODE ITEM#)) do (RETURN)
|
||||
FINALLY (HELP "Old piece not in this PCNODE."))
|
||||
2) by 4 when (EQ OLD (\GETBASEPTR PCNODE ITEM#))
|
||||
do (RETURN) finally (HELP "Old piece not in this PCNODE."))
|
||||
(OR NEW (HELP "Inserting empty item"))
|
||||
|
||||
(* ;; "Update the previous piece's length, if appropriate:")
|
||||
@@ -204,7 +203,7 @@ Copyright (c) 1990, 1991, 1993, 1994, 1995, 1999, 2018 by Venue & Xerox Corporat
|
||||
((ZEROP ITEM#)
|
||||
|
||||
(* ;;
|
||||
"The hard way -- the previous piece is in a prior btree node, so we have to go there to update it.")
|
||||
"The hard way -- the previous piece is in a prior btree node, so we have to go there to update it.")
|
||||
|
||||
(LET* ((NODE (fetch (PIECE PTREENODE) of PREV)))
|
||||
(UPDATEPCNODES PREV NEW-PREVLEN)))
|
||||
@@ -219,35 +218,37 @@ Copyright (c) 1990, 1991, 1993, 1994, 1995, 1999, 2018 by Venue & Xerox Corporat
|
||||
NEW-OLDLEN)))
|
||||
(SETQ BB (\ADDBASE PCNODE ITEM#))
|
||||
(\RPLPTR PCNODE \WORDSINBTREEMAIN NIL) (* ;
|
||||
"Clean out the slot that's about to be copied over.")
|
||||
"Clean out the slot that's about to be copied over.")
|
||||
(\BLT (\ADDBASE BB 4)
|
||||
BB
|
||||
(IDIFFERENCE \WORDSINBTREEMAIN ITEM#))
|
||||
(\PUTBASEPTR PCNODE ITEM# NIL) (* ;
|
||||
"Because it's been copied, clear the old value before the refcnt-er gets to it.")
|
||||
"Because it's been copied, clear the old value before the refcnt-er gets to it.")
|
||||
(\RPLPTR PCNODE ITEM# NEW)
|
||||
(COND
|
||||
((type? PIECE NEW)
|
||||
(\PUTBASEFIXP PCNODE (IPLUS ITEM# 2)
|
||||
(fetch (PIECE PLEN) of NEW))
|
||||
(replace (PIECE PTREENODE) of NEW with PCNODE))
|
||||
((type? BTREENODE NEW) (* ; "Inserting a NODE")
|
||||
((type? BTREENODE NEW) (* ; "Inserting a NODE")
|
||||
(\PUTBASEFIXP PCNODE (IPLUS ITEM# 2)
|
||||
(fetch (BTREENODE TOTLEN) of NEW))
|
||||
(replace (BTREENODE UPWARD) of NEW with PCNODE))
|
||||
(T (\ILLEGAL.ARG NEW)))
|
||||
[SETQ NEWLEN (replace (BTREENODE TOTLEN) of PCNODE
|
||||
with (for I from 0 to NODE-COUNT as ITEM#
|
||||
from 2 by 4 sum (\GETBASEFIXP PCNODE ITEM#]
|
||||
(SETQ NEWLEN (for I from 0 to NODE-COUNT as ITEM# from 2 by 4
|
||||
sum (\GETBASEFIXP PCNODE ITEM#)))
|
||||
(IF (TYPE? BIGNUM NEWLEN)
|
||||
THEN (HELP NEWLEN " is bignum"))
|
||||
(replace (BTREENODE TOTLEN) of PCNODE with NEWLEN)
|
||||
|
||||
(* ;; " If adding this piece overflows the tree node, split it.")
|
||||
|
||||
[COND
|
||||
((IEQP NODE-COUNT \BTREEMAXCOUNT) (* ;
|
||||
"Tree node is full, so have to split.")
|
||||
"Tree node is full, so have to split.")
|
||||
(\SPLITTREE PCNODE OLD NEW))
|
||||
(T (* ;
|
||||
"No split, so update upper nodes with delta-length.")
|
||||
"No split, so update upper nodes with delta-length.")
|
||||
(replace (BTREENODE COUNT) of PCNODE with (ADD1 NODE-COUNT))
|
||||
(\TEDIT.UPDATETREE PCNODE (IDIFFERENCE NEWLEN OLDLEN]
|
||||
|
||||
@@ -498,32 +499,32 @@ Copyright (c) 1990, 1991, 1993, 1994, 1995, 1999, 2018 by Venue & Xerox Corporat
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE BTREENODE (
|
||||
(* ;; "An order-4 BTREE node for representing the piece table for TEdit.")
|
||||
(* ;; "An order-4 BTREE node for representing the piece table for TEdit.")
|
||||
|
||||
DOWN1
|
||||
(DLEN1 FIXP)
|
||||
DOWN2
|
||||
(DLEN2 FIXP)
|
||||
DOWN3
|
||||
(DLEN3 FIXP)
|
||||
DOWN4
|
||||
(DLEN4 FIXP)
|
||||
DOWN5
|
||||
(DLEN5 FIXP)
|
||||
DOWN6
|
||||
(DLEN6 FIXP)
|
||||
DOWN7
|
||||
(DLEN7 FIXP)
|
||||
DOWN8
|
||||
(DLEN8 FIXP)
|
||||
SPARE5 (* ;
|
||||
"Used only to hold the extra piece when we're overflowing")
|
||||
(SPARELEN FIXP) (* ; "So the code is easy and fast.")
|
||||
(COUNT BITS 4) (* ; "# of children of this node")
|
||||
(UPWARD XPOINTER) (* ; "Parent of this node, if any.")
|
||||
(TOTLEN FIXP) (* ;
|
||||
"Total length of this tree and subtrees")
|
||||
))
|
||||
DOWN1
|
||||
(DLEN1 FIXP)
|
||||
DOWN2
|
||||
(DLEN2 FIXP)
|
||||
DOWN3
|
||||
(DLEN3 FIXP)
|
||||
DOWN4
|
||||
(DLEN4 FIXP)
|
||||
DOWN5
|
||||
(DLEN5 FIXP)
|
||||
DOWN6
|
||||
(DLEN6 FIXP)
|
||||
DOWN7
|
||||
(DLEN7 FIXP)
|
||||
DOWN8
|
||||
(DLEN8 FIXP)
|
||||
SPARE5 (* ;
|
||||
"Used only to hold the extra piece when we're overflowing")
|
||||
(SPARELEN FIXP) (* ; "So the code is easy and fast.")
|
||||
(COUNT BITS 4) (* ; "# of children of this node")
|
||||
(UPWARD XPOINTER) (* ; "Parent of this node, if any.")
|
||||
(TOTLEN FIXP) (* ;
|
||||
"Total length of this tree and subtrees")
|
||||
))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'BTREENODE
|
||||
@@ -562,9 +563,9 @@ Copyright (c) 1990, 1991, 1993, 1994, 1995, 1999, 2018 by Venue & Xerox Corporat
|
||||
)
|
||||
(PUTPROPS PCTREE COPYRIGHT ("Venue & Xerox Corporation" 1990 1991 1993 1994 1995 1999 2018))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3043 23338 (UPDATEPCNODES 3053 . 4140) (FINDPCNODE 4142 . 4374) (\FIRSTNODE 4376 . 4733
|
||||
) (\DELETETREE 4735 . 7216) (\INSERTTREE 7218 . 11647) (\LASTNODE 11649 . 12292) (\MATCHPCS 12294 .
|
||||
13418) (\SPLITTREE 13420 . 20596) (\TEDIT.UPDATETREE 20598 . 22075) (\TEDIT.PIECE-CHNO 22077 . 22656)
|
||||
(\TEDIT.SET-TOTLEN 22658 . 23336)) (23339 25779 (DISPTREE 23349 . 23805) (TREEGRAPHNODE 23807 . 25777)
|
||||
(FILEMAP (NIL (2966 23396 (UPDATEPCNODES 2976 . 4063) (FINDPCNODE 4065 . 4297) (\FIRSTNODE 4299 . 4656
|
||||
) (\DELETETREE 4658 . 7139) (\INSERTTREE 7141 . 11705) (\LASTNODE 11707 . 12350) (\MATCHPCS 12352 .
|
||||
13476) (\SPLITTREE 13478 . 20654) (\TEDIT.UPDATETREE 20656 . 22133) (\TEDIT.PIECE-CHNO 22135 . 22714)
|
||||
(\TEDIT.SET-TOTLEN 22716 . 23394)) (23397 25837 (DISPTREE 23407 . 23863) (TREEGRAPHNODE 23865 . 25835)
|
||||
))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
132
library/UNIXCOMM
132
library/UNIXCOMM
@@ -1,52 +1,51 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "25-Apr-2018 07:31:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXCOMM.;39 19642
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "27-Jun-2022 16:45:04" {DSK}<home>larry>medley>library>UNIXCOMM.;42 20362
|
||||
|
||||
changes to%: (VARS UNIXCOMMCOMS)
|
||||
changes to%: (FNS CREATE-PROCESS-STREAM)
|
||||
(VARS UNIXCOMMCOMS)
|
||||
|
||||
previous date%: "24-Apr-2018 20:45:11"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXCOMM.;38)
|
||||
previous date%: "26-Jun-2022 14:27:33" {DSK}<home>larry>medley>library>UNIXCOMM.;41)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1988, 1989, 1990, 2018 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT UNIXCOMMCOMS)
|
||||
|
||||
(RPAQQ UNIXCOMMCOMS
|
||||
[
|
||||
(* ;; "streams to UNIX processes & pseudo terminals")
|
||||
(RPAQQ UNIXCOMMCOMS (
|
||||
(* ;; "streams to UNIX processes & pseudo terminals")
|
||||
|
||||
|
||||
(* ;; "this stuff should really be implemented in terms of {SHELL} and {PTY} devices")
|
||||
|
||||
(* ;;
|
||||
"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")
|
||||
(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])
|
||||
(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)))
|
||||
|
||||
|
||||
|
||||
@@ -132,10 +131,14 @@ Copyright (c) 1988, 1989, 1990, 2018 by Venue & Xerox Corporation. All rights r
|
||||
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")
|
||||
[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 (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
|
||||
@@ -145,9 +148,11 @@ Copyright (c) 1988, 1989, 1990, 2018 by Venue & Xerox Corporation. All rights r
|
||||
(CHAN (FORK-UNIX COMM)))
|
||||
(if CHAN
|
||||
then (CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
CHAN)
|
||||
(AND (STRPOS ".UTF-8" (UNIX-GETENV "LANG"))
|
||||
(\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.")
|
||||
(* ;; "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)
|
||||
@@ -324,9 +329,8 @@ Copyright (c) 1988, 1989, 1990, 2018 by Venue & Xerox Corporation. All rights r
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS UNIX-CHANNEL MACRO
|
||||
((STR)
|
||||
(fetch (STREAM F1) of STR)))
|
||||
(PUTPROPS UNIX-CHANNEL MACRO ((STR)
|
||||
(fetch (STREAM F1) of STR)))
|
||||
)
|
||||
|
||||
|
||||
@@ -426,35 +430,27 @@ Copyright (c) 1988, 1989, 1990, 2018 by Venue & Xerox Corporation. All rights r
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS UNIX-PEEKEDCHAR MACRO
|
||||
((STR)
|
||||
(FETCH (STREAM F2) OF STR)))
|
||||
(PUTPROPS UNIX-PEEKEDCHAR MACRO ((STR)
|
||||
(FETCH (STREAM F2) OF STR)))
|
||||
|
||||
(PUTPROPS UNIX-LASTCHAR MACRO
|
||||
((STR)
|
||||
(FETCH (STREAM F3) 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))
|
||||
(PUTPROPS UNIXCOMM FILETYPE FAKE-COMPILE-FILE)
|
||||
(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2704 8376 (FORK-SHELL 2714 . 3911) (FORK-UNIX 3913 . 4089) (UNIX-KILL 4091 . 4280) (
|
||||
UNIX-WRITE 4282 . 4993) (CREATE-SHELL-STREAM 4995 . 6311) (CREATE-PROCESS-STREAM 6313 . 7473) (
|
||||
UNIXCOMM-AROUNDEXITFN 7475 . 8374)) (8424 13412 (INITIALIZE-NEW-SHELL-DEVICE 8434 . 9527) (
|
||||
UNIX-GET-NEXT-BUFFER 9529 . 11729) (UNIX-BACKFILEPTR-NEW 11731 . 12210) (UNIX-STREAM-EOFP-NEW 12212 .
|
||||
12758) (UNIX-STREAM-OUT 12760 . 13016) (UNIX-STREAM-CLOSE 13018 . 13410)) (13668 15533 (
|
||||
CREATE-UNIX-SOCKET-STREAM 13678 . 14539) (ACCEPT-UNIX-SOCKET-STREAM 14541 . 15531)) (15856 19035 (
|
||||
UNIX-BACKFILEPTR 15866 . 16364) (UNIX-READ 16366 . 16888) (INITIALIZE-SHELL-DEVICE 16890 . 17629) (
|
||||
UNIX-STREAM-IN 17631 . 18007) (UNIX-STREAM-EOFP 18009 . 18783) (UNIX-STREAM-PEEK 18785 . 19033)))))
|
||||
(FILEMAP (NIL (2975 9114 (FORK-SHELL 2985 . 4182) (FORK-UNIX 4184 . 4360) (UNIX-KILL 4362 . 4551) (
|
||||
UNIX-WRITE 4553 . 5264) (CREATE-SHELL-STREAM 5266 . 6582) (CREATE-PROCESS-STREAM 6584 . 8211) (
|
||||
UNIXCOMM-AROUNDEXITFN 8213 . 9112)) (9162 14150 (INITIALIZE-NEW-SHELL-DEVICE 9172 . 10265) (
|
||||
UNIX-GET-NEXT-BUFFER 10267 . 12467) (UNIX-BACKFILEPTR-NEW 12469 . 12948) (UNIX-STREAM-EOFP-NEW 12950
|
||||
. 13496) (UNIX-STREAM-OUT 13498 . 13754) (UNIX-STREAM-CLOSE 13756 . 14148)) (14406 16271 (
|
||||
CREATE-UNIX-SOCKET-STREAM 14416 . 15277) (ACCEPT-UNIX-SOCKET-STREAM 15279 . 16269)) (16612 19791 (
|
||||
UNIX-BACKFILEPTR 16622 . 17120) (UNIX-READ 17122 . 17644) (INITIALIZE-SHELL-DEVICE 17646 . 18385) (
|
||||
UNIX-STREAM-IN 18387 . 18763) (UNIX-STREAM-EOFP 18765 . 19539) (UNIX-STREAM-PEEK 19541 . 19789)))))
|
||||
STOP
|
||||
|
||||
BIN
library/UNIXCOMM.DFASL
Normal file
BIN
library/UNIXCOMM.DFASL
Normal file
Binary file not shown.
Binary file not shown.
@@ -66,7 +66,6 @@ while [ "$#" -ne 0 ]; do
|
||||
"-nogreet" | "--nogreet")
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
export LDEINIT="$MEDLEYDIR/greetfiles/NOGREET"
|
||||
@@ -121,7 +120,7 @@ while [ "$#" -ne 0 ]; do
|
||||
"-lisp")
|
||||
export LDESRCESYSOUT="$MEDLEYDIR/loadups/lisp.sysout"
|
||||
;;
|
||||
"-n" | "-new" | "-newfull" )
|
||||
"-N" | "-new" | "-newfull" )
|
||||
export LDESRCESYSOUT="$MEDLEYDIR/tmp/full.sysout"
|
||||
;;
|
||||
"-nl" | "-newlisp" )
|
||||
|
||||
@@ -7,6 +7,13 @@ if [ ! -x run-medley ] ; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
cp -p tmp/full.sysout tmp/lisp.sysout tmp/*.dribble tmp/whereis.hash loadups/
|
||||
cp -p tmp/exports.all tmp/RDSYS tmp/RDSYS.LCOM library/
|
||||
# was
|
||||
# cp -p tmp/full.sysout tmp/lisp.sysout tmp/*.dribble tmp/whereis.hash loadups/
|
||||
# cp -p tmp/exports.all tmp/RDSYS tmp/RDSYS.LCOM library/
|
||||
# just copy the files that are released
|
||||
|
||||
./scripts/cpv tmp/full.sysout loadups
|
||||
./scripts/cpv tmp/lisp.sysout loadups
|
||||
./scripts/cpv tmp/whereis.hash loadups
|
||||
./scripts/cpv tmp/exports.all library
|
||||
|
||||
|
||||
61
scripts/cpv
Executable file
61
scripts/cpv
Executable file
@@ -0,0 +1,61 @@
|
||||
#!/bin/sh
|
||||
|
||||
# cpv file dest
|
||||
# could extend with -r or copying multiple files
|
||||
# could change from cp to ln
|
||||
|
||||
file="$1"
|
||||
dest="$2"
|
||||
|
||||
|
||||
if [ ! -f "$file" ]; then
|
||||
echo no such file "$file"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
# if dest is a directory, add the source file name
|
||||
if [ -d "$dest" ]; then
|
||||
dest=$dest/`basename $file`
|
||||
fi
|
||||
|
||||
# if no such file $dest then just copy
|
||||
if [ ! -f "$dest" ]; then
|
||||
ln $file $dest #WAS cp -p $file $dest
|
||||
exit 0
|
||||
fi
|
||||
|
||||
|
||||
# find maximum version of dest
|
||||
max=0
|
||||
for vf in "$dest".~[1-9]*~
|
||||
do vn=`echo $vf | sed -e 's/^.*\.~\([1-9][0-9]*\)~$/\1/'`
|
||||
if [ -f $dest.~$vn~ ]; then
|
||||
if [ $max -lt $vn ]; then
|
||||
max=$vn
|
||||
fi
|
||||
fi
|
||||
done
|
||||
|
||||
if [ $max -eq 0 ]; then # no current versions
|
||||
mv $dest $dest.~1~ # change version to version 1
|
||||
new=2
|
||||
else
|
||||
if cmp -q $dest $dest.~$max~ >/dev/null 2>&1
|
||||
then # they're different
|
||||
max=`expr $max + 1` # make newer version
|
||||
mv $dest $dest.~$max~
|
||||
new=`expr $max + 1`
|
||||
else # dest and dest.~nn~ are equal so
|
||||
rm $dest # delete dest leave old version behind
|
||||
new=`expr $max + 1`
|
||||
fi
|
||||
fi
|
||||
|
||||
# make new version
|
||||
|
||||
ln $file $dest.~$new~ # cp -p $file $dest.~$new~
|
||||
ln $dest.~$new~ $dest # and link it
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -12,7 +12,10 @@ fi
|
||||
./scripts/loadup-lisp-from-mid.sh && \
|
||||
./scripts/loadup-full-from-lisp.sh && \
|
||||
./scripts/loadup-aux.sh && \
|
||||
./scripts/copy-all.sh && \
|
||||
ls -l loadups/*.sysout loadups/whereis.hash library/exports.all && \
|
||||
echo "**** DONE ****"
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
32
scripts/loadup-db.sh
Executable file
32
scripts/loadup-db.sh
Executable file
@@ -0,0 +1,32 @@
|
||||
#!/bin/sh
|
||||
|
||||
export MEDLEYDIR=`pwd`
|
||||
|
||||
if [ ! -f run-medley ] ; then
|
||||
echo run from MEDLEYDIR
|
||||
exit 1
|
||||
fi
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
echo '" (IL:MEDLEY-INIT-VARS)(IL:FILESLOAD MEDLEY-UTILS)(IL:MAKE-FULLER-DB)(IL:LOGOUT T)"' > tmp/loadup-db.cm
|
||||
./run-medley $scr -loadup "$MEDLEYDIR"/tmp/loadup-db.cm tmp/full.sysout
|
||||
|
||||
if [ tmp/fuller.database -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
echo ---- made ----
|
||||
ls -l tmp/fuller*
|
||||
echo --------------
|
||||
|
||||
else
|
||||
echo XXXXX FAILURE XXXXX
|
||||
ls -l tmp/fuller*
|
||||
exit 1
|
||||
fi
|
||||
460
sources/UNIXCOMM
460
sources/UNIXCOMM
@@ -1,460 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Jun-2022 14:27:33" {DSK}<home>larry>medley>library>UNIXCOMM.;2 19997
|
||||
|
||||
:CHANGES-TO (FNS CREATE-PROCESS-STREAM)
|
||||
|
||||
:PREVIOUS-DATE "25-Apr-2018 07:31:56" {DSK}<home>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
|
||||
@@ -1,460 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Jun-2022 14:27:33" {DSK}<home>larry>medley>library>UNIXCOMM.;2 19997
|
||||
|
||||
:CHANGES-TO (FNS CREATE-PROCESS-STREAM)
|
||||
|
||||
:PREVIOUS-DATE "25-Apr-2018 07:31:56" {DSK}<home>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
|
||||
Reference in New Issue
Block a user