
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
];
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 {
to м ReserveChars[to, rem];
[] м Rope.AppendChars[to, from, start, rem];
};
RETURN [to];
};

New: PUBLIC PROC [nChars: TextBound] RETURNS [REF TEXT] = {
text: REF TEXT;
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] = {
};
>>

<<
TextIndex: TYPE = [0..2];
TextMaxLength: ARRAY TextIndex OF TextBound = [100, 512, 8192];
NTextsToAllocate: ARRAY TextIndex OF NAT = [8, 2, 2];
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 => {
Bump[nCharsTooLarge];
RETURN [New[nChars]];
};
ENDLOOP;
IF (avail м available[i].rest) = NIL THEN {
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]] };
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];
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
l: LIST OF REF TEXT м available[i].rest;
WHILE l # NIL DO
l.first м New[TextMaxLength[i]];
l м l.rest;
ENDLOOP;
ENDLOOP;
};
>>
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;
IF case AND start = 0 AND rem = len THEN
WITH rope SELECT FROM
text: Rope.Text => 
RETURN[FromRefText[LOOPHOLE[text], seed]];
ENDCASE;
{
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
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.
  к  
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
RefTextImpl: operations on mutable garbage-collected strings
There are characters to append
nChars м nChars + (nChars MOD Basics.bytesPerWord);
maxLength can get rounded to LAST[NAT15]+1, which casues a bounds fault in NEW
Stuff that was used for VeryOldObtainScratch and VeryOldReleaseScratch:
Monitored global variables:
There are 10 overhead words per text (4 in the TEXT, 6 in the LIST), plus
6 overhead words per TextIndex value.
too large for pool
Give last element of reserved[i] to the collector, allocate a new one, and put it in avail.
Move first element of available[i] to front of reserved[i].
construct a list of NTextsToAllocate[i]+1 nodes.
allocate a TEXT of maxLength TextMaxLength[i] for each node but the first.
RopeHashImpl: hash functions for ROPE and REF TEXT
Limit len to be at worst the remainder of the string
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.
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.
Make the buffer lower case.  We avoid bounds checking to speed things up.
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.

 Э╩┴  Ц(cedarcode) styleХNewlineDelimiter
Щ codeЪЬЩKЪЬ
╧eЬUЩ`KЪ╨blЩKЩ3KЩ(KЩ%KЩ'KЩ,KЩ"ЧШ Ъ╧k	Ш	KЪЬЯЬ,Ш8KЪЬ	ЯЬ%Ш3KЪЬЯЬШ KШKЪЬЯЬЯЬШ=KЪЬ	ЯЬШKЪЬЯЬШ#KЪЬШKШ ЧЧЪ
╧nЬЯЬЯЯЯЬЯЬШ8KЪЯЬ@ШGKЪЯЬ!Ш(KЪЯЬШKЪЬЯШKШ KЪЯЬЯЬЯЬШKЪЬЯЬШ!KШ ЧKЪЬЯЬЯЬ	ШЪЬ	ЯЬЯЬЯЬШ)KЪЬЯШKЪЬЯЬШKЪ
ЬЯЬЯЬЯЬЯЬЯШ&KШЧheadЪЬ<Щ<ЪаЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬШRKЪЬЯЬЯЬЯЬ
╧cШQKЪЯЬЯЬЯЬШ1KЪЯЬЯЬЯЬЯЬШ\ЪЬЯЬШ6ЪЬШKЪ
ЯЬЯЬЯЬЯЬЯЬШYЧKЪ	Ь	ЯЬЯЬЯЬЯЬШ6KЪ
ЯЬЯЬЯЬЯЬЯЬШ;KШKЪЯЬШKШЧKШKШ ЧЪаЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬ$ЯЬЯЬЯЬЯЬШ|KЪЯЬЯЬШ4KШKШ ЧЪа
ЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬШIЪЯЬЯЬбШCKШKШЧKШKШKЪЯЬШKШKШ ЧЪа
ЬЯЬЯЬЯЬЯЬЯЬ	ЯЬЯЬЯЬЯЬШeKЪЬЯЬШ#KЪЯЬЯЬ	ЯЬШ7KЪЯЬЯЬШЪЯЬ	ЯЬШKЪЬЩKЪЬШKЪЬ,Ш,KШЧKЪЯЬШKШKШ ЧЪаЬЯЬЯЬЯЬЯЬЯЬШ;KЪ╧y╨kyвЩ3KЪЬЯЬЯЬШKЪЬЯЬЯЬ$ЯЩNKЪЬЯЬЯЬШDKЪЯЬЯЬЯЬЯЬЯЬЯЬШ8KЪЬЯЬЯЬШ)KШKЪЯЬШKЪЬШKШ ЧKЪаЬЯЬЯЬЯЬШ3KШ ЪаЬЯЯЯЬ$ЯЬЯЬЯЬШTЪЯЬШЪЯШЪЯЬШJЪЯЬЯЬШJЪЯЬЯЬ$Ш/ЧЧЪЯШЪЯЬШJЪЯЬЯЬ#Ш.JЪЯЬЯЬ#Ш.ЧЧЧJШJШ ЧЪ
аЬЯЬЯЬЯЬЯЬШ-ЪЯЬЯШKШ(KШ*KШ*KШ,KЪЯЬбPШYЧШKШ ЧЧЪаЬЯЬЯ
ЬЯЬ
ЯЬЯЬШOKЪЯЬЯЬЯЬбШOЪЯЬШKШ*KШ+KЪ
ЯЬЯЬЯЬЯЬЯЬ#ШPKШЧKШKШ ЧЪаЬЯЬЯЬЯЬЯЬЯЬШ@KЪЯЬЯЬЯЬЯЬШKШKЪЯЬ$ЯЬЯЬбШAЪЯЬШKШ,KШ#KШЧKШKШ ЧЪа
ЬЯЬЯЬЯЬЯЬЯЬШXKЪЬЯЬШ!KШ!KШ%ЪЯЬЯЬЯЬЯШ!JШ"JЪЯЬШЧKШKШ ЧЪаааЬЯЬЯЬЯЬЯЬЯЬШJKЪЯЬШKШKЪаШKШ ЧЪааааЬЯЬЯЬЯЬЯЬШ2KШKЪаШKШ ЧKЩGЪаШKЩKЪЬЯЬ
ШKЪЬЯЬЯЬШ?ЪЬЯЬЯЬЯЬШ5KЪЬIЩIKЪЬ%Щ%ЧKЪЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬШ:KЪЬ
ЯЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬШ9KШ KЪЬЯЬ.ШGKЪ	ЬЯЬЯЬЯЬЯЬШ2KЪаЬЯЬЯЬЯЬШTKЪаШKШ ЧЪааЬЯЬЯЬЯЬЯЬЯЬЯЬШTKШKЪ	ЬЯЬЯЬЯЬЯЬШKШЪЯЬЯЬЯЬЯШ"KЪЯЬЯЬЯЬШ(ЪЯЬЯЬШKЪЬЩKЪЬШKЪЯЬШKЪЬШЧKЪЯЬШЧЪЯЬЯЬЯЬШ+KЪЬ[Щ[KЪ	ЬЯЬЯЬЯЬЯЬШKШKШKЪЯЬЯЬЯЬЯЬШ.KЪЬЯЬ)ШGЧKЪЬ;Щ;KШKШ9KЪ
ЯЬЯЬЯЬЯЬЯЬ#ШSKЪЯЬШKЪЬШKЪаШKШ ЧЪааЬЯЬЯЬЯЬЯЬЯЬШ<KШKЪ	ЬЯЬЯЬЯЬЯЬШKЪЯЬЯЬЯЬЯЬШЪЯЬЯЬЯЬЯШ"KЪЯЬ ЯЬЯЬШ,KЪЯЬЯЬЯЬбШ.KЪЯЬШЧKШЪЯЬЯЬЯШЪЯЬЯЬШKШKШ3KШKЪЯЬШKЪЬШЧKШKЪЯЬШЧKШKЪаШKШ ЧЪааЬЯЬШ$ЪЯЬЯЬЯШ KЪЬЯЬЯЬЯЬШKЪЬ0Щ0ЪЯЬЯЬЯЬЯШ)KЪЬЯЬЯЬЯЬЯЬЯЬЯЬШ.KШKЪЯЬШЧKЪЯЬШЧЪЯЬЯЬЯШ KЪЬJЩJKЪ	ЬЯЬЯЬЯЬЯЬШ(ЪЯЬЯЬЯШKШ KШKЪЯЬШЧKЪЯЬШЧKШKЪаШЧЧЪЬ2Щ2KЪЬЯЬ	ШKЪЬЯЬбШ9ЪЬ	ЯЬШ$KШ ЧKЪЬ
ЯЬЯЬЯЬШЪЬЯЬЯЬЯЬЯЬЯЬШCKШ ЧЪбаЬЯЬЯЬ ЯЬЯЬЯЬЯЬШtKЪЬШKЪЬЯЬЯЬШ&KЪЬЯЬШKЪЬЯЬЯЬЯЬЯЬЯЬШ:KЪЬШЪЯЬЯЬШ$KЪЬBШBKШЧЪЯЬЯЬЯЬШKЪЬЯЬШ%ЪЯЬЯЬЯЬЯШKЪЬЯЬШ4KЪЯЬШЧKЪЬ&ЯЬ0Ш[KШЧKЪЬШKШ ЧЪбаЬЯЬЯЬЯЬЯЬ	ЯЬЯЬЯЬЯЬЯЬЯЬШЖKЪЬЯЬCШKЪЯЬЯЬШKЪЬ4Щ4ЧЪЯЬЯЬЯЬЯШ(ЪЯЬЯЬЯШЪЬШKЪЬqЩqKЪЯЬЯЬШ*ЧKЪЯЬШЧЧЪЬШKЪЬ╤Щ╤KЪЬЯЬЯЬШ'KЪЬЯЬЯЬЯЬЯЬЯЬЯЬЯЬШ>KЪЬЯЬШKЪЬШЪЯЬ	ЯШKЪЬШKЪЬ0Ш0ЪЯЬЯЬЯШKЪЬIЩIЪЯЬЯЬЯЬЯШKЪЬЯЬЯЬ
Ш'KЪЯЬ	ЯЬ	ЯЬ!ЯЬ
ШNKЪЯЬШЧЧKЪЬШKЪЬШKЪЬШKЪЯЬШЧKЪЬШKЪЯЬШKЪЬШЧKЪЬШKШ ЧЧKЪЬЯЬЯЬббббббШ6KЪЬ$ЯЬШ0KШ ЪаЬЯЬШKЪЯЬ0Ш7KШKШKШKШKШKШ ЧKШKШ KЪЯЬШЩ,KЩ[KЪЬ╧rЩ!ЧЩ-KЩuЧKЩ Ч ЕЧ     0  5Ы  