program CAD4L
!
!       Program to load 11/02 or Falcon or Falcon+ from PC
!
	external        cad4_pre_dummy,cad4_type_error,cad4_post_dummy
	external        cad4_load_syspar,cad4_restart_load,cad4_prompt
	external        cad4_check_type
!
      COMMON /CADCON/ ALPHA,APMIN,APMAX,MAXVAR,MINVAR,
     $                IHOLE,IVSLIT,IHSLIT,INEG45,IPOS45,IUPHAF,ILOHAF,
     $                VUTHT,VUOME,VUCHI,VUPHI,IPORT,IBAUD
      include 'CAD4COMM'    ! include common block                    
!
! First open log file
!
	call cad4_open_log_file
!
! Get instument number from process name and save it into common block
!
	call cad4_get_instrument
!
! Initialize terminal connected to 11/02
!
	call cad4_read_gon_file (1)
	call cad4_ini_terminal
!
! Initialize block number (count io transfers)
!
	io_cobnr = 0
!
! Initialize 11/02
!
	call cad4_io (f_init,cad4_pre_dummy,cad4_type_error,
     1          cad4_type_error,cad4_type_error,cad4_type_error,
     2          cad4_type_error,cad4_type_error,cad4_check_type,
     3          cad4_type_error)
!
! Select normal preprocessing routine
!
	io_prompt_flag = 0
!
! Read the goniometer ini file and write info into common block
!
	call cad4_read_gon_file (2)
!
! Transmit syspar values to 11/02
!
	slave_load_address = lsypar
	nr_load_byte = 64               !load 32 words to lsypar
	call cad4_io (f_xfr_mem,cad4_load_syspar,cad4_type_error,
     1          cad4_type_error,cad4_type_error,cad4_type_error,
     2          cad4_type_error,cad4_type_error,cad4_restart_load,
     3          cad4_post_dummy)
!
! Define the proper file for the slave computer
!
	mon_file_spec(1:22) = 'LSI_11.EXE'
	if (bvers_c .eq. 'C') mon_file_spec(1:22) = 'FALCON.EXE'
	if (bvers_c .eq. 'E') mon_file_spec(1:22) = 'FALCNP.EXE'
!
! LOAD THE SLAVE COMPUTER
!
	call cad4_load_lsi(mon_file_spec,load_error)
!
! START THE MOTHER TASK
!
	mother_file_spec = def_mother_spec
	call cad4_start_mother
!
	stop
	end
!
!
	Subroutine cad4_read_gon_file (ISWT)
C-----------------------------------------------------------------------
C  Read the CAD-4 Goniometer constants file (goniom.ini) for the
C  relevant system parameter values in SYSPAR_VAL.
C-----------------------------------------------------------------------
      COMMON /CADCON/ ALPHA,APMIN,APMAX,MAXVAR,MINVAR,
     $                IHOLE,IVSLIT,IHSLIT,INEG45,IPOS45,IUPHAF,ILOHAF,
     $                VUTHT,VUOME,VUCHI,VUPHI,IPORT,IBAUD
      COMMON /INFREE/ IFREE(20),RFREE(20),ICFLAG
      COMMON /FREECH/ OCHAR
      CHARACTER OCHAR*100,CKEY*6
	include 'CAD4COMM'          ! include common block
C-----------------------------------------------------------------------
C  Attach goniom.ini to unit 9
C-----------------------------------------------------------------------
      OPEN (UNIT=9, ACCESS='SEQUENTIAL', FILE='goniom.ini',
     $      STATUS='OLD', ERR=20)
C-----------------------------------------------------------------------
C  Set the SYSPAR_VAL values to SYSPAR_DEF for safety
C-----------------------------------------------------------------------
      IF (ISWT .EQ. 2) THEN
	DO 90 I = 1,32
	  SYSPAR_VAL(I) = SYSPAR_DEF(I)
   90   CONTINUE
C-----------------------------------------------------------------------
C  Set the invariant SYSPAR_VAL parameters to local values
C-----------------------------------------------------------------------
	SYSPAR_VAL( 7) =  6
	SYSPAR_VAL( 8) =  0
	SYSPAR_VAL( 9) = 18
	SYSPAR_VAL(10) =  2
	SYSPAR_VAL(16) =  0
      ENDIF
C-----------------------------------------------------------------------
C  Read a value from goniom.ini.  Ignore lines starting with /
C-----------------------------------------------------------------------
  100 READ (9,11000,END=200) OCHAR
11000 FORMAT (A)
      IF (OCHAR(1:1) .EQ. '/') GO TO 100
      CKEY = OCHAR(1:6)
      IF (CKEY .EQ. 'Dfmodl') GO TO 100
      OCHAR(1:6) = ' '
      CALL FREEFM (1000)
      IVAL = IFREE(1)
C-----------------------------------------------------------------------
C  Get the Port and Baudrate
C-----------------------------------------------------------------------
      IF (ISWT .EQ. 1) THEN
	IF (CKEY .EQ. 'Port  ') THEN
	  IPORT = IVAL
	ELSE IF (CKEY .EQ. 'Baud  ') THEN
	  IBAUD = IVAL
	ENDIF
C-----------------------------------------------------------------------
C  Get SYSPAR values for CAD4L routine
C-----------------------------------------------------------------------
      ELSE
	IF (CKEY .EQ. 'Hivolt') THEN
	  SYSPAR_VAL(1) = 255 - (IVAL - 255)/3
	ELSE IF (CKEY .EQ. 'Lolevl') THEN
	  SYSPAR_VAL(2) = 255 - IVAL/5
	ELSE IF (CKEY .EQ. 'Window') THEN
	  SYSPAR_VAL(3) = 255 - IVAL/5
	ELSE IF (CKEY .EQ. 'Deadtm') THEN
	  I45 = 9105330*RFREE(1)/5.3
	  I4 = I45/32768
	  SYSPAR_VAL(4) = I4
	  SYSPAR_VAL(5) = I45 - I4*32768
	ELSE IF (CKEY .EQ. 'Termbd') THEN
	  IVAL = 3*38400/IVAL
	  SYSPAR_VAL(6) = IAND(IVAL,255)
	ELSE IF (CKEY .EQ. 'Thgain') THEN
	  SYSPAR_VAL(11) = IVAL
	ELSE IF (CKEY .EQ. 'Phgain') THEN
	  SYSPAR_VAL(12) = IVAL
	ELSE IF (CKEY .EQ. 'Omgain') THEN
	  SYSPAR_VAL(13) = IVAL
	ELSE IF (CKEY .EQ. 'Kagain') THEN
	  SYSPAR_VAL(14) = IVAL
	ELSE IF (CKEY .EQ. 'Digain') THEN
	  SYSPAR_VAL(15) = IVAL
	ELSE IF (CKEY .EQ. 'Milamp') THEN
	  SYSPAR_VAL(17) = (3*(IVAL - 10))/10
	ENDIF
      ENDIF
      GO TO 100
  200 CLOSE (UNIT = 9)
      RETURN
!
! On error load default values for syspar
!
20      do 30 i=1,32
	   syspar_val(I) = syspar_def(I)
30      continue
	return
	end
!
!
	Subroutine      cad4_restart_load
!
! Subroutine to restart load detached process
!
!       1.      reset communication terminal
!       2.      create detached process
!       3.      exit current process
!
	include 'CAD4COMM'          ! Include common block
!       character*120   error_mess
!
!
! 1.  reset communication terminal
!
	call cad4_reset_terminal
!
! 2. Create detached process
!
!       process_name_c(5:5) = 'E'
!       exmess_status = sys$creprc (,process_image_c,,,
!    1                          'E_err_'//ibycan_c(2:4),,,
!    2                          process_name_c,
!    3                          %val(process_prio_l),
!    4                          %val(process_uic_l),,)
!       if (.not.exmess_status) then
!           call cad4_send_oper4 (' Cannot create new load process')
!           io_status = sys$getmsg (%val(exmess_status),i,error_mess,,)
!           if (.not.io_status) call lib$signal(%val(io_status))
!           call cad4_send_oper4 (error_mess(1:i))
!       end if
!
! 3. Exit current process
!
!       call sys$exit (%val(exmess_status))
	stop
	end
!
!
	Subroutine      cad4_start_mother
!
! Subroutine to start detached process with mother image name
!       modified: 03-jan-1985 LCB Flag SBC target processor in uic spec
!
!       1.      reset communication terminal
!       2.      create detached process
!       3.      exit current process
!
	include 'CAD4COMM'          ! Include common block
!       character*120   error_mess
!
! 1. reset communication terminal
!
	call cad4_reset_terminal
!
!
! 2. Create detached process
!
	if (bvers_c.eq.'C') then
	  process_uic_w(1) = process_uic_w(1).or. #40
	else
	  process_uic_w(1) = process_uic_w(1).and. #ffbf
	end if
	process_name_c(1:6)='NRCCAD'
!       exmess_status = sys$creprc (,mother_file_spec,,,
!    1                          'M_err_'//ibycan_c(2:4),,,
!    2                          process_name_c,
!    3                          %val(process_prio_l),
!    4                          %val(process_uic_l),,)
!       if (.not.exmess_status) then
!           call cad4_send_oper4 (' Cannot create mother process')
!           io_status = sys$getmsg (%val(exmess_status),i,error_mess,,)
!           if (.not.io_status) call lib$signal(%val(io_status))
!           call cad4_send_oper4 (error_mess(1:i))
!       end if
!
! 3. Exit current process
!
!       call sys$exit (%val(exmess_status))
	stop
	end
!
!
	Subroutine      cad4_load_lsi (filename,ierr)
!
! Subroutine to load LSI via terminal line
!       modified: 03-jan-85 LCB Enable load of complete disc blocks
!
!               filename        ASCII filename string
!               ierr            0 - success
!                              -1 - file open error
!                              -2 - read error
!
	character*(*)   filename
	integer         io_incr
!
	external        cad4_codx,cad4_type_error,cad4_restart_load
	external        cad4_post_dummy
	include 'CAD4COMM'  ! Include Instrument common block
!
!
! First open task image file
!
	open (access='direct',
     1  form='unformatted',file=filename,
     2  recl=512,status='old',unit=1,err=20,
     3  iostat=img_io_status)
!
	write (l_unit,10010) filename(1:30)
10010   format (' cad4_load_lsi : task image filename = ',a30)
!
! Read first record to get base address, load size and transfer
!               address of task image file
!
	img_io_record = 1               ! First record has length in bytes
	read (1,rec=img_io_record,
     1          iostat=img_io_status,err=30) img_io_buffer_l
	img_io_bsa = img_io_buffer_w(#8/2 + 1)  ! Get base address
	img_io_ldz = img_io_buffer_w(#e/2 + 1)  ! Load size (in 32. word blocks)
	img_io_xfr = img_io_buffer_w(#e8/2 + 1) ! Transfer address
	write (l_unit,10020) img_io_bsa, img_io_ldz, img_io_xfr
10020   format ('               : base address = ',z6,/,
     1          '                 load size    = ',z6,
     2          ' 32-word-blocks',/,
     2          '                 XFR address  = ',z6)
!
! Reset buffer pointer and record number for read 
!
	img_io_pointer = 256            ! Offset 256 to force read
	img_io_record  = 3              ! Skip LUN block
	if (bvers_c .eq. char(0)) then
	  io_incr = 2
	else
	  io_incr = 8
	end if
!
10      if (img_io_pointer.ge.256.and.img_io_ldz.gt.0) then
	    read (1,rec=img_io_record,
     1                  iostat=img_io_status,err=30) img_io_buffer_l
	    write (l_unit,10030) img_io_record
10030       format ('               : record ',i3,' read from disk')
	    img_io_record  = img_io_record + 1  ! Inc. record no.
	    img_io_pointer = 0                  ! Reset pointer
	end if
!
	call cad4_io (f_xfr_mem,cad4_codx,
     1          cad4_type_error,cad4_type_error,cad4_type_error,
     2          cad4_type_error,cad4_type_error,cad4_type_error,
     3          cad4_restart_load,cad4_post_dummy)
!
	img_io_ldz      = img_io_ldz - io_incr  ! Dec. no. of 32 word blocks
	img_io_pointer  = img_io_pointer + io_incr*32 ! Adjust pointer (words)
	img_io_bsa      = img_io_bsa + io_incr*32*2     ! Base address (bytes)
!
	if (img_io_ldz.ge.(1-io_incr)) goto 10          ! Loop
!
! Here if normal end
!
	close (unit=1)                  ! Close task image file
	ierr = 0
	return
!
! Here if unable to open task image file
!
20      ierr = -1
	    write (l_unit,10040) img_io_status
10040       format (' File open error : ',i5)
	return
!
! Here if read error
!
30      ierr = -2
	close(unit=1)
	    write (l_unit,10050) img_io_status
10050       format (' File read error : ',i5)
	return
	end
!
	Subroutine      cad4_check_type (result)
!
! Postprocessing routine for IO call in initialze 11/02
!       output: bvers  !bootstrap version character
!               lsypar !address of lsi system parameters
!
	include 'CAD4COMM'  ! Include common block
!
!       check if bootstrap version is returned
!
!  input_length .eq. 0                      means LSI_11 interface
!               .ne. 0 and bvers_c .eq. 'C' means Falcon interface
!               .ne. 0 and bvers_c .eq. 'E' means Falcon+ interface
      if(input_length .le. 0) then
	lsypar = lsi_bottom - #40
	bvers_c = char(0)
      else
	bvers = input_data(1)
	if (bvers_c .eq. 'C') lsypar = sbc_bottom - #40
	if (bvers_c .eq. 'E') lsypar = sbcp_bottom - #40
      endif
	write (l_unit,10000) bvers_c, lsypar
10000   format(' Cad4_Check_Type: Prom version - ',z4/
     $         '                  lsypar -       ',z8)
	return
	end
!
	Subroutine      cad4_codx
!
! Preprocessing routine for IO call in cad4_load_lsi
!       modified: 03-jan-1985 LCB to enable load of complete blocks
!
	include 'CAD4COMM'  ! Include common block
!
	if (img_io_ldz.gt.0) then               ! Normal memory block
	  if (bvers_c .eq. char(0)) then
	    if (img_io_ldz.eq.1) then
	      len = 1*32                        ! Last 32. word block
	    else
	      len = 2*32                        ! All other blocks
	    end if
	  else
	    if (img_io_ldz.ge.8) then           !complete block?
	      len = 8*32                        !yes!
	    else
	      len = img_io_ldz*32               !last 32 word blocks
	    end if
	  end if
!
	  do i = 1, len
	    output_data_w(i+1) = img_io_buffer_w(i+img_io_pointer)
	  end do
!
	  output_data_w(1) = img_io_bsa         ! Set load address
	  output_length    = len*2 + 2          ! Length (bytes)
!
	else
	  output_data_w(1) = img_io_xfr         ! Set start address
	  output_length    = 2                  ! One word
	end if
!
	return
	end
!
!               
	subroutine cad4_prompt
!
!       Pre processing routine to set up a prompt message
!       to be printed on 11/02 CAD4 terminal
!
	include 'CAD4COMM'
	n = 6
!
	if (io_prompt_flag .ne. 0) then
	   if (io_prompt_flag .gt. 0) then
!
! Put command error into buffer
!
		output_buffer(6)  = #0d       ! write CR
		output_buffer(7)  = #0a       ! write LF
		output_buffer_c (8:27) = 'C4L -- command-error'
		n = 28
	   else
!
! Put i/o error into buffer
!
		output_buffer(6)  = #0d       ! write CR
		output_buffer(7)  = #0a       ! write LF
		output_buffer_c (8:23) = 'C4L -- i/o-error'             
		n = 24
	   end if
	end if
!
! Put 'C4L>' prompt into buffer
!
	output_buffer(n)   = #0d       ! write CR
	output_buffer(n+1) = #0a      ! write LF
	output_buffer_c (n+2:n+5) = 'C4L>'
!
	output_length = n+2
	return
	end             

!