-- TexDebug.mesa

-- last written by Doug Wyatt, December 19, 1979  3:04 AM

DIRECTORY
	TexDebugDefs: FROM "TexDebugDefs",
	TexDefs: FROM "TexDefs",
	TexGlueDefs: FROM "TexGlueDefs",
	TexIODefs: FROM "TexIODefs",
	TexMemDefs: FROM "TexMemDefs",
	TexMem: FROM "TexMem",
	TexNodeDefs: FROM "TexNodeDefs",
	TexNode: FROM "TexNode",
	TexSynDefs: FROM "TexSynDefs";

TexDebug: PROGRAM
IMPORTS TexIODefs,mem:TexMem,TexNodeDefs,node:TexNode,TexSynDefs
EXPORTS TexDebugDefs SHARES TexMem,TexMemDefs,TexNode =
BEGIN OPEN TexDefs,TexGlueDefs,TexNodeDefs,TexMemDefs,TexIODefs;

showMem: BOOLEAN=FALSE;
showNodes: BOOLEAN=FALSE;

-- * * * * * Memory statistics: entering MainControl
-- seglist (x,x,xx,xx) = xxx pages, xxxxx words
-- freesize xxxxx  biglist (xx,xx)
--   size   NodesAlloc NodesUsed  WordsAlloc WordsUsed  WordsFree
--     n      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
--     n      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
--     n      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
--    nn      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
--    nn      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
--    nn      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
--    nn      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
-- small      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
--   big      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
-- total      xxxxx      xxxxx      xxxxx      xxxxx      xxxxx
-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

foo: STRING_"Debugging"; -- for calling ShowMem from debugger

ShowMem: PUBLIC PROCEDURE[string: STRING] =
	BEGIN IF showMem THEN MemStats[string] END;

CheckDEBUG: PROCEDURE[s: STRING] RETURNS[BOOLEAN] =
	BEGIN OPEN TexDebugDefs;
	IF NOT DEBUG THEN
		BEGIN
		Ws["* * * "L]; Ws[s];
		Ws[" unavailable: DEBUG not enabled!"L]; Cr;
		END;
	RETURN[DEBUG];
	END;

MemStats: PROCEDURE[string: STRING] =
	BEGIN OPEN mem,debug;
	seg: SegPtr;
	bptr: BigPtr;
	size: SmallSize; slot: Slot;
	pgs,na,wa,nu,wu,wf: CARDINAL_0;
	sna,snu,swa,swu,swf: CARDINAL_0;
	bna,bwa,bnu,bwu,bnf,bwf: CARDINAL_0;
	IF NOT CheckDEBUG["MemStats"L] THEN RETURN;
	Cr; Ws["* * * * * Memory statistics: "L]; Ws[string]; Cr;
	Ws["seglist ("L];
	IF (seg_seglist)#NIL THEN
		DO
		Wnf[seg.pages,0]; pgs_pgs+seg.pages;
		IF (seg_seg.link)#NIL THEN Wc[',] ELSE EXIT;
		ENDLOOP;
	Ws[") = "L]; Wnf[pgs,0]; Ws[" pages,"L];
	Wnf[WordsForPages[pgs],0]; Ws[" words"L]; Cr;
	Ws["freesize"L]; Wnf[freesize,6]; Ws["  biglist ("L];
	IF (bptr_biglist)#NIL THEN
		DO
		Wnf[bptr.size,0]; bnf_bnf+1; bwf_bwf+bptr.size;
		IF (bptr_bptr.link)#NIL THEN Wc[',] ELSE EXIT;
		ENDLOOP;
	Ws[")"L]; Cr;
	Ws["  size  NodesAlloc NodesUsed  WordsAlloc WordsUsed  WordsFree"L]; Cr;
	FOR slot IN Slot
		DO
		IF (na_slotcount[slot])=0 THEN LOOP; nu_slotNodesUsed[slot];
		size_slotsize[slot]; wa_na*size; wu_slotWordsUsed[slot]; wf_wa-wu;
		sna_sna+na; snu_snu+nu;
		swa_swa+wa; swu_swu+wu; swf_swf+wf;
		Wnf[size,5]; Wnf[na,11]; Wnf[nu,11];
		Wnf[wa,11]; Wnf[wu,11]; Wnf[wf,11]; Cr;
		ENDLOOP;
	Ws["small"L]; Wnf[sna,11]; Wnf[snu,11];
	Wnf[swa,11]; Wnf[swu,11]; Wnf[swf,11]; Cr;
	bna_bnf+(bnu_bigNodesUsed); bwa_bwf+(bwu_bigWordsUsed);
	Ws["  big"L]; Wnf[bna,11]; Wnf[bnu,11];
	Wnf[bwa,11]; Wnf[bwu,11]; Wnf[bwf,11]; Cr;
	Ws["total"L]; Wnf[sna+bna,11]; Wnf[snu+bnu,11];
	Wnf[swa+bwa,11]; Wnf[swu+bwu,11]; Wnf[swf+bwf,11]; Cr;
	Ws[" strings"L]; Wnf[strings,6];
	Ws["     Chars"L]; Wnf[stringChars,6];
	Ws["     Words"L]; Wnf[stringWords,6]; Cr;
	Ws["* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"L]; Cr;
	END;

-- *** Math mode Zone: pgs xxx  alloc xxxxx  used xxxxx
-- *** seglist (x,x,x)  unused xxxxx

ShowZone: PUBLIC PROCEDURE[zone: ZonePtr, string: STRING] =
	BEGIN
	IF showMem THEN ZoneStats[zone,string];
	END;

ZoneStats: PROCEDURE[zone: ZonePtr, string: STRING] =
	BEGIN OPEN mem,LOOPHOLE[zone,ZPtr],debug;
	seg: ZSegPtr;
	pgs,wa,wu: CARDINAL_0;
	IF NOT CheckDEBUG["ZoneStats"L] THEN RETURN;
	pgs_totalpages; wa_WordsForPages[pgs]; wu_wa-(freesize+unused);
	Cr; Ws["*** "L]; Ws[string]; Ws[" Zone: pgs"L]; Wnf[pgs,4];
	Ws["  alloc"L]; Wnf[wa,6]; Ws["  used"L]; Wnf[wu,6]; Cr;
	IF (seg_seglist)#NIL THEN
		BEGIN
		Ws["*** seglist ("L];
			DO
			Wnf[seg.pages,0]; pgs_pgs+seg.pages;
			IF (seg_seg.link)#NIL THEN Wc[',] ELSE EXIT;
			ENDLOOP;
		Ws[")  unused"L]; Wnf[unused,6]; Cr;
		END;
	END;


Clobbered: ERROR = CODE;

thresh: CARDINAL_1;
indent: CARDINAL_0;
nitems: CARDINAL_5;

Indent: PROCEDURE =
	BEGIN
	Cr; THROUGH [1..indent] DO Wc['.] ENDLOOP;
	END;

DumpNodeList: PROCEDURE[p: NodePtr] =
	BEGIN
	ENABLE Clobbered => BEGIN Ws["***???***"]; CONTINUE END;
	c: CARDINAL_0;
	q: NodePtr;
	IF indent>thresh THEN RETURN;
	FOR q_p,q.link UNTIL q=NIL
		DO
		Indent;
		IF (c_c+1)>nitems THEN BEGIN Ws["etc."]; RETURN END;
		ShowNode[q];
		ENDLOOP;
	END;

ShowNode: PUBLIC PROCEDURE[p: NodePtr] =
	BEGIN OPEN TexIODefs;
	DumpSubList: PROCEDURE[q: NodePtr] =
		BEGIN indent_indent+1; DumpNodeList[q]; indent_indent-1 END;
	WITH pp:p SELECT FROM
		char,disc =>
			BEGIN IF pp.type=disc THEN Ws["\discretionary"]; WFChar[pp.c] END;
		box =>
			BEGIN
			SELECT pp.dir FROM
				hlist => Ws["\hbox"];
				vlist => Ws["\vbox"];
				ENDCASE => ERROR Clobbered;
			Wc['(]; Wn[pp.height]; Ws["+"]; Wn[pp.depth]; Ws[")x"]; Wn[pp.width];
			IF pp.glueset#zeroGlueSet THEN
				BEGIN Ws[", glueset "]; WGlueSet[pp.glueset] END;
			IF pp.shiftamt#0 THEN
				BEGIN Ws[", shifted "]; Wn[pp.shiftamt] END;
			DumpSubList[pp.head];
			END;
		rule =>
			BEGIN
			Wr: PROCEDURE[x: Dimn] =
				BEGIN IF x=nilDimn THEN Wc['*] ELSE Wn[x] END;
			Ws["\rule"];
			Wc['(]; Wr[pp.height]; Ws["+"]; Wr[pp.depth]; Ws[")x"]; Wr[pp.width];
			END;
		glue => BEGIN Ws["\glue "]; WGlue[pp.g] END;
		space => BEGIN Ws["\space "]; Wn[pp.s] END;
		kern => BEGIN Ws["\kern "]; Wn[pp.s] END;
		leader => BEGIN Ws["\leaders"]; DumpSubList[pp.p] END;
		hyph =>
			BEGIN
			Ws["\hyphenation "];
			SELECT pp.auto FROM
				on => Ws["on"];
				off => Ws["off"];
				ENDCASE => ERROR Clobbered;
			END;
		penalty => BEGIN Ws["\penalty "]; Wn[pp.pts] END;
		eject => Ws["\eject"];
		mark =>
			BEGIN
			Ws["\mark"]; Wc['{];
			TexSynDefs.DumpTokens[NIL,pp.t.link];
			END;
		ins =>
			BEGIN
			SELECT pp.where FROM
				top => Ws["\topinsert "];
				bot => Ws["\botinsert "];
				ENDCASE => ERROR Clobbered;
			IF pp.dir=vlist THEN Ws["(can wait) "];
			WGlue[pp.glue]; DumpSubList[pp.vlist];
			END;
		unset => Ws["\unset"]; -- *** more here
		ENDCASE => ERROR Clobbered;
	END;

WGlue: PROCEDURE[g: GluePtr] =
	BEGIN
	f: Flex;
	Wn[g.space];
	IF (f_g.flex[str])#zeroFlex THEN
		BEGIN Ws[" plus "]; WFlex[f] END;
	IF (f_g.flex[shr])#zeroFlex THEN
		BEGIN Ws[" minus "]; WFlex[f] END;
	END;

WFlex: PROCEDURE[f: Flex] =
	BEGIN
	SELECT f.order FROM
		regular => NULL;
		lowerfill => Ws["lowerfill "];
		fill => Ws["fill "];
		ENDCASE => ERROR Clobbered;
	Wn[f.val];
	END;

WGlueSet: PROCEDURE[gs: GlueSet] =
	BEGIN
	SELECT gs.dir FROM
		str => Ws["str "];
		shr => Ws["shr "];
		ENDCASE => ERROR Clobbered;
	SELECT gs.order FROM
		regular => NULL;
		lowerfill => Ws["lowerfill "];
		fill => Ws["fill "];
		ENDCASE => ERROR Clobbered;
	Wn[gs.num]; Wc['/]; Wn[gs.den];
	END;

-- * * * Node statistics: page
--   NodeType   Nodes   Words
--      char      xx      xx
--    string     xxx    xxxx
--       box      xx     xxx
--      glue     xxx    xxxx
-- gluespecs      xx     xxx
--      hyph      xx      xx
--   penalty       x      xx
--     total    xxxx    xxxx
--  Len  Strings  Words
--    1      xxx   xxxx
--    2      xxx   xxxx
--    3       xx    xxx
-- * * * * * * * * * * * * * *

nodetype: ARRAY NodeType OF STRING _
	["char", "string", "box", "rule", "glue", "space", "kern", "leader",
	"hyph", "penalty", "disc", "eject", "mark", "ins", "unset", "listhead"];

nodes: ARRAY NodeType OF CARDINAL;
sizes: ARRAY NodeType OF CARDINAL;
stringvec: ARRAY StringLength OF CARDINAL;
gluespecs: CARDINAL;

ShowNodeStatistics: PUBLIC PROCEDURE[p: NodePtr, string: STRING] =
	BEGIN IF showNodes THEN NodeStats[p,string] END;

NodeStats: PROCEDURE[p: NodePtr, string: STRING] =
	BEGIN OPEN node;
	t: NodeType;
	tnodes,twords: CARDINAL_0;
	n,w: CARDINAL;
	l: StringLength;
	FOR t IN NodeType DO nodes[t]_sizes[t]_0 ENDLOOP;
	FOR l IN StringLength DO stringvec[l]_0 ENDLOOP;
	gluespecs_0;
	AddNodeList[p];
	Cr; Ws["* * * Node statistics: "L]; Ws[string]; Cr;
	Ws["  NodeType   Nodes   Words"L]; Cr;
	FOR t IN NodeType
		DO
		tnodes_tnodes+(n_nodes[t]); twords_twords+(w_sizes[t]);
		IF n=0 THEN LOOP;
		Wrjs[nodetype[t],9]; Wnf[n,8]; Wnf[w,8]; Cr;
		IF t=glue AND gluespecs>0 THEN
			BEGIN
			n_gluespecs; w_n*SIZE[GlueSpec];
			Wrjs["gluespecs"L,9]; Wnf[n,8]; Wnf[w,8]; Cr;
			END;
		ENDLOOP;
	Wrjs["total"L,9]; Wnf[tnodes,8]; Wnf[twords,8]; Cr;
	StringStats;
	Ws["* * * * * * * * * * * * * *"L]; Cr;
	END;

StringStats: PROCEDURE =
	BEGIN
	l: StringLength;
	lmin,lmax: StringLength;
	n,w: CARDINAL;
	FOR lmin IN StringLength UNTIL stringvec[lmin]>0 DO ENDLOOP;
	FOR lmax DECREASING IN StringLength UNTIL stringvec[lmax]>0 DO ENDLOOP;
	Ws[" Len  Strings  Words"L]; Cr;
	FOR l IN [lmin..lmax]
		DO
		n_stringvec[l]; w_n*StringNodeSize[l];
		Wnf[l,3]; Wnf[n,9]; Wnf[w,7]; Sp;
		THROUGH [0..(n+3)/5) DO Wc['#] ENDLOOP; Cr;
		ENDLOOP;
	END;

-- write right-justified string
Wrjs: PROCEDURE[s: STRING, w: CARDINAL] =
	BEGIN THROUGH [s.length..w) DO Sp ENDLOOP; Ws[s] END;

AddNode: PROCEDURE[p: NodePtr] =
	BEGIN
	t: NodeType_p.type;
	s: CARDINAL_0;
	WITH pp:p SELECT FROM
		char => s_SIZE[char Node];
		disc => s_SIZE[disc Node];
		string =>
			BEGIN
			l: StringLength_pp.length;
			stringvec[l]_stringvec[l]+1;
			s_StringNodeSize[l];
			END;
		box => BEGIN AddNodeList[pp.head]; s_SIZE[box Node] END;
		rule => s_SIZE[rule Node];
		glue =>
			BEGIN
			g: GluePtr_pp.g;
			IF g.refs=1 THEN gluespecs_gluespecs+1;
			s_SIZE[glue Node];
			END;
		space => s_SIZE[space Node];
		kern => s_SIZE[kern Node];
		leader => s_SIZE[leader Node];
		hyph => s_SIZE[hyph Node];
		penalty => s_SIZE[penalty Node];
		eject => s_SIZE[eject Node];
		mark => s_SIZE[mark Node];
		ins => BEGIN AddNodeList[pp.vlist]; s_SIZE[ins Node] END;
		unset => BEGIN AddNode[pp.box]; s_SIZE[unset Node] END;
		listhead => s_SIZE[listhead Node];
		ENDCASE => ERROR;
	nodes[t]_nodes[t]+1; sizes[t]_sizes[t]+s;
	END;

AddNodeList: PROCEDURE[p: NodePtr] =
	BEGIN
	q: NodePtr;
	FOR q_p,q.link UNTIL q=NIL DO AddNode[q] ENDLOOP;
	END;

END.