|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 6144 (0x1800)
Types: TextFileVerbose
Names: »logmodule«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »logmodule«
procedure log(log_mess,dc_call);
value dc_call;
real array log_mess;
boolean dc_call;
begin
real array help_arr(1:max_mess_lgh + 1);
real array field pointer,lab_pointer;
integer array field buffer;
integer no_of_bytes,no_of_halfwords;
pointer := 4;
lab_pointer := 8;
buffer := wait(log_key_sem);
no_of_bytes := log_mess(1) shift (-32);
no_of_halfwords := if dc_call then (no_of_bytes + 12) / 3 * 2 else
_ (no_of_bytes - 6) / 3 * 2;
no_of_halfwords := no_of_halfwords + no_of_halfwords mod 2;
if dc_call then
begin
tofrom(help_arr.lab_pointer,log_mess,no_of_halfwords);
help_arr(1) := real(extend no_of_halfwords shift 24);
help_arr(2) := help_arr(5);
end
else
log_mess.pointer(1) := real(extend no_of_halfwords shift 24);
if no_of_halfwords > halfwords_available then
begin
if dc_call then outvar(z_log,help_arr)
else outvar(z_log,log_mess.pointer); <* dummy, to be sure that
_ the block is filled with
_ binary nulls *>
setposition(z_log,0,0);
swoprec6(z_log,max_block_no * 4);
z_log(current_block) := real(min_for_this_block);
current_block := current_block + 1;
setposition(z_log,0,current_block * segm_pr_block);
min_for_this_block := extend (-1) shift (-1);
if current_block > max_block_no then
begin
log_change_forced := true;
change_log_zone;
end
else
if current_block > warning_block_no then
begin
<* operator warning *>
end;
end;
halfwords_available := if dc_call then
outvar(z_log,help_arr)
else outvar(z_log,log_mess.pointer);
return_buf(buffer);
end log;
\f
procedure change_log_zone;
begin
integer i;
outvar(z_log,em_record);
if -, log_change_forced then
begin
setposition(z_log,0,0);
swoprec6(z_log,max_block_no * 4);
z_log(current_block) := real(min_for_this_block);
end;
close(z_log,true);
current_log_file := 3 - current_log_file;
open(z_log,4,case current_log_file of (<:disclog1:>,<:disclog2:>),0);
outrec6(z_log,max_block_no * 4);
for i := 1 step 1 until max_block_no do
z_log(i) := real (extend (-1));
setposition(z_log,0,segm_pr_block);
current_block := 1;
halfwords_available := 128 * 4 * segm_pr_block;
min_for_this_block := extend (-1) shift (-1);
end change_log_zone;
\f
procedure dump_log(tape_name);
real array tape_name;
begin
integer dump_log_file_no,i;
integer array field buffer;
zone z(128,1,stderror);
if log_change_forced then
log_change_forced := false
else
begin
buffer := wait(log_key_sem);
change_log_zone;
return_buf(buffer);
end;
dump_log_file_no := 3 - current_log_file;
i := 1;
open(z,4,<:dumplogjob:>,0);
write(z,<:jobkort:>,"nl",1,<:dumplogbin name.:>,
string tape_name(increase(i)),<: logno.:>,<<d>,dump_log_file_no,
<: maxblock.:>,<<zd>,max_block_no,<: segm.:>,segm_pr_block,
"nl",1,<:finis:>,"nl",1,"em",3);
close(z,true);
<* newjob(<:dumplogjob:>); *>
end dump_log;
\f
procedure log_handler;
begin
zone z_in(20,1,da_std_error);
integer input_stream,no_of_hwords,op_code;
long array in_proc_name(1:2);
input_stream := 17;
inproc_name(1) := long <:strea:> add 'm';
inproc_name(2) := long <:in:>;
initzone(z_in,0,in_proc_name,0,3 shift 12 + input_stream,0);
repeat
sendbuffer(z_in,80);
no_of_hwords := getbuffer(z_in);
if no_of_hwords < 1 then
<* troubles *>
else
begin
op_code := read_ch(z_in,11);
if op_code <> 0 shift 4 + 0 then
begin
<* error - no log message *>
end
else
log(z_in,false);
end
until false;
end log_handler;
\f
procedure print_log(doc_name,from_time,to_time,sender,
receiver,op_code);
real array doc_name;
long from_time,to_time,sender,receiver;
integer op_code;
begin
<* The procedure starts the log-printer program.
*>
zone z(128,1,stderror);
integer i;
open(z,4,<:printlogjob:>,0);
i := 1;
write(z,<:jobkort:>,"nl",1,
<:message printlog begin:>,"nl",1,
<:printlogbin maxblock.:>,<<zd>,max_block_no,
<: segm.:>,segm_pr_block,"nl",1,
if doc_name(1) = real <:disc:> then case current_log_file of (
<:disclog1:>,<:disclog2:>) else string doc_name(increase(i)),"sp",1,
from_time,"sp",1,to_time,"nl",1,sender,"sp",1,receiver,"nl",1,
op_code,"nl",1,<:finis:>,"nl",1,"em",3);
close(z,true);
<* newjob(<:printlogjob:>); *>
end print_log;
«eof»