<> <> <> <> <> DIRECTORY BcdDefs: TYPE USING [Base, BcdBase, Link, MTIndex, MTRecord, NameString, SGIndex, FTSelf, SGNull, VersionID, VersionStamp], CommandUtil: TYPE USING [PairList, KeyValue], ConvertUnsafe: TYPE USING [EqualSubStrings, SubString], FS: TYPE USING [Create, Close, Error, Read, nullOpenFile, Open, OpenFile], FileParms: TYPE USING [ActualId, BindingProc, Name, Ops, SymbolSpace, nullActual, nullSymbolSpace], FileParmOps: TYPE USING [], FileSegment: TYPE USING [Span, nullSpan], Rope: TYPE USING [Concat, Equal, Find, Flatten, Length, ROPE], VM: TYPE USING [Allocate, Free, Interval, nullInterval, AddressForPageNumber]; FileParmPack: PROGRAM IMPORTS CommandUtil, ConvertUnsafe, FS, Rope, VM EXPORTS FileParmOps = { Name: TYPE = FileParms.Name; ActualId: TYPE = FileParms.ActualId; nullActual: ActualId = FileParms.nullActual; FileIndex: TYPE = NAT; nullFileIndex: FileIndex = FileIndex.LAST; <> Binding: PROC[ formalId, formalType: Name, defaultLocator: Name, binder: FileParms.BindingProc] = { i: FileIndex; name: Rope.ROPE = FileName[formalId, defaultLocator]; type: Rope.ROPE = formalType; IF name = NIL THEN i _ nullFileIndex ELSE { file: FS.OpenFile _ FS.nullOpenFile; FOR i IN [0 .. nextFile) DO IF name.Equal[fileTable[i].name, FALSE] THEN { IF type.Equal[fileTable[i].type, FALSE] THEN GO TO found; file _ fileTable[i].file}; REPEAT found => NULL; FINISHED => { matched: BOOL = (file # FS.nullOpenFile); IF ~matched THEN file _ FS.Open[name, $read ! FS.Error => TRUSTED {CONTINUE}]; IF file = FS.nullOpenFile THEN i _ nullFileIndex ELSE { version: BcdDefs.VersionStamp; span: FileSegment.Span; [version, span] _ ReadHeader[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 IF ~matched THEN {file.Close[]; file _ FS.nullOpenFile}}; }; ENDLOOP; IF i = nullFileIndex THEN binder[nullActual] ELSE binder[[fileTable[i].version, fileTable[i].name]]}}; 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: actual.locator, type: id]}; OpenFile[i]; RETURN[IF fileTable[i].file = FS.nullOpenFile OR fileTable[i].span = nullSpan THEN FileParms.nullSymbolSpace ELSE [file: 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 { IF (fileTable[i].name).Equal[actual.locator, FALSE] 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 }; <> outputFile: FS.OpenFile; AcquireOutput: PUBLIC PROC[name: Rope.ROPE] RETURNS[FS.OpenFile] = { outputFile _ FS.Create[name]; RETURN[outputFile]}; ReleaseOutput: PUBLIC PROC[file: FS.OpenFile] = { <> file.Close[ ! FS.Error => CONTINUE]; outputFile _ FS.nullOpenFile}; <> aList: CommandUtil.PairList; SetAList: PUBLIC PROC [map: CommandUtil.PairList] = {aList _ map}; ClearAList: PUBLIC PROC = {aList _ NIL}; <> Initialize: PUBLIC PROC RETURNS[FileParms.Ops] = { fileTable _ NIL; AdjustFileTable[16]; nextFile _ 0; outputFile _ FS.nullOpenFile; RETURN[[Binding, Acquire, Release, Forget]]}; Finalize: PUBLIC PROC = { FOR i: NAT IN [0..nextFile) DO ClearCacheEntry[i] ENDLOOP; IF outputFile # FS.nullOpenFile THEN { outputFile.Close[]; outputFile _ FS.nullOpenFile}; fileTable _ NIL}; <> FileName: PROC[key: Name, default: Name] RETURNS[Rope.ROPE] = { t: Rope.ROPE _ CommandUtil.KeyValue[key, aList]; IF t = NIL THEN t _ default; IF t = NIL THEN t _ key; RETURN[NormalizeFileName[t]]}; NormalizeFileName: PROC[formal: Name] RETURNS[s: Rope.ROPE] = INLINE { IF formal.Equal["$"] THEN s _ NIL ELSE { dotIndex: INT = formal.Find["."]; s _ IF dotIndex < 0 THEN formal.Concat[".bcd"] ELSE formal}; RETURN}; <> OpenFile: PROC [i: FileIndex] = { IF fileTable[i].file = FS.nullOpenFile AND fileTable[i].name # NIL THEN fileTable[i].file _ FS.Open[fileTable[i].name ! FS.Error => TRUSTED {CONTINUE}]; IF fileTable[i].file # FS.nullOpenFile AND fileTable[i].span = nullSpan THEN { version: BcdDefs.VersionStamp; [version, fileTable[i].span] _ ReadHeader[fileTable[i].file, fileTable[i].type]; IF version # fileTable[i].version THEN { ClearCacheEntry[i]; fileTable[i].file _ FS.nullOpenFile; fileTable[i].span _ nullSpan} } }; <> nullSpan: FileSegment.Span = FileSegment.nullSpan; FileRecord: TYPE = RECORD[ version: BcdDefs.VersionStamp_, file: FS.OpenFile_FS.nullOpenFile, span: FileSegment.Span_nullSpan, name: Name_NIL, type: Name_NIL]; FileTable: TYPE = RECORD[SEQUENCE length: FileIndex OF FileRecord]; fileTable: REF FileTable; nextFile: NAT; <> SearchCache: PROC[version: BcdDefs.VersionStamp] 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 _ 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}; fileTable _ newTable}; ClearCacheEntry: PROC[i: FileIndex] = { IF fileTable[i].file # FS.nullOpenFile THEN { (fileTable[i].file).Close[ ! FS.Error => IF error.code = $invalidOpenFile THEN CONTINUE]; fileTable[i].file _ FS.nullOpenFile}; fileTable[i].name _ fileTable[i].type _ NIL}; <> ReadHeader: PROC[file: FS.OpenFile, formalId: Name] RETURNS[ version: BcdDefs.VersionStamp _ nullActual.version, span: FileSegment.Span _ nullSpan] = { headerInterval: VM.Interval _ VM.nullInterval; DeleteHeader: PROC = { IF headerInterval # VM.nullInterval THEN { headerInterval.Free[]; headerInterval _ VM.nullInterval} }; IF file # FS.nullOpenFile THEN { ENABLE { UNWIND => {NULL}; ANY => {GO TO badFile}}; BcdBase: PROC [p: LONG POINTER] RETURNS [BcdDefs.Base] = INLINE { RETURN [LOOPHOLE[p, BcdDefs.Base]]}; bcd: BcdDefs.BcdBase; bcdPages: CARDINAL _ 1; mtb, ftb, sgb: BcdDefs.Base; mti: BcdDefs.MTIndex; sSeg: BcdDefs.SGIndex; nString: BcdDefs.NameString; typeId: ConvertUnsafe.SubString; d: ConvertUnsafe.SubString; DO headerInterval _ VM.Allocate[count: bcdPages]; bcd _ VM.AddressForPageNumber[headerInterval.page]; file.Read[from: 0, nPages: bcdPages, to: bcd]; IF bcd.versionIdent # BcdDefs.VersionID THEN GOTO badFile; IF bcdPages >= bcd.nPages THEN EXIT; bcdPages _ bcd.nPages; headerInterval.Free[]; headerInterval _ VM.nullInterval ENDLOOP; IF bcd.nConfigs # 0 THEN GOTO badFile; -- no packaged bcd's (for now) nString _ LOOPHOLE[bcd + bcd.ssOffset]; typeId.base _ LOOPHOLE[formalId.Flatten[]]; typeId.offset _ 0; typeId.length _ formalId.Length[]; 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 ConvertUnsafe.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 - 1, pages: sgb[sSeg].pages]; DeleteHeader[]; EXITS badFile => {DeleteHeader[]; span _ nullSpan} }; RETURN}; }.