RopeOtherImpl.mesa
Copyright Ó 1985, 1986, 1987, 1988, 1989, 1991, 1992 by Xerox Corporation. All rights reserved.
For Portable Cedar
Russ Atkinson (RRA) October 13, 1989 3:16:10 pm PDT
Carl Hauser, May 13, 1988 4:39:49 pm PDT
Willie-s, March 31, 1992 12:31 pm PST
Doug Wyatt, August 26, 1991 4:53 pm PDT
Michael Plass, February 21, 1992 4:37 pm PST
Bier, December 9, 1992 4:39 pm PST
DIRECTORY
Basics USING [charsPerWord, RaiseBoundsFault, RawChars],
Checksum USING [bytesPerHalfWord, ComputeChecksum],
RefText USING [ErrorCode, line],
RefTextExtras,
Rope USING [AppendChars, Size, Fetch, ROPE, Text, TextBound],
RopeHash USING [PureText],
RopePrivate USING [NonNeg, QStore],
SafeStorage;
RopeOtherImpl: CEDAR MONITOR LOCKS pool USING pool: Pool
IMPORTS Basics, Checksum, RefTextExtras, Rope, RopePrivate, SafeStorage
EXPORTS RefText, RefTextExtras, RopeHash
SHARES Rope
= BEGIN
ROPE: TYPE = Rope.ROPE;
TextBound: TYPE = Rope.TextBound;
Pool: TYPE = REF PoolObj;
PoolObj: PUBLIC TYPE = MONITORED RECORD [
charsPerText: NAT,
nextAvailable: INT ¬ -1,
texts: SEQUENCE count: NAT OF REF TEXT
];
RefTextImpl: operations on mutable garbage-collected strings
ReserveChars: PUBLIC PROC [to: REF TEXT, nChars: TextBound] RETURNS [REF TEXT] = {
newMinLength: INT = INT[to.length] + INT[nChars]; -- ERROR PointerFault if to=NIL
IF newMinLength <= to.maxLength THEN RETURN [to];
IF newMinLength > TextBound.LAST OR to.length > to.maxLength THEN Basics.RaiseBoundsFault[];
{ expandBy: TextBound = MAX[16, to.maxLength, nChars];
newLength: TextBound =
IF expandBy > TextBound.LAST-to.maxLength THEN TextBound.LAST ELSE expandBy+to.maxLength;
newText: REF TEXT = untracedZone.NEW[TEXT[newLength]];
FOR i: NAT IN [0..to.length) DO newText[i] ¬ to[i] ENDLOOP;
newText.length ¬ to.length;
RETURN [newText];
}
};
Append: PUBLIC PROC [to: REF TEXT, from: REF READONLY TEXT, start: TextBound, len: TextBound] RETURNS [REF TEXT] = TRUSTED {
RETURN [AppendRope[to, LOOPHOLE[from], start, len]];
};
AppendChar: PUBLIC PROC [to: REF TEXT, from: CHAR] RETURNS [REF TEXT] = {
IF to.length >= to.maxLength THEN { -- ERROR PointerFault if to=NIL
to ¬ ReserveChars[to, 1];
};
to[to.length] ¬ from;
to.length ¬ to.length + 1;
RETURN [to];
};
AppendRope: PUBLIC PROC
[to: REF TEXT, from: ROPE, start: INT, len: TextBound] RETURNS [REF TEXT] = {
rem: INT ¬ Rope.Size[from] - start;
IF start < 0 OR rem < 0 THEN Basics.RaiseBoundsFault[];
IF len < rem THEN rem ¬ len;
IF rem > 0 THEN {
There are characters to append
to ¬ ReserveChars[to, rem];
[] ¬ Rope.AppendChars[to, from, start, rem];
};
RETURN [to];
};
New: PUBLIC PROC [nChars: TextBound] RETURNS [REF TEXT] = {
nChars ¬ nChars + (nChars MOD Basics.bytesPerWord);
text: REF TEXT;
maxLength can get rounded to LAST[NAT15]+1, which casues a bounds fault in NEW
maxLength: NAT ¬ Basics.charsPerWord*WORDS[Basics.RawChars[nChars]];
IF maxLength > LAST[NAT15] THEN maxLength ¬ LAST[NAT15];
text ¬ untracedZone.NEW[TEXT[maxLength]];
text.length ¬ 0;
RETURN[text];
};
Error: PUBLIC ERROR [ec: RefText.ErrorCode] = CODE;
ObtainScratch: PUBLIC PROC [nChars: TextBound ¬ RefText.line] RETURNS [REF TEXT] = {
IF nChars>512
THEN
IF nChars>8192
THEN RETURN [New[nChars]]
ELSE RETURN [RefTextExtras.ObtainScratch8192[]]
ELSE
IF nChars>100
THEN RETURN [RefTextExtras.ObtainScratch512[]]
ELSE RETURN [RefTextExtras.ObtainScratch100[]]
};
ReleaseScratch: PUBLIC PROC [t: REF TEXT] = {
SELECT t.maxLength FROM
16 => RefTextExtras.ReleaseScratch16[t];
100 => RefTextExtras.ReleaseScratch100[t];
512 => RefTextExtras.ReleaseScratch512[t];
8192 => RefTextExtras.ReleaseScratch8192[t];
ENDCASE; -- otherwise it doesn't belong in any pools. Let the garbage collector have it.
};
ObtainInternal: PUBLIC ENTRY PROC [pool: Pool] RETURNS [thisText: REF TEXT] = {
IF pool.nextAvailable = -1 THEN RETURN[New[pool.charsPerText]] -- pool is empty
ELSE {
thisText ¬ pool.texts[pool.nextAvailable];
pool.nextAvailable ¬ pool.nextAvailable -1;
IF thisText.length # 0 THEN RETURN WITH ERROR Error[clientModifiedReleasedText];
};
};
ReleaseInternal: PUBLIC ENTRY PROC [pool: Pool, t: REF TEXT] = {
IF t = NIL THEN RETURN;
t.length ¬ 0;
IF pool.nextAvailable = pool.count -1 THEN RETURN -- pool is full
ELSE {
pool.nextAvailable ¬ pool.nextAvailable + 1;
pool.texts[pool.nextAvailable] ¬ t;
};
};
CreatePool: PUBLIC PROC [charsPerText: CARD, textsInPool: CARD] RETURNS [pool: Pool] = {
pool ¬ NEW[PoolObj[textsInPool]];
pool.charsPerText ¬ charsPerText;
pool.nextAvailable ¬ textsInPool - 1;
FOR i: NAT IN [0..textsInPool) DO
pool.texts[i] ¬ New[charsPerText];
ENDLOOP;
};
<<OldObtainScratch: PUBLIC PROC [nChars: TextBound] RETURNS [REF TEXT] = {
RETURN [New[nChars]]
};
>>
<<OldReleaseScratch: PUBLIC PROC [t: REF TEXT] = {
};
>>
Stuff that was used for VeryOldObtainScratch and VeryOldReleaseScratch:
<<
Monitored global variables:
TextIndex: TYPE = [0..2];
TextMaxLength: ARRAY TextIndex OF TextBound = [100, 512, 8192];
NTextsToAllocate: ARRAY TextIndex OF NAT = [8, 2, 2];
There are 10 overhead words per text (4 in the TEXT, 6 in the LIST), plus
6 overhead words per TextIndex value.
available: ARRAY TextIndex OF LIST OF REF TEXT ¬ ALL[NIL];
reserved: ARRAY TextIndex OF LIST OF REF TEXT ¬ ALL[NIL];
InterestingQuantity: TYPE = {obtainCalled, nCharsTooLarge, availEmpty};
Counts: ARRAY InterestingQuantity OF INT ¬ ALL[0];
Bump: INTERNAL PROC [q: InterestingQuantity] = INLINE { Counts[q] ¬ Counts[q] + 1 };
>>
<<VeryOldObtainScratch: PUBLIC ENTRY PROC [nChars: TextBound] RETURNS [REF TEXT] = {
i: TextIndex ¬ 0;
avail: LIST OF REF TEXT;
Bump[obtainCalled];
FOR i IN [0 .. LAST[TextIndex]] DO
IF nChars <= TextMaxLength[i] THEN EXIT;
REPEAT FINISHED => {
too large for pool
Bump[nCharsTooLarge];
RETURN [New[nChars]];
};
ENDLOOP;
IF (avail ¬ available[i].rest) = NIL THEN {
Give last element of reserved[i] to the collector, allocate a new one, and put it in avail.
r: LIST OF REF TEXT;
Bump[availEmpty];
r ¬ reserved[i];
UNTIL r.rest.rest = NIL DO r ¬ r.rest ENDLOOP;
avail ¬ r.rest; r.rest ¬ NIL; avail.first ¬ New[TextMaxLength[i]] };
Move first element of available[i] to front of reserved[i].
available[i].rest ¬ avail.rest;
avail.rest ¬ reserved[i].rest; reserved[i].rest ¬ avail;
IF avail.first.length # 0 THEN RETURN WITH ERROR Error[clientModifiedReleasedText];
RETURN [avail.first];
};
>>
<<VeryOldReleaseScratch: PUBLIC ENTRY PROC [t: REF TEXT] = {
i: TextIndex ¬ 0;
r, l: LIST OF REF TEXT;
IF t = NIL THEN RETURN;
FOR i IN [0 .. LAST[TextIndex]] DO
IF t.maxLength = TextMaxLength[i] THEN EXIT;
REPEAT FINISHED => RETURN; -- no good for pool
ENDLOOP;
r ¬ reserved[i];
WHILE (l ¬ r.rest) # NIL DO
IF l.first = t THEN {
r.rest ¬ l.rest;
l.rest ¬ available[i].rest; available[i].rest ¬ l;
t.length ¬ 0;
EXIT;
};
r ¬ l;
ENDLOOP;
};
>>
<<InitializeScratchPool: PROC [] = {
FOR i: TextIndex IN TextIndex DO
reserved[i] ¬ CONS[NIL, NIL];
construct a list of NTextsToAllocate[i]+1 nodes.
FOR j: NAT IN [0..NTextsToAllocate[i]] DO
l: LIST OF REF TEXT ¬ CONS[NIL, available[i]];
available[i] ¬ l;
ENDLOOP;
ENDLOOP;
FOR i: TextIndex IN TextIndex DO
allocate a TEXT of maxLength TextMaxLength[i] for each node but the first.
l: LIST OF REF TEXT ¬ available[i].rest;
WHILE l # NIL DO
l.first ¬ New[TextMaxLength[i]];
l ¬ l.rest;
ENDLOOP;
ENDLOOP;
};
>>
RopeHashImpl: hash functions for ROPE and REF TEXT
defaultSeed: CARDINAL = 31415;
bytesPerHalfWord: NAT ~ Checksum.bytesPerHalfWord; -- = 2
bufSize: NAT = 128*bytesPerHalfWord;
TextSize: NAT = SIZE[TEXT[0]];
HalfWordAsChars: TYPE = PACKED ARRAY [0..bytesPerHalfWord) OF CHAR;
--RopeHash.--FromRefText: PUBLIC PROC
[text: RopeHash.PureText, seed: CARDINAL] RETURNS [hash: CARDINAL] = TRUSTED {
len: TextBound ¬ text.length;
nLeft: NAT = len MOD bytesPerHalfWord;
nWhole: NAT = len - nLeft;
p: LONG POINTER = LOOPHOLE[text, LONG POINTER] + TextSize;
hash ¬ seed;
IF nWhole >= bytesPerHalfWord THEN {
hash ¬ Checksum.ComputeChecksum[hash, nWhole/bytesPerHalfWord, p];
};
IF nLeft # 0 THEN TRUSTED {
leftovers: HalfWordAsChars ¬ ALL[0C];
FOR j: NAT IN [0..nLeft) DO
leftovers[j] ¬ Rope.Fetch[LOOPHOLE[text], nWhole+j];
ENDLOOP;
hash ¬ Checksum.ComputeChecksum[hash, BYTES[HalfWordAsChars]/bytesPerHalfWord, @leftovers];
};
};
--RopeHash.--FromRope: PUBLIC PROC
[rope: ROPE, case: BOOL, start: INT, len: INT, seed: CARDINAL]
RETURNS [hash: CARDINAL] = TRUSTED {
rem: INT ¬ RopePrivate.NonNeg[Rope.Size[rope] - RopePrivate.NonNeg[start]];
IF rem < len THEN len ¬ rem;
Limit len to be at worst the remainder of the string
IF case AND start = 0 AND rem = len THEN
WITH rope SELECT FROM
text: Rope.Text =>
If case does not matter, and we have a flat rope, and the whole rope is to be hashed, then we have the fast case.
RETURN[FromRefText[LOOPHOLE[text], seed]];
ENDCASE;
{
In the hard case we have to move the bytes from the rope into a buffer, adjust the buffer for lower case, then perform the checksum on the buffer. We keep doing this until there are no more chars to be moved.
buf: REF TEXT ¬ ObtainScratch[bufSize];
p: LONG POINTER = LOOPHOLE[buf, LONG POINTER] + SIZE[TEXT[0]];
bytes: NAT ¬ 0;
hash ¬ seed;
WHILE len > 0 DO
buf.length ¬ 0;
bytes ¬ Rope.AppendChars[buf, rope, start, len];
IF NOT case THEN
Make the buffer lower case. We avoid bounds checking to speed things up.
FOR i: NAT IN [0..bytes) DO
c: CHAR = Rope.Fetch[LOOPHOLE[buf], i];
IF c <= 'Z AND c >= 'A THEN RopePrivate.QStore[c + ('a-'A), LOOPHOLE[buf], i];
ENDLOOP;
hash ¬ FromRefText[buf, hash];
start ¬ start + bytes;
len ¬ len - bytes;
ENDLOOP;
ReleaseScratch[buf];
RETURN [hash];
};
};
untracedZone: ZONE ¬ NIL; -- initialized below in Init
pool16, pool100, pool512, pool8192: PUBLIC Pool;
Init: PROC = {
TRUSTED {untracedZone ¬ SafeStorage.GetUntracedZone[]};
pool16 ¬ CreatePool[16, 10];
pool100 ¬ CreatePool[100, 4];
pool512 ¬ CreatePool[512, 4];
pool8192 ¬ CreatePool[8192, 4];
};
Init[];
END.
Carl Hauser, January 17, 1988 1:58:48 pm PST
Used Fetch in place of QFetch for portable Cedar. Revisit this if performance is a problem
changes to: FromRefText, FromRope
Eric A. Bier, December 9, 1992 4:38:32 pm PST
Added ObtainInternal, ReleaseInternal, and CreatePool and reimplemented ObtainScratch and ReleaseScratch to use them.