
<<file LiteralPack.mesa>>
<<last modified by Satterthwaite, February 18, 1983 10:07 am>>
<<Last Edited by: Maxwell, August 1, 1983 2:52 pm>>
<<>>
DIRECTORY
Alloc: TYPE USING [
Handle, Notifier, OrderedIndex,
AddNotify, Bounds, DropNotify, Failure, Top, Words],
ConvertUnsafe: TYPE USING [AppendRope, EqualSubStrings, SubString, SubStringToRope],
Literals: TYPE,
LiteralOps: TYPE USING [ValueDescriptor],
Symbols: TYPE USING [Type];

LiteralPack: PROGRAM
IMPORTS Alloc, ConvertUnsafe
EXPORTS LiteralOps = {
OPEN Literals;

table: Alloc.Handle;
zone: UNCOUNTED ZONE _ NIL;

ltb: Literals.Base;    -- literal table base
stb: Literals.Base;    -- string table base

UpdateBases: Alloc.Notifier = {
<<called whenever the main symbol table is repacked>>
ltb _ base[ltType];  stb _ base[stType];  RETURN};


ltMax: Alloc.OrderedIndex = Alloc.OrderedIndex.FIRST + (LTIndex.LAST-LTIndex.FIRST);
stMax: Alloc.OrderedIndex = Alloc.OrderedIndex.FIRST + (STIndex.LAST-STIndex.FIRST);

initialized: BOOL _ FALSE;

Initialize: PUBLIC PROC [ownTable: Alloc.Handle, scratchZone: UNCOUNTED ZONE] = { 
<<called to set up the compiler's literal table >>
IF initialized THEN Finalize[];
zone _ scratchZone;
hashVec _ zone.NEW[ARRAY LitHVIndex OF LTIndex];
sHashVec _ zone.NEW[ARRAY SLitHVIndex OF MSTIndex];
table _ ownTable;  table.AddNotify[UpdateBases];
[] _ ForgetEntries[];  sHashVec^ _ ALL[MSTNull];
stLimit _ localStart _ STIndex.FIRST;  locals _ markBit _ FALSE;
initialized _ TRUE};

Finalize: PUBLIC PROC = {
table.DropNotify[UpdateBases]; table _ NIL;
zone.FREE[@sHashVec];  zone.FREE[@hashVec];  zone _ NIL;
initialized _ FALSE};


<<literal table management>>

litHVLength: INTEGER = 53;
LitHVIndex: TYPE = [0..litHVLength);

hashVec: LONG POINTER TO ARRAY LitHVIndex OF LTIndex;


Find: PUBLIC PROC [v: WORD] RETURNS [LitIndex.word] = {
hvi: LitHVIndex = v MOD litHVLength;
lti: LTIndex;
FOR lti _ hashVec[hvi], ltb[lti].link UNTIL lti = LTNull DO
WITH entry: ltb[lti] SELECT FROM
short => IF entry.value = v THEN EXIT;
ENDCASE;
REPEAT
FINISHED => {
ti: Alloc.OrderedIndex = table.Words[ltType, LTRecord.short.SIZE];
IF ti >= ltMax THEN ERROR table.Failure[ltType];
lti _ ti;  ltb[lti] _ LTRecord[datum: short[value: v], link: hashVec[hvi]];
hashVec[hvi] _ lti};
ENDLOOP;
RETURN [[word[lti]]]};

FindMultiWord: PROC [baseP: Literals.Finger, desc: LitDescriptor]
RETURNS [LitIndex.word] = {
v: WORD _ 0;
hvi: LitHVIndex;
lti: LTIndex;
lLti: Literals.Base RELATIVE POINTER[0..Literals.Limit) TO LTRecord.long;
FOR i: CARDINAL IN [0 .. desc.length) DO v _ v + baseP^[desc.offset][i] ENDLOOP;
hvi _ v MOD litHVLength;
FOR lti _ hashVec[hvi], ltb[lti].link UNTIL lti = LTNull DO
WITH entry: ltb[lti] SELECT FROM
long =>
IF desc.length = entry.length THEN
FOR i: CARDINAL IN [0 .. desc.length) DO
IF entry.value[i] # baseP^[desc.offset][i] THEN EXIT;
REPEAT
FINISHED => GO TO found;
ENDLOOP;
ENDCASE;
REPEAT
found => NULL;
FINISHED => {
ti: Alloc.OrderedIndex = table.Words[ltType, LTRecord.long.SIZE + desc.length];
IF ti >= ltMax THEN ERROR table.Failure[ltType];
lLti _ ti;
ltb[lLti] _ LTRecord[
link: hashVec[hvi],
datum: long[codeIndex: 0, length: desc.length, value: ]];
FOR i: CARDINAL IN [0 .. desc.length) DO
ltb[lLti].value[i] _ baseP^[desc.offset][i] ENDLOOP;
hashVec[hvi] _ lti _ lLti};
ENDLOOP;
RETURN [[word[lti]]]};

Value: PUBLIC PROC [lti: LTIndex] RETURNS [WORD] = {
WITH entry: ltb[lti] SELECT FROM
short => RETURN [entry.value];
long => IF entry.length = 1 THEN RETURN [entry.value[0]];
ENDCASE;
ERROR};


FindDescriptor: PUBLIC PROC [desc: LiteralOps.ValueDescriptor] RETURNS [LitIndex.word] = {
base: Literals.Base _ LOOPHOLE[desc.BASE];
RETURN [IF desc.LENGTH = 1
THEN Find[desc[0]]
ELSE FindMultiWord[@base, [offset:LOOPHOLE[0], length:desc.LENGTH]]]};

deltaShort: CARDINAL = LOOPHOLE[@(NIL[POINTER TO LTRecord.short]).value];
deltaLong: CARDINAL = LOOPHOLE[@(NIL[POINTER TO LTRecord.long]).value];

DescriptorValue: PUBLIC PROC [lti: LTIndex] RETURNS [LitDescriptor] = {
RETURN [WITH entry: ltb[lti] SELECT FROM
short => [offset: LOOPHOLE[lti + deltaShort], length: 1],
long => [offset: LOOPHOLE[lti + deltaLong], length: entry.length],
ENDCASE => ERROR]};


CopyLiteral: PUBLIC PROC [literal: LTId] RETURNS [lti: LitIndex.word] = {
desc: LitDescriptor;
WITH entry: literal.baseP^[literal.index.lti] SELECT FROM
short => lti _ Find[entry.value];
long => {
desc _ [offset: LOOPHOLE[literal.index.lti + deltaLong], length: entry.length];
lti _ FindMultiWord[literal.baseP, desc]};
ENDCASE => ERROR;
RETURN};

ForgetEntries: PUBLIC PROC RETURNS [currentSize: CARDINAL] = {
hashVec^ _ ALL[LTNull]; RETURN [table.Bounds[ltType].size]};


<<string literal table management>>

MSTNull: MSTIndex = LOOPHOLE[STNull];
SLitHVLength: INTEGER = 23;
SLitHVIndex: TYPE = [0..SLitHVLength);

sHashVec: LONG POINTER TO ARRAY SLitHVIndex OF MSTIndex;

stLimit, localStart: STIndex;
locals: BOOL;
markBit: BOOL;

sizeSTPrefix: NAT = STRecord.master.SIZE - StringBody[0].SIZE;


FindString: PUBLIC PROC [s: ConvertUnsafe.SubString] RETURNS [LitIndex.string] = {
CpW: CARDINAL = 2;    -- String.CharsPerWord
hash: WORD _ 0;
hvi: SLitHVIndex;
sti: MSTIndex;
FOR i: CARDINAL IN [s.offset .. s.offset+s.length) DO
hash _ hash + LOOPHOLE[s.base[i], CARDINAL] ENDLOOP;
hvi _ hash MOD SLitHVLength;
FOR sti _ sHashVec[hvi], stb[sti].link UNTIL sti = MSTNull DO
v: LONG STRING = StringValue[sti];
vs: ConvertUnsafe.SubString _ [base:v, offset:0, length:v.length];
IF ConvertUnsafe.EqualSubStrings[s, vs] THEN EXIT;
REPEAT
FINISHED => {
nw: CARDINAL = StringBody[s.length].SIZE;
ti: Alloc.OrderedIndex = table.Words[stType, sizeSTPrefix + nw];
IF ti >= stMax THEN ERROR table.Failure[stType];
sti _ ti;
stb[sti] _ STRecord[master[
info: 0,
codeIndex: 0,
local: FALSE,
link: sHashVec[hvi],
string: [
length: 0,
maxlength: ((s.length + (CpW-1))/CpW) * CpW,
text: ]]];
ConvertUnsafe.AppendRope[@stb[sti].string, ConvertUnsafe.SubStringToRope[s]];
FOR i: CARDINAL IN [s.length .. stb[sti].string.maxlength) DO
<<-- Strings.AppendChar[@stb[sti].string, '\000];>>
stb[sti].string[stb[sti].string.length] _ '\000;
stb[sti].string.length _ stb[sti].string.length + 1;
ENDLOOP;
stb[sti].string.length _ s.length;
stLimit _ stLimit + (sizeSTPrefix + nw);
sHashVec[hvi] _ sti};
ENDLOOP;
RETURN [[string[sti]]]};


MasterString: PUBLIC PROC [sti: STIndex] RETURNS [MSTIndex] = {
RETURN [WITH s: stb[sti] SELECT FROM
master => LOOPHOLE[sti],
copy => s.link,
heap => s.link,
ENDCASE => MSTNull]};

StringReference: PUBLIC PROC [sti: STIndex] = {
WITH s: stb[sti] SELECT FROM
master => s.info _ s.info + 1;
ENDCASE => NULL};

StringValue: PUBLIC PROC [sti: STIndex] RETURNS [LONG STRING] = {
RETURN [@stb[MasterString[sti]].string]};

TextType: PUBLIC PROC [sti: STIndex] RETURNS [Symbols.Type] = {
RETURN [WITH s: stb[sti] SELECT FROM heap => s.type, ENDCASE => ERROR]};

ResetLocalStrings: PUBLIC PROC RETURNS [key: STIndex] = {
IF ~locals THEN key _ STNull
ELSE {key _ localStart; markBit _ ~markBit};
locals _ FALSE;  localStart _ table.Top[stType];
RETURN};


FindHeapString: PUBLIC PROC [key: STIndex, type: Symbols.Type] RETURNS [sti: STIndex] = {
next: STIndex;
master: MSTIndex = MasterString[key];
FOR sti _ FIRST[STIndex], next UNTIL sti = stLimit DO
WITH s: stb[sti] SELECT FROM
master => next _ sti + sizeSTPrefix + StringBody[s.string.maxlength].SIZE;
copy => next _ sti + STRecord.copy.SIZE;
heap => {
IF s.type = type AND s.link = master THEN EXIT;
next _ sti + STRecord.heap.SIZE};
ENDCASE;
REPEAT
FINISHED => {
ti: Alloc.OrderedIndex = table.Words[stType, STRecord.heap.SIZE];
IF ti >= stMax THEN ERROR table.Failure[stType];
sti _ ti;
stb[sti] _ STRecord[heap[type: type, info: 0, link: master]];
stLimit _ stLimit + STRecord.heap.SIZE};
ENDLOOP;
RETURN};

FindLocalString: PUBLIC PROC [key: STIndex] RETURNS [sti: STIndex] = {
next: STIndex;
master: MSTIndex = MasterString[key];
FOR sti _ localStart, next UNTIL sti = stLimit DO
WITH s: stb[sti] SELECT FROM
master =>
next _ sti + sizeSTPrefix + StringBody[s.string.maxlength].SIZE;
copy => {
IF s.link = master THEN EXIT;
next _ sti + STRecord.copy.SIZE};
heap => next _ sti + STRecord.heap.SIZE;
ENDCASE;
REPEAT
FINISHED => {
ti: Alloc.OrderedIndex = table.Words[stType, STRecord.copy.SIZE];
IF ti >= stMax THEN ERROR table.Failure[stType];
sti _ ti;  stb[sti] _ STRecord[copy[mark: markBit, link: master]];
stLimit _ stLimit + STRecord.copy.SIZE;
locals _ TRUE};
ENDLOOP;
RETURN};


EnumerateHeapStrings: PUBLIC PROC [proc: PROC [STIndex]] = {
next: STIndex;
FOR sti: STIndex _ FIRST[STIndex], next UNTIL sti = stLimit DO
WITH s: stb[sti] SELECT FROM
master => next _ sti + sizeSTPrefix + StringBody[s.string.maxlength].SIZE;
copy => next _ sti + STRecord.copy.SIZE;
heap => {proc[sti]; next _ sti + STRecord.heap.SIZE};
ENDCASE => ERROR;
ENDLOOP};

EnumerateLocalStrings: PUBLIC PROC [key: STIndex, proc: PROC [MSTIndex]] = {
next: STIndex;
started, mark: BOOL;
IF key = STNull THEN RETURN;
started _ FALSE;
FOR sti: STIndex _ key, next UNTIL sti = stLimit DO
WITH s: stb[sti] SELECT FROM
master => next _ sti + sizeSTPrefix + StringBody[s.string.maxlength].SIZE;
copy => {
IF ~started THEN {mark _ s.mark;  started _ TRUE};
IF s.mark # mark THEN EXIT;
proc[s.link];
next _ sti + STRecord.copy.SIZE};
heap => next _ sti + STRecord.heap.SIZE;
ENDCASE => ERROR;
ENDLOOP};

EnumerateMasterStrings: PUBLIC PROC [proc: PROC [MSTIndex]] = {
next: STIndex;
FOR sti: STIndex _ FIRST[STIndex], next UNTIL sti = stLimit DO
WITH s: stb[sti] SELECT FROM
master => {
proc[LOOPHOLE[sti]];
next _ sti + sizeSTPrefix + StringBody[s.string.maxlength].SIZE};
copy => next _ sti + STRecord.copy.SIZE;
heap => next _ sti + STRecord.heap.SIZE;
ENDCASE => ERROR;
ENDLOOP};

}.