|
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: 27648 (0x6c00)
Types: TextFile
Names: »discstat3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »discstat3tx «
discstat version: 8, latest corrections : fgs date: 1984.10.10
discstat version: 9, latest corrections : fb date: 1984.10.10
begin
<* pej 09.02.78 discstat dirty corrections dh.79.03.14 page 1
discstat
--------
the program extracts statistical information from a disc driver
or from a coredumparea with core 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 disc driver process named 'disc2' is connected:
discstat disc.disc2
the following command creates the peripheral process
'disc2auto' on device 12:
discstat disc.disc2auto.12
call
----
1 1 1
(<outfile>) = discstat (clear.<yesno>) disc.<drivername>(.<device number>)
0 0 0
or
1
(<outfile>) = discstat <s> dump.<dumparea name>.<driver addr>
0
--------
the program sends a message to the specified driver to
collect the statistics. the driver may be either a logical or
a physical disc driver - in either case the statistics concerns
the information created by a physical driver. please note that
the driver will reset its statistics when the information has
been collected.
if <device> is specified the program creates a peripheral
process named <drivername> to the device.
if the first parameter is dump, the program takes input from the
area at such a position that the specified discdriver 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 driveraddr,
and positioning takes place again, checking that the first word is 62
et cetera, until a main device 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 driver. <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 driver 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
<* pej 09.02.78 discstat page 2 *>
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;
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:>));
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;
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 *>
end;
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;
\f
<* pej 09.02.78 discstat page 3 *>
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);
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 1984.04.09 discstat page 5 *>
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 1984.04.05 discstat dirty corrections dh.79.03.14 page 6 *>
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 := 2; <*1<1 <=> 1 segment, preferably disc*>
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 1984.10.10 discstat page 6a *>
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
<* fgs1984.10.10 discstat page 6b *>
procedure fejl (z, text, param);
zone z ;
string text ;
array param ;
begin
long array field laf;
laf := 0;
write (z, "nl", 1, <:***:>, progname, "sp", 1, text, "sp", 1, param.laf,
"nl", 2,
<: call :
(<outfile> = )
discstat (clear.<yesno>) disc.<disc name> (.<device number>)
or :
(<outfile> = )
discstat dump.<area name>.<process address>
:>);
end fejl;
zone z(zone_size,1,stderror);
integer array ia,ia1(1:20), dummy (1:1), core (0:24);
integer i,i1, base_buffer_area, typ, paramno, sepleng, result;
boolean proc_created, clear;
long array progname, outfile, chainname (1:2);
real array discname(1:2), ra(1:2);
real time, r;
integer field if2;
\f
<* fgs 1984.02.05 discstat page 7 *>
proc_created := clear := false;
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*>;
if2 := 2; ra(1) := 0;
system(4, increase (paramno), ra);
if ra (1) = real <:clear:> then
begin <*clear*>
if system (4, increase (paramno), ra) <> 8 shift 12 + 10
or (ra (1) <> real <:yes:> and
ra (1) <> real <:no:>) then
fejl (out, <:param:>, ra)
else
begin
clear := ra (1) = real <:yes:>;
system (4, increase (paramno), ra);
end;
end <*clear*>;
if ra(1) = real <:dump:> then typ := 2 else
if ra(1) = real <:disc:> then typ := 1 else
typ := 0;
\f
<* fgs 1984.04.05 discstat page 8 *>
if typ = 0 then
fejl (out, <:param:>, ra)
else
if system(4,increase (paramno),discname) <> 8 shift 12 add 10 then
fejl (out, <:param:>, discname)
else
begin <*param ok*>
systime(1,0,time);
i:= 1;
write(out,<:<10><10>disc statistics, :>, case typ of(<:disc: :>, <:dump: :>),
string discname(increase(i)),<: date: :>,<<dd dd dd>,
systime(4,time,r),<: time: :>,r,<:<10>:>,
false add 45,76,<:<10>:>);
i:= 1;
open(z, case typ of(6, 4), string discname(increase(i)), 0);
i := system(4, paramno, ra);
case typ of
begin <*case*>
\f
<* fgs 1984.10.09 discstat page 9 *>
<*case 1*>
if i = 8 shift 12 add 4 then
begin
i:= ra(1);
i:= monitor(54)create_peripheral:(z,i,ia);
proc_created := i = 0;
end else
begin <*find physical disc and its autoload part*>
integer array discdescr, main (0:14);
integer physical , deviceno;
long array field name;
name := 0; <*fields name in procdescr (0:...)*>
i := monitor (4) proc descr addr :(z, 1, ia);
if i > 0 then
begin <*process exists*>
system (5) move core :(i, discdescr);
if discdescr (0) = 6 then
begin <*ida disc, find physical*>
physical := i; <*present disc*>
system (5) move core :(discdescr (5), main);
if main (0) = 6 then
physical := discdescr (5);
end else
if discdescr (0) = 62 then
begin <*disc but not ida, find physical*>
physical := i; <*present disc*>
if discdescr (5) > 0 then
physical := discdescr (5); <*main*>
end else
i := 7; <*process not a disc*>
if i > 0 then
begin <*process is a physical disc, find device no of autoload disc*>
integer array ia (1:4);
integer maxdev;
\f
<* 1984.10.10 discstat page 9a *>
system (5) move core :(74, ia);
<*ia (1) first device in nametable*>
<*ia (2) first area in nametable*>
maxdev := (ia (2) - ia (1)) // 2;
begin <*block for nametable*>
integer array nametable (0 : maxdev);
integer dev;
system (5, ia (1), nametable);
for dev := 0 step 1 until maxdev do
begin <*search disc with main = physical and first segment = 0*>
system (5) move core :(nametable (dev), discdescr);
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*>;
end <*block for nametable*>;
close (z, true);
open (z, 6, discdescr.name, 0);
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;
end else
i := 0; <*found and name ok*>
end <*process is a physical disc*>;
end <*process exists*> else
i := 8; <*process does not exist*>
end <*find physical disc and its autoload disc*>;
\f
<* fgs 1984.10.09 discstat page 10 *>
<*case 2*>
if i <> 8 shift 12 + 4 then
fejl (out, <:param:>, ra)
else
begin
i := ra(1);
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 typ = 2 i.e. dump;
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)
else
begin <*get statistics and print*>
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 1984.10.09 discstat page 11 *>
<*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);
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);
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*>;
end <*param ok*>;
write(out,<:<10><10><10><10>:>);
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◀