-- file FileParmPack.mesa
-- last modified by Satterthwaite, July 27, 1983 4:48 pm

DIRECTORY
  BcdDefs: TYPE USING [
    Base, MTIndex, MTRecord, SGIndex, VersionStamp, FTSelf, SGNull, VersionID],
  BcdOps: TYPE USING [BcdBase, NameString],
  CommandUtil: TYPE USING [PairList, FreePairList, KeyValue],
  File: TYPE USING [Capability, nullCapability],
  FileParms: TYPE USING [
    ActualId, BindingProc, Name, Ops, SymbolSpace, nullActual],
  FileParmOps: TYPE USING [],
  FileSegment: TYPE USING [Pages, Span, nullPages],
  OSMiscOps: TYPE USING [FindFile, FileError, UnnameFile],
  Space: TYPE USING [
    Handle, nullHandle, virtualMemory, Create, LongPointer, Map, Delete],
  Strings: TYPE USING [
    String, SubString, SubStringDescriptor,
    AppendChar, AppendString, AppendSubString, EqualSubStrings, EquivalentSubStrings],
  SymbolTable: TYPE USING [anySpan, Forget, Locked, SetCacheSize],
  TimeStamp: TYPE USING [Stamp];

FileParmPack: PROGRAM
    IMPORTS CommandUtil, OSMiscOps, Space, Strings, SymbolTable
    EXPORTS FileParmOps = { 

  Name: TYPE = FileParms.Name;
  ActualId: TYPE = FileParms.ActualId;
  nullActual: ActualId = FileParms.nullActual;
  
  FileIndex: TYPE = NAT;
  nullFileIndex: FileIndex = FileIndex.LAST;
  

 -- primary operations for read-only access
 
  Binding: PROC [
      formalId, formalType: Name,
      defaultLocator: Strings.String,
      binder: FileParms.BindingProc] = {
    i: FileIndex;
    name: Strings.String _ FileName[@formalId, defaultLocator];
    type: Strings.String _ CopyName[@formalType];
    IF name = NIL THEN i _ nullFileIndex
    ELSE {
      file: File.Capability _ nullFile;
      FOR i IN [0 .. nextFile) DO
	IF EquivalentStrings[name, fileTable[i].name] THEN {
	  IF EquivalentStrings[type, fileTable[i].type] THEN GO TO found;
	  file _ fileTable[i].pages.file};
	REPEAT
          found => {zone.FREE[@name]; zone.FREE[@type]};
	  FINISHED => {
	    version: TimeStamp.Stamp;
	    span: FileSegment.Span;
	    IF file = nullFile THEN file _ CreateFile[name];
	    IF file = nullFile THEN i _ nullFileIndex
	    ELSE {
	      [version, span] _ ReadHeader[file, @formalType];
	      i _ SearchCache[version];
	      IF i = nullFileIndex AND version # nullActual.version THEN {
		i _ NewCacheEntry[];
		fileTable[i] _ [
	          version: version, pages: [file, span], name: name, type: type]}
	      ELSE {
	        zone.FREE[@name]; zone.FREE[@type]}}};
        ENDLOOP;
    IF i = nullFileIndex THEN binder[nullActual]
    ELSE binder[[fileTable[i].version, [fileTable[i].name, 0, fileTable[i].name.length]]]}};


  Acquire: PROC [id: Name, actual: ActualId] RETURNS [FileParms.SymbolSpace] = {
    i: FileIndex _ SearchCache[actual.version];
    IF i = nullFileIndex THEN {
      i _ NewCacheEntry[];
      fileTable[i] _ [
        version: actual.version, name: CopyName[@actual.locator], type: CopyName[@id]]};
    OpenFile[i];
    RETURN [IF fileTable[i].pages.file = nullFile OR fileTable[i].pages.span = nullSpan
      THEN nullPages
      ELSE fileTable[i].pages]};
    
  Release: PROC [s: FileParms.SymbolSpace] = {NULL};	-- add ref counts?
  
  Forget: PROC [actual: ActualId] = {
    i: NAT _ 0;
    WHILE i < nextFile DO {
      IF fileTable[i].version = actual.version THEN GO TO delete;
      IF fileTable[i].name # NIL THEN {
        d: Strings.SubStringDescriptor _ [fileTable[i].name, 0, fileTable[i].name.length];
	IF Strings.EquivalentSubStrings[@d, @actual.locator] THEN GO TO delete};
      i _ i + 1;
      EXITS
        delete => {
	  ClearCacheEntry[i];
	  nextFile _ nextFile - 1;
	  IF i # nextFile THEN {
	    fileTable[i] _ fileTable[nextFile]; fileTable[nextFile] _ [nullActual.version]}}};
      ENDLOOP};
      
 -- operations for update access
 
  AcquireOutput: PUBLIC PROC [name: Strings.String] RETURNS [file: File.Capability] = {
    file _ OSMiscOps.FindFile[name, $write
		! OSMiscOps.FileError => {file _ File.nullCapability; CONTINUE}];
    IF file # File.nullCapability THEN {
      SymbolTable.Forget[[file: file, span: SymbolTable.anySpan]
        ! SymbolTable.Locked => {GOTO MakeTemporary}];
      EXITS
        MakeTemporary => {
          OSMiscOps.UnnameFile[name, file];
          file _ OSMiscOps.FindFile[name, $write]}};
    RETURN};
    
  ReleaseOutput: PUBLIC PROC [file: File.Capability] = {NULL};
  
           
 -- command line arguments
 
  aList: CommandUtil.PairList;
 
  SetAList: PUBLIC PROC [map: CommandUtil.PairList] = {aList _ map};
  
  ClearAList: PUBLIC PROC = {aList _ CommandUtil.FreePairList[aList]};
  

 -- initialization/finalization
 
  Initialize: PUBLIC PROC [scratchZone: UNCOUNTED ZONE] RETURNS [FileParms.Ops] = {
    zone _ scratchZone;
    fileTable _ NIL; AdjustFileTable[16];
    nextFile _ 0;
    SymbolTable.SetCacheSize[256];
    RETURN [[Binding, Acquire, Release, Forget]]};

  Finalize: PUBLIC PROC = {
    SymbolTable.SetCacheSize[0];
    FOR i: NAT IN [0..nextFile) DO ClearCacheEntry[i] ENDLOOP;
    zone.FREE[@fileTable]; zone _ NIL};


 -- interpretation of file names (Pilot PreCascade conventions)
 
  FileName: PROC [key: Strings.SubString, default: Strings.String] RETURNS [Strings.String] = {
    t: Strings.String = CommandUtil.KeyValue[key, aList];
    d: Strings.SubStringDescriptor _ SELECT TRUE FROM
	(t # NIL) => [base: t, offset: 0, length: t.length],
	(default # NIL) => [base: default, offset: 0, length: default.length],
	ENDCASE => key^;
    RETURN [NormalizeFileName[@d]]};
    
  CopyName: PROC [master: Strings.SubString] RETURNS [s: Strings.String] = {
    s _ zone.NEW[StringBody[master.length]];
    Strings.AppendSubString[s, master];
    RETURN};

  NormalizeFileName: PROC [formal: Strings.SubString] RETURNS [s: Strings.String] = {
    IF formal.length = 1 AND formal.base[formal.offset] = '$ THEN s _ NIL
    ELSE {
      char: CHAR;
      dot: BOOL _ FALSE;
      s _ zone.NEW[StringBody[formal.length+(".bcd"L).length]];
      FOR i: CARDINAL IN [formal.offset .. formal.offset+formal.length) DO
	char _ formal.base[i];
	IF char = '. THEN  dot _ TRUE;
	Strings.AppendChar[s, char];
	ENDLOOP;
      IF ~dot THEN Strings.AppendString[s, ".bcd"L]};
    RETURN};

  EquivalentStrings: PROC [s1, s2: Strings.String] RETURNS [BOOL] = {
    IF s1 # NIL AND s2 # NIL THEN {
      d1: Strings.SubStringDescriptor _ [base: s1, offset: 0, length: s1.length];
      d2: Strings.SubStringDescriptor _ [base: s2, offset: 0, length: s2.length];
      RETURN [Strings.EquivalentSubStrings[@d1, @d2]]}
    ELSE RETURN [FALSE]};
    
    
 -- file setup
 
  OpenFile: PROC [i: FileIndex] = {
    IF fileTable[i].pages.file = nullFile AND fileTable[i].name # NIL THEN
      fileTable[i].pages.file _ CreateFile[fileTable[i].name];
    IF fileTable[i].pages.file # nullFile AND fileTable[i].pages.span = nullSpan THEN {
      version: TimeStamp.Stamp;
      d: Strings.SubStringDescriptor _ [fileTable[i].type, 0, fileTable[i].type.length];
      [version, fileTable[i].pages.span] _ ReadHeader[fileTable[i].pages.file, @d];
      IF version # fileTable[i].version THEN {
        ClearCacheEntry[i];
        fileTable[i].pages _ nullPages}}};


 -- low-level file manipulation and cache management

  zone: UNCOUNTED ZONE _ NIL;

  nullPages: FileSegment.Pages = FileSegment.nullPages;
  nullFile: File.Capability = nullPages.file;
  nullSpan: FileSegment.Span = nullPages.span;
      
  FileRecord: TYPE = RECORD[
    version: TimeStamp.Stamp _ ,
    pages: FileSegment.Pages _ nullPages,
    name: Strings.String _ NIL,
    type: Strings.String _ NIL];
  FileTable: TYPE = RECORD [SEQUENCE length: FileIndex OF FileRecord];
    
  fileTable: LONG POINTER TO FileTable;
  nextFile: NAT;


  -- file table management

  SearchCache: PROC [version: TimeStamp.Stamp] RETURNS [i: FileIndex] = {
    FOR i IN [0 .. nextFile) DO
      IF fileTable[i].version = version THEN EXIT;
      REPEAT
        FINISHED => i _ nullFileIndex;
      ENDLOOP;
    RETURN};
    
  NewCacheEntry: PROC RETURNS [i: FileIndex] = {
    WHILE nextFile >= fileTable.length DO AdjustFileTable[fileTable.length + 16] ENDLOOP;
    i _ nextFile;  nextFile _ nextFile + 1};
    
  AdjustFileTable: PROC [newSize: NAT] = {
    newTable: LONG POINTER TO FileTable;
    oldSize: NAT = IF fileTable = NIL THEN 0 ELSE fileTable.length;
    IF newSize = 0 THEN newTable _ NIL
    ELSE {
      i: FileIndex;
      newTable _ zone.NEW[FileTable[newSize]];
      FOR i IN [0..MIN[oldSize, newSize]) DO newTable[i] _ fileTable[i] ENDLOOP;
      FOR i IN [oldSize..newSize) DO newTable[i] _ [version: nullActual.version] ENDLOOP};
    IF fileTable # NIL THEN zone.FREE[@fileTable];
    fileTable _ newTable};

  ClearCacheEntry: PROC [i: FileIndex] = {
    IF fileTable[i].name # NIL THEN zone.FREE[@fileTable[i].name];
    IF fileTable[i].type # NIL THEN zone.FREE[@fileTable[i].type]};


  -- file setup

  CreateFile: PROC [s: Strings.String] RETURNS [file: File.Capability _ nullPages.file] = {
    IF s # NIL THEN {
      oldLength: CARDINAL = s.length;
      IF oldLength > 1 AND s[s.length-1] = '.
        THEN s.length _ s.length - 1;	-- undo Alto convention for Pilot
      file _ OSMiscOps.FindFile[s, $read ! OSMiscOps.FileError => {CONTINUE}];
      s.length _ oldLength};
    RETURN};


  ReadHeader: PROC [file: File.Capability, typeId: Strings.SubString] RETURNS [
      version: TimeStamp.Stamp _ nullActual.version,
      span: FileSegment.Span _ nullSpan] = {
    headerSpace: Space.Handle _ Space.nullHandle;

    DeleteHeader: PROC = {
      IF headerSpace # Space.nullHandle THEN {
	Space.Delete[headerSpace];
	headerSpace _ Space.nullHandle}};

    IF file # File.nullCapability THEN {
      ENABLE {
	UNWIND => {NULL};
	ANY => {GO TO badFile}};
      BcdBase: PROC [p: LONG POINTER] RETURNS [BcdDefs.Base] = INLINE {
	RETURN [LOOPHOLE[p, BcdDefs.Base]]};
      bcd: BcdOps.BcdBase;
      bcdPages: CARDINAL _ 8;
      mtb, ftb, sgb: BcdDefs.Base;
      mti: BcdDefs.MTIndex;
      sSeg: BcdDefs.SGIndex;
      nString: BcdOps.NameString;
      d: Strings.SubStringDescriptor;
      DO
        headerSpace _ Space.Create[size: bcdPages, parent: Space.virtualMemory];
	headerSpace.Map[window: [file: file, base: 1]];
	bcd _ headerSpace.LongPointer[];
	IF bcd.versionIdent # BcdDefs.VersionID THEN GO TO badFile;
	IF bcdPages >= bcd.nPages THEN EXIT;
	bcdPages _ bcd.nPages;
	Space.Delete[headerSpace];  headerSpace _ Space.nullHandle
	ENDLOOP;
      IF bcd.nConfigs # 0 THEN GO TO badFile;	-- no packaged bcd's (for now)
      nString _ LOOPHOLE[bcd + bcd.ssOffset];
      d.base _ @nString.string;
      ftb _ BcdBase[bcd + bcd.ftOffset];
      mtb _ BcdBase[bcd + bcd.mtOffset];  mti _ BcdDefs.MTIndex.FIRST;
      UNTIL mti = bcd.mtLimit DO
	d.offset _ mtb[mti].name;  d.length _ nString.size[mtb[mti].name];
	IF Strings.EqualSubStrings[typeId, @d] THEN EXIT;
	mti _ mti + BcdDefs.MTRecord.SIZE;
	REPEAT
	  FINISHED =>
	    IF bcd.nModules = 1 THEN mti _ BcdDefs.MTIndex.FIRST ELSE GOTO badFile;
	ENDLOOP;
      ftb _ BcdBase[bcd + bcd.ftOffset];
      version _ IF mtb[mti].file = BcdDefs.FTSelf
		  THEN bcd.version
		  ELSE ftb[mtb[mti].file].version;
      sgb _ BcdBase[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;
      span _ [base: sgb[sSeg].base, pages: sgb[sSeg].pages];
      DeleteHeader[];
      EXITS
	badFile => {DeleteHeader[]; span _ nullSpan}};
    RETURN};

  }.