-- file CIFSFileParmPack.mesa
-- last modified by Satterthwaite, September 15, 1982 9:15 am

DIRECTORY
  BcdDefs: TYPE USING [
    Base, Link, MTIndex, MTRecord, SGIndex, VersionStamp, FTSelf, SGNull, VersionID],
  BcdOps: TYPE USING [BcdBase, NameString],
  CIFS: TYPE USING [OpenFile, Close, Error, GetFC, Open, create, read, replace, write],
  CommandUtil: TYPE USING [PairList, FreePairList, KeyValue],
  ConvertUnsafe: TYPE USING [ToRope],
  File: TYPE USING [Capability, nullCapability],
  FileParms: TYPE USING [
    ActualId, BindingProc, Name, Ops, SymbolSpace, nullActual, nullSymbolSpace],
  FileParmOps: TYPE USING [],
  FileSegment: TYPE USING [Span, nullSpan],
  Rope: TYPE USING [ROPE],
  Space: TYPE USING [
    Handle, nullHandle, virtualMemory, Create, LongPointer, Map, Delete],
  Strings: TYPE USING [
    String, SubString, SubStringDescriptor,
    AppendChar, AppendString, AppendSubString, EqualSubStrings, EquivalentSubStrings],
  TimeStamp: TYPE USING [Stamp];

CIFSFileParmPack: PROGRAM
    IMPORTS CIFS, CommandUtil, ConvertUnsafe, Space, Strings
    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: CIFS.OpenFile _ 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].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[CIFS.GetFC[file], @formalType];
	      i _ SearchCache[version];
	      IF i = nullFileIndex AND version # nullActual.version THEN {
		i _ NewCacheEntry[];
		fileTable[i] _ [
	          version: version, file: file, span: span, name: name, type: type]}
	      ELSE {
	        CIFS.Close[file]; file _ nullFile;
	        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].file = nullFile OR fileTable[i].span = nullSpan
      THEN FileParms.nullSymbolSpace
      ELSE [file: CIFS.GetFC[fileTable[i].file], span: fileTable[i].span]]};
    
  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
 
  outputFile: CIFS.OpenFile;
  
  AcquireOutput: PUBLIC PROC [name: Strings.String] RETURNS [File.Capability] = {
    fileName: Rope.ROPE = ConvertUnsafe.ToRope[name];
    outputFile _ CIFS.Open[fileName, CIFS.create+CIFS.replace+CIFS.write];
    RETURN [CIFS.GetFC[outputFile]]};
    
  ReleaseOutput: PUBLIC PROC [file: File.Capability] = {
    IF outputFile = nullFile OR file # CIFS.GetFC[outputFile] THEN ERROR;
    CIFS.Close[outputFile];  outputFile _ nullFile};
 
 
  -- 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;
    outputFile _ nullFile;
    RETURN [[Binding, Acquire, Release, Forget]]};

  Finalize: PUBLIC PROC = {
    FOR i: NAT IN [0..nextFile) DO ClearCacheEntry[i] ENDLOOP;
    IF outputFile # nullFile THEN {CIFS.Close[outputFile]; outputFile _ nullFile};
    --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].file = nullFile AND fileTable[i].name # NIL THEN
      fileTable[i].file _ CreateFile[fileTable[i].name];
    IF fileTable[i].file # nullFile AND fileTable[i].span = nullSpan THEN {
      version: TimeStamp.Stamp;
      d: Strings.SubStringDescriptor _ [fileTable[i].type, 0, fileTable[i].type.length];
      [version, fileTable[i].span] _ ReadHeader[CIFS.GetFC[fileTable[i].file], @d];
      IF version # fileTable[i].version THEN {
        ClearCacheEntry[i];
	fileTable[i].file _ nullFile;  fileTable[i].span _ nullSpan}}};


 -- low-level file manipulation and cache management

  zone: UNCOUNTED ZONE _ NIL;

  nullFile: CIFS.OpenFile = NIL;
  nullSpan: FileSegment.Span = FileSegment.nullSpan;
      
  FileRecord: TYPE = RECORD[
    version: TimeStamp.Stamp _ ,
    file: CIFS.OpenFile _ nullFile,
    span: FileSegment.Span _ nullSpan,
    name: Strings.String _ NIL,
    type: Strings.String _ NIL];
  FileTable: TYPE = RECORD [SEQUENCE length: FileIndex OF FileRecord];
    
  fileTable: REF 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: REF 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].file # nullFile THEN {
      CIFS.Close[fileTable[i].file]; fileTable[i].file _ nullFile};
    IF fileTable[i].name # NIL THEN zone.FREE[@fileTable[i].name];
    IF fileTable[i].type # NIL THEN zone.FREE[@fileTable[i].type]};


  -- file setup

  NameToRope: PROC [s: Strings.String] RETURNS [r: Rope.ROPE] = {
    oldLength: CARDINAL = s.length;
    IF oldLength > 1 AND s[s.length-1] = '. THEN
      s.length _ s.length - 1;	-- undo Alto convention for Pilot
    r _ ConvertUnsafe.ToRope[s];
    s.length _ oldLength;
    RETURN};

  CreateFile: PROC [s: Strings.String] RETURNS [file: CIFS.OpenFile _ nullFile] = {
    IF s # NIL THEN
      file _ CIFS.Open[NameToRope[s], CIFS.read ! CIFS.Error => TRUSTED {CONTINUE}];
    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 + (WITH m: mtb[mti] SELECT FROM
		  direct => BcdDefs.MTRecord.direct.SIZE + m.length*BcdDefs.Link.SIZE,
		  indirect => BcdDefs.MTRecord.indirect.SIZE,
		  multiple => BcdDefs.MTRecord.multiple.SIZE,
		  ENDCASE => ERROR);
	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};

  }.