518 lines
14 KiB
Fortran
518 lines
14 KiB
Fortran
!
|
|
! This is a set of FORTRAN subroutines for PDP11/02 and
|
|
! VAX/VMS CAD4 application.
|
|
!
|
|
! H. Lenk 8-Jun-1983
|
|
Subroutine cad4_io (io_func,io_pre,io_post0,io_post1,io_post2,
|
|
1 io_post3,io_post4,io_post5,io_post6,io_post7)
|
|
!
|
|
! Subroutine for protocol I/O with LSI 11
|
|
!
|
|
! io_func (byte) - function code from VAX to 11/02
|
|
! io_pre (addr) - address of pre-processing routine
|
|
! io_postn(addr) - address of post-processing routine n
|
|
! depending on function bits in input_header
|
|
! (received from 11/02)
|
|
!
|
|
integer*2 head02 !input header in word mode
|
|
!
|
|
include 'CAD4COMM' !Include common block
|
|
!
|
|
! input:
|
|
! io_coswr (word) - switch options register from vax to 11/02
|
|
! io_cobnr (word) - no. of calls to 11/02
|
|
! io_cohex (byte) - header from VAX to 11/02
|
|
!
|
|
! IO_COHEX is copied into OUTPUT_HEADER byte
|
|
!
|
|
! Prepare for next protocol message:
|
|
! a) previous result is assumed to be successfull
|
|
! b) block number of protocol message is one higher than previous one
|
|
!
|
|
result = e_suc
|
|
io_cobnr = io_cobnr + 1
|
|
!
|
|
10 continue
|
|
! Define header of protocol message
|
|
! bit 0-1 : seq. no. of the calls to LSI-11
|
|
! bit 2-4 : result code
|
|
! bit 5-7 : function
|
|
!
|
|
io_cohex = io_func + result + iand(io_cobnr,m_seq)
|
|
!
|
|
! Call pre processing routine to fill the output_buffer
|
|
!
|
|
call io_pre
|
|
!
|
|
! Move transmit header to transfer buffer
|
|
!
|
|
output_header = io_cohex
|
|
!
|
|
! Transfer buffer to LSI-11 and wait for answer
|
|
!
|
|
call cad4_readprompt (result)
|
|
!
|
|
! Check for succesfull reception of answer
|
|
!
|
|
if (result .ne. e_suc) go to 10
|
|
!
|
|
! Check if LSI-11 was able to interprete our transmitted data well
|
|
!
|
|
head02 = input_header !integer*2 header for IAND's
|
|
if (iand(head02,m_efl) .eq. e_suc) go to 30
|
|
!
|
|
! Now we are disappointed but check if LSI-11 wants a new start
|
|
!
|
|
if (iand(head02,m_efl+m_fun).ne.
|
|
1 iand(#ff,f_req_mem+e_typ)) goto 10
|
|
!
|
|
!
|
|
! If seq. no. correct
|
|
!
|
|
30 if (iand(io_cobnr,m_seq).eq.iand(head02,m_seq)) go to 40
|
|
!
|
|
! Transfer sequence error
|
|
!
|
|
result = e_seq
|
|
go to 10
|
|
!
|
|
! Select the post processing routine
|
|
!
|
|
40 n = iand(head02,m_fun) / #20
|
|
!
|
|
! write (l_unit,10010) n
|
|
10010 format(' cad4_io : received function dispatch = ',z2)
|
|
!
|
|
go to (100,101,102,103,104,105,106,107) n+1
|
|
100 call io_post0(result)
|
|
go to 200
|
|
101 call io_post1(result)
|
|
go to 200
|
|
102 call io_post2(result)
|
|
go to 200
|
|
103 call io_post3(result)
|
|
go to 200
|
|
104 call io_post4(result)
|
|
go to 200
|
|
105 call io_post5(result)
|
|
go to 200
|
|
106 call io_post6(result)
|
|
go to 200
|
|
107 call io_post7(result)
|
|
!
|
|
! Check post processing error and eventual
|
|
! initialization of 11/02
|
|
!
|
|
200 if (result .eq. e_typ) then
|
|
if (io_func .eq. f_init) result = e_suc
|
|
goto 10
|
|
else
|
|
if (result .ne. e_suc) goto 10
|
|
end if
|
|
return
|
|
end
|
|
!
|
|
!
|
|
subroutine cad4_load_syspar
|
|
!
|
|
! Pre processing routine to copy syspar values from syspar_val
|
|
! to output buffer
|
|
!
|
|
include 'CAD4COMM'
|
|
!
|
|
! Copy syspar data to output_buffer
|
|
!
|
|
do i=1,((nr_load_byte+1)/2)
|
|
output_data_w(i+1) = syspar_val(i)
|
|
end do
|
|
!
|
|
! Set load address
|
|
!
|
|
output_data_w(1) = slave_load_address
|
|
!
|
|
! Set output length
|
|
!
|
|
output_length = nr_load_byte + 2
|
|
!
|
|
return
|
|
end
|
|
!
|
|
!
|
|
Subroutine cad4_send_oper4 (text)
|
|
!
|
|
! Routine to send message to operator
|
|
!
|
|
character*(*) text ! Input string
|
|
!
|
|
include 'CAD4COMM' ! Include common block
|
|
!
|
|
print *,text
|
|
return
|
|
end
|
|
!
|
|
!
|
|
Subroutine cad4_get_instrument
|
|
!
|
|
! Subroutine to insert ASCII instrument name and logical*1
|
|
! unit number to CAD4 instrument into fortran common block
|
|
!
|
|
! modified: 03-jan-1985 LCB Adaption for SBC-21 (Falcon processor)
|
|
!
|
|
! A process name of 'CAD4?_CAn' is required !!!!!!
|
|
!
|
|
include 'CAD4COMM' ! Include common block
|
|
!
|
|
ibycan_c(2:4) = 'CA0' ! Set default
|
|
ibycan_b(1) = 0 ! name and unit
|
|
!
|
|
! For now assume a Falcon by setting UIC = #40
|
|
!
|
|
process_uic_w(1) = #40
|
|
!
|
|
if ((process_uic_w(1).and.#40).ne.0) then
|
|
lsypar = sbc_bottom - #40
|
|
else
|
|
lsypar = lsi_bottom - #40
|
|
end if
|
|
if ((process_uic_w(1).and.#20).ne.0) then
|
|
lsypar = sbcp_bottom - #40
|
|
end if
|
|
!
|
|
! write (l_unit,10020) ibycan_c(2:4), ibycan_b(1)
|
|
10020 format (' Instrument name = ',a3,' Unit = ',i3)
|
|
!
|
|
return
|
|
end
|
|
!
|
|
!
|
|
Subroutine cad4_ini_terminal ! Initialize terminal
|
|
!
|
|
CHARACTER PORT*4
|
|
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
|
|
!
|
|
cad4_terminator(1) = 0 ! Short form
|
|
cad4_terminator(2) = 0 ! No terminator characters
|
|
!
|
|
PORT = 'COM'//CHAR(IPORT+48)
|
|
call io_init (PORT,IBAUD,8,'n',1)
|
|
write (l_unit,10060) PORT,IBAUD
|
|
10060 format (' Port ',A,': set to 'I5,',8,n,1')
|
|
!
|
|
return
|
|
end
|
|
!
|
|
Subroutine cad4_exit_handler(exit_status) ! Exit handler
|
|
!
|
|
include 'CAD4COMM' ! Include common block
|
|
!
|
|
!
|
|
! if (l_unit_open) close (unit=l_unit) ! Close Log file if open
|
|
l_unit_open = .false. ! Set false
|
|
!
|
|
exit_status = exit_status
|
|
return ! Return
|
|
end
|
|
!
|
|
!
|
|
Subroutine cad4_reset_terminal ! Routine to reset cad4 terminal
|
|
!
|
|
include 'CAD4COMM' ! Include common block
|
|
!
|
|
qio_status = io_done ()
|
|
!
|
|
! de-allocate cad4 communication channel
|
|
!
|
|
return ! Return to caller
|
|
end
|
|
!
|
|
!
|
|
Subroutine cad4_readprompt(result)
|
|
!
|
|
! Arguments used :
|
|
!
|
|
! prompt_buffer ! Buffer to save prompt
|
|
! prompt_length ! No of data bytes to send
|
|
! input_buffer ! Input buffer to read record
|
|
!
|
|
include 'CAD4COMM' ! Include common block
|
|
!
|
|
! First compute checksum and insert it at the end of output buffer
|
|
! (compute total prompt size)
|
|
!
|
|
call cad4_prepare_output
|
|
!
|
|
! write (l_unit,10010) (prompt_buffer(l),l=1,prompt_size)
|
|
10010 format (' ttyreadpall - Prompt = ',20(z4,1x))
|
|
! write (l_unit,10020) prompt_header
|
|
10020 format (' - Header = ',z4)
|
|
! write (l_unit,10030) prompt_length
|
|
10030 format (' - Length = ',z7)
|
|
! write (l_unit,10035) isum_w
|
|
10035 format (' - CRC = ',z8,' sending header')
|
|
!
|
|
! Perform QIO to send prompt and read header
|
|
!
|
|
! qio_status = sys$qiow (%val(cad4_efn),%val(cad4_chan),
|
|
! 1 %val(io_funct),cad4_iosb,,,
|
|
! 2 %ref(input_buffer), ! p1 = input buffer
|
|
! 3 %val(1), ! p2 = input size
|
|
! 4 %val(cad4_l_timo), ! p3 = timeout count
|
|
! 5 %ref(cad4_terminator(1)), ! p4 = term. mask
|
|
! 6 %val(%loc(prompt_buffer)), ! p5 = prompt buffer
|
|
! 7 %val(prompt_size) ) ! p6 = prompt b. size
|
|
!
|
|
qui_status = io_prompt (cad4_iosb,
|
|
$ input_buffer,
|
|
$ 1,
|
|
$ cad4_l_timo,
|
|
$ prompt_buffer,
|
|
$ prompt_size)
|
|
!
|
|
if (iand(cad4_iosb_i2(1),1) .eq. 1) then
|
|
!
|
|
! Now read length and crc or data bytes from PDP11/02
|
|
!
|
|
cad4_iosb(1) = 0 ! Be sure length and
|
|
cad4_iosb(2) = 0 ! io-status is zero
|
|
!
|
|
! qio_status = sys$qiow (%val(cad4_efn),%val(cad4_chan),
|
|
! 1 %val(io_funct),cad4_iosb,,,
|
|
! 2 %ref(input_buffer(2)), ! p1 = input buffer
|
|
! 3 %val(4), ! p2 = input size
|
|
! 4 %val(cad4_timeout), ! p3 = timeout count
|
|
! 5 %ref(cad4_terminator(1)),,) ! p4 = term. mask
|
|
!
|
|
!
|
|
qio_status = io_read (cad4_iosb,
|
|
$ input_buffer(2),
|
|
$ 4,
|
|
$ cad4_timeout)
|
|
!
|
|
! write (l_unit,10040) input_header
|
|
10040 format (' - InpHdr = ',z4)
|
|
! write (l_unit,10050) input_length
|
|
10050 format (' - InpLen = ',z7)
|
|
!
|
|
input_size = 4
|
|
if((iand(cad4_iosb_i2(1),1) .eq. 1) .and.
|
|
$ input_length .ne. 0) then
|
|
!
|
|
! Now read data bytes from PDP11/02
|
|
!
|
|
cad4_iosb(1) = 0 ! Be sure length and
|
|
cad4_iosb(2) = 0 ! io-status is zero
|
|
!
|
|
input_size = input_length !(n-2)Data bytes and checksum
|
|
if(input_size.lt.0.or.input_size .gt. 516)input_size=516
|
|
!
|
|
! qio_status = sys$qiow (%val(cad4_efn),%val(cad4_chan),
|
|
! 1 %val(io_funct),cad4_iosb,,,
|
|
! 2 %ref(input_buffer(6)), ! p1 = input buffer
|
|
! 3 %val(input_size), ! p2 = input size
|
|
! 4 %val(cad4_timeout), ! p3 = timeout count
|
|
! 5 %ref(cad4_terminator(1)),,) ! p4 = term. mask
|
|
!
|
|
qio_status = io_read (cad4_iosb,
|
|
$ input_buffer(6),
|
|
$ input_size,
|
|
$ cad4_timeout)
|
|
!
|
|
end if
|
|
end if
|
|
!
|
|
! Check CRC and set up return status
|
|
!
|
|
call cad4_check_crc (result)
|
|
!
|
|
! write (l_unit,10070) (input_buffer(l),l=1,10)
|
|
10070 format (' - Input = ',10(z4,1x))
|
|
! write (l_unit,10080) qio_status,cad4_iosb
|
|
10080 format (' - IOSB = ',z8,2x,z8,2x,z8)
|
|
!
|
|
return
|
|
end
|
|
!
|
|
Subroutine cad4_prepare_output
|
|
!
|
|
include 'CAD4COMM' ! Include common block
|
|
!
|
|
! Prepare output buffer for output
|
|
! 1. set output_size to to no of bytes output in QIO
|
|
! 2. computes 16. bit CRC and store it at end of buffer
|
|
! 3. clear iosb
|
|
!
|
|
!
|
|
! 1. Set output_size
|
|
!
|
|
output_size = 1 + 2 + output_length + 2 ! Header byte
|
|
! No. of data bytes (word)
|
|
! n data bytes
|
|
! 16 bit CRC
|
|
!
|
|
! 2. Compute CRC
|
|
!
|
|
isum_w = 0 ! First use 16 bit sum
|
|
do l = 1, output_length + 3
|
|
crchar=ichar(output_buffer_c(l:l))
|
|
crchar=iand(crchar,#ff)
|
|
isum_w = ieor (isum_w,crchar)
|
|
do m = 1, 8
|
|
if (iand(isum_w,1) .eq. 1) then
|
|
isum_w = isum_w/2
|
|
isum_w = ieor (isum_w,iconst)
|
|
else
|
|
isum_w = isum_w / 2
|
|
end if
|
|
end do
|
|
end do
|
|
!
|
|
output_buffer(output_length+3+1) = isum_b(1) ! Copy CRC to
|
|
output_buffer(output_length+3+2) = isum_b(2) ! end of buffer
|
|
!
|
|
! 3. Clear IOSB
|
|
!
|
|
cad4_iosb(1) = 0 ! Be sure length and
|
|
cad4_iosb(2) = 0 ! io-status is zero
|
|
!
|
|
return
|
|
end
|
|
!
|
|
!
|
|
Subroutine cad4_check_crc (result)
|
|
!
|
|
include 'CAD4COMM' ! Include common block
|
|
!
|
|
! Check answer from cad4
|
|
!
|
|
! input: cad4_iosb - I/O status block
|
|
! input_buffer - input data and CRC
|
|
!
|
|
! output: cad4_iosb
|
|
!
|
|
! 1. word 2. word result
|
|
!
|
|
! ss$_xxxxxx 0 e_pnd system service failed
|
|
! ss$_normal 0 e_tol no data within timeout seconds
|
|
! ss$_normal icnt e_tos not enough data to meet protcol
|
|
! icnt = no. of bytes received
|
|
! ss$_normal rcnt e_ovf buffer ovf but trans. not. fin.
|
|
! rcnt = no. of rec. bytes is max
|
|
! ss$_normal pcnt e_crc enough data rec. but CRC error
|
|
! pcnt = hd.byte + length + data
|
|
! ss$_normal pcnt e_suc success
|
|
!
|
|
!
|
|
!
|
|
! qio_status = cad4_iosb_i2(1) ! Copy status code
|
|
!
|
|
! Here if no timeout or any other error
|
|
!
|
|
if (cad4_iosb_i2(1) .ne. 0) then
|
|
!
|
|
!
|
|
if(cad4_iosb_i2(2).eq.input_size)then
|
|
!
|
|
! Subtract CRC
|
|
!
|
|
if (input_length.lt.0 .or. input_length.gt.516)
|
|
1 input_length = 516 !protect memory
|
|
isum_b(1) = input_buffer(input_length+3+1)
|
|
isum_b(2) = input_buffer(input_length+3+2)
|
|
isum = isum_w !save received crc
|
|
!
|
|
!
|
|
! Check checksum of received data
|
|
!
|
|
isum_w = 0 ! First use 16 bit sum
|
|
do l = 1, input_length + 3
|
|
crchar=ichar(input_buffer_c(l:l))
|
|
crchar=iand(crchar,#ff)
|
|
isum_w = ieor (isum_w,crchar)
|
|
do m = 1, 8
|
|
if (iand(isum_w,1) .eq. 1) then
|
|
isum_w = isum_w / 2
|
|
isum_w = ieor (isum_w,iconst)
|
|
else
|
|
isum_w = isum_w / 2
|
|
end if
|
|
end do
|
|
end do
|
|
!
|
|
! write (l_unit,10010) isum_w, isum
|
|
10010 format (13x,'- Computed Sum = ',z8,' Received CRC = ',z8)
|
|
!
|
|
! Set status code into third word of IOSB
|
|
!
|
|
if (isum_w.eq.isum) then
|
|
result = e_suc
|
|
else
|
|
result = e_crc
|
|
end if
|
|
else
|
|
result=e_ovf
|
|
end if
|
|
!
|
|
! Here if any qio error except timeout
|
|
!
|
|
else
|
|
if (qio_status.ne.ss$_timeout) then
|
|
result = e_pnd
|
|
!
|
|
! Here if timeout
|
|
!
|
|
else
|
|
cad4_iosb_i2(1) = ss$_normal ! Set success in first word
|
|
if (cad4_iosb_i2(2).eq.0) then
|
|
result = e_tol ! No data for zero byte count
|
|
else
|
|
result = e_tos ! Not enoght data received
|
|
end if
|
|
!
|
|
end if
|
|
end if
|
|
qio_status = cad4_iosb_i2(1) ! Copy status code!
|
|
!
|
|
! write (l_unit,10020) result
|
|
10020 format (13x,'- Result = ',z4)
|
|
!
|
|
return
|
|
end
|
|
!
|
|
Subroutine cad4_open_log_file
|
|
!
|
|
include 'CAD4COMM' ! Include common block
|
|
!
|
|
l_unit_open = .true. ! File open flag
|
|
return
|
|
end
|
|
!
|
|
Subroutine cad4_post_dummy(result)
|
|
!
|
|
! Post proc. routine - just to meet standard call sequence
|
|
!
|
|
include 'CAD4COMM'
|
|
result = result
|
|
return
|
|
end
|
|
!
|
|
Subroutine cad4_pre_dummy
|
|
!
|
|
! Pre proc. routine - just to meet standard call sequence
|
|
!
|
|
include 'CAD4COMM'
|
|
output_length = 0
|
|
return
|
|
end
|
|
!
|
|
Subroutine cad4_type_error(result)
|
|
!
|
|
! Post proc. routine
|
|
!
|
|
include 'CAD4COMM'
|
|
result = e_typ
|
|
return
|
|
end
|