-- SMDFImpl.mesa
-- last edited by Schmidt June 1, 1983 5:45 pm
-- last edited by Satterthwaite, August 8, 1983 11:22 am

DIRECTORY
  ConvertUnsafe: TYPE USING [ToRope],
  CS: TYPE USING [RopeToString],
  DFSubr: TYPE USING [AllocateDFSeq, DF, DFSeq, FreeDFSeq, LookupDF, NextDF, WriteOut],
  FileStream: TYPE USING [GetLeaderPropertiesForCapability],
  IO: TYPE USING [PutF, string],
  Rope: TYPE USING [Fetch, IsEmpty, Length, ROPE, Text],
  SMCommentTableOps: TYPE USING [FindNext],
  SMDF: TYPE USING [],
  SMEval: TYPE USING [CompMod],
  SMFI: TYPE USING [BcdFileInfo, SrcFileInfo],
  SMFIOps: TYPE USING [GetExtFromParse],
  SMOps: TYPE USING [MS],
  SMTree: TYPE Tree USING [Handle, Link],
  SMTreeOps: TYPE USING [Scan, ScanSons],
  Stream: TYPE USING [Delete, Handle, PutChar],
  Subr: TYPE USING [CopyString, NewStream, SubrStop, Write],
  ViewerClasses: TYPE USING [Viewer],
  ViewerOps: TYPE USING [FindViewer, RestoreViewer];


SMDFImpl: CEDAR MONITOR 
    IMPORTS
      ConvertUnsafe, CS, DFSubr, FileStream, IO, Rope, SMCommentTableOps, SMFIOps,
      SMTreeOps, Stream, Subr, ViewerOps
    EXPORTS SMDF ~ {

 -- monitor is used to protect the DF software, which cannot
 -- be called in parallel

  ConstructDFFile: PUBLIC ENTRY PROC[ms: SMOps.MS, top: SMTree.Link] ~ TRUSTED {
    ENABLE UNWIND => NULL;
    dfFileName: STRING _ "Manufactured.DF"L;
    dfseq: DFSubr.DFSeq;
    sh: Stream.Handle;
    viewer: ViewerClasses.Viewer;
    comment: Rope.ROPE;
	
    AnalSons: SMTreeOps.Scan ~ TRUSTED {
      WITH t SELECT FROM
	applyNode: SMTree.Handle =>
	  SELECT applyNode.name FROM
	    $apply => {
	      ext: SMTree.Link _ SMFIOps.GetExtFromParse[applyNode];
	      IF ext ~= NIL AND ISTYPE[ext, SMEval.CompMod] THEN { 
		compMod: SMEval.CompMod _ NARROW[ext];
		AddToDFFile[ms, dfseq, compMod]};
	      SMTreeOps.ScanSons[applyNode, AnalSons]};
	    ENDCASE => SMTreeOps.ScanSons[applyNode, AnalSons];
	ENDCASE => NULL;
      };

    dfseq _ DFSubr.AllocateDFSeq[maxEntries~500, zoneType~shared];
    SMTreeOps.ScanSons[top, AnalSons];
    sh _ Subr.NewStream[dfFileName, Subr.Write];
    DFSubr.WriteOut[dfseq~dfseq, topLevelFile~NIL, outputStream~sh];
    -- now add first comment for Imports, etc.
    comment _ SMCommentTableOps.FindNext[ms.comments, 0].text;
    -- the first two chars are skipped, they are undoubtedly - followed by -
    FOR i: INT IN [2 .. comment.Length[]) DO Stream.PutChar[sh, comment.Fetch[i]] ENDLOOP;
    Stream.Delete[sh];
    DFSubr.FreeDFSeq[@dfseq];
    viewer _ ViewerOps.FindViewer[ConvertUnsafe.ToRope[dfFileName]];
    IF viewer ~= NIL THEN {
      IF viewer.newVersion THEN 
	ms.out.PutF["Warning - you are already editing %s.\n", IO.string[dfFileName]]
      ELSE ViewerOps.RestoreViewer[viewer]};
    ms.out.PutF["DF file written on file Manufactured.DF\n"];
    Subr.SubrStop[];	-- shuts down old DF world
    };
	
  AddToDFFile: PROC[
      ms: SMOps.MS, dfseq: DFSubr.DFSeq, compMod: SMEval.CompMod] ~ TRUSTED {
    fiSrc: SMFI.SrcFileInfo _ compMod.fiSrc;
    fiBcd: SMFI.BcdFileInfo _ compMod.fiBcd;
    createtime: LONG CARDINAL _ 0;
    AddAFile[ms, dfseq, fiSrc.host, fiSrc.directory, fiSrc.shortname, fiSrc.version];
    IF fiBcd.bcdPresent THEN
      createtime _ FileStream.GetLeaderPropertiesForCapability[fiBcd.bcdCap].create;
    AddAFile[ms, dfseq, fiBcd.host, fiBcd.directory, fiBcd.shortname, createtime]};
	
  AddAFile: PROC[
      ms: SMOps.MS, dfseq: DFSubr.DFSeq,
      host, directory, shortname: Rope.Text, createTime: LONG CARDINAL] ~ TRUSTED {
    df: DFSubr.DF;
    str: STRING _ [100];
    CS.RopeToString[to~str, from~shortname];
    IF DFSubr.LookupDF[dfseq, str] ~= NIL THEN RETURN;
    df _ DFSubr.NextDF[dfseq];
    IF df = NIL THEN RETURN; 	-- too big
    df.host _ Subr.CopyString[
	IF Rope.IsEmpty[host] THEN "Unknown"L ELSE LOOPHOLE[host], dfseq.dfzone];
    df.directory _ Subr.CopyString[
	IF Rope.IsEmpty[directory] THEN "Unknown"L ELSE LOOPHOLE[directory], dfseq.dfzone];
    df.shortname _ Subr.CopyString[LOOPHOLE[shortname], dfseq.dfzone];
    df.version _ 0;
    df.createtime _ createTime};
	
  }.