-- 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
	IMPORTS	Inline
	EXPORTS	TiogaPGSupport
	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.
(635)