<> <> <> <> <> DIRECTORY Disk USING[ Channel, DoIO, GetBootChainLink, invalid, Label, labelCheck, ok, PageNumber, PageCount, Request, SameDrive, Status ], DiskFace USING[ wordsPerPage ], File USING[ Error, FP, GetVolumeID, nullFP, PageCount, PageNumber, PagesForWords, PropertyStorage, propertyWords, RC, Reason, Volume, VolumeFile, VolumeID ], FileInternal, FileStats USING[ Data, Type, Pulses ], PrincOpsUtils USING[ LongCOPY ], ProcessorFace USING[ GetClockPulses ], VolumeFormat USING[ AbsID, Attributes, lastLogicalRun, LogicalPage, LogicalRun, LogicalRunObject, RelID, RunPageCount ], VM USING[ AddressToPageNumber, Allocate, Free, Interval, PageCount, PageNumber, PageNumberToAddress, SwapIn, Unpin, wordsPerPage, WordsToPages], VMSideDoor USING[ AttachBackingStorage, Run, RunTableIndex, RunTableObject, RunTablePageNumber ]; FileImpl: CEDAR MONITOR LOCKS file USING file: Handle IMPORTS Disk, File, FileInternal, PrincOpsUtils, ProcessorFace, VM, VMSideDoor EXPORTS DiskFace--RelID,AbsID,Attributes--, File, FileInternal, FileStats SHARES File = BEGIN -- ******** Data Types and minor subroutines ******** -- --DiskFace.--Attributes: PUBLIC TYPE = VolumeFormat.Attributes; --DiskFace.--AbsID: PUBLIC TYPE = VolumeFormat.AbsID; --DiskFace.--RelID: PUBLIC TYPE = VolumeFormat.RelID; --File.--DA: PUBLIC TYPE = VolumeFormat.LogicalPage; Handle: TYPE = REF Object; --File.--Object: PUBLIC TYPE = FileInternal.Object; RunTable: TYPE = FileInternal.RunTable; RunTableObject: TYPE = VMSideDoor.RunTableObject; RunTableIndex: TYPE = VMSideDoor.RunTableIndex; PhysicalRun: TYPE = FileInternal.PhysicalRun; lastRun: VMSideDoor.RunTablePageNumber = LAST[INT]; -- end marker in runTable -- initRuns: CARDINAL = (DiskFace.wordsPerPage-SIZE[VolumeFormat.LogicalRunObject[0]]) / SIZE[VolumeFormat.LogicalRun]; DoPinnedIO: PROC[channel: Disk.Channel, label: LONG POINTER TO Disk.Label, req: POINTER TO Disk.Request] RETURNS[ status: Disk.Status, countDone: Disk.PageCount] = TRUSTED BEGIN interval: VM.Interval = [ page: VM.AddressToPageNumber[req.data], count: VM.WordsToPages[ (IF req.incrementDataPtr THEN req.count ELSE 1)*DiskFace.wordsPerPage] ]; VM.SwapIn[interval: interval, kill: req.command.data=read, pin: TRUE]; [status, countDone] _ Disk.DoIO[channel, label, req ! UNWIND => VM.Unpin[interval] ]; VM.Unpin[interval]; END; --File.--Error: PUBLIC ERROR[why: File.Reason] = CODE; CheckStatus: PROC[status: Disk.Status] = BEGIN why: File.RC = FileInternal.TranslateStatus[status]; IF why # ok THEN ERROR File.Error[why]; END; -- ******** Header and Run-table management ******** -- propFilePages: File.PageCount = File.PagesForWords[File.propertyWords]; --FileInternal.--GetHeaderVM: PUBLIC PROC[file: Handle, runs: CARDINAL] = TRUSTED BEGIN oldVM: LONG POINTER = file.headerVM; oldHeaderVMPages: INT = file.headerVMPages; oldProperties: File.PropertyStorage = file.properties; oldLogical: LONG POINTER TO VolumeFormat.LogicalRunObject = file.logicalRunTable; runTableWords: INT = SIZE[VolumeFormat.LogicalRunObject[runs]]; vmPages: INT = VM.WordsToPages[runTableWords] + VM.WordsToPages[File.propertyWords]; runTableFilePages: File.PageCount = File.PagesForWords[runTableWords]; file.headerVM _ VM.PageNumberToAddress[VM.Allocate[vmPages].page]; file.headerVMPages _ vmPages; -- assign only after VM.Allocate succeeds file.properties _ LOOPHOLE[file.headerVM+runTableFilePages*DiskFace.wordsPerPage]; file.logicalRunTable _ LOOPHOLE[file.headerVM]; file.logicalRunTable.headerPages _ runTableFilePages + propFilePages; file.logicalRunTable.maxRuns _ runs; IF oldVM = NIL THEN BEGIN -- initialise only -- file.logicalRunTable[0].first _ VolumeFormat.lastLogicalRun; file.properties^ _ ALL[0]; END ELSE BEGIN -- initialise from old tables -- PrincOpsUtils.LongCOPY[from: oldLogical, to: file.logicalRunTable, -- may copy extra nwords: MIN[runTableWords, oldHeaderVMPages*VM.wordsPerPage] ]; file.properties^ _ oldProperties^; VM.Free[[VM.AddressToPageNumber[oldVM], oldHeaderVMPages]]; END; END; --FileInternal.--FreeHeaderVM: PUBLIC PROC[file: Handle] = TRUSTED BEGIN IF file.headerVMPages # 0 THEN VM.Free[[VM.AddressToPageNumber[file.headerVM], file.headerVMPages]]; file.headerVMPages _ 0; file.headerVM _ NIL; file.logicalRunTable _ NIL; file.properties _ NIL END; --FileInternal.--TranslateLogicalRunTable: PUBLIC PROC[file: Handle] RETURNS[ File.PageCount ] = TRUSTED BEGIN nRuns: CARDINAL; filePage: File.PageNumber _ [-file.logicalRunTable.headerPages]; FOR nRuns IN [0..file.logicalRunTable.maxRuns) DO IF file.logicalRunTable[nRuns].first = VolumeFormat.lastLogicalRun THEN EXIT; REPEAT FINISHED => ERROR File.Error[inconsistent] ENDLOOP; IF file.runTable = NIL OR file.runTable.length < nRuns+10--arbitrary-- THEN file.runTable _ NEW[RunTableObject[nRuns+10]]; file.runTable.nRuns _ nRuns; FOR i: CARDINAL IN [0..nRuns) DO IF file.logicalRunTable[i].first = VolumeFormat.lastLogicalRun THEN EXIT; [channel: file.runTable[i].channel, diskPage: file.runTable[i].diskPage] _ FileInternal.TranslateLogicalRun[file.logicalRunTable[i], file.volume]; file.runTable[i].filePage _ filePage; filePage _ [filePage + file.logicalRunTable[i].size]; ENDLOOP; file.runTable.nDataPages _ filePage; file.runTable[file.runTable.nRuns].filePage _ lastRun; RETURN[ file.runTable.nDataPages ] END; --FileInternal.--AddRun: PUBLIC PROC[file: Handle, run: POINTER TO PhysicalRun, logicalPage: VolumeFormat.LogicalPage, okPages: VolumeFormat.RunPageCount] = TRUSTED BEGIN <> logical: LONG POINTER TO VolumeFormat.LogicalRunObject = file.logicalRunTable; physical: RunTable = file.runTable; oldNRuns: CARDINAL = physical.nRuns; physical.nDataPages _ file.size + okPages; IF oldNRuns > 0 AND logical[oldNRuns-1].first + logical[oldNRuns-1].size = logicalPage AND logical[oldNRuns-1].size <= LAST[VolumeFormat.RunPageCount] - okPages AND run.channel = physical[oldNRuns-1].channel THEN logical[oldNRuns-1].size _ logical[oldNRuns-1].size + okPages ELSE BEGIN -- Add another run IF physical.nRuns+1 = logical.maxRuns THEN BEGIN -- extend logical run table to ensure there is space to record an extension -- ERROR File.Error[fragmented] END; physical[oldNRuns] _ run^; logical[oldNRuns].first _ logicalPage; logical[oldNRuns].size _ okPages; physical.nRuns _ oldNRuns + 1; IF physical.nRuns = physical.length THEN BEGIN -- extend physical run table object -- file.runTable _ NEW[RunTableObject[physical.length*2]]; <> file.runTable.nDataPages _ physical.nDataPages; file.runTable.nRuns _ physical.nRuns; FOR i: CARDINAL IN [0..physical.length) DO file.runTable[i] _ physical[i] ENDLOOP; END; file.runTable[oldNRuns + 1].filePage _ lastRun; logical[oldNRuns + 1].first _ VolumeFormat.lastLogicalRun; END; END; --FileInternal.--LastLogicalPage: PUBLIC PROC[file: Handle] RETURNS [VolumeFormat.LogicalPage] = TRUSTED BEGIN < 0>> lastRun: VolumeFormat.LogicalRun = file.logicalRunTable[file.runTable.nRuns-1]; RETURN[ [lastRun.first + lastRun.size-1] ] END; --FileInternal.--RemoveFromRunTable: PUBLIC PROC[file: Handle, remove: INT] = TRUSTED BEGIN logical: LONG POINTER TO VolumeFormat.LogicalRunObject = file.logicalRunTable; physical: RunTable = file.runTable; physical.nDataPages _ file.size; WHILE remove > 0 DO IF physical.nRuns = 0 THEN ERROR File.Error[inconsistent]; BEGIN runSize: VolumeFormat.RunPageCount = logical[physical.nRuns-1].size; amount: VolumeFormat.RunPageCount = MIN[remove, runSize]; logical[physical.nRuns-1].size _ runSize - amount; IF runSize - amount = 0 THEN BEGIN -- Remove the new run table entry entirely! -- physical.nRuns _ physical.nRuns - 1; physical[physical.nRuns].filePage _ lastRun; logical[physical.nRuns].first _ VolumeFormat.lastLogicalRun; END; remove _ remove - amount; END; ENDLOOP; END; --FileInternal.--FindRun: PUBLIC PROC[start: File.PageNumber, nPages: File.PageCount, runTable: RunTable] RETURNS[diskPage: Disk.PageNumber, size: Disk.PageCount, channel: Disk.Channel] = BEGIN probe: RunTableIndex _ runTable.nRuns / 2; -- NB: round down -- increment: CARDINAL _ probe; IF runTable.nRuns = 0 THEN ERROR File.Error[inconsistent]; IF start + nPages > runTable.nDataPages THEN ERROR File.Error[unknownPage]; IF start < runTable[0].filePage THEN ERROR File.Error[unknownPage]; DO increment _ (increment+1)/2; SELECT TRUE FROM runTable[probe].filePage > start => probe _ IF probe < increment THEN 0 ELSE probe-increment; runTable[probe+1].filePage <= start => probe _ MIN[probe + increment, runTable.nRuns-1]; ENDCASE => RETURN[ diskPage: [runTable[probe].diskPage + (start-runTable[probe].filePage)], size: IF start + nPages <= runTable[probe+1].filePage THEN nPages ELSE runTable[probe+1].filePage - start, channel: runTable[probe].channel ] ENDLOOP; END; -- ******** Subroutines for access to file pages ******** -- HeaderLabel: PROC[fp: File.FP] RETURNS[Disk.Label] = BEGIN RETURN[ [ fileID: [rel[RelID[fp]]], filePage: 0, attributes: Attributes[header], dontCare: LOOPHOLE[LONG[0]] ] ] END; DataLabel: PROC[fp: File.FP] RETURNS[Disk.Label] = BEGIN RETURN[ [ fileID: [rel[RelID[fp]]], filePage: 0, attributes: Attributes[data], dontCare: LOOPHOLE[LONG[0]] ] ] END; FreeLabel: PROC[volume: File.Volume] RETURNS[Disk.Label] = BEGIN RETURN[ [ fileID: [abs[AbsID[File.GetVolumeID[volume]]]], filePage: 0, attributes: Attributes[freePage], dontCare: LOOPHOLE[LONG[0]] ] ] END; WriteLabels: PROC[channel: Disk.Channel, diskPage: Disk.PageNumber, count: Disk.PageCount, data: LONG POINTER, label: LONG POINTER TO Disk.Label] RETURNS[ status: Disk.Status, countDone: Disk.PageCount] = TRUSTED BEGIN req: Disk.Request _ [ diskPage: diskPage, data: IF data = NIL THEN scratchWriter ELSE data, incrementDataPtr: data # NIL, command: [header: verify, label: write, data: write], count: count ]; [status, countDone] _ DoPinnedIO[channel, label, @req]; END; GetScratchPage: PROC RETURNS[data: LONG POINTER] = TRUSTED BEGIN temp: LONG POINTER TO ARRAY [0..DiskFace.wordsPerPage) OF WORD; data _ VM.PageNumberToAddress[VM.Allocate[VM.WordsToPages[DiskFace.wordsPerPage]].page]; temp _ LOOPHOLE[data]; temp^ _ ALL[0]; END; FreeScratchPage: PROC[data: LONG POINTER] = TRUSTED BEGIN VM.Free[ [ page: VM.AddressToPageNumber[data], count: VM.WordsToPages[DiskFace.wordsPerPage] ] ]; END; scratchWriter: LONG POINTER = GetScratchPage[]; -- scratch buffer for writing (all 0) scratchReader: LONG POINTER = GetScratchPage[]; -- scratch buffer for reading --FileInternal.--FreeRun: PUBLIC PROC[logicalRun: VolumeFormat.LogicalRun, volume: File.Volume] = BEGIN -- Write page labels as "free" and mark as unused in VAM -- label: Disk.Label _ FreeLabel[volume]; FileInternal.Free[volume, logicalRun]; WHILE logicalRun.size > 0 DO channel: Disk.Channel; diskPage: Disk.PageNumber; status: Disk.Status; countDone: Disk.PageCount; [channel, diskPage] _ FileInternal.TranslateLogicalRun[logicalRun, volume]; label.filePage _ logicalRun.first; TRUSTED{[status, countDone] _ WriteLabels[channel, diskPage, logicalRun.size, NIL, @label]}; SELECT status FROM Disk.ok => NULL; Disk.invalid => ERROR File.Error[wentOffline]; ENDCASE => BEGIN -- Couldn't write label, so assume page is bad -- countDone _ countDone + 1; END; logicalRun.first _ [logicalRun.first + countDone]; logicalRun.size _ logicalRun.size - countDone; ENDLOOP; END--FreeRun--; maxTransferRun: Disk.PageCount _ 100; <> Transfer: PROC[file: Handle, data: LONG POINTER, filePage: File.PageNumber, nPages: File.PageCount, action: {write, read}, where: {header, data} ] = BEGIN label: Disk.Label _ IF where = header THEN HeaderLabel[file.fp] ELSE DataLabel[file.fp]; label.filePage _ filePage; WHILE nPages > 0 DO status: Disk.Status; countDone: Disk.PageCount; channel: Disk.Channel; req: Disk.Request; req.data _ data; req.incrementDataPtr _ TRUE; req.command _ IF action = read THEN [header: verify, label: verify, data: read] ELSE [header: verify, label: verify, data: write]; TRUSTED{ [diskPage: req.diskPage, size: req.count, channel: channel] _ FileInternal.FindRun[ -- NB: first call of FindRun checks entire transfer is within file start: IF where = header THEN [-file.logicalRunTable.headerPages+filePage] ELSE filePage, nPages: nPages, runTable: file.runTable] }; IF req.count > maxTransferRun THEN req.count _ maxTransferRun; TRUSTED{[status, countDone] _ DoPinnedIO[channel, @label, @req]}; CheckStatus[status]; TRUSTED{data _ data + countDone * DiskFace.wordsPerPage}; nPages _ nPages - countDone; filePage _ [filePage + countDone]; ENDLOOP; END; WriteRunTable: PROC[file: Handle] = TRUSTED BEGIN Transfer[file: file, data: file.headerVM, filePage: [0], nPages: file.logicalRunTable.headerPages - propFilePages, action: write, where: header] END; MakeBootable: PROC[file: Handle, firstPage: File.PageNumber] = BEGIN data: LONG POINTER; status: Disk.Status; label: Disk.Label _ DataLabel[file.fp]; countDone: Disk.PageCount; filePage: File.PageNumber _ firstPage; thisDiskPage: Disk.PageNumber; thisSize: Disk.PageCount; channel: Disk.Channel; IF file.size > firstPage THEN [diskPage: thisDiskPage, size: thisSize, channel: channel] _ FileInternal.FindRun[start: filePage, nPages: file.size-filePage, runTable: file.runTable]; data _ GetScratchPage[]; WHILE filePage + thisSize < file.size DO BEGIN ENABLE UNWIND => FreeScratchPage[data]; nextDiskPage: Disk.PageNumber; nextSize: Disk.PageCount; nextChannel: Disk.Channel; req: Disk.Request; filePage _ [filePage+thisSize]; -- file page number of start of next run thisDiskPage _ [thisDiskPage + thisSize - 1]; -- disk page number of last page of this run [diskPage: nextDiskPage, size: nextSize, channel: nextChannel] _ FileInternal.FindRun[start: filePage, nPages: file.size-filePage, runTable: file.runTable]; IF NOT Disk.SameDrive[nextChannel, channel] THEN ERROR File.Error[mixedDevices]; label.filePage _ filePage-1; req _ [ diskPage: thisDiskPage, data: data, incrementDataPtr: TRUE, command: [header: verify, label: verify, data: read], count: 1 ]; TRUSTED{[status, countDone] _ DoPinnedIO[channel, @label, @req]}; CheckStatus[status]; label.dontCare _ Disk.GetBootChainLink[channel, nextDiskPage]; label.filePage _ filePage-1; TRUSTED{[status, countDone] _ WriteLabels[channel, thisDiskPage, 1, data, @label]}; CheckStatus[status]; thisDiskPage _ nextDiskPage; thisSize _ nextSize; END ENDLOOP; FreeScratchPage[data]; END; Extend: PROC[file: Handle, amount: INT, create: BOOL, report: PROC[File.FP]] = BEGIN <> volume: File.Volume = file.volume; nearTo: VolumeFormat.LogicalPage _ -- hint for FileInternal.Alloc -- IF create THEN [0] ELSE FileInternal.LastLogicalPage[file]; headerVMPos: LONG POINTER _ file.headerVM; -- headerVM to be written to disk (creating) freeLabel: Disk.Label _ FreeLabel[volume]; freeReq: Disk.Request _ [ diskPage:, data: scratchReader, incrementDataPtr: FALSE, command: [header: verify, label: verify, data: read], count: ]; label: Disk.Label; IF NOT create THEN BEGIN label _ DataLabel[file.fp]; label.filePage _ file.size; END; <> WHILE amount > 0 -- Loop for each allocated disk run -- DO logicalRun: VolumeFormat.LogicalRun _ FileInternal.Alloc[volume: volume, first: nearTo, size: amount ]; nearTo _ [logicalRun.first + logicalRun.size]; -- hint for next call of Alloc -- WHILE logicalRun.size > 0 -- Loop for each available fragment of disk run -- DO labelsOK: Disk.PageCount; -- count of labels that are genuinely free pages -- status: Disk.Status; run: PhysicalRun; [run.channel, run.diskPage] _ FileInternal.TranslateLogicalRun[logicalRun, volume]; run.filePage _ file.size; freeReq.diskPage _ run.diskPage; freeReq.count _ logicalRun.size; freeLabel.filePage _ logicalRun.first; TRUSTED{ [status, labelsOK] _ DoPinnedIO[run.channel, @freeLabel, @freeReq] -- verify free --}; IF labelsOK > 0 THEN BEGIN labelsWritten: Disk.PageCount _ 0; -- total labels actually written -- labelsThisTime: Disk.PageCount _ 0; -- labels written in this transfer -- Consume: PROC = BEGIN file.size _ file.size + labelsThisTime; labelsWritten _ labelsWritten + labelsThisTime; amount _ amount - labelsThisTime; logicalRun.first _ [logicalRun.first+labelsThisTime]; logicalRun.size _ logicalRun.size - labelsThisTime; END; firstHeaderPage: BOOL = file.runTable.nRuns = 0; TRUSTED{FileInternal.AddRun[file, @run, logicalRun.first, labelsOK]}; IF firstHeaderPage THEN BEGIN IF NOT create THEN ERROR File.Error[inconsistent]; file.fp _ [id: FileInternal.NewID[volume], da: logicalRun.first]; label _ HeaderLabel[file.fp]; IF report # NIL THEN report[file.fp]; <<"create" must be TRUE, and ensuing transfer will write the run table to disk>> END ELSE WriteRunTable[file];-- ensure run-table is superset of allocated pages IF create THEN BEGIN -- write labels and data for header area -- TRUSTED{[status, labelsThisTime] _ WriteLabels[run.channel, run.diskPage, MIN[-file.size, labelsOK], headerVMPos, @label]}; Consume[]; IF file.size < 0 -- still writing header pages THEN TRUSTED{ headerVMPos _ headerVMPos + labelsThisTime * DiskFace.wordsPerPage} ELSE BEGIN create _ FALSE; label _ DataLabel[file.fp]; label.filePage _ file.size; END; END; IF labelsOK > labelsWritten AND NOT create -- i.e. if there's still pages free and creation completed THEN BEGIN TRUSTED{[status, labelsThisTime] _ WriteLabels[run.channel, [run.diskPage+labelsThisTime], labelsOK-labelsWritten, NIL, @label]}; Consume[]; END; -- correct run-table to number of pages successfully written -- IF labelsOK > labelsWritten THEN FileInternal.RemoveFromRunTable[file, labelsOK-labelsWritten]; END; SELECT status FROM Disk.ok => NULL; Disk.invalid => ERROR File.Error[wentOffline]; ENDCASE => -- skip bad/in-use page -- { logicalRun.first _ [logicalRun.first+1]; logicalRun.size _ logicalRun.size-1 }; ENDLOOP-- Loop for each available fragment of disk run --; ENDLOOP-- Loop for each allocated disk run --; END--Extend--; Contract: PROC[file: Handle, delete: BOOL, newSize: File.PageCount--iff NOT delete--] = TRUSTED BEGIN logical: LONG POINTER TO VolumeFormat.LogicalRunObject = file.logicalRunTable; WHILE delete OR file.size > newSize DO IF file.runTable.nRuns=0 THEN { IF delete THEN EXIT ELSE ERROR File.Error[inconsistent] }; BEGIN lastRun: VolumeFormat.LogicalRun _ logical[file.runTable.nRuns-1]; thisTime: VolumeFormat.RunPageCount = IF NOT delete THEN MIN[file.size-newSize, lastRun.size] ELSE lastRun.size; file.size _ file.size - thisTime; FileInternal.RemoveFromRunTable[file, thisTime]; FreeRun[[first: [lastRun.first + lastRun.size-thisTime], size: thisTime], file.volume]; END; ENDLOOP; IF NOT delete THEN WriteRunTable[file]; END--Contract--; DoOpen: PROC[file: Handle] = TRUSTED BEGIN volume: File.Volume = file.volume; FileInternal.GetHeaderVM[file, initRuns]; BEGIN -- First try to transfer entire header in a single request (an optimisation!) initTryPages: INT = file.logicalRunTable.headerPages; logicalRun: VolumeFormat.LogicalRun = [first: file.fp.da, size: initTryPages]; channel: Disk.Channel; diskPage: Disk.PageNumber; label: Disk.Label; req: Disk.Request; status: Disk.Status; countDone: Disk.PageCount; [channel, diskPage] _ FileInternal.TranslateLogicalRun[logicalRun, volume]; label _ HeaderLabel[file.fp]; req _ [ diskPage: diskPage, data: file.headerVM, incrementDataPtr: TRUE, command: [header: verify, label: verify, data: read], count: initTryPages ]; TRUSTED{[status, countDone] _ DoPinnedIO[channel, @label, @req]}; IF countDone = 0 THEN BEGIN IF status = Disk.labelCheck THEN ERROR File.Error[unknownFile] ELSE CheckStatus[status]; END; IF file.logicalRunTable.headerPages # initTryPages -- multi-page run-tables! THEN ERROR File.Error[inconsistent]; file.size _ FileInternal.TranslateLogicalRunTable[file]; -- assumes single-page run-table IF countDone # file.logicalRunTable.headerPages THEN -- read in the remaining header pages (e.g. property page) Transfer[file: file, data: file.headerVM + countDone*DiskFace.wordsPerPage, filePage: [countDone], nPages: file.logicalRunTable.headerPages - countDone, action: read, where: header] END; END; --FileInternal.--RegisterVMFile: PUBLIC PROC[file: Handle] = BEGIN Lock[file, shared]; BEGIN ENABLE File.Error => Unlock[file]; label: Disk.Label _ DataLabel[file.fp]; TRUSTED{ VMSideDoor.AttachBackingStorage[label, 0, file.runTable] }; END; Unlock[file]; END; LockMode: TYPE = { shared, exclusive }; unlocked: CONDITION; Lock: ENTRY PROC[file: Handle, mode: LockMode] = BEGIN ENABLE UNWIND => NULL; IF file = NIL OR file.state = deleted THEN RETURN WITH ERROR File.Error[unknownFile]; IF mode = shared THEN BEGIN WHILE file.users < 0 --writers-- DO WAIT unlocked ENDLOOP; file.users _ file.users + 1; END ELSE BEGIN WHILE file.users # 0 --anyone-- DO WAIT unlocked ENDLOOP; file.users _ file.users - 1; END; END; Unlock: ENTRY PROC[file: Handle] = BEGIN SELECT file.users FROM < 0 => file.users _ file.users + 1; > 0 => file.users _ file.users - 1; ENDCASE => NULL; BROADCAST unlocked; END; -- ******** Statistics ******** -- statistics: REF ARRAY FileStats.Type OF FileStats.Data _ NEW[ARRAY FileStats.Type OF FileStats.Data _ ALL[]]; GetPulses: PROC RETURNS[FileStats.Pulses] = TRUSTED INLINE { RETURN[ ProcessorFace.GetClockPulses[] ] }; Incr: PUBLIC --ENTRY-- PROC[type: FileStats.Type, pages: INT, startPulse: FileStats.Pulses] = BEGIN old: FileStats.Data = statistics[type]; statistics[type] _ [calls: old.calls+1, pages: old.pages+pages, pulses: old.pulses + (GetPulses[]-startPulse)]; END; --FileStats.--GetData: PUBLIC --ENTRY-- PROC[type: FileStats.Type] RETURNS[FileStats.Data] = { RETURN[statistics[type]] }; --FileStats.--ClearData: PUBLIC --ENTRY-- PROC[type: FileStats.Type] = { statistics[type] _ [] }; -- ******** Top-level procedures ******** -- --File.--Create: PUBLIC PROC[volume: File.Volume, size: File.PageCount, report: PROC[File.FP] _ NIL] RETURNS[file: Handle] = BEGIN startPulse: FileStats.Pulses = GetPulses[]; file _ FileInternal.AllocForCreate[]; -- gives us a handle not yet in FileTable file.volume _ volume; GetHeaderVM[file, initRuns]; file.size _ TranslateLogicalRunTable[file]; InnerSetSize[file: file, size: size, create: TRUE, report: report ! UNWIND => FileInternal.FreeHeaderVM[file]--Delete[File]???--]; file.state _ opened; FileInternal.Insert[file]; Incr[create, size, startPulse]; END; --File.--Open: PUBLIC PROC[volume: File.Volume, fp: File.FP] RETURNS[file: Handle] = BEGIN IF fp = File.nullFP THEN ERROR File.Error[unknownFile]; file _ FileInternal.Lookup[volume, fp.id]; Lock[file, exclusive]; IF file.state = none THEN BEGIN <> ENABLE File.Error => Unlock[file]; startPulse: FileStats.Pulses = GetPulses[]; file.fp.da _ fp.da; DoOpen[file]; file.state _ opened; Incr[open, file.size, startPulse]; END; Unlock[file]; RETURN[file] END; --File.--Delete: PUBLIC PROC[file: Handle] = BEGIN Lock[file, exclusive]; BEGIN ENABLE File.Error => Unlock[file]; startPulse: FileStats.Pulses = GetPulses[]; delta: INT = file.size; Contract[file, TRUE, ]; Incr[delete, delta, startPulse]; END; Unlock[file]; END; --File.--SetSize: PUBLIC PROC[file: Handle, size: File.PageCount] = { InnerSetSize[file: file, size: size, create: FALSE, report: NIL] }; InnerSetSize: PROC[file: Handle, size: File.PageCount, create: BOOL, report: PROC[File.FP] ] = BEGIN DO Lock[file, exclusive]; BEGIN ENABLE File.Error => BEGIN lack: INT = size-file.size; -- calculate it while we still have the file locked Unlock[file]; IF why = volumeFull AND FileInternal.Flush[file.volume, lack] THEN LOOP; <> END; startPulse: FileStats.Pulses = GetPulses[]; delta: INT = size-file.size; SELECT TRUE FROM delta > 0 => { Extend[file, delta, create, report]; Incr[extend, delta, startPulse] }; delta < 0 => { Contract[file, FALSE, size]; Incr[contract, -delta, startPulse] }; ENDCASE => NULL; END; Unlock[file]; EXIT ENDLOOP; END; --File.--Info: PUBLIC PROC[file: Handle] RETURNS[volume: File.Volume, fp: File.FP, size: File.PageCount] = BEGIN Lock[file, shared]; BEGIN ENABLE File.Error => Unlock[file]; volume _ file.volume; fp _ file.fp; size _ file.size; END; Unlock[file]; END; --File.--SetRoot: PUBLIC PROC[root: File.VolumeFile, file: Handle, page: File.PageNumber _ [0]] = TRUSTED BEGIN diskPage: Disk.PageNumber; channel: Disk.Channel; Lock[file, shared]; BEGIN ENABLE File.Error => Unlock[file]; MakeBootable[file, page]; [diskPage: diskPage, channel: channel] _ FileInternal.FindRun[start: page, nPages: 1, runTable: file.runTable]; FileInternal.RecordRootFile[file.volume, root, file.fp, page, RelID[file.fp], Disk.GetBootChainLink[channel, diskPage], channel]; END; Unlock[file]; END; --File.--Read: PUBLIC UNSAFE PROC[file: Handle, from: File.PageNumber, nPages: File.PageCount, to: LONG POINTER] = BEGIN IF from < 0 THEN ERROR File.Error[unknownPage]; Lock[file, shared]; BEGIN ENABLE File.Error => Unlock[file]; startPulse: FileStats.Pulses = GetPulses[]; Transfer[file: file, data: to, filePage: from, nPages: nPages, action: read, where: data]; Incr[read, nPages, startPulse]; END; Unlock[file]; END; --File.--Write: PUBLIC PROC[file: Handle, to: File.PageNumber, nPages: File.PageCount, from: LONG POINTER] = BEGIN IF to < 0 THEN ERROR File.Error[unknownPage]; Lock[file, shared]; BEGIN ENABLE File.Error => Unlock[file]; startPulse: FileStats.Pulses = GetPulses[]; Transfer[file: file, data: from, filePage: to, nPages: nPages, action: write, where: data]; Incr[write, nPages, startPulse]; END; Unlock[file]; END; --File.--GetProperties: PUBLIC PROC[file: Handle] RETURNS[p: File.PropertyStorage] = BEGIN Lock[file, shared]; BEGIN ENABLE File.Error => Unlock[file]; p _ file.properties; END; Unlock[file]; END; --File.--WriteProperties: PUBLIC PROC[file: Handle] = TRUSTED BEGIN Lock[file, shared]; BEGIN ENABLE File.Error => Unlock[file]; Transfer[file: file, data: file.properties, filePage: [file.logicalRunTable.headerPages-propFilePages], nPages: propFilePages, action: write, where: header] END; Unlock[file]; END; END.