|
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: 43008 (0xa800)
Types: TextFile
Names: »slicel3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »slicel3tx «
\f
<*
UTILITY PROGRAM SLICELIST.
__________________________
Author: Hans Henriksen.
Release: June 1979.
*>
\f
begin
<* 790614. SLICELIST rel. 1.0 page 1 *>
<* Table of contents.
__________________
page
1. Introduction........................... 2
2. Declarations........................... 3
2.1 Variables............................. 3
2.2 Procedures............................ 5
2.2.1 connectout.......................... 5
2.2.2 errormessage........................ 6
2.2.3 fpparam............................. 7
2.2.4 termout............................. 10
2.2.5 testoutput.......................... 11
2.2.6 writeentry.......................... 13
2.2.7 writeslices......................... 14
3. Initialization......................... 19
4. The central loop....................... 20
5. Program termination.................... 24
*>
\f
<* 841009. SLICELIST rel. 1.0 page 2 *>
<* 1. Introduction.
________________
This is the sourcetext for the utilityprogram SLICELIST.
The program is described in RCSL. no 31-D570.
Below is given a summery of the syntax for the program call,
and a debugging facility is shortly described.
Call:
_____
1 * *
(<outfile>=) slicelist ((<modifier>) <filename> )
0
<filename>::=<name of a file stored on an RC82xx/RC83xx disc>
(cylinder )
(segment ) (yes)
<modifier>::=( ) .( )
(slice ) (no )
(test )
<outfile>::=<name of desired output file>
The initial setting of the modifiers are:
cylinder.no, segment.no, slice.yes, and test.no .
If test.yes is specified in the program call, it will cause
an execution of procedure Testoutput (see page 11) for each fol-
lowing occurrence of <filename>.
*>
\f
<* 790614. SLICELIST rel. 1.0 page 3 *>
<*
2. Declarations.
________________
2.1 Variables.
______________
*>
integer i,j, <* index *>
<* *>
number_of_heads, <* the number of heads on the *>
<* disc on which the file beeing*>
<* processed is stored. *>
<* *>
slicelength, <* the slicelength for the logi-*>
<* cal disc on which the file be*>
<* ing processed is stored. *>
<* *>
type; <* the value of type determines *>
<* what action that is to be per*>
<* formed in the central loop *>
boolean alternate_outfile, <* true if an <outfile> is spe- *>
<* cified in the program call *>
<* otherwise false *>
<* *>
cylinder, <* corresponds to the *>
segment, <* <modifier>'s in the program *>
slice, <* call. *>
test, <* *>
finis, <* holds the exit condition for *>
<* the central loop. *>
ff, nl, sp, ok; <* *>
array chaintable(1:512), <* holds the chaintable for the *>
<* logical disc on which the *>
<* file being processed is sto- *>
<* red. *>
<* *>
parameter(1:5,1:2), <* holds the text equivalents *>
<* for the <modifier>'s *>
<* *>
items(1:4), <* parameters in calls of the *>
progname(1:2), <* procedures connectout,fpparam*>
stack(1:2); <* and termout. *>
integer
array fdpd(1:6), <* physical disc process descrip*>
<* tion *>
entry(1:20), <* holds the catalog entry for *>
<* the file being processed *>
ib(1:20), <* parameters in procedure calls*>
itemtype(1:2), <* *>
kind(1:1), <* process kind *>
ldpd(1:4), <* logical disc process descrip-*>
<* tion. *>
pda1, pda2(1:1); <* process description address *>
\f
<* 790614. SLICELIST rel. 1.0 page 4 *>
integer
array
field iaf;
boolean
array
field baf;
real yes, no; <*holds the texts 'yes' and 'no'*>
zone z(1,1,stderror); <* used in calls of procedure *>
<* monitor. *>
\f
<* 790614. SLICELIST rel. 1.0 page 5 *>
<* 2.2 Procedures.
_______________
2.2.1 connectout.
*>
boolean procedure connectout(filename,stack);
array filename, stack;
<* This procedure terminates the use of the file to which the
zone OUT is currently connected, in a way so that it may be later
resumed, and connects the zone OUT to the file specified by the
parameter 'filename'. If no file with that name exists or it cannot
be connected, then a file with the specified name is created (on
the main-disc) if the necessary resources are available.
Call:
connectout(filename, stack)
connectout (return value, boolean) true if the file
specified by filename is connected otherwise
false.
filename (call value, array) length >= 2, filename(1)
and filename(2) is expected to contain the name
of the file, to which the zone OUT is to be con
nected.
stack (return value, array) length >= 2, contains the
name of the BS-area on which the previous con
tent of the zone OUT is dumped.
The procedure uses the external procedure FPPROC(action,w0,w1,w2),
descibed in RCSL. no 31-D356, which simulates the execution of:
jl w3 fpbase + h-name(action).
The actual used 'actions' connect output (h28), stack zone (h29),
and unstack zone (h30) are described in System 3 utility programs,
part three RCSL no 31-D379 page 8-4 ff.
*>
begin
integer size;
array name, temp(1:2);
temp(1) := temp(2) := real <::>;
name(1) := filename(1);
name(2) := filename(2);
fpproc(29,0,out,temp); <* stack zone *>
size := 3; <* size := no. of segm. add device *>
fpproc(28,size,out,name); <* connect zone *>
if size <> 0
then
begin <* file can not be connected *>
fpproc(30,0,out,temp); <* unstack zone *>
connectout := false;
end
else
begin
connectout := true; <* file is connected *>
stack(1) := temp(1); <* save stack area name *>
stack(2) := temp(2);
end;
end *** procedure connectout ***;
\f
<* 841009. SLICELIST rel. 1.0 page 6 *>
<* 2.2.2 errormessage.
*>
procedure errormessage(no);
value no; integer no;
<* This procedure outputs a message on current output. The message
has the following form:
*** slicelist <text>
where the <text> part of the message depends on the value of no. The
correspondence between <text> and the value of no are shown in the
table listed below:
no <text>
1 <name> can not be connected.
2 <name> can not be looked up.
3 <name> is not a BS-area.
4 <name> , <devicename> intervention.
5 <name> , <devicename> is not an rc82xx/rc83xx disc.
6 param: <name>.<name> illegal.
The procedure references the following global declared
variables: entry, items, nl, sp.
*>
begin
integer k, l;
real array field raf;
k := 1;
write(out,nl,2,<:*** slicelist:>,sp,3);
case no of
begin
write(out,string items(increase(k)),sp,2,
<:can not be connected:>,nl,1);
write(out,string items(increase(k)),sp,2,
<:can not be looked up.:>,nl,1);
write(out,string items(increase(k)),sp,2,
<:is not a BS-area.:>,nl,1);
begin raf := 0; l := 5;
write(out,string items(increase(k)),<: , :>,
string entry.raf(increase(l)),
<: intervention.:>,nl,1);
end;
begin l := 3;
write(out,<:param: :>,string items(increase(k)),
<:.:>,string items(increase(l)),sp,2,
<:illegal.:>,nl,1);
end;
begin raf := 0; l := 5;
write(out,string items(increase(k)),<: , :>,
string entry.raf(increase(l)),
<: is not an rc82xx/rc83xx disc.:>);
end;
end *** case no of ***;
end *** procedure errormessage ***;
\f
<* 790614. SLICELIST rel. 1.0 page 7 *>
<* 2.2.3 fpparam.
*>
integer procedure fpparam(maxintno,maxnameno,maxitemno,progname,items,
itemtype);
value maxintno,maxnameno,maxitemno;
integer maxintno,maxnameno,maxitemno;
array progname,items;
integer array itemtype;
<*
This procedure reads the next <param> from the FP-commandstack, and
returns the items which were part of it.As a special case <name>=<name>
is considered to be a single <param>. A formal definition of <param> is
given below:
<param>::=<name>=<name> I <itemlist> I <empty>
<itemlist>::=<item> I <item>.<itemlist>
<item>::=<integer> I <name>
<empty>::= end of commandstack
In case of an error (see below), the procedure outputs a message on
current output, and skips forward until the first <item> of the next
<param>. The only situation which can give rise to the errorreaction
are when one or more of the three following relations are not
fulfilled:
number of integer items in param <= maxintno
number of name items in param <= maxnameno
number of items in param <= maxitemno
e.i. the <param> consists of more <item>'s than it is allowed
Errormessage format: *** progname param: <param> illegal
Call: fpparam(maxintno,maxnameno,maxitemno,progname,items,itemtype)
fpparam (return value, integer) in case of an error -1
else number of items.
maxintno (call value,integer ) states the maximum number of
integer items which are allowed in the <param>.
maxnameno (call value, integer) states the maximum number of
name items which are allowed in the <param>.
maxitemno (call value, integer) states the maximum number of
items which are allowed in the <param>.
progname (call value, array) used in case of an error as
part of the errormessage.
items (return value, array) contains the items which
were part of the just read <param>. Integer items
occupies one location, name items occupies two
locations.
itemtype (return value, integer array) gives the informa-
tion neessary for interpretation of the contents
of items. Itemtype(i) is equal to one if the i'th
item was a name and is equal to two if the i'th
item was an integer.
*>
\f
<* 790614. SLICELIST rel. 1.0 page 8 *>
begin
procedure error;
begin
integer i, j, n; integer array digit(1:8);
no := oldno; i := 1;
write(out,<:<10>*** :>,string progname(increase(i)),<: param: :>);
sep_and_type := system(4,no,name);
repeat
if sep_and_type extract 12//4 = 1
then
begin
i := 0; n := name(1);
repeat
i := i + 1;
digit(i) := n - n//10 * 10 + 48;
n := n//10;
until n = 0;
for j := i step -1 until 1 do outchar(out,digit(j));
end
else
begin
i := 1;
write(out,string name(increase(i)));
end;
no := no + 1;
sep_and_type := system(4,no,name);
if (6 shift 12 add sep_and_type) shift (-12) < 12
then finis := true
else write(out,<:.:>);
until finis;
write(out,<: illegal:>);
itemno := -1;
end *** procedure error ***;
own integer no;
integer intno, nameno, itemno, oldno, sep_and_type;
array name(1:2);
boolean finis;
\f
<* 790614. SLICELIST rel. 1.0 page 9 *>
intno := nameno := itemno := 0;
oldno := no;
finis := false;
sep_and_type := system(4,no,name);
repeat
case sep_and_type extract 12//4 + 1 of
begin
<* end of commandlist *>
finis := true;
<* integer item *>
if intno = maxintno or itemno = maxitemno
then error
else
begin
intno := intno + 1;
itemno := itemno + 1;
itemtype(itemno) := 2;
items(nameno * 2 + intno) := name(1);
end;
<* name item *>
if nameno = maxnameno or itemno = maxitemno
then error
else
begin
itemno := itemno + 1;
itemtype(itemno) := 1;
items(nameno * 2 + intno + 1) := name(1);
items(nameno * 2 + intno + 2) := name(2);
nameno := nameno + 1;
end;
end *** case sep_and_type extract 12//4 + 1 of ***;
if -, finis
then
begin
no := no + 1;
sep_and_type := system(4,no,name);
finis := (6 shift 12 add sep_and_type) shift (-12) < 12;
end;
until finis;
fpparam := itemno;
end *** procedure fpparam ***;
\f
<* 790614. SLICELIST rel. 1.0 page 10 *>
<* 2.2.4 termout.
*>
procedure termout(stack);
array stack;
<* This procedure is the reverse to procedure connectout (see
above). It terminates the use of the file to which the zone OUT is
currently connected, and makes the file to which the zone OUT was
previously connected accessible for further processing.
Call:
termout(stack)
stack (call value, array) is expected to contain the
name of the BS-area on which the zone-descriptor
etc. was dumped when procedure connectout were
called.
*>
begin
array temp(1:2);
integer block, file;
integer array tail(1:10);
temp(1) := stack(1);
temp(2) := stack(2);
outchar(out,25); <* write endmark *>
monitor(42)lookup entry:(out,0,tail);
if tail(1) >= 0
then
begin
getposition(out,file,block);
tail(1) := block + 1;
monitor(44)change entry:(out,0,tail);
end;
close(out,true); <* close *>
fpproc(30,0,out,temp); <* and unstack file *>
end *** procedure termout ***;
\f
<* 790614. SLICELIST rel. 1.0 page 11 *>
<* 2.2.5 Testoutput.
*>
procedure testoutput;
<* This procedure is intended only for maintaince purposes. It
can be used to output the values/contents of the global decla-
red variables listed below.
cylinder, segment, slice.
pda1, pda2.
chaintable, entry, fdpd, ldpd, number_of_heads, slicelength.
The procedure is executed only when test.yes is specified in
the program call.
*>
begin
boolean st;
integer i, j, last_slice;
real array field raf;
st := false add 42;
write(out,ff,1,nl,2,<:*** slicelist testoutput::>,
nl,2,sp,6,<:modifier values::>,nl,1,sp,8,
<:cylinder::>,sp,3, if cylinder then <:true:>
else <:false:>,nl,1,sp,8,<:segment::>,sp,4,
if segment then <:true:> else <:false:>,nl,1,sp,8,
<:slices::>,sp,5,if slice then <:true:> else
<:false:>,nl,2,sp,6,<:varible values::>,nl,2,
<<dd ddd ddd>,sp,8,
<:pda1::>,pda1(1),nl,1,sp,8,<:pda2::>,pda2(1),
nl,1,sp,8,<:slicelength: :>,slicelength,
nl,1,sp,8,<:no of heads: :>,number_of_heads,
nl,1,sp,8,<:first segment::>,ldpd(3),nl,2,sp,6,
<:ldpd and fdpd values::>,nl,1);
j := 22;
for i := 1 step 1 until 4 do
write(out,nl,1,sp,8,<:ldpd(:>,<<d>,i,<:): +:>,<<dd>,
j + i * 2,<:: :>,<<dd ddd ddd>,ldpd(i),sp,4,
case i of (<:chaintable:>,<:slicelength:>,
<:first segment:>,<:no. of segments:>));
j := 26;
write(out,nl,1);
for i := 1 step 1 until 6 do
write(out,nl,1,sp,8,<:fdpd(:>,<<d>,i,<:): +:>,<<dd>,
j + i * 2,<:: :>,<<dd ddd ddd>,fdpd(i),sp,4,
case i of (<:firtst segment:>,<:no. of segments:>,
<:segms. per track:>,<:flags:>,
<:segms. per cyl.:>,<:odd cyl shift:>));
write(out,nl,2,sp,6,<:catalog entry values::>,nl,1,sp,8,
<:entry1::>,sp,3,<<dddd>,entry(1) shift (-12),
sp,3,entry(1) extract 12 shift (-3),sp,3,entry(1)
extract 3);
\f
<* 790614. SLICELIST rel. 1.0 page 12 *>
raf := 6; i := 1;
write(out,nl,1,sp,8,<:entry4::>,sp,3,string
entry.raf(increase(i)),nl,1,sp,8,<:entry8::>,sp,3,
<<dddd>,entry(8));
raf := 16; i := 1;
write(out,nl,1,sp,8,<:entry9::>,sp,3,string
entry.raf(increase(i)));
last_slice := ldpd(4)/ldpd(2);
write(out,ff,1,nl,1,sp,6,<:chaintable dump::>,nl,2,
sp,8,<:no. of slices::>,<<ddd ddd>,last_slice,
nl,2,sp,15,st,71,nl,1,sp,15,st,1);
for i := 0 step 1 until 9 do
write(out,<<dddd>,i,sp,2,st,1);
write(out,nl,1,sp,8,st,78);
baf := 1; j := 0;
while j < last_slice and j < 2048 do
begin
if j mod 10 = 0
then write(out,nl,1,sp,8,st,1,<<ddddd>,j,sp,1,st,1);
i := chaintable.baf(j) extract 12;
if i > 2048
then i := i - 4096;
write(out,<<-dddd>,i,sp,1,st,1);
j := j + 1;
end *** while j < last_slice do ***;
end *** procedure testoutput ***;
\f
<* 790614. SLICELIST rel. 1.0 page 13 *>
<* 2.2.6 Writeentry.
*>
procedure writeentry(entry);
integer array entry;
<* This procedure outputs a catalog entry, which describes a
BS-area, with the same format as the one used by the
program LOOKUP.
*>
begin
integer i, permkey, scope;
long array bases(1:4);
long base;
real r;
integer array field iaf;
real array field raf;
i := 1; raf := 6;
write(out,sp,14 - write(out,nl,2,string entry.raf(
increase(i))),
<:= set :>,entry(8));
i:= 1; raf := 16;
write(out,sp,1,string entry.raf(increase(i)),sp,1);
if entry(13) <> 0
then write(out,<:d.:>,<<dddddd>,systime(6,entry(13),r),
<:.:>,<<dddd>,r/100,sp,1)
else write(out,<:0:>,sp,1);
for i := 14, 15, 16, 17 do
begin
if entry(i) shift (-12) <> 0
then write(out,<<d>, entry(i) shift (-12),<:.:>);
write(out,<<d>, entry(i) extract 12, sp,1);
end;
iaf := 0;
system(11,0,bases.iaf);
base := extend entry(2) shift 24 add entry(3);
permkey := entry(1) extract 3;
scope := if permkey <= 2 and base = bases(2)
then 1 + permkey//2
else
if permkey = 3
then 2 + ( if base = bases(3)
then 1
else
if base = bases(4)
then 2
else
if extend entry(2) <= extend bases.iaf(7) and
extend entry(3) >= extend bases.iaf(8)
then 3
else 4)
else 6;
write(out,<: ; :>,case scope of (<:temp:>,<:login:>,<:user:>,
<:project:>,<:system:>,<:***:>),
nl,1,sp,12,<:; :>,entry(1) shift (-12), entry(1) extract 12
shift (-3), entry(1) extract 3,entry(2), entry(3),
nl,1,sp,12,<:;:>);
end *** procedure writeentry ***;
\f
<* 841009. SLICELIST rel. 1.0 page 14 *>
<* 2.2.7 Writeslices.
*>
procedure writeslices(entry,chaintable);
integer array entry;
boolean array chaintable ;
<* This procedure performs the computations and the printing of
the surveys, which are selected by the setting of the modifiers.
The computations are based on the two parameters entry
and chaintable, which contains the catalog entry for the
file being processed and the chaintable for the logical
disc on which it is stored.
Furthermore the procedure references the following global
declared variables:
ldpd, fdpd, pda1, pda2, kind, cylinder, segment, slice,
slicelength, and number_of_heads.
*>
begin
integer i, j, <* index *>
<* *>
mode, <* used to determine what survey,*>
<* concerning the slice and seg- *>
<* ment numbers, that is to be *>
<* produced. *>
<* *>
no, <* index, and when the slicenum- *>
<* bers are collected from the *>
<* chaintable the number of these*>
<* *>
offset, <* used when collecting the slice*>
<* numbers from the chaintable. *>
<* the value to be added to the *>
<* current index to obtain the *>
<* number of the next slice. *>
<* *>
size, <* the size of the file *>
<* *>
slno; <* slicenumber *>
write(out,nl,1,sp,12,<:;:>,nl,1,sp,12,<:;:>,sp,3,
<:logical disc characteristics::>,nl,1,sp,12,
<:;:>,nl,1,sp,12,<:;:>,<<dddd ddd>,sp,4,
<:slicelength::>,sp,4,slicelength,nl,1,sp,12,
<:;:>,sp,4,<:first segment::>,sp,2,ldpd(3),
nl,1,sp,12,<:;:>,sp,4,<:no. of segments::>,
ldpd(4),nl,1,sp,12,<:;:>,nl,1,sp,12,<:;:>,sp,3,
<:physical disc characteristics::>,nl,1,sp,12,
<:;:>,nl,1,sp,12,<:;:>,sp,4,<<ddd ddd>,
<:process desciption addr::>,if pda2(1) = 0
then pda1(1) else pda2(1));
if kind(1)=6 <*ida disc*> then
write(out,nl,1,sp,12,<:;:>)
else
write(out,nl,1,sp,12,<:;:>,sp,4,
<:segm. per cyl.::>,fdpd(5),nl,1,sp,12,<:;:>,sp,4,
<:odd cyl. shift::>,fdpd(6),nl,1,sp,12,<:;:>);
\f
<* 790618. SLICELIST rel. 1.0 page 15 *>
size := entry(8);
slno := (size + slicelength -1)//slicelength;
if size > 0 and ( cylinder or segment or slice)
then
begin
integer array sliceno(1:slno);
no := 0;
slno := entry(1) shift (-12);
<* The slicenumbers are collected from the chaintable. *>
repeat
no := no + 1;
sliceno(no) := slno;
offset := chaintable(slno) extract 12;
slno := slno + (if offset > 2047 then offset - 4096
else offset);
until offset = 0;
<* The slicenumbers are sorted in ascending ordrer.
The sortingmethod used is: bubblesort. *>
if no > 1
then
begin
for j := no - 1 step -1 until 1 do
for i := 1 step 1 until j do
if sliceno(i) > sliceno(i+1)
then
begin
slno := sliceno(i + 1);
sliceno(i + 1) := sliceno(i);
sliceno(i) := slno;
end;
end;
\f
<* 790618. SLICELIST rel. 1.0 page 16 *>
<* The survey of the slice and/or segment numbers is
printed.
*>
mode := if slice and segment
then 3
else
if slice or segment
then 2
else 1;
write(out,nl,1,sp,12,<:;:>,sp,3,<:number of slices::>,
<<ddd ddd>,no);
write(out,nl,1,sp,12,<:;:>,nl,1,sp,12,<:;:>,sp,3,
case mode of (<::>,if slice then <:slicenumbers:>
else <:segmentnumbers:>,
<:slice and segment numbers:>),
nl,1,sp,12,<:;:>,nl,1,sp,12,<:;:>);
i := 0;
case mode of
begin
<* slice.no and segment.no - no action *>;
<* slice.yes or segment.yes *>
while i < no do
begin
if i mod 5 = 0
then write(out,nl,1,sp,12,<:;:>,sp,4);
i := i + 1;
write(out,<<ddd ddd>,if slice then sliceno(i)
else sliceno(i) * slicelength,sp,4);
end *** while i < no do ***;
<* slice.yes and segment.yes *>
begin
for j := 1 step 1 until (if no = 1 then 1
else 2)
do write(out,sp,4,<:sliceno:>,sp,3,<:segm. no.:>);
j := no//2 + no mod 2;
slno := j;
repeat
i := i + 1;
j := j + 1;
write(out,nl,1,sp,12,<:;:>,sp,3,<<ddd ddd>,
sliceno(i),sp,4,sliceno(i) * slicelength);
if j <= no
then write(out,sp,5,<<ddd ddd>,sliceno(j),sp,4,
sliceno(j) * slicelength);
until i = slno;
end;
end *** case mode of ***;
\f
<* 841009. SLICELIST rel. 1.0 page 17 *>
<* The survey showing the distribution of the slices on
cylinders is computed and printed.
*>
if cylinder and kind(1)=6 <*ida disc*> then
write(out,nl,1,sp,12,<:;:>,nl,1,sp,12,<:;:>,sp,3,
<:cylinder option not possible on rc83xx discs:>,
nl,1,sp,12,<:;:>)
else
if cylinder
then
begin
integer cylno1, <* the number of the cylinder *>
<* for which there is being *>
<* counted slices. *>
cylno2, <* the number of the cylinder *>
<* on which the first segment *>
<* of the current slice is *>
<* located. *>
cylno3, <* the number of the cylinder *>
<* on which the last segment *>
<* of the current slice is *>
<* located. *>
<* *>
first_cylno, <* the number of the first *>
<* cylinder of the logical *>
<* disc on the physical disc. *>
<* *>
first_segment, <* the number of the first *>
<* segment of the logical disc*>
<* on the physical disc. *>
<* *>
segm_per_cyl; <* segments per cylinedr. *>
real part, <* used when a slice is divi- *>
<* ded on two cylinders. *>
<* '1 - part' is the part of *>
<* the slice located on cylin-*>
<* der 'cylno2' and 'part' is *>
<* the part of the slice loca-*>
<* ted on cylinder 'cylno3'. *>
<* *>
slices; <* the number of slices, coun-*>
<* ted until now, on cylinder *>
<* 'cylno1' *>
\f
<* 790618. SLICELIST rel. 1.0 page 18 *>
write(out,nl,1,sp,12,<:;:>,nl,1,sp,12,<:;:>,sp,3,
<:cyl. no.:>,sp,3,<:no. of slices:>);
segm_per_cyl := number_of_heads * 21;
first_segment := ldpd(3);
first_cylno := first_segment//segm_per_cyl;
i := 0;
slices := 0.0;
cylno1 := (sliceno(1) * slicelength + first_segment)//
segm_per_cyl - first_cylno;
repeat
i := i + 1;
cylno2 := (sliceno(i) * slicelength + first_segment)//
segm_per_cyl - first_cylno;
cylno3 := (sliceno(i) * slicelength + slicelength - 1 +
first_segment)//segm_per_cyl - first_cylno;
if cylno1 = cylno2 and cylno2 = cylno3
then slices := slices + 1.0
else
begin
part := if cylno2 = cylno3 then 1.0
else (sliceno(i) * slicelength + slicelength +
first_segment) mod segm_per_cyl/
slicelength;
if cylno1 = cylno2
then slices := slices + 1 - part;
write(out,nl,1,sp,12,<:;:>,sp,5,<<dddd>,cylno1,sp,7,
<<ddd.dd>,slices);
if cylno1 <> cylno2 and cylno2 <> cylno3
then write(out,nl,1,sp,12,<:;:>,sp,5,<<dddd>,cylno2,
sp,7,<<ddd.dd>,1.0 - part);
cylno1 := cylno3;
slices := part;
end;
until i = no;
write(out,nl,1,sp,12,<:;:>,sp,5,<<dddd>,cylno1,sp,7,
<<ddd.dd>,slices);
end ***if cylinder then ***;
end *** if size > 0 and ( cylider or segment or slice) ***;
end *** procedure writeslices ***;
\f
<* 790618. SLICELIST rel. 1.0 page 19 *>
<* 3. Initialization.
__________________
*>
for j := 1 step 1 until 4 do
for i := 1,2 do
parameter(j,i) := case (j - 1) * 2 + i of
(real <:cylin:> add 100, real <:er:>,
real <:segme:> add 110, real <:t:>,
real <:slice:> , real <::>,
real <:test:>, real <::>);
progname(1) := real <:slice:> add 108;
progname(2) := real <:ist:>;
yes := real <:yes:>; no := real <:no:>;
nl := false add 10; ff := false add 12; sp := false add 32;
test := cylinder := segment := false; slice := true;
finis := false;
trapmode := 1 shift 10;
<* It is tested whether an <outfile> is specified in the
program call, and if so it is tried to connect it.
*>
case fpparam(0,2,2,progname,items,itemtype) of
begin
alternate_outfile := false;
if connectout(items, stack)
then alternate_outfile := true
else
begin
errormessage(1);
alternate_outfile := false;
end;
end *** case fpparam of ***;
\f
<* 790615. SLICELIST rel. 1.0 page 20 *>
<* 4. The central loop.
____________________
The central loop comprises four actions, which each corre-
sponds to one of the possible four returnvalues (-1, 0, 1, 2)
delivered by procedure FPPARAM in the begining of the loop.
The correspondence between the value of type and the action
which is to be performed is shown in the table listed below.
type action
1 erroneous parameter - no action.
2 end of parameter list - exit loop.
3 The parameter has the form: <name>. It
is checked whether the parameter is the
name of a file stored on an RC82xx disc.
If so, then the surveys, which are selec-
ted by the setting of the modifiers, are
produced.
4 The parameter has the form: <name>.<name> .
It is checked whether the parameter is a
<modifier>. If so, that modifier is set in
accordance with the parameter.
*>
repeat
type := fpparam(0, 2, 2, progname, items, itemtype) + 2;
case type of
begin
<* erroneous parameter - no action *>;
<* parameter list exhausted - finis *>
finis := true;
\f
<* 841009. SLICELIST rel. 1.0 page 21 *>
begin
<* the parameter is expected to be a filename *>
iaf := 0;
getzone6(z, ib);
for i := 1, 2, 3, 4 do
ib(i + 1) := items.iaf(i);
setzone6(z, ib);
if monitor(76)lookup head and tail:(z, i, entry) <> 0
then errormessage(2)
else
if entry(8) < 0
then errormessage(3)
else
begin
getzone6(z,ib);
for i := 2, 3, 4, 5 do
ib(i) := entry(i + 7);
setzone6(z,ib);
<* Get the addr. of the logical disc process
description.
*>
pda1(1) := monitor(4)process description:(z,0,ib);
if pda1(1) <> 0
then system(5,pda1(1),kind);
if pda1(1) = 0
then errormessage(4)
else
<* Check whether the process description describes
an RC82xx/RC83xx disc or not.
*>
if kind(1) <> 62 and kind(1) <> 6
then errormessage(6)
else
begin
<* Get the addr. of the physical disc
process description.
*>
system(5, pda1(1) + 10, pda2);
<* Get a part of the process description for the
logical disc.
*>
system(5, pda1(1) + 24, ldpd);
<* Get a part of the process description for the
physical disc.
*>
system(5, 28 + (if pda2(1) = 0 then pda1(1)
else pda2(1)), fdpd);
\f
<* 841009. SLICELIST rel. 1.0 page 22 *>
<* Get the chaintable for the actual disc. *>
system(5, ldpd(1), chaintable);
<* The retrived parts of the process descriptions
for the logical disc and for the physical disc
are:
logical disc
ldpd(1): +24: chaintable addr.
ldpd(2): +26: slicelength.
ldpd(3): +28: first segm. (on phys. disc)
ldpd(4): +30: number of segments.
physical disc
fdpd(1): +28: first segm.
fdpd(2): +30: number of segments.
fdpd(3): +32: segm. per track.
fdpd(4): +34: flags.
fdpd(5): +36: segm. per cylinder.
fdpd(6): +38: odd cylinder shift.
*>
slicelength := ldpd(2);
number_of_heads := if kind(1)=6 <*ida disc*> then 1 else fdpd(5)/fdpd(3);
<* The adjustment of number_of_heads made below
is performed only when the file is stored on
the fixed-head part of an RC8233 disc. It is
done to ensure that the computations of the
distribution of the slices on cylinders are per-
formed correct.(e.i. the fixed-head part of the
disc is wieved as a seperate disc with one sur-
face and one head.)
*>
if number_of_heads = 4 and ldpd(3) = 4
then number_of_heads := 1;
baf := 1;
writeentry(entry);
writeslices(entry, chaintable.baf);
if test
then testoutput;
end;
end;
end *** filename parameter ***;
\f
<* 790618. SLICELIST rel. 1.0 page 23 *>
<* the parameter is expected to be a modifier *>
if items(3) = yes or items(3) = no
then
begin
i := 0;
repeat
i := i + 1;
until i = 5 or items(1) = parameter(i,1) and
items(2) = parameter(i,2);
case i of
begin
cylinder := items(3) = yes;
segment := items(3) = yes;
slice := items(3) = yes;
test := items(3) = yes;
errormessage(5);
end;
end
else errormessage(5);
end *** case type of ***;
until finis;
\f
<* 81.08.10. SLICELIST rel. 1.0 page 24 *>
<* 5. Program termination.
_______________________
*>
outchar (out, 10);
if alternate_outfile
then termout(stack);
end \f
** program slicelist ***;
▶EOF◀