|
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: 56064 (0xdb00)
Types: TextFile
Names: »UNIJCS.SA«
└─⟦311ba069f⟧ Bits:30009789/_.ft.Ibm2.50006625.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »UNIJCS.SA«
└─⟦49237ce80⟧ Bits:30009789/_.ft.Ibm2.50006627.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »UNIJCS.SA«
└─⟦714bbb381⟧ Bits:30009789/_.ft.Ibm2.50006595.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »UNIJCS.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 UNIPS ;
æ U N I x P r o c e s s a n d S i g n a l m a n a g e m e n t .
UU UU N NN IIII PPPPP SSSS WRITTEN BY:
UU UU NN NN II PP PP SS SS
UU UU NNN NN II PP PP SS V I L H E L M
UU UU NNNNNN II PPPPP SSSS
UU UU NN NNN II PP SS R O S E N Q V I S T
UU UU NN NN II PP SS SS
UUUU NN N IIII PP SSSS N C R S E - C P
å CONST VersID=010100; VersDate=831110; æ
This EOS module implements process and signal functionality as expected by
C programs under UNIX version 7. (UNIX is a trade mark of BELL LABS.).
A system call library that calls the UNIPS interfaces must be linked with the
C programs.
When UNIPS is installed it imports references to the following objects:
Allocate, Scheduler, ObjDir and Clock.
When a terminal is included (ENTRY INCLUDE) a reference to a "share master
object" must be passed as a formal pointer parameter. The object will be called
during INCLUDE and must return a refrence (probably an ownset) to an INPUT/
OUTPUT family object. This object serves as the default file system for the
C programs called from the terminal. The default file system must support
the following non-arch. entries:
IOSYS.CloneEnv , IOSYS.WaitSignal and FAO.CloneFao .
The UNIPS module itself does not belong to a family. However, a job handler
family object is created each time INCLUDE is called.
å
æ$H=0 : no heap space å
æ$D- : this assignment is only valid for the first part of the program. å
æ pascal statement numbers are heavily used during debugging. å
æ$L-å
æ$F=FAMILY.UNIV.IDå
æ$F=FAMILY.KNEL.IDå
PROCEDURE PrintText(text:fullId); FORWARD;
PROCEDURE PrintVar(text:fullId; UNIV v:BlockPtr); FORWARD;
FUNCTION Statement : integer; FORWARD;
æ$F=FAMILY.ALLOC.IDå
æ$F=FAMILY.SCHED.IDå
æ$F=FAMILY.OBJDIR.IDå
æ$F=FAMILY.IOSYS.IDå
æ$L+å
æ$Eå
æ$F=PRIVATE.UAPPLI.IDå
æ$Eå
æ$F=FAMILY.CLOCK.IDå
æ$F=PRIVATE.SHCLFS.IDå
æ$Eå
æ$F=PRIVATE.UNIJCS.IDå
æ$Eå
æ$L+å
FUNCTION æ value data in eosPascal cannot be specified as a sub segment
in the actual list of objCall, callExtend etc..However, this
However, this would be more convenient when UNIPS
"forks" (entry fork) or "execs" (entry exec) a utility.
solutions: 1) extend eosPascal
2) change UNIPS: Use the WHILE construct to specify value params.
3) implement an assembly routine as specified here.
å
ObjCallExtend (VAR callExt : ref; VAR obj : ref; func : integer;
VAR valueSeg : ref; valueBytes : long;
VAR files : ref; VAR jobhandler : ref;
VAR æOUTå execArgs : ref;
æ optional å VAR stack : ref; æ optional å VAR data : ref)
: ResultType; FORWARD;
PROCEDURE PS (hint : fullId); æprint statement numberå
VAR s : integer;
BEGIN s:=statement; PrintVar(hint,s); END;
PROCEDURE PSS(hint : fullId; l : Long); æprint statement number and Longå
VAR v : RECORD s : Long; l : Long; END;
BEGIN v.s:= statement; v.l:= l; PrintVar(hint,v); END;
PROCEDURE PR ( res : ResultType); æprint Resultå
VAR OutPut : RECORD
StatNo : integer;
result : ResultType;
END;
BEGIN
OutPut.StatNo:= statement;
OutPut.result:= res;
PrintVar('UNIPS Number OrgSy Au Ar OrgNo Fa Ca',OutPut);
END;
æ$Eå
PROCEDURE SCheck ( R : ResultType);
BEGIN
IF R.main <> ok THEN
begin printtext('***SCheck E R R O R ***'); PR(R) end else
æ#ALRES# PR(R) &ALRES&å ;
END;
PROCEDURE NoCheck ( R : ResultType);
BEGIN
æ#ALRES# PR(R) &ALRES&å æ#BTRES# PR(R) &BTRES&å ;
END;
PROCEDURE RCheck ( R : ResultType);
BEGIN
æ#ALRES# PR(R) &ALRES&å ;
IF R.main <> ok THEN BEGIN
æ#BTRES# PR(R) &BTRES&å ; ObjReturn(R);
END;
END;
PROCEDURE XCheck ( R : ResultType);
BEGIN
æ#ALRES# PR(R) &ALRES&å ;
IF R.main <> ok THEN BEGIN
æ#BTRES# PR(R) &BTRES&å ; exception(R);
END;
END;
FUNCTION Call ( R : ResultType) : ResultType;
BEGIN
æ#ALRES# PR(R) &ALRES&å æ#BTRES# PR(R) &BTRES&å ;
Call := R ;
END;
FUNCTION univRes (m : byte) : ResultType;
VAR r : ResultType;
BEGIN r.family:=0; r.main:= -m; r.orgNo:=statement; univRes:=r; END;
æ$Eå
æ*********** U N I P S D A T A S T R U C T U R E S ************å
CONST
ignore=1; default=0; noOfSignals=15; noOfFiles=20;
SIGHUP=1; SIGINT=2; SIGILL=4; SIGTRAP=5; SIGKILL=9; SIGALRM=14;
MaxSeconds=1000; MaxUSeconds=1000000000; Ragnarok=LongMax;
stop=0; rej=1; æpropagation modeså
uxio=1; æunix io-modeå
SHIFT16=16#10000;
TYPE
textVar = charstring; æ ARRAY Æ1..AddrMaxÅ OF char; å
text = ^ ÆÅ textVar ;
dirWName= ARRAY Æ1..14Å OF char; æX:PROCID:INDEXå
sigItem = RECORD
sigState : Long; æ ignore, default, sigFunc å
sigPend : Boolean;
END;
divPDType = RECORD æ variables returned from newUproc å
procID : IDType;
noOfFiles: long;
fenvSize: sizeType;
extSize : sizeType;
END;
PstateType = ( embryo, aborted, child, waiting, exec, zombie, dead );
æ embryo : until FORKEND is called by process
aborted: killed before FORKEND is called
child : normal running state (after FORKEND)
waiting: proc is waiting for child termination
exec : after PREPEXEC, before call to new program
zombie : terminated, parent exists but has not waited
dead : terminated, no parent
å
procData = RECORD
procID : IDType;
progCount : word; æ #programs executed by this process å
noOfChildren: word; æ #forks executed by this process å
procState : PstateType;
childState : PstateType; æ child OR embryo å
termStatus : Byte; æ initially ZERO , when killed = signalID å
useNewExt : boolean; æ true if a new extention is created in PREPEXEC å
alarmTime : Long; æ <> 0 when proc is in the alarmSet å
exitRes : ResultType; æ result of some program call å
parentID : IDType;
zombieID : IDType; æ assigned by zombie before a å
zombieStatus: Long; æ waiting parent is signaled. å
callLoad : dirWName;
callCrea : dirWName;
execLoad : dirWName;
execCrea : dirWName;
valBytes : long; æ size of valuedata for this process å
extSize : sizeType; æ std. size of extension object å
sig : ARRAY Æ1..noOfSignalsÅ OF sigItem;
END;
uniData = RECORD
alarmTime : Long;
noOfAlarms: Word;
newTime : Long;
nxtProcID : IDType; æ initially = 2 å
nxtPipeID : IDType; æ initially = 0 å
maxStack : SizeType; æ "constant" set during INIT å
procSize : SizeType; æ "constant" set during INIT å
extSize : SizeType; æ "constant" set during INIT å
fenvSize : SizeType; æ "constant" set during INIT å
END;
kpt = ^^ ;
PprocData = ^^ procData;
PuniData = ^^ uniData;
fileEnv = ARRAY Æ1..noOfFilesÅ OF kpt;
PfileEnv = ^^ fileEnv;
PgrpObj = ^^ GroupObj;
PobjDir = ^^ objDir;
PprocEnv = ^^ procEnv;
PgrpEnv = ^^ grpEnv;
PuniEnv = ^^ uniEnv;
procEnv = RECORD
pData : PprocData ;æ embedded segment object å
fileOwn : ^^ ;æ owns the file envelope object å
callProg : ^^UnixUtil ;æ called program å
execProg : ^^UnixUtil ;æ next program å
execExt : ^^ ; æ simple ref to extension object å
egoObj : ^^ ; æ simple ref to process object å
egoEnv : PprocEnv ;æ simple ref to process envelope å
parent : PprocEnv ;æ simple ref to parent envelope å
forkStack : ^^ ; æ used byå
forkData : ^^ ; æ fork å
files : PfileEnv ;æ ref to file envelope å
alarmSet : PprocEnv ;æ next proc in alarmset OR undef å
waitCond : ^^Condition;æ used by PAUSE , WAIT and FORK å
zombCond : ^^Condition;æ queue of zombies å
ProcGrp : PgrpEnv ;æ group of process, used by alarmProc å
END;
grpEnv = RECORD
code : ^^ ;
gData : ^^ ;æ no group data at present å
dir : ^^objDir ;æ owns objDir of this groupå
ClSh : ^^IoSys ;æ clone/share group object å
grpGate : ^^Gate ;æ protects group and processes of this group å
tmpManSet : PprocEnv ;æ manset of attention process + work manset å
procSet : PprocEnv ;æ manset of normal processes å
procOwn : ^^ ; æ owns all processes in this group å
unix : puniEnv ;æ global pointers å
deadZombie : PprocEnv ;æ may point to the oldest zombie å
execExtO : ^^ ; æ owns extension objects while they are not used å
fenvSet : ^^ ; æ manset of file envelopes å
egoObj : PgrpObj;
egoEnv : PgrpEnv;
END;
uniEnv = RECORD æ global pointers and pointers of alarm process å
code : ^^ ;
uData : PuniData ;
dir : ^^objDir ;æ set when loaded å
alloc : ^^allocate;æ set when loaded å
sched : ^^Scheduler;æ set when loaded å
uniClock : ^^Clock ;æ set when loaded å
egoEnv : PuniEnv ;æ set when loaded å
alarmSet : PprocEnv ;æ first proc in alarmSet å
grpSet : ^^ ; æ manset of groupså
uniGate : ^^Gate ;æ protects global unips structures å
alarmCond : ^^Condition;æ Time Out for the alarm process å
grpOwn : ^^ ; æ owns group objects and alarm process å
END;
æ if uniGate and (one) grpGate must both be locked, unigate is locked first å
æ$Eå
æ$K+ : needed during debugging å
æ******************* G L O B A L P R O C E D U R E S *******************å
TYPE longName = array Æ1..50Å of char;
FUNCTION FIX(w:dirWName):longName; æ this procedure fixes an error in objDir å
VAR f : longName; i : integer;
BEGIN for i:= 1 to 14 do fÆiÅ:= wÆiÅ; fÆ15Å:= chr(0); FIX:= f; END;
FUNCTION WName (c : char; ID : IDType; Index : word) : dirWName;
VAR w : dirWName; i : integer ;
BEGIN
wÆ1Å:= c ; wÆ2Å:= ':' ; wÆ9Å:= ':' ;
FOR i:= 8 DOWNTO 3 DO BEGIN
wÆiÅ:= chr(ord('0') + (ID mod 10)) ;
ID:= ID div 10 ;
END ;
FOR i:= 14 DOWNTO 10 DO BEGIN
wÆiÅ:= chr(ord('0') + (Index mod 10)) ;
Index:= Index div 10 ;
END ;
WName:= w ;
END ;
PROCEDURE sigProc (VAR proc : PprocEnv;
VAR p : procData;
VAR dir : PobjDir ;
sigNo : Long );
æ send signal to process, grpGate has been locked by caller å
BEGIN
æ the procState of the proc will be child, exec or waiting, because
embryo is killed by parent and aborted+zombie+dead does not execute at allå
WITH item = p.sigÆsigNoÅ DO BEGIN
IF item.sigState <> ignore THEN BEGIN æ abort or speedUp å
IF ( item.sigState = default) OR ( item.sigPend ) THEN BEGIN
IF p.termStatus = 0 THEN p.termStatus := sigNo ;
NoCheck( dir.AbortObj(;p.callCrea)); æ sufficient stack ! å
END ELSE BEGIN æsigFunc defined å
item.sigPend := true ;
NoCheck( dir.SpeedUpObj(;p.callCrea)); æ sufficient stack ! å
æ speedUpObj may later be replaced by the kernel operation speedUpProc å
END ;
END æ don't ignore å;
END æWITH itemå;
END æsigProcå;
æ$Eå
FUNCTION sigGrp (VAR grp : PgrpEnv ; æ must be a direct address å
VAR proc : PprocEnv; æ working pointer å
Var noOfSignals : Long;
sigNo : Long ;
grpFunc : Long) : Boolean;
æ grpFunc = 0 => signal is sent to all processes in the group
grpFunc < 0 => signal is sent to all processes except: procID= -grpFunc
grpFunc > 0 => signal is sent only to the process where: procID=grpFunc
sigGrp is true at return if procID=grpFunc was found, false otherwise;
å
type action = (sigGoOn, sig, GoOn);
VAR res : ResultType; ac : action;
BEGIN
SCheck( grp^^.grpGate.Lock); æcannot speed up, propMode = stop !! å
res:= Call( FirstInSet(grp^^.procSet,proc));
sigGrp:= false;
WHILE res.main = ok DO BEGIN
WITH p = proc^^.pData^^ DO BEGIN
IF grpFunc = 0 THEN ac:=sigGoOn ELSE
IF (grpFunc < 0) AND (p.procID <> -grpFunc) THEN ac:=sigGoOn ELSE
IF (grpFunc > 0) AND (p.procID = grpFunc) THEN ac:=sig ELSE ac:=GoOn;
IF (ac=sigGoOn) or (ac=sig) THEN BEGIN æ do send signal to process å
noOfSignals := noOfSignals + 1; æset to zero by callerå
sigProc(proc,p,grp^^.dir,sigNo);
IF ac = sig THEN BEGIN sigGrp:=true; res.main:= ok+1; END;
END æ sig å ;
IF (ac=sigGoOn) or (ac=GoOn) THEN BEGIN
res:= Call( NextInSet(grp^^.procSet,proc));
END æ GoOn å;
END æWITH På;
END æWHILEå;
SCheck( grp^^.grpGate.Open);
END æsigGrpå;
æ$Eå
PROGRAM UNIPSGRP OBJECT GROUPOBJ WITH grpEnv ; æ******************å
æ*** LOCAL PROCEDURES IN GROUP OBJECT ***å
FUNCTION NEWUPROC ( att : Boolean;
VAR parent : PprocEnv;
VAR proc : PprocEnv; æ return value å
VAR tempOwn : kpt ; æ return value å
VAR divPD : divPDType) : ResultType;
æ divPD recieves process values from UniData ( and grpData ? ) å
VAR res : ResultType; i : Long; newPsize : sizeType;
BEGIN æ propagate(rej) is set by caller å
res.main:= ok;
IN æ allocation may fail å
æ get data values for the new proc, at present all values can
be found in the unix object å
XCheck( unix^^.unigate.Lock); æ may speed up å
WITH u = unix^^.uData^^ DO BEGIN
divPD.procID:= u.nxtProcID;
u.nxtProcID:= u.nxtProcID + 1;
divPD.noOfFiles:= noOfFiles; æ CONST at present å
divPD.fenvSize:= u.fenvSize;
divPD.extSize:= u.extSize;
IF att THEN newPsize:= u.extSize ELSE newPsize:= u.procSize;
END æWITH uå;
SCheck( unix^^.uniGate.Open);
IF res.main <> ok THEN exception(res);
XCheck( unix^^.sched.NewProc(OUT tempOwn; newPsize)); æsize fixed at INITå
XCheck( DeclEnv(tempOwn, tmpManSet, proc, refs(procEnv),
0, makeSize(0,0), makeSize(-1,-1))); æ process envelope å
SCheck( Copy(tempOwn, proc^^.egoObj));
SCheck( Copy(proc, proc^^.egoEnv));
SCheck( Copy(egoEnv, proc^^.procGrp));
SCheck( Copy(parent, proc^^.parent));
XCheck( unix^^.alloc.newObj(OUT proc^^.fileOwn; divPD.fenvSize, OUT i));
SCheck( DeclEnv(proc^^.fileOwn, fenvSet, proc^^.files, divPD.noOfFiles,
0, makeSize(0,0), makeSize(-1,-1))); æ file envelope å
XCheck( newSeg(proc^^.pData, bytes(procData)));
XCheck( grpGate.NewCond(OUT proc^^.waitCond));
XCheck( grpGate.NewCond(OUT proc^^.zombCond));
DO IF res.main = ok THEN res:= getException;
æ in case of errors created objects will be deallocated by the caller å
newUproc:= res;
END ænewUprocå;
ENTRY GETPARAMS æRESERVEDå
WITH RECORD t:^^; END;
BEGIN ObjReturn(univRes(EntryIllegal)) END;
æ$Eå
ENTRY PREPEXEC æOUT execArgs : Ptext;
IN sourceName : text;
IN argBytes : Long å
æ Called by unix system call 'exec'.
load program, create callable application object and maybe a new
extension object. If everything succeeds create and return a segment
object in execArgs å
WITH RECORD t:^^;
proc : PprocEnv;
newExt : ^^;
cur : PprocEnv; æ working pointer for 'regret alarm' code å
END;
VAR res : ResultType; i : Long; segSize : sizeType;
first,last : integer;
BEGIN
æ#ENTRY# PS('PREPEXEC') &ENTRY&å ;
RCheck( inspProc(egoEnv,proc,i));
WITH p = proc^^.pData^^ DO BEGIN
IF p.procState <> child THEN ObjReturn(univRes(ObjectState));
SCheck( propagate(rej)); res.main:= ok;
p.execLoad:= WName('L', p.procID, p.progCount);
p.execCrea:= p.execLoad; p.execCreaÆ1Å := 'C' ;
æ If the sourceName specifies the default file system named '$'
this file system may be skipped by dir ??å
last:= elements(sourceName);
first:= 1;
IF last > 2 THEN BEGIN
IF ( sourceNameÆ1Å='$' ) AND ( sourceNameÆ2Å='/' ) THEN first:= 3;
END ;
RCheck( dir.Load(;FIX(p.execLoad), sourceNameÆfirst..lastÅ));
IN æ program loaded å
XCheck( dir.Create(OUT proc^^.execProg; FIX(p.execCrea), p.execLoad));
IN æ program created å
IF argBytes > 0 THEN BEGIN
SCheck( ClearSize(segSize));
SCheck( AddSeg(segSize,argBytes));
XCheck( unix^^.alloc.NewObj(OUT execArgs; segSize, OUT i));
XCheck( DeclSeg(execArgs, argBytes));
END ;
(* NOT implemented YET :
IF "callstack req. of created program > p.execExt" THEN BEGIN
XCheck( unix^^.alloc.NewObj(OUT newExt; "NEWSIZE", OUT i));
SCheck( Copy(newExt, proc^^.execExt));
SCheck( MoveOwn(newExt, execExtO));
p.useNewExt:= true;
END ;
*)
æ PREPEXEC has succeded. The child is allowed to copy data into the
execArg segment and return to UNIPS. All calls to UNIPS will be
rejected and signals cannot be caught å
SCheck( propagate(stop)); æa pending signal must not speed up the lockå
SCheck( grpGate.Lock);
p.procState:= exec;
p.valBytes:= argBytes;
p.progCount:= p.progCount + 1;
FOR i:= 1 TO noOfSignals DO BEGIN
IF p.sigÆiÅ.sigState <> ignore THEN BEGIN
p.sigÆiÅ.sigState:= default;
IF p.sigÆiÅ.sigPend THEN BEGIN æ new prog killed during PREPEXEC å
p.termStatus := i; æ means process killed å
NoCheck( dir.AbortObj(; p.callCrea));
END ;
END ;
END æFORå;
SCheck( grpGate.Open);
æ note that the process is not removed from the alarmSet å
DO BEGIN
IF res.main = ok THEN res:= getException;
NoCheck( Dealloc(execArgs, execArgs)); æmay not have been created yetå
SCheck( dir.deleteItem(; p.execCrea));
exception(res);
END ;
DO BEGIN
IF res.main = ok THEN res:= getException;
SCheck( dir.deleteItem(; p.execLoad));
END ;
ObjReturn(res);
END æWITH på;
END æENTRY PREPEXECå;
PRIVATE FORKPROC (IN proc : PprocEnv ;
IN parent : PprocEnv);
æ$Eå
ENTRY FORKBEGIN æIN stack : kpt ; <== should be a formal subsegment!!!!
IN data : kpt å
æ Because stack and data segment of the calling unips utility are
parameters to the entry, value parameters cannot easily be added
to the parameter list. However, childID of the new process must be returned
to the calling process. The value could be a VAR parameter (subsegment)
of an other temp data segment created by the run time system,
but at present childID is returned via the standard result value !!!!!! å
æ !!!!! if stack IS a formal subsegment, childId could be normal value data å
æ Create a new process, and let the NEW process turn itself into a copy
of the calling process. The entry is called by the unix system call 'fork' å
WITH RECORD t:^^;
proc : PprocEnv; æcalling procå
newChild: PprocEnv;
tempOwn : ^^ ; æ owns process object å
tempExt : ^^ ; æ owns extension object å
END ;
VAR res : ResultType; i : Long; divPD : divPDType;
BEGIN
æ#ENTRY# PS('FORKBEGIN') &ENTRY&å ;
RCheck( InspProc(egoEnv,proc,i));
WITH p = proc^^.pData^^ DO BEGIN
IF p.procState <> child THEN ObjReturn(univRes(ObjectState));
SCheck( Propagate(rej)); res.main:= ok;
RCheck( unix^^.alloc.NewObj(OUT tempExt; p.extSize, OUT i));
RCheck( newUproc(false,proc,newChild,tempOwn,divPD));
SCheck( Copy(tempExt,newChild^^.execExt));æ childs ref to extObj å
WITH c = newChild^^.pData^^ DO BEGIN
c.procID:= divPD.procID;
c.parentID:= p.procID;
c.callLoad:= p.callLoad; æ child runs the same program as parent å
c.progCount:= 0; æ index of a forked program å
c.callCrea:= WName('C',c.procID,c.progCount);
c.progCount:= 1; æ index of first execed program å
c.noOfChildren:= 0;
c.termStatus:= 0;
c.procState:= p.childState; æ child or embryo å
c.childState:= embryo;
c.useNewExt:= false; æ the first extension object is of cause used å
c.alarmTime:= 0;
c.valBytes:= p.valBytes; æ size of original value data å
c.extSize:= divPD.extSize;
FOR i:= 1 TO noOfSignals DO BEGIN
c.sigÆiÅ.sigState:= p.sigÆiÅ.sigState;
c.sigÆiÅ.sigPend:= false;
END æFORå;
RCheck( CallExtend(tempExt,ClSh,CloneFileEnv,
proc^^.files,newChild^^.files));
RCheck( CallExtend(tempExt,dir,create,
OUT newChild^^.callProg; FIX(c.callCrea), c.callLoad));
RCheck( grpGate.Lock); æ may speed up, ==> child will be deallocated å
æ from this point nothing can prevent declaration of the child process å
æ however the statements below could be rearranged so that errors from å
æ MoveOwn ( should not occur ) can be handled correctly (XCheck) å
SCheck( MoveMan(newChild,procSet)); æ makes child visible å
SCheck( MoveOwn(tempExt,execExtO)); æ must not fail å
SCheck( Copy(stack,proc^^.forkStack));
SCheck( Copy(data,proc^^.forkData));
SCheck( DeclProc(tempOwn,forkProc,newChild,proc));
SCheck( MoveOwn(tempOwn,procOwn)); æ must not fail å
p.exitRes.main:= ok; æ may be changed by child if it fails å
æ c.procState equals embryo, except when attProc calls FORKBEGIN å
IF c.procState = embryo THEN BEGIN æ wait for forkEnd å
res:= Call( proc^^.waitCond.wait); æ may be speeded up or signaled å
IF res.main = -speededUp THEN BEGIN æ reject the fork å
p.exitRes:= res;
c.procState:= aborted;
NoCheck( dir.AbortObj(; c.callCrea));
æ the child process may execute in the initial context (FORKPROC) å
æ**** NoCheck( SpeedUpProc(void,newChild)); NOT IMPLEMENTED YET å
END æspeedupå;
END æwaitå;
IF c.procState = child THEN BEGIN
p.noOfChildren:= p.noOfChildren + 1;
p.exitRes.orgNo:= c.procID MOD (SHIFT16);
p.exitRes.orgSys:= c.procID DIV (SHIFT16);
END ;
SCheck( Copy(void,proc^^.forkStack)); æ must be done å
SCheck( Copy(void,proc^^.forkData)); æ must be done å
SCheck( grpGate.Open);
ObjReturn(p.exitRes);
END æWITH cå;
END æWITH på;
END æENTRY FORKBEGINå;
æ$Eå
ENTRY FORKEND
æ Called by the embyo when the environment of the parent has been copied å
WITH RECORD t:^^;
proc : PprocEnv;
papa : PprocEnv;
END ;
VAR res : ResultType; i : Long;
BEGIN
æ#ENTRY# PS('FORKEND') &ENTRY&å ;
RCheck( InspProc(egoEnv,proc,i));
WITH p = proc^^.pData^^ DO BEGIN
IF p.procState <> embryo THEN ObjReturn(univRes(ObjectState));
SCheck( Propagate(rej)); res.main:= ok;
RCheck( grpGate.Lock); æ can only be speeded up by abortion because å
æ no signals are caught by embryo å
æ since the child reaced so far, the parent is still waiting with exitRes=ok å
p.procState:= child;
SCheck( Copy(proc^^.parent,papa));
SCheck( papa^^.waitCond.Signal);
SCheck( grpGate.Open);
ObjReturn(res);
END æWITH på;
END æENTRY FORKENDå;
æ$Eå
PRIVATE CLEANUP (IN proc : PprocEnv)
æ Dealloc objects owned by the process envelope AND remove proc from alarmSet.å
æ CleanUp is called to utilize the free stack of an extension object during å
æ dealloc. GrpGate must not be open while uniGate is locked by cleanUp.å
WITH RECORD t:^^;
END ;
VAR rep : boolean;
BEGIN
æ#ENTRY# PS('CLEANUP') &ENTRY&å ;
NoCheck( Dealloc(proc^^.fileOwn,proc^^.fileOwn));
NoCheck( Dealloc(proc^^.zombCond,proc^^.zombCond)); æ release zombies å
NoCheck( Dealloc(proc^^.waitCond,proc^^.waitCond));
WITH p = proc^^.pData^^ DO BEGIN
rep:= true;
WHILE rep DO BEGIN æ only two loops are executed å
SCheck( unix^^.uniGate.Lock);
IF p.alarmTime = 0 THEN rep := false
ELSE BEGIN
p.alarmTime:= Ragnarok; æ proc should be removed å
æ u.newTime is zero, alarmProc will remove proc from alarmSet å
SCheck( unix^^.alarmCond.Signal);
æ p.alarmTime is set to zero by alarmProc å
END ;
SCheck( unix^^.uniGate.Open); æ allow alarmProc to run å
END æWHILEå;
END æWITH pø;
END æPRIVATE CLEANUPå;
æ$Eå
PRIVATE FORKPROC æIN proc : PprocEnv ;
IN parent : PprocEnv å
æ Unix processes executing unix utility programs starts in this entry å
WITH RECORD t:^^;
callArgs : ^^ ; æ segment object å
execArgs : ^^ ; æ segment object å
callExt : ^^ ; æ extension object å
kid : PprocEnv;
END ;
VAR res : ResultType; i : Long; remove, progUsed : boolean; LABEL 0;
BEGIN
æ#ENTRY# PS('FORKPROC') &ENTRY&å ;
SCheck( Propagate(rej));
WITH p = proc^^.pData^^ DO BEGIN
IN æ This IN block should be reprogrammed using IF !!??å
SCheck( MoveOwn(proc^^.execExt,callExt)); æ extObj created by parent å
æ next two alloc calls has been moved to FORKBEGIN. å
æ XCheck( CallExtend(callExt,ClSh,CloneFileEnv, å
æ parent^^.files,proc^^.files)); å
æ XCheck( CallExtend(callExt,dir,create, å
æ OUT proc^^.callProg; FIX(p.callCrea), p.callLoad));å
IF p.procState = child THEN BEGIN æ initial fork to login program å
p.valBytes:= 70; æ *********** obs: must match the TOTAL below å
p.exitRes:= Call( CallExtend( callExt, proc^^.callProg, run,
æunips standard:å proc^^.files, egoObj, OUT execArgs;
æ 6+2 byteså 'llgin',
æ 0+2 byteså ''æ end of arguments å ,
æ 6+2 byteså 'HOME=/',
æ20+2 byteså 'PATH=:/bin:/usr/bin',
æ 0+2 byteså ''æ end of environment å ,
æ10+2 byteså '$/unixfs/' æ ClSh + lowlevel FS å ,
æ10+2 byteså '$/pipefs/' æ ClSh + pipe FS å ,
æ 2+2 byteså '/' æ current working dir å));
æTOTAL= 54+16 =70, must have been assigned to p.valBytes above å
END ELSE
IF p.procState = embryo THEN BEGIN æ parent is still waiting å
p.exitRes:= Call( ObjCallExtend( callExt, proc^^.callProg, fork,
ædummy values:å t, p.valBytes,
æunips standard:å proc^^.files, egoObj, æOUTå execArgs,
æoptionals:å parent^^.forkStack, parent^^.forkData));
END ;
IF p.procState = embryo THEN exception(p.exitRes);
DO BEGIN æ the fork has failed å
SCheck( Propagate(stop));
SCheck( grpGate.Lock);
IF p.procState = embryo THEN BEGIN æ parent is waiting å
WITH dad = parent^^.pData^^ DO BEGIN
dad.exitRes:= getException;
IF dad.exitRes.main = ok æ ok may have been returned from appl å
THEN dad.exitRes:= univRes(giveUp);
SCheck( parent^^.waitCond.Signal);
END æWITH dadå;
END æ waiting parent å;
SCheck( grpGate.Open);
SCheck( Propagate(rej)); æ not realy needed å
END æfork has failedå;
REPEAT æ exec loop å
NoCheck( CallExtend(callExt,dir,deleteItem ;p.callCrea));
æ check whether "children" or "parents" are using the loaded prog å
res:= Call( FirstInSet(procSet,kid));
REPEAT æ always at least one proc in set å
progUsed:=false;
WITH cp=kid^^.pData^^ DO BEGIN
IF p.procID <> cp.procID THEN BEGIN æ other process å
progUsed:=true;
FOR i:=bytes(dirWName) DOWNTO 1 DO
IF p.callLoadÆiÅ <> cp.callLoadÆiÅ THEN progUsed:=false;
END æ other process å;
END æWITHå;
IF NOT progUsed THEN res:= Call( NextInSet(procSet,kid));
UNTIL progUsed OR (res.main <> ok);
IF NOT progUsed THEN
NoCheck( CallExtend(callExt,dir,deleteItem ;p.callLoad));
NoCheck( Dealloc(callArgs,callArgs));
IF p.procState <> exec THEN goto 0; æ exit the exec repeat loop å
p.procState:= child;
æ has a new extension object been defined in PREPEXEC ?å
IF p.useNewExt THEN BEGIN æ a new extension object has been created å
SCheck( MoveOwn(proc^^.execExt,callExt));
SCheck( FirstInSet(callExt,kid)); æ kid:= old extension å
SCheck( Dealloc(callExt,kid));
p.useNewExt:= false;
END ;
SCheck( grpGate.Lock); æ speedUp do not occur å
p.callLoad:= p.execLoad;
p.callCrea:= p.execCrea;
SCheck( Copy(proc^^.execProg,proc^^.callProg));
SCheck( MoveOwn(execArgs,callArgs));
i:= p.termStatus;
Scheck( grpGate.Open);
IF i = 0 THEN BEGIN æ proc has not been killed å
p.exitRes:= Call( ObjCallExtend( callExt, proc^^.callProg, run,
ævalueData:å callArgs, p.valBytes,
æunips standard:å proc^^.files, egoObj, æOUTå execArgs,
ædummy optionals:å t,t));
END ;
UNTIL false ;
0: NoCheck( CallExtend(callExt,void,cleanUp,IN proc));
æ cleanUp will deallocate the fileEnv and the condition objects in the
process envelope. It also removes the process from the alarmSet å
NoCheck( Dealloc(callExt,callExt));
æ execArgs may own an object returned by the last clumsy program å
IF p.procState <> child THEN BEGIN
P.procState := dead ;
æ at present dead processes are deallocated "by luck" (see below
and in attProc. ADAM may be implemented later å
END ELSA BEGIN
æ the terminating process did become a child; it may have:
1) zombies : turned into dead processes
2) children: loose their parent
3) parent : activated if waiting for children to terminate
å
Scheck( grpGate.Lock);
IF p.noOfChildren > 0 THEN BEGIN
res:= Call( FirstInSet(procSet,kid));
WHILE res.main = ok DO BEGIN
WITH c = kid^^.pData^^ DO BEGIN
IF c.parentID = p.procID THEN BEGIN æ child is found å
IF c.procState = zombie
THEN c.procState:= dead
ELSE c.parentID := 1 æno parentå ;
END ;
IF c.procState = dead THEN remove:= true ELSE remove:= false;
END æWITH cå;
IF remove THEN SCheck( Copy(kid^^.egoObj,callExt)); æsave refDeadå
res:= Call( NextInSet(procSet,kid));
IF remove THEN SCheck( Dealloc(procOwn,callExt));
END æWHILEå;
END ænoOfChildren > 0å;
res.main:= ok; æprepare parent handlingå
IF p.parentID = 1 THEN BEGIN æ no parent å
p.procState:= dead;
END ELSE BEGIN
p.procState:= zombie;
IN æ zombCond may be deallocated by a terminating parent å
WITH papa = parent^^.pData^^ DO BEGIN
IF papa.procState <> waiting THEN BEGIN
XCheck( parent^^.zombCond.Wait);
æ exception with res.main=status when cond is deallocated å
END ;
papa.zombieID:= p.procID;
æ note the signbit problem in the next statement å
papa.zombieStatus:= (p.exitRes.auxCause * 256) + p.termStatus;
SCheck( Copy(proc,deadZombie)); æ zombie is a shared pointer:OK!å
SCheck( parent^^.waitCond.Signal);
END æWITH papaå;
DO res:= getException;
END æparent handlingå;
IF res.main <= ok æ reject or ok å
THEN SCheck( grpGate.Open);
END æchild terminationå;
ObjReturn(res); æ return from initial context å
END æWITH på;
END æPRIVATE FORKPROCå;
æ$Eå
ENTRY WAITexit æOUT procID : Long ;
OUT status : Long å
æ Called by unix system call 'wait' å
WITH RECORD t:^^;
proc : PprocEnv;
END ;
VAR res : ResultType; i : Long;
BEGIN
æ#ENTRY# PS('WAIT') &ENTRY&å ;
RCheck( InspProc(egoEnv,proc,i));
WITH p = proc^^.pData^^ DO BEGIN
IF p.procState <> child THEN ObjReturn(univRes(ObjectState));
SCheck( Propagate(rej)); res.main := ok;
RCheck( grpGate.Lock); æ may speed up å
p.procState:= waiting;
IN æ gate locked å
IF p.noOfChildren = 0 THEN BEGIN
procID:= -1;
exception(res); æ res=okå
END ;
SCheck( proc^^.zombCond.Signal); æif zombies are queued, activate firstå
XCheck( proc^^.waitCond.Wait); æ may speed up å
æ zombie signal recieved å
status:= p.zombieStatus;æ assigned by zombie å
procID:= p.zombieID; æ assigned by zombie å
NoCheck( Dealloc(procOwn,deadZombie^^.egoObj));
p.noOfChildren:= p.noOfChildren - 1;
DO IF res.main = ok THEN res:= getException;
p.procState:= child;
SCheck( grpGate.Open);
ObjReturn(res);
END æWITH på;
END æENTRY WAITå;
æ$Eå
ENTRY PAUSE
æ Called by unix system call 'pause' å
WITH RECORD t:^^;
proc : PprocEnv;
END ;
VAR res : ResultType; i : Long;
BEGIN
æ#ENTRY# PS('PAUSE') &ENTRY&å ;
RCheck( InspProc(egoEnv,proc,i));
WITH p = proc^^.pData^^ DO BEGIN
IF p.procState <> child THEN ObjReturn(univRes(ObjectState));
SCheck( Propagate(rej));
RCheck( grpGate.Lock); æ may speed up å
res:= Call( proc^^.waitCond.Wait); æ waitState = noWait å
æ waitCond will never be signaled, but will be speeded up å
SCheck( grpGate.Open);
ObjReturn(res);
END æWITH på;
END æENTRY PAUSEå;
æ$Eå
ENTRY ALARM æIN secs : Longå
æ Called by unix system call 'alarm' å
WITH RECORD t:^^;
proc : PprocEnv;
END ;
VAR res : ResultType; i : Long;
BEGIN
æ#ENTRY# PS('ALARM') &ENTRY&å ;
IF secs <= 0 THEN secs := 0 æ regret alarm å ELSE BEGIN
res:= Call( unix^^.uniClock.GetClock(; OUT i )); æ i:= NOW å
IF res.main <> ok THEN i:= 1; æ dummy value when no clock is present å
IF Ragnarok - i < secs THEN secs := Ragnarok -1 ELSE secs := secs + i ;
END ;
RCheck( InspProc(egoEnv,proc,i));
WITH p = proc^^.pData^^ DO BEGIN
IF p.procState <> child THEN ObjReturn(univRes(ObjectStatus));
SCheck( Propagate(rej)); res.main:= ok;
RCheck( unix^^.uniGate.lock); æ may speed up å
WITH u = unix^^.uData^^ DO BEGIN
IF secs = 0 THEN BEGIN æ proc should not be in alarmSet å
IF p.alarmTime <> 0 æ proc IS in alarmSet å
THEN p.alarmTime := Ragnarok; æ proc will be removed from set å
END ELSE BEGIN æ proc should belong to the alarmSet å
IF p.alarmTime = 0 THEN BEGIN æ proc is NOT in set å
æ move proc into set å
IF u.noOfAlarms > 0 æ set is not empty å
THEN SCheck( Copy(unix^^.alarmSet,proc^^.alarmSet));
SCheck( Copy(proc,unix^^.alarmSet));
u.noOfAlarms := u.noOfAlarms + 1 ;
END ;
p.alarmTime := secs; æ proc is now ok in set å
IF secs < u.alarmTime THEN BEGIN
æ new proc is the next proc to recieve alarm signal å
u.newTime:= secs;
SCheck( unix^^.alarmCond.Signal); æ notify alarmProc å
END ;
END ;
END æWITH uå;
SCheck( unix^^.uniGate.Open);
ObjReturn(res);
END æWITH på;
END æENTRY ALARMå;
æ$Eå
ENTRY SIGSAG æ IN OUT sigOp : Long ;
IN OUT sigNo : Long ;
IN OUT sigFunc : Long å
æ Called by signal handling parts of the unix system call library
sigOp=1 : getSigState(IN sigNo ; OUT sigFunc);
sigOp=2 : setSigState(IN signo ; IN OUT sigFunc); =signal
sigOp=3 : recieveSig (OUT noOfPending; OUT sigNo; OUT sigFunc);
sigOp=4 : sendSignal (OUT noOfSignaled; IN sigNo; IN procID ); =kill
sigOp=5 : egoSignal (OUT noOfSignaled; IN sigNo; IN dummy );
å
WITH RECORD t:^^;
proc : PprocEnv;
work : PprocEnv;
grp : PgrpEnv ;
END ;
VAR res : ResultType; i : Long; found : boolean;
BEGIN
æ#ENTRY# PSS('SIGSAG',sigOp) &ENTRY&å ;
IF (sigOp>0)AND(sigOp<6)AND(sigNo>0)AND(sigNo<=noOfSignals) THEN æOKå
ELSE ObjReturn(univRes(DataValue));
RCheck(InspProc(egoEnv,proc,i));
WITH p = proc^^.pData^^ DO BEGIN
IF p.procState <> child THEN ObjReturn(univRes(ObjectState));
res.main:= ok;
IF sigOp < 4 THEN BEGIN
SCheck( Propagate(rej));
RCheck(grpGate.Lock); æ may speed up å
IF sigOp = 3 THEN BEGIN æ recieve signal å
sigOp:= 0; æ noOfPending := 0 å
FOR i:= 1 TO noOfSignals DO BEGIN
IF p.sigÆiÅ.sigPend THEN BEGIN
sigOp:= sigOp + 1; æ increase noOfPending å
sigFunc:= p.sigÆiÅ.sigState;
sigNo:= i;
END ;
END æFORå;
IF sigOp <> 0 THEN BEGIN æ signal has been caught å
p.sigÆsigNoÅ.sigPend:= false;
IF ( sigNo <> SIGILL ) AND ( sigNo <> SIGTRAP ) THEN BEGIN
p.sigÆsigNoÅ.sigState := default ;
END ;
END ;
END æ recieve signal å
æ$Eå
ELSE BEGIN æ set/get sigState å
WITH item = p.sigÆsigNoÅ DO BEGIN
i:= item.sigState;
IF sigOp=2 THEN BEGIN æsetSigStateå
IF sigNo <> SIGKILL THEN BEGIN æ kill signal cannot be redefined å
item.sigState:= sigFunc;
item.sigPend:= false; æ normally it will be false already å
END ;
END ;
sigFunc:= i;
END æWITH itemå;
END æ set/get å;
SCheck( grpGate.open);
ObjReturn(res);
END æ sigOp = 1 , 2 or 3 å;
IF sigOp=5 THEN sigFunc:= p.procID; æ kill ego å
IF sigFunc = -1 THEN sigFunc:= -p.procID; æ kill all except ego å
IF sigFunc = p.procID THEN BEGIN æ kill ego, sigOp may be 4 or 5 å
SCheck( Propagate(rej));
RCheck( grpGate.lock); æ may speed up å
sigProc(proc,p,dir,sigNo);
SCheck( grpGate.open);
objReturn(res);
END;
END æWITH på; æ rather peculier nesting of blocks å
æ sigOp = 4 : send signals : kill å
sigOp:= 0; æ noOfSignaled:= 0; å
IF sigFunc = 0 THEN BEGIN æ kill all procs in own group å
found:= sigGrp(egoEnv,work,sigOp,sigNo,sigFunc); æ no speed up å
END ELSE BEGIN æ scan group set å
SCheck( unix^^.uniGate.Lock); æ prevent group dealloc. no speed up å
SCheck( FirstInSet(unix^^.grpSet,grp));
REPEAT æ always at least one group å
found:=sigGrp(grp,work,sigOp,sigNo,sigFunc);
IF NOT found THEN res:= Call( NextInSet(unix^^.grpSet,grp));
UNTIL ( res.main <> ok ) OR found ;
SCheck( unix^^.uniGate.Open);
END æ group scan needed å;
res.main:= ok;
ObjReturn(res); æ sigOp equals noOfSignaled processes å
END æENTRY SIGSAGå;
æ$Eå
ENTRY SETGETID æIN IDID : Long ;
IN OUT ID : IDType å
æ Called by ID handling parts of the system call library
IDID=1 : getPid; IDID=2 : getPPid; IDID=3 : getPGrp
IDID=4 : getUid; IDID=5 : getGid; IDID=6 : getEUid; IDID=7 : getEGid
IDID=8 : setPGrp; IDID=9 : setUid; IDID=10: setGid;
****** at present only getPid is implemented
å
WITH RECORD t:^^;
proc : PprocEnv;
END ;
VAR res : ResultType; i : Long;
BEGIN
æ#ENTRY# PSS('SETGETID',IDID) &ENTRY&å ;
RCheck( InspProc(egoEnv,proc,i));
WITH p = proc^^.pData^^ DO BEGIN
IF p.procState <> child THEN ObjReturn(univRes(ObjectState));
res.main:= ok;
IF IDID <> 1 THEN ID:= 0 ELSE ID := p.procID;
ObjReturn(res);
END æWITH på;
END æENTRY SETGETIDå;
æ$Eå
ENTRY GetUniqueId æ ; OUT uniqueId : fullId å
WITH RECORD t : ^^;
proc : PprocEnv;
END;
VAR
res : resultType;
i : integer;
id : idType;
æ This entry creates a unique pipe id as a text string of the form
'p:<PipeId>' terminated by a null char. The string is 13 chars long
å
BEGIN
æ#ENTRY# PS('GETUNIQUEID ') &ENTRY&å ;
RCheck( InspProc(egoEnv,proc,i));
WITH p = proc^^.pData^^ DO BEGIN
IF p.procState <> child THEN ObjReturn(univRes(ObjectState));
IF 13 > elements(uniqueId) THEN ObjReturn(univRes(DataValue));
res.main:= ok;
XCheck( unix^^.uniGate.Lock ); æmay speed upå
WITH u = unix^^.uData^^ DO
BEGIN
id := u.nxtPipeID;
u.nxtPipeID := u.nxtPipeID + 1;
END; æwith uå
SCheck( unix^^.uniGate.Open );
æconvert id to text stringå
FOR i := 12 DOWNTO 3 DO
BEGIN
uniqueIdÆiÅ := chr( ord('0') + (id MOD 10));
id := id DIV 10;
END;
uniqueIdÆ1Å := 'p';
uniqueIdÆ2Å := ':';
uniqueIdÆ13Å:= chr(0);
ObjReturn(res);
END æWITH på;
END; æENTRY getUniqueIdå
æ$Eå
PRIVATE ATTPROC (IN proc : PprocEnv;
IN termName : text ;
IN loginProg : text )
æ The attention process forks to the login program when the control
terminal becomes ready. The attention process sends 'interrupt' and
'hangUp' signals to processes in the group. The attention process
will fork to the login program once more in case it discovers
that all the processes of the group has terminated
å
WITH RECORD t:^^;
files : PfileEnv;
sssProc : PprocEnv;
work : PprocEnv;
END ;
VAR res : ResultType; i : Long; sig : Long; LProcID : IDType;
restart, remove, reload, ready : Boolean;
BNL : ARRAY Æ1..3Å OF char; æ BIG New Line å
BEGIN
æ#ENTRY# PS('ATTPROC') &ENTRY&å ;
BNLÆ1Å:= chr(13);
BNLÆ2Å:= chr(10);
BNLÆ3Å:= chr(13);
SCheck( Copy(proc^^.files,files));
WITH p = proc^^.pData^^ DO BEGIN
æ at entry the loginProg has already been loaded å
reload:= false;
REPEAT æ login progcess is not running å
REPEAT æ control terminal is not ready å
ready:= false;
IN æ terminal may stil not be ready OUT is required by windowfs å
XCheck(files^^Æ2Å.WriteSeq(VAR IN OUT BNL; OUT i, IN uxio));
XCheck(files^^Æ2Å.WriteSeq(VAR IN OUT termName; OUT i, IN uxio));
XCheck(files^^Æ2Å.WriteSeq(VAR IN OUT BNL; OUT i, IN uxio));
XCheck(files^^Æ2Å.WriteSeq(VAR IN OUT loginProg; OUT i, IN uxio));
XCheck(files^^Æ2Å.WriteSeq(VAR IN OUT BNL; OUT i, IN uxio));
ready := true;
DO BEGIN
æ if the calls below returns "not ok" immediatly
because ClSh or files^^Æ2Å is in error, the attProc
will loop endlessly and waste CPU time å
NoCheck( ClSh.waitSignal(; OUT i)); æ calls waitBreak å
NoCheck( files^^Æ2Å.WaitReady);
END ;
UNTIL ready;
IF reload THEN NoCheck( dir.Load(; IN FIX(p.callLoad), IN loginProg));
reload:= true;
res:= Call( egoObj.forkBegin(void,void));
IF res.Main <> ok THEN restart:= true ELSE BEGIN
restart:= false;
LProcID:= (res.orgSys * shift16) + res.orgNo;
END ;
WHILE NOT restart DO BEGIN
æ take care of signals generated by the control terminal å
res:= Call( ClSh.waitSignal(; OUT i)); æ calls waitBreak å
IF res.main = ok
THEN sig := SIGINT
ELSE sig := SIGHUP ;
SCheck( grpGate.Lock);
res:= Call( FirstInSet(procSet,sssProc));
restart:= true;
WHILE res.main = ok DO BEGIN
WITH sp = sssProc^^.pData^^ DO BEGIN
IF sp.procState = dead THEN remove:= true ELSE BEGIN
sigProc(sssProc,sp,dir,sig);
remove:= false;
restart:= false; æ because processes are still executing å
END ;
END æWITH spå;
IF remove THEN SCheck( Copy(sssProc,work));
res:= Call( NextInSet(procSet,sssProc));
IF remove THEN NoCheck( Dealloc(procOwn,work^^.egoObj));
END æWHILEå;
SCheck( grpGate.Open);
NoCheck( files^^Æ2Å.WaitReady); æ remove break status å
END æWHILEå;
UNTIL false;
END æWITH på;
END æPRIVATE ATTPROCå;
æ$Eå
PRIVATE STARTGRP æIN ShareMaster : refShClFS;
IN termName : text ;
IN loginProg : text å
æ Create attention process , ClSh and dir å
WITH RECORD t:^^;
files : PfileEnv;
proc : PprocEnv;
NilDad: PprocEnv;
END ;
VAR res : ResultType; i : Long; divPD : divPDType;
BEGIN
æ#ENTRY# PS('STARTGRP') &ENTRY&å ;
RCheck( newUproc(true,NilDad,proc,procOwn,divPD)); æ create attProc å
æ proc stays in tmpManSet as the first member å
WITH p = proc^^.pData^^ DO BEGIN
p.procID:= 1; æ children of this proc has "no parent" å
p.parentID:= divPD.procID; æ could serve as group identifier å
p.progCount:= 0;
p.callLoad:= WName('L',divPD.procID,p.progCount);
p.noOfChildren:= 0; æ counts #times loginProcess has been created å
p.procState:= child;
p.childState:= child; æ special value in attProc å
p.alarmTime:= 0; æ not used å
p.termStatus:= 0; æ not used å
p.extSize:= divPD.extSize; æ used by forkbegin å
FOR i:= 1 TO noOfSignals DO BEGIN
p.sigÆiÅ.sigState:= default; æ copied to login process å
p.sigÆiÅ.sigPend:= false;
END æFORå;
æ***SCheck( Copy(unix^^.dir,dir)); used in tests without subdir ***å
RCheck( unix^^.dir.NewSubDir(OUT dir; IN FIX(WName('S',divPD.procID,0))));
RCheck( ShareMaster.createGroup(OUT ClSh, IN dir; IN termName));
RCheck( dir.InsertPointer(IN ClSh; IN '$'));
RCheck( dir.Load(; IN FIX(p.callLoad), IN loginProg));
SCheck( Copy(proc^^.files,files));
FOR i:= 1 TO 3
DO RCheck( ClSh.Assign(OUT files^^ÆiÅ; IN '$//dev/tty', IN readwrite));
SCheck( MakeReentrant(void));
RCheck( DeclProc(procOwn,attProc,tmpManSet;termName,loginProg));
res.main:= ok;
ObjReturn(res);
END æWITHå;
END æPRIVATE GRPINITå;
æ$Eå
OTHERWISE GRPother
WITH RECORD t:^^;
END;
BEGIN
æ#ENTRY# PS('GRPother') &ENTRY&å ;
ObjReturn(univRes(EntryIllegal));
END ;
END æ PROGRAM UNIPSGRPå ;
PROGRAM UNIPSimpl OBJECT UNIPS WITH uniEnv ; æ*****************å
æ*********************************************************************å
PROCEDURE ABORTGRP (VAR tempGrp : PgrpEnv ; æ temp pointer å
VAR work : PprocEnv);
æ UniGate must be locked by caller, and propMode must be set to stop å
VAR res : ResultType; i : Long; b : Boolean;
BEGIN
SCheck( MoveMan(tempGrp,tempGrp)); æ remove group from group set å
b:= sigGrp(tempGrp,work,i,SIGKILL,0); æ kill all procs in group å
SCheck( Abort(tempGrp)); æ speeds up and terminates attProcess å
res:= Call( FirstInSet(tempGrp^^.procSet,work));
WHILE res.main = ok DO BEGIN
WITH p = work^^.pData^^ DO p.alarmTime:= Ragnarok; æ remove proc å
res:= Call( NextInSet(tempGrp^^.procSet,work));
END æWHILEå;
SCheck( alarmCond.Signal); æ activate alarm proc å
SCheck( unigate.Open); æ wait until all å
SCheck( unigate.Lock); æ procs are removed å
END æabortGrpå ;
æ$Eå
PRIVATE ALARMPROC
æ The alarm process generates alarm signals.
At present the alarm process is NOT used as ADAM.
At present the alarmSet is NOT sorted ! (performancer)
å
WITH RECORD t:^^;
proc : PprocEnv;
prvProc : PprocEnv;
group : PgrpEnv;
END ;
VAR res : ResultType; NOW : Long; qix : Integer ; remove : Boolean;
TimePar : RECORD zero : Long; usec : Long; END ;
BEGIN
æ#ENTRY# PS('ALARMPROC ') &ENTRY&å ;
NoCheck( dir.getRef(OUT uniClock; IN 'clock'));
æ when no clock is present, alarms are not generated correctly å
SCheck( uniGate.Lock);
WITH u = uData^^ DO BEGIN
u.noOfAlarms:= 0; æ no of procs in alarmSet å
TimePar.zero:= 0; æ never changed å
TimePar.usec:= 0; æ no time Out at all å
u.alarmTime := Ragnarok; æ next time alarmSet is searched å
u.newTime:= 0; æ assigned by ENTRY ALARM å
res:= Call( dir.speedUpObj(; ' ')); æ check call stack å
IF (res.main = -ProcessSpace) AND (res.family=0) THEN u.newTime:= 1;
SCheck( alarmCond.Signal); æ activate init process å
SCheck( uniGate.Open);
IF u.newTime <> 0 THEN ObjReturn(res);
æ main loop of alarmProc å
SCheck( uniGate.Lock); æ alarmProc stays in the monitor å
REPEAT
NoCheck( alarmCond.Wait(; TimePar));
res:= Call( uniClock.GetClock(; OUT NOW));
IF res.main <> ok THEN NOW:= Ragnarok -1; æ dummy value å
æ NOTE: if uniClock.SetClock is called the alarm signals may not
be generated as expected by the requesting programså
IF u.newTime >= NOW THEN æ small timeOut has been inserted å
u.alarmTime:= u.newTime
ELSE BEGIN
æ scan alarmSet, generate signals, compute next alarmTime å
u.alarmTime:= Ragnarok;
qix:= 1;
WHILE qix <= u.noOfAlarms DO BEGIN
IF qix = 1 THEN BEGIN
SCheck( Copy(alarmSet,proc)); æ next:= first å
END ELSE BEGIN
SCheck( Copy(proc,prvProc));
SCheck( Copy(proc^^.alarmSet,proc)); æ next := next å
END ;
WITH p = proc^^.pData^^ DO BEGIN
IF p.alarmTime = Ragnarok THEN æcancelå remove:= true ELSE
IF p.alarmTime <= NOW THEN BEGIN æ proc has timed out å
SCheck( Copy(proc^^.ProcGrp,group));
SCheck( group^^.grpGate.Lock); æ no speed up å
sigProc(proc,p,group^^.dir,SIGALRM);
SCheck( group^^.grpGate.Open);
remove:= true;
END ELSE
æ compute next alarmtime å
IF p.alarmTime < u.alarmTime THEN BEGIN
u.alarmTime:= p.alarmTime;
remove:= false;
END ;
IF remove THEN BEGIN
p.alarmTime := 0;
u.noOfAlarms:= u.noOfAlarms - 1;
IF qix = 1 THEN BEGIN æ remove first in queue å
SCheck( Copy(proc^^.alarmSet,alarmSet));
END ELSE BEGIN
SCheck( Copy(proc^^.alarmSet,proc));
SCheck( Copy(proc,prvProc^^.alarmSet));
END ;
END ELSE qix:=qix + 1 ;
END æWITH på;
END æWHILEå;
END æ scan å;
u.newTime:= 0;
IF u.alarmTime = Ragnarok THEN BEGIN
TimePar.usec:= 0; æno time outå
END ELSE BEGIN
NOW := u.alarmTime - NOW ; æ #seconds to next time out å
IF NOW > maxSeconds
THEN TimePar.usec:= maxSeconds
ELSE TimePar.usec:= NOW * 1000000 ;
END ;
UNTIL false;
END æWITH uå;
END æPRIVATE ALARMPROCå;
æ$Eå
ENTRY INIT æIN maxStack : sizeType ;
IN procSize : sizeType ;
IN extSixe : sizeType å
æ Called once to initialize UNIPS å
æprocSize < max ==> procs may execute in groupå
æextSize-applicCtxSize < max ==> applications may call groupå
WITH RECORD t:^^;
kpt : ^^;
END ;
VAR res : ResultType; alarmSize : sizeType;
BEGIN
æ#ENTRY# PS('INIT') &ENTRY&å ;
res:= Call( FirstInSet(uniGate,kpt));
IF res.main = ok THEN ObjReturn(univRes(EntryIllegal));
æ Initialize has not been succesfully called å
WITH u = uData^^ DO BEGIN
u.nxtProcID := 2;
u.nxtPipeID := 0;
u.maxStack:= maxStack; æ used when groups are created å
u.procSize:= procSize; æ can call gate/cond/alloc å
u.extSize := extSize ; æ >> maxStack å
SCheck( ClearSize(u.fenvSize));
SCheck( AddEnv(u.fenvSize,noOfFiles));
SCheck( Propagate(rej));
IN æ init may fail å
XCheck( sched.NewGate(OUT uniGate));
XCheck( uniGate.NewCond(OUT alarmCond));
alarmSize:= u.procSize;
SCheck( AddSize(alarmSize,u.procSize)); æ probably ok ? å
XCheck( sched.NewProc(OUT grpOwn; IN alarmSize));
XCheck( uniGate.Lock);
XCheck( DeclProc(grpOwn,alarmProc));
SCheck( Propagate(stop));
SCheck( alarmCond.Wait) ; æ wait for alarmProc to initialize å
IF u.newTime <> 0 THEN exception(univRes(DataValue));
SCheck( uniGate.Open);
SCheck( makeReentrant(void));
res.main:= ok;
DO BEGIN
res:= getException;
NoCheck( Dealloc(uniGate,uniGate));
NoCheck( Dealloc(alarmCond,alarmCond));
NoCheck( Dealloc(grpOwn,grpOwn));
END ;
END æWITH uå;
END æINITå;
æ$Eå
ENTRY INCLUDE æOUT group : PgrpObj ;
IN ShareMaster : refShClFS;
IN termName : text ;
IN loginProg : text å
WITH RECORD t:^^;
tempOwn : ^^;
tempGrp : PgrpEnv;
work : PprocEnv; æ also used as manSet etc. å
END ;
VAR res : ResultType; i : Long; objSize, callStack : sizeType;
BEGIN
æ#ENTRY# PS('INCLUDE') &ENTRY&å ;
WITH u = uData^^ DO BEGIN
RCheck( FirstInSet(uniGate,work)); æ check init ok å
SCheck( Propagate(rej));
SCheck( ClearSize(objSize));
SCheck( AddGen(objSize,refs(grpEnv)));
RCheck( alloc.NewObj(OUT tempOwn; IN objSize, OUT i));
IF u.maxStack = makeSize(-1,-1) THEN callStack:=makeSize(0,0)
ELSE callStack:=u.maxStack;
RCheck( DeclGen(tempOwn,work,tempGrp,refs(grpEnv),
0,makeSize(0,0),u.maxStack,refs(unipsGrp),
bytes(unipsGrp),0,addr(unipsGrp),callStack,true));
SCheck( Copy(tempGrp,tempGrp^^.egoEnv));
SCheck( Copy(tempOwn,tempGrp^^.egoObj));
SCheck( Copy(code,tempGrp^^.code));
SCheck( Copy(egoEnv,tempGrp^^.unix));
RCheck( Copy(tempOwn,group)); æ assign return pointer å
RCheck( sched.NewGate(OUT tempGrp^^.grpGate));
SCheck( MoveMan(tempGrp,grpSet)); æ group becomes visible, work:=NIL å
IN æ group is visible å
XCheck( tempGrp.startGrp(shareMaster; termName, loginProg));
ægroup is readyå
XCheck( MoveOwn(tempOwn,grpOwn));
res.main:= ok;
DO BEGIN æ abort group å
res:= getException;
SCheck( Propagate(stop));
SCheck( uniGate.Lock);
abortGrp(tempGrp,work);
SCheck( uniGate.Open);
END ;
ObjReturn(res);
END æWITH uå;
END æENTRY INCLUDEå;
æ$Eå
ENTRY EXCLUDE æIN group : PgrpObjå
WITH RECORD t:^^;
tempOwn : ^^;
tempGrp : PgrpEnv;
work : PprocEnv;
END ;
VAR res : ResultType; i : Long;
BEGIN
æ#ENTRY# PS('EXCLUDE') &ENTRY&å ;
SCheck( uniGate.Lock);
IN æ gate locked å
XCheck( InspObj(egoEnv,tempGrp,group,i)); æ old param sequence !!!!å
XCheck( MoveOwn(group,tempOwn));
æ group can be deallocated by calling process å
abortGrp(tempGrp,work);
res.main := ok;
DO res:= getException;
SCheck( uniGate.Open);
ObjReturn(res); æ group will be deallocated if temp Owned å
END æENTRY EXCLUDEå;
OTHERWISE UNIPSother
WITH RECORD t:^^;
END;
BEGIN
æ#ENTRY# PS('UNIPSother') &ENTRY&å ;
ObjReturn( univRes(EntryIllegal));
END ;
END æprogram UNIPSimplå;
INITIALIZE
UNIPSimpl 'UNIPS' :
dir 'objDir', alloc 'allocate', sched 'scheduler',
egoEnv '**' , uData
END.
«eof»