-- file FilePack.Mesa
-- last modified by Satterthwaite, October 19, 1979  10:42 AM

DIRECTORY
  AltoFileDefs: FROM "altofiledefs" USING [FP],
  BcdDefs: FROM "bcddefs"
    USING [
      BCD, MTIndex, MTRecord, NameString, SGIndex, VersionStamp,
      FTSelf, SGNull, VersionID],
  Copier: FROM "copier",
  DirectoryDefs: FROM "directorydefs" USING [EnumerateDirectory],
  SegmentDefs: FROM "segmentdefs"
    USING [
      FileHandle, FileSegmentHandle, OldFileOnly, Read,
      DeleteFileSegment, FileError, FileNameError, FileSegmentAddress,
      InsertFile, MoveFileSegment, NewFile, NewFileSegment, ReleaseFile,
      SwapIn, SwapOut, Unlock],
  StringDefs: FROM "stringdefs"
    USING [
      SubStringDescriptor,
      AppendChar, AppendString, AppendSubString,
      EqualSubStrings, EquivalentSubStrings],
  SymbolTable: FROM "symboltable"
    USING [
      Base, Handle, NullHandle,
      Acquire, Release, SegmentForTable, SetCacheSize, TableForSegment],
  Symbols: FROM "symbols"
    USING [mdType,
      HTIndex, MDRecord, MDIndex, FileIndex,
      HTNull, CTXNull, IncludedCTXNull, OwnMdi, MDNull, NullFileIndex],
  SymbolOps: FROM "symbolops" USING [EnterString, SubStringForHash],
  SymbolSegment: FROM "symbolsegment" USING [VersionID],
  SystemDefs: FROM "systemdefs"
    USING [
      AllocateHeapNode, AllocateHeapString, FreeHeapNode, FreeHeapString],
  Table: FROM "table"
    USING [Base, Notifier, AddNotify, Allocate, Bounds, DropNotify];

FilePack: PROGRAM
    IMPORTS
	DirectoryDefs, SegmentDefs, StringDefs, SymbolTable, SymbolOps,
	SystemDefs, Table 
    EXPORTS Copier = 
  BEGIN
  OPEN Symbols;

  SubStringDescriptor: TYPE = StringDefs.SubStringDescriptor;

-- tables defining the current symbol table

  mdb: Table.Base;		-- module directory base

  FilePackNotify: Table.Notifier =
    BEGIN  -- called whenever the main symbol table is repacked
    mdb _ base[mdType];
    END;
  

-- included module accounting

  VersionStamp: TYPE = BcdDefs.VersionStamp;

  FileProblem: PUBLIC SIGNAL [HTIndex] RETURNS [BOOLEAN] = CODE;
  FileVersion: PUBLIC SIGNAL [HTIndex] RETURNS [BOOLEAN] = CODE;
  FileVersionMix: PUBLIC SIGNAL [HTIndex] = CODE;

  AnyVersion: VersionStamp = [net:0, host:0, time:0];

  EqStamps: PROCEDURE [v1, v2: POINTER TO VersionStamp] RETURNS [BOOLEAN] =
    BEGIN
    RETURN [v1.time = v2.time AND v1.net = v2.net AND v1.host = v2.host]
    END;


  EnterFile: PUBLIC PROCEDURE [id: HTIndex, name: STRING] RETURNS [HTIndex] =
    BEGIN
    mdi: MDIndex = FindMdEntry[id, AnyVersion, NormalizeFileName[name]];
    RETURN [mdb[mdi].moduleId]
    END;

  NormalizeFileName: PROCEDURE [name: STRING] RETURNS [hti: HTIndex] =
    BEGIN
    i: CARDINAL;
    char: CHARACTER;
    dot: BOOLEAN _ FALSE;
    s: STRING _ SystemDefs.AllocateHeapString[name.length+(".bcd"L).length+1];
    desc: SubStringDescriptor;
    FOR i IN [0 .. name.length)
      DO
      SELECT (char _ name[i]) FROM
	IN ['A..'Z] =>  char _ char + ('a-'A);
	'. =>  dot _ TRUE;
	ENDCASE;
      StringDefs.AppendChar[s, char];
      ENDLOOP;
    IF ~dot THEN StringDefs.AppendString[s, ".bcd"L];
    IF s[s.length-1] # '. THEN StringDefs.AppendChar[s, '.];
    desc _ [base:s, offset:0, length: s.length];
    hti _ SymbolOps.EnterString[@desc];
    SystemDefs.FreeHeapString[s];  RETURN
    END;

  HtiToMdi: PUBLIC PROCEDURE [hti: HTIndex] RETURNS [mdi: MDIndex] =
    BEGIN
    limit: MDIndex = LOOPHOLE[Table.Bounds[mdType].size];
    FOR mdi _ FIRST[MDIndex], mdi + SIZE[MDRecord] UNTIL mdi = limit
      DO
      IF hti = mdb[mdi].moduleId THEN RETURN;
      ENDLOOP;
    RETURN [MDNull]
    END;

  FindMdEntry: PUBLIC PROCEDURE [
	id: HTIndex, version: VersionStamp, file: HTIndex]
      RETURNS [mdi: MDIndex] =
    BEGIN
    limit: MDIndex = LOOPHOLE[Table.Bounds[mdType].size];
    duplicate: BOOLEAN _ FALSE;
    FOR mdi _ FIRST[MDIndex], mdi + SIZE[MDRecord] UNTIL mdi = limit
      DO
      IF mdb[mdi].moduleId = id
	THEN
	  BEGIN
	  IF EqStamps[@mdb[mdi].stamp, @version] THEN RETURN;
	  IF mdb[mdi].stamp = AnyVersion
	    THEN
	      BEGIN
	      OpenSymbols[mdi !FileProblem => RESUME [FALSE]];
	      IF EqStamps[@mdb[mdi].stamp, @version] THEN RETURN;
	      END;
	  IF mdb[mdi].stamp # AnyVersion THEN duplicate _ TRUE;
	  END;
      ENDLOOP;
    IF duplicate THEN SIGNAL FileVersionMix[id];
    mdi _ Table.Allocate[mdType, SIZE[MDRecord]];
    mdb[mdi] _ MDRecord[
	stamp: version,
	moduleId: id,
	fileId: file,
	ctx: IncludedCTXNull,
	shared: FALSE,
	exported: FALSE,
	defaultImport: CTXNull,
	file: NullFileIndex];
    RETURN
    END;


  GetSymbolTable: PUBLIC PROCEDURE [mdi: MDIndex] RETURNS [base: SymbolTable.Base] =
    BEGIN
    index: FileIndex;
    OpenSymbols[mdi];
    index _ mdb[mdi].file;
    IF fileTable[index].file = NIL
      THEN  base _ NIL
      ELSE
	BEGIN
	base _ SymbolTable.Acquire[fileTable[index].table];
	IF base.stHandle.versionIdent # SymbolSegment.VersionID
	  THEN
	    BEGIN
	    SymbolTable.Release[base];  base _ NIL;
	    IF SIGNAL FileProblem[mdb[mdi].fileId]
	      THEN
		BEGIN
		SegmentDefs.DeleteFileSegment[
		  SymbolTable.SegmentForTable[fileTable[index].table]];
		fileTable[index] _ NullFileRecord;
		END;
	    END;
	END;
    RETURN
    END;

  FreeSymbolTable: PUBLIC PROCEDURE [base: SymbolTable.Base] =
    BEGIN  SymbolTable.Release[base]  END;


-- low-level file manipulation

  FileRecord: TYPE = RECORD[
    file: SegmentDefs.FileHandle,
    table: SymbolTable.Handle];

  NullFileRecord: FileRecord = FileRecord[NIL, SymbolTable.NullHandle];

  fileTable: DESCRIPTOR FOR ARRAY OF FileRecord;
  lastFile: INTEGER;


  -- file table management

  FileInit: PUBLIC PROCEDURE [self: STRING, version: VersionStamp] =
    BEGIN
    Table.AddNotify[FilePackNotify];
    IF FindMdEntry[HTNull, version, NormalizeFileName[self]] # Symbols.OwnMdi
      THEN ERROR;
    END;

  CreateFileTable: PUBLIC PROCEDURE [size: CARDINAL] =
    BEGIN  OPEN SystemDefs;
    i: CARDINAL;
    fileTable _ DESCRIPTOR [AllocateHeapNode[size*SIZE[FileRecord]], size];
    FOR i IN [0..size) DO fileTable[i] _ NullFileRecord ENDLOOP;
    lastFile _ -1;
    END;

  ExpandFileTable: PROCEDURE =
    BEGIN  OPEN SystemDefs;
    table: DESCRIPTOR FOR ARRAY OF FileRecord;
    i: CARDINAL;
    size: CARDINAL = LENGTH[fileTable] + 2;
    table _ DESCRIPTOR [AllocateHeapNode[size*SIZE[FileRecord]], size];
    FOR i IN [0..LENGTH[fileTable]) DO table[i] _ fileTable[i] ENDLOOP;
    FOR i IN [LENGTH[fileTable]..size) DO table[i] _ NullFileRecord ENDLOOP;
    FreeHeapNode[BASE[fileTable]];
    fileTable _ table;
    END;

  FileReset: PUBLIC PROCEDURE =
    BEGIN
    i: INTEGER;
    SymbolTable.SetCacheSize[0];
    FOR i IN [0..lastFile]
      DO
      SELECT TRUE FROM
	(fileTable[i].table # SymbolTable.NullHandle) =>
	  SegmentDefs.DeleteFileSegment[
	    SymbolTable.SegmentForTable[fileTable[i].table]];
	(fileTable[i].file # NIL AND fileTable[i].file.lock = 0) =>
	  SegmentDefs.ReleaseFile[fileTable[i].file];
	ENDCASE => NULL;
      ENDLOOP;
    SystemDefs.FreeHeapNode[BASE[fileTable]];
    Table.DropNotify[FilePackNotify];
    END;


  -- file setup

  OwnFile: PUBLIC SIGNAL [file: SegmentDefs.FileHandle] = CODE;

  LocateTables: PUBLIC PROCEDURE [nTables: CARDINAL] =
    BEGIN
    n: CARDINAL _ nTables;
    limit: MDIndex = LOOPHOLE[Table.Bounds[mdType].size];

    CheckFile: PROCEDURE [fp: POINTER TO AltoFileDefs.FP, s: STRING] RETURNS [BOOLEAN] =
      BEGIN
      d1: SubStringDescriptor _ [base:s, offset:0, length:s.length];
      d2: SubStringDescriptor;
      mdi: MDIndex;
      FOR mdi _ FIRST[MDIndex], mdi+SIZE[MDRecord] UNTIL mdi = limit
	DO
	SymbolOps.SubStringForHash[@d2, mdb[mdi].fileId];
	IF StringDefs.EquivalentSubStrings[@d1, @d2]
	  THEN
	    BEGIN
	    mdb[mdi].file _ lastFile _ lastFile+1;
	    fileTable[lastFile] _ FileRecord[
		file: SegmentDefs.InsertFile[fp, SegmentDefs.Read],
		table: SymbolTable.NullHandle];
	    IF mdi = OwnMdi THEN SIGNAL OwnFile[fileTable[lastFile].file];
	    n _ n-1;
	    END;
	ENDLOOP;
      RETURN [n = 0]
      END;

    DirectoryDefs.EnumerateDirectory[CheckFile];
    END;


  MakeFileTableEntry: PUBLIC PROCEDURE
	[file: SegmentDefs.FileHandle, table: SymbolTable.Handle]
      RETURNS [FileIndex] =
    BEGIN
    lastFile _ lastFile + 1;
    UNTIL lastFile < LENGTH[fileTable] DO ExpandFileTable[] ENDLOOP;
    fileTable[lastFile] _ FileRecord[file: file, table: table];
    RETURN [lastFile]
    END;

  FillFile: PROCEDURE [mdi: MDIndex] =
    BEGIN
    newFile: FileIndex;
    desc: SubStringDescriptor;
    name: STRING;
    SymbolOps.SubStringForHash[@desc, mdb[mdi].fileId];
    newFile _ lastFile + 1;
    UNTIL newFile < LENGTH[fileTable] DO ExpandFileTable[] ENDLOOP;
    fileTable[newFile] _ NullFileRecord;
    name _ SystemDefs.AllocateHeapString[desc.length];
    StringDefs.AppendSubString[name, @desc];
      BEGIN  OPEN SegmentDefs;
      fileTable[newFile].file _ NewFile[name, Read, OldFileOnly
	! FileNameError, FileError =>
	    IF SIGNAL FileProblem[mdb[mdi].moduleId]
	      THEN CONTINUE
	      ELSE GO TO noEntry];
      lastFile _ newFile;
      EXITS
	noEntry => newFile _ NullFileIndex;
      END;
    SystemDefs.FreeHeapString[name];
    mdb[mdi].file _ newFile;
    END;


  OpenSymbols: PROCEDURE [mdi: MDIndex] =
    BEGIN
    index: FileIndex;
    symbolSeg, headerSeg: SegmentDefs.FileSegmentHandle _ NIL;

    DeleteHeader: PROCEDURE =
      BEGIN
      IF headerSeg # NIL
	THEN
	  BEGIN OPEN SegmentDefs;
	  Unlock[headerSeg];  DeleteFileSegment[headerSeg];  headerSeg _ NIL;
	  END;
      END;

    Fail: PROCEDURE [voidEntry: BOOLEAN] =
      BEGIN
      IF voidEntry
	THEN
	  BEGIN
	  SELECT TRUE FROM
	    (headerSeg # NIL) =>  DeleteHeader[];
	    (fileTable[index].file.lock = 0) =>
	      SegmentDefs.ReleaseFile[fileTable[index].file];
	    ENDCASE =>  NULL;
	  fileTable[index].file _ NIL;
	  END
	ELSE  DeleteHeader[];
      END;

    IF mdb[mdi].file = NullFileIndex THEN FillFile[mdi];
    index _ mdb[mdi].file;
    IF index # NullFileIndex AND fileTable[index].table = SymbolTable.NullHandle
     AND fileTable[index].file # NIL
      THEN
	BEGIN  OPEN SegmentDefs;
	ENABLE
	  BEGIN
	  UNWIND => NULL;
	  ANY => GO TO badFile
	  END;
	bcd: POINTER TO BcdDefs.BCD;
	bcdPages: CARDINAL;
	mtb, ftb, sgb: Table.Base;
	mti: BcdDefs.MTIndex;
	sSeg: BcdDefs.SGIndex;
	nString: BcdDefs.NameString;
	d1, d2: SubStringDescriptor;
	version: VersionStamp;
	bcdPages _ 1;
	headerSeg _ NewFileSegment[fileTable[index].file, 1, bcdPages, Read];
	  DO
	  SwapIn[headerSeg];  bcd _ FileSegmentAddress[headerSeg];
	  IF bcdPages = bcd.nPages THEN EXIT;
	  bcdPages _ bcd.nPages;
	  Unlock[headerSeg];  SwapOut[headerSeg];
	  MoveFileSegment[headerSeg, 1, bcdPages];
	  ENDLOOP;
	IF bcd.versionident # BcdDefs.VersionID OR bcd.nConfigs > 1
	  THEN GO TO badFile;
	SymbolOps.SubStringForHash[@d1, mdb[mdi].moduleId];
	nString _ LOOPHOLE[bcd + bcd.ssOffset];
	d2.base _ @nString.string;
	ftb _ LOOPHOLE[bcd + bcd.ftOffset];
	mtb _ LOOPHOLE[bcd + bcd.mtOffset];  mti _ FIRST[BcdDefs.MTIndex];
	UNTIL mti = bcd.mtLimit
	  DO
	  d2.offset _ mtb[mti].name;
	  d2.length _ nString.size[mtb[mti].name];
	  IF StringDefs.EqualSubStrings[@d1, @d2] THEN EXIT;
	  mti _ mti + (SIZE[BcdDefs.MTRecord] + mtb[mti].frame.length);
	  REPEAT
	    FINISHED => GOTO badFile;
	  ENDLOOP;
	ftb _ LOOPHOLE[bcd + bcd.ftOffset];
	version _ IF mtb[mti].file = BcdDefs.FTSelf
		    THEN bcd.version
		    ELSE ftb[mtb[mti].file].version;
	sgb _ LOOPHOLE[bcd + bcd.sgOffset];  sSeg _ mtb[mti].sseg;
	IF sSeg = BcdDefs.SGNull
	 OR sgb[sSeg].pages = 0 OR sgb[sSeg].file # BcdDefs.FTSelf
	  THEN GO TO badFile;
	IF mdb[mdi].stamp # AnyVersion
	 AND ~EqStamps[@mdb[mdi].stamp, @version] THEN GO TO wrongVersion;
	mdb[mdi].stamp _ version;
	symbolSeg _ NewFileSegment[
			  headerSeg.file,
			  sgb[sSeg].base, sgb[sSeg].pages,
			  Read];
	symbolSeg.class _ other;
	fileTable[index].table _ SymbolTable.TableForSegment[symbolSeg];
	DeleteHeader[];
	EXITS
	  badFile =>  Fail[SIGNAL FileProblem[mdb[mdi].moduleId]];
	  wrongVersion =>  Fail[SIGNAL FileVersion[mdb[mdi].moduleId]];
	END;

    END;


  TableForModule: PUBLIC PROCEDURE [mdi: MDIndex] RETURNS [SymbolTable.Handle] =
    BEGIN
    RETURN[fileTable[mdb[mdi].file].table]
    END;

  END.