-- TexDump.mesa
-- Last changed by Doug Wyatt, September 23, 1980  3:40 PM

DIRECTORY
	TexDefs: FROM "TexDefs",
	TexHashDefs: FROM "TexHashDefs",
	TexInpDefs: FROM "TexInpDefs",
	TexIODefs: FROM "TexIODefs",
	TexMemDefs: FROM "TexMemDefs",
	TexStringDefs: FROM "TexStringDefs",
	TexSynDefs: FROM "TexSynDefs",
	TexTableDefs: FROM "TexTableDefs",
	TexTokenDefs: FROM "TexTokenDefs";

TexDump: PROGRAM
IMPORTS TexHashDefs,TexInpDefs,TexIODefs,TexMemDefs,TexTableDefs,TexStringDefs
EXPORTS TexSynDefs =
BEGIN OPEN TexTokenDefs,TexIODefs;

-- The diagnostic routines dumplist,dumptokens

tokstring: STRING←NIL;
id: STRING←NIL;

DumpInit: PROCEDURE =
	BEGIN OPEN TexMemDefs;
	tokstring←AllocString[500];
	id←AllocString[TexHashDefs.maxidsize];
	END;

-- the value returned by DumpList is the index in the string s
-- corresponding to the token pointed to by q

DumpList: PROCEDURE[s: STRING, p,q: TokenPtr] RETURNS[CARDINAL] =
	BEGIN OPEN TexIODefs;
	stream: StreamHandle←TexStringDefs.CreateStringStream[s];
	itm: Token; npars: CARDINAL←0;
	qindex: CARDINAL←0;
	lengthlimit: CARDINAL=s.length-8;

	SetStream[stream];
	WHILE p#NIL
		DO
		ENABLE TexStringDefs.StringFull => CONTINUE;
		IF p=q THEN qindex←s.length;
		itm←p.token;
		WITH x: itm SELECT FROM
			ctrlseq =>
				BEGIN OPEN TexTableDefs;
				i: HashIndex←x.index;
				IF i IN HashIndex THEN
					BEGIN
					id.length←0; TexHashDefs.IdName[id, i];
					IF (s.length+id.length)>lengthlimit THEN GOTO Etc;
					Esc; Ws[id]; IF id.length>1 OR ChType[id[0]]=letter THEN Sp;
					END
				ELSE Ws["IMPOSSIBLE"L];
				END;
			match => SELECT x.matchcode FROM
				par => BEGIN Wc['#]; Wc['0+(npars←npars+1)] END;
				end => Wc[']; -- right arrow
				ENDCASE;
			outpar => BEGIN Wc['#]; Wc['0+x.paramnum] END;
			macprm => Ws["##"L];
			parend => BEGIN Esc;Ws["par "L] END;
			endv => BEGIN Esc;Ws["ENDV"L] END;
			spacer => Wc[' ];
			lbrace,rbrace,mathbr,tabmrk,supmrk,submrk,
			 letter,otherchar => Wc[x.char];
			ENDCASE => BEGIN Esc;Ws["BAD"L] END;
		IF s.length>lengthlimit THEN GOTO Etc;
		p←p.link;
		REPEAT Etc => BEGIN Esc;Ws["ETC"L] END
		ENDLOOP;
	UseDisplay; stream.destroy[stream];
	RETURN[qindex];
	END -- of DumpList --;

DumpTokens: PUBLIC PROCEDURE[s: STRING, p: TokenPtr] =
	BEGIN []←DumpList[s, p,NIL] END;

DumpContext: PUBLIC PROCEDURE =
	BEGIN OPEN TexInpDefs,TexIODefs;
	ptr: [0..instacksize]; t: TokenPtr;

	UseDisplay; -- output to display
	instack[inptr]←instate;
	FOR ptr DECREASING IN [0..inptr] DO
		WITH instack[ptr] SELECT FROM
		tokenlist =>
			BEGIN
			iloc: CARDINAL;
			WITH recovery SELECT FROM
				donothing => BEGIN Ps["<argument> "L]; t←l END;
				endulist => BEGIN Ps["<ulist> "L]; t←l END;
				endvlist => BEGIN Ps["<vlist> "L]; t←l END;
				prune => BEGIN Cr; t←l.link END;
				destroy => IF loc#NIL THEN
					BEGIN Ps["<to be read again> "L]; t←l END
					ELSE LOOP; -- tokenlist to be flushed, won't be dumped
				ENDCASE => ERROR;
			tokstring.length←0;
			iloc←DumpList[tokstring,t,loc]; ShowLoc[tokstring, iloc];
			END;
		charlist =>
			BEGIN
			curfile: STRING←filename;
			IF curfile=NIL THEN Ps["(*) "L]
			ELSE BEGIN Ps["p."L]; Wn[page]; Ws[",l."L]; Wn[line]; Sp END;
			ShowLoc[inbuf,ibptr+1];
			IF curfile#NIL THEN EXIT;
			Cr;
			END;
		ENDCASE;
		ENDLOOP; 
	END -- of DumpContext --;

ShowLoc: PROCEDURE[s: STRING, loc: CARDINAL] =
	BEGIN OPEN TexIODefs;
	del: CARDINAL=32;
	beg,end,e: CARDINAL;
	head,tail: BOOLEAN;
	IF s.length=0 THEN RETURN;
	head←loc>del; beg←IF head THEN loc-del ELSE 0;
	tail←s.length>(e←loc+del); end←IF tail THEN e ELSE s.length;
	IF s[end-1]=CR THEN end←end-1;
	IF head THEN Ws["..."L]; Wss[s,beg,loc];
--	tab←Loc[]; Wss[s,loc,end]; IF tail THEN Ws["..."L];
--	Cr; Tab[tab]; Wc['↑];
	Ws[" <=> "L]; Wss[s,loc,end]; IF tail THEN Ws["..."L]; -- *** try this
	END;

DumpInit;

END.