-- DBStashImpl.Mesa
-- last edit by Schmidt, January 6, 1983 1:44 pm
-- last edit by Satterthwaite, February 1, 1983 10:08 am

-- This module provides a cache of dependencies (DepSeq's) for the modeller
-- it is designed to operate independently so that the modeller can be changed.
-- without needing to replace this module, so it is loaded separately only
-- once by the Modeller.  In particular it is bound in its own config
-- (DBStashPack.Config) and does not rely on any Modeller procedures.
-- The cache is indexed by file create time.  There is only one DepSeq per
-- create time.
-- Things get tricky when these DepSeq's are passed to the Modeller, so
-- we adopt the convention that the Modeller never FREE's anything in the DepSeq, 
-- including the strings.  If necessary, strings may be put into the DepSeq
-- using the depseq.CopyString[] call.  This allows the memory for the Modeller
-- and this module to be COMPLETELY separate.  In fact the strings in the 
-- depseq's stored in no heap at all.


DIRECTORY
  CWF: TYPE USING [FWF0, FWF1, FWF2, FWF3, FWF4, 
  	SetWriteProcedure, SWF1, WF0, WF1, WF3, WFCR],
  DBStash: TYPE USING [],
  Dir: TYPE USING [DepSeq, DepSeqRecord, MaximumDepSize],
  Inline: TYPE USING [LongCOPY],
  IO: TYPE USING[Handle, PutChar],
  LongString: TYPE USING [AppendString, EquivalentString],
  Rope: TYPE USING[Text],
  RopeInline: TYPE USING[InlineFlatten],
  Subr: TYPE USING [AbortMyself, Any,   
  	HugeZone, numberofleaders, PagesUsedInHugeZone, 
		strcpy, SubrInit, SubrStop],
  TimeStamp: TYPE USING [Null, Stamp],
  UECP: TYPE USING[Argv, Parse],
  UserExec: TYPE USING[CommandProc, GetStreams, RegisterCommand, UserAbort];

DBStashImpl: MONITOR
IMPORTS CWF, Inline, IO, LongString, RopeInline, Subr, UECP, UserExec
EXPORTS DBStash = {

STASHSIZE: CARDINAL = 500;

StashSeq: TYPE = LONG POINTER TO StashSeqRecord;
StashSeqRecord: TYPE = RECORD[
	stashzone: UNCOUNTED ZONE _ NIL,
	temporarydepseq: Dir.DepSeq _ NIL,
	nhits: LONG CARDINAL _ 0,
	nmisses: LONG CARDINAL _ 0,
	size: CARDINAL _ 0,
	body: SEQUENCE maxsize: CARDINAL OF StashRecord
	];
	
ST: TYPE = LONG POINTER TO StashRecord;
StashRecord: TYPE = RECORD[
	create: LONG CARDINAL _ 0,
	fileName: LONG STRING _ NIL,	-- fileName and create are linked
	bcdVers: TimeStamp.Stamp _ TimeStamp.Null,
	depseq: Dir.DepSeq _ NIL
	];
	
-- MDS usage!!!
stashseq: StashSeq _ NIL;
-- endof mds usage


-- uses linear lookup, should use a hash of some sort
Lookup: PUBLIC ENTRY PROC[create: LONG CARDINAL, fileName: LONG STRING] 
	RETURNS[depseq: Dir.DepSeq] = {
ENABLE UNWIND => NULL;
RETURN[InternalLookup[create, fileName]];
};

InternalLookup: INTERNAL PROC[create: LONG CARDINAL, fileName: LONG STRING] 
	RETURNS[depseq: Dir.DepSeq] = {
st: ST;
InternalInit[];
IF create = 0 THEN ERROR;
FOR i: CARDINAL IN [0 .. stashseq.size) DO
	st _ @stashseq[i];
	IF create = st.create 
	AND LongString.EquivalentString[fileName, st.fileName] THEN {
		stashseq.nhits _ stashseq.nhits + 1;
		RETURN[st.depseq];
		};
	ENDLOOP;
stashseq.nmisses _ stashseq.nmisses + 1;
RETURN[NIL];
};

BcdVersLookup: PUBLIC ENTRY PROC[bcdVers: TimeStamp.Stamp] RETURNS[depseq: Dir.DepSeq] = {
ENABLE UNWIND => NULL;
st: ST;
InternalInit[];
IF bcdVers = TimeStamp.Null THEN ERROR;
FOR i: CARDINAL IN [0 .. stashseq.size) DO
	st _ @stashseq[i];
	IF bcdVers = st.bcdVers THEN {
		stashseq.nhits _ stashseq.nhits + 1;
		RETURN[st.depseq];
		};
	ENDLOOP;
stashseq.nmisses _ stashseq.nmisses + 1;
RETURN[NIL];
};

Insert: PUBLIC ENTRY PROC[create: LONG CARDINAL, fileName: LONG STRING, depseq: Dir.DepSeq] 
	RETURNS[newdepseq: Dir.DepSeq] = {
ENABLE UNWIND => NULL;
RETURN[InternalInsert[create, fileName, depseq]];
};

-- it is an error to Insert something that is already in the cache
InternalInsert: INTERNAL PROC[create: LONG CARDINAL, fileName: LONG STRING, depseq: Dir.DepSeq] 
	RETURNS[newdepseq: Dir.DepSeq] = {
newdepseq _ depseq;
InternalInit[];
FOR i: CARDINAL IN [0 .. stashseq.size) DO
	IF create = stashseq[i].create 
	AND LongString.EquivalentString[fileName, stashseq[i].fileName] THEN ERROR;
	ENDLOOP;
IF stashseq.size >= stashseq.maxsize THEN {
	CWF.WF0["Error - have run out of stash slots.\n"L];
	RETURN;
	};
stashseq[stashseq.size].create _ create;
stashseq[stashseq.size].fileName _ SpecialCopyString[fileName];
stashseq[stashseq.size].bcdVers _ IF depseq.fromsource THEN TimeStamp.Null 
				  ELSE depseq.bcdVers;	-- may be Null
IF depseq ~= stashseq.temporarydepseq THEN ERROR;
-- this allows us to insert only pieces that are really being used
newdepseq _ AllocateDepSeq[depseq.size];
Inline.LongCOPY[to: newdepseq, from: depseq, 
	nwords: SIZE[Dir.DepSeqRecord[depseq.size]]];
depseq.bcdVers _ TimeStamp.Null;
depseq.size _ 0;
depseq.bcdFileName _ depseq.srcFileName _ depseq.moduleName _ NIL;
stashseq[stashseq.size].depseq _ newdepseq;
stashseq.size _ stashseq.size + 1;
};

GetTemporaryDepSeq: PUBLIC ENTRY PROC RETURNS[Dir.DepSeq] = {
ENABLE UNWIND => NULL;
RETURN[stashseq.temporarydepseq];
};

-- in what follows, I use a different Heap (stashseq.stashzone)
-- for the DepSeqRecord and the Strings in it.  
-- A homebuilt Heap is used for the DepSeqRecords, StashSeq's, and strings in it.

SpecialCopyString: PROC[old: LONG STRING, zone: UNCOUNTED ZONE _ NIL] 
	RETURNS[new: LONG STRING] = {
hugezone: UNCOUNTED ZONE _ stashseq.stashzone;
IF old = NIL THEN ERROR;
new _ hugezone.NEW[StringBody[old.length]
	_ StringBody[length: 0, maxlength: old.length, text:] ];
Subr.strcpy[new, old];
};

InternalInit: INTERNAL PROC = {
stashzone: UNCOUNTED ZONE;
IF stashseq ~= NIL THEN RETURN;
stashzone _ Subr.HugeZone[];
stashseq _ stashzone.NEW[StashSeqRecord[STASHSIZE]];
stashseq.stashzone _ stashzone;
stashseq.temporarydepseq _ AllocateDepSeq[Dir.MaximumDepSize];
};

-- utility procedures
AllocateDepSeq: PROC[size: CARDINAL] RETURNS[depseq: Dir.DepSeq] = {
depseq _ stashseq.stashzone.NEW[Dir.DepSeqRecord[size]];
-- this so we can be sure we have the right strings
depseq.CopyString _ SpecialCopyString;
};

SetNLeaders: PUBLIC ENTRY PROC = {
InternalInit[];
Subr.numberofleaders _ 0;
};

GetNLeaders: PUBLIC PROC RETURNS[nleaders: CARDINAL] = {
RETURN[Subr.numberofleaders];
};

SetNHits: PUBLIC ENTRY PROC = {
InternalInit[];
stashseq.nhits _ stashseq.nmisses _ 0;
};

GetNHits: PUBLIC PROC RETURNS[nhits, nmisses: LONG CARDINAL]= {
RETURN[stashseq.nhits, stashseq.nmisses];
};

PrintSeparatorLine: PROC[wfproc: PROC[CHAR]] = {
CWF.FWF0[wfproc, "-----------------\n"L];
};

ForceOut: PUBLIC ENTRY PROC RETURNS[npages: CARDINAL] = {
IF stashseq ~= NIL THEN 
	npages _ Subr.PagesUsedInHugeZone[stashseq.stashzone]
ELSE npages _ 0;
};

-- these are the two commands available in the SimpleExec
Flush: PUBLIC ENTRY UserExec.CommandProc = TRUSTED {
ENABLE UNWIND => NULL;
MyPutChar: PROC[ch: CHAR] = {
	out.PutChar[ch];
	};
out: IO.Handle = exec.GetStreams[].out;
[] _ CWF.SetWriteProcedure[MyPutChar];
stashseq _ NIL;
Subr.SubrStop[];
CWF.WF0["Dependency Cache Flushed.\n"L];
};

Stat: UserExec.CommandProc = TRUSTED {
MyPutChar: PROC[ch: CHAR] = {
	out.PutChar[ch];
	};
out: IO.Handle = exec.GetStreams[].out;
[] _ CWF.SetWriteProcedure[MyPutChar];
CWF.WF1["Cache has %u entries:\n"L, @stashseq.size];
FOR i: CARDINAL IN [0 .. stashseq.size) DO
	s: LONG STRING;
	depseq: Dir.DepSeq;
	depseq _ stashseq[i].depseq;
	s _ IF depseq.bcdFileName ~= NIL THEN depseq.bcdFileName
	    ELSE IF depseq.srcFileName ~= NIL THEN depseq.srcFileName
	    ELSE depseq.moduleName;
	CWF.WF1["%s "L, s];
	IF UserExec.UserAbort[exec] THEN SIGNAL Subr.AbortMyself;
	ENDLOOP;
CWF.WFCR[];
};

PrintEntry: UserExec.CommandProc = TRUSTED {
out: IO.Handle = exec.GetStreams[].out;
depseq: Dir.DepSeq;
filename: STRING _ [100];
argv: UECP.Argv _ UECP.Parse[event.commandLine];
MyPutChar: PROC[ch: CHAR] = {
	out.PutChar[ch];
	};
[] _ CWF.SetWriteProcedure[MyPutChar];
FOR parm: CARDINAL IN [1 .. argv.argc) DO
	flat: Rope.Text _ RopeInline.InlineFlatten[argv[parm]];
	Subr.strcpy[filename, LOOPHOLE[flat]];
	IF NOT Subr.Any[filename, '.] THEN LongString.AppendString[filename, ".Bcd"L];
	FOR i: CARDINAL IN [0 .. stashseq.size) DO
		depseq _ stashseq[i].depseq;
		IF UserExec.UserAbort[exec] THEN SIGNAL Subr.AbortMyself;
		IF (depseq.bcdFileName ~= NIL 
		AND LongString.EquivalentString[depseq.bcdFileName, filename])
		OR (depseq.srcFileName  ~= NIL 
		AND LongString.EquivalentString[depseq.srcFileName, filename]) THEN {
			CWF.WF3["Entry under (%s, %lt, %lt):\n"L, stashseq[i].fileName, 
				@stashseq[i].create, @stashseq[i].bcdVers.time];
			PrintDepSeq[depseq, exec.GetStreams[].out];
			CWF.WFCR[];
			};
		REPEAT
		FINISHED => 
			CWF.WF1["Can't find %s in DB cache.\n"L, filename];
		ENDLOOP;
	ENDLOOP;
};

PrintDepSeq: PROC[depseq: Dir.DepSeq, window: IO.Handle] = {
zero: STRING _ "(Zero)"L;
tstr: STRING _ [30];

	WFPut: PROC[ch: CHAR] = {
	window.PutChar[ch];
	};
	
	Cvt: PROC[time: LONG CARDINAL] RETURNS[str: STRING] = {
	IF time = 0 THEN RETURN[zero]
	ELSE CWF.SWF1[tstr, "%lt"L, @time];
	RETURN[tstr];
	};
	
IF depseq.bcdFileName ~= NIL THEN
	CWF.FWF2[WFPut, "Bcd file %s of %s\n"L, depseq.bcdFileName, Cvt[depseq.bcdVers.time]];
IF depseq.srcFileName ~= NIL THEN {
	IF depseq.bcdFileName ~= NIL THEN CWF.FWF0[WFPut, "  "L];
	CWF.FWF2[WFPut, "Source file %s of %s\n"L, depseq.srcFileName, Cvt[depseq.srcCreate]];
	};
CWF.FWF1[WFPut, "ModuleName %s\n"L, depseq.moduleName];
CWF.FWF4[WFPut, "   defns %s, config %s, fromsource %s, istablecompiled %s.\n"L, 
	IF depseq.isdefns THEN "T"L ELSE "F"L,
	IF depseq.isconfig THEN "T"L ELSE "F"L,
	IF depseq.fromsource THEN "T"L ELSE "F"L,
	IF depseq.istablecompiled THEN "T"L ELSE "F"L];
FOR i: CARDINAL IN [0 .. depseq.size) DO
	CWF.FWF1[WFPut, "     %s "L, 
		SELECT depseq[i].relation FROM
		imports => "Imports:  "L,
		exports => "Exports:  "L,
		directory => "Directory:"L,
		ENDCASE => ERROR];
	CWF.FWF3[WFPut, "%s of %s (%s),\n"L, 
		depseq[i].bcdFileName, Cvt[depseq[i].bcdVers.time], depseq[i].moduleName];
	ENDLOOP;
};

OnceInit: PROC = {
Subr.SubrInit[256];
UserExec.RegisterCommand["XDBFlush.~", Flush];
UserExec.RegisterCommand["XDBPrint.~", PrintEntry];
UserExec.RegisterCommand["XDBStat.~", Stat];
};

-- the start code
OnceInit[];
}.