-- TiogaPGSupportImpl.Mesa
-- written by Bill Paxton, January 1981
-- last written by Paxton. March 20, 1981 2:43 PM


DIRECTORY
TiogaPGSupport,
TiogaFileOps,
TextLooks,
TextNode,
Inline USING [BITXOR];

TiogaPGSupportImpl: PROGRAM
IMPORTSInline
EXPORTSTiogaPGSupport
SHARES TiogaPGSupport =
BEGIN
OPEN
TiogaPGSupport,
fOpsI:TiogaFileOps,
nodeI:TextNode,
looksI:TextLooks;

-- PGF is the file-level structure for put/get
-- PGS if the style-level structure for put/get

PGF: TYPE = REF PGFBody;
PGFBody: PUBLIC TYPE = RECORD [
pgsList: PGSList,
pgsNext: CARDINAL ← 0, -- next available StyleIndex
pgsTable: PGSTable
];

PGSList: TYPE = REF PGSListBody;
PGSListBody: TYPE = RECORD [ next: PGSList, pgs: PGS ];

PGSTable: TYPE = ARRAY fOpsI.StyleIndex OF PGS;

CreatePGF: PUBLIC PROC RETURNS [pgf: PGF] = { pgf ← NEW [PGFBody] };

GetPGS: PUBLIC PROC
[stylename: nodeI.StyleName, pgf: PGF]
RETURNS [pgs: PGS] =
BEGIN
start: PGSList ← pgf.pgsList;
pgsList: PGSList ← pgf.pgsList;
UNTIL pgsList = NIL DO
pgs ← pgsList.pgs;
IF pgs.stylename = stylename THEN RETURN;
pgsList ← pgsList.next;
ENDLOOP;
pgs ← NEW[PGSBody];
pgs.stylename ← stylename;
pgf.pgsList ← NEW[PGSListBody ← [start, pgs]];
pgs.looksTable[0] ← looksI.noLooks;
pgs.looksNext ← 1;
END;

RetrievePGS: PUBLIC PROC
[index: fOpsI.StyleIndex, pgf: PGF] RETURNS [PGS] =
BEGIN
IF index >= pgf.pgsNext THEN ERROR;
RETURN [pgf.pgsTable[index]];
END;

EnterPGS: PUBLIC PROC [pgs: PGS, pgf: PGF] RETURNS
[BOOLEAN, fOpsI.StyleIndex] =
BEGIN
next: CARDINAL ← pgf.pgsNext;
FOR i: fOpsI.StyleIndex IN [0 .. next) DO
IF pgf.pgsTable[i] = pgs THEN RETURN [TRUE, i];
ENDLOOP;
IF next < fOpsI.numStyles THEN -- room left in table
{ pgf.pgsTable[LOOPHOLE[next]] ← pgs; pgf.pgsNext ← next+1 };
RETURN [FALSE, 0]; -- index irrelevant in this case
END;

EnterTypeName: PUBLIC PROC
[typename: nodeI.TypeName, pgs: PGS]
RETURNS [BOOLEAN, fOpsI.TypeIndex] =
BEGIN
next: CARDINAL ← pgs.typeNext;
initloc, loc: CARDINAL;
IF typename = nodeI.nullTypeName THEN RETURN [FALSE, 0]; -- reject
loc ← initloc ← LOOPHOLE[typename,CARDINAL] MOD typeHashSize;
DO
SELECT pgs.typeHashKeys[loc].key FROM
typename => RETURN [TRUE, pgs.typeHashVals[loc]];
nodeI.nullTypeName => EXIT; -- this is an unused entry
ENDCASE;
SELECT (loc ← loc+1) FROM
typeHashSize => IF (loc ← 0)=initloc THEN ERROR;
initloc => ERROR; -- should never have full table
ENDCASE;
ENDLOOP;
IF next < fOpsI.numTypes THEN -- room left in table
BEGIN
pgs.typeTable[next] ← typename;
pgs.typeNext ← next+1;
pgs.typeHashKeys[loc].key ← typename;
pgs.typeHashVals[loc].index ← LOOPHOLE[next];
END;
RETURN [FALSE, 0]; -- index irrelevant in this case
END;

EnterLooks: PUBLIC PROC [looks: looksI.Looks, pgs: PGS]
RETURNS [ok: BOOLEAN, index: fOpsI.LooksIndex] =
BEGIN
next: CARDINAL ← pgs.looksNext;
initloc, loc: CARDINAL;
IF looks = looksI.noLooks THEN RETURN [TRUE, 0]; -- reserved
loc ← initloc ←
Inline.BITXOR[
LOOPHOLE[looks, looksI.LooksBytes].byte0,
Inline.BITXOR[LOOPHOLE[looks, looksI.LooksBytes].byte1,
LOOPHOLE[looks, looksI.LooksBytes].byte2]]
MOD looksHashSize;
DO
SELECT pgs.looksHashKeys[loc].key FROM
looks => RETURN [TRUE, pgs.looksHashVals[loc]];
looksI.noLooks => EXIT; -- this is an unused entry
ENDCASE;
SELECT (loc ← loc+1) FROM
looksHashSize => IF (loc ← 0)=initloc THEN ERROR;
initloc => ERROR; -- should never have full table
ENDCASE;
ENDLOOP;
IF next < fOpsI.numLooks THEN -- room left in table
BEGIN
pgs.looksTable[next] ← looks;
pgs.looksNext ← next+1;
pgs.looksHashKeys[loc].key ← looks;
pgs.looksHashVals[loc] ← LOOPHOLE[next];
END;
RETURN [FALSE, 0]; -- index irrelevant in this case
END;

END.