|
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: 14592 (0x3900)
Types: TextFile
Names: »tcfexample «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »tcfexample «
CF-SYSTEM Programming example.
begin
comment
This an example of an algol 6 program which creates 2
master files: master_1 and master_2, and one listfile:
list.
2 chain groups: chain_1 and chain_2, are associated to
master_1 and list, and to master_2 and list respective-
ly.
A rudimentary description file: descrfile, sufficient
for the check of version numbers performed by the cf
protection system is also created.
Various functions are performed on the file configura-
tion.
;
procedure check_one;
comment gives a case alarm if result_cf <> 1;
case result_cf of begin end;
procedure printtime(text);
string text;
comment
prints the time consumed since last call;
begin
own boolean later_call;
own real cpubase, timebase;
real cpu, time;
if later_call then
begin
cpu:= systime(1, timebase, time) - cpubase;
write(out, <:<10>:>, text, <: in seconds, cpu::>,
<<dddd.dd>, cpu, <:, real::>, time);
end later_call
else later_call:= true;
cpubase:= systime(1, 0, timebase);
end printtime;
printtime(<::>); blocks_read:= 0;
begin
comment
block for creation of file heads;
integer
file_no,
fixed_rec_length,
i,
max_blocks,
max_bucks,
max_rec_length,
min_rec_length,
no_of_keys,
segs_per_block,
segs_per_buck;
integer array
chains(1:(2*4)),
rec_descr(1:4, 1:2),
size_l, size_m(1:4);
comment
initialize array chains:
chain group mother daughter chain type compr.key
1 1 100 headed see head_m
2 2 100 headed see head_m
;
for i:= 1 step 1 until 2*4 do
chains(i):= case i of(
1, 100, 1, 0,
2, 100, 1, 0);
comment
the fourth field in each line above, compressed keysize, is
initialized by head_m, and used by head_l.
(from the record description below it can be seen to be 8
bytes).
create the head of master_1;
file_no:= 1;
comment
initialize the record description:
keyfield type order address
1 long ascending 4
2 byte descending 11
3 word ascending 10
length fixed
;
no_of_keys:= 3;
for i:= 1 step 1 until (no_of_keys + 1) * 2 do
rec_descr((i+1)//2, 2-i mod 2):= case i of(
+3, 4,
-1, 11,
+2, 10,
0, 0);
comment
initialize size parameters;
size_m(1):= max_rec_length:= 120;
size_m(2):= max_bucks:= 100;
size_m(3):= segs_per_buck:= 40;
size_m(4):= segs_per_block:= 2;
comment
create the file head, the backing store area: master1,
must exist;
head_m(<:master1:>, file_no, chains, rec_descr, no_of_keys,
size_m);
comment
for simplicity, the same parameters are used for master_2;
file_no:= 2;
head_m(<:master2:>, file_no, chains, rec_descr, no_of_keys,
size_m);
comment
create the description file head;
file_no:= 1000;
comment
initialize the record description according to appendix E:
keyfield type order address
1 long ascending 12
2 long ascending 16
3 long ascending 20
length word - 2
;
no_of_keys:= 3;
for i:= 1 step 1 until (no_of_keys + 1) * 2 do
rec_descr((i+1)//2, 2 - i mod 2):= case i of(
+3, 12,
+3, 16,
+3, 20,
2, 2);
comment
initialize size_m, the description file is regarded as
being a small file;
size_m(1):= max_rec_length:= 100;
size_m(2):= max_bucks:= 50;
size_m(3):= segs_per_buck:= 10;
comment
never choose a smaller value for segs_per_buck;
size_m(4):= segs_per_block:= 1;
head_m(<:descrfile:>, file_no, chains, rec_descr, no_of_keys,
size_m);
comment
create the listfile head:
variable record length, minimum about 20 bytes;
file_no:= 100;
size_l(1):= fixed_rec_length:= 0;
size_l(2):= min_rec_length:= 20;
size_l(3):= segs_per_block:= 1;
size_l(4):= max_blocks:= 2000;
head_l(<:list:>, file_no, chains, size_l);
end block for the creation of file heads;
printtime(<:file heads created :>);
begin
comment
block for initialization of master files.
master_1, and master_2 are provided with a dummy record
having all fields equal to zero, because open_cf requires
that a master file contains at least one record.
the description file is initialized with 4 file description
records;
zone
zm1(buflength_cf(<:master1:>, 1), 3, stderror),
zm2(buflength_cf(<:master2:>, 1), 3, stderror),
zdescr(buflength_cf(<:descrfile:>, 1), 3, stderror);
integer
file_no;
integer field
descr_length;
long field
descr_key_1,
descr_key_2,
descr_key_3,
l_fld;
real array
rec(1:50);
comment
initialize the field variables for the description file;
descr_length:= 2;
descr_key_1:= 12;
descr_key_2:= 16;
descr_key_3:= 20;
comment
set all fields of array rec to zero;
for l_fld:= 4 step 4 until 200 do rec.l_fld:= 0;
comment
initialize master_1 with one record having all fields
equal to zero;
init_file_m(zm1, <:master1:>, 0, 1, 1);
init_rec_m(zm1, rec);
checkone;
comment
this procedure checks that result_cf was one, see the
procedure declaration at the beginning of the program;
close_cf(zm1, true);
comment
the same is done for master_2;
init_file_m(zm2, <:master2:>, 0, 1, 1);
init_rec_m(zm2, rec);
checkone;
close_cf(zm2, true);
comment
initialize the description file with 4 records, describing
the files including the description file itself;
init_file_m(zdescr, <:descrfile:>, 0, 1, 1);
for file_no:= 1, 2, 100, 1000 do
begin
comment
the file numbers of master_1, master_2, list, and
descr_file;
rec.descr_length:= 30;
rec.descr_key_1:= 2;
rec.descr_key_2:= file_no;
rec.descr_key_3:= 0;
init_rec_m(zdescr, rec);
checkone;
comment
the version numbers are zero in the description records as
well as in the catalog entries of the corresponding files,
if the files were created by set in this way:
master1= set 120, etc. just before the call of this
program;
end for file_no;
close_cf(zdescr, true);
comment
the list file needs no initialization;
end block for initialization;
printtime(<:files initialized :>);
begin
comment
block for processing of the file configuration:
200 records are inserted in both master files, at random
keys, and 1000 list records are connected to records
in both files via chain group 1 and chain group 2;
zone
zm1(buflength_cf(<:master1:>, 2) + 10*12//4, 3, stderror),
zm2(buflength_cf(<:master2:>, 2) + 10*12//4, 3, stderror),
zl(buflength_cf(<:list:>, 3) + 100//8, 4, stderror);
comment
the addition to buflength_cf provides for extra bufferlength
for extensions of the files during the processing: 10 extra
buckets for the master files, and 100 extra blocks for the
listfile.
the factor 12 in the expression for the master zone buffer
length is equal to compressed_keysize + 4, see appendix G;
integer
i,
ic_mode;
integer field
length,
m_key_3;
long field
l_fld;
real
chain_ref_1,
chain_ref_2;
real array
m_rec, l_rec(1:50);
procedure create_key;
comment
this procedure generates a pseudo random master key
in array m_rec;
begin
own integer ps_random;
random(ps_random);
m_rec.m_key_3:= ps_random mod 10000;
end create_key;
comment
initialize the field variables;
length:= 2; comment the length field of list records;
m_key_3:= 10; comment see the file head creation;
comment
this call provides the cf-system with the name of the
description file;
open_cf(zm1, <:master1:>, 0);
checkone;
open_cf(zm2, <:master2:>, 0);
checkone;
open_cf(zl, <:list:>, 0);
comment
the version numbers and the update marks have been checked,
and the zone states are read_only;
read_upd_cf(zm1);
read_upd_cf(zm2);
read_upd_cf(zl);
comment
now the zone states are read_update, insertions are allowed,
and the update marks are set in the catalog entries;
init_chain(zm1, zl, 1, chain_ref_1);
init_chain(zm2, zl, 2, chain_ref_2);
comment
the 2 chain groups are ready for processing, the chain_refs
are used to reference them;
for l_fld:= 4 step 4 until 200 do
m_rec.l_fld:= l_rec.l_fld:= 0;
for i:= 1 step 1 until 10 do
begin
comment
insert 200 master records in master_1, with random values
of keyfield 3, and the other fields equal to zero;
make_a_key:
create_key;
insert_m_rec:
insert_m(zm1, m_rec);
case result_cf of
begin
comment 1, ok, do nothing;
;
comment 2, record exists already, try another key;
goto make_a_key;
comment 3, not inserted, too expensive.
this is not possible when param_cf has not been used
to change the insertion parameters;
checkone;
comment 4, the file is full, extend the file with one
bucket = 40 segments;
begin
extend_cf(zm1, 40);
checkone;
goto insert_m_rec;
end 4;
comment 5, length error, not possible with fixed length;
checkone;
comment 6, no buffer, not possible because result_cf has
been checked after open_cf and extend_cf;
checkone
end case result_cf;
end insertion of 200 records in master_1;
comment
insert 200 records in master_2 in a more crude way;
for i:= 1 step 1 until 10 do
begin
create_key;
insert_m(zm2, m_rec);
case result_cf of
begin
comment 1, ok;
;
comment 2, exists already, repeat;
i:= i - 1
end case result_cf;
comment
other results will give a case alarm;
end insertion of 200 records in master_2;
printtime(<:master recs inserted:>);
for i:= 1 step 1 until 50 do
begin
comment
insert 1000 list records connected to random master
records.
the list records are clustered in chain group 1, i.e.,
insert_l works upon chain_ref_1;
create_key;
get_m(zm1, m_rec);
comment
the result is ignored, there will always be a current
record in a master file;
comment
insert a list record as the last in the chain_1 depar-
ting from the current master_1 record.
insertion as the first in chain is faster, but
it does not demonstrate the use of get_l;
get_l(zl, chain_ref_1, 1);
comment
read the first record in this chain, if any;
ic_mode:= if result_cf = 1 then 2 else 1;
comment
insert mode is next to last accessed, if there is any
record in the chain, else next to mother;
for i:= i while result_cf = 1 do get_l(zl, chain_ref_1, 2);
comment
read all records in the chain, last accessed in chain
group 1 is now the last in chain, if any;
l_rec.length:= 30;
insert_l_rec:
insert_l(zl, chain_ref_1, ic_mode, l_rec);
case result_cf of
begin
comment 1, ok, do nothing;
;
comment 2, fill limit exceeded, extend the file with
20 blocks = 20 segments;
begin
extend_the_file:
extend_cf(zl, 20);
checkone;
goto insert_l_rec;
end 2;
comment 3, length error;
checkone;
comment 4, no block can take this record;
goto extend_the_file
end case result_cf;
comment
connect the list record to a random master_2 record, as
first in chain;
create_key;
get_m(zm2, m_rec);
ic_mode:= 1; comment connect next to mother;
connect(zl, chain_ref_1, chain_ref_2, ic_mode);
checkone;
end insert 1000 list records;
comment
master_1 is not updated any more;
read_only_cf(zm1);
printtime(<:list recs inserted :>);
comment
go through all chains of chain group 2, at the same time
look up the master_1 record being the mother of the chain
1 passing through each list record, and at last delete the
list record.
the list records are counted, to check that all 1000 have
been deleted;
comment
master_2 is read by means of next_m, starting at the dummy
record created by init_rec_m;
m_rec.m_key_3:= 0;
get_m(zm2, m_rec);
checkone;
i:= 0;
for i:= i while result_cf = 1 do
begin
comment
read the first record in the chain_1 departing from the
current record of master_2;
get_l(zl, chain_ref_2, 1);
for i:= i while result_cf = 1 do
begin
get_head(zl, chain_ref_1, m_rec);
checkone;
comment
now m_rec contains the key of the record, which is the
mother of the chain_1 passing through the current list
record;
get_m(zm1, m_rec);
checkone;
comment
the calls of get_head and get_m above are performed
as a demonstration of how each list record acts as a
link between a record in master_2 and a record in mas-
ter_1;
delete_l(zl, chain_ref_2);
i:= i + 1;
comment
delete and count the list file record, delete will
access the next record in chain_2, if any;
end reading and deleting of one chain;
next_m(zm2);
comment
read the next master_2 record;
end reading of master_2;
if i <> 1000 then
write(out, <:<10>***error in count :>, i);
close_cf(zm1, true);
close_cf(zm2, true);
close_cf(zl, true);
end block for processing of file configuration;
printtime(<:list records deleted:>);
write(out, <:<10>blocks read: :>, blocks_read);
end program
▶EOF◀