-- 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 --.