{
{ This module contains some procedure used by camac_in and must be 
{ included in camac_in after the declaration of the general variables 
{			Version 0.1 
{			Author       G.Sanzani 14/5/87 Bologna
{ 
{			F Ronga sept 1989
{			added some instructions
{}
procedure skip_blank (	stringa    : varying_string (80);
		 	var first_part : varying_string (80);
        		var rest_part  : varying_string (80);
                        var end_string : [optional] boolean);
{
{ This procedure is called by the fill_camac_list and other procedures.
{ It divides a string (stringa) in two parts :
{ a) the first one (first_part) contains a part of the original string 
{    until a blank
{ b) the second one contains(rest_part)  the part of the string from the 
{    character after the blank to the end of the string.
{  Is not possible to give as 'stringa' and 'first_part' the same variable
{  Is possible to give as 'stringa' and 'rest_part' the same variable
{}
var
	posblank  : integer;
        poschar   : integer
begin
        if present(end_string) then end_string:=FALSE;
	poschar := find_member (stringa,['A'..'Z','a'..'z','$',
   {search the first char}    '0','1','2','3','4','5','6','7','8','9']);
        stringa := substr (stringa,poschar);
	posblank := find_member ( stringa,[' ']);
        if (posblank=0) then 
         begin
          first_part := stringa {end string};
          if present(end_string) then end_string:=TRUE;
         end
         else 
         begin
	  first_part := substr( stringa,1,posblank-1);
          rest_part := substr(stringa,posblank+1);
          poschar := find_member (stringa,['A'..'Z','a'..'z','$',
		                '0','1','2','3','4','5','6','7','8','9']);
          rest_part := substr (rest_part,poschar);
         end;
end;
{}

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

procedure skip_comma   ( stringa    : varying_string (80);
		 	var first_part : varying_string (80);
        		var rest_part  : varying_string (80);
                        var end_string : [optional] boolean);
{
{
{ This procedure is called by the fill_camac_list and other procedures.
{ It divides a string (stringa) in two parts :
{ a) the first one (first_part) contains a part of the original string 
{    until a comma
{ b) the second one contains(rest_part)  the part of the string from the 
{    character after the comma to the end of the string.
{  An optional variable (end_string) is set true when  no comma is found
{  inside the string. Is useful for decoding a string the contains
{  many variable s separatede by commas to signal the end of the string.
{  Is not possible to give as 'stringa' and 'first_part' the same variable
{  Is possible to give as 'stringa' and 'rest_part' the same variable
{}
var
	poscomma  : integer;
        poschar : integer;
begin
        if present(end_string) then end_string:=FALSE;
	poschar := find_member (stringa,['A'..'Z','a'..'z','$',
		                '0','1','2','3','4','5','6','7','8','9']);
        stringa := substr (stringa,poschar);
	poscomma := find_member ( stringa,[',']);
        if (poscomma=0) then {no comma found,i have reached the end ?}
         begin
          if present(end_string) then end_string:=TRUE;
          first_part := substr( stringa,poschar);
         end
        else
         begin
	  first_part := substr( stringa,poschar,poscomma-1);
          rest_part := substr(stringa,poscomma+1);
	  poschar := find_member (stringa,['A'..'Z','a'..'z','$',
	 	                '0','1','2','3','4','5','6','7','8','9']);
          rest_part := substr (rest_part,poschar);
        end; 
end;

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

procedure fill_nil;

{ This procedure is called by the main process of the job Camac_in when it
{ starts to clear all the pointer used by the acquisition process
{}
var
	i,ii:integer;
begin

        for i:=1 to 255 do begin
         for ii:=1 to 255 do begin
          select_matrix[i,ii]:=nil;
         end;   
         trigger_array[i] :=nil;
         pointer_array[i] :=nil;
        end;
        pointer_for_init:=nil;
end;

{------------------------------------------------------------------}
procedure interrupt_enable(irq_num : integer);

{ This procedure unmask the 8210 ext int
{}

var 	csrreg: ces8210_csr;
	camadd : camac_addr;

begin	
	camadd.full:=0;
	camadd.b:=int_branch;
	camadd.c:=0;
	camadd.n:=29;
	camadd.a:=0;
	camadd.f:=4;

{ IFR register}
	eln$camac_short_write(camadd,0); {clear pending int}

	camadd.f:=0;
{ CSR Register}
	eln$camac_short_read(camadd,csrreg.full); {read csr}

	if (irq_num=2) then
	    csrreg.ext_int_2:=0
	else
	    csrreg.ext_int_4:=0;
    	
	eln$camac_short_write(camadd,csrreg.full); {clear ext int mask}
	
end;
	
{------------------------------------------------------------------}
procedure interrupt_disable(irq_num :integer);

{ This procedure mask the 8210 ext int
{}

var 	csrreg: ces8210_csr;
	camadd : camac_addr;

begin	
	camadd.full:=0;
	camadd.b:=int_branch;
	camadd.c:=0;
	camadd.n:=29;
	camadd.a:=0;
	camadd.f:=0;

{ CSR Register}
	eln$camac_short_read(camadd,csrreg.full); {read csr}

	if (irq_num=2) then
	    csrreg.ext_int_2:=1
	else
	    csrreg.ext_int_4:=1;
    	
	eln$camac_short_write(camadd,csrreg.full); {set ext int mask}

	camadd.f:=4;
{ IFR register}
	eln$camac_short_write(camadd,0); {clear pending int}
end;

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


procedure freememory (point_to_mem:^camac_list);

{ This procedure frees the memory allocated for the camac_list and is
{ called each time the camac_list is loaded (by mean of the command
{ init). In input requires the pointer to the first element of a list.
{ It executes the statement 'dispose' until a nil pointer is reached.
{}

var
	nextfree_point,free_point : ^camac_list ;
begin
	free_point := point_to_mem;
	while (free_point<>nil) do begin
         nextfree_point:=free_point^.next_elem;
	 dispose(free_point);
         free_point := nextfree_point;
	end;
end;
{-----------------------------------------------------------------------}

procedure fill_list(b:camac_B;c:camac_C;n:camac_N;a:camac_A;f:camac_F;
		    length24:boolean;q_oper:boolean;cam_data:word24);

{ This procedure fills a block of the camac_list.
{  It requires in input the camac b,c,n,a,f and data in word24 (integer
{ with max value = 2**(24-1)
{ This procedure,also,allocates the memory space for another block of 
{ the list (new(p)) and loads  the pointer to the new block in a 
{ word of the old one.
{}
begin
{}
	  p^.cam_add.full:=0;

          p^.cam_add.b:=b;
          p^.cam_add.c:=c;
	  p^.cam_add.n:=n;
	  p^.cam_add.a:=a;
	  p^.cam_add.f:=f;       {load address}

	  if (length24 = FALSE)  then
		p^.cam_add.opl:=1;

{ Set Q test option }
          p^.qtest:=q_oper;
	  
          csr_add.b:=b;
	  p^.stat_add::integer := base_ptr::integer+csr_Add::integer; 
{ Add map offset}

	  p^.mem_add::integer:=base_ptr::integer+p^.cam_add.full;
	
          p^.data_to_write.full:=cam_data;
	  previus := p;
	  new (p); 			{space for a new element }
	  previus^.next_elem := p;     {load the pointer to the new block}
end;                                   {in the previus one} 

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

procedure decode_bcnaf (input_str : varying_string(80);
	  	          var B:camac_B;
	  	          var C:camac_C;
	  	          var N:camac_N;
	  	          var A:camac_A;
	  	          var F:camac_F;
		          var cam_data  :word24;
                          var rpt : [optional] word16);
{ This procedure decode a string of the camac_list and gives the camac
{ b,c,n,a,f . Data is always given in word24 (two words). Only one is used
{ for 16 bits operations.
{}
var
	end_str:boolean;
        local_str : varying_string(80);
	idigit : array [1..6] of integer ;
	ilen,ipot,j,k : integer ;
        chnum : string(1); 
{}
begin
             cam_data:=0;{la pongo sempre a zero}
	     if present(rpt) then 
			rpt:=0;	
             skip_comma (input_str,local_str,input_str);
             B:=convert(camac_B,local_str);
             skip_comma (input_str,local_str,input_str);
	     C:=convert(camac_C,local_str);
             skip_comma (input_str,local_str,input_str);
	     N := convert (camac_N,local_str);{converto la station}
             skip_comma (input_str,local_str,input_str);
             A :=convert (camac_A,local_str);{converto il subadd.}
             skip_comma (input_str,local_str,input_str,end_str);
	     F :=convert (camac_F,local_str);{converto la function}
             if not end_str then 
              begin
               skip_comma (input_str,local_str,input_str,end_str);
	       if substr(local_str,1,1)='$'  then  {hexadecimal input}
                begin
	         ilen := length(local_str) ;
                 ilen:=ilen-1;
	         local_str:=substr(local_str,2,ilen);
  	         for k := 1 to 6 do
	          begin
	           idigit[k] := 0
	          end ;
	         for k := 1 to ilen do
	          begin
	           chnum := substr(local_str,k,1) ;
	           j := ilen+1-k ;
	           idigit [j] := ord(chnum)-48 ;
	           if idigit[j] >16 then idigit[j] := idigit[j]-7 ;
	          end ;
	          ipot := 1 ;  
	          cam_data := idigit [1] ;
	          for j := 2 to 6 do
	          begin
	           cam_data := cam_data + (ipot*16)*idigit[j] ;
	           ipot := ipot*16 ;
	          end ;
                end
               else  cam_data:=convert(word24,local_str);
             end ;
             if not end_str then
              begin
               if present(rpt) then
                begin
                 skip_comma (input_str,local_str,input_str);
                 rpt:=convert(word16,local_str);
                end;
               end;
end;


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

procedure hextoint(var local_str : varying_string(80);
		   var int_data : integer);

{ Conversion hex to integer
  input : hex string starting with '$' char 
  output : integer 
}

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

begin
	         ilen := length(local_str) ;
                 ilen:=ilen-1;
	         local_str:=substr(local_str,2,ilen);
  	         for k := 1 to 8 do
	          begin
	           idigit[k] := 0
	          end ;
	         for k := 1 to ilen do
	          begin
	           chnum := substr(local_str,k,1) ;
	           j := ilen+1-k ;
	           idigit [j] := ord(chnum)-48 ;
	           if idigit[j] >16 then idigit[j] := idigit[j]-7 ;
	          end ;
	          ipot := 1 ;  
	          int_data := idigit [1] ;
	          for j := 2 to 8 do
	          begin
	           int_data := int_data + (ipot*16)*idigit[j] ;
	           ipot := ipot*16 ;
	          end ;
end ;


{------------------------------------------------------------------}
procedure decode_vic_comm (input_str : varying_string(80);
	  	           var B  : camac_B;
	  	           var C  : camac_C;
		           var page : integer;
                           var vme_off : integer;
                           var nwords : integer);

{ This procedure decode a string of the camac_list for vic operation 
{}
var
	end_str:boolean;
        local_str : varying_string(80);
	idigit : array [1..6] of integer ;
	ilen,ipot,j,k : integer ;
        chnum : string(1); 
	ext_vme_add :integer;
{}
begin
             skip_comma (input_str,local_str,input_str);
             B:=convert(camac_B,local_str);
             skip_comma (input_str,local_str,input_str);
	     C:=convert(camac_C,local_str);
             skip_comma (input_str,local_str,input_str,end_str);
	     hextoint(local_str,ext_vme_add);
             page := ext_vme_add DIV %x100000;	     
             vme_off := ext_vme_add MOD %x100000;	     
             if not end_str then
	       begin
                 skip_comma (input_str,local_str,input_str);
  		 if substr(local_str,1,1)='$'  then  {hexadecimal input}
	             hextoint(local_str,nwords)
                 else
                     nwords:=convert(integer,local_str);
               end
	    else nwords:=1;
end;

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

procedure decode_i1i2 (input_str : varying_string(80);
	  	          var B:integer2;
	  	          var C:integer2);
{ This procedure decode a string of the camac_list and gives two integers
{ adapted from decode_bcna by F Ronga
{}
var
        local_str : varying_string(80);
{}
begin
             skip_comma (input_str,local_str,input_str);
             B:=convert(camac_B,local_str);
             skip_comma (input_str,local_str,input_str);
	     C:=convert(camac_C,local_str);
end;

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

procedure decode_i1i2i3 (input_str : varying_string(80);
	  	          var B:integer;
	  	          var C:integer;
                          var D:integer);
{ This procedure decodes a string of the camac_list and gives three integers
{ adapted from decode_i1i2 by E Kearns
{}
var
        local_str : varying_string(80);
{}
begin
             skip_comma (input_str,local_str,input_str);
             B:=convert(integer,local_str);
             skip_comma (input_str,local_str,input_str);
	     C:=convert(integer,local_str);
             skip_comma (input_str,local_str,input_str);
	     D:=convert(integer,local_str);
end;

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

procedure decode_i1i2i3i4 (input_str : varying_string(80);
	  	          var B:integer;
	  	          var C:integer;
                          var D:integer;
                          var E:integer);
{ This procedure decodes a string of the camac_list and gives three integers
{ adapted from decode_i1i2i3 by E Kearns
{}
var
        local_str : varying_string(80);
{}
begin
             skip_comma (input_str,local_str,input_str);
             B:=convert(integer,local_str);
             skip_comma (input_str,local_str,input_str);
	     C:=convert(integer,local_str);
             skip_comma (input_str,local_str,input_str);
	     D:=convert(integer,local_str);
             skip_comma (input_str,local_str,input_str);
	     E:=convert(integer,local_str);
end;

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

procedure fill_amc_list (qmode:word24;
                         long_operation : boolean;                              
 			var iover:[optional]byte);
{}
{ This procedure fills some blocks of camac_list ,as many as it's need,
{ for executing an amc operation.
{ It also loads the amc reset operation in the comunication region with
{ the isr for the lam clear.
{ It requires in input a variable giving the mode of operation of the amc,
{ a boolean variable set if 24bits operation it's need, and a byte variable,
{ used as a flag and read from the camac_list, that gives the mode of 
{ operation when in qscan (see manual).
{}
var
	br : camac_B;
	cr : camac_C;
	sn : camac_N;
	na : camac_A;
        fu : camac_F;
	long_data,num_word : word24;

begin
{ load amc reset operation in the comunication region with the isr}
	     decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
	     num_word:=long_data;
{F Ronga nov 1993 temporaneo per problema ultima parola in qstop}
	     if qmode=%X0002 then num_word := num_word+1;
{--- Load CAMP ---------------------------------------------------------}
             p^.mode_operation:=2;
             long_data:=(cr*512)+(sn*16)+na;
             fill_list(br,0,29,1,4,FALSE,FALSE,long_data);

	     if (qmode=%x0006) then	{QSCAN mode}
	     begin
	      	p^.mode_operation:=2;
       	      	long_data:=dma_end_n*16; {set QSCAN end address}
             	fill_list(br,0,29,1,5,FALSE,FALSE,long_data);
	     end;
		
{--- Load VMEGEN -------------------------------------------------------}
             p^.mode_operation:=2;
	     long_data:=%x3E;  {Address modifiers}
             fill_list(br,0,29,1,7,FALSE,FALSE,long_data);

{--- Load WCNT -------------------------------------------------------}
             p^.mode_operation:=3;
             fill_list(br,0,29,1,6,TRUE,FALSE,num_word);

{--- Load CSR1 -------------------------------------------------------}
             p^.mode_operation:=2;
	     long_data:=qmode;

	     if (long_operation) then long_data:=long_data+1;{tras 24}

	     long_data:=long_data+(fu*8); { load F }
	     long_data:=long_data+(1*256); {IRQ 5}
	     long_data:=long_data+(1*1024); {Arbitration}
	     long_data:=long_data+(1*32768); {Arm DMA}

             p^.mode_operation:=2;
             fill_list(br,0,29,1,0,FALSE,FALSE,long_data);



{----------------------- Interrupt management ---------------------}


{--- Reset chip ------------------------------------------------------}
		
	     long_data:=0;
	     p^.mode_operation:=2;
	     fill_list(br,0,29,1,8,TRUE,FALSE,long_data);

{--- Set mode bits to comon vector ------------------------------------}
		
	     long_data:=%x82;
	     p^.mode_operation:=2;
	     fill_list(br,0,29,1,8,TRUE,FALSE,long_data);


{--- Unmask all IRR bits ----------------------------------------------}
		
	     long_data:=%x20;
	     p^.mode_operation:=2;
	     fill_list(br,0,29,1,8,TRUE,FALSE,long_data);

{--- Byte count --------------------------------------------------------}
		
	     long_data:=%xe0;
	     p^.mode_operation:=2;
	     fill_list(br,0,29,1,8,TRUE,FALSE,long_data);

{--- Int.Vector --------------------------------------------------------}

		
	     long_data:=%x40;
	     p^.mode_operation:=2;
	     fill_list(br,0,29,1,8,FALSE,FALSE,long_data);
	
{--- Arm Int    --------------------------------------------------------}

		
	     long_data:=%xA1;
	     p^.mode_operation:=2;
	     fill_list(br,0,29,1,8,TRUE,FALSE,long_data);
	

{--- Set for ADRP -------------------------------------------------------}
	     p^.mode_operation:=7;
	     if (long_operation) then
		p^.spare:=0   {mark 24 bit transfer} 
	     else 
		p^.spare:=1;   {mark 16 bit transfer}
	     fill_list(br,0,29,1,3,TRUE,FALSE,long_data);

{--- Load CSR2 -------------------------------------------------------}

	     long_data:=%x80;        {start DMA}
             p^.mode_operation:=7;
	     p^.spare:=qmode;
	     fill_list(br,0,29,1,1,FALSE,FALSE,long_data);
end;               
{}

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

procedure fill_camac_list (filename : varying_string (80));

{}
{	This procedure open the file (filename ) in the vax/vms 
{	tha contains the camac list and reads and decodes the records.
{	For each record one or blocks like the following is filled:
{
{	1 word : 	cam_add  (camac_add) address the operation to execute
{	2 word :	mode_operation (byte) Kind of operation 
{	3 word :	data_to_write (packed record) Data for write operation
{			or used for other parameters
{	4 word :	next_equip (^camac_list) If filled points to the start
{			of the next equipment.
{	5 word :	next_elem (^camac_list) Points to the next element
{			of the list.
{
{	The pointer to the first element of an equipment list is contained in
{	the pointer_array. When the command trig n followed by the list
{       of the equipment (eqp) is received the list of equipment are
{	copied in an unique list (one for trigger).
{	The pointer to the first element of a trigger list is contained
{	in the trigger_array.
{       In case of select register is used a matrix of ^camac_list 
{	(select_matrix) that gives the pointer to the first element
{	of the selected part of an equipment.
{	I.e. select_matrix[1,5] means the in the selecct register 1
{	the bit 5 is set so is executed the associated list.
{	The following numbers gives what operation must be executed
{	(loaded in the mode_operation element of a camac list block
{
{ short_read 		      	0
{ long_read			1
{ short_write			2
{ long_write			3	
{ short_test 			4   
{ long_test			5   	
{ mark end equipment		6   
{ start dma transfer    	7
{  (loading MAR)	
{ short read of a module	8
{ long read of a module  	9
{ read select register   	10
{ read select block      	11
{ start equipment        	12 
{ execute user procedure	13
{ test acc lam			14
{ wait for q response		15
{ short write of a module 
{ (with the same a)             16
{ long write of a module 
{ (with the same a)             17
{ short write of a module 
{ (with different a)            18
{ long write of a module  
{ (with different a)            19
{ load data file                20
{ load unf. data file           21
{
{ added by F Ronga sept 1989
{ short read ignore q           22
{ long  read ignore q           23
{ short read of a module no q   24
{ long read of a module no q    25
{ Q read (last operation)       26
{ Q read for a new operation    27
{ short read stop q=0           28
{ long read stop q=0            29
{ short read qignore            30
{ long read qignore             31
{ short read sqstop             34
{ long read  sqstop             35
{    						
{ The test function (t) executes write operation or read without loading
{ data in memory. 
{}
type
	file_record = varying_string (80);
	list_command_type = (INIT,TRIG,RDTRIG,EQUIP,LAMCLR,LOAD,USER_PROCEDURE,
                             EOE,C,EOI,EOT,F,T,SET16,SET24,QIGNORE,
			     QREPEAT,QSCAN,DMAEND,QSTOP,
			     SELREG,SECT,SELECT,EOS,WAIT_Q,WR_SAME_A,
			     WR_DIFF_A,LOADF,LOOP,ENDL,
			     SETQ,SETNOQ,QREAD,EVSCA,TRMVAX,FQIGNORE,
			     FQSTOP,DEF_SETVETO,VME_RD_EX,VME_RD_ST,VME_WR_EX,
                             WFD_READOUT,WFD_MAP,WFD_PATREG,WFD_THRESH,
                             WFD_RDMEM,WFD_RDTIM,WRITEHEX,
			     SQSTOP,VME_WR_ST,VME16,VME32,DEF_RESVETO);
var 
	fill_camac_stato,i,ii,record_num : integer;
	list_file: file of file_record;
        ifil:file of integer;
        list_command : file_record;
        conv_list_command : list_command_type;
        fill_command:varying_string(80);
	status: integer;
	eof_found : boolean;
        long_operation:boolean;
	vme_long_operation:boolean;
	q_operation:boolean:=true;
        trig_num : byte; 
        equip_num,sect_num,select_num : byte;
        stop_dma,iover:byte;
        repet:word16;
        pointer_to_copy,remember_pointer,start_equip_pointer : ^camac_list;
	br : camac_B;
	cr : camac_C;
	sn : camac_N;
	na,num_add : camac_A;
        fu : camac_F;
	long_data,num_word:word24;
	nwords: integer;
	i1,i2 : integer2;
        tmpint, iwin, ilim, ism, ichan, iend, iinp, ival : integer;
        wfd_sm_base_addr, wfd_ch_base_addr : integer;
        pgd_add : ^VIC_pgd;

{---------------------- VIC variable declaration -------------------}


	vme_b : camac_B;
	vme_c : camac_C;
	vme_add : integer;
	vme_page : integer;
	pgd : VIC_pgd;
	map_found : boolean ;
	pg_add : ^integer;
	found_pgd : VIC_pgd;
	virtual_base_add : ^word32;
	istat, entry : integer;
	pgdnum,pgindex:integer;
	vme_data : integer;
{-------------- Surdo:}
        ipg,iipg : integer;
{-----------------------------}

function fill_exception of type exception_handler;
{exception if an error occurs}
var
	list_error_string: varying_string(255);
begin
          eln$get_status_text (signal_args.name,[],list_error_string);
          writeln (list_error_string) ;
          if ( signal_args.name=error_on_list) then begin
                   writeln ('Received : ',list_command);
                   writeln (' Received ',fill_command,' while in status ',
                   fill_camac_stato:3,' record num. ',record_num);
          end;
          if ( signal_args.name=BCoffline) then begin
                   writeln ('Received : ',list_command);
                   writeln (' Branch or Crate OFFLINE ');
          end;
	   list_error:=true;
           fill_exception:=true;
           if (fill_camac_stato>1) then p^.next_elem:=nil;  
           goto end_proc
end;	
{}

procedure pr_qstop;
begin
 	        fill_amc_list(%x0002,long_operation){qstop oper}
end;

procedure pr_dmaend;
begin
	     dma_end_n := convert(camac_N,scratch_string);{conversion of the crate num.}
end

procedure pr_qscan;
begin
 	      fill_amc_list(%x0006,long_operation,iover);{qscan oper}
end;

procedure pr_qrepeat;
begin
 	     fill_amc_list(%x0004,long_operation);
end;

procedure pr_qignore;
begin
             fill_amc_list(%x0000,long_operation);
end;

procedure pr_user_procedure;
begin
	         p^.data_to_write.low 
                                 := convert(word16,scratch_string);{proc. number}
	      	 p^.mode_operation :=13;
	      	 previus:=p;
	      	 new(p); {space for the next element}
	     	 previus^.next_elem:=p;
end;

procedure pr_vme_ex;

var i:integer;

begin
              
	      pgd.crate:=vme_c;
	      pgd.amcode:= VIC_EX_CODE;
              pgd.addr:= vme_page;
	      pgd.ok := 1;
              pgd.swap:=0;
	      map_found:=FALSE;
	      for i:=1 to npg_mapped[vme_b] do
               begin
{ page descr add = virtual base address+ MMU address + page address}

		pgdnum:=%x1000+vme_b*%x10+(i-1);

		pgd_add::integer := vic_base_add[vme_b]::integer+%x20000+
					pgdnum*4;		
		found_pgd:=pgd_add^;
       found_pgd.dont_care := 0;   {! Error/Status byte reset ! A.SURDO !!!!}
		if(found_pgd.full=pgd.full) then
		 begin
			map_found:=TRUE;		
			virtual_base_add:=
                                  saved_virt_base_add[(vme_b-1)*%x10+i];
                 end;            
	       end;
	      if(not(map_found)) then
               begin 

		pgdnum:=%x1000+vme_b*%x10+(npg_mapped[vme_b]);

		pgd_add::integer := vic_base_add[vme_b]::integer+%x20000+
					pgdnum*4;		

		pgd_add^:=pgd;
                kav$out_map(status:=istat,
			   entry:=entry,
			   page_count:=16,
                           bus_address:=vme_b*%x1000000 
					+npg_mapped[vme_b]*%x100000,
			   virtual_address:=virtual_base_add,
		           am_code:=kav$k_user_32,
                           map_functions := kav$m_vme+kav$m_mode_3_swap);

                 if not odd(istat) then                               
                        begin                                         
                          lock_mutex(write_mutex);                    
                          writeln(' VIC map  error during camaclist',
					hex(istat));      
                          unlock_mutex(write_mutex);                  
                       end;                                           

		pgindex:=(vme_b-1)*%x10+(npg_mapped[vme_b]+1);
		saved_virt_base_add[pgindex]:=virtual_base_add;            
                npg_mapped[vme_b]:=npg_mapped[vme_b]+1;

{ Modified to allow access to variables by ELN_VMS_SERVER.    A.Surdo }
                lock_area(save_vic_data,vic_data_p^.lock_vic);
                 vic_data_p^.npg_maps[vme_b] := npg_mapped[vme_b];
                 vic_data_p^.vic_adds[pgindex] := virtual_base_add;
                unlock_area(save_vic_data,vic_data_p^.lock_vic);

	       end;
end;


procedure pr_vme_st;

var i:integer;

begin

	      vme_b:=1;
	      pgd.crate:=vme_c;
	      pgd.amcode:= VIC_ST_CODE;
              pgd.addr:= vme_page;
	      pgd.ok := 1;
              pgd.swap:=0;
	      map_found:=FALSE;
	      for i:=1 to npg_mapped_st do
               begin
{ page descr add = virtual base address+ MMU address + page address}

		pgdnum:=%x1FF0+%xB+(i-1);

		pgd_add::integer := vic_base_add[vme_b]::integer+%x20000+
					pgdnum*4;		
		found_pgd:=pgd_add^;
       found_pgd.dont_care := 0;   {! Error/Status byte reset ! A.SURDO !!!!}
		if(found_pgd.full=pgd.full) then
		 begin
			map_found:=TRUE;		
			virtual_base_add:=
                                  saved_virt_base_add_st[i];
                 end;            
	       end;
	      if(not(map_found)) then
               begin 

		pgdnum:=%x1FF0+vme_b*%xB+npg_mapped_st;

		pgd_add::integer := vic_base_add[vme_b]::integer+%x20000+
					pgdnum*4;		

		pgd_add^:=pgd;
                kav$out_map(status:=istat,
			   entry:=entry,
			   page_count:=16,
                           bus_address:=%xB00000 
					+npg_mapped_st*%x100000,
			   virtual_address:=virtual_base_add,
		           am_code:=kav$k_user_24,
                           map_functions := kav$m_vme+kav$m_mode_2_swap);

                 if not odd(istat) then                               
                        begin                                         
                          lock_mutex(write_mutex);                    
                          writeln(' VIC standard map  error during camaclist',
					hex(istat));      
                          unlock_mutex(write_mutex);                  
                       end;                                           

		pgindex:=npg_mapped_st+1;
		saved_virt_base_add_st[pgindex]:=virtual_base_add;            
                if(npg_mapped_st <= 5) then
			npg_mapped_st:=npg_mapped_st+1;

{ Modified to allow access to variables by ELN_VMS_SERVER.    A.Surdo }
                lock_area(save_vic_data,vic_data_p^.lock_vic);
                 vic_data_p^.npg_map_st := npg_mapped_st;
                 vic_data_p^.vic_add_st[npg_mapped_st] := virtual_base_add;
                unlock_area(save_vic_data,vic_data_p^.lock_vic);

	       end;
end;


procedure pr_vme_st_master;

var i:integer;

begin

	      if ((vme_page <5 ) or (vme_page >7)) then 
	       begin
                lock_mutex(write_mutex);                    
                writeln(' VIC master map  error: ADDRESS NOT AVAILABLE');
                unlock_mutex(write_mutex);                  
               end
	      else
               begin		
	        if (master_virt_base_add_st[vme_page-4]::integer<>0) then
                 begin
		  virtual_base_add:= master_virt_base_add_st[vme_page-4];
                 end
		else
                 begin
                  kav$out_map(status:=istat,
			   entry:=entry,
			   page_count:=16,
                           bus_address:=vme_page*%x100000,
			   virtual_address:=virtual_base_add,
		           am_code:=kav$k_user_24,
                           map_functions := kav$m_vme+kav$m_mode_2_swap);

                  if not odd(istat) then                               
                        begin                                         
                          lock_mutex(write_mutex);                    
                          writeln(' VIC master standard map  error during camaclist',
					hex(istat));      
                          unlock_mutex(write_mutex);                  
                       end;                                           

		  master_virt_base_add_st[vme_page-4]:=virtual_base_add;            

{ Modified to allow access to variables by ELN_VMS_SERVER.    A.Surdo }
                  lock_area(save_vic_data,vic_data_p^.lock_vic);
                   vic_data_p^.mast_adds[vme_page-4] := virtual_base_add;
                  unlock_area(save_vic_data,vic_data_p^.lock_vic);

 	        end;
	     end;
end;

{------- Start of fill_camac_list body --------------------------------}

begin
        establish(fill_exception);
	
{----------------------------------------------------- Surdo }
      lock_area(save_vic_data,vic_data_p^.lock_vic);
       for i := 1 to 3 do begin
         npg_mapped[i] := vic_data_p^.npg_maps[i];
         for ipg := 1 to npg_mapped[i] do begin
           iipg:=(i-1)*%x10 + ipg;
           saved_virt_base_add[iipg] := vic_data_p^.vic_adds[iipg];
         end;
       end;
       npg_mapped_st := vic_data_p^.npg_map_st;
       for ipg := 1 to npg_mapped_st do
         saved_virt_base_add_st[ipg] := vic_data_p^.vic_add_st[ipg];
       for i := 1 to 3 do
         master_virt_base_add_st[i] := vic_data_p^.mast_adds[i];
      unlock_area(save_vic_data,vic_data_p^.lock_vic);

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

	fill_camac_stato:=1; {procedure status}
        long_operation:= FALSE;
        vme_long_operation:= FALSE;
	q_operation:=true;
	eof_found:=FALSE;
        for i:=1 to 255 do begin {dispose of memory}
         for ii:=1 to 255 do begin
          freememory (select_matrix[i,ii]);
          select_matrix[i,ii] :=nil;
         end; 
         freememory (trigger_array[i]);
         trigger_array[i] :=nil;
         freememory (pointer_array[i]);
         pointer_array[i] :=nil;
        end;
        freememory (pointer_for_init);
        pointer_for_init:=nil ;
	previus := nil;
	select_num:=0;
        record_num:=0;
	veto_present := FALSE;

	
{}

	open(list_file,
	     file_name := filename,
	     history := history$readonly);
	reset(list_file);
       writeln (' ');
       writeln ('...Reading List : ',filename);
	repeat
	 if not eof(list_file) then 
          begin
	   read(list_file,list_command);
           record_num:=record_num+1; 
{A.S.(22/6/94)           writeln ('Received : ',list_command); }
	   skip_blank (list_command,fill_command,scratch_string);
           conv_list_command := convert (list_command_type,fill_command);
           case fill_camac_stato of          

{-------------------------------------------------------------------}
1:  	  begin 
           case conv_list_command of
{}           


RDTRIG:     begin
             	decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);

       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
    		trigger_add.b := br;
		trigger_add.c := cr;
		trigger_add.n := sn;
		trigger_add.a := na;
		trigger_add.f := fu;
	    
 	    end;

DEF_SETVETO:   begin
             	decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);

       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
    		setveto.veto_add.b := br;
		setveto.veto_add.c := cr;
		setveto.veto_add.n := sn;
		setveto.veto_add.a := na;
		setveto.veto_add.f := fu;
                if (fu = 16) then
		begin
			setveto.data.full:=long_data;  
			setveto.testop:=FALSE;
		end
		else
			setveto.testop:=TRUE;

		veto_present := TRUE;
	      end;

DEF_RESVETO: begin
             	decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
    		resveto.veto_add.b := br;
		resveto.veto_add.c := cr;
		resveto.veto_add.n := sn;
		resveto.veto_add.a := na;
		resveto.veto_add.f := fu;
                if (fu = 16) then
		begin
			resveto.data.full:=long_data;  
			resveto.testop:=FALSE;
		end
		else
			resveto.testop:=TRUE;

		veto_present := TRUE;
 	   end;

EVSCA:     begin  {define register for event number (if any)}
	     ev_da_scala := true;
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
    	     event_add.b := br;
	     event_add.c := cr;
	     event_add.n := sn;
             event_add.a := na;
	     event_add.f := fu;
            end;

TRMVAX:     begin {define trigger list (if any)};
            decode_i1i2(scratch_string,i1,i2);
	    TR_LIST[i1].full := i2;	    
            end;

C:          begin
             {only comments}
            end; 

EQUIP:	    begin
	     equip_num := convert(byte,scratch_string);{equip. num}
	     new (p); {apro una nuova tabella di indirizzi camac}
	     p^.data_to_write.low:=equip_num;
	     p^.mode_operation:=12; 
	     pointer_array [equip_num]:=p; {load the pointer in the array}
	     previus:=p;
             new(p);
	     previus^.next_elem:=p;
             fill_camac_stato:=2;
	    end;

INIT:       begin
	     new (p); {new camac_list block}
	     pointer_for_init:=p; {memorize for init execution}
	     p^.data_to_write.low:=999; {init equip number}
	     p^.mode_operation:=99;
	     p^.next_equip:=NIL;
	     previus:=p;
	     new(p);
	     previus^.next_elem:=p;
	     fill_camac_stato:=3;
	    end;

TRIG:	    begin
	     trig_num := convert (byte,scratch_string);{trigger num.}
	     new(p);  {new block}
             trigger_array[trig_num]:=p; { load the pointer to the list}
             fill_camac_stato:=4; 
            end;
            
            otherwise raise_exception (error_on_list);
            end; {of case stato 1}
           end; {of stato 1}

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

2:	  begin
	   case conv_list_command of

T:	    begin
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             if (long_operation) then p^.mode_operation:=5 
	       else p^.mode_operation:=4;
             fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);
            end;

F:  	    begin
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             if (fu>15) and (fu<24) then {write function}
              begin 
	       if (long_operation) then p^.mode_operation:=3
                  else p^.mode_operation:=2;                       
              end
	     else {read function}
              begin
                if (long_data<>0) then {is a serie of operations}
                 begin
     	             if (long_operation)  then
			p^.mode_operation:=9
                     else 
		        p^.mode_operation:=8; 
                 end
                else  {is NOT a serie of operations}
                 begin
     	             if (long_operation)  then
			p^.mode_operation:=1
                     else 
		        p^.mode_operation:=0; 
                 end;  
	      end;
            fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);
            end;

SET16:      long_operation:= FALSE;

SET24:	    long_operation:= TRUE; 

VME16:      vme_long_operation := FALSE;

VME32:      vme_long_operation := TRUE;

SETQ:	    q_operation := true;

SETNOQ:	    q_operation := false;

QREAD:     begin
	    p^.mode_operation :=26;
            fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);
	    end;


FQSTOP:	    begin
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             if (fu>15) and (fu<24) then {write function}
	     else 
              begin
     	             if (long_operation) then
				p^.mode_operation:=29 
			else
				p^.mode_operation:=28; 
		                fill_list(br,cr,sn,na,fu,long_operation,
					     q_operation,long_data);
                end
            end;

SQSTOP:	    begin
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             if (fu>15) and (fu<24) then {write function}
	     else 
              begin
     	             if (long_operation) then
				p^.mode_operation:=35
			else
				p^.mode_operation:=34; 
		                fill_list(br,cr,sn,na,fu,long_operation,
					     q_operation,long_data);
                end
            end;

QIGNORE:    pr_qignore;

QREPEAT:    pr_qrepeat;

DMAEND:	    begin	
             pr_dmaend;
             fill_camac_stato:=5;
             end;

QSTOP:	    begin
             pr_qstop;
            end;

EOE:        begin
	     p^.mode_operation :=6;{end equipment}
             p^.next_elem:=NIL;
             fill_camac_stato := 1;
	     long_operation := FALSE;
	     vme_long_operation := FALSE;
	     q_operation := TRUE;
            end; 

C:          begin
             {only comments}
            end; 

SELREG:     begin
             if (long_operation) then p^.mode_operation:=10
              else p^.mode_operation:=10;{only short max 16 bits}
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);{new(p) is  in fill_list}

{}
             select_num:=select_num+1; {increment consecutive num} 
	     p^.data_to_write.low:=select_num; {load consecutive num.in list}
             p^.mode_operation:=11;
	     remember_pointer:=p;
             new(p);{creo lo spazio per il prossimo blocco della lista}
             remember_pointer^.next_elem:=p;{carico il point al nuovo blocco}   
             fill_camac_stato:=8;   
            end;

SECT:	     begin
              p^.mode_operation:=11;{end list of select}
              p^.next_elem:=nil;
	      sect_num := convert (byte,scratch_string);{new list}
              new(p);{creo lo spazio per il primo elemento della lista sect}
              select_matrix[select_num,sect_num]:=p;
             end;

USER_PROCEDURE: begin
                 pr_user_procedure;
	       end;

EOS:	     begin
              p^.mode_operation:=11;
	      p^.next_elem:=nil;
              p:=remember_pointer^.next_elem; {restore della lista}
             end;     	
WAIT_Q:     begin
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data,repet);
          if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             if repet=0 then  {max wait time}
                p^.spare:=2  {wait default to 20ms}
              else
                p^.spare:=repet;
             p^.mode_operation:=15;
             fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);
            end;
                                                   
                                                                        
LOOP:       begin                                                       
             p^.mode_operation:=32;                                     
             p^.spare := convert(integer,scratch_string);{num of loop}  
             previus:=p;                                                
             new (p); {apro una nuova tabella di indirizzi camac}       
             previus^.next_elem:=p;                                     
            end;                                                        
                                                                        
ENDL:       begin                                                       
             p^.mode_operation:=33;                                     
             previus:=p;                                                
             new (p); {apro una nuova tabella di indirizzi camac}       
             previus^.next_elem:=p;                                     
            end;                                                        

FQIGNORE:     begin                                                      
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);      
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             if (fu>15) and (fu<24) then {write function}                
             else                                                        
              begin                                                      
                     if (long_operation) then                            
                                p^.mode_operation:=31                    
                        else                                             
                                p^.mode_operation:=30;                   
                                fill_list(br,cr,sn,na,fu,
					long_operation,FALSE,long_data);     
                end                                                      
            end;                                                         
                                                                         
VME_RD_EX: begin
	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
					nwords);
	      pr_vme_ex;
              
{ Now fill camac_list block}
	     if (vme_long_operation) then
	     	begin
	     		p^.mode_operation:=50; 
	     		p^.l_mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
	    	end
	     else
		begin
	     		p^.mode_operation:=51; 
	     		p^.mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
		end;
	     p^.spare:=nwords;
	     previus:=p;
             new(p);
	     previus^.next_elem:=p;

	      
	    end;	


VME_RD_ST: begin

	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
 					nwords);
	      if (vme_b = 0) then
                 pr_vme_st_master
              else
                 pr_vme_st;	     

{ Now fill camac_list block}
	     if (vme_long_operation) then
	     	begin
	     		p^.mode_operation:=50; 
	     		p^.l_mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
	    	end
	     else
		begin
	     		p^.mode_operation:=51; 
	     		p^.mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
		end;
	     p^.spare:=nwords;
	     previus:=p;
             new(p);
	     previus^.next_elem:=p;

	      
	    end;	

VME_WR_EX: begin
	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
					vme_data);
	      pr_vme_ex;
              
{ Now fill camac_list block}
	     if (vme_long_operation) then
	     	begin
	     		p^.mode_operation:=52; 
	     		p^.l_mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
	    	end
	     else
		begin
	     		p^.mode_operation:=53; 
	     		p^.mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
		end;
	     p^.data_to_write.full:=vme_data;
	     previus:=p;
             new(p);
	     previus^.next_elem:=p;

	      
	    end;	


VME_WR_ST: begin

	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
 					vme_data);
	      if (vme_b = 0) then
                 pr_vme_st_master
              else
                 pr_vme_st;	     

{ Now fill camac_list block}
	     if (vme_long_operation) then
	     	begin
	     		p^.mode_operation:=52; 
	     		p^.l_mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
	    	end
	     else
		begin
	     		p^.mode_operation:=53; 
	     		p^.mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
		end;
	     p^.data_to_write.full:=vme_data;
	     previus:=p;
             new(p);
	     previus^.next_elem:=p;
	    end;	

WRITEHEX:  begin
              hextoint(scratch_string,tmpint);
              p^.data_to_write.full := tmpint;
              p^.mode_operation := 57;
	      previus:=p;
              new(p);
	      previus^.next_elem:=p;
           end;

WFD_PATREG:
           begin
              decode_i1i2i3(scratch_string,
                            tmpint,
                            p^.cam_add.full,
                            p^.data_to_write.full);
              p^.l_mem_add := address(wfd_spr[tmpint]);
              p^.mode_operation := 58;
	      previus:=p;
              new(p);
	      previus^.next_elem:=p;
           end;

WFD_RDMEM: begin
	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
					nwords);
	      pr_vme_ex;
              if (vme_long_operation) then
	         begin
                    p^.mode_operation:=54; 
	     	    p^.l_mem_add::integer:= virtual_base_add::integer+
		                            vme_add::integer;
	         end
              else
	         begin
	     	    p^.mode_operation:=54; 
	     	    p^.mem_add::integer:= virtual_base_add::integer+
		                          vme_add::integer;
	         end;
              p^.spare:=nwords;
	      previus:=p;
              new(p);
	      previus^.next_elem:=p;
	   end;	

WFD_READOUT:  
            { Example usage: WFD_READOUT 1,0,200000,5000               }
            { -------------------------------------------------------- }
            { The first argument is the supermodule number, which is   }
            { used to index the software pattern register array in     }
            { the CADRIVER readout code. The second argument is a mode }
            { select which is currently unused and undefined and       }
            { should always be set to zero. The third argument is the  }
            { default time window in 5 ns units. This initializes the  }
            { pattern register that stores the time window. It is      }
            { expected that in normal running, this register will be   }
            { dynamically filled by the STOP master if we use variable }
            { length delays. The fourth argument contains the limit    }
            { on the amount of data to readout, in bytes.              }
            { -------------------------------------------------------- }
            { ETK 16-Mar-1995                                          }
            begin
              decode_i1i2i3i4(scratch_string,ism,tmpint,iwin,ilim);
              p^.mode_operation:=56;
              p^.spare := ism;              {  <-  supermodule number  }
              wfd_spr[12+ism] := iwin;      {  <-  default time-window }
              p^.data_to_write.full := ilim;
              previus:=p;
              new(p);
              previus^.next_elem:=p;
	    end;	

WFD_RDTIM: begin
	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
					nwords);
	      pr_vme_ex;
	      if (vme_long_operation) then
	       	 begin
	     	    p^.mode_operation:=55; 
	     	    p^.l_mem_add::integer:= virtual_base_add::integer+
		                            vme_add::integer;
                 end
              else
	         begin
	     	    p^.mode_operation:=55; 
	     	    p^.mem_add::integer:= virtual_base_add::integer+
		                          vme_add::integer;
                 end;
              p^.spare:=nwords;
	      previus:=p;
              new(p);
	      previus^.next_elem:=p;
           end;

            otherwise raise_exception (error_on_list);
           end; {of case stato 2} 
           end; {of stato 2}


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

3:	  begin
case conv_list_command of

T:	    begin
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             if (long_operation) then p^.mode_operation:=5 
	       else p^.mode_operation:=4;
             fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);
            end;
            
F:	    begin
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             if (fu>15) and (fu<24) then
             begin 
	      if (long_operation) then p^.mode_operation:=3
                 else p^.mode_operation:=2;                       
              end
	     else 
              begin
	      if (long_operation) then p^.mode_operation:=5
                 else p^.mode_operation:=4;{in initi solo funzioni di test}
	      end;
             fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);
            end;

LOADF:      begin
             ind_file:=ind_file+1;
             write_file[ind_file]:=scratch_string;
             if (long_operation) then p^.spare:=1
                 else p^.spare:=0;{set long or short transfer}
	     p^.mode_operation :=20;
	     p^.data_to_write.low:=ind_file; {give the index for find the file}
             open(ifil,history:=history$readonly,
                   file_name := write_file[p^.data_to_write.low]);
             close(ifil);
	     previus:=p;
	     new(p); {space for the next element}
	     previus^.next_elem:=p;
	    end;

LOAD:      begin
             if (long_operation) then raise_exception (error_on_list);    
             ind_file:=ind_file+1;
             write_file[ind_file]:=scratch_string;
	     p^.mode_operation :=21;
	     p^.data_to_write.low:=ind_file; {give the index for find the file}
             open(ifil,history:=history$old,
                   file_name := write_file[p^.data_to_write.low],
	           record_type:=record$variable);
             close (ifil); {test if file is present}
	     previus:=p;
	     new(p); {space for the next element}
	     previus^.next_elem:=p;
	    end;

WR_SAME_A:  begin
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data,repet);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             p^.mode_operation:=16;
             p^.spare:=repet;{how many times?}
             fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);
            end;

WR_DIFF_A:  begin
             decode_bcnaf(scratch_string,br,cr,sn,na,fu,long_data,repet);
       if (not(table_br_cr[br][cr])) then raise_exception (BCoffline);
             p^.mode_operation:=18;
             p^.spare:=repet;{how many times?}
             fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);
            end;

SET16:      long_operation:= FALSE;

SET24:	    long_operation:= TRUE; 

SETQ:	    q_operation := true;

SETNOQ:	    q_operation := false;


USER_PROCEDURE: begin
                 pr_user_procedure;
	     	end;

QIGNORE:    pr_qignore;

QREPEAT:    pr_qrepeat;

DMAEND:	    begin	
             pr_dmaend;
             fill_camac_stato:=9;
             end;

QSTOP:	    begin
             pr_qstop;
            end;

EOI:	    begin
             dispose (p);
             previus^.next_elem:=nil;
	     long_operation := FALSE;
	     vme_long_operation := FALSE;
	     q_operation := TRUE;
             fill_camac_stato:=1 ;
  	    end;

C:          begin
             {solo commenti}
            end; 


QREAD:     begin
	    p^.mode_operation :=26;
            fill_list(br,cr,sn,na,fu,long_operation,q_operation,long_data);
	    end;

                                                                        
LOOP:       begin                                                       
             p^.mode_operation:=30;                                     
             p^.spare := convert(integer,scratch_string);{num of loop}  
             previus:=p;                                                
             new (p); {apro una nuova tabella di indirizzi camac}       
             previus^.next_elem:=p;                                     
            end;                                                        
                                                                        
ENDL:       begin                                                       
             p^.mode_operation:=31;                                     
             previus:=p;                                                
             new (p); {apro una nuova tabella di indirizzi camac}       
             previus^.next_elem:=p;                                     
            end;                                                        
                                                                        
{.........................................................................}
{ Commands added in the INIT section on request of A.Sanzgiri for WFD tests...
{                                                         A.Surdo, 28/3/'94.
{}

VME16:      vme_long_operation := FALSE;

VME32:      vme_long_operation := TRUE;

VME_RD_EX: begin
	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
					nwords);
	      pr_vme_ex;
              
{ Now fill camac_list block}
	     if (vme_long_operation) then
	     	begin
	     		p^.mode_operation:=50; 
	     		p^.l_mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
	    	end
	     else
		begin
	     		p^.mode_operation:=51; 
	     		p^.mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
		end;
	     p^.spare:=nwords;
	     previus:=p;
             new(p);
	     previus^.next_elem:=p;

	      
	    end;	

VME_RD_ST: begin

	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
 					nwords);
	      if (vme_b = 0) then
                 pr_vme_st_master
              else
                 pr_vme_st;	     

{ Now fill camac_list block}
	     if (vme_long_operation) then
	     	begin
	     		p^.mode_operation:=50; 
	     		p^.l_mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
	    	end
	     else
		begin
	     		p^.mode_operation:=51; 
	     		p^.mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
		end;
	     p^.spare:=nwords;
	     previus:=p;
             new(p);
	     previus^.next_elem:=p;

	      
	    end;	

VME_WR_EX: begin
	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
					vme_data);
	      pr_vme_ex;
              
{ Now fill camac_list block}
	     if (vme_long_operation) then
	     	begin
	     		p^.mode_operation:=52; 
	     		p^.l_mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
	    	end
	     else
		begin
	     		p^.mode_operation:=53; 
	     		p^.mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
		end;
	     p^.data_to_write.full:=vme_data;
	     previus:=p;
             new(p);
	     previus^.next_elem:=p;

	      
	    end;	


VME_WR_ST: begin

	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
 					vme_data);
	      if (vme_b = 0) then
                 pr_vme_st_master
              else
                 pr_vme_st;	     

{ Now fill camac_list block}
	     if (vme_long_operation) then
	     	begin
	     		p^.mode_operation:=52; 
	     		p^.l_mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
	    	end
	     else
		begin
	     		p^.mode_operation:=53; 
	     		p^.mem_add::integer:= virtual_base_add::integer+
		      			vme_add::integer;
		end;
	     p^.data_to_write.full:=vme_data;
	     previus:=p;
             new(p);
	     previus^.next_elem:=p;

	    end;	
{.........................................................................}

WFD_PATREG:
           begin
              decode_i1i2i3(scratch_string,
                            tmpint,
                            p^.cam_add.full,
                            p^.data_to_write.full);
              p^.l_mem_add := address(wfd_spr[tmpint]);
              p^.mode_operation := 58;
	      previus:=p;
              new(p);
	      previus^.next_elem:=p;
           end;

WFD_THRESH: begin
               decode_i1i2i3i4(scratch_string,
                               ism,ichan,iinp,ival);
               iend  := ichan MOD 2;
               ichan := ichan DIV 2;
               p^.spare := iinp;
               p^.cam_add.full := 1000*ism + 10*ichan + iend;
               p^.data_to_write.full := ival;
               p^.mode_operation := 59;
	       previus:=p;
               new(p);
	       previus^.next_elem:=p;
            end;

WFD_MAP:    begin
	      decode_vic_comm(scratch_string,vme_b,vme_c,vme_page,vme_add,
					tmpint);
              
              wfd_sm_base_addr := vme_page * %x100000 + vme_add;
              for ichan := 0 to 23 do
                 begin
                 for iend := 0 to 1 do
                    begin
                       wfd_ch_base_addr := wfd_sm_base_addr +
                                           (ichan*2+iend) * %x10000;
                       vme_page := wfd_ch_base_addr DIV %x100000;
                       vme_add  := wfd_ch_base_addr MOD %x100000;
                       pr_vme_ex;
                       wfd_chan_addr[tmpint,ichan,iend].virtual := 
                          virtual_base_add::integer+vme_add::integer;
                       wfd_chan_addr[tmpint,ichan,iend].actual :=
                          wfd_ch_base_addr;
                    end;
                 end;
	    end;	

WRITEHEX:   begin
               hextoint(scratch_string,tmpint);
               p^.data_to_write.full := tmpint;
               p^.mode_operation := 57;
	       previus:=p;
               new(p);
	       previus^.next_elem:=p;
            end;

            otherwise raise_exception (error_on_list);
           end; {of case stato 3}  
          end; {of stato 3}
{---------------------------------------------------------------------------}
4:	begin
	  case conv_list_command of
{}
EQUIP:     begin
  	    skip_blank (scratch_string,user_string,scratch_string);
	    equip_num := convert (byte,user_string);
	    pointer_to_copy := pointer_array[equip_num];{punta alla lista}
	    start_equip_pointer:=p;{save pointer to the first}
	    while (pointer_to_copy<>NIL) do begin
 	     p^:=pointer_to_copy^ ;{ricopio l'elemento di lista}
	     previus:=p; {salvo il puntatore}
             new(p);
	     previus^.next_elem :=p; {puntatore nella lista precedente}
	     pointer_to_copy:=pointer_to_copy^.next_elem;
            end;
	    start_equip_pointer^.next_equip:=p;
           end;

EOT:	   begin
            dispose (p);
	    start_equip_pointer^.next_equip:=NIL;
            previus^.next_elem:=NIL;
            fill_camac_stato:=1 ;
  	   end;

C:          begin
             {solo commenti}
           end; 

           otherwise raise_exception (error_on_list);
           end; {of case stato 4}
          end; {of stato 4}
{-------------------------------------------------------------------------}
5:	  begin
	   case conv_list_command of
{}
QSCAN:	     begin
              pr_qscan;
	      fill_camac_stato:=2;
             end;
             otherwise raise_exception (error_on_list);
            end; {of case stato 5}
           end; {of stato 5}
		

{-------------------------------------------------------------------------}
7: 	   begin
           {error status wait for end of file}
           end; {of case stato 7}
{-------------------------------------------------------------------------}
8:	  begin
	   case conv_list_command of
{}
SECT:	     begin
	      sect_num := convert (byte,scratch_string);
              new(p);{creo lo spazio per il primo elemento della lista sect}
              select_matrix[select_num,sect_num]:=p;
              fill_camac_stato:=2;
             end;

             otherwise raise_exception (error_on_list);
            end; {of case stato 8}
           end; {of stato 8}

{-------------------------------------------------------------------------}
9:	  begin
	   case conv_list_command of
{}
QSCAN:	     begin
              pr_qscan;
	      fill_camac_stato:=3;
             end;
             otherwise raise_exception (error_on_list);
            end; {of case stato 9}
           end; {of stato 9}
		
{--------------------------------------------------------------------------}


          end; {of case sugli stati}
         end{dell'if sull eof}
	else {ho trovato l'eof}
	  begin
	   eof_found:=true;
	   fill_camac_stato:=1;
           writeln ('Ready ... ');
           writeln (' ');
	  end;	
	until eof_found;
end_proc: close (list_file);
end;