github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-17 09:10:55 +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