LiteralOpsImpl.mesa
Copyright Ó 1985, 1986, 1988, 1991 by Xerox Corporation. All rights reserved.
Satterthwaite, June 19, 1986 9:45:28 am PDT
Russ Atkinson (RRA) June 21, 1989 11:50:46 am PDT
JKF August 16, 1988 12:44:27 pm PDT
Willie-s, September 24, 1991 1:45 pm PDT
DIRECTORY
Alloc USING [AddNotify, Bounds, DropNotify, Failure, Handle, Notifier, OrderedIndex, Top, Units],
Basics USING [HighHalf, LowHalf],
ConvertUnsafe USING [EqualSubStrings, SubString],
Host: TYPE MachineParms USING [bitsPerLongWord],
LiteralOps USING [],
Literals,
MimZonePort,
MimZones USING [RegisterForReset, permZone, tempUZ],
SymbolOps USING [DecodeCard],
Symbols USING [Type, UNSPEC],
Target: TYPE MachineParms USING [bitsPerByte, bitsPerLongWord];
LiteralOpsImpl:
PROGRAM
IMPORTS Alloc, Basics, ConvertUnsafe, MimZonePort, MimZones, SymbolOps
EXPORTS LiteralOps = {
OPEN Literals, Target;
UNSPEC: TYPE = Symbols.UNSPEC;
table: Alloc.Handle ¬ NIL;
ltb: Literals.Base ¬ NIL; -- literal table base
stb: Literals.Base ¬ NIL; -- string table base
UpdateBases: Alloc.Notifier = {
called whenever the main symbol table is repacked
ltb ¬ base[ltType];
stb ¬ base[stType];
};
ltbZoneScratch: MimZonePort.Scratch;
ltbZone: UNCOUNTED ZONE ¬ MimZonePort.MakeZone[
alloc: LtbZoneProc, free: NIL, scratch: @ltbZoneScratch];
LtbZoneProc:
PROC
[self:
UNCOUNTED
ZONE, size:
CARDINAL]
RETURNS [ptr:
LONG
POINTER] = {
index: Alloc.OrderedIndex = table.Units[ltType, size];
IF index > ltMax THEN ERROR table.Failure[ltType];
ptr ¬ @ltb[index];
};
LTBRelative:
PROC [ptr:
LONG
POINTER
TO LTRecord]
RETURNS [LTIndex] =
INLINE {
RETURN [LOOPHOLE[ptr-LOOPHOLE[ltb, LONG POINTER TO LTRecord]]];
};
stbZoneScratch: MimZonePort.Scratch;
stbZone: UNCOUNTED ZONE ¬ MimZonePort.MakeZone[
alloc: StbZoneProc, free: NIL, scratch: @stbZoneScratch];
StbZoneProc:
PROC
[self:
UNCOUNTED
ZONE, size:
CARDINAL]
RETURNS [ptr:
LONG
POINTER] = {
index: Alloc.OrderedIndex = table.Units[stType, size];
IF index > stMax THEN ERROR table.Failure[stType];
stLimit ¬ stLimit + size;
ptr ¬ @stb[index];
};
STBRelative:
PROC [ptr:
LONG
POINTER
TO STRecord]
RETURNS [STIndex] =
INLINE {
RETURN [LOOPHOLE[ptr-LOOPHOLE[stb, LONG POINTER TO STRecord]]];
};
RoundUpBytes:
PROC [bytes:
CARDINAL]
RETURNS [
CARDINAL] =
INLINE {
bytesPerLongWord: CARDINAL = bitsPerLongWord/bitsPerByte;
mod: CARDINAL = bytes MOD bytesPerLongWord;
IF mod # 0 THEN bytes ¬ bytes + (bytesPerLongWord-mod);
RETURN [bytes];
};
ltMax: Alloc.OrderedIndex = LOOPHOLE[LTLast];
stMax: Alloc.OrderedIndex = LOOPHOLE[STLast];
bitsPerHostUnspec:
NAT =
BITS[
UNSPEC];
checkThisOut: [Host.bitsPerLongWord..Host.bitsPerLongWord] = bitsPerHostUnspec;
bytesPerLongWord: NAT = Target.bitsPerLongWord/Target.bitsPerByte;
initialized: BOOL ¬ FALSE;
Initialize:
PUBLIC
PROC [ownTable: Alloc.Handle] = {
called to set up the compiler's literal table
IF initialized THEN Finalize[];
table ¬ ownTable;
table.AddNotify[UpdateBases];
[] ¬ ForgetEntries[];
stLimit ¬ localStart ¬ STFirst;
locals ¬ markBit ¬ FALSE;
initialized ¬ TRUE;
};
Finalize:
PUBLIC
PROC = {
IF table # NIL THEN {table.DropNotify[UpdateBases]; table ¬ NIL};
initialized ¬ FALSE;
};
ClassError:
PUBLIC
ERROR =
CODE;
litHVLength: INTEGER = 53;
LitHVIndex: TYPE = [0..litHVLength);
hashVec: REF ARRAY LitHVIndex OF LTIndex
¬ MimZones.permZone.NEW[ARRAY LitHVIndex OF LTIndex];
IsShort:
PUBLIC
PROC [lti: LTIndex]
RETURNS [
BOOL] = {
WITH entry: ltb[lti]
SELECT
FROM
short => RETURN [TRUE];
ENDCASE => RETURN [FALSE];
};
Find:
PUBLIC
PROC [class: LitClass, val:
UNSPEC]
RETURNS [lti: LTIndex] = {
hvi: LitHVIndex = Basics.LowHalf[SymbolOps.DecodeCard[val]] MOD litHVLength;
FOR lti ¬ hashVec[hvi], ltb[lti].link
UNTIL lti = LTNull
DO
WITH entry: ltb[lti]
SELECT
FROM
short => IF entry.value = val AND entry.class = class THEN RETURN [lti];
ENDCASE;
ENDLOOP;
hashVec[hvi] ¬ lti ¬ LTBRelative[ltbZone.NEW[LTRecord.short
¬ [link: hashVec[hvi], class: class, datum: short[value: val]]]];
};
FindMultiWord:
PROC [baseP: Literals.Finger, desc: LitDescriptor]
RETURNS [lti: LTIndex] = {
bits: INT = desc.bits;
words:
NAT = (bits + bitsPerHostUnspec - 1) / bitsPerHostUnspec;
Don't trust the # of words coming in.
v: CARD ¬ bits;
hvi: LitHVIndex;
FOR i:
CARDINAL
IN [0..words)
DO
Try to get a good hash value
v ¬ v + Basics.HighHalf[v] + i + SymbolOps.DecodeCard[baseP[desc.offset][i]];
ENDLOOP;
hvi ¬ Basics.LowHalf[v] MOD litHVLength;
FOR lti ¬ hashVec[hvi], ltb[lti].link
UNTIL lti = LTNull
DO
WITH entry: ltb[lti]
SELECT
FROM
long =>
IF bits = entry.bits
THEN
FOR i:
CARDINAL
IN [0 .. words)
DO
IF entry.value[i] # baseP[desc.offset][i] THEN EXIT;
REPEAT
FINISHED => GO TO found;
ENDLOOP;
ENDCASE;
REPEAT
found => NULL;
FINISHED => {
ptr: LONG POINTER TO LTRecord.long ¬ ltbZone.NEW[LTRecord.long[words]];
ptr.link ¬ hashVec[hvi];
ptr.bits ¬ bits;
ptr.class ¬ desc.class;
hashVec[hvi] ¬ lti ¬ LTBRelative[ptr];
FOR i:
CARDINAL
IN [0 .. words)
DO
ptr[i] ¬ baseP[desc.offset][i];
ENDLOOP;
};
ENDLOOP;
RETURN [lti];
};
Value:
PUBLIC
PROC [lti: LTIndex]
RETURNS [class: LitClass, val:
UNSPEC] = {
WITH entry: ltb[lti]
SELECT
FROM
short => RETURN [entry.class, entry.value];
ENDCASE;
ERROR;
};
FindDescriptor:
PUBLIC
PROC [bits:
INT, ptr: WordSequencePtr]
RETURNS [LTIndex] = {
desc: LitDescriptor ¬ [bits: bits, class: bits, words: 0, offset: LOOPHOLE[(0).LONG]];
base: Literals.Base ¬ LOOPHOLE[ptr];
RETURN [FindMultiWord[@base, desc]];
deltaShort: CARDINAL = LTRecord.short.SIZE - Symbols.UNSPEC.SIZE;
deltaLong: CARDINAL = SIZE[LTRecord.long[0]];
DescriptorValue:
PUBLIC
PROC [lti: LTIndex]
RETURNS [LitDescriptor] = {
WITH entry: ltb[lti]
SELECT
FROM
short => RETURN [[class: entry.class, offset: LOOPHOLE[lti + deltaShort],
bits: bitsPerHostUnspec, words: 1]];
long => RETURN [[class: entry.class, offset: LOOPHOLE[lti + deltaLong],
bits: entry.bits, words: entry.max]];
ENDCASE => ERROR;
CopyLiteral:
PUBLIC
PROC [literal: LTId]
RETURNS [lti: LTIndex] = {
desc: LitDescriptor;
WITH entry: literal.baseP[literal.index]
SELECT
FROM
short => lti ¬ Find[entry.class, entry.value];
long => {
desc ¬ [class: bits, offset: LOOPHOLE[literal.index + deltaLong],
bits: entry.bits, words: 0];
lti ¬ FindMultiWord[literal.baseP, desc];
};
ENDCASE => ERROR;
};
ForgetEntries:
PUBLIC
PROC
RETURNS [ltBias:
CARD, stBias:
CARD] = {
hashVec ¬ ALL[LTNull];
sHashVec ¬ ALL[MSTNull];
RETURN [table.Bounds[ltType].size, table.Bounds[stType].size];
};
MSTNull: MSTIndex = LOOPHOLE[STNull];
SLitHVLength: INTEGER = 23;
SLitHVIndex: TYPE = [0..SLitHVLength);
sHashVec: REF ARRAY SLitHVIndex OF MSTIndex
¬ MimZones.permZone.NEW[ARRAY SLitHVIndex OF MSTIndex];
stLimit: STIndex ¬ STNull;
localStart: STIndex ¬ STNull;
locals: BOOL ¬ FALSE;
markBit: BOOL ¬ FALSE;
sizeSTPrefix: NAT = STRecord.master.SIZE - StringBody[0].SIZE;
CopyStringLiteral:
PUBLIC
PROC [baseP: Literals.Finger, index: Literals.STIndex]
RETURNS [sti: Literals.STIndex ¬ STNull] = {
DO
ptr: LONG POINTER TO Literals.STRecord ¬ @baseP[index];
WITH s: ptr
SELECT
FROM
master => {
scratchLen: NAT = 80;
scratch: STRING ¬ [scratchLen];
len: NAT = s.length;
new: LONG STRING ¬ scratch;
IF len > scratchLen THEN new ¬ MimZones.tempUZ.NEW[StringBody[len]];
FOR i:
NAT
IN [0..len)
DO
new[i] ¬ s[i];
ENDLOOP;
new.length ¬ len;
sti ¬ FindString[[new, 0, len]];
IF len > scratchLen THEN MimZones.tempUZ.FREE[@new];
EXIT;
};
copy => index ¬ s.link;
heap => index ¬ s.link;
ENDCASE => EXIT;
ENDLOOP;
};
FindString:
PUBLIC
PROC [s: ConvertUnsafe.SubString]
RETURNS [sti: STIndex] = {
hash: WORD ¬ 0;
hvi: SLitHVIndex;
FOR i:
CARDINAL
IN [s.offset .. s.offset+s.length)
DO
hash ¬ hash + i + 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 s.EqualSubStrings[vs] THEN EXIT;
REPEAT
FINISHED => {
len: CARDINAL = s.length;
max: CARDINAL = RoundUpBytes[len];
ptr: LONG POINTER TO STRecord.master ¬ stbZone.NEW[STRecord.master[max]];
ptr.info ¬ 0;
ptr.codeIndex ¬ 0;
ptr.local ¬ FALSE;
ptr.link ¬ sHashVec[hvi];
ptr.length ¬ len;
FOR i:
CARDINAL
IN [0 .. len)
DO
ptr[i] ¬ s.base[s.offset+i];
ENDLOOP;
FOR i:
CARDINAL
IN [len .. max)
DO
ptr[i] ¬ '\000;
ENDLOOP;
sHashVec[hvi] ¬ LOOPHOLE[sti ¬ STBRelative[ptr]];
};
ENDLOOP;
RETURN [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;
StringValue:
PUBLIC
PROC [sti: STIndex]
RETURNS [
LONG
STRING] = {
ptr: LONG POINTER TO STRecord.master = @stb[MasterString[sti]];
RETURN [LOOPHOLE[ptr + SIZE[STRecord.master[0]] - SIZE[StringBody[0]]]];
};
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];
};
FindHeapString:
PUBLIC
PROC [key: STIndex, type: Symbols.Type]
RETURNS [sti: STIndex] = {
master: MSTIndex = MasterString[key];
FOR sti ¬ localStart, sti
UNTIL sti = stLimit
DO
WITH s: stb[sti]
SELECT
FROM
master => sti ¬ sti + STRecord.master[s.maxLength].SIZE;
copy => sti ¬ sti + STRecord.copy.SIZE;
heap => {
IF s.type = type AND s.link = master THEN RETURN;
sti ¬ sti + STRecord.heap.SIZE;
};
ENDCASE;
ENDLOOP;
sti ¬ STBRelative[stbZone.NEW[STRecord.heap
¬ [link: master, cases: heap[type: type, info: 0]]]];
};
FindLocalString:
PUBLIC
PROC [key: STIndex]
RETURNS [sti: STIndex] = {
master: MSTIndex = MasterString[key];
FOR sti ¬ localStart, sti
UNTIL sti = stLimit
DO
WITH s: stb[sti]
SELECT
FROM
master => sti ¬ sti + STRecord.master[s.maxLength].SIZE;
copy => {
IF s.link = master THEN RETURN;
sti ¬ sti + STRecord.copy.SIZE;
};
heap => sti ¬ sti + STRecord.heap.SIZE;
ENDCASE => ERROR;
REPEAT
FINISHED => {
sti ¬ STBRelative[stbZone.NEW[STRecord.copy
¬ [link: master, cases: copy[mark: markBit]]]];
locals ¬ TRUE;
};
ENDLOOP;
};
EnumerateHeapStrings: PUBLIC PROC [proc: PROC [STIndex]] = {
sti: STIndex ← STFirst;
WHILE sti # stLimit DO
WITH s: stb[sti] SELECT FROM
master => sti ← sti + STRecord.master[s.maxLength].SIZE;
copy => sti ← sti + STRecord.copy.SIZE;
heap => {proc[sti]; sti ← sti + STRecord.heap.SIZE};
ENDCASE => ERROR;
ENDLOOP;
};
EnumerateLocalStrings: PUBLIC PROC [key: STIndex, proc: PROC [MSTIndex]] = {
sti: STIndex ← STFirst;
started, mark: BOOL;
IF key = STNull THEN RETURN;
started ← FALSE;
WHILE sti # stLimit DO
WITH s: stb[sti] SELECT FROM
master => sti ← sti + STRecord.master[s.maxLength].SIZE;
copy => {
IF ~started THEN {mark ← s.mark; started ← TRUE};
IF s.mark # mark THEN EXIT;
proc[s.link];
sti ← sti + STRecord.copy.SIZE;
};
heap => sti ← sti + STRecord.heap.SIZE;
ENDCASE => ERROR;
ENDLOOP;
EnumerateMasterStrings: PUBLIC PROC [proc: PROC [MSTIndex]] = {
sti: STIndex ← STFirst;
WHILE sti # stLimit DO
WITH s: stb[sti] SELECT FROM
master => {
proc[LOOPHOLE[sti]];
sti ← sti + STRecord.master[s.maxLength].SIZE;
};
copy => sti ← sti + STRecord.copy.SIZE;
heap => sti ← sti + STRecord.heap.SIZE;
ENDCASE => ERROR;
ENDLOOP;