|
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: 13568 (0x3500)
Types: TextFile
Names: »UNIJCST.SA«
└─⟦909f4eb2b⟧ Bits:30009789/_.ft.Ibm2.50006622.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »UNIJCST.SA«
└─⟦e12db5ad4⟧ Bits:30009789/_.ft.Ibm2.50007357.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »UNIJCST.SA«
æ
U N I p s T E S T
å
OBJECT PROGRAM unixFsTest;
æ$H=0 : no heap space å
æ$L-å
æ$F=FAMILY.UNIV.IDå
æ$F=FAMILY.KNEL.IDå
PROCEDURE printText (text : fullId); FORWARD;
PROCEDURE printVar (text : fullId; UNIV val : blockPtr); FORWARD;
æ$F=FAMILY.ALLOC.IDå
æ$F=FAMILY.SCHED.IDå
æ$F=FAMILY.OBJDIR.IDå
æ SYS:3005..uappltst.IDå
æ$F=PRIVATE.UAPPLI.IDå
æ 2611..unixiofm å
æ$F=FAMILY.IOSYS.IDå
æ$F=PASINCLU.TERMTOOL.SAå
æ$F=FAMILY.CLOCK.IDå
æ$F=PRIVATE.SHCLFS.IDå
æ$F=PRIVATE.UNIJCS.IDå
æ$L+å
CONST
space = ' ';
FUNCTION makeRes (m,f,a,c : integer) : resultType;
VAR r : resultType;
BEGIN
r.main := m;
r.family := f;
r.argNo := a;
r.auxCause := c;
r.orgNo := 17;
r.orgSys := 34;
makeRes := r;
END; æmakeReså
PROCEDURE xCheck (res : resultType);
BEGIN
if res.main <> ok then printVar ('*** uxFsTest check *** res = ', res);
IF res.main <> ok THEN Exception (res);
END;
PROCEDURE try (res : resultType);
BEGIN
if res.main <> ok then
printVar ('*** uxFsTest try *** res = ', res);
END;
æ$Eå
FUNCTION getInt (line : shortId;
VAR pos : integer
) : integer;
VAR
c, i, k, n : integer;
digit : boolean;
æ Reads an integer from 'line' from character position 'pos' å
BEGIN
k := getLength (line);
n := 0;
i := pos-1;
digit := false;
æ skip leading non-digits å
REPEAT
i := i+1;
IF i <= k THEN c := ORD (lineÆiÅ) ELSE c := 0;
digit := (c >= 48) AND (c <= 57);
UNTIL digit OR (i > k);
æ read until next non-digit å
WHILE digit AND (i <= k) DO
BEGIN
n := n*10 + c - 48;
i := i+1;
IF i <= k THEN
BEGIN
c := ORD (lineÆiÅ);
digit := (c >= 48) AND (c <= 57);
END;
END;
pos := i;
getInt := n;
END; ægetIntå
PROCEDURE getText (line, text : shortId;
fillChar : char;
VAR pos : integer);
VAR
i, j, k, t : integer;
c : char;
æ Reads into 'text' a txt string surrounded by '...' from 'line', from
character position 'pos'. Any unused chars in 'text' are filled with
NUL-chars å
BEGIN
k := getLength (line);
t := elements (text);
i := pos-1;
j := 0;
æ skip until first ' å
REPEAT
i := i+1;
IF i <= k THEN c := lineÆiÅ ELSE c := '''';
UNTIL c = '''';
æ reaed until next ' å
REPEAT
i := i+1;
IF i <= k THEN c := lineÆiÅ ELSE c := '''';
IF (c <> '''') AND (j < t) THEN
BEGIN
j := j+1;
textÆjÅ := c;
END;
UNTIL c = '''';
æ fill rest of text with fill-char å
FOR j := j+1 TO t DO
textÆjÅ := fillChar;
pos := i;
END; ægetTextå
æ$Eå
æ Local pointers å
TYPE
uxTestLocals = RECORD
code : ^^;
stubRef : ^^ObjDir;
fao1,
fao2,
fao3 : faoRefType;
stdIn,
stdOut,
stdError : faoRefType;
fs : ioSysRefType;
W1 : ^^;
W2 : ^^;
W3 : ^^;
SCM : ^^SHCLFS;
uxUps : ^^unips;
UPSGRP : ^^;
clk : ^^clock;
END;
æ$Eå
PROGRAM iUnixFsTest OBJECT UnixUtil WITH uxTestLocals;
ENTRY pascalerror æfE,jS,pIdå with record t:^^; end;
var res:resulttype; begin res.main:=EntryIllegal; objReturn(res); end;
OTHERWISE runFork
(* fileEnv, jobSys æ, OUT execArgså; progId Æ, textÅ *)
WITH RECORD
tt : ^^;
fileEnv : refFileEnv;
UPS : ^^groupObj;
argPt : bufRef;
END;
VAR
line, iLine : array Æ1..100Å of char;
buf : array Æ1..1000Å of byte;
smallBuf : array Æ1..298Å of byte;
i, j, pos, testNo : integer;
res : resultType;
fmlRef : refPtr;
WAITSTEPS,WAITCOUNT:INTEGER;
PROCEDURE printLine (txt : shortId);
BEGIN
clearText (line);
putText (line, txt);
putNl (line);
xCheck ( termIo (stdOut, WriteSeq, line));
END; æprintLineå
PROCEDURE printInt(txt : shortid; i : integer);
begin
clearText(line);
putText(line,txt);
putInt(line,i,16);
putNL(line);
try (termIO(stdOut, WriteSeq, line));
end ;
PROCEDURE printError (txt : shortid);
VAR
saveRes : resultType;
BEGIN
saveRes := getException;
æ#B printText (txt) E#å;
printLine (txt);
putError (line, saveRes, '',0);
try (termIo (stdOut, WriteSeq, line));
END; æprintErrorå
PROCEDURE readInt (txt : shortId;
VAR val : integer);
BEGIN
printLine (txt);
xCheck ( termIo (stdIn, ReadSeq, iLine));
pos := 3;
val := getInt (iLine, pos);
END; æreadIntå
PROCEDURE readText (txt, val : shortId;
fillChar : char );
BEGIN
printLine (txt);
xCheck ( termIo (stdIn, ReadSeq, iLine));
pos := 3;
getText (iLine, val, fillChar, pos);
END; æreadTextå
æ$Eå
PROCEDURE printMenu;
BEGIN
printLine (' 0 : printMenu ');
printLine ('901 : GET REFS to CLOCK, SCFS, UNIPS ');
printLine ('902 : INIT CALL TO SCFS ');
printLine (' ');
printLine ('801 : clock.setClock ');
printLine ('802 : clock.getClock ');
printLine (' ');
printLine (' 1 : INIT CALL TO UNIPS ');
printLine (' 2 : INCLUDE CALL TO UNIPS with params ');
printLine (' 3 : EXCLUDE CALL TO UNIPS ');
printLine (' 4 : INIT UNIJCS WITH STANDARD PARAMETERS ');
printLine (' 5 : 901+4+2 = STANDARD INIT + INCLUDE ');
printLine (' ');
printLine (' 11 : PREPEXEC ');
printLine (' 22 : FORKBEGIN ');
printLine (' 33 : FORKEND ');
printLine (' 44 : WAIT ');
printLine (' 55 : PAUSE ');
printLine (' 66 : ALARM ');
printLine (' 77 : SIGSAG ');
printLine (' 88 : SETGETID ');
printLine (' ');
printLine ('400 : SET WAIT LOOP ');
printLine (' ');
printLine ('999 : stop');
END; æprintMenuå
æ$Eå
PROCEDURE SETWAIT;
BEGIN
READINT('TYPE #SECS : 0-999 : ',WAITSTEPS);
WAITSTEPS:=WAITSTEPS * 1000000 ;
END;
function lastchar(s:fullid) : integer;
var i, last, length : integer;
begin
i:=0; length:=elements(s); last:=length;
while (i <= length) and (last = length) do begin
i:= i+1;
if ord(sÆiÅ) <= 32 then last:=i-1;
end ;
lastchar:=last;
end ;
PROCEDURE ENSrefs;
VAR R:RESULTTYPE; used,kind : integer;
BEGIN
XCHECK(STUBREF.GETREF(OUT CLK;IN 'clock', OUT used, OUT kind));
XCHECK(STUBREF.GETREF(OUT uxUps; IN 'unips', OUT used, OUT kind));
XCHECK(STUBREF.GETREF(OUT SCM; IN 'scfs', OUT used, OUT kind));
R:=STUBREF.GETREF(OUT fs; IN '$', OUT used, OUT kind);
END;
PROCEDURE SETklokken;
var ss : integer;
BEGIN
readInt('type baseTime as #secs : ',ss);
XCHECK(CLK.SETClock(; ss ));
END ;
procedure getklokken;
var ss : integer;
begin
xcheck(clk.getClock(; out ss));
printInt('time is : ',ss);
end ;
PROCEDURE INITUNIPS;
VAR R:RESULTTYPE; MAX,PROC,EXT:SIZETYPE;
user, kernel: integer;
BEGIN
readint('max.user? ',user);
readint('max.kernel (0 means void)? ',kernel);
if kernel = 0 then
max:=MakeSize(-1,-1)
else
MAX:= MAKESIZE(user,kernel);
readint('proc.user? ',user);
readint('proc.kernel? ',kernel);
PROC:= MAKESIZE(user,kernel);
readint('ext.user? ',user);
readint('ext.kernel? ',kernel);
EXT:= MAKESIZE(user,kernel);
IN
XCHECK(uxUps.INIT(;MAX,PROC,EXT));
DO
PRINTERROR('INITUNIPS ERR ');
END;
procedure STDINITUNIPS;
VAR R:RESULTTYPE; MAX,PROC,EXT : SIZETYPE;
BEGIN
max:=makesize(-1,-1);
proc:=makesize(2000,1000);
ext:=makesize(20000,5000);
R:=uxUps.INIT(;MAX,PROC,EXT);
END;
PROCEDURE INITSC;
BEGIN IN XCHECK(SCM.INITSCFS); DO PRINTERROR('INITSC ERR '); END;
PROCEDURE tINCLUDE(READNAMES:BOOLEAN);
VAR TERMNAME, LOGINPROG: ARRAY Æ1..50Å OF CHAR;
BEGIN
IF READNAMES THEN BEGIN
READTEXT('TYPE ''TERMNAME'' = ',TERMNAME,CHR(0));
æ#B printvar('termname',TERMNAME) E#å ;
READTEXT('TYPE ''LOGINPROG'' = ',LOGINPROG,CHR(0));
æ#B PRINTVAR('LOGINPROG',LOGINPROG) E#å ;
END ;
IN
IF NOT READNAMES THEN
XCHECK( uxUps.INCLUDE(OUT UPSGRP, IN SCM;
'versafs/eosc:0..w2.eo','versafs/eosc:0..ed.eo'));
IF READNAMES THEN
XCHECK( uxUps.INCLUDE(OUT UPSGRP, IN SCM;
IN TERMNAMEÆ1..lastchar(TERMNAME)Å,
IN LOGINPROGÆ1..lastchar(LOGINPROG)Å));
DO
PRINTERROR('INCLUDE ERROR ');
END;
procedure tEXCLUDE;
var res : resulttype;
begin
in
if res.main=ok then printtext('exclude ok ') else
exception(res);
do
printerror(' exclude not called ');
end ;
procedure tPREPEXEC;
const valMax=400;
var res : resultType;
prog: array Æ1..50Å of char;
i,v,top: integer;
values : array Æ0..399Å of char;
val : array Æ1..40Å of char;
begin
in
readtext('type ''program FILE name'' = ',prog,chr(0));
top:=valMax;
repeat
readtext('(name+args)!env!secret&: ''text'' or ''!'' or ''&'' ',val,chr(0));
if valÆ1Å='&' then begin
v:=valMax-top;
end else begin
if valÆ1Å='!' then v:=0 æ empty value å
else v:=lastchar(val);
valuesÆtop-1Å:=chr(v); æset up length fieldå
valuesÆtop-2Å:=chr(0); æset up length fieldå
v:=(v+1) div 2 * 2; æround up vå
top:=top-v-2;
for i:=1 to v do valuesÆtop+i-1Å:=valÆiÅ;
end ;
until valÆ1Å = '&' ;
fmlRef:= formal(3);
res:= ups.prepexec(OUT fmlRef^;
in progÆ1..lastchar(prog)Å,
in v );
xcheck(copy(fmlRef^,argpt));
if res.main = ok then
with ea=argpt^^ do begin
for i:= 1 to v do eaÆiÅ:=ord(valuesÆtop+i-1Å);
printvar('valueDataSeg = ',eaÆ1..vÅ);
printLine('type 999 to exit and exec ');
end
else
exception(res);
do
printerror('prepexec error = ');
end ;
procedure tFORKBEGIN;
var res : resultType;
begin
in
res:= ups.forkbegin(w3,w3); æ w3 will not cause problems å
if res.main=ok then printInt('ChildId = ',res.orgNo) else
exception(res);
æ childID is in result å
do
printerror(' forkbegin error = ');
end ;
procedure tFORKEND;
var res : resultType;
begin
in
res:= ups.forkend;
if res.main=ok then printLine('forkEnd ok ') else
exception(res);
do
printerror(' forkend error = ');
end ;
procedure tWAIT;
var res : resultType;
pid : long;
status : long;
begin
in
res:= ups.waitexit(;OUT pid,OUT status);
if res.main=ok then begin
printInt('pid = ',pid);
printInt('status= ',status);
end else
exception(res);
do begin
printerror(' wait error = ');
end;
end ;
procedure tPAUSE;
var res : resultType;
begin
in
res:= ups.pause;
if res.main=ok then printLine(' pause ended OK ') else
exception(res);
do
printerror('pause error = ');
end ;
procedure tALARM;
var res : resultType;
secs: integer;
begin
in
readInt('type #secs = ',secs);
res:= ups.alarm(;secs);
if res.main=ok then printInt('alarm requested within : ',secs) else
exception(res);
do
printerror('alarm error = ');
end ;
procedure tSIGSAG;
var res : resulttype;
sigOp,sigNo,sigFunc : long;
begin
in
readInt('type sigOp : ',sigOp);
readInt('type sigNo : ',sigNo);
readInt('type sigFunc : ',sigFunc);
if sigFunc=1 then sigFunc:= -1;
res:= ups.sigsag(;in out sigOp, in out sigNo, in out sigFunc);
if res.main=ok then begin
printInt(' sigOp = ',sigOp);
printInt(' sigNo = ',sigNo);
printInt(' sigFunc = ',sigFunc);
end else
exception(res);
do
printerror(' sigsag error = ');
end ;
procedure tSETGETID;
var res : resulttype;
idid : integer;
begin
in
readInt('type idid = ',idid);
res:=ups.setgetid(;in idid, out idid);
if res.main=ok then printInt('id = ',idid) else
exception(res);
do
printerror('setgetid error ');
end ;
æ$Eå
BEGIN
fmlRef:= formal(1);
xcheck(copy(fmlRef^,fileEnv));
fmlRef:= formal(2);
xcheck(copy(fmlRef^,UPS));
xCheck ( Copy (fileEnv^^Æ1Å, stdIn ));
xCheck ( Copy (fileEnv^^Æ2Å, stdOut ));
xCheck ( Copy (fileEnv^^Æ3Å, stdError ));
printLine ('***** start unips menu program *****');
WAITSTEPS:=0;
REPEAT
IN
readInt ('type testno/function (0=help, 999=stop)', testno);
æ#B printVar ('start testNo = ', testNo) E#å ;
FOR WAITCOUNT:=1 TO WAITSTEPS DO WAITSTEPS:=WAITSTEPS;
CASE testNo OF
0 : printMenu;
901 : ENSrefs ; æ getRefå
902 : INITSC;
801 : setklokken;
802 : getklokken;
1 : INITUNIPS;
2 : tINCLUDE(TRUE);
3 : tEXCLUDE;
4 : STDINITUNIPS;
5 : begin ENSrefs; STDINITUNIPS; tINCLUDE(TRUE); end;
11 : tPREPEXEC;
22 : tFORKBEGIN;
33 : tFORKEND;
44 : tWAIT;
55 : tPAUSE;
66 : tALARM;
77 : tSIGSAG;
88 : tSETGETID;
400 : SETWAIT;
999 : æ#B printText ('***** stop test UnixFs ***** ') E#å ;
OTHERWISE printLine ('unknown testNo');
END; æcaseå
DO
BEGIN
res := GetException;
printVar ('exception = ', res);
END;
æ#B printVar ('end testNo = ', testno) E#å ;
UNTIL testNo = 999;
END; æOTHERWISEå
END; æunixTestå
INITIALIZE iUnixFsTest 'unixtest':
stubRef 'objdir'
END.
«eof»