|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 36096 (0x8d00)
Types: TextFile
Names: »discstat4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »discstat4tx «
discstat version: 1 pej date: 1978.02.09
discstat version: 2 dirty corrections : dh date: 1979.03.14
discstat version: 8, latest corrections : fgs date: 1984.10.10
discstat version: 9, latest corrections : fb date: 1984.10.10
discstat version:10, latest corrections : fgs date: 1989.01.19
begin
<* fgs 1988.10.01 discstat page ...1 ...*>
<*
discstat
--------
the program extracts statistical information from a disc process,
or from a memory dumparea with addr 0 equivalent to area addr 0,
and it prints the information on current output.
example
-------
the following command extracts statistics about the disc to which
the process named 'disc2' is connected:
discstat disc.disc2
call
----
* *
(outfile) = discstat ( (clear.<yes/no>) (dump.<dumpfile>) (<disc>) )
1 1
<disc> ::= disc.<discname>/
addr.<discaddr>/
devno.<devno> /
<discname> ::= name of disc process
<discaddr> ::= address of disc process
<devno> ::= device number of disc process
<dumpfile> ::= name of system dump file
<yesno> ::= yes / no, default : no
--------
the program sends a message to the autoload disc belonging to the same
physical disc as the specified one to collect the statistics.
the disc process may be either a logical or
a physical disc process - in either case the statistics concerns
the information created by a physical disc process. please note that
the disc process will reset its statistics when the information has
been collected.
*>
\f
<* fgs 1988.10.01 discstat page ...2 ...*>
<*
if the first parameter is dump, the program takes input from the
area at such a position that the specified disc process is read. then it
is checked that the first word has the contents = 62, i.e. kind disc.
if the contents of word 10 <> 0 then this address is used for disc process addr,
and positioning takes place again, checking that the first word is 62
etc., until a main disc process is found. now the zone is positioned and the
remaining data taken so that it is simulated that it was an answer to
a statistics message.
error messages
--------------
param
param error in call.
buffer claim exceeded or break 6
no message buffer available.
monitor result <result>
a normal answer was not received from the disc process. <result>
is the result delivered in the answer to the message.
create <result>
not possible to create a peripheral process for a
reason given by <result>.
disc specified not disc
the disc process address in the dumparea is not a main disc and
does not lead to a main disc
status error <status>
<status> is the (decimal) statusword received from
the disc driver.
giveup <integer> algolcheck
called from .... ....
.... ....
*device status <dumpareaname>
.... ....
only relevant if the first parameter is dump.
the message after device status will give the cause. please
remember that does not exist may mean: too few areaprocesses.
*>
\f
<* fgs 1988.10.01 discstat page ...3 ...*>
long procedure long_bytes (z, bytes);
value bytes ;
integer bytes ;
zone z ;
begin
integer c1,c2,c3,c4,c5,c6;
integer array byte_table (0:255);
for c1:= 0 step 1 until 255 do byte_table(c1):= 6 shift 12 + c1;
c1:= c2:= c3:= c4:= c5:= c6:= 0;
intable (byte_table);
goto case bytes of (l1,l2,l3,l4,l5,l6) ;
l6: readchar (z, c1);
l5: readchar (z, c2);
l4: readchar (z, c3);
l3: readchar (z, c4);
l2: readchar (z, c5);
l1: readchar (z, c6);
intable(0);
long_bytes:= extend 0 add c2 shift 8
add c1 shift 8
add c4 shift 8
add c3 shift 8
add c6 shift 8
add c5;
end long_bytes;
\f
<* fgs 1988.10.01 discstat page ...4 ...*>
procedure print_ida_statistics (rz, control_module, slave_unit, phys_disc);
value control_module, slave_unit, phys_disc ;
integer control_module, slave_unit, phys_disc ;
zone rz ;
begin
integer i, pos, count, cylinder, head, sector;
write (out, <:control unit::>,<<ddd>,control_module,
<: - slave unit::>,slave_unit, <<ddddd>,
<: - device number of physical disc::>,phys_disc, "nl",1);
for i:= 1 step 1 until if slave_unit = 0 then 35 else 21 do
begin
outchar (out, 10);
pos:= write (out, case i of (
<: detailed stastistics for slave device:>,
<: no of seeks:>,
<: seek error:>,
<: unable to read header:>,
<: unable to read data:>,
<: write protected media violation:>,
<: no device response:>,
<: data correction applied:>,
<: seek retry applied:>,
<: data retry applied:>,
<: no head select fault:>,
<: write fault:>,
<: (r+w) x off cylinder fault:>,
<: (r*w) fault:>,
<: voltage fault:>,
<: head select fault:>,
<: software write protect fault:>,
<: 1. defective sector address (count,c,h,s):>,
<: 2. defective sector address (count,c,h,s):>,
<: 3. defective sector address (count,c,h,s):>,
<: 4. defective sector address (count,c,h,s):>,
<: detailed statistics for control module:>,
<: command block overwrite:>,
<: illegal command byte:>,
<: illegal secondary seek address:>,
<: illegal primary seek address:>,
<: illegal command parameter:>,
<: i/o illegal write error:>,
<: i/o illegal disconnect:>,
<: i/o parity error:>,
<: r/w scheduler parity error:>,
<: buffer parity error:>,
<: ecc hardware fault:>,
<: illegal device/no control field:>,
<: diagnostic fault detected:>));
\f
<* fgs 1988.10.01 discstat page ...5 ...*>
write (out, false add 46, 45-pos);
case i of
begin
write (out, ".", 15, "nl",1, "=", 64);
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 6)); <* seeks *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* seek error *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* unable t.r. header *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* unable t.r. data *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* wr. pr. media viol. *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* no device responce *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* data corect. applied *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* seek retry applied *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* data retry applied *>
begin
long_bytes(rz, 4); <* skip unused *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* no head select fault *>
end;
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* write fault *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* (r+w) x off cyl. fault *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* (r*w) fault *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* voltage fault *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* head select fault *>
begin
long_bytes(rz, 2); <* skip unused *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* soft. write pr. fault *>
end;
begin
long_bytes(rz, 6); <* skip unused *>
count:= long_bytes(rz, 2);
cylinder:= long_bytes(rz, 2);
sector:= long_bytes (rz, 1) shift (-8);
head:= long_bytes (rz, 1) shift (-8);
write (out, <<ddddd>, count, << ddddd>, cylinder, << ddd>, head, sector);
end;
\f
<* fgs 1988.10.01 discstat page ...6 ...*>
begin
count:= long_bytes(rz, 2);
cylinder:= long_bytes(rz, 2);
sector:= long_bytes (rz, 1) shift (-8);
head:= long_bytes (rz, 1) shift (-8);
write (out, <<ddddd>, count, << ddddd>, cylinder, << ddd>, head, sector);
end;
begin
count:= long_bytes(rz, 2);
cylinder:= long_bytes(rz, 2);
sector:= long_bytes (rz, 1) shift (-8);
head:= long_bytes (rz, 1) shift (-8);
write (out, <<ddddd>, count, << ddddd>, cylinder, << ddd>, head, sector);
end;
begin
count:= long_bytes(rz, 2);
cylinder:= long_bytes(rz, 2);
sector:= long_bytes(rz, 1) shift (-8);
head:= long_bytes(rz, 1) shift (-8);
write (out, <<ddddd>, count, << ddddd>, cylinder, << ddd>, head, sector);
end;
write (out, ".", 15, "nl", 1, "=", 64);
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* comm. bl. overwrite *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* ill. command byte *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* ill. sec. seek addr. *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* ill. prim. seek addr. *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* ill. com. param. *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* i/o ill. write error *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* i/o ill. disconnect *>
begin
long_bytes(rz, 4); <* skip unused *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* i/o parity error *>
end;
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* r/w schd. par. error *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* buffer par. error *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* ecc hardware fault *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* ill. dev./no cntrl. field *>
write (out, <<ddd ddd ddd ddd ddd>, long_bytes(rz, 2)); <* diagnostic fault detec. *>
end; <* end case *>
end; <* end for i *>
errorbits := 0; <*ok.yes, warning.no*>
end;
\f
<* fgs 1988.10.01 discstat page ...7 ...*>
procedure write_disc_statistics(z,ra);
zone z ; <* output zone *>
real array ra ; <* disc driver statistics *>
begin
integer field accesses, errors, ecc_correc, rep_correc;
boolean field neg, pos, late, late_neg, late_pos, early,
early_neg, early_pos;
boolean array field magnitude;
boolean array field compound;
boolean array field detailed;
integer array field segments;
integer field segm_no;
boolean field in_ok, in_rep, out_ok, out_rep;
integer i;
boolean sp, nl;
sp:= false add 32; nl:= false add 10;
accesses:= 2; errors:= 4; ecc_correc:= 6; rep_correc:= 8;
neg:= 9; pos:= 10; late:= 12; late_neg:= 13; late_pos:= 14;
early:= 16; early_neg:= 17; early_pos:= 18;
magnitude:= 19; compound:= 34; detailed:= 58;
segments:= 82;
segm_no:= 2;
in_ok:= 3; in_rep:= 4; out_ok:= 5; out_rep:= 6;
write(z,<<ddddddd>,nl,3,
<:number of accesses:>,sp,17,ra.accesses,nl,3,
<:errors in first attempt:>,sp,12,ra.errors,nl,1,
<:errors corrected solely by ecc:>,sp,5,ra.ecc_correc,nl,1,
<:errors corrected within 3 retries:>,sp,2,ra.rep_correc,nl,3);
write(z,<<dddd>,
<:errors corrected by::>,nl,1,
<: neg offset:>,sp,17,ra.neg extract 12,nl,1,
<: pos offset:>,sp,17,ra.pos extract 12,nl,1,
sp,15,<:late strobe:>,sp,3,ra.late extract 12,nl,1,
<: neg offset + late strobe:>,sp,3,ra.late_neg extract 12,nl,1,
<: pos offset + late strobe:>,sp,3,ra.late_pos extract 12,nl,1,
sp,15,<:early strobe:>,sp,2,ra.early extract 12,nl,1,
<: neg offset + early strobe:>,sp,2,ra.early_neg extract 12,nl,1,
<: pos offset + early strobe:>,sp,2,ra.early_pos extract 12,nl,3);
\f
<* fgs 1988.10.01 discstat page ...8 ...*>
write(z,
<:errors corrected by offset magnitude::>,nl,1,
<: -01- -02- -03- -04- -05- -06- -07- :>,
<:-08- -09- -10- -11- -12- -13- -14- -15-:>,nl,1,sp,2);
for i:= 1 step 1 until 15 do
write(z,<<dddd>,ra.magnitude(i) extract 12,sp,1);
write(z,nl,3,
<:occurrencies of::>,nl,1);
for i:= 7,8,12,9,10,11, <* curr status *>
1,2,4,5,6,21,22,23,24, <* event status *>
20,19,18,17,16,15,14 do <* i/o result *>
write(out,case i of (
<: event status bit 0 intervention :>,
<: 1 data error (parity) :>,
<::>,
<: 3 data overrun :>,
<: 4 hard error :>,
<: 5 position error :>,
<: curr status bit 0 power low :>,
<: 1 local :>,
<: 8 write protect :>,
<: 9 high density :>,
<: 10 mode :>,
<: 5 seek error :>,
<::>,
<: 6 power restart :>,
<: 5 wait progr. termination :>,
<: 4 abnorm. termination :>,
<: 3 software timeout :>,
<: 2 bus timeout :>,
<: 1 bus reject :>,
<: i/o result 0 normal termination :>,
<: 20 bus communication error :>,
<: 21 interrupt error :>,
<: 22 bus timeout :>,
<: 23 bus parity error :>),
<<dddd>,ra.compound(i) extract 12,nl,1);
\f
<* fgs 1988.10.01 discstat page ...9 ...*>
write(z,nl,2,
<:occurrencies of detailed statusbit::>,nl,1,
<: -00- -01- -02- -03- -04- -05- -06- -07- -08- -09- -10- -11-:>,
nl,1,sp,2);
for i:= 1 step 1 until 12 do
write(z,<<dddd>,ra.detailed(i) extract 12,sp,1);
write(z,nl,2,
<: -12- -13- -14- -15- -16- -17- -18- -19- -20- -21- -22- -23-:>,
nl,1,sp,2);
for i:= 13 step 1 until 24 do
write(z,<<dddd>,ra.detailed(i) extract 12,sp,1);
if ra.segments.segm_no <> -1 then
begin
write(z,nl,3,
<:segment successful input op. successful output op.:>,
nl,1,
<:number input op. with rep. output op. with rep.:>,
nl,1);
for segments:= 82 step 6 until 136 do
if ra.segments.segm_no = -1
then segments:= 137
else
write(z,
sp,1,<<dddddd>,ra.segments.segm_no,
sp,6,<<dddd>,ra.segments.in_ok extract 12,
sp,8,ra.segments.in_rep extract 12,
sp,9,ra.segments.out_ok extract 12,
sp,9,ra.segments.out_rep extract 12,nl,1);
end
else
write(z,nl,3,<:no error segments detected:>,nl,1);
errorbits := 0; <*ok.yes, warning.no*>
end;
\f
<* fgs 1988.10.01 discstat page ...10...*>
integer statistics_length, zone_size;
statistics_length:= 142; <* no of bytes *>
zonesize := 128 *((112+statistics_length+511)//512 + 1);
<* in segments: (first_of_stat_field + 2 + enough) converted to segments
+ 1 segment to avoid segment boundaries *>
begin
integer
procedure stack_current_output (file_name);
long array file_name ;
begin
integer result ;
result := 1 shift 2; <*1<2 <=> 1 segment, temporary*>
fp_proc (29, 0, out, chain_name); <*stack c o*>
fp_proc (28, result, out, file__name); <*connect *>
if result <> 0 then
fp_proc (30, 0, out, chain_name); <*unstack *>
stack_current_output := result;
end stack_current_output;
procedure unstack_current_output ;
begin
fp_proc (34, 0, out, 25); <*close up*>
fp_proc (79, 0, out, 0); <*terminate*>
fp_proc (30, 0, out, chain_name); <*unstack *>
end unstack_current_output;
\f
<* fgs 1988.10.01 discstat page ...11...*>
procedure maybe_device_status (z);
zone z ;
<***********************************************************>
<* *>
<* The procedure writes on the zone z a device status mes- *>
<* sage with document name and status bit names the same *>
<* way fp does if the program was to terminate with a give *>
<* up alarm instead of having trapped one. *>
<* *>
<***********************************************************>
begin
integer status, cause, param, bit;
long array text (1:4);
long array field docname;
docname := 8; <*fields possible docname in text*>
status := getalarm (text);
cause := alarmcause extract 24 ;
param := alarmcause shift (-24);
if cause = -11 then
begin <*give up*>
write (z, "nl", 1,
<:device status :>, text.docname);
for bit := 0 step 1 until 23 do
if status shift bit < 0 then
write (z, "nl", 1, case (bit + 1) of (
<:intervention:>,
<:parity error:>,
<:timer:>,
<:data overrun:>,
<:block length error:>,
<:end of document:>,
<:load point:>,
<:tape mark or attention:>,
<:writing enabled:>,
<:mode error:>,
<:read error:>,
<:card rejected or disk error:>,
<:checksum error:>,
<:bit 13:>,
<:bit 14:>,
<:stopped:>,
<:word defect:>,
<:position error:>,
<:process does not exist:>,
<:disconnected:>,
<:unintelligible:>,
<:rejected:>,
<:normal:>,
<:hard error:>));
write (z, "nl", 1);
end;
end maybe device status;
\f
<* fgs 1988.10.01 discstat page ...12...*>
procedure fejl (z, text, sep, param);
value sep ;
zone z ;
string text ;
integer sep ;
array param ;
begin
write (z,
"nl", 1, <:***:>, progname,
"sp", 1, text, "sp", 2,
if sep shift (-12) = 8 then "." else " ", 1);
if sep extract 12 = 4 then
write (z, <<d>, round param (1))
else
write (z, param );
write (out,
"nl", 1);
goto slutlabel;
end procedure fejl;
\f
<* fgs 1988.10.01 discstat page ...13...*>
procedure info (z);
zone z ;
begin
write (z,
"nl", 2,
<:
call :
* *
(outfile) = discstat ( (clear.<yes/no>) (dump.<dumpfile>) (<disc>) )
1 1
<disc> ::= disc.<discname>/
addr.<discaddr>/
devno.<devno> /
<discname> ::= name of disc process
<discaddr> ::= address of disc process
<devno> ::= device number of disc process
<dumpfile> ::= name of system dump file
<yesno> ::= yes / no, default : no
:>, "nl", 1);
goto slutlabel;
end info;
\f
<* fgs 1988.10.01 discstat page ...14...*>
zone z (zone_size, 1, stderror), dz, dz1 (256, 1, stderror);
integer array ia, ia1 (1:20), dummy (1:1), core (0:24);
integer i, i1, base_buffer_area, typ, paramno, sepleng, result,
firstparam, monrelease, dpd, devno;
boolean proc_created, clear, coredump, testoutput;
long array progname, outfile, chainname (1:2);
real array discname, dumparea, param (1:2);
real time, r;
integer field if2;
integer array field iff;
errorbits := 3; <*ok.no, warning.yes*>
trap (slutlabel);
trapmode := 1 shift 10; <*no end alarm written*>
system (4, 0, out_file);
sepleng :=
system (4, 1, progname);
if sepleng shift (-12) <> 6 <*=*> then
begin <*noleft side, progname is param after programname*>
for i := 1, 2 do
begin
prog_name (i) := out_file (i);
out__file (i) := long <::> ;
param_no := 1 ;
end;
end <*no left side*> else
param_no := 2;
if out_file (1) <> long <::> then
begin <*stack current out and connect*>
result := stack_current_output (out_file);
if result <> 0 then
begin
write (out, "nl", 1, <:***:>, progname, "sp", 1, <:connect :>, outfile,
"sp", 1, case result of (
<:no resources:>,
<:malfunction:>,
<:not user, not exist:>,
<:convention error:>,
<:not allowed:>,
<:name format error:> ));
out_file (1) := long <::>;
end;
end <*stack current out and connect*>;
\f
<* fgs 1988.10.01 discstat page ...15...*>
iff := -2;
if2 := 2;
monrelease := dpd := 0;
devno := -1;
proc_created := coredump := clear := testoutput := false;
movestring (discname, 1, <::>);
movestring (dumparea, 1, <::>);
firstparam := paramno;
for sepleng := system (4, increase (paramno), param)
while sepleng = 4 shift 12 + 10 do
begin <*next parameter set*>
typ := 0;
for i := 1 step 1 until 6 do
if param (1) = real ( case i of (
<:disc:>,
<:addr:>,
<:devno:>,
<:dump:>,
<:clear:>,
<:testo:> add 'u' )) then
begin
typ := i;
i := 6;
end;
if typ > 0 then
begin <*known parameter read*>
sepleng := system (4, increase (paramno), param);
if typ = 1 and sepleng <> 8 shift 12 + 10
or typ = 2 and sepleng <> 8 shift 12 + 4
or typ = 3 and sepleng <> 8 shift 12 + 4
or typ > 3 and sepleng <> 8 shift 12 + 10 then
fejl (out, <:syntax:>, sepleng, param);
end <*known parameter read*>;
\f
<* fgs 1988.10.01 discstat page ...16...*>
case (typ + 1) of
begin
begin <*unknown parameter*>
fejl (out, <:unknown parameter:>, sepleng, param);
end;
begin <*disc*>
tofrom (discname, param, 8);
dpd := 0;
devno := -1;
end <*disc*>;
begin <*addr*>
if param (1) <= 0 then
fejl (out, <:illegal addr:>, sepleng, param);
dpd := param (1);
movestring (discname, 1, <::>);
devno := -1;
end <*addr*>;
begin <*devno*>
if param (1) < 0 then
fejl (out, <:illegal devno:>, sepleng, param);
devno := param (1); <*devno*>
dpd := 0;
movestring (discname, 1, <::>);
end <*devno*>;
begin <*dump*>
coredump := true;
tofrom (dumparea, param, 8); <*dump*>
end <*dump*>;
begin <*clear*>
if param (1) <> real <:yes:> and
param (1) <> real <:no:> then
fejl (out, <:syntax:>, sepleng, param)
else
clear := param (1) = real <:yes:>;
end <*test*>;
testoutput := true; <*testout*>
end <*case*>;
\f
<* fgs 1988.10.01 discstat page ...17...*>
<**********************>
if testoutput then
write (out,
"nl", 1, <:after a while : :>,
"nl", 1, <:typ = :>, typ ,
"nl", 1, <:disc = :>, discname,
"nl", 1, <:addr = :>, dpd,
"nl", 1, <:devno = :>, devno,
"nl", 1, <:dump = :>, if coredump then <:true:> else <:false:>,
"nl", 1, <:area = :>, dumparea,
"nl", 1, <:clear = :>, if clear then <:true:> else <:false:>,
"nl", 1, <:pno. = :>, paramno,
"nl", 1, <:f.st = :>, firstparam);
if typ >= 1 and
typ<= 3 then
begin <*disc specified*>
typ :=
if not coredump then
1
else
2;
<**********************>
if testoutput then
write (out,
"nl", 1, <:typ = :>, typ);
<***************************************************************>
\f
<* fgs 1988.10.01 discstat page ...18...*>
case typ of
begin <*case*>
begin <*case 1, not dump, find physical disc and its autoload part*>
integer array discdescr, main (0:14), ia (1:4);
integer physical , deviceno;
long array field name;
integer array field iaf;
integer maxdev;
system (5) move core :(64, ia);
monrelease := ia (1);
if monrelease >= 80 shift 12 + 0 then
begin
write (out,
<:
************************************************
* *
* rc9000-10, discstat not implemented *
* *
************************************************:>,
"nl", 1);
goto slutlabel;
end;
system (5) move core :(74, ia);
<*ia (1) first device in nametable*>
<*ia (2) first area in nametable*>
maxdev := (ia (2) - ia (1)) // 2;
\f
<* fgs 1988.10.01 discstat page ...19...*>
begin <*block for nametable*>
integer array nametable (0 : maxdev);
integer dev;
iaf := -2;
system (5, ia (1), nametable.iaf);
if discname (1) <> real <::> then
begin
open (z, 0, discname, 0);
dpd := monitor (4) proc descr addr :(z, 1, ia);
end;
if devno >= 0 then
dpd := nametable (devno);
i := 0;
if testoutput then
write (out,
"nl", 1, <:dpd = :>, dpd);
if dpd > 0 then
begin <*scan nametable for devno*>
system (5) move core :(dpd, discdescr.iaf);
if discdescr (0) <> 62 and
discdescr (0) <> 6 then
i := 7
else
begin <*search nametable*>
for dev := 0 step 1 until maxdev do
begin <*search disc with nametable = addr*>
if nametable (dev) = dpd then
begin devno := dev; dev := maxdev; end;
end <*search*>;
if devno < 0 then
i := 8
else
i := dpd;
end <*search nametable*>;
end <*scan nametable for devno*>
\f
<* fgs 1988.10.01 discstat page ...20...*>
else
i := 8; <*process does not exist*>
if testoutput then
write (out,
"nl", 1, <:i = :>, i);
if i > 8 then
begin <*process exists*>
system (5) move core :(dpd, discdescr.iaf);
if discdescr (0) = 6 then
begin <*ida disc, find physical*>
physical := dpd; <*present disc*>
system (5) move core :(discdescr (5), main.iaf);
if main (0) = 6 then
physical := discdescr (5);
end else
if discdescr (0) = 62 then
begin <*disc but not ida, find physical*>
physical := dpd; <*present disc*>
if discdescr (5) > 0 then
physical := discdescr (5); <*main*>
end else
i := 7; <*process not a disc*>
if i > 7 then
begin <*process is a phys. disc, find device no of autoload disc*>
for dev := 0 step 1 until maxdev do
begin <*search disc with main = phys. and first segment = 0*>
system (5) move core :(nametable (dev), discdescr.iaf);
if (discdescr ( 0) = 62 <*disc not ida*>
or discdescr ( 0) = 6 <*disc ida*>) and
discdescr ( 5) = physical and
discdescr (14) = 0 <*first segm *> then
begin device_no := dev; dev := maxdev; end;
end <*search*>;
\f
<* fgs 1988.10.01 discstat page ...21...*>
close (z, true);
open (z, 6, discdescr, 0);
if testoutput then
write (out,
"nl", 1, <:discdescr = :>, discdescr);
if discdescr (1) = 0 then
begin <*create peripheral process with wrk name*>
i := monitor (54) create peripheral proc :(z, deviceno, ia);
proc_created := i = 0;
if testoutput then
begin
integer array ia (1:20);
long array field laf;
laf := 2;
getzone6 (z, ia);
write (out,
"nl", 1, <:proc created = :>,
if proccreated then <:true:> else <:false:>,
"nl", 1, <:name in z = :>, ia.laf);
end;
end else
i := 0; <*found and name ok*>
end <*process is a physical disc*>;
end <*process exists*>;
end <*block for nametable*>;
end <*case 1, find physical disc and its autoload disc*>;
\f
<* fgs 1988.10.01 discstat page ...22...*>
begin <*case 2, dump area*>
if dpd = 0 then
begin
write (out,
"nl", 1, <:***:>, progname,
<: disc must be specified by address in dump area:>,
"nl", 1);
goto slutwhile;
end;
open (z, 4, dumparea, 0);
setposition (z, 0, 0);
inrec6 (z, 64);
inrec6 (z, 2);
monrelease := z.if2 ;
i := dpd;
rep: setposition(z, 0, i shift(-9));
inrec6(z, i extract 9);
inrec6(z, 2);
if z.if2 <> 62 then i := 9 <*not a disc or an ida disc*> else
begin
inrec6(z, 8); inrec6(z, 2);
i := z.if2; if i <> 0 then goto rep;
end
end <*case 2, dump area*>;
end <*case*>;
if i <> 0 and i <> 3 then
write (out, "nl", 1, <:***:>, progname,
"sp", 1, if typ = 1 and i <= 6 then
<:create peripheral process :> else <:disc specified :>,
case i of (
<:function forbidden in calling process:>,
<:calling proc not user; catalog i/o error:>,
<:name conflict:>,
<:device no does not exist:>,
<:device is reserved by another user:>,
<:name format illegal:>,
<:is not a disc:>,
<:does not exist:>,
<:is either not a disc or it is an ida disc:>),
"nl", 1)
\f
<* fgs 1988.10.01 discstat page ...23...*>
else
begin <*get statistics and print*>
write(out, "nl", 2, <:disc statistics, :>);
if discname (1) <> real <::> then
write (out, <:disc.:>, discname)
else
if devno >= 0 then
write (out, <: devno.:>, devno)
else
write (out, <:addr.:>, dpd);
if typ = 2 then
write (out, <: dump.:>, dumparea);
systime(1,0,time);
write (out,
"sp", if typ = 1 then 14 else 0,
<: date: :>, <<dd dd dd>,
systime (4, time, r), <: time : :>, r,
"nl", 1, false add 45, 76,
"nl", 2,
if monrelease < 80 shift 12 + 0 then
<:rc8000, :>
else
<:rc9000-10, :>,
<:monitor release : :>, "sp", 13, monrelease shift (-12),
<<d>, <:.:> , monrelease extract 12 ,
"nl", 2);
if typ > 1 then
begin
inrec6(z, 96-10);
for i := 5, 6, 7 do
begin
inrec6(z, 2); ia(i) := z.if2;
end;
inrec6(z, 6);
inrec6(z, statistics_length);
core (0) := 62; <*not ida*>
end else
begin <*typ = 1*>
\f
<* fgs 1988.10.01 discstat page ...24...*>
<*begin typ = 1*>
getzone6(z,ia);
base_buffer_area:= ia(19);
ia(14):= base_buffer_area; <* record base *>
ia(16):= statistics_length; <* record length *>
setzone6(z,ia);
getshare6(z,ia,1);
ia(4):= 9 shift 12 + (if clear then 1 else 0); <* operation *>
ia(5):= base_buffer_area + 1; <* firstaddr *>
ia(6):= ia(5) + statistics_length - 2; <* lastaddr *>
setshare6(z,ia,1);
monitor (16) send message :(z, 1, ia);
i := 1 shift
monitor (18) wait answer :(z, 1, ia);
if i = 1 shift 1 then
i := ia (1) add i; <*status add normal answer*>
if i <> 1 shift 1 then
stderror (z, i, if i = 1 shift 1 then 0 else ia (2));
getshare6 (z, ia1, 1);
i:= ia(2) + ia1(5); <* top transferred = first shared + halfwords *>
ia1(12):= i;
setshare6 (z, ia1, 1);
getzone6 (z, ia1);
ia1(15):= i-1; <* last byte last transferred - 1 *>
ia1(13):= 2; <* zone state after repeat char *>
system (5, ia1 (14) + 1, core.iff);
ia1 (12) := core (0) shift 8 + 1; <* init partial word *>
setzone6 (z, ia1);
system (5) move_core :(
monitor (4) process_description :(z, 1, core),
core.iff);
end <*typ = 1*>;
if core(0)=6 then
print_ida_statistics (z,core(22),core(23), core(18))
else
begin <*not ida*>
write_disc_statistics(out,z);
write(out,<:<10>:>);
for i:= 5, 6, 7 do
begin
write(out,<:<10>:>,case i-4 of (
<:latest sensed curr status :>,
<: event status :>,
<: detailed status:>),<: :>);
for i1:= -23 step 1 until 0 do
write(out,if ia(i) shift i1 extract 1 = 0
then <:.:> else <:1:>);
end ;
end <*not ida*>;
end <*get statistics and print*>;
write (out, "nl", 1);
close (z, true);
\f
<* fgs 1988.10.01 discstat page ...25...*>
end <*if typ >= 1 and typ <= 3*>;
slutwhile:
end <*while sepleng = 4 shift 12 + 10*>;
if paramno = firstparam + 1 then
info (out);
if discname (1) = real <::> and
devno < 0 and
dpd = 0 then
fejl (out, <:disc missing:>, sepleng, param);
if false then
slutlabel:
maybe_device_status (out);
if proc_created then
monitor (64) remove process :(z, 1, dummy);
if outfile (1) <> long <::> then
unstack_current_output;
end;
end;
▶EOF◀