-- SMFIImpl.mesa, June 17, 1983 9:50 am
-- last edit by Schmidt May 24, 1983 11:11 am
-- last edit by Satterthwaite, August 11, 1983 2:36 pm

DIRECTORY
  Atom: TYPE USING [MakeAtom],
  BcdDefs: TYPE USING [
    Base, EXPIndex, FTIndex, IMPIndex, MTIndex, Namee, NameRecord, NullName],
  BcdOps: TYPE USING [
    BcdBase, EXPHandle, IMPHandle, MTHandle, NameString,
    FindName, ProcessExports, ProcessImports, ProcessModules],
  CS: TYPE USING [CardFromRope, EndsIn, RopeFromStamp, StampFromRope, z],
  CtoSP1: TYPE --P1-- USING [InstallParseTable, Parse],
  CtoSParseData: TYPE,
  Directory: TYPE USING [Error, ignore, Lookup],
  File: TYPE USING [Capability, nullCapability],
  FileIO: TYPE USING [Open, OpenFailed],
  FileSegment: TYPE USING [],
  FileStream: TYPE USING [GetLeaderPropertiesForCapability],
  IO: TYPE USING [
    card, Close, Put, PutF, rope, string, STREAM, UserAbort, UserAborted],
  Rope: TYPE USING [Cat, Equal, Fetch, Flatten, FromProc, Length, Lower, ROPE, Text],
  Runtime: TYPE USING [GetTableBase],
  SMEval: TYPE USING [Eval],
  SMFI: TYPE USING [BcdFileInfo, BcdFileInfoRecord, SrcFileInfo, SrcFileInfoRecord],
  SMFIOps: TYPE USING [],
  SMOps: TYPE USING [MS],
  SMTree: TYPE Tree USING [Link, null],
  SMTreeOps: TYPE USING [PopTree],
  SMTypeCons: TYPE USING [
    MkArrow, MkControlType, MkCrossReverse, MkCross2, MkDeclElem, MkDeclReverse,
    MkInterfaceType, MkStampType],
  SMUtil: TYPE USING [PrintSubTree],
  Space: TYPE USING [
    Create, CreateUniformSwapUnits, Delete, Handle, LongPointer, MakeReadOnly,
    Map, virtualMemory],
  TimeStamp: TYPE USING [Null, Stamp],
  UECP: TYPE USING [Argv, Parse],
  UserExec: TYPE USING [CommandProc, GetStreams, RegisterCommand];
	
SMFIImpl: CEDAR MONITOR 
    IMPORTS
      Atom, BcdOps, CS, CtoSP1, CtoSParseData, Directory, FileIO, FileStream, IO,
      Rope, Runtime, SMEval, SMTreeOps, SMTypeCons, SMUtil,
      Space, UECP, UserExec
    EXPORTS SMFIOps ~ {
  OPEN Tree~~SMTree;

-- code in this module updates the FI tables
-- therefore most PUBLIC procedures acquire the monitor lock

 -- MDS usage
 -- these data structures are protected by the monitor lock
  srcFiList: SMFI.SrcFileInfo _ NIL;
  bcdFiList: SMFI.BcdFileInfo _ NIL;
 -- endof MDS

-- code to manipulate the FI's

  Flush: PUBLIC ENTRY PROC ~ {
    ENABLE UNWIND => {NULL};
    srcFiList _ NIL;
    bcdFiList _ NIL};
	
  Reset: PUBLIC ENTRY PROC ~ {
    ENABLE UNWIND => {NULL};
    FOR srcFi: SMFI.SrcFileInfo _ srcFiList, srcFi.link UNTIL srcFi = NIL DO
      srcFi.capability _ File.nullCapability;
      srcFi.state _ MAX[srcFi.state, $analyzed];
      ENDLOOP;
    FOR bcdFi: SMFI.BcdFileInfo _ bcdFiList, bcdFi.link UNTIL bcdFi = NIL DO
      bcdFi.capability _ File.nullCapability;
      bcdFi.state _ MAX[bcdFi.state, $analyzed];
      ENDLOOP;
    };
	

  FindSource: PUBLIC ENTRY PROC[create: LONG CARDINAL_0]
      RETURNS[fi: SMFI.SrcFileInfo] ~ {
    ENABLE UNWIND => {NULL};
    IF create # 0 THEN
      FOR srcFi: SMFI.SrcFileInfo _ srcFiList, srcFi.link UNTIL srcFi = NIL DO
	IF srcFi.create = create THEN RETURN[srcFi]
	ENDLOOP;
    fi _ (CS.z).NEW[SMFI.SrcFileInfoRecord _ [create~create, state~$empty, link~srcFiList]];
    srcFiList _ fi};

  NewestSource: PUBLIC PROC[srcFileName: Rope.Text]
      RETURNS[fi: SMFI.SrcFileInfo] ~ TRUSTED {
    cap: File.Capability;
    none: BOOL _ FALSE;
    cap _ Directory.Lookup[fileName~LOOPHOLE[srcFileName], permissions~Directory.ignore
	! Directory.Error => {none _ TRUE; CONTINUE}];
    RETURN[FindSource[IF none THEN 0 ELSE CreateFromCap[cap]]]};

    
  FindBcd: PUBLIC ENTRY PROC[stamp: TimeStamp.Stamp_TimeStamp.Null]
      RETURNS[fi: SMFI.BcdFileInfo] ~ {
    ENABLE UNWIND => {NULL};
    IF stamp # TimeStamp.Null THEN
      FOR bcdFi: SMFI.BcdFileInfo _ bcdFiList, bcdFi.link UNTIL bcdFi = NIL DO
	IF bcdFi.stamp = stamp THEN RETURN[bcdFi]
	ENDLOOP;
    fi _ (CS.z).NEW[SMFI.BcdFileInfoRecord _ [stamp~stamp, state~$empty, link~bcdFiList]];
    bcdFiList _ fi};
	
  FindBcdByName: PUBLIC PROC[bcdFileName: Rope.Text] RETURNS[fi: SMFI.BcdFileInfo] ~ {
    FOR bcdFi: SMFI.BcdFileInfo _ bcdFiList, bcdFi.link UNTIL bcdFi = NIL DO
      IF bcdFileName.Equal[bcdFi.localName, FALSE] THEN RETURN[bcdFi]
      ENDLOOP;
    RETURN[NIL]};
	
  PrintFileInfo: ENTRY UserExec.CommandProc ~ TRUSTED {
    ENABLE UNWIND => {NULL};
    argv: UECP.Argv ~ UECP.Parse[event.commandLine];
    in, out: IO.STREAM;
    [in, out] _ UserExec.GetStreams[exec];
    FOR i: CARDINAL IN [1 .. argv.argc) DO
      PrintEntries[argv[i].Flatten[], in, out];
      ENDLOOP;
    IF argv.argc = 1 THEN PrintEntries[NIL, in, out]};	-- no args

 -- prints all if rope = NIL
  PrintEntries: PROC[rope: Rope.Text, in, out: IO.STREAM] ~ {
    FOR srcFi: SMFI.SrcFileInfo _ srcFiList, srcFi.link UNTIL srcFi = NIL DO
      IF rope = NIL OR rope.Equal[srcFi.shortName, FALSE] THEN {
	out.PutF["Entry: %s!(%t)", IO.rope[srcFi.localName], IO.card[srcFi.create]];
	IF srcFi.state = $opened THEN out.Put[IO.string[", present"L]];
	out.Put[IO.string["\n  type:"L]];
	SMUtil.PrintSubTree[out, srcFi.type, 4];
	out.Put[IO.string["\n\n"L]];
	IF in.UserAbort THEN ERROR IO.UserAborted[NIL, NIL]};
      ENDLOOP;
    FOR bcdFi: SMFI.BcdFileInfo _ bcdFiList, bcdFi.link UNTIL bcdFi = NIL DO
      IF rope = NIL OR rope.Equal[bcdFi.shortName, FALSE] THEN {
	out.PutF[
	  "Entry: %s!%s", IO.rope[bcdFi.localName], IO.rope[CS.RopeFromStamp[bcdFi.stamp]]];
	IF bcdFi.state = $opened THEN out.Put[IO.string[", present"L]];
	out.Put[IO.string["\n  type:"L]];
	SMUtil.PrintSubTree[out, bcdFi.type, 4];
	out.Put[IO.string["\n\n"L]];
	IF in.UserAbort[] THEN ERROR IO.UserAborted[NIL, NIL]};
      ENDLOOP;
    };
	
-- code to read in and analyze files
-- each inner procedure acquires ML

  EvaluateUnitId: PUBLIC PROC[ms: SMOps.MS, unitId, version: Rope.ROPE] 
	RETURNS[value: SMTree.Link] ~ {
    ENABLE UNWIND => {NULL};
    shortName: Rope.Text ~ unitId.Flatten[];		-- for now
    IF CS.EndsIn[shortName, ".mesa"] THEN {
      fi: SMFI.SrcFileInfo ~ IF Ambiguous[version]
        THEN NewestSource[shortName] ELSE FindSource[CS.CardFromRope[version]];
      IF fi.state >= $analyzed THEN RETURN[fi];
      fi.host _ fi.directory _ NIL;  fi.shortName _ shortName;  fi.version _ 0;
      FillSource[fi];
      IF fi.state = $opened THEN AddCedarInfo[ms, fi];
      RETURN[fi]}
    ELSE IF CS.EndsIn[shortName, ".bcd"] THEN {
      fi: SMFI.BcdFileInfo;
      IF Ambiguous[version] THEN {
        fi _ FindBcdByName[shortName];
        IF fi = NIL THEN fi _ FindBcd[TimeStamp.Null]}
      ELSE fi _ FindBcd[CS.StampFromRope[version]];
      IF fi.state >= $analyzed THEN RETURN[fi];
      fi.host _ fi.directory _ NIL;  fi.shortName _ shortName;  fi.version _ 0;
      FillBcd[ms, fi];
      RETURN[fi]}
    ELSE IF CS.EndsIn[shortName, ".model"] THEN {
      ERROR}		-- do nothing for now
    ELSE ERROR};

  Ambiguous: PUBLIC PROC[version: Rope.ROPE] RETURNS[BOOL] ~ {
    RETURN[version = NIL OR (version.Length = 1 AND Rope.Lower[version.Fetch[0]] = 'h)]};
   

 -- fills in src for .mesa
  FillSource: PUBLIC ENTRY PROC[fi: SMFI.SrcFileInfo] ~ TRUSTED {
    cap: File.Capability;
    failed: BOOL _ FALSE;
    fi.localName _ fi.shortName;
    RetrieveRemoteSrcFile[fi];	-- place holder
    cap _ Directory.Lookup[
	fileName~LOOPHOLE[fi.localName], permissions~Directory.ignore
	    ! Directory.Error => {failed _ TRUE; CONTINUE}];
    IF ~failed THEN {
      create: LONG CARDINAL ~ CreateFromCap[cap];
      IF fi.create = 0 THEN fi.create _ create
      ELSE IF fi.create # create THEN failed _ TRUE};
    IF failed THEN {fi.capability _ File.nullCapability; fi.state _ MAX[fi.state, $analyzed]}
    ELSE {fi.capability _ cap; fi.state _ $opened}};

 -- fills in bcd for .bcd in model
  FillBcd: ENTRY PROC[ms: SMOps.MS, fi: SMFI.BcdFileInfo] ~ TRUSTED {
    rn: Rope.Text ~ GetRootName[fi.shortName];
    failed: BOOL _ FALSE;
    fi.localName _ rn.Cat[".bcd"].Flatten[];
    RetrieveRemoteBcdFile[fi];	-- place holder
    fi.capability _ Directory.Lookup[
	fileName~LOOPHOLE[fi.localName], permissions~Directory.ignore
	    ! Directory.Error => {failed _ TRUE; CONTINUE}];
    -- note that version stamp is not validated here
    IF failed THEN fi.state _ MAX[fi.state, $analyzed]
    ELSE IF fi.state = $analyzed THEN fi.state _ $opened		-- stamp not verified
    ELSE IF AddBcdInfo[ms, fi].success THEN fi.state _ $opened};	-- stamp verified

  GetRootName: PROC[name: Rope.Text] RETURNS[root: Rope.Text] ~ {
    i: CARDINAL _ name.Length - 1;
    WHILE i > 0 AND name.Fetch[i] ~= '. DO i _ i-1 ENDLOOP;
    root _ IF i > 0 THEN name.Flatten[0, i] ELSE name;
    RETURN};

  CreateFromCap: PROC[cap: File.Capability] RETURNS[LONG CARDINAL] ~ TRUSTED {
    RETURN[FileStream.GetLeaderPropertiesForCapability[cap].create]};

  RetrieveRemoteSrcFile: PROC[fi: SMFI.SrcFileInfo] ~ {};
  RetrieveRemoteBcdFile: PROC[fi: SMFI.BcdFileInfo] ~ {};


  -- code to analyze bcds and srcs
  
  -- for Mesas

  AddCedarInfo: ENTRY PROC[ms: SMOps.MS, fi: SMFI.SrcFileInfo] ~ {
    in: IO.STREAM _ NIL;
    in _ FileIO.Open[fi.shortName ! FileIO.OpenFailed => {CONTINUE}];
    IF in = NIL THEN fi.type _ Tree.null
    ELSE {
      complete: BOOL;
      nTokens, nErrors: NAT;
      TRUSTED {[complete, nTokens, nErrors] _ CtoSP1.Parse[ms, in]};
      fi.type _ IF complete --AND nErrors = 0--
        THEN SMEval.Eval[ms, (ms.tm).PopTree, NIL]
        ELSE Tree.null;
      IF nErrors # 0 THEN {
        (ms.out).PutF["%s was not parsed successfully\n", IO.rope[fi.shortName]];
        fi.type _ Tree.null};
      in.Close[]}
    };
		
-- for Bcds

  -- imports and exports are partially uncheckable (not enough info in Bcd)

  AddBcdInfo: PROC[ms: SMOps.MS, fi: SMFI.BcdFileInfo] RETURNS[success: BOOL]~ TRUSTED {
    LinkList: TYPE ~ LIST OF Tree.Link;
    d, m, r: LinkList _ NIL;
    range: Tree.Link;
    bcdBase: BcdOps.BcdBase _ NIL;
    nameString: BcdOps.NameString;
    ftb: BcdDefs.Base;
    sgb: BcdDefs.Base;

    UnitList: PROC[l: LIST OF Tree.Link] RETURNS[BOOL] ~ CHECKED INLINE {
      RETURN[l # NIL AND l.first = NIL]};
      
    NameToRope: PROC[name: BcdDefs.NameRecord] RETURNS[Rope.Text] ~ TRUSTED {
      i: CARDINAL _ 0;
      
      EachChar: PROC RETURNS[c: CHAR] ~ TRUSTED {
        c _ nameString.string.text[name+i]; i _ i+1; RETURN};
        
      RETURN[Rope.FromProc[nameString.size[name], EachChar].Flatten]};

    NameeToRope: PROC[namee: BcdDefs.Namee] RETURNS[Rope.Text] ~ TRUSTED {
      name: BcdDefs.NameRecord ~ BcdOps.FindName[bcdBase, namee];
      RETURN[IF name = BcdDefs.NullName THEN NIL ELSE NameToRope[name]]};
    
    {
    space: Space.Handle;

    ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
	RETURNS[stop: BOOL_FALSE] ~ TRUSTED {
      name: ATOM ~ Atom.MakeAtom[NameToRope[mth.name]];
      type: Tree.Link ~ SMTypeCons.MkInterfaceType[ms.tm, name];
      IF bcdBase.definitions THEN r _ (ms.z).CONS[type, r]
      ELSE {
        m _ (ms.z).CONS[SMTypeCons.MkDeclElem[ms.tm, name, type], m];	-- for cross2
        r _ (ms.z).CONS[name, r]};	-- programs export instances
      };
	
    ForEachImport: PROC[ith: BcdOps.IMPHandle, iti: BcdDefs.IMPIndex] 
	RETURNS[stop: BOOL_FALSE] ~ TRUSTED {
      name: ATOM ~ Atom.MakeAtom[
        IF ith.namedInstance THEN NameeToRope[[import[iti]]]
        ELSE NameToRope[ith.name].Cat["Impl"]];
      type: Tree.Link ~ SMTypeCons.MkStampType[ms.tm, ftb[ith.file].version];
      d _ (ms.z).CONS[SMTypeCons.MkDeclElem[ms.tm, name, type], d]};
	
    ForEachExport: PROC[eth: BcdOps.EXPHandle, eti: BcdDefs.EXPIndex]
	RETURNS[stop: BOOL_FALSE] ~ TRUSTED {
      r _ (ms.z).CONS[SMTypeCons.MkStampType[ms.tm, ftb[eth.file].version], r]};
	
    [space, bcdBase] _ LoadUpBcd[fi.capability];
    success _ (fi.stamp = bcdBase.version OR fi.stamp = TimeStamp.Null);
    IF success THEN {
      nameString _ LOOPHOLE[bcdBase + bcdBase.ssOffset];
      ftb _ LOOPHOLE[bcdBase, BcdDefs.Base] + bcdBase.ftOffset;
      sgb _ LOOPHOLE[bcdBase, BcdDefs.Base] + bcdBase.sgOffset;
      fi.stamp _ bcdBase.version;
      [] _ BcdOps.ProcessModules[bcdBase, ForEachModule];
      [] _ BcdOps.ProcessImports[bcdBase, ForEachImport];
      [] _ BcdOps.ProcessExports[bcdBase, ForEachExport];
      IF ~bcdBase.definitions THEN {
	-- implementors export a variable of type CONTROL as well
	r _ (ms.z).CONS[SMTypeCons.MkControlType[ms.tm], r]};
      range _ IF UnitList[r] THEN r.first ELSE SMTypeCons.MkCrossReverse[ms.tm, r];
      IF ~bcdBase.definitions THEN {
	range _ SMTypeCons.MkCross2[
		  tm~ms.tm,
		  decl~SMTypeCons.MkDeclReverse[ms.tm, m],
		  type~range];
	};
      fi.type _ SMEval.Eval[
    		    ms,
    		    SMTypeCons.MkArrow[
			tm~ms.tm,
			domain~SMTypeCons.MkDeclReverse[ms.tm, d], 
			range~range],
		    NIL];
      };
    Space.Delete[space]}};


  LoadUpBcd: PROC[cap: File.Capability]
      RETURNS[space: Space.Handle, bcdBase: BcdOps.BcdBase] ~ TRUSTED {
    nPages: CARDINAL _ 10;
    IF cap = File.nullCapability THEN ERROR;
    DO
      space _ Space.Create[size~nPages, parent~Space.virtualMemory];
      space.Map[window~[file~cap, base~1]];
      bcdBase _ space.LongPointer;
      IF bcdBase.nPages <= nPages THEN EXIT;
      nPages _ bcdBase.nPages;
      Space.Delete[space];
      ENDLOOP;
    Space.CreateUniformSwapUnits[parent~space, size~8];	-- good idea?
    space.MakeReadOnly};

  InitModule: PROC ~ {
    TRUSTED {CtoSP1.InstallParseTable[Runtime.GetTableBase[LOOPHOLE[CtoSParseData]]]};
    UserExec.RegisterCommand["YFIPrint", PrintFileInfo]};

  InitModule[];

  }.