|
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: 27520 (0x6b80)
Types: TextFile
Names: »SHCLFS.SA«
└─⟦2322e079b⟧ Bits:30009789/_.ft.Ibm2.50006594.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »SHCLFS.SA«
└─⟦311ba069f⟧ Bits:30009789/_.ft.Ibm2.50006625.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »SHCLFS.SA«
└─⟦49237ce80⟧ Bits:30009789/_.ft.Ibm2.50006627.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »SHCLFS.SA«
æ*****************************************************************
Copyright 1984 by
NCR Corporation
Dayton, Ohio U.S.A.
All Rights Reserved
******************************************************************
EOS Software produced by:
NCR Systems Engineering - Copenhagen
Copenhagen
DENMARK
*****************************************************************å
OBJECT PROGRAM ShareCloneFS;
æ$H=0 : no heap space å
æ** Written by Vilhelm Rosenqvist and Peter Mikkelsen **å
æChanges:
vers. 1.00 83-11-27 VIR initial release
vers. 1.01 83-12-09 EAR testprint off
vers. 2.00 83-12-20 EAR share group implemented
vers. 2.01 83-12-23 EAR central.lock around createClone
vers. 2.02 84-01-02 ERN error in closeclone
vers. 2.03 84-01-03 ERN error in seek
å
CONST versid = 'shclfs 2.03 84-01-03 ';
æ********************************************************å
æ$L-å
æ$F=FAMILY.UNIV.IDå
æ$F=FAMILY.KNEL.IDå
æ$F=FAMILY.IOSYS.IDå
æ$F=FAMILY.ALLOC.IDå
æ$F=FAMILY.SCHED.IDå
æ$F=FAMILY.OBJDIR.IDå
æ$L+å
æ$F=PRIVATE.SHCLFS.IDå
CONST OrgSys = 4010;
ResultId = 'SHCLFS: sNo OrgSy Au Ar OrgNo Fa Ma ';
æ$F=PASINCLU.CHKPROCS.SAå
æ*** CONSTANTS AND TYPES ***å
æ*******************************å
CONST
del = 127;
maxIdLgt = 80;
æaux causeså
notSameEntity = 16#51;
noReadReservation = 16#52;
noWriteReservation = 16#53;
fNameTooLong = 16#54;
TYPE
fullName = array Æ1..maxIdLgtÅ of char;
æ$Eå
æ*** OBJECT ENVIRONMENT TYPES ***å
æ************************************å
TYPE
shClFsLocals = RECORD
code : ^^;
groupMan : ^^shClGrpLocals;
central : ^^Gate;
allocRef : ^^Allocate;
schedRef : ^^Scheduler;
egoEnv : ^^;
END;
refSCFsLocals = ^^shClFSLocals;
shClGrpLocals = RECORD
code : ^^;
egoEnv : ^^shClGrpLocals;
fsEnv : ^^shClFsLocals;
dir : ^^objDir; æsubDir used by this group å
controlClone: ^^fao;
æ control terminal clone: created along with the group
the exsistence ensure that the control terminal FAO
is not deallocated until the whole group is removed å
cloneMan : ^^cloneLocals;
shareOwner : ^^; æowns the share groupå
shareMan : ^^shareLocals;
faoOwner : ^^fao; æowns fao objects, first fao = the control terminalå
errOwner : ^^; æowns fao objects which could not be deallocatedå
END;
refSCGLocals=^^shClGrpLocals;
shareLocals = RECORD
shareGate : ^^Gate;
llFao : ^^Fao;
egoObj : ^^;
pShareData : ^^shareData;
END;
refShareLocals = ^^shareLocals;
shareData = RECORD
fPos : long;
rwMode : ioType;
fileName : fullName;
fNameLgt : word;
cloneCount : word;
terminal : boolean;
END;
refShData = ^^shareData;
cloneLocals = RECORD
code : ^^;
shareEnv : ^^shareLocals;
fsEnv : ^^shClFSLocals;
groupEnv : ^^shClGrpLocals;
egoEnv : ^^cloneLocals;
END;
refCloneLocals = ^^cloneLocals;
refGate = ^^Gate;
æ$Eå
æ*** GLOBAL PROCEDURES ***å
æ*****************************å
FUNCTION createClone (VAR cloneOwner : ref;
VAR cloneMan : ref;
VAR cloneEnv : refCloneLocals;
VAR fsEnv : refSCFsLocals;
VAR groupEnv : refSCGLocals;
VAR shareEnv : refShareLocals
) : resultType; FORWARD;
æ This procedure is placed in the end of the program because of
references to the object 'iClone'
å
FUNCTION createShare (VAR shareOwner : ref;
VAR shareMan : ref;
VAR shareEnv : refShareLocals;
VAR fsEnv : refSCFsLocals;
VAR llFao : faoRefType
) : resultType;
VAR
res : resultType;
s, voidSize : sizeType;
i : integer;
BEGIN
æ#ENTRY# PS ('CREATESHARE '); &ENTRY&å
res.main := ok;
IN
SCheck ( ClearSize (s));
voidSize.user := -1; voidSize.kernel := -1;
SCheck ( AddEnv (s, refs(shareLocals)));
SCheck ( AddSeg (s, bytes(shareData)));
XCheck ( fsEnv^^.allocRef.NewObj ( OUT shareOwner ; IN s, OUT i ));
XCheck ( DeclEnv ( shareOwner, shareMan, shareEnv, refs(shareLocals),
0 æno termProcå, s, voidSize));
XCheck ( NewSeg (shareEnv^^.pShareData, bytes(sharedata)));
XCheck ( fsEnv^^.schedRef.NewGate (OUT shareEnv^^.shareGate));
SCheck ( Copy ( llFao, shareEnv^^.llFao ));
SCheck ( Copy ( shareOwner, shareEnv^^.egoObj ));
DO
IF res.main = ok THEN res := GetException;
createShare := res;
END; æcreateShareå
FUNCTION equalNames (name1, name2 : fullId;
lg2 : integer
) : boolean;
VAR
b : boolean;
i : integer;
æ returns the value true if 'name1' equals the first 'lg2' chars of 'name2'å
BEGIN
b := elements(name1) = lg2;
i := 1;
WHILE b AND (i <= lg2) DO
BEGIN
b := name1ÆiÅ = name2ÆiÅ;
i := i+1;
END;
equalNames := b;
END; æequalNameså
FUNCTION findFile (VAR shareMan : ref;
VAR tmpEnv : refShareLocals;
VAR tmpFao : faoRefType;
fName : fullId
) : boolean;
VAR
res : resultType;
BEGIN
æ#ENTRY# PS('FINDFILE '); &ENTRY&å
findFile := false;
res := FirstInSet (shareMan, tmpEnv);
WHILE res.main = ok DO
BEGIN
WITH sh = tmpEnv^^.pShareData^^ DO
BEGIN
IF equalName (fName, sh.fileName, sh.fNameLgt) THEN
BEGIN
findFile := true;
SCheck ( Copy (tmpEnv^^.llFao, tmpFao ));
END; æequalå
END; æwithå
res := NextInSet (shareMan, tmpEnv);
END;
END; æfindFileå
æ$Eå
PROGRAM iClone OBJECT fao WITH cloneLocals;
ENTRY ReadSeq æ segment ; OUT byteCount å
WITH RECORD t : ^^; END;
VAR
i : integer;
param : fullId;
res : resultType;
æ A call of ReadSeq is executed as ReadRandom using the share position
stored in the share group data å
BEGIN
æ#ENTRY# PS ('READSEQ '); &ENTRY&å
res.main := ok;
SCheck ( shareEnv^^.shareGate.Lock );
IN
WITH sh = shareEnv^^.pShareData^^ DO
BEGIN
æ*b* printVar ('shareData = ', sh);
printVar ('sh.fPos = ', sh.fPos); *e*å
IF (sh.rwMode = NoRights) OR
(sh.rwMode = WriteRights) THEN
Exception (makeRes (-EntryIllegal, Universal,
2, noReadReservation ));
SCheck ( Propagate ( propReject ));
IF sh.terminal THEN
XCheck(shareEnv^^.llFao.ReadSeq (IN segment ; OUT byteCount,
WHILE NextValArg(param) DO (IN OUT param)))
ELSE
BEGIN
res := shareEnv^^.llFao.ReadRandom (IN segment ;
OUT byteCount, IN sh.fPos, OUT i,
WHILE NextValArg(param) DO (IN OUT param));
IF res.main = -EntryIllegal THEN
BEGIN
sh.Terminal:=true;
XCheck(shareEnv^^.llFao.ReadSeq(IN segment ; OUT byteCount,
WHILE NextValArg(param) DO (IN OUT param)));
res.main:=ok;
END
ELSE XCheck(res);
END; ænot terminalå
sh.fPos := sh.fPos + byteCount;
æ*b* printVar ('after readSeq, byteCount = ', byteCount);
printVar ('updated sh.fPos = ', sh.fPos); *e*å
END; æwithå
DO
IF res.main = ok THEN res := GetException;
SCheck ( shareEnv^^.shareGate.Open );
ObjReturn (res);
END; æReadSeqå
ENTRY WriteSeq æ segment ; OUT byteCount å
WITH RECORD t : ^^; END;
VAR
i : integer;
param : fullId;
res : resultType;
æ A call of WriteSeq is executed as WriteRandom using the share position
stored in the share group data å
BEGIN
æ#ENTRY# PS ('WRITESEQ '); &ENTRY&å
res.main := ok;
SCheck ( shareEnv^^.shareGate.Lock );
IN
WITH sh = shareEnv^^.pShareData^^ DO
BEGIN
IF sh.rwMode < WriteRight THEN
Exception (makeRes (-EntryIllegal, Universal,
2, noWriteReservation ));
SCheck ( Propagate ( propReject ));
IF sh.terminal THEN
XCheck ( shareEnv^^.llFao.WriteSeq (IN segment ; OUT byteCount,
WHILE NextValArg(param) DO (IN OUT param)))
ELSE
BEGIN
res := shareEnv^^.llFao.WriteRandom (IN segment ;
OUT byteCount, IN sh.fPos, OUT i,
WHILE NextValArg(param) DO (IN OUT param));
IF res.main = -EntryIllegal THEN
BEGIN
sh.terminal:=true;
XCheck ( shareEnv^^.llFao.WriteSeq (IN segment ; OUT byteCount,
WHILE NextValArg(param) DO (IN OUT param)));
res.main:=ok;
END
ELSE XCheck(res);
END;
sh.fPos := sh.fPos + byteCount;
END; æwithå
DO
IF res.main = ok THEN res := GetException;
SCheck ( shareEnv^^.shareGate.Open );
ObjReturn (res);
END; æWriteSeqå
ENTRY ReadRandom æ segment ; OUT byteCount, IN pos, OUT actualPos å
WITH RECORD t : ^^; END;
VAR
param : fullId;
res : resultType;
BEGIN
æ#ENTRY# PS ('READ-RANDOM '); &ENTRY&å
res.main := ok;
SCheck ( shareEnv^^.shareGate.Lock );
IN
WITH sh = shareEnv^^.pShareData^^ DO
BEGIN
IF (sh.rwMode = NoRights) OR
(sh.rwMode = WriteRight) THEN
Exception (makeRes (-EntryIllegal, Universal,
2, noReadReservation ));
SCheck ( Propagate ( propReject ));
XCheck ( shareEnv^^.llFao.ReadRandom (IN segment ;
OUT byteCount, IN pos, OUT actualPos,
WHILE NextValArg(param) DO (IN OUT param)));
sh.fPos := pos + byteCount;
END; æwithå
DO
IF res.main = ok THEN res := GetException;
SCheck ( shareEnv^^.shareGate.Open );
ObjReturn (res);
END; æReadRandomå
ENTRY WriteRandom æ segment ; OUT byteCount, IN pos, OUT actualPos å
WITH RECORD t : ^^; END;
VAR
param : fullId;
res : resultType;
BEGIN
æ#ENTRY# PS ('WRITE-RANDOM '); &ENTRY&å
res.main := ok;
SCheck ( shareEnv^^.shareGate.Lock );
IN
WITH sh = shareEnv^^.pShareData^^ DO
BEGIN
IF sh.rwMode < WriteRight THEN
Exception (makeRes (-EntryIllegal, Universal,
2, noWriteReservation ));
SCheck ( Propagate ( propReject ));
XCheck ( shareEnv^^.llFao.WriteRandom (IN segment ;
OUT byteCount, IN pos, OUT actualPos,
WHILE NextValArg(param) DO (IN OUT param)));
sh.fPos := pos + byteCount;
END; æwithå
DO
IF res.main = ok THEN res := GetException;
SCheck ( shareEnv^^.shareGate.Open );
ObjReturn (res);
END; æWriteRandomå
ENTRY Seek æ ; IN baseMode, IN offset, OUT pos å
WITH RECORD t : ^^; END;
VAR
param : fullId;
res : resultType;
lBaseMode: baseType;
lOffset: integer;
æ The position returned from llFao.Seek is stored in the shareGroup data å
BEGIN
æ#ENTRY# PS ('SEEK '); &ENTRY&å
res.main := ok;
SCheck ( shareEnv^^.shareGate.Lock );
IN
WITH sh = shareEnv^^.pShareData^^ DO
BEGIN
if baseMode = fromCurrent then begin
lOffset := sh.fPos + offset;
lBaseMode := fromStart;
end else begin
lBaseMode := baseMode;
lOffset := offset;
end;
XCheck ( shareEnv^^.llFao.Seek ( ; IN lBaseMode, IN lOffset, OUT pos,
WHILE NextValArg(param) DO (IN OUT param)));
sh.fPos := pos;
END;
DO
IF res.main = ok THEN res := GetException;
SCheck ( shareEnv^^.shareGate.Open );
ObjReturn (res);
END; æSeekå
ENTRY DataSize æ ; IN dataBytes å
WITH RECORD t : ^^; END;
VAR
param : fullId;
res : resultType;
BEGIN
æ#ENTRY# PS ('DATASIZE '); &ENTRY&å
res.main := ok;
SCheck ( shareEnv^^.shareGate.Lock );
IN
WITH sh = shareEnv^^.pShareData^^ DO
BEGIN
IF sh.rwMode < WriteRight THEN
Exception (makeRes (-EntryIllegal, Universal,
2, noWriteReservation ));
SCheck ( Propagate ( propReject ));
XCheck ( shareEnv^^.llFao.DataSize ( ; IN dataBytes ,
WHILE NextValArg(param) DO (IN OUT param)));
sh.fPos := 0;
END; æwithå
DO
IF res.main = ok THEN res := GetException;
SCheck ( shareEnv^^.shareGate.Open );
ObjReturn (res);
END; æ DataSize å
ENTRY DUP æ OUT dupClone å
WITH RECORD
tt : ^^;
cloneEnv : ^^cloneLocals;
END;
VAR
res: ResultType;
BEGIN
æ#ENTRY# PS('DUP ') &ENTRY&å ;
res.main:=ok;
SCheck ( fsEnv^^.central.Lock );
IN
XCheck ( createClone ( dupClone, groupEnv^^.cloneMan, cloneEnv,
fsEnv, groupEnv, shareEnv ));
DO
IF res.main = ok THEN res := GetException;
SCheck ( fsEnv^^.central.Open );
ObjReturn(res);
END; æ*** dup ***å
OTHERWISE cloneEntries with record tt: ^^; end;
VAR
i : integer;
formalRef : refPtr;
args : ArgType;
res : ResultType;
param : FullId;
FUNCTION nextFormal : boolean;
BEGIN
i := i+1;
nextFormal := i <= args.NoOfFormals;
IF i <= args.NoOfFormals THEN formalRef := Formal(i);
END; æ***nextFormal***å
BEGIN
res.main := ok;
i := 0;
args := EntryArgs;
æ#ENTRY# PSS('CLONEother ',args.opCode) &ENTRY&å ;
SCheck ( shareEnv^^.shareGate.Lock );
IN
SCheck ( Propagate ( propReject ));
XCheck ( shareEnv^^.llFao.args.opCode
(WHILE nextFormal DO (IN æOUTå formalRef^) ; æpascal/kerne BEUFå
WHILE NextValArg(param) DO (IN OUT param)));
DO
IF res.main = ok THEN res := GetException;
SCheck ( shareEnv^^.shareGate.Open );
ObjReturn(res);
END; æ***otherwise***å
END æ***PROGRAM iClone***å;
æ$Eå
PROGRAM iShClGrp OBJECT IoSys WITH shClGrpLocals;
ENTRY Assign æ OUT ownedFao ; IN fileName, IN ioRights å
WITH RECORD
tt : ^^;
fileSys : ioSysRefType;
tmpFao : ^^;
saveFao : ^^;
tmpClEnv : ^^cloneLocals;
tmpShEnv : ^^shareLocals;
tmpShOwner : ^^Gate;
END;
VAR
res : ResultType;
i, j, lgt, used : integer;
old : boolean;
param : fullId ;
BEGIN
æ#ENTRY# PS('ASSIGN '); &ENTRY&å
res.main := ok;
IN
XCheck ( dir.GetRef (OUT fileSys ; IN fileName, OUT used, OUT i));
lgt := elements (fileName);
æ#B# printvar('$ assign, restName= ',fileNameÆused+1..lgtÅ); #E#å
IF equalNames (fileNameÆused+1..lgtÅ, '/dev/tty', 8) THEN
BEGIN æterminal: duplicate cloneå
XCheck ( controlClone.Dup (OUT ownedFao));
END
ELSE
BEGIN æfile: search fileName in set of share objects.
(In the present implementation only the file name is checked,
but the file system aught to be checked by means of RefEqual)
If fileName not found then assign file and create new share
and clone. Otherwise duplicate share and create new clone å
SCheck ( fsEnv^^.central.lock );
IN
old := findFile (shareMan, tmpShEnv,
æoutåtmpFao, fileNameÆused+1..lgtÅ);
IF NOT old THEN
XCheck (fileSys.Assign (OUT tmpFao ;
IN fileNameÆused+1..lgtÅ, IN IoSys.ReadWriteRight,
WHILE nextValArg(param) DO (IN OUT param) ));
XCheck ( createShare (tmpShOwner, shareMan,
tmpShEnv, fsEnv, tmpFao ));
æ initialize ShareData å
WITH sh = tmpShEnv^^.pShareData^^ DO
BEGIN
sh.fPos := 0;
sh.rwMode := ioRights;
j := 0;
FOR i := used+1 TO lgt DO
BEGIN
j := j + 1;
sh.fileNameÆjÅ := fileNameÆiÅ;
END;
FOR i := j+1 TO maxIdLgt DO
sh.fileNameÆiÅ := chr(0);
sh.fNameLgt := j;
sh.cloneCount := 0;
sh.terminal:=false; ædefault, may be changed later /mik 83-12-22å
END; æwith shå
XCheck ( MoveOwn (tmpShOwner, shareOwner));
IN
IF NOT old THEN
BEGIN
SCheck ( Copy (tmpFao, saveFao));
XCheck ( MoveOwn (tmpFao, faoOwner));
END;
IN
XCheck ( createClone (ownedFao, cloneMan, tmpClEnv,
fsEnv, egoEnv ægroupEnvå, tmpShEnv ));
DO BEGIN
IF res.main = ok THEN res := GetException;
IF not old THEN
NoCheck ( Dealloc (faoOwner, saveFao));
Exception (res);
END; æcreateClone errorå
DO BEGIN
IF res.main = ok THEN res := GetException;
NoCheck ( Dealloc (shareOwner, tmpShEnv^^.egoObj));
Exception (res);
END; æ MoveOwn(fao) or createClone error å
DO
IF res.main = ok THEN res := GetException;
SCheck ( fsEnv^^.central.Open );
END; æfile <> '/dev/tty'å
DO
IF res.main = ok THEN res := GetException;
ObjReturn (res); æ deallocates clone and fao in case of errors å
END; æ*** entry Assign ***å
æ$Eå
PRIVATE CloseClone
æin owner: faoRefType;
in env: refCloneLocalså
WITH RECORD
tt : ^^;
work : ^^;
tmpOwn : ^^;
tmpFao : faoRefType;
tmpShEnv : ^^shareLocals;
END;
VAR
res : resultType;
BEGIN
æ#ENTRY# PS('CLOSE-CLONE '); &ENTRY&å
SCheck ( fsEnv^^.central.Lock );
res.main := ok;
IN
WITH cl = env : refCloneLocals DO
BEGIN
SCheck ( Copy ( cl^^.shareEnv, tmpShEnv ));
WITH sh = tmpShEnv^^.pShareData^^ DO
BEGIN
sh.cloneCount := sh.cloneCount - 1;
IF sh.cloneCount < 1 THEN
BEGIN æ last clone to this share, dealloc share å
IN XCheck ( MoveOwn (tmpShEnv^^.egoObj, tmpOwn));
DO SCheck ( MoveOwn (tmpShEnv^^.egoObj, errOwner));
SCheck ( MoveMan (tmpShEnv, tmpShEnv ));
IF NOT findFile (shareMan, work, æoutå tmpFao,
sh.fileNameÆ1..sh.fNameLgtÅ) THEN
BEGIN æ also last share to same file, dealloc fao å
IN XCheck ( MoveOwn (tmpShEnv^^.llFao, tmpFao));
DO SCheck ( MoveOwn (tmpShEnv^^.llFao, errOwner));
END; ælast share, dealloc Faoå
END; ælast clone, dealloc shareå
END; æwith shå
END; æwith clå
DO
IF res.main = ok THEN res := GetException;
SCheck ( fsEnv^^.central.Open );
ObjReturn(res); æ deallocates clone and possibly share and fao å
END; æ*** CloseClone ***å
æ$Eå
ENTRY WaitSignal
æout signalType: integerå
WITH RECORD
tt: ^^;
control : ^^ fao;
END;
BEGIN
æ#ENTRY# PS('WAITSIGNAL ') &ENTRY&å ;
signalType:=del;
SCheck(firstInSet(faoOwner,control));
ObjReturn(control.WaitBreak); æ control clone could have been called å
END æ***WaitSignal***å;
ENTRY CloneFileEnv
æfromEnv, toEnv: refFileEnvelopeå
WITH RECORD
tt : ^^;
temp : ^^cloneLocals;
cloneEnv : ^^cloneLocals;
tmpShEnv : ^^ shareLocals;
END;
VAR res, res1 : ResultType;
stop : boolean ;
i, ix: integer;
BEGIN
æ#ENTRY# PS('CLONE-FILE-ENV ') &ENTRY&å ;
res.main:=ok;
IN
i:=0; stop := false;
REPEAT
i := i+1; æ next pointer in envelope å
res1 := InspObj (void, cloneEnv, fromEnv^^ÆiÅ, ix) ; æ OLD param list å
IF res1.main = -addressIllegal THEN æ end of pointer array in env å
BEGIN
res.main := ok;
stop := true;
END ELSE
IF res1.main = ok THEN
BEGIN
SCheck ( Copy (cloneEnv^^.shareEnv, tmpShEnv ));
SCheck ( fsEnv^^.central.Lock );
res := createClone (toEnv^^ÆiÅ, cloneMan, cloneEnv,
fsEnv, egoEnv ægroupEnvå, tmpShEnv );
SCheck ( fsEnv^^.central.Open );
XCheck (res);
END
ELSE
SCheck( Copy (fromEnv^^ÆiÅ, toEnv^^ÆiÅ ))
;
UNTIL stop;
DO
IF res.main=ok THEN res:=GetException;æ some clones may be in toEnv ???å
ObjReturn(res);
END æ***entry CloneFileEnv***å;
æ$Eå
ENTRY CreateLink æIN fileName, newFileName : fullIdå
WITH RECORD
t : ^^;
fileSys1 : ioSysRefType;
fileSys2 : ioSysRefType;
END;
VAR
res : resultType;
used1, used2, i : integer;
BEGIN
æ#ENTRY# PS('CREATELINK ') &ENTRY&å ;
res.main := ok;
IN
XCheck( dir.GetRef (OUT fileSys1 ;
IN fileName, OUT used1, OUT i));
XCheck( dir.GetRef (OUT fileSys2 ;
IN newFileName, OUT used2, OUT i));
IF NOT SameEntity (fileSys1, fileSys2) THEN
Exception( makeRes (-PointerValueIllegal, Universal, 1, notSameEntity));
XCheck( fileSys1.CreateLink ( ;
IN fileNameÆused1+1..elements(fileName)Å,
IN newFileNameÆused2+1..elements(newFileName)Å ));
DO
IF res.main = ok THEN res := GetException;
ObjReturn (res);
END; æCreateLinkå
æ$Eå
ENTRY DeleteLink æ IN fileName : fullId å
WITH RECORD
t : ^^;
fileSys : ioSysRefType;
END;
VAR
res : resultType;
i, used : integer;
BEGIN
æ#ENTRY# PS('DELETELINK ') &ENTRY&å ;
res.main := ok;
IN
XCheck( dir.GetRef (OUT fileSys ;
IN fileName, OUT used, OUT i ));
XCheck( fileSys.DeleteLink ( ;
IN fileNameÆused+1..elements(fileName)Å ));
DO
IF res.main = ok THEN res := GetException;
ObjReturn (res);
END; æDeleteLinkå
OTHERWISE SCGother
WITH RECORD
tt : ^^;
fs : ^^; æpointer to next file systemå
END;
VAR
used, i: integer;
formalRef: refPtr;
args: ArgType;
res: ResultType;
param: FullId;
FUNCTION nextFormal : boolean;
BEGIN
i:=i+1; nextFormal:=i<=args.NoOfFormals;
IF i<=args.NoOfFormals THEN formalRef:=Formal(i);
END æ***nextFormal***å;
BEGIN
res.main:=ok;
i:= 0; args:=EntryArgs;
æ#ENTRY# PSS('SCGother ',args.opCode) &ENTRY&å ;
ObjReturn(makeRes(-EntryIllegal,Universal,args.NoOfFormals,args.opCode));
æ the following code outlines how a "call thru mechanism" could be made å
IN
SCheck(Propagate(propReject));
IF not NextValArg(param) THEN
ObjReturn(makeRes(1,2,3,4));
res:= Call(dir.GetRef(OUT fs; IN OUT param, OUT used, OUT i));
XCheck(fs.args.opCode
(WHILE nextFormal DO (IN æOUTå formalRef^); æpascal/kerne BEUFå
WHILE NextValArg(param) DO (IN OUT param)));
DO
IF res.main=ok THEN res:=GetException;
ObjReturn(res);
END æ***otherwise***å;
END æ***PROGRAM iShClGrp***å;
æ$Eå
PROGRAM iShClFS OBJECT shClFS WITH shClFSLocals;
ENTRY InitSCFS
WITH RECORD
t: ^^;
END;
BEGIN
æ#ENTRY# PS('INITscfs ') &ENTRY&å ;
printtext( versid );
XCheck(schedRef.NewGate(out central));
SCheck(MakeReentrant(egoEnv));
END æ*** entry Init ***å;
ENTRY CreateGroup
æout groupOwner: refIoSysType;
in dir : refObjDir;
in termName: FullIdå
WITH RECORD
t: ^^;
tEnv: ^^shClGrpLocals;
fileSys: ioSysRefType;
END;
VAR
res: ResultType;
s: SizeType;
i: integer;
used: integer;
BEGIN
æ#ENTRY# PS('CREATEGROUP ') &ENTRY&å ;
IF SameEntity (Void, central) THEN
BEGIN
XCheck(schedRef.NewGate(out central));
SCheck(MakeReentrant(egoEnv));
END;
res.main:=ok;
IN
SCheck ( ClearSize(s));
SCheck ( AddGen(s,refs(shClGrpLocals)));
XCheck ( allocRef.NewObj(out groupOwner; s,out i));
SCheck ( ClearSize(s));
XCheck ( DeclGen(groupOwner,groupMan,tEnv,
refs(shClGrpLocals),0,s,makeSize(-1,-1),refs(iShClGrp),
bytes(iShClGrp),0,addr(iShClGrp),s, true));
æ assign local pointers of the group å
XCheck ( copy (code ,tEnv^^.code));
XCheck ( copy (egoEnv ,tEnv^^.fsEnv));
XCheck ( copy (tEnv ,tEnv^^.egoEnv));
XCheck ( copy (dir ,tEnv^^.dir));
XCheck ( makeReentrant (tEnv));
XCheck ( groupOwner.assign(OUT tEnv^^.controlClone; termName, readWrite));
DO
IF res.main=ok THEN res:=GetException;
ObjReturn(res); æ deallocates group in case of errors å
END æ*** entry CreateGroup ***å;
OTHERWISE scfsOther
WITH RECORD t: ^^; END;
BEGIN
æ#ENTRY# PS('scfsOTHER ') &ENTRY&å ;
exception(makeRes(-EntryIllegal,Universal,2,0));
END æ*** otherwise ***å;
END æ***PROGRAM iShClFS***å;
æ$Eå
æ*** GLOBAL ROUTINES ***å
FUNCTION createClone; æ(VAR cloneOwner : ref;
VAR cloneMan : ref;
VAR cloneEnv : refCloneLocals;
VAR fsEnv : refSCFsLocals;
VAR groupEnv : refSCGLocals;
VAR shareEnv : refShareLocals
) : resultType; å
VAR
res : resultType;
s : sizeType;
i : integer;
BEGIN
æ#ENTRY# PS ('CREATECLONE '); &ENTRY&å
res.main := ok;
IN
SCheck ( ClearSize (s));
SCheck ( AddGen (s, refs(cloneLocals)));
XCheck ( fsEnv^^.allocRef.NewObj (OUT cloneOwner ; IN s, OUT i ));
SCheck ( ClearSize (s));
XCheck ( DeclGen (cloneOwner, cloneMan, cloneEnv, refs(cloneLocals),
CloseClone, s, s, refs(iClone), bytes(iClone),
0, addr(iClone), s, true));
SCheck ( Copy ( groupEnv^^.code, cloneEnv^^.code ));
SCheck ( Copy ( fsEnv , cloneEnv^^.fsEnv ));
SCheck ( Copy ( groupEnv , cloneEnv^^.groupEnv ));
SCheck ( Copy ( cloneEnv , cloneEnv^^.egoEnv ));
SCheck ( Copy ( shareEnv , cloneEnv^^.shareEnv ));
SCheck ( MakeReentrant ( cloneEnv ));
æ increase cloneCount in shareData å
WITH sh = shareEnv^^.pShareData^^ DO
sh.cloneCount := sh.cloneCount + 1;
DO
IF res.main = ok THEN res := GetException;
createClone := res;
END; æcreateCloneå
INITIALIZE
iShClFS 'scfs': allocRef 'allocate',
schedRef 'scheduler',
egoEnv '**'
END.
«eof»