{ Modulo Cadriver
{ This module contains routines for performing camac operation (read
{ and write ) ,camac_initialize and create device. 
{ 				Version 0.1
{				Author G.Sanzani  Bologna
{				
{				version 1.1 F Ronga 1 Sept 1989
{				new CAMAC_LIST instructions
{}
{ Versione VME.                                        Oct 1993
{}

	interrupt_service camac_isr(camac_reg_pointer : ^word16;
                                    int_com:^isr_region);

{ This routine is called by the system each time a trigger occurs }
{}
var
 	dat : word16;
        save_register:word16;
{}
        begin
         signal_device;
	end;



{----------Routine DMA temporanea -------------------}


        interrupt_service dma_int
			(dma_reg_pointer : ^word16;
                                    dma_com:^isr_region);

        begin
         signal_device;
	end;


{---------------------------------------------------------------------}

	interrupt_service alarm_isr(alarm_reg_pointer:^word16;
				  alarm_com:^alarm_region);

{ this is called when an alarm (EXT int 2) occurs}
{}
        begin
         signal_device;
	end;


{---------------------------------------------------------------------}
procedure set_veto;

var
	camdata : word16;
begin
	if veto_present then
	begin
	  if (setveto.testop) then
		eln$camac_short_read(setveto.veto_add,camdata)
          else    
		eln$camac_short_write(setveto.veto_add,setveto.data.low);
	end;
end;	

{---------------------------------------------------------------------}
procedure reset_veto;

var
	camdata : word16;
begin
	if veto_present then
	begin
	  if (resveto.testop) then
		eln$camac_short_read(resveto.veto_add,camdata)
          else    
		eln$camac_short_write(resveto.veto_add,resveto.data.low);
	end;
end;

{---------------------------------------------------------------------}
procedure ss_set_veto;

var
	camdata : word16;
	cam_addr : ^word16;
	camdata_ptr : ^word16;
	istat	: integer;
begin
	if veto_present then
	begin
          setveto.veto_add.opl:=1;
	  cam_addr::integer := base_ptr::integer + setveto.veto_add.full;
	  new(camdata_ptr);
	  if (setveto.testop) then
	     begin	
                kav$bus_read(status := istat,
                        data_type := kav$k_word,
                        virtual_address := cam_addr,
                        buffer := camdata_ptr,
                        count := 1);
                if not odd(istat) then
                        writeln('%ERROR while setting VETO-Code ',hex(istat));
              end
          else    
              begin
		camdata_ptr^:=camdata;
                kav$bus_write(status := istat,
                        data_type := kav$k_word,
                        virtual_address := cam_addr,
                        buffer := camdata_ptr,
                        count := 1);
	      end;	

	  dispose(camdata_ptr);
	end;
end;	

{---------------------------------------------------------------------}
procedure ss_reset_veto;

var
	camdata : word16;
	cam_addr : ^word16;
	camdata_ptr : ^word16;
	istat	: integer;
begin
	if veto_present then
	begin
	  new(camdata_ptr);
          resveto.veto_add.opl:=1;
	  cam_addr::integer := base_ptr::integer + resveto.veto_add.full;
	  if (resveto.testop) then
	     begin	
                kav$bus_read(status := istat,
                        data_type := kav$k_word,
                        virtual_address := cam_addr,
                        buffer := camdata_ptr,
                        count := 1);
                if not odd(istat) then
                        writeln('%ERROR while RE-setting VETO-Code ',
							hex(istat));
              end
          else    
              begin
		camdata_ptr^ :=camdata;
                kav$bus_write(status := istat,
                        data_type := kav$k_word,
                        virtual_address := cam_addr,
                        buffer := camdata_ptr,
                        count := 1);
	      end;	
	  dispose(camdata_ptr);
	end;
end;

{---------------------------------------------------------------------}

procedure eln$camac_create_device (var status1 : integer;
                         var   status2 : integer;
                         var   status3 : integer) ;
 var 
       ipl: integer;
       vector : integer;
begin

{ This routine must be called before each operation with the camac.
{ It creates the devices (three one for camac ,one for amc,one for alarms)}

         create_device('ACQU',
                      acq_device,
                      vector_number:=1,
                      priority:=ipl,
                      service_routine:=camac_isr,
                      region:= int_com,
                      registers := camac_reg_pointer,
                      status:=status1);

{ creo device for dma transfer}

         create_device('VDMA',
                      amc_device,
                      vector_number:=1,
                      service_routine:=dma_int,
                      region:= dma_com,
                      registers := dma_reg_pointer,
                      status:=status2);
	one_second:=time_value('0000 00:00:01.00');{set timeout for amc oper}

          create_device('ALRM',
                      alarm_device,
                      vector_number:=1,
                      service_routine:=alarm_isr,
                      region:= alarm_com,
                      registers := alarm_reg_pointer,
                      status:=status3);
end;

{------------------------------------------------------------------------}


procedure kav_map (var status4 :integer ) ;

var	entry	   : integer;

	begin
		kav$out_map(status := status4,
			entry := entry,
			page_count := 32,
			bus_address := %x800000,
			virtual_address := base_ptr,
			am_code := kav$k_user_24,
			map_functions := kav$m_vme+kav$m_mode_2_swap);
	

	
end;


{------------------------------------------------------------------------}

procedure kav_in_map (var point_buffer:^anytype; st_entry :integer;
			var status :integer ) ;

	begin
		kav$in_map(status := status,
			entry :=st_entry*8,  
			page_count :=8,
			virtual_address:=point_buffer,
			map_functions:=kav$m_memory+kav$m_mode_2_swap);
	end;


{------------------------------------------------------------------------}

procedure kav_unmap (var point_buffer:^anytype; st_entry:integer;
			var status :integer ) ;

	begin
		kav$in_map(status := status,
			entry:=st_entry*8,  
			page_count:=8,
			virtual_address:=point_buffer,
			map_functions:=kav$m_memory);
	end;


{------------------------------------------------------------------------}

procedure eln$camac_initialize ;

{ These routine is only preliminary and must be modified for a general reset
of the system.
}
 
var	int_mask,istat : integer;
	csrreg: ces8210_csr;
	camadd : camac_addr;
	unit,ch : integer;
begin



{ Enable interrupt in CPU module }
	int_mask:=%x34; {Allow interrupt 2,4 and 5}
	kav$vme_setup(status:=istat,
			setup_functions:=kav$k_allow_vme_irq,
			buffer:=int_mask);

	if (not odd(istat)) then
	begin
	 lock_mutex(write_mutex);
 	 writeln ('Error while enabling IRQ ') ;
 	 unlock_mutex(write_mutex);
	end;		

	kav$vme_setup(status:=istat,
		      setup_functions := kav$k_rd_a24_rotary,
		      buffer:= rotary_add);

        rotary_add:=rotary_add*1048576;
		


{ Load CSR address in csr_add common variable}

	csr_add.full := %xE802; 

	itcadd.full:=0;
	itcadd.n:=29;
	itcadd.a:=1;
	itcadd.f:=8;

	itdadd.full:=2;
	itdadd.n:=29;
	itdadd.a:=1;
	itdadd.f:=8;

{ Branch enabled to receive interrupt }
	int_branch := 1;

	unit:=3;
	cdset(ch,unit);
	base_ptr:=camac^.CBD_space::^word16;	

	vic_initialize;

end;



{--------------------------------------------------------------------------}
                                                                             
procedure read_w ( vme_b : camac_B ;                                         
                    mloc : integer ;                                         
                    var dat : word16 );                                      
                                                                             
var                                                                          
        w_ptr : ^word16;                                                     
                                                                             
        begin                                                                
                w_ptr::integer := vic_base_add[vme_b]::integer + mloc;       
                dat := w_ptr^ ;                                              
        end;                                                                 
{}                                                                           
                                                                             
                                                                             
{------------------------------------------------------------------------}   
                                                                             
                                                                                
procedure write_lw ( vme_b : camac_b ;                            
                     mloc : integer ;                                           
                     dat : word32 );                                            
var
        longw_ptr : ^word32;                

        begin                                                                   
                longw_ptr::integer := vic_base_add[vme_b]::integer + mloc; 
                longw_ptr^ := dat;                                              
        end;                                                                    
{}                                                                              
                                                                                
{--------------------------------------------------------------------------}

                                                                             
procedure read_lw ( vme_b : camac_B ;                                          
                    mloc : integer ;                                         
                    var dat : word32 );                                      

var
        longw_ptr : ^word32;                

        begin                                                                
                longw_ptr::integer := vic_base_add[vme_b]::integer + mloc;      
                dat := longw_ptr^ ;                                          
        end;                                                                 
{}                                                                         
  
                                                                             
{------------------------------------------------------------------------}

procedure vic_initialize ;

{ These routine is only preliminary and must be modified for a general reset
of the system.
}


var		base_ptr_x,buf32_ptr : ^word32;
		istat,entry,locmem,i,datal : integer;
		vicb : camac_B;
		add_ptr : ^anytype;
                online : word32;                                            
                boolean_reg : packed array [1..32] of boolean;              
                ipg,iipg : integer;

begin

{ Now map only VIC branch 1  }

		vicb := 1; 

{}
                kav$out_map(status := istat,                                
                        entry := entry,                                     
                        page_count := 16,                                   
                        bus_address := %x300000,                            
                        virtual_address := base_ptr_x,                      
                        am_code := kav$k_user_24,                           
                        map_functions := kav$m_vme+kav$m_mode_3_swap);      
 
                 if not odd(istat) then                                      
                        begin                                               
			  lock_mutex(write_mutex);
                          writeln(' VIC map  error',hex(istat));
 			  unlock_mutex(write_mutex);
                       end;                                                
                vic_base_add[vicb]:= base_ptr_x;                



                add_ptr::integer := vic_base_add[vicb]::integer+dev0ct;            

		new(buf32_ptr);
                buf32_ptr^:=0;                                              
                kav$bus_write(status := istat,                              
                        data_type := kav$k_longword,                        
                        virtual_address := add_ptr,                         
                        buffer := buf32_ptr,                                
                        count := 1);                                        
                                                                            
               if odd(istat) then  {VIC present }
                begin                                               
		
                write_lw (vicb, dev0ct, 0) ;                  
                read_lw (vicb, dev0ct, datal) ;               
                write_lw (vicb, dev0ct, 1) ;                  
                write_lw (vicb, dev0ct, 0) ;                  
                write_lw (vicb, dev0ct, 0) ;                  
                write_lw (vicb, dev0ct, 1) ;                  
                write_lw (vicb, dev0ct, 0) ;                  
                                                           
                write_lw (vicb, dev1ct, 0) ;                  
                read_lw (vicb, dev1ct, datal) ;               
                write_lw (vicb, dev1ct, 1) ;                  
                write_lw (vicb, dev1ct, 0) ;                  
                write_lw (vicb, dev1ct, 0) ;                  
                write_lw (vicb, dev1ct, 1) ;                  
                                                           
	
{ init vic }

               read_lw (vicb, dev0ct, datal );             
               write_lw (vicb, dev0ct , %x20 ) ;           
               write_lw (vicb, dev0ct , %x00 ) ;           
               write_lw (vicb, dev0ct , %x22 ) ;           
               write_lw (vicb, dev0ct , %xfc ) ;           
               write_lw (vicb, dev0ct , %x23 ) ;           
               write_lw (vicb, dev0ct , %x00 ) ;           
               write_lw (vicb, dev0ct , %x24 ) ;           
               write_lw (vicb, dev0ct , %x00 ) ;           
               write_lw (vicb, dev0ct , %x28 ) ;           
               write_lw (vicb, dev0ct , %x00 ) ;           
               write_lw (vicb, dev0ct , %x2a ) ;           
               write_lw (vicb, dev0ct , %xf0 ) ;           
               write_lw (vicb, dev0ct , %x2b ) ;           
               write_lw (vicb, dev0ct , %xff ) ;           
               write_lw (vicb, dev0ct , %x05 ) ;           
               write_lw (vicb, dev0ct , %x00 ) ;           
               write_lw (vicb, dev0ct , %x06 ) ;           
               write_lw (vicb, dev0ct , %x0f ) ;           
               write_lw (vicb, dev0a , %x01 ) ;            
               write_lw (vicb, dev0ct , %x01 ) ;           
               write_lw (vicb, dev0ct , %x94 ) ;           

                read_lw (vicb, dev1ct, datal );                     
                write_lw (vicb, dev1ct , %x20 ) ;                   
                write_lw (vicb, dev1ct , %x00 ) ;                   
                write_lw (vicb, dev1ct , %x22 ) ;                   
                write_lw (vicb, dev1ct , %x00 ) ;                   
                write_lw (vicb, dev1ct , %x23 ) ;                   
                write_lw (vicb, dev1ct , %x00 ) ;                   
                write_lw (vicb, dev1ct , %x24 ) ;                   
                write_lw (vicb, dev1ct , %x00 ) ;                   
                write_lw (vicb, dev1ct , %x28 ) ;                   
                write_lw (vicb, dev1ct , %x00 ) ;                   
                write_lw (vicb, dev1ct , %x2a ) ;                   
                write_lw (vicb, dev1ct , %x00 ) ;                   
                write_lw (vicb, dev1ct , %x2b ) ;                   
                write_lw (vicb, dev1ct , %xff ) ;                   
                write_lw (vicb, dev1ct , %x05 ) ;                   
                write_lw (vicb, dev1ct , %x0f ) ;                   
                write_lw (vicb, dev1ct , %x06 ) ;                   
                write_lw (vicb, dev1ct , %x00 ) ;                   
                write_lw (vicb, dev1a , %x00 ) ;                    
                write_lw (vicb, dev1c , %x00 ) ;                    
                write_lw (vicb, dev1ct , %x01 ) ;                   

                write_lw (vicb, dev1ct , %x94 ) ;                    
                                                                    
                locmem := %x20000;              {mmu start address} 
                for i:=1 to 32768 do                                
                        begin                                       
                        write_lw (vicb, locmem , 0 );                
                        locmem:= locmem + 4 ;                       
                        end;                                        
                                                                    
                                                                    
                write_lw (vicb, dev1c , %x0D ) ;                     

	{ Set to 0 VIC page mapped table}                       
        	for i:=1 to 3 do begin                          
         	   npg_mapped[i]:=0;                             
        	end;                                            
        	npg_mapped_st:=0;                               

        	for i:=1 to 3 do begin                          
         	   master_virt_base_add_st[i]::integer:=0;
        	end;                                            

{ ...Added Surdo Dec 93 ....(to allow access from ELN_VMS_SERVER)}

      lock_area(save_vic_data,vic_data_p^.lock_vic);
       vic_data_p^.init_vic[1] := true;
       vic_data_p^.vic_base[1] := vic_base_add[1];
       for i := 1 to 3 do begin
         vic_data_p^.npg_maps[i] := npg_mapped[i];
         for ipg := 1 to 16 do begin
           iipg:=(i-1)*%x10 + ipg;
           vic_data_p^.vic_adds[iipg]::integer := 0;
         end;
       end;
       vic_data_p^.npg_map_st := npg_mapped_st;
       for ipg := 1 to 5 do
         vic_data_p^.vic_add_st[ipg]::integer := 0;
       for i := 1 to 3 do
         vic_data_p^.mast_adds[i] := master_virt_base_add_st[i];
      unlock_area(save_vic_data,vic_data_p^.lock_vic);

{.................................}

 { Read online crates }                                                        
                                                                               


                add_ptr::integer := vic_base_add[vicb]::integer+online_reg;    

                kav$bus_read(status := istat,                              
                        data_type := kav$k_longword,                        
                        virtual_address := add_ptr,                         
                        buffer := buf32_ptr,                                
                        count := 1);                                        

               if odd(istat) then  {Crates present }
		begin
	 	  online := buf32_ptr^;

                  boolean_reg::byte_data:=online::byte_data;       

	          writeln('*** VME   Branch #',vicb,
				' :  Status = ON-LINE');
                  for i:= 2 to 16 do begin              
                    if(boolean_reg[i]) then                                     
                     begin                                                     
                       write_lw (vicb, csrr+(4*(i-1)) , %x800) ;              
                       lock_mutex(write_mutex);                                
                       writeln('          Crate  #',i-1,                 
                                ' :  Status = ON-LINE');                        
                       unlock_mutex(write_mutex);                              
                     end                                                       
                   end;   {of for}
                                  
	        end
	      else
		begin
                  lock_mutex(write_mutex);                                
		  writeln('          All Crates : Status = OFF ');
                  unlock_mutex(write_mutex);                                
                end;

	      end;  {of VIC present test}


end;




{---------------------------------------------------------------------}

procedure eln$camac_short_write( var coded_BCNAF: camac_addr;
                                cam_data : word16  );

{        perform a short write operation  on camac  (16 bits)      }
{        cam_data  camac word data  }

var	cam_addr  : ^word16 ;

begin
	
	coded_BCNAF.opl:=1;
	cam_addr::integer 
		:= base_ptr::integer + coded_BCNAF.full;
	cam_addr^ := cam_data ;

end;   


{-----------------------------------------------------------------------}

procedure eln$camac_long_write( var coded_BCNAF: camac_addr;
	                         cam_data : integer  );


{      eln$camac_long_write : perform a long write operation on camac . }
{      cam_data :  camac integer data  					}



var	tmp_data : record
		     w1 : word16;
		     w2 : word16;
                   end;

	cam_addr_1 : ^word16 ;
	cam_addr_2 : ^word16 ;
begin

	coded_BCNAF.opl:=0;

	cam_addr_2::integer 
		:= base_ptr::integer + coded_BCNAF.full ;
	cam_addr_1::integer := cam_addr_2::integer + 2;
	tmp_data::byte_data(4) := cam_data::byte_data(4) ;
	cam_addr_2^ := tmp_data.w2 ;
	cam_addr_1^ := tmp_data.w1 ;

end;

{--------------------------------------------------------------------}

procedure eln$camac_short_read( var coded_BCNAF : camac_addr;
                    	   var  cam_data : word16  );

{  eln$camac_short_read :  perform a short read  operation	   } 
{                          on camac			           }
{        cam_data  camac word data  (optional for command operations)  }

var	cam_addr  : ^word16 ;

begin
	coded_BCNAF.opl:=1;
	cam_addr::integer := 
		base_ptr::integer + coded_BCNAF.full;
	cam_data := cam_addr^;
end; 


{-------------------------------------------------------------------}

procedure eln$camac_long_read ( var coded_BCNAF : camac_addr;
	                    var  cam_data : integer  );

{      eln$camac_long_read : perform a long read  operation        }
{      on camac .                                                  }
{        cam_data  camac integer data  (optional for command operations)}

var	tmp_data : record
		     w1 : word16;
		     w2 : word16;
                   end;

	cam_addr_1 : ^word16 ;
	cam_addr_2 : ^word16 ;
begin

	coded_BCNAF.opl:=0;
	cam_addr_2::integer := 
		base_ptr::integer + coded_BCNAF.full;
	cam_addr_1::integer := cam_addr_2::integer + 2;
	tmp_data.w2 := cam_addr_2^ ;
	tmp_data.w1 := cam_addr_1^ ;
	cam_data::byte_data(4) := tmp_data::byte_data(4) ;

end;

{---------------------------------------------------------------------}

procedure eln$camac_status ( B : camac_B;
			 var Q : boolean );

{ read csr to give Q response }

var     camadd     : camac_addr;
        packed_csr : ces8210_csr;
{}
              begin

	       camadd.b:=B;
	       camadd.c:=0;
	       camadd.n:=29;
	       camadd.a:=0;
	       camadd.f:=0;

               eln$camac_short_read(camadd,packed_csr.full);
               Q:=packed_csr.Q;
              end;

{--------------------------------------------------------------------}

procedure eln$camac_block_read (point:^camac_list) ;

{ Read of a block of camac addresses (camac list) until the pointer is nil.
{ Some explanations are in camacprocedure.pas
{}
type
     	rec_received=record
			wd: word16;
	                len_rec:word16;
			w1: array [1..1000] of word16;
	end;
  

type	pack_byte = packed record
		case integer of
		  0: (low : byte;
		      high: byte);
		  1: (full:word16);
		end;			

        bit32 = packed array [0..31] of boolean;

var 	rec: ^rec_received;
    	fil: file of rec_received;
        jin: integer;

        dt,select_register,oplen : word16 ;
	temp_dt,vme_add:camac_word_32;
        satisfier,stat,num_add,length_equip_index,i:integer; 
	Q_response : word16;
	Q_test : boolean;
        boolean_index,bit_set,count,start_ev:integer;
        save_select_pointer:^camac_list;
        boolean_register: packed array [1..16] of boolean;
        data_rec:varying_string(80);
	data_file: file of varying_string(80);
        found_eof:boolean:=false;
        iindex:integer;
        ends:boolean;
	x_string:varying_string(80);
	y_string:varying_string(80);

	idigit : array [1..6] of integer ;
	ilen,ipot,j,k,byte_word : integer ;
        chnum : string(1); 

        first_time,second_time : large_integer;
        diff_time  : time_record;
        total_hs : integer;

{ New for VME version }
	camaddr   : ^word16;
	tmp_data,irr_stat,isr_stat :  word16;
	branch : camac_B;

	camaddr_1 : ^word16 ;
	camaddr_2 : ^word16 ;
	tmp_it    : ^word16;

	tmp_24 : camac_word_32;
	dma_n_word  : integer;

	adrp_add : ^word16;
        save_loop_ptr: ^camac_list;
        last_loop, num_of_loop:integer;

	tmp_16 : pack_byte;		
	tmp_32 : pack_int;
	tmp_mem_add : ^word16;
	tmp_l_mem_add : ^word32;
	tmp_buf_ptr : ^integer;
	tmp_buf_p   : ^word16;

        remain,limit,start,tlast,tnow,t : integer;
        wfd_base_add  : ^word32;
        wfd_creg_add  : ^word32;
        wfd_dac_add   : ^word32;
        wfd_end_add   : ^word32;
        wfd_stop_add  : ^word32;
        wfd_quit_add  : ^word32;
        wfd_address   : ^word32;
        wfd_addr_d    : ^word32;
        wfd_addr_t    : ^word32;
        wfd_len_ptr   : ^word32;
        indx          : integer;
        limaddr,numchan       : integer;
        bitson        : integer;
    { added declaration for eqp_start ... APS 2/21/95}
        eqp_start     : integer;
        ism, ichan, iend: integer;
        ival : packed record
               case integer of
                  0: ( b3 : byte;
                       b2 : byte;
                       b1 : byte;
                       b0 : byte );
                  1: ( full : integer );
               end;

	saved_next_equip : ^camac_list;
	saved_evt_word,saved_eqp_word : integer;

{}	

function list_exception of type exception_handler;

var
	error_string : varying_string(255);
	tvar : large_integer;
        old_csr,old_fusu : word16;
        temp_data,save_register : integer2;
	stat : integer;
	ret_add : camac_addr;
	newfp : ^integer;
	ustat : integer;
	no_back_error: boolean;

begin
        no_back_error:=false;
	eln$get_status_text(signal_args.name,[],error_string);
         lock_mutex(write_mutex);
          get_time(tvar);
          writeln (time_string(tvar),' ',error_string) ;
          unlock_mutex(write_mutex);
          data[id]^.event_error_code := signal_args.name; {camac error}{ FR }

	if   (signal_args.name=no_q_response) then
           begin
            cam_error_flag:=true;
            ret_add.full := signal_args.additional[1];
            old_csr := ret_add.b*2048+ret_add.c*256+ret_add.n;
            old_fusu := ret_add.a*32+ret_add.f+1;
            signal_args.additional[1] := old_csr;
            if (noqindex<=1000) then
              begin
               noqindex:=noqindex+1;
               no_q_buffer[noqindex]:=old_csr;
               noqindex:=noqindex+1;
               no_q_buffer[noqindex]:=old_fusu;
              end;
            lock_mutex(write_mutex);
            writeln ('>>> Last camac operation on br. ',ret_add.b:3,
                     ' cr. ',ret_add.c:3,' st. ',ret_add.n:3);
            unlock_mutex(write_mutex);
           end

	else if (signal_args.name=amc_fail) then
          begin
            cam_error_flag:=true;
            if (noqindex<=1000) then
             begin
              noqindex:=noqindex+1;
              no_q_buffer[noqindex]:=signal_args.additional[1]; {dma branch #}
              noqindex:=noqindex+1;
              no_q_buffer[noqindex]:=signal_args.additional[2]; {isr status}
             end;
            lock_mutex(write_mutex);
           writeln(' in the readout of equipment # ',
                        signal_args.additional[3]:4);
            writeln(' >>> DMA fail, isr register = ',
                                hex(signal_args.additional[2]),
                    ' on branch ',signal_args.additional[1]:2);
            unlock_mutex(write_mutex);
            end

	else if (signal_args.name=amc_timeou) then
          begin
            cam_error_flag:=true;
            if (noqindex<=1000) then
             begin
              noqindex:=noqindex+1;
              no_q_buffer[noqindex]:=signal_args.additional[1]; {dma branch #}
              noqindex:=noqindex+1;
              no_q_buffer[noqindex]:=signal_args.additional[2]; {irr register}
             end;
            lock_mutex(write_mutex);
            writeln(' in the readout of equipment # ',
                        signal_args.additional[3]:4);
            writeln(' AMC timeout on branch ', signal_args.additional[1]:2,
                     'IRR register = ',hex(signal_args.additional[2]));
            unlock_mutex(write_mutex);
          end                                                               

	else
         begin
		no_back_error := true;    
		lock_mutex(write_mutex);
	        writeln ('>>> Hardware error executing EQUIP # ',
			saved_next_equip^.data_to_write.low);
		unlock_mutex(write_mutex);
		point:=saved_next_equip^.next_equip;{jump to the next equipment}
	       	evt_word:=saved_evt_word;
		eqp_word:=saved_eqp_word;
	end;

{ notify errors to VMS }                                                 
 	with  notify_data^ do                                       
 	 begin                                                      
 	   	alarm_csr_register := signal_args.additional[1];    
 		alarm_error_code  := signal_args.name; 
        		len_alarm_record  := 8;   
  	 end {of with};                   
       	sendrecord(90,net_server);    
{}

       	list_exception:=TRUE;
	
{ Hardware errors need goto ?}
          
	if (no_back_error) then
		goto again;	
end;

	
begin
	     establish(list_exception);
 
 again:      while (point<>nil ) do begin
              case point^.mode_operation of {see camac procedure}



{ Short Read  -------------------------------------------------------------}

0:             begin

                evt_word := evt_word+1;
                eqp_word := eqp_word+1;

                evt_buffer[id]^[evt_word]:= point^.mem_add^;

{ Read CSR to test Q answer }
	        if (point^.qtest) then
		  begin		
		    csr_stat.full := point^.stat_add^;
                    if (csr_stat.Q = FALSE)then
                     begin
                      evt_buffer[id]^[evt_word]:=0; {0 if not Q}
 	              raise_exception (no_q_response,point^.cam_add.full);
		     end;
                  end;

               end;


{ Long Read  -------------------------------------------------------------}


1:             begin

                camaddr_2:= point^.mem_add;
	        camaddr_1::integer := camaddr_2::integer + 2;
		
		tmp_data := camaddr_2^ ;

                evt_word := evt_word+1;   
                evt_buffer[id]^[evt_word]:= camaddr_1^;
                evt_word := evt_word+1;   
                evt_buffer[id]^[evt_word]:= tmp_data;
                eqp_word := eqp_word+2;

{ Read CSR to test Q answer }
	        if (point^.qtest) then
		  begin		
		    csr_stat.full := point^.stat_add^;
                    if (csr_stat.Q = FALSE)then
                     begin
                      evt_buffer[id]^[evt_word]:=0; {0 if not Q}
 	              raise_exception (no_q_response,point^.cam_add.full);
		     end;
                  end;

               end;


{ Short Write  -------------------------------------------------------------}

2:	       begin
		point^.mem_add^ := point^.data_to_write.low;

{ Read CSR to test Q answer }
	        if (point^.qtest) then
		  begin		
		    csr_stat.full := point^.stat_add^;
                    if (csr_stat.Q = FALSE)then
 	              raise_exception (no_q_response,point^.cam_add.full);
                  end;

               end;



{ Long Write  -------------------------------------------------------------}


3:	       begin
		camaddr_2 := point^.mem_add ;
		camaddr_1::integer := camaddr_2::integer + 2;
		camaddr_2^ := point^.data_to_write.high ;
		camaddr_1^ := point^.data_to_write.low ;

{ Read CSR to test Q answer }
	        if (point^.qtest) then
		  begin		
		    csr_stat.full := point^.stat_add^;
                    if (csr_stat.Q = FALSE)then
 	              raise_exception (no_q_response,point^.cam_add.full);
                  end;
               end;


{ Short Test  -------------------------------------------------------------}


4:	      begin
	       dt:= point^.mem_add^;

{ Read CSR to test Q answer ---- commentato ----------
	       if (point^.qtest) then
		 begin		
		   csr_stat.full := point^.stat_add^;
                   if (csr_stat.Q = FALSE)then
 	              raise_exception (no_q_response,point^.cam_add.full);
                 end;
}
	      end;


{ Long Test  -------------------------------------------------------------}


5:	       begin
  	        camaddr_2 := point^.mem_add;
	        camaddr_1::integer := camaddr_2::integer + 2;
		dt := camaddr_2^ ;
                dt := camaddr_1^;

{ Read CSR to test Q answer --------- commentato ----------
	       if (point^.qtest) then
		 begin		
		   csr_stat.full := point^.stat_add^;
                   if (csr_stat.Q = FALSE)then
 	              raise_exception (no_q_response,point^.cam_add.full);
                 end;
}
               end;


{ End of Equipment -------------------------------------------------------}

6:             begin
                evt_buffer[id]^[length_equip_index]:=eqp_word+1;
	        eqp_word:=0
               end; 


{ Start DMA transfer  -----------------------------------------------------}

{ write ADRP}
7:	       begin	
		branch:=point^.cam_add.b; {save branch for future use}
	        vme_add.full:=rotary_add+id*65536*8+(evt_word*2);
		oplen:=point^.spare; {0=24 bits 1=16 bits}
		if ((point^.spare=0) AND ((vme_add.full MOD 4)<>0)) then
		begin
	                evt_word := evt_word+1;
    		        eqp_word := eqp_word+1;  
	                evt_buffer[id]^[evt_word]:= %xFFFF;
			vme_add.full:=vme_add.full+2; {align 24 bits boundery}
		end;
		adrp_add:=point^.mem_add;
		camaddr_2 := point^.mem_add ;
		camaddr_1::integer := camaddr_2::integer + 2;
		camaddr_2^ := vme_add.high ;
		camaddr_1^ := vme_add.low ;

{ Load another Camaclist block to start DMA !!!}
	        point:=point^.next_elem;

		point^.mem_add^ := point^.data_to_write.low;
	
		wait_any(amc_device,result:=satisfier,time:=one_second);

		case satisfier	of	
0:{timeout}	 begin
		  itcadd.b:=branch; {fill itc address}
                  tmp_it::integer:=base_ptr::integer+itcadd::integer;
	          tmp_it^ := %xA8; {select IRR}
		  itdadd.b:=branch;
                  tmp_it::integer:=base_ptr::integer+itdadd::integer;
		  irr_stat:=tmp_it^;
		  tmp_16.full:=irr_stat;
		  tmp_16.high:=0;
		  irr_stat:=tmp_16.full;

	          raise_exception (amc_timeou,branch,irr_stat,
			        current_equipment);
                 end;	
1:	 	 begin
		  itcadd.b:=branch; {fill itc address}
                  tmp_it::integer:=base_ptr::integer+itcadd::integer;
	          tmp_it^ := %xA0; {select ISR}
		  itdadd.b:=branch;
                  tmp_it::integer:=base_ptr::integer+itdadd::integer;
		  isr_stat:=tmp_it^;
		  tmp_16.full:=isr_stat;
		  tmp_16.high:=0;
		  isr_stat:=tmp_16.full;
                  if (isr_stat<>1) then 
		    raise_exception(amc_fail,branch,isr_stat,
			        current_equipment)
                  else
                   begin
	  	    camaddr_2 := adrp_add;
	            camaddr_1::integer := camaddr_2::integer + 2;
		    tmp_24.high := camaddr_2^ ;
                    tmp_24.low  := camaddr_1^;
		    tmp_16.full := tmp_24.high;
		    tmp_16.high := 0;            {to clear highest byte}
		    tmp_24.high := tmp_16.full;
		    dma_n_word  := tmp_24.full-vme_add.full; {num. of bytes}	
	
	            evt_word:=evt_word+trunc(dma_n_word/2); {word length}
		    eqp_word:=eqp_word+trunc(dma_n_word/2);

		    if(point^.spare=%x0002)then {qstop mode has one extra word}
		     begin
			if (oplen=1) then {16 bits oper} 
			  begin
				evt_word:=evt_word-1;
				eqp_word:=eqp_word-1;
			  end
			else   	{24 bits oper}
			  begin
				evt_word:=evt_word-2;
				eqp_word:=eqp_word-2;
			  end;
		     end;
	           end;		
		end;
	       end;
              end;
	    
{ Short read of a module --------------------------------------------------}


8:	      begin
	        camaddr:=point^.mem_add;
                for num_add:=1 to point^.data_to_write.low do
		 begin
	          evt_word := evt_word+1;
                  eqp_word := eqp_word+1;
                  evt_buffer[id]^[evt_word]:= camaddr^;

		  if (point^.qtest) then
		   begin		
{ Read CSR to test Q answer }
		    csr_stat.full := point^.stat_add^;
                    if (csr_stat.Q = FALSE)then
                     begin
                      evt_buffer[id]^[evt_word]:=0; {0 if not Q}
 	              raise_exception (no_q_response,point^.cam_add.full);
		     end;
                   end;

                   camaddr::integer:=camaddr::integer+128;
                 end;
               end;


{ Long read of a module ---------------------------------------------------}

9:            begin
  	        camaddr_2 := point^.mem_add;
                for num_add:=1 to point^.data_to_write.low do 
                 begin {list of operation}
  		  tmp_data := camaddr_2^ ;

                  evt_word := evt_word+1;   
		  camaddr_1::integer := camaddr_2::integer + 2;
                  evt_buffer[id]^[evt_word]:= camaddr_1^;

                  evt_word := evt_word+1;   
                  evt_buffer[id]^[evt_word]:= tmp_data;
                  eqp_word := eqp_word+2;

		  if (point^.qtest) then
		   begin        
{ Read CSR to test Q answer }
	            csr_stat.full := point^.stat_add^;
	            if (csr_stat.Q = FALSE)then
                     begin
                      evt_buffer[id]^[evt_word-1]:=0; {0 if not Q}
                      evt_buffer[id]^[evt_word]:=0; {0 if not Q}
 	              raise_exception (no_q_response,point^.cam_add.full);
                     end;
		   end;

  	           camaddr_2::integer := camaddr_2::integer + 128;
                  end;
               end;


{ Selection register ------------------------------------------------------}

10:	      begin
                select_register  := point^.mem_add^;

{ Read CSR to test Q answer }
	        if (point^.qtest) then
		  begin		
		    csr_stat.full := point^.stat_add^;
                    if (csr_stat.Q = FALSE)then
                     begin
                      select_register:=0; {0 if not Q}
 	              raise_exception (no_q_response,point^.cam_add.full);
		     end;
                  end;

               evt_word := evt_word+1;
               eqp_word := eqp_word+1;
               evt_buffer[id]^[evt_word]:=select_register;
               boolean_register::byte_data:=select_register::byte_data; 
               boolean_index:=1;{set index used in case 11:}
               save_select_pointer:=point^.next_elem;{save the pointer to the}
	      end;				     {next element of the list}


{ Check bit on selection register ------------------------------------------}

11:	      begin
  next_bit:    bit_set := find_first_bit_set( boolean_register,
                                              boolean_index);
               if (bit_set>16) then point:=save_select_pointer {continue on}
               else 						{camac list}
                begin
                 point:=select_matrix[save_select_pointer^.data_to_write.low,
                                      bit_set];{list of a select module}
                 boolean_index:=bit_set+1;
                 if (point=nil) then goto next_bit;
	         goto again;
                end;
               end;


{ Start of equipment  -----------------------------------------------------}

12:	      begin
	       saved_next_equip:=point;
               saved_evt_word:=evt_word;
	       saved_eqp_word:=eqp_word;
	       if (equip_mask_read[point^.data_to_write.low]) then
		 begin {equipment just read}
		  point:=point^.next_equip;{jump to the next equipment}
		 goto again;
		end
	       else
	        begin
		 evt_word:=evt_word+1;{increment event word}
	         length_equip_index:=evt_word;{save location for equip length}
                 equip_mask_read[point^.data_to_write.low]:=true;{set bit of}
                 evt_word := evt_word+1;
                 eqp_word := eqp_word+1;
                 evt_buffer[id]^[evt_word]:= point^.data_to_write.low;
		 current_equipment:= point^.data_to_write.low; 
	       end;  						
	      end;	


{ User procedure calls --------------------------------------------------}

13: 	      begin {calls to user procedure}
	       case point^.data_to_write.low of
	 1:      user_procedure_1;	
	 2:      user_procedure_2;	
	 3:      user_procedure_3;	
	 4:      user_procedure_4;	
	 5:      user_procedure_5;	
	 6:      user_procedure_6;	
	 7:      user_procedure_7;
	 8:      user_procedure_8;	
	 9:      user_procedure_9;	
	 10:      user_procedure_10;	
	
		 otherwise
               end;
              end;

14:          begin

	     {Not implemented}

	     end;

{ Wait Q on a 16bits register ------------------------------------------}
15:          begin
              count:=0;
              get_time(first_time);
wait_Q:       if (point^.cam_add.opl = 0) then
               begin
                 camaddr_2 := point^.mem_add;
                 camaddr_1::integer := camaddr_2::integer + 2;
                 dt := camaddr_2^ ;
                 dt := camaddr_1^;
               end
              else
                dt:= point^.mem_add^;

              get_time(second_time);
              diff_time:=time_fields(first_time-second_time);
             total_hs:=diff_time.minute*6000+
                        diff_time.second*100+diff_time.hundredth;
              if (total_hs>=point^.spare) then
               begin
                raise_exception (no_q_response,point^.cam_add.full);
                point:=point^.next_elem {load the pointer to the next};
                goto again;
               end;

               csr_stat.full := point^.stat_add^;  {read Q}

               if (point^.data_to_write.low=1) then
                 begin
                  if (csr_stat.Q = FALSE ) then goto wait_Q;
                 end
                else
                 begin
                  if (csr_stat.Q = TRUE ) then goto wait_Q;
                 end;

              end;

{ Short or Long write of a module with the same A --------------------------}

16:	       begin
                 for i:=1 to point^.spare do 
                  begin
 		   if(point^.cam_add.opl = 1) then   {short write}
                      point^.mem_add^ := point^.data_to_write.low
                   else
		     begin
 		       camaddr_2 := point^.mem_add ;
		       camaddr_1::integer := camaddr_2::integer + 2;
		       camaddr_2^ := point^.data_to_write.high ;
		       camaddr_1^ := point^.data_to_write.low ;
                     end; 

{ Read CSR to test Q answer }
	           if (point^.qtest) then
		    begin		
		      csr_stat.full := point^.stat_add^;
                      if (csr_stat.Q = FALSE)then
 	                 raise_exception (no_q_response,point^.cam_add.full);
                    end;
 
                 end;  {of for}

               end;  {of case}


17:	       begin
		 {No more implemented}
               end;


{ Short or Long write of a module with the different  A ----------------------}

18:	       begin
		 camaddr_2:=point^.mem_add;
                 for i:=1 to point^.spare do 
                  begin
 		   if(point^.cam_add.opl = 1) then   {short write}
                      camaddr_2^ := point^.data_to_write.low
                   else
		     begin
		       camaddr_1::integer := camaddr_2::integer + 2;
		       camaddr_2^ := point^.data_to_write.high ;
		       camaddr_1^ := point^.data_to_write.low ;
                     end; 

{ Read CSR to test Q answer }
	           if (point^.qtest) then
		    begin		
		      csr_stat.full := point^.stat_add^;
                      if (csr_stat.Q = FALSE)then
 	                 raise_exception (no_q_response,point^.cam_add.full);
                    end;

  	           camaddr_2::integer := camaddr_2::integer + 128;
 
                 end;  {of for}

               end;  {of case}



19:	       begin
		 {No more implemented}
               end;

{ Read formatted file -------------------------------------------------}

20:           begin
               found_eof:=false;
               evt_word:=0;
	       iindex:=0;
	       open(data_file,history:=history$readonly,
	     		file_name := write_file[point^.data_to_write.low]);
	       reset (data_file);
	       repeat
	        if not eof(data_file) then
                 begin
other:	          read(data_file,data_rec);
	          x_string:=data_rec;
	          repeat
	           iindex:=iindex+1;
	           skip_blank (x_string,y_string,x_string,ends);
	           if substr(y_string,1,1)='$'  then  {hexadecimal input}
                    begin
	             ilen := length(y_string) ;
                     ilen:=ilen-1;
	             y_string:=substr(y_string,2,ilen);
  	             for k := 1 to 6 do
	              begin
	               idigit[k] := 0
	              end ;
	             for k := 1 to ilen do
	              begin
	               chnum := substr(y_string,k,1) ;
	               j := ilen+1-k ;
	               idigit [j] := ord(chnum)-48 ;
	               if idigit[j] >16 then idigit[j] := idigit[j]-7 ;
	              end ;
	              ipot := 1 ;  
	              temp_dt.full := idigit [1] ;
	              for j := 2 to 6 do
	               begin
	                temp_dt.full := temp_dt.full + (ipot*16)*idigit[j] ;
	                ipot := ipot*16 ;
	               end ;
                      end
                    else  temp_dt.full:=convert(word24,y_string);
	           if (point^.spare=1) then
                    begin
                     evt_buffer[id]^[iindex]:=temp_dt.low;
                     iindex:=iindex+1;
                     evt_buffer[id]^[iindex]:=temp_dt.high;
                    end
                    else evt_buffer[id]^[iindex]:=temp_dt.low;
  	          until ends;
                 end
	        else found_eof:=true ;
	       until found_eof;
	       close (data_file);
               writeln ('Num. of records loaded: ', iindex);
              end;
       


{ Read unformatted file -------------------------------------------------}

21:           begin
	       found_eof:=false;
               evt_word:=0;
	       iindex:=0;
 	       new(rec);
               writeln (write_file[point^.data_to_write.low]);
	       open(fil,history:=history$old,
                    file_name := write_file[point^.data_to_write.low],
	            record_type:=record$variable);
               reset(fil);
	       repeat
	         if not eof(fil) then
                  begin
	           read(fil,rec^);
                   for jin:=1 to rec^.len_rec do 
	            begin
	             iindex:=iindex+1;
                     evt_buffer[id]^[iindex]:=rec^.w1[jin];
                    end;
	          end
                 else found_eof:=true ;
                until found_eof;
	        close (fil);
	        writeln ('Num. of records loaded: ', iindex);
	        dispose(rec);
	      end;


22:             begin
		  {No more implemented}
                end;

23:             begin
                 end;

24:             begin
               end;

25:             begin
               end;

{ Read Q response and load in  the buffer ----------------------------------}

26:	      begin
		csr_stat.full := point^.stat_add^;
		evt_word := evt_word+1;
		eqp_word := eqp_word+1;
		evt_buffer[id]^[evt_word]:= ord(csr_stat.Q);
	      end;

27:	      begin
		{ }
	      end;
	
{ Read a  16 bit module (same A) until Q = false or count=number of cycles---}

28:            begin
		count:=0;
		csr_stat.Q:=true; {to enter in the while loop}
		evt_word := evt_word+1; {frees a word }
		eqp_word := eqp_word+1;
		start_ev := evt_word;
	        
                tmp_mem_add:=point^.mem_add;                       
                evt_word:=evt_word+1;                              
                tmp_buf_p := address(evt_buffer[id]^[evt_word]);   

	        while (count < point^.data_to_write.low) and csr_stat.Q do 
                 begin
                  count := count+1;
                  tmp_buf_p^:=tmp_mem_add^;               
		  csr_stat.full := point^.stat_add^;
                  tmp_buf_p::integer :=tmp_buf_p::integer+2;         
                 end; {of while}

	       evt_buffer[id]^[start_ev]:=count::word16;
               eqp_word:=eqp_word+count;
               evt_word:=evt_word+count-1;
              end;  


{ Read a  24 bit module (same A) until Q = false or count=number of cycles---}

29:            begin
		count:=0;
		csr_stat.Q:=true; {to enter in the while loop}

		evt_word := evt_word+1; {frees a word }
		eqp_word := eqp_word+1;
		start_ev := evt_word;

                camaddr_2:= point^.mem_add;
	        camaddr_1::integer := camaddr_2::integer + 2;

	        evt_word :=evt_word+1;
	 	tmp_buf_p := address(evt_buffer[id]^[evt_word]);

	        while (count < point^.data_to_write.low) and csr_stat.Q do 
                 begin
                  count := count+1;

		  tmp_data := camaddr_2^ ;
                  tmp_buf_p^ := camaddr_1^;
	          tmp_buf_p::integer := tmp_buf_p::integer+2;
                  tmp_buf_p^ := tmp_data;
		  csr_stat.full := point^.stat_add^;
	          tmp_buf_p::integer := tmp_buf_p::integer+2;

                 end; {of while}
		 evt_buffer[id]^[start_ev]:=count::word16;
		 eqp_word:=eqp_word+count*2;
		 evt_word:=evt_word+(count*2)-1      ;
	end;

{ Read with the same A n 16 bits word ----------------------------------}

30:	       begin

		tmp_mem_add:=point^.mem_add;
		evt_word:=evt_word+1; 
		tmp_buf_p := address(evt_buffer[id]^[evt_word]);
                for count :=1 to point^.data_to_write.low do                    
		  begin
	                tmp_buf_p^:=tmp_mem_add^;
		        tmp_buf_p::integer :=tmp_buf_p::integer+2;
                  end;
                 evt_word:=evt_word+point^.data_to_write.low-1; 
                 eqp_word:=eqp_word+point^.data_to_write.low;

               end;                                                         


{ Read with the same A n 24 bits word ----------------------------------}

                                                                                
31:             begin                                                           
		 
	         
                 camaddr_2:= point^.mem_add;
	 	 camaddr_1::integer := camaddr_2::integer + 2;
                 evt_word:=evt_word+1;
                 tmp_buf_p := address(evt_buffer[id]^[evt_word]);   
                 
	         for count :=1 to point^.data_to_write.low do                  
                  begin                                                         

                                                                       
                  	tmp_data := camaddr_2^ ;                             
                  	tmp_buf_p^ := camaddr_1^;                            
                  	tmp_buf_p::integer := tmp_buf_p::integer+2;          
                  	tmp_buf_p^ := tmp_data;                              
	                tmp_buf_p::integer := tmp_buf_p::integer+2;          
                  end; {of for}                                            
                  
                  evt_word:=evt_word+(point^.data_to_write.low)*2-1; 
                  eqp_word:=eqp_word+point^.data_to_write.low*2;

               end;                                                             
                                                                                

{ Loop case ------------------------------------------------------------}

32:           begin                                        
               save_loop_ptr:=point;                       
               num_of_loop:=0;                             
               last_loop:=point^.spare;                    
              end;       
                                  
                                                           
{ End of Loop case -------------------------------------------------------}
                                                           
33:           begin                                        
               num_of_loop:=num_of_loop+1;                 
               if (num_of_loop<last_loop) then             
                        point:=save_loop_ptr;              
              end;                                         
                                                           


{ Read a  16 bit module (same A) until Q = false or count=number of cycles---}
{ the format is slight different from the operatrion #28 no first word with  }
{ the buffer length no last word with q=0			       	     }
34:            begin
		count:=0;
		csr_stat.Q:=true; {to enter in the while loop}
                tmp_mem_add:=point^.mem_add;                       
                evt_word:=evt_word+1;                              
                tmp_buf_p := address(evt_buffer[id]^[evt_word]);   

	        while (count < point^.data_to_write.low) and csr_stat.Q do 
                 begin
                  count := count+1;
                  tmp_buf_p^:=tmp_mem_add^;               
		  csr_stat.full := point^.stat_add^;
                  tmp_buf_p::integer :=tmp_buf_p::integer+2;         
                 end; {of while}
	       if not csr_stat.q then count := count-1;
               eqp_word:=eqp_word+count;
               evt_word:=evt_word+count-1;
              end;  


{ Read a  24 bit module (same A) until Q = false or count=number of cycles---}
{ similar to operation #34}
35:            begin
		count:=0;
		csr_stat.Q:=true; {to enter in the while loop}

                camaddr_2:= point^.mem_add;
	        camaddr_1::integer := camaddr_2::integer + 2;

	        evt_word :=evt_word+1;
	 	tmp_buf_p := address(evt_buffer[id]^[evt_word]);

	        while (count < point^.data_to_write.low) and csr_stat.Q do 
                 begin
                  count := count+1;

		  tmp_data := camaddr_2^ ;
                  tmp_buf_p^ := camaddr_1^;
	          tmp_buf_p::integer := tmp_buf_p::integer+2;
                  tmp_buf_p^ := tmp_data;
		  csr_stat.full := point^.stat_add^;
	          tmp_buf_p::integer := tmp_buf_p::integer+2;

                 end; {of while}
		 if not csr_stat.q then count:=count-1;
		 eqp_word:=eqp_word+count*2;
		 evt_word:=evt_word+(count*2)-1      ;
	end;

{ VME Long Word Read  ------------------------------------------------------}

50:            begin

		tmp_l_mem_add:=point^.l_mem_add;
		evt_word:=evt_word+1; {1}
		tmp_buf_p := address(evt_buffer[id]^[evt_word]);
		tmp_buf_ptr::integer:=tmp_buf_p::integer; 
		for count:=1 to point^.spare do
		  begin
	                tmp_buf_ptr^:=tmp_l_mem_add^;
		        tmp_buf_ptr::integer :=tmp_buf_ptr::integer+4;
		        tmp_l_mem_add::integer :=tmp_l_mem_add::integer+4;
                  end;
                 evt_word:=evt_word+(point^.spare*2)-1; {1}
                 eqp_word:=eqp_word+(point^.spare*2);
                 
               end;


{ VME Short Word Read  ------------------------------------------------------}

51:            begin
		tmp_mem_add:=point^.mem_add;
		evt_word:=evt_word+1; {1}
		tmp_buf_p := address(evt_buffer[id]^[evt_word]);
		for count:=1 to point^.spare do
		  begin
	                tmp_buf_p^:=tmp_mem_add^;
		        tmp_buf_p::integer :=tmp_buf_p::integer+2;
		        tmp_mem_add::integer :=tmp_mem_add::integer+2;
                  end;
                 evt_word:=evt_word+point^.spare-1; {1}
                 eqp_word:=eqp_word+point^.spare;
               end;

{ VME Long Word write  ------------------------------------------------------}

52:            begin
		point^.l_mem_add^:=point^.data_to_write.full;
               end;


{ VME Short Word write  ------------------------------------------------------}

53:            begin
		point^.mem_add^:=point^.data_to_write.low;
               end;

{ WFD_RDMEM:   WFD n-Word Circular Read --------------------------------------}
{ This section of code reads "n" wfd data words (2 x 32 bits). It starts by   }
{ using the special wfd function that returns the address pointer that        }
{ records the last memory location digitized when the STOP signal happens.    }
{ The code then read "n" wfd data, from the adc bank and time bank. If the    }
{ wfd address pointer is less than n words from the end, this routine will    }
{ stop at the end of channel memory and continue readout from the top of      }
{ channel memory. Therefore, this routine wraps around circular memory.       }
{ ETK: 19-Jan-1994                                                            }

54:            begin
            
                { base address is CAMAC list argument }
		wfd_base_add := point^.l_mem_add;
                { calculate address of control register }
                wfd_creg_add::integer := wfd_base_add::integer + %xFFE0;

                { Put wfd card into address readback mode: }
                wfd_creg_add^ := %x08080808;
                { Readback stop address: }
                wfd_address::integer := wfd_base_add^;
                { Put wfd card back into standard operating mode: }
                wfd_creg_add^ := %x01010101;
                { Calculate wfd stop address: }
                { This formula is complicated because WFD returns }
                { address of *next* cycle. So I have to add 4 but }
                { be careful of memory boundary at base+0xfffc.   }
                wfd_address::integer := wfd_base_add::integer
                    + (((wfd_address::integer DIV %x10000) +4) MOD %x8000);
                wfd_addr_t::integer  := wfd_address::integer + %x8000;

                { calculate loop limit (point^.spare = nwords) }
                remain := (%x8000 - 
                    (wfd_address::integer - wfd_base_add::integer)) DIV 4;
                if remain < point^.spare then
                   limit := remain
                else
                   limit := point^.spare;

                { pointer setup (see VME Long Read 50:) }
		evt_word:=evt_word+1; {1}
		tmp_buf_p := address(evt_buffer[id]^[evt_word]);
		tmp_buf_ptr::integer:=tmp_buf_p::integer; 

                { Header of this data structure:                 }
                {     [ starting address of wfd data       ]     }
                {     [ tics from stop to first cycle (t0) ]     }
                {     [ length of wfd data (32 bit words)  ]     }
                tmp_buf_ptr^ := wfd_address::integer;
                tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                tmp_buf_ptr^ := 0;
                tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                wfd_len_ptr := tmp_buf_ptr;   { <-- Fill in later }
                tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;

                { Loop over memory and alternate reading ADC and time data }
		for count:=1 to limit do
		  begin
	                tmp_buf_ptr^ := wfd_address^;            
		        tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                        tmp_buf_ptr^ := wfd_addr_t^;
		        tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                        wfd_address::integer := wfd_address::integer+4;
                        wfd_addr_t::integer := wfd_addr_t::integer+4;
                  end;

                { This second loop is only executed if we are near the }
                { end of memory for this channel and we must wrap to   }
                { the beginning of memory to finish reading.           }
                wfd_address := wfd_base_add;
                wfd_addr_t::integer  := wfd_address::integer + %x8000;
		for count:=limit to point^.spare do
		  begin
	                tmp_buf_ptr^ := wfd_address^;            
		        tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                        tmp_buf_ptr^ := wfd_addr_t^;
		        tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                        wfd_address::integer := wfd_address::integer+4;
                        wfd_addr_t::integer := wfd_addr_t::integer+4;
                  end;

                { Increment totals. Compare with VME Long Read. }
                wfd_len_ptr^ := (tmp_buf_ptr::integer - 
                                 wfd_len_ptr::integer - 4) DIV 4;
                evt_word := evt_word + 2*(wfd_len_ptr^) + 6 - 1; {1}
                eqp_word := eqp_word + 2*(wfd_len_ptr^) + 6;

              end;

{ WFD_RDTIM:   WFD Time Window Read ------------------------------------------}
{ This section of code reads wfd data words (2 x 32 bits) until a certain     }
{ amount of time (in units of 5 ns at 200 MSPS) has elapsed. It begins by     }
{ using the special wfd function that returns the address pointer that        }
{ records the last memory location digitized when the STOP signal happens.    }
{ The code then read "n" wfd data, from the adc bank and time bank. The code  }
{ calculates the elapsed time by looking at the WFD timeword as it is stored. }
{ When the requested time has elapsed (passed in point^.spare), it calculates }
{ the length of the data and stores that at the beginning of the equipment,   }
{ as well as in evt_word (used by the daq). This routine handles wrap-around  }
{ reading of the wfd memory.                                                  }
{ ETK: 25-Jan-1994                                                            }

55:            begin
            
                { base address is CAMAC list argument }
		wfd_base_add := point^.l_mem_add;
                { calculate address of control register }
                wfd_creg_add::integer := wfd_base_add::integer + %xFFE0;

                { Put wfd card into address readback mode: }
                wfd_creg_add^ := %x08080808;
                { Readback stop address: }
                wfd_address::integer := wfd_base_add^;
                { Put wfd card back into standard operating mode: }
                wfd_creg_add^ := %x01010101;
                { Calculate wfd stop address: }
                { This formula is complicated because WFD returns }
                { address of *next* cycle. So I have to add 4 but }
                { be careful of memory boundary at base+0xfffc.   }
                wfd_address::integer := wfd_base_add::integer
                    + (((wfd_address::integer DIV %x10000) +4) MOD %x8000);
                wfd_addr_t::integer  := wfd_address::integer + %x8000;
                { Calculate loop starting value: }
                start := (wfd_address::integer - wfd_base_add::integer) DIV 4;
                count := start;

                { pointer setup (see VME Long Read 50:) }
		evt_word := evt_word+1; {1}
		tmp_buf_p := address(evt_buffer[id]^[evt_word]);
		tmp_buf_ptr::integer := tmp_buf_p::integer; 
                { We will calculate data length from address of tmp_buf_p }

                { Header of this data structure:                 }
                {     [ starting address of wfd data       ]     }
                {     [ tics from stop to first cycle (t0) ]     }
                {     [ length of wfd data (32 bit words)  ]     }
                tmp_buf_ptr^ := wfd_address::integer;
                tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                tmp_buf_ptr^ := 0;
                tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                wfd_len_ptr := tmp_buf_ptr;   { <-- Fill in later }
                tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;

                { Read first data to initialize tlast: }
                { This is nearly the same as in the loop below. }
                begin
	              tmp_buf_ptr^ := wfd_address^;            
		      tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                      tmp_buf_ptr^ := wfd_addr_t^;

                      { Calculate tlast: }
                      tlast := tmp_buf_ptr^ DIV %x10000;

		      tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                      wfd_address::integer := wfd_address::integer+4;
                      wfd_addr_t::integer := wfd_addr_t::integer+4;

                      count := count + 1;
                end;

                { Loop over memory and alternate reading ADC and time data }
                { The constant 8191 represents 7ffc in units of four bytes }
                t := 0;
		while (count < 8191) AND (t < point^.spare) do
		  begin
	                tmp_buf_ptr^ := wfd_address^;            
		        tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                        tmp_buf_ptr^ := wfd_addr_t^;

                        { Calculate elapsed time: }
                        tnow := tmp_buf_ptr^ DIV %x10000;
                        if (tlast < tnow) then
                           t := t + tlast + 65536 - tnow
                        else
                           t := t + tlast - tnow;
                        tlast := tnow;

		        tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                        wfd_address::integer := wfd_address::integer+4;
                        wfd_addr_t::integer := wfd_addr_t::integer+4;

                        count := count + 1;
                  end;

                { This second loop is only executed if we are near the }
                { end of memory for this channel and we must wrap to   }
                { the beginning of memory to finish reading. The       }
                { condition (count < start) ensures that we read at    }
                { most the entire 64K memory only once.                }
                wfd_address := wfd_base_add;
                wfd_addr_t::integer  := wfd_address::integer + %x8000;
                count := 1;
		while (count < start) AND (t < point^.spare) do
		  begin
	                tmp_buf_ptr^ := wfd_address^;            
		        tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                        tmp_buf_ptr^ := wfd_addr_t^;

                        { Calculate elapsed time: }
                        tnow := tmp_buf_ptr^ DIV %x10000;
                        if (tlast < tnow) then
                           t := t + tlast + 65536 - tnow
                        else
                           t := t + tlast - tnow;
                        tlast := tnow;

		        tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                        wfd_address::integer := wfd_address::integer+4;
                        wfd_addr_t::integer := wfd_addr_t::integer+4;

                        count := count + 1;
                  end;

                { Increment totals. Compare with VME Long Read. }
                wfd_len_ptr^ := (tmp_buf_ptr::integer - 
                                 wfd_len_ptr::integer - 4) DIV 4;
                evt_word := evt_word + 2*(wfd_len_ptr^) + 6 - 1; {1}
                eqp_word := eqp_word + 2*(wfd_len_ptr^) + 6;
                 
              end;

{ WFD_READOUT:   WFD selective channel readout -------------------------------}
{ This section of code reads wfd data words (2 x 32 bits) until a certain     }
{ amount of time (in units of 5 ns at 200 MSPS) has elapsed. It begins by     }
{ using the special wfd function that returns the address pointer that        }
{ records the last memory location digitized when the STOP signal happens.    }
{ The code then read "n" wfd data, from the adc bank and time bank. The code  }
{ calculates the elapsed time by looking at the WFD timeword as it is stored. }
{ When the requested time has elapsed (passed in wfd_spr[12+ism]), it finds   }
{ the length of the data and stores that at the beginning of the equipment,   }
{ as well as in evt_word (used by the daq).                                   }
{ ETK: 31-Aug-1994                                                            }
{ The code has been modified to handle large (>64 K) events. The way this     }
{ works is: for an event, the first buffer (id= 1) will carry only the wfd    } 
{ header which contains the number of channels to read out. Subsequent        }
{ buffers will carry groups of 3 pairs of channels (or less) with id=2. The   }
{ wfd equip. no. will be 6042 whenever split readout gets called - i.e        }
{ whenever there is at least one pair of channels to be read out.             }
{ RN/APS/FR: 28-Feb-1995                                                      }
 
56:       begin
             numchan := 6;
             limaddr := point^.data_to_write.full DIV 2;

             { find bit set in wfd software pattern register }
             indx := FIND_FIRST_BIT_SET(wfd_spr[point^.spare]::bit32);

             while indx < 32 do
             begin
 
                for i := 0 to 1 do    { loop over end-0 to end-1 }
                begin

                    { pointer setup: }
                    evt_word := evt_word+1; {1}
                    tmp_buf_p := address(evt_buffer[id]^[evt_word]);
                    tmp_buf_ptr::integer := tmp_buf_p::integer; 
                    { We will calculate data length from address of tmp_buf_p }

                    {split_readout is called for every 6 channels}
                    {this is temporary etk }
                    if numchan = 6 then
                       begin
                       split_readout(60000,0,current_equipment,
                                  length_equip_index,
                                  tmp_buf_p,tmp_buf_ptr);
                       numchan := 0;
                       end;


                    { base address is indexed from array }
                    wfd_base_add::integer := 
                       wfd_chan_addr[point^.spare,indx,i].virtual;
                    { calculate end of adc memory for this channel }
                    wfd_end_add::integer := wfd_base_add::integer + %x7FFF;
                    { calculate address of control register }
                    wfd_creg_add::integer := wfd_base_add::integer + %xFFE0;

                    { Put wfd card into address-readback mode: }
                    wfd_creg_add^ := %x08080808;
                    { Readback stop address: }
                    wfd_stop_add::integer := wfd_base_add^;
                    { Put wfd card back into standard operating mode: }
                    wfd_creg_add^ := %x01010101;
                    { Calculate wfd stop address. Note: the wfd returns }
                    { the address of *next* cycle. Hence, the +4 below. }
                    wfd_stop_add::integer := wfd_base_add::integer
                        + ((wfd_stop_add::integer DIV %x10000) MOD %x8000);
                    { Calculate first address to read from. Handle special }
                    { case when wfd stops at end of channel memory.        }
                    if (wfd_stop_add = wfd_end_add) then
                       wfd_addr_d::integer := wfd_base_add::integer
                    else
                       wfd_addr_d::integer  := wfd_stop_add::integer + 4;
                    wfd_addr_t::integer  := wfd_addr_d::integer + %x8000;
                  
                    { This variable limits the amount of data readout.  }
                    wfd_quit_add::integer := wfd_stop_add::integer + limaddr;

                    if wfd_quit_add::integer > wfd_end_add::integer then
                       wfd_quit_add::integer := wfd_quit_add::integer - %x8000 
                    else
                       wfd_end_add::integer := wfd_quit_add::integer;

                    { Header of this data structure:                 }
                    {     [ starting address of wfd data       ]     }
                    {     [ tics from stop to first cycle (t0) ]     }
                    {     [ length of wfd data (32 bit words)  ]     }
                    tmp_buf_ptr^ := wfd_chan_addr[point^.spare,indx,i].actual;
                    tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                    tmp_buf_ptr^ := 0;
                    tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                    wfd_len_ptr := tmp_buf_ptr;   { <-- Fill in later }
                    tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;

                    { Read first data to initialize tlast: }
                    { This is nearly the same as in the loop below. }
                    begin
	              tmp_buf_ptr^ := wfd_addr_d^;            
		      tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                      tmp_buf_ptr^ := wfd_addr_t^;

                      { Calculate tlast: }
                      tlast := tmp_buf_ptr^ DIV %x10000;

		      tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                      wfd_addr_d::integer := wfd_addr_d::integer+4;
                      wfd_addr_t::integer := wfd_addr_t::integer+4;
                    end;

                    { Loop over memory and alternate reading ADC and time data }
                    t := 0;
                    while (wfd_addr_d::integer < wfd_end_add::integer) AND 
                          (t < wfd_spr[point^.spare+12]) do 
                    begin
                       tmp_buf_ptr^ := wfd_addr_d^;            
	               tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                       tmp_buf_ptr^ := wfd_addr_t^;

                       { Calculate elapsed time: }
                       tnow := tmp_buf_ptr^ DIV %x10000;
                       t := t + tlast - tnow;
                       if (tlast < tnow) then
                          t := t + 65536;
                       tlast := tnow;

                       tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                       wfd_addr_d::integer := wfd_addr_d::integer+4;
                       wfd_addr_t::integer := wfd_addr_t::integer+4;
                    end;

                    { This second loop is only executed if we reach the    }
                    { end of memory for this channel and we must wrap to   }
                    { the beginning of memory to finish reading. We only   }
                    { enter this loop if the quit_add also wrapped around. }
                    if wfd_quit_add::integer < wfd_end_add::integer then
                    begin

                       { reposition pointers at beginning of memory }
                       wfd_addr_d::integer := wfd_base_add::integer;
                       wfd_addr_t::integer := wfd_addr_d::integer + %x8000;

                       while (wfd_addr_d::integer < wfd_quit_add::integer) AND 
                             (t < wfd_spr[point^.spare+12]) do 
                       begin
                          tmp_buf_ptr^ := wfd_addr_d^;  
                          tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                          tmp_buf_ptr^ := wfd_addr_t^;

                          { Calculate elapsed time: }
                          tnow := tmp_buf_ptr^ DIV %x10000;
                          t := t + tlast - tnow;
                          if (tlast < tnow) then
                             t := t + 65536;
                          tlast := tnow;

                          tmp_buf_ptr::integer := tmp_buf_ptr::integer+4;
                          wfd_addr_d::integer := wfd_addr_d::integer+4;
                          wfd_addr_t::integer := wfd_addr_t::integer+4;
                       end;
                    end;
                   
                    { Calculate the length of this data and }
                    { store it in the wfd data structure.   }
                      wfd_len_ptr^ := (tmp_buf_ptr::integer - 
                                      wfd_len_ptr::integer - 4) DIV 4;
                    { Increment totals that are used in the equipment. }
                      evt_word := evt_word + 2*(wfd_len_ptr^) + 6 - 1; {1}
                      eqp_word := eqp_word + 2*(wfd_len_ptr^) + 6;

                      numchan := numchan + 1;

                end;   { end of while i := 0 to 1 (tank end) }

                { Find next set bit in readout pattern }
                indx := FIND_FIRST_BIT_SET(wfd_spr[point^.spare]::bit32,indx+1);

              end;   { end of while...do (loop over pattern bits) }
          end;   { end of case 56: }

{ WRITEHEX:   Write Hex Constant ---------------------------------------------}
{ This code writes a 32-bit constant (passed in point^) to an equipment.      }
{ ETK: 26-Jan-1994                                                            }
57:           begin
                 evt_word := evt_word + 1;
                 tmp_buf_p := address(evt_buffer[id]^[evt_word]);
                 tmp_buf_ptr::integer := tmp_buf_p::integer;
                 tmp_buf_ptr^ := point^.data_to_write.full;
                 evt_word := evt_word+1;
                 eqp_word := eqp_word+2;
              end;

{ WFD_PATREG:   WFD Pattern Register -----------------------------------------}
{ This is a software pattern register to control WFD readout.                 }
{ I have recruited the camac_list structure as follows:                       }
{   point^.l_mem_add          =   address of wfd software pattern register    }
{   point^.cam_add.full       =   id of pattern unit (CIT,FMT,LIP etc)        }
{   point^.data_to_write.full =   sub-id of pattern unit                      }
{ ETK: 30-Sep-1994                                                            }
58:           begin
                 if (point^.cam_add.full = 0) and
                    (point^.data_to_write.full = 0) then
                    { write wfd software pattern register into data stream }
                    begin
                      evt_word := evt_word + 1;
                      tmp_buf_p := address(evt_buffer[id]^[evt_word]);
                      tmp_buf_ptr::integer := tmp_buf_p::integer;
                      tmp_buf_ptr^ := point^.l_mem_add^;
                      evt_word := evt_word+1;
                      eqp_word := eqp_word+2;
                    end
                 else if (point^.cam_add.full = 0) and
                         (point^.data_to_write.full = 1) then
                    { count bits in s.p.r. and write into data stream }
                    begin
                       bitson := 0;
                       indx := FIND_FIRST_BIT_SET(point^.l_mem_add^::bit32);
                       while indx < 32 do
                          begin
                             bitson := bitson + 1;
                             indx := 
                                 FIND_FIRST_BIT_SET(point^.l_mem_add^::bit32,
                                                    indx+1);
                          end;
                       evt_word := evt_word + 1;
                       tmp_buf_p := address(evt_buffer[id]^[evt_word]);
                       tmp_buf_ptr::integer := tmp_buf_p::integer;
                       tmp_buf_ptr^ := bitson+bitson;
                       evt_word := evt_word+1;
                       eqp_word := eqp_word+2;
                    end
                 else
                    { perform selected masking operation: }
                    begin
                      tmp_buf_p := address(evt_buffer[id]^[evt_word-1]);
                      tmp_buf_ptr::integer := tmp_buf_p::integer;
                      wfd_patreg(point^.l_mem_add, 
                                 point^.cam_add.full,
                                 point^.data_to_write.full, 
                                 tmp_buf_ptr);
                    end;
              end;

{ WFD_THRESH:   WFD Threshold setting ----------------------------------------}
{ I have recruited the camac_list structure as follows:                       }
{   point^.spare              =   input number (0-3)                          }
{   point^.cam_add.full       =   1000*ism + 10*ichan + iend                  }
{   point^.data_to_write.full =   DAC value                                   }
{ ETK: 30-Oct-1994                                                            }
59:           begin

                { decode channel id and calculate addresses }
                ism := point^.cam_add.full DIV 1000;
                ichan := (point^.cam_add.full MOD 1000) DIV 10;
                iend := point^.cam_add.full MOD 10;
                wfd_base_add::integer := wfd_chan_addr[ism,ichan,iend].virtual;
                wfd_creg_add::integer := wfd_base_add::integer + %xFFE0;
                wfd_dac_add::integer := wfd_base_add::integer + %xFFF0
                                        + 4*point^.spare;

                { this places DAC value into correct byte }
                ival.b0 := point^.data_to_write.full::byte;

                { load dac value into all bytes }
                wfd_dac_add^ := ival.full;

                { toggle dac clock }
                wfd_creg_add^ := %x80808080;

                { Put wfd card back into standard operating mode: }
                wfd_creg_add^ := %x01010101;
              end;

{ Start of init equipment  ---------------------------------------------------}

99:	      begin
	       saved_next_equip:=point;
	      end;	


{ END OF CASE  -------------------------------------------------------------}


              end; {of case}
              
	      point:=point^.next_elem {load the pointer to the next};

             end;	     

	     data[id]^.tot_length:=evt_word;{load total length }

	revert;
end;

{------------------------------------------------------------------------}

[inline] procedure fill_error_equipment;

{ added by FR may 31 1990 to fix a bug producing multiples error equipments}

var i: integer;

begin
             if (cam_error_flag) then
              begin
               evt_word:=evt_word+1;
               evt_buffer[id]^[evt_word]:=noqindex+2;{error equipment length}
               evt_word:=evt_word+1;
               evt_buffer[id]^[evt_word]:=999; {error equipment num}
               for i:=1 to noqindex do
                begin
                 evt_word:=evt_word+1;
                 evt_buffer[id]^[evt_word]:=no_q_buffer[i];
                end;
               end;
	
	data[id]^.tot_length:=evt_word;{load total length }
end;