DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »logmodule«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »logmodule« 

TextFile

      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◀