-- File: AltoDirectory.mesa
-- Last edited by Levin:  12-Apr-83 13:16:38

DIRECTORY
  AltoDefs USING [BytesPerWord, PageSize],
  AltoFile USING [
    CFP, CreateFile, DEfile, DEfree, DV, DVPtr, fileNameChars, FP, FPPtr, LookupAction,
    VersionOption],
  AltoFilePrivate USING [DirHandle, DirObject],
  DiskIODefs USING [fillInvDA, vDA],
  FileDefs USING [ComparePositions, IncrementPosition, Position],
  Inline USING [COPY],
  StringDefs USING [
    AppendChar, BcplSTRING, BcplToMesaString, EquivalentString,
    MesaToBcplString, StringBoundsFault, WordsForBcplString],
  VMDefs USING [
    FileHandle, GetFileLength, Mark, MarkStart, Page, PageAddress, PageNumber,
    Position, ReadPage, Release, Start, SetFileLength, WaitFile];

AltoDirectory: MONITOR LOCKS dir.LOCK USING dir: AltoFilePrivate.DirHandle
  IMPORTS AltoFile, FileDefs, Inline, StringDefs, VMDefs
  EXPORTS AltoFile, AltoFilePrivate =

  BEGIN OPEN AltoFile, AltoFilePrivate, FileDefs;

  -- Miscellaneous Declarations --

  LookupType: TYPE = {name, fp};

  BadDirectory: ERROR = CODE;

  bcplNameSize: CARDINAL = -- WordsForBcplString[fileNameChars] -- 20;

  DEugly: CARDINAL = DEfile + 1;


  -- Types Exported to AltoFile --

  DirObject: PUBLIC TYPE = AltoFilePrivate.DirObject;


  -- Procedures and Signals Exported to AltoFile --

  MapFileNameToFP: PUBLIC PROCEDURE [name: STRING, version: VersionOption,
    leadervDA: DiskIODefs.vDA _ DiskIODefs.fillInvDA]
    RETURNS [fp: FP] =
    BEGIN
    SELECT version FROM
      old => IF ~Lookup[sysDir, name, @fp].found THEN ERROR NoSuchFile;
      new =>
	IF ~Lookup[sysDir, name, @fp, [new[leadervDA]]].new THEN
	  ERROR FileAlreadyExists;
      oldOrNew => [] _ Lookup[sysDir, name, @fp, [new[leadervDA]]];
      ENDCASE;
    END;

  NoSuchFile: PUBLIC ERROR = CODE;
  FileAlreadyExists: PUBLIC ERROR = CODE;
  IllegalFileName: PUBLIC ERROR = CODE;

  Enumerate: PUBLIC ENTRY PROCEDURE [
    dir: DirHandle, proc: PROCEDURE [entry: DVPtr, name: STRING] RETURNS [BOOLEAN]]
    RETURNS [found: BOOLEAN] =
    BEGIN

    PassItOn: PROCEDURE [entry: DVPtr, entryName: STRING, entryPos: Position]
      RETURNS [BOOLEAN] = {RETURN[proc[entry, entryName]]};

    found _ DoEnumerate[dir, PassItOn ! UNWIND => NULL];
    END;

  Lookup: PUBLIC PROCEDURE [
    dir: DirHandle, name: STRING, fp: FPPtr, action: LookupAction _ [old[]]]
    RETURNS [found, new: BOOLEAN] =
    BEGIN
    fullName: STRING _ [fileNameChars];

    DoIt: ENTRY PROCEDURE[dir: DirHandle] =
      BEGIN
      ENABLE UNWIND => NULL;
      [found, ] _ DoLookup[dir, name, fullName, fp];
      IF ~found THEN
	WITH a: action SELECT FROM
	  old => NULL;
	  new =>
	    BEGIN
	    new _ TRUE;
	    fp^ _ CreateFile[fullName, dir.fp, a.leadervDA];
	    InsertEntry[dir, fullName, fp];
	    END;
	  ENDCASE;
     END;

    ValidateAndExpandName[fullName, name];
    new _ FALSE;
    DoIt[dir];
    END;

  LookupFP: PUBLIC ENTRY PROCEDURE [dir: DirHandle, fp: FPPtr, name: STRING]
    RETURNS [found: BOOLEAN] =
    {[found, ] _ DoLookup[dir, fp, name, fp ! UNWIND => NULL]};

  Enter: PUBLIC PROCEDURE [dir: DirHandle, name: STRING, fp: FPPtr]
    RETURNS [entered: BOOLEAN] =
    BEGIN
    fullName: STRING _ [fileNameChars];

    DoIt: ENTRY PROCEDURE [dir: DirHandle] =
      BEGIN
      sinkFP: FP;
      IF (entered _ ~DoLookup[dir, name, fullName, @sinkFP].found) THEN
	InsertEntry[dir, fullName, fp];
      END;

    ValidateAndExpandName[fullName, name];
    DoIt[dir ! UNWIND => NULL];
    END;

  Delete: PUBLIC PROCEDURE [dir: DirHandle, name: STRING, fp: FPPtr _ NIL]
    RETURNS [found: BOOLEAN] =
    BEGIN
    fullName: STRING _ [fileNameChars];
    sinkFP: FP;
    ValidateAndExpandName[fullName, name];
    RETURN[DoDelete[dir, name, fullName, IF fp = NIL THEN @sinkFP ELSE fp]]
    END;

  DeleteFP: PUBLIC PROCEDURE [dir: DirHandle, fp: FPPtr, name: STRING _ NIL]
    RETURNS [found: BOOLEAN] =
    BEGIN
    sink: STRING = [0];
    RETURN[DoDelete[dir, fp, IF name = NIL THEN sink ELSE name, fp]]
    END;


  -- Procedures and Signals Exported to AltoFilePrivate --

  sysDir: PUBLIC DirHandle;

  FlushDirectoryBuffer: PUBLIC PROCEDURE [dir: DirHandle] =
    -- eliminates any cached page buffer.
    BEGIN
    IF dir.buffer ~= NIL THEN
      BEGIN
      VMDefs.Release[dir.buffer];
      dir.buffer _ NIL;
      dir.page _ LAST[VMDefs.PageNumber];
      END;
    END;

  ResetDirectoryLength: PUBLIC PROCEDURE [dir: DirHandle] =
    -- recomputes 'dir.length'.
    BEGIN
    position: VMDefs.Position = VMDefs.GetFileLength[dir.file];
    dir.length _ [position.page, position.byte];
    END;


  -- Internal Procedures --

  -- Lookup, Enter, and Delete Procedures --

  DoLookup: PROCEDURE [dir: DirHandle, type: LookupType, name: STRING, fp: FPPtr]
    RETURNS [found: BOOLEAN, pos: Position] =
    -- If type = name, looks up the given 'name' in 'dir'.  If the name is found, fp^
    -- is filled in with the associated file pointer from the directory, 'found'
    -- becomes TRUE, and 'pos' indicates the location of the entry in the directory.  If
    -- the name is not found, 'fp' is unchanged, 'found' is FALSE, 'pos' is undefined,
    -- and <dir.spaceFA, dir.spaceFound> is a block of free storage in the directory of
    -- possible interest to InsertEntry.  If dir.spaceFound is greater than or equal to
    -- dir.spaceNeeded, the block is wholly contained within the existing directory.  If
    -- not, the directory will require extension to accommodate a new entry of size
    -- dir.spaceNeeded.  If type = fp, this procedure looks up fp^ in 'dir'.  If a
    -- matching entry is found, 'name' has the associated file name stored in it,
    -- 'found' becomes TRUE, and 'pos' indicates the location of the entry in the
    -- directory.  If fp^ is not found, 'name' is unchanged, 'found' is FALSE and
    -- 'pos' is undefined.
    BEGIN

    CheckName: PROCEDURE [entry: DVPtr, entryName: STRING, entryPos: Position]
      RETURNS [BOOLEAN] =
      -- matches a file name entry against fullName.  A match terminates the
      -- enumeration.  As a side effect, this procedure records the location of a free
      -- slot of adequate size to hold the name.
      BEGIN
      match: BOOLEAN _ FALSE;
      SELECT entry.type FROM
	DEfree =>
	  BEGIN
	  IF dir.spaceFound = 0 THEN dir.spacePos _ entryPos;
	  IF dir.spaceFound < dir.spaceNeeded THEN
	    dir.spaceFound _ dir.spaceFound + entry.length;
	  END;
	DEfile =>
	  IF StringDefs.EquivalentString[name, entryName] THEN
	    {fp^ _ FP[entry.fp.serial, entry.fp.leaderDA]; pos _ entryPos; match _ TRUE};
	ENDCASE;
      IF entry.type ~= DEfree AND dir.spaceFound < dir.spaceNeeded THEN
	dir.spaceFound _ 0;
      RETURN[match]
      END;

    CheckFP: PROCEDURE [entry: DVPtr, entryName: STRING, entryPos: Position]
      RETURNS [BOOLEAN] =
      -- matches a file name entry against fp^.  A match terminates the enumeration.
      -- As a side effect, this procedure records the matching string name in 'name'.
      BEGIN
      match: BOOLEAN _ entry.type = DEfile AND fp^ = FP[
	entry.fp.serial, entry.fp.leaderDA];
      IF match THEN
	BEGIN
	length: CARDINAL _ MIN[entryName.length, name.maxlength];
	FOR i: CARDINAL IN [0..length) DO name[i] _ entryName[i]; ENDLOOP;
	name.length _ length;
	pos _ entryPos;
	END;
      RETURN[match]
      END;

    SELECT type FROM
      name =>
	BEGIN
	dir.spaceFound _ 0;
	dir.spaceNeeded _ SIZE[DV] + StringDefs.WordsForBcplString[name.length];
	found _ DoEnumerate[dir, CheckName];
	IF dir.spaceFound = 0 THEN dir.spacePos _ dir.length;
	END;
      fp => found _ DoEnumerate[dir, CheckFP];
      ENDCASE;
    END;

  DoDelete: ENTRY PROCEDURE [
    dir: DirHandle, type: LookupType, fullName: STRING, fp: FPPtr]
    RETURNS [found: BOOLEAN] =
    -- attempts to find and delete an entry in 'dir'.
    BEGIN
    ENABLE UNWIND => NULL;
    pos: Position;
    [found, pos] _ DoLookup[dir, type, fullName, fp];
    IF found THEN DeleteEntry[dir, pos];
    END;

  InsertEntry: PROCEDURE [dir: DirHandle, name: STRING, fp: FPPtr] =
    -- inserts the entry <name, fp> into directory 'dir'.  It is assumed that the
    -- space-related fields of 'dir' are valid.
    BEGIN
    nameBuffer: ARRAY [0..bcplNameSize) OF UNSPECIFIED;
    bcplFileName: POINTER TO StringDefs.BcplSTRING = LOOPHOLE[@nameBuffer];
    entry: DV;
    pos: Position _ dir.spacePos;
    leftOver: CARDINAL;
    IF dir.spaceFound < dir.spaceNeeded THEN -- extension will be needed
      BEGIN
      EnsureDirectoryLength[dir,
        IncrementPosition[dir.spacePos, dir.spaceNeeded*AltoDefs.BytesPerWord]];
      dir.spaceFound _ dir.spaceNeeded;
      END;
    entry _ DV[DEfile, dir.spaceNeeded, CFP[fp.serial, 1, 0, fp.leaderDA]];
    Write[dir, @pos, @entry, SIZE[DV]];
    StringDefs.MesaToBcplString[name, bcplFileName];
    IF bcplFileName.length MOD 2 = 0 THEN -- keep Boggs happy
      bcplFileName.char[bcplFileName.length] _ 0C;
    Write[dir, @pos, bcplFileName, dir.spaceNeeded - SIZE[DV]];
    IF (leftOver _ dir.spaceFound - dir.spaceNeeded) > 0 THEN
      {entry _ DV[DEfree, leftOver, ]; Write[dir, @pos, @entry, 1]};
    VMDefs.Start[dir.buffer];
    VMDefs.WaitFile[dir.file];
    FlushDirectoryBuffer[dir];
    END;

  DeleteEntry: PROCEDURE [dir: DirHandle, pos: Position] = -- INLINE --
    -- removes the entry beginning at address 'pos' in directory 'dir'.
    BEGIN
    entry: DV;
    oldPos: Position _ pos;
    Read[dir, @pos, @entry, 1]; -- read old entry to get size
    entry.type _ DEfree;
    Write[dir, @oldPos, @entry, 1];
    VMDefs.Start[dir.buffer];
    VMDefs.WaitFile[dir.file];
    FlushDirectoryBuffer[dir];
    END;

  -- Enumeration Procedure --

  DoEnumerate: PROCEDURE [
    dir: DirHandle,
    proc: PROCEDURE [DVPtr, STRING, Position] RETURNS [BOOLEAN]]
    RETURNS [found: BOOLEAN] =
    -- scans directory 'dir' calling 'proc' for each item.  The DVPtr points to the
    -- fixed information, the STRING is valid only when entry.type = DEfile.  The
    -- Position indicates the location of the entry in 'dir'.
    BEGIN
    bcplFileName: ARRAY [0..bcplNameSize) OF UNSPECIFIED;
    fileName: STRING _ [fileNameChars];
    entry: DV;
    entryLength: CARDINAL;
    pos: Position _ [0, 0];

    FillEntry: PROCEDURE = INLINE
      -- reads the directory entry beginning at 'pos' into 'entry' and 'bcplName'.
      BEGIN
      tempPos: Position _ pos;
      Read[dir, @tempPos, @entry, 1];
      IF (entryLength _ entry.length) = 0 THEN ERROR BadDirectory;
      fileName.length _ 0;
      IF entry.type = DEfile THEN
	IF entryLength IN (SIZE[DV]..SIZE[DV] + LENGTH[bcplFileName]] THEN
	  BEGIN
	  Read[dir, @tempPos, @entry + 1, SIZE[DV] - 1];
	  Read[dir, @tempPos, @bcplFileName, entryLength - SIZE[DV]];
	  StringDefs.BcplToMesaString[LOOPHOLE[@bcplFileName], fileName];
	  END
	ELSE entry.type _ DEugly;
      END;

    DO
      IF pos = dir.length THEN RETURN[FALSE];
      FillEntry[];
      IF (found _ proc[@entry, fileName, pos]) THEN EXIT;
      pos _ IncrementPosition[pos, entryLength*AltoDefs.BytesPerWord];
      ENDLOOP;
    FlushDirectoryBuffer[dir];
    END;

  -- Quick-and-Dirty "Streaming" Procedures --

  Read: PROCEDURE [
    dir: DirHandle, pos: POINTER TO Position, p: POINTER, n: [0..AltoDefs.PageSize)] =
    -- reads 'n' words from <file, pos> into the buffer beginning at 'p'.
    BEGIN OPEN AltoDefs, Inline;
    base: POINTER;
    wordsLeft: CARDINAL;
    EnsureProperBuffer[dir, pos.page];
    base _ dir.buffer + (pos.byte/BytesPerWord);
    wordsLeft _ PageSize - (pos.byte/BytesPerWord);
    IF wordsLeft >= n THEN COPY[to: p, from: base, nwords: n]
    ELSE
      BEGIN -- block straddles a page boundary
      IF wordsLeft > 0 THEN COPY[to: p, from: base, nwords: wordsLeft];
      EnsureProperBuffer[dir, pos.page + 1];
      base _ LOOPHOLE[dir.buffer];
      COPY[to: p + wordsLeft, from: base, nwords: n - wordsLeft];
      END;
    pos^ _ IncrementPosition[pos^, n*AltoDefs.BytesPerWord];
    END;

  Write: PROCEDURE [
    dir: DirHandle, pos: POINTER TO Position, p: POINTER, n: [0..AltoDefs.PageSize)] =
    -- writes 'n' words from the buffer beginning at 'p' to <file, pos>.  It is assumed
    -- that the backing file is long enough to accommodate the write, i.e., no extension
    -- is performed.
    BEGIN
    OPEN VMDefs;
    base: POINTER;
    wordsLeftOnPage: CARDINAL = AltoDefs.PageSize - (pos.byte/AltoDefs.BytesPerWord);
    newPos: Position = IncrementPosition[pos^, n*AltoDefs.BytesPerWord];
    EnsureProperBuffer[dir, pos.page];
    base _ dir.buffer + (pos.byte/AltoDefs.BytesPerWord);
    IF wordsLeftOnPage >= n THEN Inline.COPY[to: base, from: p, nwords: n]
    ELSE
      BEGIN
      -- block straddles a page boundary.  Assert:  0 < wordsLeftOnPage < n
      Inline.COPY[to: base, from: p, nwords: wordsLeftOnPage];
      MarkStart[dir.buffer];
      EnsureProperBuffer[dir, pos.page + 1];
      base _ dir.buffer;
      Inline.COPY[to: base, from: p + wordsLeftOnPage, nwords: n - wordsLeftOnPage];
      END;
    Mark[dir.buffer];
    pos^ _ newPos;
    END;

  EnsureDirectoryLength: PROCEDURE [dir: DirHandle, newEnd: Position] =
    -- ensures that the length of the backing file dir.file spans 'newEnd'.
    BEGIN
    IF ComparePositions[newEnd, dir.length] = greater THEN
      BEGIN
      VMDefs.SetFileLength[dir.file, [newEnd.page, newEnd.byte]];
      ResetDirectoryLength[dir];
      END;
    END;

  EnsureProperBuffer: PROCEDURE [dir: DirHandle, page: VMDefs.PageNumber] =
    -- ensures that <dir.file, page> is associated with 'dir'.
    BEGIN OPEN VMDefs;
    IF dir.page ~= page THEN
      BEGIN
      IF dir.buffer ~= NIL THEN Release[dir.buffer];
      dir.page _ page;
      dir.buffer _ ReadPage[[dir.file, page], 2];
      END;
    END;

  -- File Name Manipulation --

  ValidateAndExpandName: PROCEDURE [fullName, name: STRING] =
    -- ensures that the file name contains no illegal characters and
    -- terminates with a '.'.
    BEGIN OPEN StringDefs;
    ENABLE StringBoundsFault => GO TO nameTooLong;
    char: CHARACTER _ 0C;
    FOR i: CARDINAL IN [0..name.length) DO
      SELECT (char _ name[i]) FROM
	IN ['a..'z], IN ['A..'Z], IN ['0..'9], '., '$, '!, '?, '+, '-, '<, '> =>
	  AppendChar[fullName, char];
	ENDCASE => ERROR IllegalFileName;
      ENDLOOP;
    IF char ~= '. THEN AppendChar[fullName, '.];
    EXITS
      nameTooLong => ERROR IllegalFileName;
    END;

  END.