*$noreference ! ! This is the common block for CAD4 ! VAX/VMS to PDP11/02 transfer program. ! ! modified: 03-jan-1985 LCB adaption for SBC-21 target processor ! ! Logical assignments used in CAD4 system ! ! CAn_term device name of communication channel with lsi-11 ! LB0 default device for [1,3n]GONCAn.DAT;1 data files ! cad4$nrcsys default directory specification for .EXE ! cad4$error default task error device ! ! Assumed process name CAD4?_CAn ! ! ! Filename of GONCAn.DAT file ! character*22 def_gon_spec parameter (def_gon_spec='LB0:[1,40]GONCAn.DAT;1') character*18 gon_file_spec ! ! Filename of monitor task image ! character*21 def_mon_spec parameter (def_mon_spec='CAD4M.TSK') character*22 mon_file_spec ! ! Default mother task image name ! character*18 def_mother_spec parameter (def_mother_spec='nrccad') ! ! Input filenames ! character*63 mother_file_spec character*63 daughter_file_spec ! ! Test send message definitions ! character*120 message_text integer*1 message_buffer integer*4 message_descr dimension message_buffer(128),message_descr(2) equivalence (message_buffer(9),message_text) ! parameter (l_unit=6 ) ! Logical unit number for log file logical*1 l_unit_open ! True if file open ! ! Define QIO function codes and modifiers ! external tt$v_eightbit,tt$v_noecho,tt$v_passall external tt$v_nobrdcst,tt$v_escape,tt$v_hostsync external tt$v_ttsync,tt$v_readsync,tt$v_halfdup external io$_setmode,io$_ttyreadpall,io$_writelblk external io$_ttyreadall,io$m_timed,io$m_noecho external io$m_noformat,io$m_purge ! ! Define QIO status codes ! integer*4 ss$_normal,ss$_badchksum,ss$_bufferovf integer*4 ss$_abort,ss$_timeout,ss$_nodata ! parameter (ss$_normal = #1) ! Normal return parameter (ss$_timeout = #22c) ! Timeout ! ! Internal status codes returned in one byte ! integer*2 result,e_suc,e_tos,e_tol,e_seq integer*2 e_crc,e_typ,e_ovf,e_pnd ! parameter (e_suc = #0) ! success parameter (e_tos = #4) ! tmo + data parameter (e_tol = #8) ! tmo , no data parameter (e_seq = #c) ! Unexpected sequence number parameter (e_crc = #10) ! CRC error parameter (e_typ = #14) ! Unexpected function code parameter (e_ovf = #18) ! Buffer overflow parameter (e_pnd = #1c) ! Any system service fail. ! integer*2 m_seq,m_efl,m_fun ! parameter (m_seq = #3) ! Mask to get seq. bits parameter (m_efl = #1c) ! Mask to get error flag parameter (m_fun = #e0) ! Mask to get function bits ! ! Function codes for CAD4_IO routine ! integer*2 io_func,f_init,f_xfr_asc,f_xfr_mem,f_tr_swr integer*2 f_tr_gon,f_tr_asc,f_req_mem,f_req_asc ! parameter (f_init = #0) ! Bootstrap 11/02 parameter (f_xfr_asc = #20) ! Xfr ASCII buffer to 11/02 parameter (f_xfr_mem = #40) ! Xfr code block to 11/02 parameter (f_tr_swr = #60) ! Trm. and rec. SWR parameter (f_tr_gon = #ff80) ! Trm. and rec. goniometer data parameter (f_tr_asc = #ffa0) ! Trm. and rec. ASCII buffer parameter (f_req_mem = #ffc0) ! Request code block from 11/02 parameter (f_req_asc = #ffe0) ! Request ASCII buffer from 11/02 ! ! Data used by CAD4_IO routine ! integer*2 io_coswr ! Switch options register from vax to 11/02 integer*2 io_cobnr ! No. of calls to 11/02 integer*1 io_cohex ! Header from VAX to 11/02 ! bit 0-1 : seq. no. of the calls to 11/02 ! bit 2-4 : result code ! bit 5-7 : function ! ! Flags to define command string options ! 0 - no option ! -1 - negated option ! +1 - positive option ! integer*1 mt_flag,ex_flag ! ! Flag for cad4_prompt routine ! 0 - no error message ! 1 - command input error ! -1 - daughter file cannot be opened ! -2 - " " " " read ! integer*1 io_prompt_flag ! ! Define baud rate constants for CAD4 terminal ! integer*2 baud_38400,baud_19200,baud_9600,baud_4800 integer*2 baud_2400,baud_1200,baud_600,baud_300 ! parameter (baud_38400 = 3) parameter (baud_19200 = 2*baud_38400) parameter (baud_9600 = 2*baud_19200) parameter (baud_4800 = 2*baud_9600) parameter (baud_2400 = 2*baud_4800) parameter (baud_1200 = 2*baud_2400) parameter (baud_600 = 2*baud_1200) parameter (baud_300 = 2*baud_600) ! ! Default goniometer parameter (goncan.dat record 8) ! system constants as will be expected at bottom of LSI target computer ! integer*2 lsi_bottom ! LSI memory size (bytes) parameter (lsi_bottom=#8000) integer*2 sbc_bottom ! SBC user memory bottom parameter (sbc_bottom=#ec00) integer*2 lsypar ! value of LSI syspar address integer*2 sbcp_bottom ! SBC PLUS memory bottom parameter (sbcp_bottom=#7F80) ! integer*2 syspar_def_1,syspar_def_2,syspar_def_3 integer*2 syspar_def_4,syspar_def_5,syspar_def_6 integer*2 syspar_def_7,syspar_def_8,syspar_def_9 integer*2 syspar_def_10,syspar_def_11,syspar_def_12 integer*2 syspar_def_13,syspar_def_14,syspar_def_15 integer*2 syspar_def_16,syspar_def_17 ! parameter (syspar_def_1 = #ff-((640-255)/3) ) ! Photomultiplier hv setting of 640 volts parameter (syspar_def_2 = #ff-(120/5) ) ! Lower level setting of 120 parameter (syspar_def_3 = #ff-(750/5) ) ! Discrimination window setting parameter (syspar_def_4 = 0) parameter (syspar_def_5 = 0) ! Deadtime correction factor (default 0, I*4) parameter (syspar_def_6 = baud_300.and.#ff) ! CAD4 terminal baudrate setting of ... parameter (syspar_def_7 = baud_300/#100) ! 300 baud default parameter (syspar_def_8 = 0) parameter (syspar_def_9 = 18) ! System clock speed default = 400 cycles/sec. parameter (syspar_def_10 = 2) ! Default positioning accuracy is 2 steps ! ! ! common for load syspar data ! integer*2 slave_load_address !address to load syspar in lsi integer*2 nr_load_byte !number of bytes to load ! character*1 bvers_c integer*1 bvers !bootstrap version character if not 0 equivalence (bvers,bvers_c(1:1)) ! ! ! 5 Axes gain list ! ! output = calculated value*(32.-gain)/32. ! parameter (syspar_def_11 = 24) ! Theta motorgain parameter (syspar_def_12 = 28) ! Phi motorgain parameter (syspar_def_13 = 24) ! Omega motorgain parameter (syspar_def_14 = 24) ! Kappa motorgain parameter (syspar_def_15 = 24) ! Dial motorgain ! ! System flag word ! ! 1 - High voltage sense ! 4 - Switch limit for phi: present = set ! 10 - Special collar: present = set ! 20 - Cryostat: present = set ! parameter (syspar_def_16 = 0) ! System flag word ! parameter (syspar_def_17 = (60-10)*3/10 ) ! Maximum emission allowed of 60 mA ! integer*2 syspar_def dimension syspar_def(32) ! ! Define syspar values as read from goncan.dat file ! integer*2 syspar_val dimension syspar_val(32) ! ! Define code for $getdvi system service ! integer*4 dvi$_devdepend,dvi$_devdepend2 integer*4 dvi$_devclass,dvi$_devtype parameter (dvi$_devclass = #00000004) parameter (dvi$_devdepend = #0000000A) parameter (dvi$_devdepend2= #0000001C) parameter (dvi$_devtype = #00000006) ! ! Define system services as integer*4 to allow function call ! integer*4 io_status ! I/O status code integer*4 exmess_status !i/o status code memory for exit integer*4 cli$present,cli$get_value,sys$exit,sys$alloc integer*4 sys$assign,sys$qiow,sys$getdvi,sys$dclexh,sys$sndopr integer*4 sys$setprn,sys$getjpi,sys$creprc,sys$getmsg ! ! Cad4 buffer format ! ! 15 0 ! +-----------------------+ ! + header byte + ! +------------------------------------------------+ ! + length(high byte) + length (low byte) + ! +------------------------------------------------+ ! ! switch register word or load address + ! +------------------------------------------------+ ! ! switch register word or load address + ! +------------------------------------------------+ ! ! ! ! ! ... ! ! ! ! 256 words data (512. bytes) ! ! +------------------------------------------------+ ! + CRC (16. bit) + ! +------------------------------------------------+ ! ! ! Define argumensts for cad4_readprompt routine ! integer*1 prompt_buffer ! Buffer to save prompt dimension prompt_buffer(521) ! send to pdp11/02 integer*1 output_buffer ! Same as Output buffer dimension output_buffer(521) ! for cad4_writelogical equivalence (prompt_buffer(1),output_buffer(1)) character*521 output_buffer_c ! Allow use of ICHAR function equivalence (prompt_buffer(1),output_buffer_c) ! integer*4 prompt_size ! Size of prompt (for QIO) integer*4 output_size ! " equivalence (prompt_size,output_size) ! integer*1 input_buffer ! Input buffer to read record dimension input_buffer(521) integer*4 input_size ! Size of input buff for Qio character*521 input_buffer_c ! Allow use of ICHAR function equivalence (input_buffer(1),input_buffer_c) ! ! Buffer for input and output are the same ! equivalence (input_buffer(1),output_buffer(1)) ! ! Define structure of I/O blocks ! integer*1 prompt_header ! Header byte of output block integer*1 output_header ! " equivalence (prompt_buffer(1),prompt_header) equivalence (prompt_buffer(1),output_header) ! integer*2 prompt_length ! Length send to pdp11/02 integer*2 output_length ! " equivalence (prompt_buffer(2),prompt_length) equivalence (prompt_buffer(2),output_length) ! integer*1 prompt_data ! Data bytes send to pdp11/02! integer*1 output_data ! " integer*2 output_data_w ! character*518 output_data_c ! dimension prompt_data(512+2+2+2) dimension output_data(512+2+2+2) dimension output_data_w((512+2+2+2)/2) equivalence (prompt_buffer(4),output_data_c) equivalence (prompt_buffer(4),prompt_data(1)) equivalence (prompt_buffer(4),output_data(1)) equivalence (prompt_buffer(4),output_data_w(1)) ! integer*1 input_header ! Header byte received from 11 equivalence (input_buffer(1),input_header) ! integer*2 input_length ! Length received from pdp11/02 equivalence (input_buffer(2),input_length) ! integer*1 input_data ! Data read from pdp11/02 integer*2 input_data_w ! dimension input_data(512+2+2+2) dimension input_data_w((512+2+2+2)/2) equivalence (input_buffer(4),input_data(1)) character*518 input_data_c ! equivalence (input_buffer(4),input_data_c) equivalence (input_buffer(4),input_data_w) ! ! Define word to compute CRC ! integer*4 iconst !crc-constant parameter (iconst=#a001) ! value of constant integer*4 crchar !crc-character integer*4 isum !to remember received crc integer*4 isum_w ! 16 bit CRC integer*1 isum_b ! 8 bit (low&high 16 bit CRC) dimension isum_b(2) equivalence (isum_w,isum_b) ! ! Define item list for $getdvi system service ! integer*4 item_list_i4 ! Item list for $getdvi integer*2 item_list_i2 ! information integer*1 item_list_i1 dimension item_list_i4(13) ! 4* 3 + 1 longword dimension item_list_i2(13*2) dimension item_list_i1(13*4) equivalence (item_list_i4,item_list_i2) equivalence (item_list_i4,item_list_i1) ! ! Define item list for $getjpi system service ! integer*4 getjpi_list_l integer*2 getjpi_list_w dimension getjpi_list_l(13) dimension getjpi_list_w(2*13) equivalence (getjpi_list_l,getjpi_list_w) ! ! Define info var from $getjpi ! character*15 process_name_c integer*1 process_name_b dimension process_name_b(15) equivalence (process_name_c(1:1),process_name_b(1)) integer*2 process_name_len ! integer*4 process_uic_l integer*2 process_uic_w dimension process_uic_w(2) equivalence (process_uic_l,process_uic_w) integer*2 process_uic_len ! character*63 process_image_c integer*1 process_image_b dimension process_image_b(63) equivalence (process_image_c(1:1),process_image_b(1)) integer*2 process_image_len ! integer*4 process_prio_l integer*2 process_prio_len ! ! Define buffer for io$_setmode QIO ! integer*4 char_buff_i4 ! Item list for $getdvi integer*2 char_buff_i2 ! information integer*1 char_buff_i1 dimension char_buff_i4(3) ! Three longwords dimension char_buff_i2(3*2) dimension char_buff_i1(3*4) equivalence (char_buff_i4,char_buff_i2) equivalence (char_buff_i4,char_buff_i1) ! ! Define characteristics returned by $getdvi and used for ! $qiow (io$_setmode). ! integer*4 cad4_devclass ! Device class integer*4 cad4_devtype ! Device type integer*4 cad4_devdepend ! Device characteristics integer*4 cad4_devdepend2 ! integer*2 cad4_pagewidth ! Width of a page integer*1 cad4_pagelength ! Length of a page equivalence (char_buff_i1(1),cad4_devclass) equivalence (char_buff_i1(2),cad4_devtype) equivalence (char_buff_i2(2),cad4_pagewidth) equivalence (char_buff_i4(2),cad4_devdepend) equivalence (char_buff_i4(3),cad4_devdepend2) equivalence (char_buff_i1(8),cad4_pagelength) ! integer*4 cad4_devdepend_old ! Save old characteristics here ! ! ! Define arguments for QIOW system service to cad4 ! integer*4 qio_status ! Qio status code integer*2 cad4_chan ! Channel number integer*4 cad4_event_flag ! Event flag number parameter (cad4_event_flag=8) ! integer*4 cad4_iosb ! I/O status integer*2 cad4_iosb_i2 ! words dimension cad4_iosb(2) ! quadword dimension cad4_iosb_i2(4) equivalence (cad4_iosb,cad4_iosb_i2) integer*4 cad4_l_timo ! Long time out count parameter (cad4_l_timo=25) ! 25 seconds integer*4 cad4_timeout ! Short timeout count parameter (cad4_timeout=2) ! Two seconds integer*4 cad4_terminator ! Line terminator bit mask dimension cad4_terminator(2) ! quadword (short form) ! ! Define argument block for declare exit handler directive ! integer*4 exit_block ! Exit handler control block dimension exit_block(4) integer*4 exit_status ! ! Define parameters for $assign system service ! character*10 cad4_term_name ! Physical name of transfer ! terminal integer*4 cad4_term_len ! Length of physical ! name string ! ! Variable to save instrument name ! ! ibycan_b 1. byte : integer CA?: unit number ! 2.-4. byte : ASCII device name ('CAn') ! integer*1 ibycan_b dimension ibycan_b(4) integer*2 ibycan dimension ibycan(2) character*4 ibycan_c equivalence (ibycan_b(1),ibycan_c(1:1)) equivalence (ibycan_b(1),ibycan(1)) integer*2 ir5can !radix-50 name of channel for RSX ! ! Variable to save current process name name and uic ! ! Common block for all I/O routines ! integer*4 img_io_record ! Record no. of task image integer*4 img_io_status ! FORTRAN I/O status code ! ! Define file I/O buffer ! integer*4 img_io_buffer_l integer*2 img_io_buffer_w integer*1 img_io_buffer_b dimension img_io_buffer_l(128),img_io_buffer_w(256) equivalence (img_io_buffer_l,img_io_buffer_w) equivalence (img_io_buffer_l,img_io_buffer_b) ! ! Define read bookkeeping ! integer*2 img_io_bsa ! Base address (bytes) integer*2 img_io_ldz ! Load size (32. word blocks) integer*2 img_io_xfr ! Transfer address integer*4 img_io_pointer ! Pointer ! ! ! common declaration for blank common block integer*2 nswreg !slave switch register integer*2 iroutf !routine flag integer*2 incr1 !master increment integer*2 incr2 !slave increment integer*2 npi1 !inverse of scanspeed for master integer*2 npi2 !relative scanspeed for slave integer*2 iscanw !scanwidth tensor integer*2 motw !motor selection word integer*2 ishutf !shutter flag integer*2 ibalf !balance filter flag integer*2 iattf !attenuator filter flag integer*2 iresf !reserve flag integer*2 ierrf !result error flag integer*2 intfl !intensity result flag real*4 xrayt !x-ray time real*4 tthp !limit value for detector real*4 tthn !limit value for neg side real*4 aptw !wanted encoder value for aperture real*4 want !wanted values for gonio-angles real*4 spare !spare locs real*4 aptm !measured encoder value of aperture real*4 cmeas !measured gonio angles real*4 dump !intensity dumps ! ! cad4-handler offsets ! integer*2 c4h_swreg integer*2 c4h_routfl integer*2 c4h_errfl integer*2 c4h_intfl integer*2 c4h_tthmxh integer*2 c4h_tthmnh integer*2 c4h_sasysc integer*2 c4h_xrtim integer*2 c4h_mselw integer*2 c4h_nrd integer*2 c4h_nid integer*2 c4h_incr integer*2 c4h_inci integer*2 c4h_dincr integer*2 c4h_nrinc integer*2 c4h_thwh integer*2 c4h_phwh integer*2 c4h_omwh integer*2 c4h_kawh integer*2 c4h_apwh integer*2 c4h_apwl integer*2 c4h_thmh integer*2 c4h_phmh integer*2 c4h_ommh integer*2 c4h_kamh integer*2 c4h_apmh integer*2 c4h_dump0 ! parameter (c4h_swreg =1) parameter (c4h_routfl =2) parameter (c4h_errfl =3) parameter (c4h_intfl =4) parameter (c4h_tthmxh =5) parameter (c4h_tthmnh =7) parameter (c4h_sasysc =9) parameter (c4h_xrtim =10) parameter (c4h_mselw =12) parameter (c4h_nrd =13) parameter (c4h_nid =14) parameter (c4h_incr =12) parameter (c4h_inci =0) parameter (c4h_dincr =1) parameter (c4h_nrinc =2) parameter (c4h_thwh =30) parameter (c4h_phwh =32) parameter (c4h_omwh =34) parameter (c4h_kawh =36) parameter (c4h_apwh =38) parameter (c4h_apwl =39) parameter (c4h_thmh =40) parameter (c4h_phmh =42) parameter (c4h_ommh =44) parameter (c4h_kamh =46) parameter (c4h_apmh =48) parameter (c4h_dump0 =50) ! ! c4h_routfl function table ! integer*2 rf_swi integer*2 rf_mea integer*2 rf_col integer*2 rf_poc integer*2 rf_pos integer*2 rf_pof integer*2 rf_sap integer*2 rf_sca integer*2 rf_scd integer*2 rf_res integer*2 routbl(16) ! parameter (rf_swi =#0) parameter (rf_mea =#4) parameter (rf_col =#8) parameter (rf_poc =#10) parameter (rf_pos =#20) parameter (rf_pof =#40) parameter (rf_sap =#80) parameter (rf_sca =#100) parameter (rf_scd =#200) parameter (rf_res =#8000) ! integer*2 rout0,rout1,rout2,rout3,rout4,rout5 integer*2 rout6,rout7,rout8,rout9,rout10,rout11 integer*2 rout12,rout13,rout14,rout15 ! parameter (rout0 = rf_swi+rf_res) parameter (rout1 = rf_swi+rf_mea+rf_res) parameter (rout2 = rf_swi+rf_col+rf_res) parameter (rout3 = rf_swi+rf_pos+rf_res) parameter (rout4 = rf_swi+rf_pof+rf_res) parameter (rout5 = rf_swi+rf_poc+rf_pof+rf_res) parameter (rout6 = rf_swi+rf_sca+rf_res) parameter (rout7 = rf_swi+rf_sap+rf_sca+rf_res) parameter (rout8 = rf_swi+rf_poc+rf_pof+rf_sap+rf_sca+rf_res) parameter (rout9 = rf_swi+rf_scd+rf_res) parameter (rout10= rf_swi+rf_sap+rf_scd+rf_res) parameter (rout11= rf_swi+rf_poc+rf_pof+rf_sap+rf_scd+rf_res) parameter (rout12= rf_swi+rf_poc+rf_res) parameter (rout13= rf_swi+rf_sap+rf_res) parameter (rout14= rf_swi+rf_res) !free parameter (rout15= rf_swi+rf_res) !free ! ! cad4_handler error table ! integer*2 errtbl(15) ! ! cad4_handler intensity error table ! integer*2 inttbl(15) ! ! ! cad4-handler sasysc table ! integer*2 sa_att integer*2 sa_shu ! parameter (sa_att = #4000) parameter (sa_shu = #8000) ! integer*2 satbl(4),sas0,sas1,sas2,sas3 ! parameter (sas0 = #0) parameter (sas1 = sa_att) parameter (sas2 = sa_shu) parameter (sas3 = sa_att+sa_shu) ! ! fortran blank common array for angles ! integer*2 for_ph integer*2 for_om integer*2 for_ka integer*2 for_th ! parameter (for_ph = 1) parameter (for_om = 2) parameter (for_ka = 3) parameter (for_th = 4) ! ! number of dumps used ! integer ndumps ! common /cad4_main/nswreg ,iroutf ,incr1 ,incr2 ,npi1 , 1 npi2 ,iscanw ,motw ,ishutf ,ibalf ,iattf , 2 iresf ,ierrf ,intfl ,xrayt ,tthp ,tthn , 3 aptw ,want(4) ,spare(6) ,aptm , 4 cmeas(4),ndumps, dump(512) ! ! ! Common for cad4 ascii buffer in cad4b ! integer*2 nr_ascii_byte !number of ascii in BUFA character*1 bufa !ascii buffer dimension bufa(134) ! ! common /mesg/bufa !ascii buffer for cad4b ! ! ! Common blocks for integer and logical variables ! common /cad4_integer/ io_status,cad4_term_len, 1 item_list_i4,char_buff_i4,cad4_devdepend_old, 2 exit_block,cad4_chan,cad4_iosb,qio_status, 3 cad4_terminator,isum_w,l_unit_open, 4 message_buffer,message_descr, 5 img_io_buffer_l,img_io_bsa,img_io_ldz,img_io_xfr, 6 img_io_record,img_io_pointer,img_io_status, 7 getjpi_list_l,process_name_b,process_uic_l, 8 process_image_b,process_name_len,process_uic_len, 9 process_image_len,process_prio_l,process_prio_len, 1 mt_flag,ex_flag,io_prompt_flag,syspar_def, 2 slave_load_address,nr_load_byte,nr_ascii_byte, 3 bvers ! ! ! Common block for transfer buffer ! common /tbuf/output_size,output_buffer,input_size ! ! ! Common block for communication channel name and communication values ! common /cacomm/ibycan,ir5can,lsypar,io_coswr,io_cobnr, 1 io_cohex ! ! ! Common block for syspar values (shadow of 11/02 lsi_bottom) ! common /syspar/syspar_val ! ! ! Common block for character variables ! common /cad4_character/ cad4_term_name, 1 mother_file_spec,daughter_file_spec, 2 gon_file_spec ! common /cad4_sysval/ freq, ragmxt ! ! cad4-handler motor table ! integer*2 mottbl(8) !no,ap,ph,om,ka,th,no,no ! !converted to data mottbl /0,5,2,3,4,1,0,0/ !no,th,ph,om,ka,ap,no,no ! data syspar_def /syspar_def_1,syspar_def_2,syspar_def_3, 1 syspar_def_4,syspar_def_5,syspar_def_6, 2 syspar_def_7,syspar_def_8,syspar_def_9, 3 syspar_def_10,syspar_def_11,syspar_def_12, 4 syspar_def_13,syspar_def_14,syspar_def_15, 5 syspar_def_16,syspar_def_17,15*0/ ! data routbl /rout0,rout1,rout2,rout3, 1 rout4,rout5,rout6,rout7,rout8, 2 rout9,rout10,rout11,rout12,rout13, 3 rout14,rout15/ ! data errtbl /1,2,3,4,5,5,5,0,0,0,0,0,0,0,0/ ! data inttbl /-1,1,0,0,0,0,0,0,0,0,0,0,0,0,0/ ! data satbl/sas0,sas1,sas2,sas3/ ! data ndumps /512/ ! ! ! *$reference