|
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: 1536 (0x600)
Types: TextFile
Names: »packmesst«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »packmesst«
packmess = algol list.yes
external
procedure pack_mess(mess);
real array mess;
begin
integer lower,upper,pack_index,part_one,part_two,part,
_ count,no_of_bytes,i;
lower := system(3,upper,mess);
no_of_bytes := mess(1) shift (-24) extract 16 + 2;
if no_of_bytes <= 2 * upper and no_of_bytes >= 16 then
upper := 1 + no_of_bytes // 4 - (if no_of_bytes mod 4 = 0 then
1 else 0);
count := 1;
i := 1;
for pack_index := 1 step 1 until upper do
begin
part_one := mess(pack_index) shift (-24) extract 16;
part_two := mess(pack_index) extract 16;
for part := part_one,part_two do
begin
mess(count) := mess(count) shift 16 add part;
i := i + 1;
if i > 3 then
begin
count := count + 1;
i := 1;
end;
end;
end;
mess(count) := mess(count) shift (case i of (48,32,16));
end pack_mess;
end
finis
▶EOF◀