function dix_dump_file(control,file,iterm,dis,mult_file) implicit none c c Dump one or more records to the output file c c include 'dix_def.inc' record /control/ control !:io: the control area record /file_info/ file !:io: the file info c record /data_info/ data !:i: the data integer*4 iterm !:o: the terminator (action wanted) record /dis_pars/ dis !:i: the display parameters logical*4 mult_file !:i: multiple files? integer*4 dix_dump_file !:f: function result c# c integer*4 i_count,istat,pr_count,k c integer*4 dix_rms_get logical dix_search_search_file integer*4 dix_dump_get_rfa external dix_msg_seanotf external dix_msg_ctrlcseen external rms$_eof integer*4 dix_dump_file_dump integer*4 dix_dump_file_write_out c integer*4 max_find_recs,n_rfas parameter (max_find_recs = 255) record /rfa/ rfas(max_find_recs) c i_count = 0 !!no records yet pr_count = 0 !print count istat = 1 c if(mult_file) then istat = dix_dump_file_write_out(control, 1 control.symbol(1:control.nk_symb), 1 'FILENAME', 1 'FILENAME:', 1 file.fnam(1:file.nk_fnam)) if(.not. istat) goto 90 end if c c For sequential files, display the recordnumber c See if the (optional) search strings are in the databuffer c c If the user wants to search a record containg something c check if this records matches c if(control.search.count .ne. 0) then c c Init counters c call dix_search_stats_init(control) call dix_fastio_stats_init(control,file) endif c 20 if(control.search.count .ne. 0) then istat = dix_search_search_file(control,file,.true., 1 max_find_recs,rfas,n_rfas,.false.) if(.not. istat) then if(i_count .gt. 0 .and. istat .eq. %loc(dix_msg_seanotf)) istat = 1 goto 90 endif c c rfa(1) is the rfa of the current record c rfa(2..n) are the rfa's of the records to be displayed c do k=2,n_rfas istat = dix_dump_get_rfa(control,file,rfas(k)) if(.not. istat) goto 90 istat = dix_dump_file_dump(control,file,dis,pr_count) if(.not. istat) goto 90 end do c c Return pointer to original record c c if(n_rfas .gt. 1) then istat = dix_dump_get_rfa(control,file,rfas(1)) if(.not. istat) goto 90 c endif else c c Normal display, We have a match c Display the record number c istat = dix_dump_file_dump(control,file,dis,pr_count) if(.not. istat) goto 90 endif i_count = i_count + 1 c c If we selected a specific record, any result is exit c 80 if(control.one_rec) goto 90 if(control.control_c_seen) then istat = %loc(dix_msg_ctrlcseen) control.control_c_seen = .false. goto 90 endif c c If the user asked for /count=nn, stop after the expected count c if(file.count .eq. 0 .or. i_count .lt. file.count) then if(control.search.count .gt. 0) goto 20 istat = dix_rms_get(control,file) if(istat) goto 20 if(file.count .eq. 0 .and. istat .eq. %loc(rms$_eof)) istat = 1 endif c 90 iterm = key_exit if(control.search.count .ne. 0) then call dix_search_stats_show(control) call dix_fastio_stats_show(control,file) endif if(.not. istat) call dix_message(control,%val(istat)) dix_dump_file = istat return end function dix_dump_file_dump(control,file,dis,pr_count) implicit none c c Dump the current record in the file c include 'dix_def.inc' record /control/ control !:i: control block record /file_info/ file !:i: file data record /dis_pars/ dis !:i: display parameters integer*4 pr_count !:io: print count (needed for csv header) integer*4 dix_dump_file_dump !:f: function result c integer*4 nkar,nk_hline,nk_line,nk_cntasc,istat logical*4 mult_des,do_vfc character*(max_command_length) line,hline character*(max_nr_asc_length) cntasc c record /des_expanded/ des_expanded pointer (p_des_expanded, des_Expanded) c logical*4 do_header c record /des_info/ des_info pointer(p_des_info,des_info) c integer*4 dix_dump_print_line integer*4 dix_dump_file_raw integer*4 dix_dump_file_des integer*4 dix_dump_file_write_out c c Check if we have a description c istat = 1 c do_vfc = dis.vfc if(dis.vfc) then if(file.data.nb_vfc .eq. 0) then c c User asked for VFC, but there is no VFC data c do_vfc = .false. endif endif c c Now display the data c do_header = .true. if(dis.raw .or. file.top_des .eq. 0) then c c No des, so dump raw, first the vfc data c if(do_vfc) then c if(dis.data) then istat = dix_dump_print_line(control,0,'%VFC_data') if(.not. istat) goto 90 endif c istat = dix_dump_file_raw(control,file,file.data.nb_vfc, 1 file.data.vfc_data,dis, 1 control.symbol(1:control.nk_symb)//'VFC',0, 1 do_header) if(.not. istat) goto 90 do_header = .false. !we already have the header endif c c And then the real data c if(dis.data) then c if(do_vfc) then istat =dix_dump_print_line(control,0,'%Record_data') if(.not. istat) goto 90 endif c istat = dix_dump_file_raw(control,file,file.data.nb_data, 1 file.data.data_rec,dis, 1 control.symbol(1:control.nk_symb),0,do_header) if(.not. istat) goto 90 endif else c c Yes, a description, use them all c if(dis.data .or. do_vfc) then c c We want to print data or vfc data c p_des_expanded = file.top_des mult_des = des_expanded.link.forw .ne. 0 nk_line = 0 nk_hline = 0 c do while(p_des_expanded .ne. 0) c p_des_info = des_Expanded.p_des_info c c Dump with this description, c istat = dix_dump_file_des(control,file,dis,des_info,des_Expanded, 1 mult_des, 1 control.symbol(1:control.nk_symb), 1 pr_count, 1 nk_hline,hline,nk_line,line) c c And set the pointer to the next c if(.not. istat) goto 90 p_des_expanded = des_expanded.link.forw end do c c All valid fields processed, now print csv line, If present c if(control.csv.csv .and. nk_line .gt. 0) then c c User wanted CSV output c nkar = 0 if(pr_count .eq. 0) then nk_cntasc = 0 else call sys$fao('!UL',nk_cntasc,cntasc,%val(pr_count)) endif pr_count = pr_count + 1 c if(control.csv.header .and. (pr_count .eq. 1)) then nk_hline = nk_hline - 1 istat = dix_dump_file_write_out(control, 1 control.symbol(1:control.nk_symb), 1 'Record'//cntasc(1:nk_cntasc), 1 line(1:nkar),hline(1:nk_hline)) call sys$fao('!UL',nk_cntasc,cntasc,%val(pr_count)) if(.not. istat) goto 90 pr_count = pr_count + 1 endif c c Skip trailing , (if there) c if(nk_line .gt. 0) nk_line = nk_line - 1 c c Output the csv line c istat = dix_dump_file_write_out(control, 1 control.symbol(1:control.nk_symb), 1 'Record'//cntasc(1:nk_cntasc), 1 line(1:nkar),line(1:nk_line)) if(.not. istat) goto 90 endif endif end if 90 dix_dump_file_dump = istat return end function dix_dump_file_raw(control,file,nb_data,data_rec, 1 dis,symbol,lun,do_header) implicit none c c Raw dump (DUMP mode) c include 'dix_def.inc' record /control/ control !:i: control block record /file_info/ file !:i: file block integer*4 nb_data !:i: Legnth of data byte data_rec(*) !:i: data record record /dis_pars/ dis !:i: display parameters character*(*) symbol !:i: the symbol value integer lun !:i: the lun to print to logical*4 do_header !:i: header display integer*4 dix_dump_file_raw !:f: funciton result c# c local vars c integer*4 linenr,kpl,fldsiz,posasc,nlines,nkar,nk_symbasc,lun_save integer*4 istat character*(max_line_length) line,symbasc c include '($smgdef)' c integer*4 n_bol integer*4 begpos_bol(10),endpos_bol(10) c integer*4 dix_dump_print_header integer*4 dix_dump_raw_line integer*4 dix_dump_file_write_out c c start, compute # values on 1 line c istat = 1 if(do_header) then istat = dix_dump_print_header(control,file,dis) if(.not.istat) goto 90 endif c call dix_dump_vars(control,dis,kpl,fldsiz,posasc) c lun_save = control.lun_out if(lun .ne. 0) control.lun_out = lun c nlines = (nb_data+kpl-1)/kpl do linenr=1,nlines if(control.control_c_seen) goto 90 istat = dix_dump_raw_line(control,(linenr-1)*kpl,kpl,nb_data, 1 data_rec,dis,posasc, 1 begpos_bol,endpos_bol,n_bol,line, 1 nkar,fldsiz,file) if(.not. istat) goto 90 call sys$fao('!UL',nk_symbasc,symbasc,%val(linenr)) c istat = dix_dump_file_write_out(control,symbol, 1 symbasc(1:nk_symbasc), 1 ' ',line(1:nkar)) if(.not. istat) goto 90 end do 90 control.lun_out = lun_save dix_dump_file_raw = istat return end function dix_dump_print_header(control,file,dis) implicit none c c Print the header info c include 'dix_def.inc' record /control/ control record /file_info/ file record /dis_pars/ dis integer*4 dix_dump_print_header c integer*4 nk_totline,nkar,istat record /rfa/ rfa character*(max_line_length) line,totline c integer*4 dix_dump_file_display_nr integer*4 dix_dump_print_line c c We need to print a header for this record c See which parts are needed c istat = 1 nk_totline = 0 if(file.rec_nr .ne. 0) then if(dis.recnr) then c c We want to display the recnr, include it c if(file.block_size .ne. 0) then call sys$fao('Blocknumber (!UL byte size blocks)',nkar,line, 1 %val(file.block_size*512)) istat = dix_dump_file_display_nr(control,file.rec_nr,dis, 1 line(1:nkar),totline,nk_totline) else istat = dix_dump_file_display_nr(control,file.rec_nr,dis, 1 'Recordnumber',totline,nk_totline) endif if(.not.istat) goto 90 c endif endif c c display the record size (if wanted) c if(dis.recsiz) then istat = dix_dump_file_display_nr(control,file.data.nb_data,dis, 1 'Recordsize',totline,nk_totline) if(.not.istat) goto 90 c c If vfc data wanted too, display the vfc size (if >0) c if(dis.vfc .and. file.data.nb_vfc .gt. 0) then istat = dix_dump_file_display_nr(control,file.data.nb_vfc,dis, 1 'VFCsize',totline,nk_totline) if(.not.istat) goto 90 endif endif c if(dis.rfa) then c c Append the RFA c call dix_rms_return_rfa(file,rfa) nkar = 0 call sys$fao('(!UL,!UW)',nkar,line, 1 %val(rfa.bbnr),%val(rfa.offset)) c if(control.symbol(1:control.nk_symb) .ne. ' ') then call lib$set_symbol( 1 control.symbol(1:control.nk_symb)//'RFA', 1 line(1:nkar)) endif c c if(nk_totline .gt. 0) then call dix_append1(nk_totline,totline,' , ') endif call dix_append1(nk_totline,totline,'RFA = ') call dix_append(nk_totline,totline,line(1:nkar)) endif c if(nk_totline .gt. 0) then istat = dix_dump_print_line(control,0, 1 '%Info:'//totline(1:nk_totline)) if(.not. istat) goto 90 end if 90 dix_dump_print_header = istat return end function dix_dump_file_des(control,file,dis,des_info,des_Expanded, 1 multi,symbname,pr_count, 1 nk_hline,hline,nk_line,line) implicit none c c Dump with description to file/term with no screen c include 'dix_def.inc' record /control/ control !:i: control block record /file_info/ file !:i: file block record /des_info/ des_info !:i: desciption block record /des_expanded/ des_expanded !:i: expanded des block record /dis_pars/ dis !:i: display parameters logical*4 multi !:i: display more than 1 descriptions? character*(*) symbname !:i: symbolname to output to integer*4 pr_count !:i: record number to print(start with 0) integer*4 nk_hline !:io: length of csv header character*(*) hline !:io: csv header line integer*4 nk_line !:io: length of csv line character*(*) line !:io: csv line integer*4 dix_dump_file_des !:f: function result c# character*(max_line_length) mask integer*4 nk_mask,ipos,istat logical*4 first c logical*4 dix_des_expand integer*4 dix_dump_inter_match_des integer*4 dix_dump_file_des_part integer*4 memtab_read integer*4 dix_dump_file_raw external dix_msg_ctrlcseen c istat = 1 c if(.not. dix_des_expand(control,des_expanded,file,.true.)) then c c Could not expand, do it the raw way c istat = dix_dump_file_raw(control,file,file.data.nb_data, 1 file.data.data_rec,dis, 1 control.symbol(1:control.nk_symb),0,.true.) goto 90 end if c first = .true. c if(control.lun_select .ne. 0) then c c We have a select lun, rewind it c call memtab_rewind(control.lun_select) endif c c Restart for the next mask c 10 if(control.lun_select .ne. 0) then c c We had a select lun, get the next line c istat = memtab_read(control.lun_select,nk_mask,mask) if(.not. istat) then istat = 1 !end of file goto 90 !all lines processed endif c c We have a selection record c the format is [desmask\]fieldmask, see if desmask exists c ipos = index(mask(1:nk_mask),'\') if(ipos .ne. 0) then c c Yes, desmask is there, so now see if description name matches c if(.not. dix_dump_inter_match_des(des_expanded, 1 mask(1:ipos-1),wildcard_flag_standard)) goto 50 c c Yes it does, now the field mask is the rest c mask = mask(ipos+1:) nk_mask = nk_mask - ipos endif endif c if(dis.vfc .and. file.data.nb_vfc .gt. 0) then c c Dump the vfc data c istat = dix_dump_file_des_part(control,file,dis,des_info, 1 des_Expanded, 1 multi,symbname,pr_count, 1 nk_hline,hline,nk_line,line, 1 mask(1:nk_mask),.true.,first) if(.not. istat) goto 90 endif if(dis.data) then c c Dump the normal data c istat = dix_dump_file_des_part(control,file,dis,des_info, 1 des_Expanded, 1 multi,symbname,pr_count, 1 nk_hline,hline,nk_line,line, 1 mask(1:nk_mask),.false.,first) if(.not. istat) goto 90 endif c c See if more selection records wanted c 50 if(control.control_c_seen) then istat = %loc(dix_msg_ctrlcseen) goto 90 endif c if(control.lun_select .ne. 0) goto 10 c 90 dix_dump_file_des = istat return end subroutine dix_dump_csv_add_token(control,nk_line,line, 1 name,ent_type) implicit none c c Add a CSV token to a line c include 'dix_def.inc' record /control/ control integer*4 nk_line character*(*) line character*(*) name integer*4 ent_type c logical*4 text integer*4 nk logical*4 dix_con_typ_is_text integer*4 dix_util_get_len_fu c nk = dix_util_get_len_fu(name) c if(control.csv.all_quotes) then text = .true. elseif(control.csv.quotes) then text = dix_con_typ_is_text(ent_type) if(index(name(1:nk),control.csv.separator) .ne. 0) text = .true. if(index(name(1:nk),' ') .ne. 0) text = .true. else text = .false. endif c if(text) call dix_append1(nk_line,line,control.csv.quote) call dix_append(nk_line,line,name(1:nk)) if(text) call dix_append1(nk_line,line,control.csv.quote) call dix_append1(nk_line,line,control.csv.separator) c return end function dix_dump_file_write_out(control,symbname,symbfield, 1 header,data) implicit none c c Output to file, and optionally to symbol c include 'dix_def.inc' record /control/ control character*(*) symbname character*(*) symbfield character*(*) header character*(*) data integer*4 dix_dump_file_write_out c# integer*4 dix_dump_print_line c dix_dump_file_write_out = dix_dump_print_line(control,0,header//data) if(symbname .ne. ' ') call lib$set_symbol(symbname//symbfield,data) return end function dix_dump_file_display_nr(control,value,dis,name, 1 totline,nk_totline) implicit none c c Display the record number, c create symbol if wanted, and add to total line c include 'dix_def.inc' record /control/ control !:i: control block integer*4 value !:i: the vlaue to peint record /dis_pars/ dis !:i: display parameters character*(*) name !:i: the name for the field character*(*) totline !:io: the total info line integer*4 nk_totline !:io: the length of the total infoline integer*4 dix_dump_file_display_nr !:f: funciton result c# character*20 line integer*4 nkar,istat,ipos c c We want to display the recnr c istat = 1 nkar = 0 call dix_util_con_nr(value*8,.false.,line,nkar, 1 dis.number_hex,control) if(dis.number_hex) then line = '%X'//line(1:nkar) nkar = nkar + 2 endif c if(control.symbol(1:control.nk_symb) .ne. ' ') then c c USer wanted symbols, he gets this one c ipos = index(name,' ')-1 if(ipos .lt. 0) ipos = len(name) call lib$set_symbol( 1 control.symbol(1:control.nk_symb)//name(1:ipos), 1 line(1:nkar)) endif c c Append the name=value to thge totline c if(nk_totline .gt. 0) then call dix_append1(nk_totline,totline,' , ') endif call dix_append(nk_totline,totline,name) call dix_append1(nk_totline,totline,' = ') call dix_append(nk_totline,totline,line(1:nkar)) c istat = dix_dump_file_write_out(control, c 1 control.symbol(1:control.nk_symb), c 1 name,'%'//name//' = ',line(1:nkar)) dix_dump_file_display_nr = istat return end function dix_dump_file_write_line(control,regel, 1 nkar,nk_disp,nk_nroff, 1 bit_offset,has_fields,number_hex, 1 symbname,fieldname,multi) c implicit none include 'dix_def.inc' c record /control/ control !:i: control block character*(*) regel !:i: the text to print integer*4 nkar !:i: length of regel integer*4 nk_disp !:i: length of line integer*4 nk_nroff !:i: the size of the offset field integer*4 bit_offset !:i: bit_offset logical*4 has_fields !:i: the description has fields logical*4 number_hex !:i: print the offset in hex character*(*) symbname !:i: the symbol name character*(*) fieldname !:i: the fieldname logical*4 multi integer*4 dix_dump_file_write_line !:f: function result c# integer*4 ibpos,iepos,nk_rem,nk2,istat c character*(max_line_length) line character*(max_nr_asc_length) nroff c integer*4 dix_dump_file_write_out c istat = 1 ibpos = 1 if(nkar .eq. 0) nkar = 1 !make sure to print at least one line c if(nk_disp .gt. 0) then nk_rem = control.ncols - nk_disp-1-1 else nk_rem = control.ncols endif if(multi) nk_rem = nk_rem - 1 c c Build the intro part c offset|fieldname| c if(nk_nroff .gt. 0) then c c We know the size of the offset(nk_nroff), so convert to that size c call dix_util_con_nr(bit_offset,has_fields, 1 nroff,nk_nroff,number_hex,control) line = nroff(1:nk_nroff)//'|'//fieldname else line = fieldname end if c if(nk_disp .ne. 0) then line(nk_disp+1:nk_disp+1) = '|' nk2 = nk_disp + 1 else nk2 = 0 endif c c Now line(1:nk_disp+1) = offset|fieldname| c (the offset| is optional) c do while(ibpos .le. nkar) iepos = min(nkar,ibpos+nk_rem-1) if(multi) then istat = dix_dump_file_write_out(control,symbname,fieldname, 1 ' '//line(1:nk2),regel(ibpos:iepos)) if(.not. istat) goto 90 else istat = dix_dump_file_write_out(control,symbname,fieldname, 1 line(1:nk2),regel(ibpos:iepos)) if(.not. istat) goto 90 end if ibpos = iepos + 1 if(nk_disp .gt. 0) line(1:nk_disp) = ' ' !leave | present end do 90 dix_dump_file_write_line = istat return end function dix_dump_file_des_part(control,file,dis,des_info, 1 des_Expanded,multi,symbname,pr_count, 1 nk_hline,hline,nk_line,line,mask,vfc,first) implicit none c c Dump with description to file/term with no screen c include 'dix_def.inc' record /control/ control !:i: control block record /file_info/ file !:i: file block record /des_info/ des_info !:i: desciption block record /des_expanded/ des_expanded !:i: expanded des block record /dis_pars/ dis !:i: display parameters logical*4 multi !:i: display more than 1 descriptions? character*(*) symbname !:i: symbolname to output to integer*4 pr_count !:i: record number to print(start with 0) integer*4 nk_hline !:io: length of csv header character*(*) hline !:io: csv header line integer*4 nk_line !:io: length of csv line character*(*) line !:io: csv line logical*4 vfc !:i: the vfc part t the normal part character*(*) mask !:i: mask logical*4 first !:io: first line printed integer*4 dix_dump_file_des_part !:f: function result c# character*(max_command_length) regel integer*4 nk_nroff,cnt,istat logical*4 match integer*4 nkar,k,nk_min,offs,nk_disp,max_len,nbytes record /des_rec/ des_recs(*) pointer (p_des_recs ,des_recs) c logical*4 dix_util_match_string_wild integer*4 dix_dump_file_write_line integer*4 dix_dump_file_write_out integer*4 dix_dump_print_header c character*(max_nr_asc_length) nroff c istat = 1 if(vfc) then p_des_recs = des_expanded.table_vfc.address cnt = des_expanded.table_vfc.count nbytes = file.data.nb_vfc nk_min = des_expanded.vfc_max_name_size else p_des_recs = des_expanded.table_nor.address cnt = des_expanded.table_nor.count nbytes = file.data.nb_data nk_min = des_expanded.max_name_size endif if(.not. dis.field) nk_min = 0 c c Compute max size for number c nk_nroff = 0 nk_disp = nk_min if(dis.number) then call dix_util_con_nr(nbytes*bits_per_byte, 1 des_info.has_fields, 1 nroff,nk_nroff,dis.number_hex,control) nk_disp = nk_disp + nk_nroff if(nk_min .gt. 0) nk_disp = nk_disp + 1 !one for the | end if c c GO through all vfc descripions, and print the result c do k=1,cnt c c Get the desciption c if(.not. dis.compres .or. 1 (des_recs(k).flags .and. des_flag_compressed) .eq. 0) then c c Check if this fieldname wanted c if(control.lun_select .eq. 0) then match = .true. else match = dix_util_match_string_wild(des_recs(k).nam, 1 mask,.false.,wildcard_flag_standard) endif c offs = des_recs(k).bit_offset/8 if(match .and. (offs .lt. nbytes)) then c c Convert th data to ascii c if(vfc) then call dix_con_intasc(nbytes-offs,des_recs(k), 1 file.data.vfc_data,regel,nkar,dis.hex, 1 max_len,control) else call dix_con_intasc(nbytes-offs,des_recs(k), 1 file.data.data_rec,regel,nkar,dis.hex, 1 max_len,control) endif c c Print, in multiple lines c if(control.csv.csv .and. control.csv.header) then if(pr_count .eq. 0) then call dix_dump_csv_add_token(control,nk_hline,hline, 1 des_recs(k).nam, 1 enttyp_chr) endif endif if(control.csv.csv) then c c Add token to csv line c call dix_dump_csv_add_token(control,nk_line,line, 1 regel(1:nkar),des_recs(k).ent_type) else c c Normal output, if not de name not yet printed (and multides) c print des name now c if(first) then c c Print the header line(s) first c istat = dix_dump_print_header(control,file,dis) if(.not. istat) goto 90 if(multi) then call dix_des_display(control,des_info,regel,nkar,.false.) istat =dix_dump_file_write_out(control,symbname, 1 'Description_file', 1 'Description file:',regel(:nkar)) if(.not. istat) goto 90 end if endif first = .false. !and remember header lines are done c c And now the data c if(control.control_c_seen) goto 90 istat = dix_dump_file_write_line(control,regel, 1 nkar,nk_disp,nk_Nroff, 1 des_recs(k).bit_offset,des_info.has_fields, 1 dis.number_hex, 1 symbname,des_recs(k).nam,multi) if(.not. istat) goto 90 endif !csv end if !match on fieldname end if !not compressed enddo !loop over all fields 90 dix_dump_file_des_part = istat return end