-- TexEqtb.mesa

-- last written by Doug Wyatt, November 10, 1979  5:43 PM

DIRECTORY
	TexDefs: FROM "TexDefs",
	TexErrorDefs: FROM "TexErrorDefs" USING[Confusion,OverFlow],
	TexGlueDefs: FROM "TexGlueDefs" USING[GluePtr,AddGlueLink,DelGlueLink],
	TexHashDefs: FROM "TexHashDefs",
	TexMathDefs: FROM "TexMathDefs",
	TexMemDefs: FROM "TexMemDefs",
	TexTableDefs: FROM "TexTableDefs",
	TexTokenDefs: FROM "TexTokenDefs" USING[DelRCLink];

TexEqtb: PROGRAM
IMPORTS TexGlueDefs,TexErrorDefs,TexHashDefs,TexMemDefs,TexTableDefs,
	TexTokenDefs
EXPORTS TexTableDefs SHARES TexTableDefs =
BEGIN OPEN TexMathDefs,TexDefs,TexHashDefs,TexTableDefs;

TableError: PUBLIC SIGNAL = CODE;
UndefinedFont: PUBLIC ERROR = CODE;

EqtbEntry: TYPE = RECORD[lev: Lev, cmd: Cmd, info: CmdInfo];
nullEqtbEntry: EqtbEntry=[lev: 0, cmd: undefined, info: [undefined[]]];

HashEquivArray: TYPE = ARRAY HashIndex OF EqtbEntry;
CharTypeArray: TYPE = ARRAY Char OF EqtbEntry;
MModeCodeArray: TYPE = ARRAY Char OF EqtbEntry;
MFontTableArray: TYPE = ARRAY MathFontTableIndex OF EqtbEntry;
HangParamArray: TYPE = ARRAY HangParamType OF EqtbEntry;
TexParamArray: TYPE = ARRAY TexParamType OF EqtbEntry;
GlueParamArray: TYPE = ARRAY GlueParamType OF EqtbEntry;

-- *** this is awful. Why can't I say LENGTH[HashEquivArray], etc. ???
hashEquivLength: CARDINAL = SIZE[HashEquivArray]/SIZE[EqtbEntry];
charTypeLength: CARDINAL = SIZE[CharTypeArray]/SIZE[EqtbEntry];
mmodeCodeLength: CARDINAL = SIZE[MModeCodeArray]/SIZE[EqtbEntry];
fontEntryLength: CARDINAL = 1;
mfontTableLength: CARDINAL = SIZE[MFontTableArray]/SIZE[EqtbEntry];
hangParamLength: CARDINAL = SIZE[HangParamArray]/SIZE[EqtbEntry];
texParamLength: CARDINAL = SIZE[TexParamArray]/SIZE[EqtbEntry];
glueParamLength: CARDINAL = SIZE[GlueParamArray]/SIZE[EqtbEntry];

eqtbLength: CARDINAL=hashEquivLength+charTypeLength
	+mmodeCodeLength+fontEntryLength+mfontTableLength
	+hangParamLength+texParamLength+glueParamLength;

EqtbIndex: TYPE = [0..eqtbLength);

EqtbArray: TYPE = ARRAY EqtbIndex OF EqtbEntry;

eqtb: POINTER TO EqtbArray←NIL;

hashEquivBase: EqtbIndex = 0;
charTypeBase: EqtbIndex = hashEquivBase+hashLength;
mmodeCodeBase: EqtbIndex = charTypeBase+charTypeLength;
fontEntryBase: EqtbIndex = mmodeCodeBase+mmodeCodeLength;
mfontTableBase: EqtbIndex = fontEntryBase+fontEntryLength;
hangParamBase: EqtbIndex = mfontTableBase+mfontTableLength;
texParamBase: EqtbIndex = hangParamBase+hangParamLength;
glueParamBase: EqtbIndex = texParamBase+texParamLength;

--charTypes: POINTER TO CharTypeArray = LOOPHOLE[@eqtb[charTypeBase]];
--mModeCodes: POINTER TO MModeCodeArray = LOOPHOLE[@eqtb[mmodeCodeBase]];
--fontPtr: POINTER TO EqtbEntry = @eqtb[fontEntryBase];
--mFontTable: POINTER TO MFontTableArray = LOOPHOLE[@eqtb[mfontTableBase]];
--hangParams: POINTER TO HangParamArray = LOOPHOLE[@eqtb[hangParamBase]];
--texParams: POINTER TO TexParamArray = LOOPHOLE[@eqtb[texParamBase]];
--glueParams: POINTER TO GlueParamArray = LOOPHOLE[@eqtb[glueParamBase]];

ChTypeIndex: PROCEDURE[c: Char] RETURNS[EqtbIndex] = --INLINE--
	BEGIN RETURN[charTypeBase+LOOPHOLE[c,CARDINAL]] END;
ChType: PUBLIC PROCEDURE[c: Char] RETURNS[CharType] =
	BEGIN
	index: EqtbIndex←ChTypeIndex[c];
	entry: EqtbEntry←eqtb[index];
	WITH x:entry.info SELECT entry.cmd FROM
		chartypeentry => RETURN[x.chartype];
		ENDCASE => ERROR TableError;
	END;
SetChType: PUBLIC PROCEDURE[c: Char, type: CharType] =
	BEGIN
	index: EqtbIndex←ChTypeIndex[c];
	EqDefine[index, chartypeentry, [chartypeentry[type]]];
	END;

MModeCodeIndex: PROCEDURE[c: Char] RETURNS[EqtbIndex] = --INLINE--
	BEGIN RETURN[mmodeCodeBase+LOOPHOLE[c,CARDINAL]] END;
MModeCode: PUBLIC PROCEDURE[c: Char] RETURNS[TMChar] =
	BEGIN
	index: EqtbIndex←MModeCodeIndex[c];
	entry: EqtbEntry←eqtb[index];
	WITH x:entry.info SELECT entry.cmd FROM
		tmcharentry => RETURN[x.tmchar];
		ENDCASE => ERROR TableError;
	END;
SetMModeCode: PUBLIC PROCEDURE[c: Char, tmchar: TMChar] =
	BEGIN
	index: EqtbIndex←MModeCodeIndex[c];
	EqDefine[index, tmcharentry, [tmcharentry[tmchar]]];
	END;

FontIndex: PROCEDURE RETURNS[EqtbIndex] = --INLINE--
	BEGIN RETURN[fontEntryBase] END;
fontptr: POINTER TO EqtbEntry;
fontinfo: POINTER TO fontentry CmdInfo;
InitFont: PROCEDURE =
	BEGIN
	fontptr←@eqtb[FontIndex[]];
	fontptr↑←[1,fontentry,[fontentry[FALSE,0]]];
	WITH x:fontptr.info SELECT fontentry FROM
		fontentry => fontinfo←@x; ENDCASE;
	END;

CurFont: PUBLIC PROCEDURE RETURNS[Font] =
	BEGIN
	WITH x:fontptr.info SELECT fontptr.cmd FROM
		fontentry => IF x.defined THEN RETURN[x.font] ELSE ERROR UndefinedFont;
		ENDCASE => ERROR TableError;
-- *** for efficiency, probably want assume fontptr.cmd=fontentry:
--	IF fontinfo.defined THEN RETURN[fontinfo.font] ELSE ERROR UndefinedFont;
	END;
SetFont: PUBLIC PROCEDURE[f: Font] =
	BEGIN
	EqDefine[FontIndex[], fontentry, [fontentry[TRUE, f]]];
	END;


MFTableIndex: PROCEDURE[i: MathFontTableIndex]
	RETURNS[EqtbIndex] = --INLINE--
	BEGIN
	RETURN[mfontTableBase+i];
	END;
InitMathFontTable: PROCEDURE =
	BEGIN
	i: MathFontTableIndex;
	FOR i IN MathFontTableIndex DO
		eqtb[MFTableIndex[i]]←[1,fontentry,[fontentry[FALSE,0]]];
		ENDLOOP;
	END;

CurMathFont: PUBLIC PROCEDURE[i: MathFontTableIndex] RETURNS[Font] =
	BEGIN
	index: EqtbIndex←MFTableIndex[i];
	entry: EqtbEntry←eqtb[index];
	WITH x:entry.info SELECT entry.cmd FROM
		fontentry => IF x.defined THEN RETURN[x.font] ELSE ERROR UndefinedFont;
		ENDCASE => ERROR TableError;
	END;
SetMathFont: PUBLIC PROCEDURE[i: MathFontTableIndex, f: Font] =
	BEGIN
	index: EqtbIndex←MFTableIndex[i];
	EqDefine[index, fontentry, [fontentry[defined: TRUE, font: f]]];
	END;

HangIndentIndex: PROCEDURE[h: HangParamType] RETURNS[EqtbIndex] = --INLINE--
	BEGIN RETURN[hangParamBase+LOOPHOLE[h,CARDINAL]] END;
CurHangIndent: PUBLIC PROCEDURE RETURNS[HangSpec] =
	BEGIN
	hang: HangSpec;
	h: HangParamType;
	index: EqtbIndex;
	entry: EqtbEntry;
	FOR h IN HangParamType
		DO
		index←HangIndentIndex[h]; entry←eqtb[index];
		WITH x:entry.info SELECT entry.cmd FROM
			hangentry => WITH hpar:x.hangpar SELECT h FROM
				begin => hang.begin←hpar.begin;
				first => hang.first←hpar.first;
				width => hang.width←hpar.width;
				ENDCASE;
			ENDCASE => ERROR TableError;
		ENDLOOP;
	RETURN[hang];
	END;
SetHangIndent: PUBLIC PROCEDURE[hang: HangSpec] =
	BEGIN
	h: HangParamType;
	index: EqtbIndex;
	hangpar: HangPar;
	FOR h IN HangParamType
		DO
		index←HangIndentIndex[h];
		hangpar←SELECT h FROM
			begin => [begin[hang.begin]],
			first => [first[hang.first]],
			width => [width[hang.width]],
			ENDCASE => ERROR;
		EqDefine[index, hangentry, [hangentry[hangpar]]];
		ENDLOOP;
	END;

TexParamIndex: PROCEDURE[t: TexParamType] RETURNS[EqtbIndex] = --INLINE--
	BEGIN RETURN[texParamBase+LOOPHOLE[t,CARDINAL]] END;
TexParam: PUBLIC PROCEDURE[t: TexParamType] RETURNS[TexPar] =
	BEGIN
	index: EqtbIndex←TexParamIndex[t];
	entry: EqtbEntry←eqtb[index];
	WITH x:entry.info SELECT entry.cmd FROM
		texparentry => RETURN[x.texpar];
		ENDCASE => ERROR TableError;
	END;
SetTexParam: PUBLIC PROCEDURE[t: TexParamType, texpar: TexPar] =
	BEGIN
	index: EqtbIndex←TexParamIndex[t];
	EqDefine[index, texparentry, [texparentry[texpar]]];
	END;
CurPenalty: PUBLIC PROCEDURE[t: PenaltyType] RETURNS[Penalty] =
	BEGIN
	texpar: TexPar←TexParam[t];
	WITH texpar SELECT t FROM
		jpar,hpen,penpen,wpen,bpen,mbpen,mrpen,disppen => RETURN[penalty];
		ENDCASE => ERROR;
	END;
CurTracing: PUBLIC PROCEDURE RETURNS[TraceInfo] =
	BEGIN
	texpar: TexPar←TexParam[tracing];
	WITH t:texpar SELECT tracing FROM
		tracing => RETURN[t.tracing];
		ENDCASE => ERROR;
	END;

GlueParamIndex: PROCEDURE[t: GlueParamType] RETURNS[EqtbIndex] = --INLINE--
	BEGIN RETURN[glueParamBase+LOOPHOLE[t,CARDINAL]] END;
GlueParam: PUBLIC PROCEDURE[t: GlueParamType] RETURNS[TexGlueDefs.GluePtr] =
	BEGIN
	index: EqtbIndex←GlueParamIndex[t];
	entry: EqtbEntry←eqtb[index];
	WITH x:entry.info SELECT entry.cmd FROM
		glueentry => RETURN[x.glue];
		ENDCASE => ERROR TableError;
	END;
SetGlueParam: PUBLIC PROCEDURE[t: GlueParamType, glue: TexGlueDefs.GluePtr] =
	BEGIN
	index: EqtbIndex←GlueParamIndex[t];
	EqDefine[index, glueentry, [glueentry[glue]]];
	TexGlueDefs.AddGlueLink[glue];
	END;


HashEqIndex: PROCEDURE[i: HashIndex] RETURNS[EqtbIndex] = --INLINE--
	BEGIN RETURN[hashEquivBase+i] END;
HashEquiv: PUBLIC PROCEDURE[i: HashIndex]
	RETURNS[cmd: Cmd, info: CmdInfo] =
	BEGIN
	index: EqtbIndex←HashEqIndex[i];
	[cmd: cmd, info: info]←eqtb[index];
	END;
SetHashEquiv: PUBLIC PROCEDURE[i: HashIndex, cmd: Cmd, info: CmdInfo,
	global: BOOLEAN←FALSE] =
	BEGIN
	index: EqtbIndex←HashEqIndex[i];
	savelev: Lev←curlev;
	IF global THEN eqtb[index].lev←curlev←1;
	EqDefine[index, cmd, info];
	curlev←savelev;
	END;
HashEquivDefined: PUBLIC PROCEDURE[i: HashIndex] RETURNS[BOOLEAN] =
	BEGIN
	index: EqtbIndex←HashEqIndex[i];
	RETURN[eqtb[index].lev#0];
	END;

-- the savestack

curlev: Lev;

CurLev: PUBLIC PROCEDURE RETURNS[Lev] =
	BEGIN RETURN[curlev] END;

SaveEntry: TYPE = RECORD
	[
	SELECT type: * FROM
		invalid => NULL,
		destroy => [i: EqtbIndex],
		restore => [i: EqtbIndex, entry: EqtbEntry],
		endcode => [code: EndingCode],
		ENDCASE
	];

savesize: CARDINAL = 200;
saveptr: POINTER←NIL; -- pointer to most recent entry in savestack
savestack: POINTER←NIL; -- pointer to base of savestack

SaveBaseArray: TYPE = ARRAY Lev OF POINTER TO endcode SaveEntry;
savebase: POINTER TO SaveBaseArray;

-- this returns the EndingCode for the current level
SaveCode: PUBLIC PROCEDURE RETURNS[EndingCode] = 
	BEGIN RETURN[savebase[curlev].code] END;

UnSave: PUBLIC PROCEDURE[ec: EndingCode] =
	BEGIN
	eptr: POINTER TO SaveEntry;
	IF curlev=1 THEN RETURN; -- *** perhaps should complain
	curlev←curlev-1;
		DO
		eptr←saveptr;
		WITH e:eptr SELECT FROM
			destroy =>
				BEGIN
				i: EqtbIndex=e.i;
				IF eqtb[i].lev#1 THEN
					BEGIN
					EqDestroy[eqtb[i]]; eqtb[i]←nullEqtbEntry;
					HashOut[i-hashEquivBase];
					END;
				saveptr←saveptr+SIZE[destroy SaveEntry];
				END;
			restore =>
				BEGIN
				i: EqtbIndex=e.i;
				-- no restoration is made after the control sequence
				--  has been subject to \gdef or \xdef
				IF i IN HashIndex AND eqtb[i].lev=1 THEN EqDestroy[e.entry]
				ELSE BEGIN EqDestroy[eqtb[i]]; eqtb[i]←e.entry END;
				saveptr←saveptr+SIZE[restore SaveEntry];
				END;
			endcode =>
				BEGIN
				-- check that the ending code is the one we expected
				IF e.code#ec THEN SIGNAL TexErrorDefs.Confusion;
				saveptr←saveptr+SIZE[endcode SaveEntry];
				EXIT;
				END;
			ENDCASE => ERROR TexErrorDefs.Confusion; -- bad SaveStackEntry type
		ENDLOOP;
	END -- of UnSave --;

NewSaveLevel: PUBLIC PROCEDURE[ec: EndingCode] =
	BEGIN
	IF curlev=LAST[Lev] THEN
		ERROR TexErrorDefs.OverFlow["curlev"]; -- max savelevel exceeded
	curlev←curlev+1;
	PushEndcode[ec];
	END -- of NewSaveLevel --;

SaveEqtbEntry: PROCEDURE[i: EqtbIndex] =
	BEGIN
	entry: EqtbEntry;
	IF (entry←eqtb[i]).lev=0 THEN PushDestroy[i]
	ELSE PushRestore[i, entry];
	END -- of SaveEqtbEntry --;

PushDestroy: PROCEDURE[i: EqtbIndex] = --INLINE--
	BEGIN
	p: POINTER TO destroy SaveEntry←BumpSavePtr[SIZE[destroy SaveEntry]];
	p↑←[destroy[i]];
	END;

PushRestore: PROCEDURE[i: EqtbIndex, entry: EqtbEntry] = --INLINE--
	BEGIN
	p: POINTER TO restore SaveEntry←BumpSavePtr[SIZE[restore SaveEntry]];
	p↑←[restore[i,entry]];
	END;

PushEndcode: PROCEDURE[code: EndingCode] = --INLINE--
	BEGIN
	p: POINTER TO endcode SaveEntry←BumpSavePtr[SIZE[endcode SaveEntry]];
	p↑←[endcode[code]];
	savebase[curlev]←p;
	END;

BumpSavePtr: PROCEDURE[n: CARDINAL] RETURNS[POINTER] =
	BEGIN
	IF saveptr-savestack<n THEN
		ERROR TexErrorDefs.OverFlow["savestack"]; -- savestack full
	RETURN[saveptr←saveptr-n];
	END;

EqDestroy: PROCEDURE[entry: EqtbEntry] =
	BEGIN
	WITH x:entry.info SELECT entry.cmd FROM
		call => TexTokenDefs.DelRCLink[x.toklist];
		glueentry => TexGlueDefs.DelGlueLink[x.glue];
		ENDCASE;
	END -- of EqDestroy --;

EqDefine: PROCEDURE[i: EqtbIndex, cmd: Cmd, info: CmdInfo] =
	BEGIN
	entry: EqtbEntry←eqtb[i];
	IF entry.lev=curlev THEN EqDestroy[entry] -- redefinition on same level
	ELSE IF curlev>1 THEN SaveEqtbEntry[i]; -- save definition on old level
	eqtb[i]←[lev: curlev, cmd: cmd, info: info];
	END -- of EqDefine --;


EqtbInit: PROCEDURE =
	BEGIN OPEN TexMemDefs;
	p: POINTER TO invalid SaveEntry;
	i: CARDINAL;

	eqtb←AllocMem[SIZE[EqtbArray]];
	savestack←AllocMem[savesize];
	savebase←AllocMem[SIZE[SaveBaseArray]];

	-- initialize the savestack
	saveptr←savestack+savesize;
	curlev←1; PushEndcode[bottomlevel];
	-- put an invalid SaveEntry on the stack to detect underflow
	p←saveptr←saveptr-SIZE[invalid SaveEntry];
	p↑←[invalid[]];

	-- initialize eqtb
	FOR i IN EqtbIndex DO eqtb[i]←nullEqtbEntry ENDLOOP;
	InitFont;
	InitMathFontTable;
	START TexHashInit;
	END;

EqtbInit;

END -- of TexEqtb --.