|
DataMuseum.dkPresents historical artifacts from the history of: Bogika Butler |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Bogika Butler Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 52736 (0xce00)
Types: TextFile
Names: »VERSAFS.SA«
└─⟦311ba069f⟧ Bits:30009789/_.ft.Ibm2.50006625.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »VERSAFS.SA«
└─⟦49237ce80⟧ Bits:30009789/_.ft.Ibm2.50006627.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »VERSAFS.SA«
└─⟦714bbb381⟧ Bits:30009789/_.ft.Ibm2.50006595.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »VERSAFS.SA«
æ*****************************************************************
Copyright 1984 by
NCR Corporation
Dayton, Ohio U.S.A.
All Rights Reserved
******************************************************************
EOS Software produced by:
NCR Systems Engineering - Copenhagen
Copenhagen
DENMARK
*****************************************************************å
æ$h=0åæ No heap space å
OBJECT PROGRAM VersaFs;
æ
VV VV EEEEEE RRRRR SSSS AA FFFFFF SSSS
VV VV EE RR RR SS SS AAAA FF SS SS
VV VV EE RR RR SS AA AA FF SS
VV VV EEEE RRRRR SSSS AAAAAA == FFFFF SSSS
VVVV EE RR R SS AA AA FF SS
VVVV EE RR RR SS SS AA AA FF SS SS
VV EEEEEE RR RR SSSS AA AA FF SSSS
V E R S A F S
Change history: 83-06-20, EAR, first version
83-07-10, VIR, read/write less than one page
83-09-28, EAR, allow null-char for end of file name
vers.01.01 83-11-09, EAR, re-entrant fao
vers.01.02 83-11-15, EAR, check ioRights in DataSize
vers.01.03 83-12-01, EAR, changed iosys.id
exclude: moveMan in terminate loop
å CONST procId = 'versafs vers.01.03 83-12-01 '; æ
The VersaFs Module is a low level file system for Motorola's
VersaDos file format.
In the present implementation only contiguous files are allowed, and
creation/deletion of files is not implemented.
The VersaFs contains the following entries:
OBJECT FileSystem;
ENTRY Assign (ownedFao; fileName, ioRights Æ, createMode Æ, volumeÅÅ );
Creates a File Access Object (FAO) to the file named
by 'fileName'. The disc must have been included previously.
The file is reserved according to 'ioRights':
Write reservation demands that no other FAO have any
access to the same file; read reservation demands only
that no other FAO have write access to the file.
The present implementation handles only contiguous files,
which must exist on disc when assign is called. The
optional parameter 'createMode' has a special meaning in
this implementation: When the parameter is specified with
the value 'NewFile', the logical end-of-file is reset to -1
denoting an empty file.
The logical end-of-file may contain the following values
(which are not in accordance with Versados):
-1: empty file
0: end-of-file = allocation limit
(standard when a contiguous file is created
by Versados)
>0: LSN (logical sector no) of end-of-file pos
ENTRY Include (; devName Æ, readOnlyÅ );
This procedure includes the disc specified by 'deviceName'.
The proper driver system is found, and a Disc Access Object
(DAO) is created by the object call "driver.assign".
If the optional parameter 'readOnly' is specified as <> 0, all
files on the disc can only be read, i.e all calls of WriteSeq
and WriteRandom will be rejected. Default value is false.
ENTRY Exclude (; devName Æ, abortAllowedÅ );
This procedure removes the disc specified by 'deviceName' from
the system.
The value of the optional parameter 'abortAllowed' determines the
reaction on any open FAO on the disc: If 'abortAllowed' <> 0
all open FAOs on the disc are aborted, and the termination
procedure is called. Otherwise Exclude is rejected if any
open FAO is found. Default value is false.
The Disc Access Object (DAO) corresponding to 'deviceName' is
deallocated. If this fails, the deallocation must be performed
when the device is included again.
OBJECT Fao;
ENTRY ReadSeq (segment ; byteCount );
This procedure reads a physical block from the file, starting
in the logical file position defined by current position.
The block is read into the buffer specified by 'segment',
and the block consists of as many whole pages as the buffer
may contain. The parameter 'byteCount' returns the number
of bytes actually read, and current position is advanced
corresponding to the end of the block read.
When reaching the logical end-of-file a shorter block may
be read, and a correspondingly smaller value of byteCount
is returned. Reading beyond end-of-file but within the
allocation limit returns a 'byteCount' of zero.
An attempt to read beyond the allocation limit is rejected.
This situation can only occur after a seek operation.
The FAO must have read or readWrite reservation, otherwise
the call is rejected.
ENTRY WriteSeq (segment ; byteCount );
This procedure writes a physical block from the buffer specified
by 'segment', into the file from current position and on.
The size of the block is always as many whole pages as the
buffer may contain.
Current position is advanced corresponding to the end of the block
written. 'ByteCount' returns the number of bytes actually written.
If the new current position is beyond the logical end-of-file
position (but within the allocation limit) the end-of-file
position is advanced.
A file of contiguous type cannot be extended, i.e. if the
block would exceed the allocation limit, the call is rejected.
(When writing into a non-contiguous file the file is extended
if needed. P.t. not implemented).
The FAO must have write or readWrite reservation, otherwise
the call is rejected.
ENTRY ReadRandom (segment ; byteCount, pos, actualPos );
Reads a physical block into the buffer in the same manner as ReadSeq,
but the logical position within the file is determined by 'pos',
which is a relative byte address. In case 'pos' does not
correspond to a page boundary, the nearest lower page boundary
is used. 'ActualPos' returns the position actually used.
If 'pos' is beyond end-of-file but within the allocation limit
a 'byteCount' of zero is returned. If pos is beyond the allocation
limit the call is rejected.
Current position is updated corresponding to the end of the
block read.
ENTRY WriteRandom (segment ; byteCount, pos, actualPos );
Writes a physical block from the buffer into the file, to a position
determined by 'pos' in the same manner as ReadRandom. Otherwise
similar to WriteSeq.
ENTRY Seek (; baseMode, offset, pos );
Changes current position according to 'baseMode' and 'offset'. The
return parameter 'pos' is computed as 'baseMode' + 'offset', and
current position of the file will be this position, or the nearest
lower page boundary.
If the resulting position is < 0 the call is rejected. If the
resulting position is beyond the allocation limit, a later
read or write call may be rejected.
END Fao
END FileSystem
å
æ$L-å
æ$Eå
æ$F=FAMILY.UNIV.IDå
æ$F=FAMILY.KNEL.IDå
æ$L+å
æ$Eå
æ****** E X P O R T D E S C R I P T I O N *.****å
æ*************************************************å
æ$F=FAMILY.IOSYS.IDå
æ$L-å
æ$Eå
æ****** I M P O R T D E S C R I P T I O N ******å
æ*************************************************å
æ$F=FAMILY.ALLOC.IDå
æ$F=FAMILY.SCHED.IDå
æ$F=FAMILY.OBJDIR.IDå
æ$L+å
æ$Eå
æ***** E X T E R N A L P R O C E D U R E S *****å
æ*****************************************************å
PROCEDURE PrintText (text : fullId); FORWARD;
PROCEDURE PrintVar (text : fullId; UNIV v : blockPtr); FORWARD;
æ$Eå
æ***** C O N S T A N T S A N D T Y P E S *****å
æ*************************************************å
CONST
maxDisc = 5;
maxIdLength = 48;
noControl = 0;
orgNo = 34;
orgSys = 4003;
Reject = -1;
space = ' ';
versaPageSize = 256;
æVersaDos File Typeså
contiguous = 0;
sequential = 1;
isamKey = 2;
isamDup = 3;
æargument numberså
objectArg = 1;
entryA = 2;
faoArg = 4;
bufArg = 4;
fNameArg = -1;
dNameArg = -1;
baseArg = -1;
ioArg = -2;
posArg = -2;
offsetArg = -2;
createArg = -3;
seekPosArg = -3;
æaux causeså
volIdError = 11;
userOrCatalog = 12;
fileOrExt = 13;
nonContiguous = 14;
volNotIncluded = 15;
volAlreadyInclud = 16;
devTabLimit = 17;
driverObjectkind = 18;
deviceClass = 19;
devicePageSize = 20;
nameFormatIllegal= 21;
posNegative = 22;
illBaseMode = 23;
illIoRights = 24;
illCreateMode = 25;
filesOpen = 26;
noReadRight = 27;
noWriteRight = 28;
æ$Eå
æ***** VERSADOS DESCRIPTIONS *****å
æ*********************************å
TYPE
fullName = PACKED ARRAY Æ1..maxIdLengthÅ OF char;
name2 = PACKED ARRAY Æ1..2Å OF char;
name4 = PACKED ARRAY Æ1..4Å OF char;
name8 = PACKED ARRAY Æ1..8Å OF char;
sdbEntry = RECORD
userNo : word; æUser Noå
catName : name8; æCatalog Nameå
fPdp : long; æ^ first Pdbå
sDummy : word; æreservedå
END;
catStructure = (vid, sdb);
catV = RECORD
CASE catStructure OF
vid: æVolume Identification Blockå
(vidVol : name4; æVolume Idå
vidUser : word; æVolume Ownerå
vidSat : long; æ^ Sector Alloc Tableå
vidSal : word; ælength - - - å
vidSds : long æ^ first Sdbå
);
sdb: æSecond Directory Blockå
(sdbFpt : long; æ^ next Sdbå
sdbDummy : packed array Æ1..12Å of byte; æreservedå
sde : ARRAY Æ1..15Å OF sdbEntry
);
END; æcatVå
pdbEntry = RECORD
fileName : name8; æFile Nameå
ext : name2; æExtension Nameå
pDummy1 : word; æreservedå
dirFS : long; æPSN first sectorå
dirFE : long; æLSN last sector (alloc size)å
dirEOF : long; æ eos eos LSN end of file as byte# (used size)å
dirEOR : long; ælast recno (non-contiguous)å
dirWCD : byte; æWrite Access Codeå
dirRCD : byte; æRead Access Codeå
dirAtt : byte; æFile Typeå
dirLBZ : byte; ælast data block size (non-contig)å
dirRecSize : word; æRecord Size (non-contiguous)å
pDummy2 : byte; æreservedå
dirKey : byte; ænon-contiguous: key sizeå
dirFab : byte; æ - - : FAB sizeå
dirDat : byte; æ - - : Data Block sizeå
writeDate : word; ælast update dateå
assignDate : word; ælast assign dateå
pDummy3 : packed array Æ1..8Å of byte; æreservedå
END;
catP = RECORD æPrimary Directory Blockå
pdbFpt : long; æ^ next pdbå
pdbUser : word; æUser Noå
pdbCatName : name8; æCatalog Nameå
pDummyA : word; æreservedå
pde : ARRAY Æ1..20Å OF pdbEntry;
pDummyB : ARRAY Æ1..8Å OF byte;
END; æcatPå
æ$Eå
æ***** G L O B A L P R O C E D U R E S *****å
æ*********************************************å
FUNCTION MakeRes (main, family, argNo, auxCause : integer)
: resultType;
VAR
r : resultType;
BEGIN
r.main := main;
r.family := family;
r.argNo := argNo;
r.auxCause := auxCause;
r.orgNo := orgNo;
r.orgSys := orgSys;
MakeRes := r;
END; æ MakeRes å
PROCEDURE CheckOk (res : resultType);
BEGIN
æ IF res.main <> Ok THEN printVar ('**** Versa Check **** res=', res); å
IF res.main <> Ok THEN Exception (res);
END;
PROCEDURE sCheck (res : resultType);
BEGIN æresult can only be okå
IF res.main <> ok THEN printVar ('*** versafs sCheck ***, res= ', res);
END;
PROCEDURE rCheck (res : resultType);
BEGIN æobjReturn if result <> okå
IF res.main <> ok THEN printVar ('*** versafs rCheck ***, res= ', res);
IF res.main <> ok THEN ObjReturn (res);
END;
TYPE
stringeling = ^ÆÅ charstring;
FUNCTION Equal (s1, s2 : stringeling) : boolean;
VAR
i : integer;
b : boolean;
BEGIN
b := elements(s1) = elements(s2);
i := 1;
WHILE b AND (i<=elements(s1)) DO
BEGIN
b := s1ÆiÅ = s2ÆiÅ;
i := i+1;
END;
Equal := b;
END; æ Equal å
æ$Eå
PROCEDURE GetName (fileName : fullId;
partName : shortId;
sep : char;
VAR index : integer;
max : integer );
æ This procedure fetches a part of fileName, from the character after
index to the next occurrence of the separator sep (or end of fileName).
At return index points to the separator last read.
å
FUNCTION nextChar (VAR i : integer) : char;
VAR c : char; x : integer;
BEGIN
i := i+1;
c := fileNameÆiÅ;
IF c = CHR(0) THEN
BEGIN
c := sep;
i := i-1;
END
ELSE
IF (c>='a') AND (c<='z') THEN
c := CHR (ORD(c) - 32);
nextChar := c;
END;
VAR
i, j, k : integer;
c : char;
BEGIN
j := 0;
i := index;
k := Elements (fileName);
IF i>=k THEN æfileName exhaustedå
c := sep
ELSE
REPEAT æskip leading spaces and/or slash å
c := nextChar(i);
UNTIL (c<>'/') AND (c<>space) OR (i>k);
WHILE (c<>sep) AND (j<max) AND (i<=k) DO
BEGIN
j := j+1;
partNameÆjÅ := c;
IF i<k THEN
c := nextChar(i)
ELSE
c := sep; æsimulate separator at end of nameå
END; æ while å
IF c<>sep THEN æskip possible ending spaceså
WHILE c=space DO
IF i<k THEN c := nextChar(i) ELSE c := sep;
IF ( (j=0) AND (index=0) ) OR (c<>sep) THEN
Exception (MakeRes (Reject * FileNotFound, IoFamily,
fNameArg, nameFormatIllegal));
æfill partName with ending spaceså
IF j<max THEN
FOR j := j+1 TO max DO
partNameÆjÅ := space;
index := i;
END; æ GetName å
æ$Eå
æ****** F A O L O C A L P O I N T E R S ******å
æ*************************************************å
TYPE
refFao = ^^faoLocals;
pGateType = ^^Gate;
faoLocals = RECORD
code : ^^;
faoData : ^^vFaoData;
faoGate : ^^Gate;
faoChain : refFao;
vsRef : ^^versaLocals;
daoRef : faoRefType;
END;
vFaoData = RECORD
fileAddr, æabs. byteAddr of fileStartå
curPos, ærel. - - current positionå
eofPos, ærel. - - eof positionå
fileSize, ærel. - - allocation limitå
pdbPos, æabs. - - current PDBå
firstFab, æsector noå
curFab, æ - å
lastFab : integer; æ - å
rwRights : ioType;
fileType : byte;
readOnly : boolean;
terminated : boolean;
pageSize : integer;
localId : integer;
pdbEntry : 1..20;
END;
æ$Eå
æ****** I O S Y S L O C A L P O I N T E R S ******å
æ*****************************************************å
TYPE
versLocRef = ^^ versaLocals;
versaLocals = RECORD
code : ^^;
vsGate : ^^Gate;
dao : ARRAY Æ1..maxDiscÅ OF faoRefType;
faoMan : ARRAY Æ1..maxDiscÅ OF refFao;
vsData : ^^versaData;
objDirRef : ^^ObjDir;
allocRef : ^^Allocate;
schedRef : ^^Scheduler;
END;
discData = RECORD
deviceName : fullName;
volName : name4;
pageSize : word;
readOnly : boolean;
deviceState : (free, included, exNotOk);
END;
versaData = RECORD
lastLocalId : integer;
devTable : ARRAY Æ1..maxDiscÅ OF discData;
END;
æ$Eå
æ****** I M P L E M E N T V E R S A F A O ******å
æ***************************************************å
PROGRAM VersaFaoImplement OBJECT Fao WITH FaoLocals;
PROCEDURE ReadBlock (VAR buf : bufRef;
VAR fd : vFaoData;
VAR byteCount : integer;
VAR actualPos : integer;
argNo : integer æin case of errorå );
VAR
bs, eof, pos : integer;
BEGIN
WITH b = buf^^ DO
BEGIN
æ#b# printVar ('readBlock: fd= ', fd); #e#å
æ Check read reservation å
IF (fd.rwRights = NoRights) OR
(fd.rwRights = WriteRights) THEN
Exception (MakeRes (Reject * EntryIllegal, Universal,
0, noReadRight ));
æ Check current position against eof position å
IF fd.eofPos = 0
THEN eof := fd.fileSize æallocation limitå
ELSE eof := fd.eofPos; æeofå
æ#b# printVar ('eof=',eof); #e#å
IF fd.curPos > fd.fileSize THEN
Exception (makeRes (Reject * PosOutsideRange, IoFamily,
argNo, ReadRights));
IF fd.curPos >= eof THEN
byteCount := 0 æfile exhaustedå
ELSE
BEGIN
pos:=fd.curPos;
bs := elements(b);
æ#b# printVar ('elements(b) = ', bs ); #e#å
IF pos + bs > eof THEN
bs := eof - fd.curPos; ænot data enough for full bufferå
æ Read data block and update current position å
pos := fd.fileAddr + pos;
æ#b#
printVar ('absPos=',pos);
printVar ('bs = ', bs );
#e#å
CheckOk( daoRef.ReadRandom (VAR IN OUT buf^^Æ1..bsÅ ;
OUT byteCount, IN pos, OUT pos));
æ#b# printVar ('pos after dao.Read=',pos); #e#å
actualPos := pos - fd.fileAddr;
fd.curPos := actualPos + byteCount;
æ#b# printVar ('new curPos=', fd.curPos); #e#å
END; ænot eofå
END; æwithå
END; æReadBlockå
æ$Eå
PROCEDURE WriteBlock (VAR buf : bufRef;
VAR fd : vFaoData;
VAR byteCount : integer;
VAR actualPos : integer;
argNo : integer æin case of eof errorå);
VAR
bs, eof, pos : integer;
BEGIN
WITH b = buf^^ DO
BEGIN
æ Check write reservation å
æ#b# printVar ('writeBlock: fd= ',fd); #e#å
IF (fd.rwRights < WriteRights) OR fd.readOnly THEN
Exception (MakeRes (Reject * EntryIllegal, Universal,
0, noWriteRight));
pos:= fd.curPos;
æ Check position against eof position å
IF fd.eofPos= 0
THEN eof := fd.fileSize æallocation limitå
ELSE eof := fd.eofPos; æeofå
bs := elements (b);
IF pos + bs > fd.fileSize THEN
Exception (MakeRes (Reject * PosOutsideRange, IoFamily,
argNo, WriteRights));
æ Write data block and update current position å
pos := fd.fileAddr + pos;
æ#b# printVar ('absPos = ',pos); #e#å
CheckOk( daoRef.WriteRandom (buf ; OUT byteCount, IN pos, OUT pos));
actualPos := pos - fd.fileAddr;
fd.curPos := actualPos + byteCount;
æ Update eof position å
IF fd.curPos > eof THEN
fd.eofPos := fd.curPos;
END;
END; æ writeBlock å
æ$Eå
æ***** ReadSeq / WriteSeq *****å
æ**********************************å
ENTRY ReadSeq
æ segment ; OUT byteCount å
WITH RECORD
t : ^^;
END;
VAR
actualPos : integer;
res : resultType;
BEGIN
æ#b# printText ('-----vs.ReadSeq-----'); #e#å
sCheck ( faoGate.Lock );
IN
WITH fd = faoData^^ DO
ReadBlock (segment, fd, byteCount, actualPos, bufArg);
res := MakeRes(Ok, Ok, Ok, Ok);
DO
res := GetException;
sCheck ( faoGate.Open );
æ#b# printVar ('--end vs.ReadSeq-- res=', res); #e#å
ObjReturn (res);
END; æReadSeqå
ENTRY WriteSeq
æ segment ; OUT byteCount å
WITH RECORD
t : ^^;
END;
VAR
actualPos : integer;
res : resultType;
BEGIN
æ#b# printText ('-----vs.WriteSeq-----'); #e#å
sCheck ( faoGate.Lock );
IN
WITH fd = faoData^^ DO
WriteBlock (segment, fd, byteCount, actualPos, bufArg);
res := MakeRes (Ok, Ok, Ok, Ok);
DO
res := GetException;
sCheck ( faoGate.Open );
æ#b# printVar ('--end vs.WriteSeq-- res=', res); #e#å
ObjReturn (res);
END; æWriteSeqå
æ$Eå
æ***** ReadRandom *****å
æ**************************å
ENTRY ReadRandom
æ segment ; OUT byteCount, IN pos, OUT actualPos å
WITH RECORD
t : ^^;
END;
VAR
res : resultType;
BEGIN
æ#b# printText ('-----vs.ReadRandom-----'); #e#å
sCheck ( faoGate.Lock );
IN
WITH fd = faoData^^ DO
BEGIN
æ Check position and assign current position å
IF (pos < 0) OR
(pos > fd.fileSize) THEN
Exception (makeRes (Reject * PosOutsideRange, IoFamily,
posArg, ReadRights ));
fd.curPos:=pos;
æ Read data block å
ReadBlock (segment, fd, byteCount, actualPos, bufArg);
res := MakeRes (Ok, Ok, Ok, Ok);
END; æwith fdå
DO
res := GetException;
sCheck (faoGate.Open );
æ#b# printVar ('--end vs.ReadRandom-- res=',res); #e#å
ObjReturn (res);
END; æReadRandomå
æ$Eå
ENTRY WriteRandom
æ segment ; OUT byteCount, IN pos, OUT actualPos å
WITH RECORD
t : ^^;
END;
VAR
res : resultType;
BEGIN
æ#b# printText ('-----vs.WriteRandom-----'); #e#å
sCheck ( faoGate.Lock );
IN
WITH fd = faoData^^ DO
BEGIN
æ#b# printVar ('pos= ',pos); #e#å
æ Check position and assign current position å
IF (Pos < 0) OR
(Pos > fd.fileSize) THEN
Exception (MakeRes (Reject * PosOutsideRange, IoFamily,
posArg, WriteRights ));
fd.curPos := Pos;
æ Write data block å
WriteBlock (segment, fd, byteCount, actualPos, posArg);
res := MakeRes (Ok, Ok, Ok, Ok);
END; æwithå
DO
res := GetException;
sCheck ( faoGate.Open );
æ#b# printVar ('--end vs.WriteRandom-- res=', res); #e#å
ObjReturn (res);
END; æWriteRandomå
æ$Eå
ENTRY Seek
æ ; IN baseMode, IN offset, OUT pos å
WITH RECORD t : ^^; END;
VAR
res : resultType;
tPos, eof : integer;
BEGIN
æ#b# printText ('---------vs.seek-----------'); #e#å
sCheck ( faoGate.Lock );
IN
WITH fd = faoData^^ DO
BEGIN
IF fd.fileType <> contiguous THEN
Exception (makeRes (Reject * VolumeFormatError, IoFamily,
entryA, nonContiguous ));
æseek cannot be implemented without disc access for a
non-contiguous fileå
CASE baseMode OF
FromStart:
tPos := offset;
FromCurrentPos:
tPos := fd.curPos + offset;
FromEnd:
BEGIN
eof := fd.eofPos;
IF eof = 0 THEN eof := fd.fileSize ELSE
IF eof =-1 THEN eof := 0;
tPos := eof + offset;
END; æfromEndå
OTHERWISE
Exception (makeRes (Reject * DataValueIllegal, IoFamily,
baseArg, illBaseMode));
END; æcaseå
æ#b# printVar ('pos= ',tPos); #e#å
IF tPos < 0 THEN
Exception (makeRes (Reject * PosOutsideRange, IoFamily,
offsetArg, posNegative));
fd.curPos := tPos;
pos := tPos;
END; æwithå
res := makeRes (Ok, Ok, Ok, Ok);
DO
res := GetException;
sCheck ( faoGate.Open);
æ#b# printVar ('---------end vs.seek--------, res= ',res); #e#å
ObjReturn (res);
END;
æ$Eå
ENTRY SetMode
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
end;
ENTRY GetFileInf
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
end;
ENTRY SetRights
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
end;
ENTRY CheckRights
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
end;
ENTRY MoveRights
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
end;
ENTRY NewLink
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
end;
ENTRY AllocSize
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
end;
æ$Eå
ENTRY DataSize
æ ; IN dataBytes å
WITH RECORD t : ^^; END;
VAR
res : resultType;
BEGIN
æ#b# printText ('-----vs.DataSize----- '); #e#å
sCheck ( faoGate.Lock);
IN
WITH fd = faoData^^ DO
BEGIN
æ Check write reservation å
IF (fd.rwRights < WriteRights) OR fd.readOnly THEN
Exception (MakeRes (Reject * EntryIllegal, Universal,
0, noWriteRight));
IF dataBytes = 0 THEN fd.eofPos := -1
ELSE fd.eofPos := dataBytes;
æ#b# printVar ('fd.eofPos = ',fd.eofPos); #e#å
res := okResult;
END; æwithå
DO
res := GetException;
sCheck ( faoGate.Open);
ObjReturn (res);
END;
ENTRY WaitBreak
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
end;
ENTRY WaitReady
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
end;
OTHERWISE FaoOther
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
END; æotherwisweå
END; æVersaFaoImplementå
æ$Eå
æ****** I M P L E M E N T V E R S A F I L E S Y S T E M ******å
æ*****************************************************************å
PROGRAM VersFilImplement OBJECT IoSys WITH versaLocals;
PRIVATE Close
(IN fao : ownSet;
IN faoEnv : refFao);
PROCEDURE InitFilSys;
VAR
d, i : integer;
BEGIN
printText (procId);
CheckOk( schedRef.NewGate (OUT vsGate));
CheckOk( vsGate.Lock);
æ Initialize versaData å
WITH vsData^^ DO
BEGIN
lastLocalId := 0;
FOR d := 1 TO maxDisc DO
WITH devTableÆdÅ DO
BEGIN
deviceState := free;
FOR i := 1 TO maxIdLength DO
deviceNameÆiÅ := space;
FOR i := 1 TO 4 DO
volNameÆiÅ := space;
END; æ for d å
END; æ with å
CheckOk ( MakeReentrant (Void));
END; æ InitFilSys å
æ$Eå
æ***** Assign *****å
æ**********************å
ENTRY Assign
æOUT ownedFao; IN fileName, IN ioRights, optional IN createMode, volumeå
WITH RECORD
t : ^^;
faoEnv : ^^ faoLocals;
tmpFaoMan : ^^;
nextFao : refFao;
saveFaoPtr : refFao;
END;
VAR
nullSize, voidSize, size : sizeType;
dummyRes, res : resultType;
found : boolean;
cmPtr : ^createType;
createMode : createType;
auxCause, charNo, count, daoIndex, e, i, j, locId,
nextPdb, nextSdb, pageSize, pos, savedAddr, userNo : integer;
extension : name2;
vol, user : name4;
catalog, fileN : name8;
buf : catV;
pbuf : catP;
BEGIN
æ*b* printText ('-----vs.Assign-----'); *e*å
IN
CheckOk( vsGate.Lock );
DO
BEGIN
æ not ok means file system not initialized å
InitFilSys;
END;
res := vsGate.Open;
æ Check IoRights parameter å
IF (ioRights < NoRights) OR (ioRights > ReadWrite) THEN
Exception (MakeRes (Reject * DataValueIllegal, Universal,
ioArg, illIoRights));
æ Take optional createMode parameter å
IF NextValArg (cmPtr)
THEN createMode := cmPtr^
ELSE createMode := oldFile;
æ*b* printVar ('createMode=', createMode); *e*å
IF (createMode < NewOrOld) OR (createMode > NewFile) THEN
Exception (makeRes (Reject * DataValueIllegal, Universal,
createArg, illCreateMode));
æ Allocate Fao Object å
sCheck ( ClearSize (size));
sCheck ( AddGen (size, refs(faoLocals)));
sCheck ( AddEmbSeg (size, bytes(vFaoData)));
rCheck ( allocRef.NewObj (OUT ownedFao; IN size, OUT i));
æ Make Fao a general object with temporary manager å
nullSize.user := 0; nullSize.kernel := 0;
voidSize.user := -1; voidSize.kernel := -1;
rCheck ( DeclGen (ownedFao, tmpFaoMan, faoEnv, refs(faoLocals), Close,
nullSize, voidSize, refs(VersaFaoImplement),
bytes(VersaFaoImplement), noControl,
addr(VersaFaoImplement), nullSize, true));
æ Create Fao data segment å
rCheck ( NewSeg (faoEnv^^.faoData, bytes(vFaoData)));
æ Create fao gate å
rCheck ( schedRef.NewGate (OUT faoEnv^^.faoGate));
æ enter critical region before search devTab å
sCheck ( vsGate.Lock );
IN
WITH vd = vsData^^ DO
BEGIN
æ Find disc volume name in device table å
charNo := 0;
GetName (fileName, vol, ':', charNo, 4);
æ*b* printVar ('fileName=',fileName); *e*å
æ*b* printVar ('vol =',vol); *e*å
daoIndex := 1;
found := false;
REPEAT
IF Equal (vd.devTableÆdaoIndexÅ.volName, vol) THEN
BEGIN
found := true;
pageSize := vd.devTableÆdaoIndexÅ.pageSize;
END
ELSE
daoIndex := daoIndex + 1;
UNTIL found OR
(daoIndex > maxDisc);
æ*b* printVar ('daoIndex=',daoIndex); *e*å
IF NOT found THEN
Exception (makeRes (Reject * FileNotFound, IoFamily,
fNameArg, volNotIncluded));
æwhen volName not found in deviceTable, an automatic search for volName
on all included devices could be made. If found on a device this device
should be implicit excluded and included
å
æ Now the proper Dao is found (daoIndex), search fileName
in disc directory å
æFirst split fileNameå
GetName (fileName, user, '.', charNo, 4);
æ*b* printVar ('user =',user); *e*å
GetName (fileName, catalog, '.', charNo, 8);
æ*b* printVar ('catalog=',catalog); *e*å
GetName (fileName, fileN, '.', charNo, 8);
æ*b* printVar ('fileN =',fileN); *e*å
GetName (fileName, extension,'(', charNo, 2);
æ*b* printVar ('ext =',extension); *e*å
æ Convert user into binary userNo å
userNo := 0;
FOR i := 1 TO 4 DO
BEGIN
j := ORD(userÆiÅ) - ORD('0');
IF (j>=0) AND (j<=9) THEN
userNo := userNo*10 + j
ELSE
IF userÆiÅ <> space THEN
Exception (MakeRes (Reject * FileNotFound, IoFamily,
fNameArg, nameFormatIllegal));
END;
æ*b* printVar ('userN0 =',userNo); *e*å
æ Read Volume Identification Block, VID å
pos := 0;
CheckOk( daoÆdaoIndexÅ.ReadRandom (VAR IN OUT buf;
OUT count, IN pos, OUT pos));
æ Check Volume Name å
IF NOT Equal (vol, buf.vidVol) THEN
Exception (makeRes (Reject * VolumeFormatError, IoFamily,
fNameArg, volIdError ));
æwhen volName on device not ok, this device should be implicit excluded
and included again. All devices should be searched for the wanted volName,
and if found on some other device, this should also be excluded and
included again.
å
æ Search Secondary Directory Block, SDB å
æ*b* printText ('search Secondary Directory Block'); *e*å
auxCause := userOrCatalog;
found := false;
nextSdb := buf.vidSds;
REPEAT
æ*b* printVar ('nextSdb=',nextSdb); *e*å
pos := nextSdb * pageSize;
CheckOk( daoÆdaoIndexÅ.ReadRandom (VAR IN OUT buf;
OUT count, IN pos, OUT pos));
nextSdb := buf.sdbFpt;
e := 1;
REPEAT
IF (buf.sdeÆeÅ.userNo = userNo) AND
Equal (buf.sdeÆeÅ.catName, catalog)
THEN found := true
ELSE e := e + 1;
UNTIL found OR (e>15);
UNTIL found OR (nextSdb=0);
æ*b* printVar ('sdb-e =',e); *e*å
IF found THEN
BEGIN
æ Search Primary Directory Block, PDB å
æ*b* printText ('search Primary Directory Block'); *e*å
auxCause := fileOrExt;
found := false;
nextPdb := buf.sdeÆeÅ.fPdp;
REPEAT
æ*b* printVar ('nextPdb=',nextPdb); *e*å
pos := nextPdb * pageSize;
CheckOk( daoÆdaoIndexÅ.ReadRandom (VAR IN OUT pBuf;
OUT count, IN pos, OUT pos));
nextPdb := pbuf.pdbFpt;
e := 1;
REPEAT
IF Equal (pbuf.pdeÆeÅ.fileName, fileN) AND
Equal (pbuf.pdeÆeÅ.ext, extension)
THEN found := true
ELSE e := e + 1;
UNTIL found OR (e > 20);
UNTIL found OR (nextPdb = 0);
END; æsearch PDBå
æ*b* printVar ('pdb-e =',e); *e*å
IF NOT found THEN
Exception (MakeRes (Reject * FileNotFound, IoFamily,
fNameArg, auxCause));
æ FileName has been found in directory, check file type
(must be contiguous), and initialize faoData å
WITH fd = faoEnv^^.faoData^^, pbuf.pdeÆeÅ DO
BEGIN
IF dirAtt = contiguous THEN
BEGIN
savedAddr := dirFS * pageSize;
fd.fileAddr := savedAddr;
fd.curPos := 0;
IF createMode = newFile
THEN fd.eofPos := -1
ELSE fd.eofPos := dirEOF;
fd.fileSize := (dirFE+1) * pageSize;
fd.pdbPos := pos;
fd.pdbEntry := e;
fd.firstFab := 0;
fd.curFab := 0;
fd.lastFab := 0; ænot used by contig.fileå
fd.fileType := dirAtt;
fd.rwRights := ioRights;
fd.readOnly := vd.devTableÆdaoIndexÅ.readOnly;
fd.terminated := false;
fd.pageSize := pageSize;
æ*b* printVar ('file description = ',fd); *e*å
END æ contiguous å
ELSE
Exception (MakeRes (reject * VolumeFormatError, ioFamily,
fNameArg, nonContiguous));
ænon-contiguous files not implementedå
END; æwith fdå
æ Search all other faos connected to same disc. If same file
then check reservation å
æ*b* printVar ('search other faos, own file addr=', savedAddr); *e*å
found := false;
res := FirstInSet (faoManÆdaoIndexÅ, nextFao);
IF res.main = ok THEN
BEGIN
REPEAT
WITH fd = nextFao^^.faoData^^ DO
BEGIN
æ*b* printVar ('fd.fileAddr=',fd.fileAddr); *e*å
IF fd.fileAddr = savedAddr THEN
BEGIN æ same file å
IF (ioRights > readRights) OR
(fd.rwRights > readRights) THEN
Exception (MakeRes (Reject * RightsOccupied, IoFamily,
fNameArg, ioRights));
IF NOT found THEN
BEGIN æ first same, save fao pointer for later connectå
sCheck ( Copy (nextFao^^.faoChain, faoEnv^^.faoChain));
sCheck ( Copy (nextFao, saveFaoPtr));
found := true;
locId := fd.localId;
END; æfirst foundå
END; æsame fileå
END; æwith fdå
res := NextInSet (faoManÆdaoIndexÅ, nextFao);
æ*b* printVar ('NextInSet, res= ',res); *e*å
UNTIL res.main <> Ok;
END; æfaoMan set not emptyå
æ Reservation ok, move new fao manager and initialize fao pointerså
sCheck ( MoveMan (tmpFaoMan, faoManÆdaoIndexÅ));
sCheck ( Copy (code, faoEnv^^.code));
sCheck ( Copy (daoÆdaoIndexÅ, faoEnv^^.daoRef));
sCheck ( MakeReentrant (faoEnv));
æ*b* printText ('after copy fao pointers '); *e*å
æ Insert this fao in file chain, and assign localId å
WITH fd = faoEnv^^.faoData^^ DO
BEGIN
IF found THEN
BEGIN
fd.localId := locId;
CheckOk( Copy (faoEnv, saveFaoPtr^^.faoChain));
END æfoundå
ELSE
BEGIN æfile not used before,
create new localId and new fileChain å
vd.lastLocalId := vd.lastLocalId + 1;
fd.localId := vd.lastLocalId;
CheckOk( Copy (faoEnv, faoEnv^^.faoChain));
END; ænot foundå
æ*b* printVar ('localId=',fd.localId); *e*å
END; æ with fd å
res := MakeRes (Ok, Ok, Ok, Ok);
END; æwith vdå
DO
BEGIN
æsome error during assign, undo everythingå
IF daoIndex > 0 THEN
BEGIN
dummyRes := DelEnv (ownedFao, faoManÆdaoIndexÅ);
dummyRes := Dealloc (ownedFao, faoManÆdaoIndexÅ);
END;
res := GetException;
END;
æ Leave critical region å
dummyRes := vsGate.Open;
æ*b* printVar ('--end vs.Assign-- res=',res); *e*å
ObjReturn (res);
END; æAssignå
æ$Eå
ENTRY InitFileScan æp.t. not implementedå
æOUT scanObj; IN partialFileNameå
WITH RECORD t : ^^; END;
BEGIN ObjReturn (MakeRes (Reject*EntryIllegal, Universal, entryA, 0)); END;
ENTRY RenameFile æp.t. not implementedå
æ ; IN fileName, IN newFileNameå
WITH RECORD t : ^^; END;
BEGIN ObjReturn (MakeRes (Reject*EntryIllegal, Universal, entryA, 0)); END;
ENTRY CreateLink æp.t. not implementedå
æ ; IN fileName, IN newFileNameå
WITH RECORD t : ^^; END;
BEGIN ObjReturn (MakeRes (Reject*EntryIllegal, Universal, entryA, 0)); END;
ENTRY DeleteLink æp.t. not impelmentedå
æ ; IN fileNameå
WITH RECORD T : ^^; END;
BEGIN ObjReturn (MakeRes (Reject*EntryIllegal, Universal, entryA, 0)); END;
ENTRY InitIpcSys ænot VersaFså
WITH RECORD t : ^^; END;
BEGIN ObjReturn (MakeRes (Reject*EntryIllegal, Universal, entryA, 0)); END;
ENTRY CreateFile ænot VersaFså
WITH RECORD t : ^^; END;
BEGIN ObjReturn (MakeRes (Reject*EntryIllegal, Universal, entryA, 0)); END;
ENTRY DeleteFile ænot VersaFså
WITH RECORD T : ^^; END;
BEGIN ObjReturn (MakeRes (Reject*EntryIllegal, Universal, entryA, 0)); END;
æ$Eå
æ***** INCLUDE *****å
æ***********************å
ENTRY Include
æ ; IN devName Æ, reaOnlyÅ å
WITH RECORD
t : ^^;
discDriver : ioSysRefType;
END;
VAR
i, k, minBufSize,
daoIndex, devClass, kind, localId, pos, size, used : integer;
accessMode : ioType;
alreadyOpen : boolean;
name, freeEntry : fullName;
dummyRes, res : resultType;
roPtr : ^integer;
readOnly : integer;
buf : catV;
BEGIN
æ*b* printText ('-----vs.Include-----'); *e*å
IN
CheckOk (vsGate.Lock);
DO ænot ok means file system not initializedå
InitFilSys;
WITH vd = VsData^^ DO
BEGIN
IN
æ Take optional readOnly parameter å
IF NextValArg (roPtr)
THEN readOnly := roPtr^
ELSE readOnly := 0;
æ*b* printVar ('readOnly=',readOnly); *e*å
æ Initialization å
k := elements(devName);
FOR i := 1 TO maxIdLength DO freeEntryÆiÅ := space;
FOR i := 1 TO k DO nameÆiÅ := devNameÆiÅ;
FOR i := k+1 TO maxIdLength DO nameÆiÅ := space;
alreadyOpen := false;
æ Search deviceName in device table å
daoIndex := 0;
FOR i := 1 TO maxDisc DO
BEGIN
IF Equal (vd.devTableÆiÅ.deviceName, name) THEN
BEGIN
CASE vd.devTableÆiÅ.deviceState OF
free:
daoIndex := i;
included:
Exception (MakeRes (Reject*FileNameExists, IoFamily,
dNameArg, volAlreadyIncluded));
exNotOk:
BEGIN æExclude has been called, but Dealloc was not succesful,
so the Dao must be de-allocated before re-use å
daoIndex := i;
alreadyOpen := true;
END;
END; æcaseå
END; æequalå
IF daoIndex = 0 THEN
IF Equal (vd.devTableÆiÅ.deviceName, freeEntry) THEN
BEGIN
daoIndex := i;
vd.devTableÆiÅ.deviceName := name;
END;
END; æfor iå
IF (daoIndex = 0) OR alreadyOpen THEN
BEGIN ædevName not found, and no free entries. If any "excludeNotOk"
entry this can be used, otherwise reject å
FOR i := 1 TO maxDisc DO
BEGIN
IF vd.devTableÆiÅ.deviceState = exNotOk THEN
BEGIN
daoIndex := i;
dummyRes := Dealloc (daoÆdaoIndexÅ, daoÆdaoIndexÅ);
vd.devTableÆiÅ.deviceState := free;
vd.devTableÆiÅ.deviceName := name;
END;
END; æfor iå
IF daoIndex = 0 THEN
Exception (MakeRes (Reject*NoResources, Universal,
dNameArg, devTabLimit)); æno free entryå
END; ædaoIndex=0å
DO
BEGIN
dummyRes := vsGate.Open;
ObjReturn (GetException);
END;
æ Now an entry in device table has been found, get driver ref å
IN
æ*b* printVar ('daoIndex = ',daoIndex); *e*å
CheckOk( objDirRef.GetRef (OUT discDriver ;
IN devName, OUT used, OUT kind));
IF (kind <> GeneralObject) AND
(kind <> AccessObject) THEN
Exception (MakeRes (Reject*GiveUp, Universal,
dNameArg, driverObjectKind));
æ Assign disc driver, i.e. create DiscAccessObject (DAO) å
IF readOnly<>0 THEN accessMode := ReadRights
ELSE accessMode := ReadWrite;
æ*b* printVar ('devName= ',devName); *e*å
æ*b* printVar ('used= ',used); *e*å
CheckOk( discDriver.Assign (OUT daoÆdaoIndexÅ ;
IN devNameÆused+1..kÅ, IN accessMode));
IN
æ Check Device Information å
CheckOk( daoÆdaoIndexÅ.GetFileInf (OUT discDriver ;
OUT localId, OUT name, OUT devClass,
OUT i æbytesAllocatedå, OUT minBufSize,
OUT i æcylSizeå ));
DO æ GetFileInf in driver not implemented, assign ok-values å
BEGIN
minBufSize := VersaPageSize;
devClass := Disc;
END;
IF devClass <> Disc THEN
Exception (MakeRes (Reject*GiveUp, Universal,
dNameArg, deviceClass));
IF minBufSize > VersaPageSize THEN
Exception (MakeRes (Reject*GiveUp, Universal,
dNameArg, devicePageSize));
æ Read Sector 0 å
pos := 0;
CheckOk( daoÆdaoIndexÅ.ReadRandom (VAR IN OUT buf ;
OUT size, IN pos, OUT pos));
æ Assign Device Table entry å
WITH ve = vd.devTableÆdaoIndexÅ DO
BEGIN
ve.volName := buf.vidVol; ævolume Idå
ve.pageSize := minBufSize;
if readOnly=0 then ve.readOnly := false
else ve.readOnly := true;
ve.deviceState := included;
æ*b* printVar ('device table entry',ve); *e*å
END;
res := MakeRes (Ok, Ok, Ok, Ok);
DO
BEGIN
dummyRes := Dealloc (daoÆdaoIndexÅ, daoÆdaoIndexÅ);
æcheck result of Deallocå
dummyRes := Copy (void, daoÆdaoIndexÅ);
IF dummyRes.main = Ok
THEN vd.devTableÆdaoIndexÅ.deviceState := free
ELSE vd.devTableÆdaoIndexÅ.deviceState := exNotOk;
res := GetException;
END;
END; æwith vdå
dummyRes := vsGate.Open;
æ*b* printVar ('--end vs.Include-- res=', res); *e*å
ObjReturn (res);
END; æIncludeå
æ$Eå
æ***** TerminateFao *****å
æ****************************å
PROCEDURE TerminateFao (VAR faoEnv : refFao ;
VAR fd : vFaoData;
var daoTmp : faoRefType);
VAR
byteCount, e, pos : integer;
pbuf : catP;
BEGIN
æ*b* printText ('-----TerminateFao-----'); *e*å
æ abort will remove all simple pointers of the envelope,
this may be changed in a later version of the kernel.
until then take a copy of the daoRef and faoGate before abort. å
sCheck ( copy (faoEnv^^.daoRef,daoTmp));
sCheck ( faoEnv^^.faoGate.Lock );
æ prevent other users from accessing the fao during terminate å
sCheck ( Abort (faoEnv));
æ*b* printtext ('=====Abort (faoEnv)==='); *e*å
æ update disc directory: eof position and date å
IF (fd.rwRights > ReadRights) AND
(NOT fd.readOnly) AND
(fd.eofPos <> 0) THEN
BEGIN
pos := fd.pdbPos;
CheckOk( daoTmp.ReadRandom (VAR IN OUT pbuf;
OUT byteCount, IN pos, OUT pos));
æ*b* printtext ('=====ReadpdbEntry====='); *e*å
e := fd.pdbEntry;
WITH pbuf.pdeÆeÅ DO
BEGIN
dirEOF := fd.eofPos;
writeDate := 0; ædate p.t. not implementedå
æ*b* printVar ('update dirEOF= ',dirEOF); *e*å
END; æwith pbufå
CheckOk( daoTmp.WriteRandom (VAR IN OUT pbuf;
OUT byteCount, IN pos, OUT pos));
æ*b* printtext('=====WritepdbEntry====='); *e*å
END; æ update directory å
æ remove faoGate å
sCheck ( faoEnv^^.faoGate.Open );
sCheck ( Dealloc (faoEnv^^.faoGate, faoEnv^^.faoGate));
æ*b* printText ('--end TerminateFao--'); *e*å
END; æ terminateFao å
æ$Eå
æ***** EXCLUDE *****å
æ***********************å
ENTRY Exclude
æ ; IN deviceName Æ, abortAllowedÅ å
WITH RECORD
t : ^^;
tempMan: ^^;
tempEnv: ^^;
faoEnv : refFao;
daoTmp : faoRefType;
END;
VAR
daoIndex, i, k : integer;
res, dummyRes : resultType;
name : fullName;
aaPtr : ^integer;
abortAllowed : integer;
BEGIN
æ*b* printText ('-----vs.Exclude----- '); *e*å
IN
CheckOk (vsGate.Lock);
DO ænot ok means file system not initializedå
InitFilSys;
WITH vd = vsData^^ DO
BEGIN
IN
æTake optional abortAllowed parameterå
IF NextValArg (aaPtr)
THEN abortAllowed := aaPtr^
ELSE abortAllowed := 0;
æ*b* printVar ('abortAllowed= ',abortAllowed); *e*å
k := elements(devName);
FOR i := 1 TO k DO nameÆiÅ := devNameÆiÅ;
FOR i := k+1 TO maxIdLength DO nameÆiÅ := space;
æSearch devName in device tableå
daoIndex := 0;
FOR i := 1 TO maxDisc DO
BEGIN
IF Equal (vd.devTableÆiÅ.deviceName, name) AND
(vd.devTableÆiÅ.deviceState > free) THEN
daoIndex := i;
END; æforå
æ*b* printVar ('daoIndex= ',daoIndex); *e*å
IF daoIndex=0 THEN
Exception (MakeRes (Reject*FileNotFound, IoFamily,
entryA, volNotIncluded));
æNow the device name has been found in device table,
check if any open fao å
res := FirstInSet (faoManÆdaoIndexÅ, faoEnv);
IF res.Main = Ok THEN
BEGIN
IF abortAllowed = 0 THEN
Exception (MAkeRes (Reject*RightsOccupied, IoFamily,
entryA, filesOpen));
REPEAT
WITH fd = faoEnv^^.faoData^^ DO
BEGIN
IF fd.terminated THEN ænothingå
ELSE
BEGIN
terminateFao (faoEnv , fd, daoTmp);
fd.terminated := true;
END;
END; æwithå
sCheck ( Copy (faoEnv, tempEnv));
res := NextInSet (faoManÆdaoIndexÅ, faoEnv);
sCheck ( MoveMan (tempEnv, tempMan)); æremove fao from ManSetå
UNTIL res.main <> ok;
END;
æRemove manager pointerå
res := MoveMan (faoManÆdaoIndexÅ, tempMan);
æDeallocate the disc driverå
res := Dealloc (daoÆdaoIndexÅ, daoÆdaoIndexÅ);
WITH vd.devTableÆdaoIndexÅ DO
BEGIN
IF res.main = Ok THEN
BEGIN
deviceState := free;
FOR i:=1 TO maxIdLength DO deviceNameÆiÅ := space;
END
ELSE
deviceState := exNotOk;
END;
res := MakeRes (Ok, Ok, Ok, Ok);
DO
res := GetException;
END; æwithå
æ*b* printVar ('---end exclude ---, res= ',res); *e*å
dummyRes := vsGate.Open;
ObjReturn (res);
END; æExcludeå
æ$Eå
æ***** CLOSE *****å
æ*********************å
PRIVATE Close
æ fao, faoEnv å
WITH RECORD
t : ^^;
nextFao : refFao;
daoTmp : faoRefType;
END;
VAR
res : resultType;
BEGIN
æ*b* printText ('-----vs.Close-----'); *e*å
IN
CheckOk (vsGate.Lock);
WITH fd = faoEnv^^.faoData^^ DO
BEGIN
IF fd.terminated THEN ænothingå
ELSE
BEGIN
terminateFao (faoEnv , fd, daoTmp);
fd.terminated := true;
æ OBS! For the time being RefEqual is dummy (always true),
so the fao file chain is not maintained. But the chain will
be used only when a file reservation is to be changed, which
is not yet implemented.å
æ Remove current fao from file chain å
IF SameEntity (faoEnv^^.faoChain, faoEnv ) THEN
æ only one fao to this file, nothing to be done å
ELSE
BEGIN
res := Copy (faoEnv, nextFao);
WHILE NOT SameEntity (nextFao^^.faoChain, faoEnv) DO
res := Copy (nextFao^^.faoChain, nextFao);
res := Copy (faoEnv^^.faoChain, nextFao^^.faoChain);
END;
END; ænot previously terminated by Excludeå
END; æwithå
DO begin
res:=getException;
æ*b* printVar ('Close Exception, Res: ',res); *e*å
end;
ægate must be re-openedå
res := vsGate.Open;
æ*b* printText ('-- end vs.Close --'); *e*å
END; æCloseå
OTHERWISE VersOther
WITH RECORD t : ^^; END;
BEGIN
Exception (MakeRes (Reject*EntryIllegal, Universal, entryA, 0));
END; æotherwiseå
END; æVersFilImplementå
INITIALIZE
versFilImplement 'versafs':
allocRef 'allocate',
schedRef 'scheduler',
objDirRef 'objdir',
vsData
END.
«eof»