Cedar Nucleus (Files): per-file operations, locking file header data structures
FileImpl.mesa
Andrew Birrell August 5, 1983 4:47 pm
Last Edited by: Levin, May 20, 1983 5:19 pm
Last Edited by: Schroeder, June 10, 1983 5:20 pm
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
Either extend last run, or add new run
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^ ← physical^ . . . . but the compiler can't copy sequences
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
Assumes file.runTable.nRuns > 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;
Largest number of disk pages to transfer in single request. This much VM will be pinned during the transfer. Variable, not constant, to allow patching.
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
NOTE: on entry, if "create", then file.size = -(number of header pages) and file.fp = nullFP.
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;
Otherwise, wait until we know the FP!
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
File is in table but has not yet been opened. We try it, under the file's exclusive lock
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;
Otherwise, let the error propagate to our client
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.