|
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: 6912 (0x1b00)
Types: TextFile
Names: »printlogtx«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »printlogtx«
begin
integer segm_pr_block,max_block;
segm_pr_block := læs_fp_tal(<:segm:>);
max_block := læs_fp_tal(<:maxblock:>);
begin
zone z_in(128 * segm_pr_block,1,tapeerror),
_ z_out(128,1,stderror),
_ block_descr(max_block,1,tape_error);
real array doc_name(1:2);
real array field mess;
long field time;
long from_time,to_time,sender,receiver;
integer array field data;
integer op_code,i,block_count,line_no,old_left,new_left,mess_lgh;
boolean tape_mode,block_change;
procedure header(z);
zone z;
begin
own integer page_no;
own long print_date;
own boolean called_before;
if -, called_before then
begin
print_date := convtime(getclock);
called_before := true;
end;
page_no := page_no + 1;
write(z,"ff",1,<:UDSKRIFT AF LOG:>,"sp",10,<:19:>,<<dd dd dd>,
print_date shift (-24),<:-:>,print_date extract 24,"sp",17,<:Side :>,
<<ddd>,page_no,"nl",1,"-",69,"nl",2,
<:DATO:>,"sp",7,<:KLOKKEN:>,"sp",3,<:MODTAGER:>,"sp",6,
<:AFSENDER:>,"sp",6,<:KODE:>,"sp",3,<:DATA:>,"nl",1);
end header;
procedure tape_error(z,s,b);
zone z;
integer s,b;
begin
if -, tape_mode then stderror(z,s,b);
if s shift (-22) extract 1 = 1 then error(1) else
if s shift (-7) extract 1 = 1 then error(2) else stderror(z,s,b);
close(z,true);
goto after_tape_error;
end tape_error;
procedure error(no);
integer no;
begin
write(out,"nl",1,case no of (
<:paritetsfejl på bånd:>,
<:"worddefect" på bånd:>),
"sp",4,<:print ikke udført:>,"nl",1);
end error;
readstring(in,doc_name,1);
read(in,from_time,to_time,sender,receiver,op_code);
if to_time = 0 then to_time := extend (-1) shift (-1);
line_no := 80;
mess := time := 8;
data := 0;
tape_mode := doc_name(1) <> real <:discl:> add 'o';
i := 1;
open(block_descr,if tape_mode then 18 else 4,
string doc_name(increase(i)),0);
setposition(block_descr,1,0);
inrec6(block_descr,max_block * 4);
open(z_out,4,<:logprintfil:>,0);
i := 1;
open(z_in,if tape_mode then 18 else 4,
string doc_name(increase(i)),0);
replacechar(1 <* space in number *>, '.');
for block_count := 1 step 1 until max_block do
begin
if block_descr(block_count) <> real (extend (-1)) then
begin
if to_time >= long block_descr(block_count) then
begin
setposition(z_in,1,block_count * (if tape_mode then
1 else segm_pr_block));
old_left := segm_pr_block * 4;
repeat
new_left := invar(z_in);
block_change := new_left > old_left;
if -, block_change then
begin
old_left := new_left;
if z_in.time >= from_time and z_in.time <= to_time then
begin
unpack_mess(z_in.mess);
mess_lgh := (z_in.mess.data(1) + 2) // 2;
if sender = 0 or sender = extend
z_in.mess.data(4) shift 24 add z_in.mess.data(5) then
begin
if receiver = 0 or receiver = extend
z_in.mess.data(2) shift 24 add
z_in.mess.data(3) then
begin
if op_code = 0 or op_code =
z_in.mess.data(6) shift (-8) then
begin
line_no := line_no + 1;
if line_no > 39 then
begin
header(z_out);
line_no := 0;
end;
write(z_out,"nl",1,<: 19:>,<<zd dd dd>,
convtime(z_in.time) shift (-24),"sp",1,
convtime(z_in.time) extract 24,"sp",2,<<z>,
z_in.mess.data(2) shift (-12),"-",1,<<zd>,
z_in.mess.data(2) shift (-6) extract 6,"-",1,
z_in.mess.data(2) extract 6,"-",1,<<zddd>,
z_in.mess.data(3),"sp",2,<<z>,
z_in.mess.data(4) shift (-12),"-",1,<<zd>,
z_in.mess.data(4) shift (-6) extract 6,"-",1,
z_in.mess.data(4) extract 6,"-",1,<<zddd>,
z_in.mess.data(5),"sp",2,<<zd>,
z_in.mess.data(6) shift (-12),".",1,
z_in.mess.data(6) shift (-8) extract 4,"sp",2);
i := 9;
for i := i + 1 while i <= mess_lgh do
begin
write(zout,<<ddddd>,z_in.mess.data(i),
"sp",2,<<dd>,z_in.mess.data(i) shift (-8)
extract 8,"sp",1,z_in.mess.data(i) extract 8);
if i < mess_lgh then
begin
line_no := line_no + 1;
if line_no > 39 then
begin
header(zout);
line_no := 0;
end;
write(z_out,"nl",1,"sp"57);
end;
end;
end;
end;
end;
end;
end
until block_change;
end;
end;
end;
setposition(z_in,-1,0);
after_tape_error:
close(z_in,true);
close(block_descr,true);
write(z_out,"ff",1,"em",3);
close(z_out,true);
<* convert(<:logprintfil:>); *>
end;
end
▶EOF◀