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

MEDLEY-UILS loadup-db run-medley fixes (#808)

Browse Source 
* 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
2022-06-28 11:45:59 -07:00
committed by GitHub
parent 0d07ed6379
commit 32128f5e19
16 changed files with 387 additions and 1079 deletions
Download Patch File Download Diff File Expand all files Collapse all files

113
library/PCTREE
View File

@@ -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

BIN
library/PCTREE.LCOM
View File

Binary file not shown.

132
library/UNIXCOMM
View File

@@ -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
View File

Binary file not shown.

BIN
library/UNIXCOMM.LCOM
View File

Binary file not shown.