455 lines
13 KiB
Fortran
455 lines
13 KiB
Fortran
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
|
|
|
|
!
|
|
|
|
|