-- file FilePack.mesa
-- last modified by Satterthwaite, February 18, 1983 10:07 am

DIRECTORY
  Alloc: TYPE USING [Handle, Notifier, AddNotify, DropNotify, Top, Words],
  Copier: TYPE USING [],
  FileParms: TYPE USING [ActualId, BindingProc, Ops, nullActual, nullName],
  Strings: TYPE USING [String, SubString, SubStringDescriptor],
  SymbolTable: TYPE USING [
    Base, Handle, nullHandle, voidHandle, Acquire, Forget, Locked, Release],
  Symbols: TYPE USING [
    Base, Name, MDRecord, MDIndex, FileIndex,
    nullName, CTXNull, IncludedCTXNull, OwnMdi, MDNull, nullFileIndex, mdType],
  SymbolOps: TYPE USING [EnterString, SubStringForName],
  SymbolPack: TYPE USING [mdLimit, stHandle],
  SymbolSegment: TYPE USING [VersionID],
  TimeStamp: TYPE USING [Stamp];

FilePack: PROGRAM
    IMPORTS
      Alloc, SymbolTable, SymbolOps, 
      own: SymbolPack
    EXPORTS Copier = { 
  OPEN Symbols;

  zone: UNCOUNTED ZONE _ NIL;
  table: Alloc.Handle _ NIL;

-- tables defining the current symbol table

  mdb: Symbols.Base;		-- module directory base

  FilePackNotify: Alloc.Notifier = {mdb _ base[mdType]};
  

-- included module accounting

  VersionStamp: TYPE = TimeStamp.Stamp;

  FileProblem: PUBLIC SIGNAL [Name] RETURNS [BOOL] = CODE;
  FileVersion: PUBLIC SIGNAL [Name] RETURNS [BOOL] = CODE;
  FileVersionMix: PUBLIC SIGNAL [Name] = CODE;

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


  EnterFile: PUBLIC PROC [formalId, typeId: Name, defaultFile: Strings.String]
      RETURNS [mdi: MDIndex _ MDNull] = {
    
    BindItem: FileParms.BindingProc = {
      IF actual # FileParms.nullActual THEN
        mdi _ FindMdEntry[typeId, actual.version, SymbolOps.EnterString[@actual.locator]]
      ELSE [] _ SIGNAL FileProblem[formalId]};	-- need better error message

    fd, td: Strings.SubStringDescriptor;
    SymbolOps.SubStringForName[@fd, formalId];
    SymbolOps.SubStringForName[@td, typeId];
    fileParms.Binding[fd, td, defaultFile, BindItem];
    RETURN};

  FindMdEntry: PUBLIC PROC [id: Name, version: VersionStamp, file: Name]
      RETURNS [mdi: MDIndex] = {
    limit: MDIndex = table.Top[mdType];
    duplicate: BOOL _ FALSE;
    FOR mdi _ MDIndex.FIRST, mdi + MDRecord.SIZE UNTIL mdi = limit DO
      IF mdb[mdi].moduleId = id THEN {
	IF mdb[mdi].stamp = version THEN RETURN;
	duplicate _ TRUE};
      ENDLOOP;
    IF duplicate THEN SIGNAL FileVersionMix[id];
    mdi _ table.Words[mdType, MDRecord.SIZE];
    mdb[mdi] _ MDRecord[
	stamp: version,
	moduleId: id,
	fileId: file,
	ctx: IncludedCTXNull,
	shared: FALSE, exported: FALSE,
	defaultImport: CTXNull,
	file: nullFileIndex];
    own.mdLimit _ own.mdLimit + MDRecord.SIZE;
    RETURN};


  GetSymbolTable: PUBLIC PROC [mdi: MDIndex] RETURNS [base: SymbolTable.Base] = {
    index: FileIndex;
    OpenSymbols[mdi];
    index _ mdb[mdi].file;
    IF fileTable[index].file = nullHandle.file THEN base _ NIL
    ELSE {
      base _ SymbolTable.Acquire[fileTable[index]];
      IF base.stHandle.versionIdent # SymbolSegment.VersionID THEN {
	SymbolTable.Release[base];  base _ NIL;
	IF SIGNAL FileProblem[mdb[mdi].fileId] THEN GO TO flush}
      ELSE IF base.stHandle.version # mdb[mdi].stamp THEN {
	SymbolTable.Release[base];  base _ NIL;
	IF SIGNAL FileProblem[mdb[mdi].fileId] THEN GO TO flush};
      EXITS
        flush => {
	  SymbolTable.Forget[fileTable[index] ! SymbolTable.Locked => {CONTINUE}];
	  fileParms.Release[fileTable[index]];
	  fileTable[index] _ voidHandle}};
    RETURN};

  FreeSymbolTable: PUBLIC PROC [base: SymbolTable.Base] = {SymbolTable.Release[base]};


-- low-level file manipulation

  FileHandle: TYPE = SymbolTable.Handle;
  FileTable: TYPE = RECORD[SEQUENCE length: NAT OF FileHandle];
  
  nullHandle: FileHandle = SymbolTable.nullHandle;
  voidHandle: FileHandle = SymbolTable.voidHandle;
  
  fileTable: LONG POINTER TO FileTable;
  lastFile: INTEGER;


  -- file table management

  fileParms: FileParms.Ops;
  
  FileInit: PUBLIC PROC [
      self: FileParms.ActualId,
      ownTable: Alloc.Handle,
      scratchZone: UNCOUNTED ZONE,
      ops: FileParms.Ops] = {
    table _ ownTable;  table.AddNotify[FilePackNotify];
    zone _ scratchZone;
    IF FindMdEntry[nullName, self.version, SymbolOps.EnterString[@self.locator]] # Symbols.OwnMdi
      THEN ERROR;
    fileParms _ ops;  fileTable _ NIL; lastFile _ -1};

  CreateFileTable: PUBLIC PROC [size: CARDINAL] = {
    n: CARDINAL = size+1;	-- allow for ownMdi
    fileTable _ zone.NEW[FileTable[n]];
    FOR i: FileIndex IN [0..n) DO fileTable[i] _ nullHandle ENDLOOP;
    lastFile _ -1};

  ExpandFileTable: PROC = {
    newTable: LONG POINTER TO FileTable;
    i: FileIndex;
    size: CARDINAL = fileTable.length + 2;
    newTable _ zone.NEW[FileTable[size]];
    FOR i IN [0..fileTable.length) DO newTable[i] _ fileTable[i] ENDLOOP;
    FOR i IN [fileTable.length..size) DO newTable[i] _ nullHandle ENDLOOP;
    zone.FREE[@fileTable];
    fileTable _ newTable};

  FileReset: PUBLIC PROC = {
    FOR i: INTEGER IN [0..lastFile] DO
      IF fileTable[i] # nullHandle THEN fileParms.Release[fileTable[i]];
      fileTable[i] _ nullHandle;
      ENDLOOP;
    zone.FREE[@fileTable]; zone _ NIL;
    table.DropNotify[FilePackNotify]; table _ NIL};


  -- file setup

  MdiToFile: PROC [mdi: MDIndex] RETURNS [FileIndex] = {
    IF mdb[mdi].file = nullFileIndex THEN {
      newFile: FileIndex = lastFile + 1;
      UNTIL newFile < fileTable.length DO ExpandFileTable[] ENDLOOP;
      fileTable[newFile] _ nullHandle;
      lastFile _ newFile;
      mdb[mdi].file _ newFile};
    RETURN [mdb[mdi].file]};


  OpenSymbols: PROC [mdi: MDIndex] = {
    index: FileIndex = MdiToFile[mdi];
    IF fileTable[index] = nullHandle THEN {
      d1, d2: Strings.SubStringDescriptor;
      SymbolOps.SubStringForName[@d1, mdb[mdi].moduleId];
      SymbolOps.SubStringForName[@d2, mdb[mdi].fileId];
      fileTable[index] _ fileParms.Acquire[d1, [mdb[mdi].stamp, d2]];
      IF fileTable[index] = nullHandle
       AND (SIGNAL FileProblem[mdb[mdi].moduleId]) THEN
	fileTable[index] _ voidHandle}};


  TableForModule: PUBLIC PROC [mdi: MDIndex] RETURNS [SymbolTable.Handle] = {
    RETURN[fileTable[mdb[mdi].file]]};

 -- mdi bypass
 
  MapSymbols: PUBLIC PROC [id: FileParms.ActualId] RETURNS [base: SymbolTable.Base] = {
    IF id = FileParms.nullActual THEN base _ NIL
    ELSE {
      handle: SymbolTable.Handle = fileParms.Acquire[FileParms.nullName, id];
      IF handle.file = nullHandle.file THEN base _ NIL
      ELSE {
        base _ SymbolTable.Acquire[handle];
        IF base.stHandle.versionIdent # SymbolSegment.VersionID THEN {
	  fileParms.Release[handle]; SymbolTable.Release[base]; base _ NIL}}};
    RETURN};
     
  UnmapSymbols: PUBLIC PROC [SymbolTable.Base] = FreeSymbolTable;
   
  }.