PFSClassImpl.mesa
Copyright Ó 1989, 1991, 1992 by Xerox Corporation. All rights reserved.
Carl Hauser, June 7, 1989 10:26:27 am PDT
Chauser, June 21, 1990 10:48 am PDT
Willie-s, May 1, 1992 1:15 pm PDT
DIRECTORY
Atom,
BasicTime USING[GetClockPulses, Pulses, PulsesToMicroseconds],
PFSClass,
Process,
Rope USING [Concat, EqualSubstrs, Length, ROPE, Substr],
SymTab
;
PFSClassImpl: CEDAR MONITOR
IMPORTS SymTab, BasicTime, Rope, Atom, Process
EXPORTS PFSClass
~ {
OPEN PFSClass;
Constants
viewUnix: PUBLIC ATOM ¬ $viewUnix;
viewCedar: PUBLIC ATOM ¬ $viewCedar;
Copied Types
ROPE: TYPE ~ Rope.ROPE;
Pulses: TYPE ~ BasicTime.Pulses;
Parameters
secsBetweenSweeps: INT ¬ 6;
downFSTTL: CARD ¬ 60; -- seconds
waitForFSTimeout: INT ¬ 60; -- seconds
Time Intervals Using Pulses
NowPulses: PROC RETURNS [Pulses] ~ --INLINE-- { RETURN[BasicTime.GetClockPulses[]] };
PeriodPulses: PROC [from, to: Pulses] RETURNS [delta: CARD] ~ INLINE {
delta ¬ to - from;
IF LOOPHOLE[delta, INT] < 0 THEN delta ¬ 0;
};
PulsesToSeconds: PROC [pulses: Pulses] RETURNS [seconds: INT] ~ {
t1: CARD ¬ BasicTime.PulsesToMicroseconds[pulses];
t2: CARD ¬ t1 + 500000;
t2 ¬ MAX[t1, t2];
RETURN [t2 / 1000000]; -- no bounds fault
};
Registration
Registration: TYPE ~ REF RegistrationObject;
RegistrationObject: TYPE ~ RECORD [
next: Registration,
flavor: ATOM,
nameSuffix: ROPE,
getHandle: GetHandleProc
];
registrations: Registration ¬ NIL;
Register: PUBLIC ENTRY PROC [flavor: ATOM, getHandle: GetHandleProc] ~ {
no ENABLE UNWIND
p, prev: Registration;
nameSuffix: ROPE ¬ Rope.Concat["-", Atom.GetPName[flavor]];
FOR p ¬ registrations, p.next WHILE p # NIL DO
IF p.flavor = flavor THEN {
IF prev = NIL THEN registrations ¬ p.next ELSE prev.next ¬ p.next;
EXIT;
};
prev ¬ p;
ENDLOOP;
IF getHandle # NIL
THEN registrations ¬ NEW[RegistrationObject ¬ [registrations, flavor, nameSuffix, getHandle]];
};
Server Handle Cache
fsTab: SymTab.Ref ¬ SymTab.Create[case~FALSE];
lastSweepTimePulses: Pulses ¬ NowPulses[];
readyToSweep: CONDITION;
Daemon: PROC ~ {
seconds: INT ¬ 0;
CallSweep: SymTab.EachPairAction -- [key, val] RETURNS [quit] -- ~ {
h: FSHandle ~ NARROW[val];
h.maintenanceProcs.sweep[h, CARD[seconds]];
RETURN [FALSE];
};
WaitReadyToSweep: ENTRY PROC ~ INLINE {
ENABLE UNWIND => NULL;
DO
thisSweepTimePulses: Pulses ~ NowPulses[];
delta: Pulses ¬ PeriodPulses[from~lastSweepTimePulses, to~thisSweepTimePulses];
seconds ¬ PulsesToSeconds[delta];
IF seconds >= secsBetweenSweeps THEN {
lastSweepTimePulses ¬ thisSweepTimePulses;
EXIT;
};
WAIT readyToSweep;
ENDLOOP;
};
TRUSTED {
Process.EnableAborts[@readyToSweep];
Process.SetTimeout[@readyToSweep, Process.MsecToTicks[INT[1000]*secsBetweenSweeps]];
};
DO
WaitReadyToSweep[];
[] ¬ SymTab.Pairs[fsTab, CallSweep];
ENDLOOP;
};
ClearPFSClassCache: ENTRY PROC ~ { -- callable using interp to clear cache
ENABLE UNWIND => NULL;
SymTab.Erase[fsTab];
lastSweepTimePulses ← NowPulses[];
};
Finding a server (exported to RemoteFile)
GetFSResponse: TYPE ~ REF GetFSResponseObject;
GetFSResponseObject: TYPE ~ RECORD [
nRunning: CARDINAL ¬ 0,
wakeup: CONDITION,
handle: FSHandle ¬ NIL,
downMsg: ROPE ¬ NIL
];
GetFS: PUBLIC PROC [fs: ROPE] RETURNS [h: FSHandle] ~ {
Raises Error if server is down.
obsolete: BOOL;
downMsg: ROPE;
fsWithoutSuffix: ROPE;
kids: LIST OF PROCESS ¬ NIL;
response: GetFSResponse;
theRegistration: Registration;
startedPulses: Pulses;
MakeChild: ENTRY PROC [r: Registration] RETURNS [p: PROCESS] ~ --INLINE-- {
ENABLE UNWIND => NULL;
p ¬ FORK DoGetFS[r, fs, FALSE, response];
response.nRunning ¬ response.nRunning + 1;
};
WaitForResponse: ENTRY PROC ~ --INLINE-- {
ENABLE UNWIND => NULL;
set [h, downMsg] ...
WHILE (response.nRunning > 0) AND (response.handle = NIL) AND (response.downMsg = NIL) DO
sinceStarted: INT ~ PulsesToSeconds[PeriodPulses[from~startedPulses, to~NowPulses[]]];
IF sinceStarted >= waitForFSTimeout THEN EXIT;
TRUSTED { Process.SetTimeout[@response.wakeup, Process.MsecToTicks[1000*(waitForFSTimeout-sinceStarted)+500]] };
WAIT response.wakeup;
ENDLOOP;
h ¬ response.handle;
downMsg ¬ response.downMsg;
};
h ¬ NARROW[SymTab.Fetch[fsTab, fs].val];
IF h # NIL THEN {
[obsolete, downMsg] ¬ h.maintenanceProcs.validate[h];
IF NOT obsolete THEN {
IF downMsg # NIL THEN ErrorDownFS[h, downMsg];
RETURN;
};
};
response ¬ NEW [GetFSResponseObject];
FOR theRegistration ¬ registrations, theRegistration.next WHILE theRegistration # NIL DO
suffixLen, pos: INT;
suffixLen ¬ Rope.Length[theRegistration.nameSuffix];
pos ¬ Rope.Length[fs] - suffixLen;
IF (pos >= 0) AND Rope.EqualSubstrs[fs, pos, suffixLen, theRegistration.nameSuffix, 0, suffixLen, FALSE]
THEN { fsWithoutSuffix ¬ Rope.Substr[fs, 0, pos]; EXIT };
ENDLOOP;
IF theRegistration # NIL
THEN {
DoGetFS[theRegistration, fsWithoutSuffix, TRUE, response];
IF (h ¬ response.handle) # NIL THEN h.name ¬ fs;
downMsg ¬ response.downMsg;
};
ELSE {
startedPulses ¬ NowPulses[];
TRUSTED { Process.EnableAborts[@response.wakeup] };
FOR each: Registration ¬ registrations, each.next WHILE each # NIL DO
kids ¬ CONS [MakeChild[each], kids];
ENDLOOP;
WaitForResponse[];
FOR kid: LIST OF PROCESS ¬ kids, kid.rest WHILE kid # NIL DO
TRUSTED { Process.Abort[kid.first] };
TRUSTED { Process.Detach[kid.first] };
ENDLOOP;
};
IF h = NIL THEN {
IF downMsg = NIL
THEN {
downMsg ¬ "unknown fs";
h ¬ MakeDownFS[fs, $serverNotKnown, downMsg];
}
ELSE {
h ¬ MakeDownFS[fs, $serverNotAvailable, downMsg];
};
};
[] ¬ SymTab.Store[fsTab, h.name, h];
IF downMsg # NIL THEN ErrorDownFS[h, downMsg];
};
DoGetFS: PROC [r: Registration, fs: ROPE, flavorSpecified: BOOL, response: GetFSResponse] ~ {
h: FSHandle ¬ NIL;
downMsg: ROPE ¬ NIL;
NotifyDone: ENTRY PROC ~ --INLINE-- {
ENABLE UNWIND => NULL;
response.nRunning ¬ response.nRunning - 1;
IF (response.handle # NIL) OR (response.downMsg # NIL) THEN RETURN;
SELECT TRUE FROM
(h # NIL) OR (downMsg # NIL) => -- found it -- {
response.handle ¬ h;
response.downMsg ¬ downMsg;
NOTIFY response.wakeup;
};
(response.nRunning = 0) => -- nobody will find it -- {
NOTIFY response.wakeup;
};
ENDCASE;
};
[h, downMsg] ¬ r.getHandle[fs, flavorSpecified
! Error -- can't happen--, ABORTED => CONTINUE];
NotifyDone[];
};
Controlling the flavor of a cached file system.
SetCachedFS: PUBLIC ENTRY PROC [fs: ROPE, flavor: ATOM] ~ {
r: Registration;
h: FSHandle;
downMsg: ROPE;
FOR r ¬ registrations, r.next WHILE (r # NIL) AND (r.flavor # flavor) DO NULL ENDLOOP;
IF r = NIL THEN RETURN;
[h, downMsg] ¬ r.getHandle[fs, TRUE];
IF h = NIL THEN {
code: ATOM;
IF downMsg = NIL
THEN { downMsg ¬ "unknown fs"; code ¬ $fsNotKnown }
ELSE { code ¬ $fsNotAvailable };
h ¬ MakeDownFS[fs, code, downMsg];
};
[] ¬ SymTab.Store[fsTab, fs, h];
};
ClearCachedServer: PUBLIC ENTRY PROC [fs: ROPE] ~ {
[] ¬ SymTab.Delete[fsTab, fs];
};
Down server implementation
DownFSData: TYPE ~ REF DownFSDataObject;
DownFSDataObject: TYPE ~ RECORD [
ttl: CARD,
errorCode: ATOM,
downMsg: ROPE
];
downFSMaintenanceProcs: PFSClass.MaintenanceProcs ¬
NEW[PFSClass.MaintenanceProcsObject ¬ [
sweep~SweepDownFS,
validate~ValidateDownFS
]
];
MakeDownFS: PROC [name: ROPE, errorCode: ATOM, downMsg: ROPE] RETURNS [h: FSHandle] ~ {
d: DownFSData ¬ NEW[DownFSDataObject ¬ [downFSTTL, errorCode, downMsg]];
h ¬ NEW[PFSClass.FSObject ¬ [$DOWN, name, downFSMaintenanceProcs, NIL, d]];
};
SweepDownFS: PFSClass.SweepProc -- [h: FSHandle, seconds: CARD] -- ~ {
d: DownFSData ¬ NARROW[h.data];
IF d.ttl > seconds THEN d.ttl ¬ d.ttl - seconds ELSE d.ttl ¬ 0;
};
ValidateDownFS: PFSClass.ValidateProc -- [h: FSHandle] RETURNS [obsolete: BOOL, downMsg: ROPE] -- ~ {
d: DownFSData ¬ NARROW[h.data];
RETURN[(d.ttl = 0), d.downMsg];
};
Error
Error: PUBLIC ERROR [code: ATOM, msg: ROPE] ~ CODE;
ErrorDownFS: PROC [h: FSHandle, downMsg: ROPE ¬ NIL] ~ {
code: ATOM;
WITH h.data SELECT FROM
d: DownFSData => {
code ¬ d.errorCode;
IF downMsg = NIL THEN downMsg ¬ d.downMsg;
};
ENDCASE => {
code ¬ $fsNotAvailable;
};
ERROR Error[code, downMsg];
};
Initialization
TRUSTED { Process.Detach[ FORK Daemon[] ]
};
}...