|
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: 3840 (0xf00)
Types: TextFile
Names: »hlmmasktx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦787c125fb⟧ »adjprocfile«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦787c125fb⟧ »adjprocfile«
└─⟦this⟧
; hlm_mask_tx * page 1 10 05 79, 10.36;
; hlm_mask
; ********
if listing.yes
char 10 12 10
hlm_mask = set 1
hlm_mask = algol
external long procedure hlm_mask
________________________________
_ (level, nmb, max_nmb, t0);
value level, nmb, t0;
integer level, nmb, max_nmb, t0;
comment
hlm_mask (call and return, long procedure)
is the position mask of a block with number nmb at level level in
Helmert binary blocking (nested dissection). The mask contains a 6
bit byte for each level, where the two least significant bits are
used for block 1 or 2 respectively.
level (call, integer)
Up to 8 levels (numbered 0-7) is possible. System alarm is given
if 0 <= level and level <= 7 is false.
nmb (call, integer)
The number of the block at the given level. The numbering is lexico-
graphic with least significant bytes moving fastest. The number is taken
modulo max_nmb. System alarm is given if nmb is <= 0.
max_nmb (return, integer)
The maximum number of blocks at the called level. Any number may be
given at call time, enabling the start of a loop. The correct value
will then be available after first call.
t0 (call, integer)
The number of masks at level 0. 1 or 2 are possible. Other
values give a system alarm.
ext. used.
____________
system(9)
nl, sp, write, in testoutput only
Prog.: Knud Poder, MAY 1979;
\f
comment hlm_mask_tx * page 2 10 05 79, 10.36
0 1 2 3 4 5 6 7 8 9 ;
_
comment test for valid params;
______________________________
if 0 <= level and level <= 7 and nmb > 0
_ and (t0 = 1 or t0 = 2) then
begin
comment ON TEST: : integer i;
integer lev, lev_shift, t_ex, t, t_max, ch;
long m;
long array mask(0:t0*(2 shift level - 1));
long array field m_f;
_
comment init of params;
_______________________
mask(0) := 0;
t_max :=
ch :=
m_f := 0;
_
comment level loop;
___________________
for lev := 0 step 1 until level do
begin
lev_shift := 42 - 6*lev;
comment ON TEST: :
write(out, nl, 3, <:level = :>, lev);
_
comment reset max blocks at level;
__________________________________
m_f := m_f + 4*t_max;
t_max := t0 shift lev;
if lev = level then
begin
max_nmb := t_max;
t_max :=
nmb := (nmb - 1) mod t_max + 1;
end;
\f
comment hlm_mask_tx * page 3 10 05 79, 10.36
0 1 2 3 4 5 6 7 8 9 ;
_
comment block loop at level;
____________________________
for t := 1 step 1 until t_max do
begin
t_ex := (t - 1) mod 2 + 1;
_
comment reset mask;
___________________
if false add t_ex then
begin
m := mask(ch);
ch := ch + 1;
end;
mask.m_f(t) := m + (extend t_ex) shift lev_shift;
comment ON TEST: :
write(out, nl, 1, <<ddddd>, t, sp, 5);
comment ON TEST: :
for i := 0 step 1 until 47 do
write(out, sp, if i mod 6 = 0 then 1 else 0,
if mask.m_f(t) shift i < 0 then <:x:> else <:.:>);
end t-loop;
end lev-loop;
hlm_mask := mask.m_f(nmb);
end acc params
else
if level < 0 or 7 < level then
<*level alarm*>
system(9)alarm:(level, <:<10>hlm_lev:>)
else
if nmb < 0 then
<*block_nr alarm*>
system(9)alarm:(nmb, <:<10>hlm_blk:>)
else
<*start nmb alarm*>
system(9)alarm:(t0, <:<10>hlm_strt:>);
end
if ok.no
mode warning.yes
if warning.yes
(mode 0.yes
message hlm_mask not ok
lookup hlm_mask)
end
finis
▶EOF◀