-- file LiteralPack.Mesa
-- last modified by Satterthwaite, 9-Feb-82 9:48:21
DIRECTORY
Alloc: TYPE USING [
Handle, Notifier, OrderedIndex,
AddNotify, Bounds, DropNotify, Failure, Top, Words],
Literals: TYPE,
LiteralOps: TYPE USING [ValueDescriptor],
Strings: TYPE USING [
String, SubString, SubStringDescriptor,
AppendChar, AppendSubString, EqualSubStrings],
Symbols: TYPE USING [SEIndex];
LiteralPack: PROGRAM
IMPORTS Alloc, Strings
EXPORTS LiteralOps =
PUBLIC {
OPEN Literals;
table: PRIVATE Alloc.Handle;
zone: PRIVATE UNCOUNTED ZONE ← NIL;
ltb: PRIVATE Literals.Base; -- literal table base
stb: PRIVATE Literals.Base; -- string table base
UpdateBases: PRIVATE Alloc.Notifier = {
-- called whenever the main symbol table is repacked
ltb ← base[ltType]; stb ← base[stType]; RETURN};
LTMax: Alloc.OrderedIndex = FIRST[Alloc.OrderedIndex] + (LAST[LTIndex]-FIRST[LTIndex]);
STMax: Alloc.OrderedIndex = FIRST[Alloc.OrderedIndex] + (LAST[STIndex]-FIRST[STIndex]);
initialized: PRIVATE BOOLEAN ← FALSE;
Initialize: 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 ← FIRST[STIndex]; locals ← markBit ← FALSE;
initialized ← TRUE};
Finalize: PROC = {
table.DropNotify[UpdateBases]; table ← NIL;
zone.FREE[@sHashVec]; zone.FREE[@hashVec]; zone ← NIL;
initialized ← FALSE};
-- literal table management
LitHVLength: PRIVATE INTEGER = 53;
LitHVIndex: PRIVATE TYPE = [0..LitHVLength);
hashVec: PRIVATE LONG POINTER TO ARRAY LitHVIndex OF LTIndex;
Find: PROC [v: WORD] RETURNS [lti: LTIndex] = {
hvi: LitHVIndex = v MOD LitHVLength;
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, SIZE[short LTRecord]];
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};
FindMultiWord: PRIVATE PROC [baseP: Literals.Finger, desc: LitDescriptor]
RETURNS [lti: LTIndex] = {
v: WORD ← 0;
hvi: LitHVIndex;
lLti: Literals.Base RELATIVE POINTER [0..Literals.Limit) TO long LTRecord;
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, SIZE[long LTRecord] + 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};
Value: 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: PROC [desc: LiteralOps.ValueDescriptor] RETURNS [LTIndex] = {
base: Literals.Base ← LOOPHOLE[BASE[desc]];
RETURN [IF LENGTH[desc] = 1
THEN Find[desc[0]]
ELSE FindMultiWord[@base, [offset:LOOPHOLE[0], length:LENGTH[desc]]]]};
deltaShort: CARDINAL = LOOPHOLE[@(NIL[POINTER TO short LTRecord]).value];
deltaLong: CARDINAL = LOOPHOLE[@(NIL[POINTER TO long LTRecord]).value];
DescriptorValue: 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: PROC [literal: LTId] RETURNS [lti: LTIndex] = {
desc: LitDescriptor;
WITH entry: literal.baseP↑[literal.index] SELECT FROM
short => lti ← Find[entry.value];
long => {
desc ← [offset: LOOPHOLE[literal.index + deltaLong], length: entry.length];
lti ← FindMultiWord[literal.baseP, desc]};
ENDCASE => ERROR;
RETURN};
ForgetEntries: PROC RETURNS [currentSize: CARDINAL] = {
hashVec↑ ← ALL[LTNull]; RETURN [table.Bounds[ltType].size]};
-- string literal table management
MSTNull: PRIVATE MSTIndex = LOOPHOLE[STNull];
SLitHVLength: PRIVATE INTEGER = 23;
SLitHVIndex: PRIVATE TYPE = [0..SLitHVLength);
sHashVec: PRIVATE LONG POINTER TO ARRAY SLitHVIndex OF MSTIndex;
stLimit, localStart: STIndex;
locals: BOOLEAN;
markBit: BOOLEAN;
FindString: PROC [s: Strings.SubString] RETURNS [STIndex] = {
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: Strings.String = StringValue[sti];
desc: Strings.SubStringDescriptor ← [base:v, offset:0, length:v.length];
IF Strings.EqualSubStrings[s, @desc] THEN EXIT;
REPEAT
FINISHED => {
nw: CARDINAL = SIZE[StringBody[s.length]];
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: ]]];
Strings.AppendSubString[@stb[sti].string, s];
FOR i: CARDINAL IN [s.length .. stb[sti].string.maxlength) DO
Strings.AppendChar[@stb[sti].string, 0C] ENDLOOP;
stb[sti].string.length ← s.length;
stLimit ← stLimit + (SizeSTPrefix + nw);
sHashVec[hvi] ← sti};
ENDLOOP;
RETURN [sti]};
MasterString: PROC [sti: STIndex] RETURNS [MSTIndex] = {
RETURN [WITH s: stb[sti] SELECT FROM
master => LOOPHOLE[sti],
copy => s.link,
heap => s.link,
ENDCASE => MSTNull]};
StringReference: PROC [sti: STIndex] = {
WITH s: stb[sti] SELECT FROM
master => s.info ← s.info + 1;
ENDCASE => NULL};
StringValue: PROC [sti: STIndex] RETURNS [Strings.String] = {
RETURN [@stb[MasterString[sti]].string]};
TextType: PROC [sti: STIndex] RETURNS [Symbols.SEIndex] = {
RETURN [WITH s: stb[sti] SELECT FROM heap => s.type, ENDCASE => ERROR]};
ResetLocalStrings: PROC RETURNS [key: STIndex] = {
IF ~locals THEN key ← STNull
ELSE {key ← localStart; markBit ← ~markBit};
locals ← FALSE; localStart ← table.Top[stType];
RETURN};
FindHeapString: PROC [key: STIndex, type: Symbols.SEIndex] 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 + SIZE[StringBody[s.string.maxlength]];
copy => next ← sti + SIZE[copy STRecord];
heap => {
IF s.type = type AND s.link = master THEN EXIT;
next ← sti + SIZE[heap STRecord]};
ENDCASE;
REPEAT
FINISHED => {
ti: Alloc.OrderedIndex = table.Words[stType, SIZE[heap STRecord]];
IF ti >= STMax THEN ERROR table.Failure[stType];
sti ← ti;
stb[sti] ← STRecord[heap[type: type, info: 0, link: master]];
stLimit ← stLimit + SIZE[heap STRecord]};
ENDLOOP;
RETURN};
FindLocalString: 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 + SIZE[StringBody[s.string.maxlength]];
copy => {
IF s.link = master THEN EXIT;
next ← sti + SIZE[copy STRecord]};
heap => next ← sti + SIZE[heap STRecord];
ENDCASE;
REPEAT
FINISHED => {
ti: Alloc.OrderedIndex = table.Words[stType, SIZE[copy STRecord]];
IF ti >= STMax THEN ERROR table.Failure[stType];
sti ← ti; stb[sti] ← STRecord[copy[mark: markBit, link: master]];
stLimit ← stLimit + SIZE[copy STRecord];
locals ← TRUE};
ENDLOOP;
RETURN};
EnumerateHeapStrings: 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 + SIZE[StringBody[s.string.maxlength]];
copy => next ← sti + SIZE[copy STRecord];
heap => {proc[sti]; next ← sti + SIZE[heap STRecord]};
ENDCASE => ERROR;
ENDLOOP};
EnumerateLocalStrings: PROC [key: STIndex, proc: PROC [MSTIndex]] = {
next: STIndex;
started, mark: BOOLEAN;
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 + SIZE[StringBody[s.string.maxlength]];
copy => {
IF ~started THEN {mark ← s.mark; started ← TRUE};
IF s.mark # mark THEN EXIT;
proc[s.link];
next ← sti + SIZE[copy STRecord]};
heap => next ← sti + SIZE[heap STRecord];
ENDCASE => ERROR;
ENDLOOP};
EnumerateMasterStrings: 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 + SIZE[StringBody[s.string.maxlength]]};
copy => next ← sti + SIZE[copy STRecord];
heap => next ← sti + SIZE[heap STRecord];
ENDCASE => ERROR;
ENDLOOP};
}.