Google
 

Trailing-Edge - PDP-10 Archives - LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86 - tools/10backup/10backup.bas
There are 8 other files named 10backup.bas in the archive. Click here to see a list.
1 %title '10BACKUP Program To Read DECsystem 10 Backup Tapes'
  %ident '10BACKUP v1.0'
  !
  !
  !
  !
  ! DEC-10 backup tapes contain fixed length 2720 byte records
  ! written in DEC-10 core dump format. This program is an attempt
  ! at understanding the format of these records.
  !
  ! This program uses interchange mode (ignores Disk and UFD info)
  ! to read DEC-10 backup tapes. (and maybe TOPS-20 Dumper tapes.)
  ! Any bugs in the program must be considered 'par for course'
  ! as it has not yet been extensively tested. In fact the code
  ! for bad block recovery has probably never yet even executed.
  ! If you do find or fix any problems or have any suggestions then
  ! I would be grateful if you could let me know. My address is:-
  !			Paul Nankervis
  !			Computer Centre
  !			La Trobe University
  !			BUNDOORA, 3083
  !			AUSTRALIA
  !
  ! This program is can read its tape input from an RMS file:-
  !
  !		$ MOUNT/FOREIGN MTA0:/BLOCK=2720/RECORD=2720
  !		$ COPY MTA0: 10TAPE.DAT
  !		$ RUN 10BACKUP
  !		/FILE 10TAPE.DAT
  !		/DIR
  !		 .....
  !		/REWIND
  !		/RESTORE
  !		/EXIT
  !		$
  !
  ! Or the program can use QIO's to directly access the tape:-
  !
  !		$ MOUNT/FOREIGN MSA0:
  !		$ RUN 10BACKUP
  !		/TAPE MSA0:
  !		/SSNAME 68SURVEY
  !		/DIR *.DAT,*.FOR
  !		 .....
  !		/REWIND
  !		/RESTORE *.FOR
  !		/EXIT
  !		$
  !
  !
  !
  ! The source modules that make up the 10BACKUP program are:-
  !
  !	10BACKUP.BAS	the main line program.
  !	BIO.BAS		contains tape and file IO routines.
  !	BUR.MAR		is a set of macro utility routines.
  !	C36.MAR		contains 36 bit conversion routines.
  !	BMS.MSG		contains the error message definitions.
  !	10BACKUP.RNH	Runoff input to build the help library.
  !
  ! The program can be compiled and linked in the following manner:-
  !
  !		$ BASIC 10BACKUP
  !		$ BASIC BIO
  !		$ MACRO BUR
  !		$ MACRO C36
  !		$ MESSAGE BMS
  !		$ LINK/NOTRACE 10BACKUP,BIO,BUR,C36,BMS
  !		$ RUNOFF 10BACKUP.RNH
  !		$ LIBRARY/CREATE/HELP 10BACKUP 10BACKUP
  !
  !
  !
  !
  ! There are a couple of extensions that can be made to this program. These
  ! include:-
  !	a) Handle multi-volumes.
  !	b) Use VAX CLI command interface.
  !	c) Handle DATE-75 dates.
  !	d) Handle device formats other than TM10 (see module C36).
  !	e) Multibuffering of tape input (This program must be slow on a TU80).
  !	f) Write of backup tapes?
  !
  !
  !
  !
  !
  !
  !
  !
	option type = explicit
  !
  !
  ! Declare error status codes:-
  !
	external long constant					&
		bms_unrecmd,	bms_notape,	bms_endofile,	&
		bms_notssblk,	bms_unexpectype,bms_nofilend,	&
		bms_seqerr,	bms_filenoeof,	bms_datanofile,	&
		bms_eofnofile,	bms_noname,	bms_noattributes,&
		bms_sixbitsize,	bms_badrecsize,	bms_checksum,	&
		bms_badheader,	bms_badtype,	ss$_normal,	&
		rms$_eof
  !
  !
  ! Declare external functions:-
  !
	external long function					&
		lib$get_input,	bur_flag_set,	bur_get_help,	&
		tape_init,	tape_read,	tape_skip_file,	&
		tape_rewind,	tape_close,	ots$cvt_ti_l
	external string function				&
		bur_get_date, bur_get_sixbit, bur_get_ascii
  !
  !
  !
  ! Set valid codes for record types (for g$type):-
  !
	declare integer constant		&
		t$lbl = 1%,			&
		t$beg = 2%,			&
		t$end = 3%,			&
		t$fil = 4%,			&
		t$ufd = 5%,			&
		t$eov = 6%,			&
		t$com = 7%,			&
		t$con = 8%,			&
		t$max = 8%
  !
  !
  !
  ! Set up g$flag bit definitions:-
  !
	declare integer constant		&
		gf$eof = 0%,			&
		gf$rpt = 1%,			&
		gf$nch = 2%,			&
		gf$sof = 3%
  !
  !
  !
  ! Set up overhead block types:-
  !
	declare integer constant		&
		o$name = 1%,			&
		o$file = 2%,			&
		o$dirt = 3%,			&
		o$sysn = 4%,			&
		o$ssnm = 5%
  !
  !
  !
  ! Set up o$file block offsets:-
  !
	declare integer constant		&
		a$fhln = 1%,			&
		a$flgs = 2%,			&
		a$writ = 3%,			&
		a$alls = 4%,			&
		a$mode = 5%,			&
		a$leng = 6%,			&
		a$bsiz = 7%,			&
		a$vers = 8%
  !
  !
  !
  ! Set up t$lbl varying word definitions:-
  !
	declare integer constant		&
		l$date = 0%,			&
		l$fmt = 1%,			&
		l$bver = 2%,			&
		l$mon = 3%,			&
		l$sver = 4%,			&
		l$apr = 5%,			&
		l$dev = 6%,			&
		l$mtch = 7%,			&
		l$rlnm = 8%,			&
		l$dstr = 9%
  !
  !
  !
  ! Set up t$beg, t$con, and t$end varying word definitions:-
  !
	declare integer constant		&
		s$date = 0%,			&
		s$fmt = 1%,			&
		s$bver = 2%,			&
		s$mon = 3%,			&
		s$sver = 4%,			&
		s$apr = 5%,			&
		s$dev = 6%,			&
		s$mtch = 7%
  !
  !
  ! Map out the unpacked tape block:-
  ! (Each 36 bit word is stored in a quadword)
  !
	map (tape_block) string tape_block = 4352
	map (tape_block)			&
		long g$type(1),			&
		long g$seq(1),			&
		long g$rtnm(1),			&
		long g$flag(1),			&
		string g$chk = 8%,		&
		long g$siz(1),			&
		long g$lnd(1),			&
		long g$future(3,1),		&
		long g$cust(1),			&
		long g$vary(19,1),		&
		long g$data(511,1)
  !
  !
  ! Map out the tape subroutine areas:-
  !
	map (tape_control) long tape_blocksize, long tape_status,	&
		word tape_iosb(3), word tape_chan,			&
		byte tape_mode, byte tape_marks
	map (tape_buffer) string tape_buffer = 32767
  !
  !
  ! Map out file subroutine areas:-
  !
	map (file_control) long file_recsiz, byte file_open_flag
	map (file_buffer) string file_buffer = 32763
  !
  !
  ! Declare overhead block functions:-
  !
	declare long function blk_locate
	declare string function blk_get_text
	declare					&
		long blk_typ,			&
		long blk_len
  !
  !
  ! Command loop variables:-
  !
	declare					&
		long exit_status,		&
		long cmd_status,		&
		long cmd_verb_end,		&
		string cmd_input,		&
		string cmd_verb,		&
		string cmd_parameters
  !
  !
  ! File selection variables:-
  !
	declare					&
		byte ss_loop_flag,		&
		byte fl_loop_flag,		&
		byte restore_flag,		&
		byte direct_flag,		&
		byte sl_restore_flag,		&
		byte sl_direct_flag,		&
		string sl_ssname,		&
		string sl_files,		&
		string sl_name,			&
		string sl_ext,			&
		long sl_sear,			&
		long sl_locat
  !
  !
  ! File/Save-set identification variables:-
  !
	declare					&
		string ssname,			&
		string fl_name,			&
		string fl_ext,			&
		long fl_size,			&
		string fl_date
  !
  !
  ! Read block variables:-
  !
	declare					&
		byte rd_loop_flag,		&
		long read_status,		&
		long read_save_status,		&
		long read_retries,		&
		long read_recseq,			&
		string read_chksum
  !
  !
  ! Name/Attribute block variables:-
  !
	declare					&
		long nm_blk,			&
		long nm_len,			&
		long fl_blk
  !
  !
  ! General variables:-
  !
	declare					&
		byte got_ss_flag,		&
		byte infile_flag,		&
		long sixbit_recsiz,		&
		long skip_count,		&
		long density(7)
  !
  !
  ! Set up density array:-
  !
	density(1) = 200%
	density(2) = 556%
	density(3) = 800%
	density(4) = 1600%
	density(5) = 6250%



1000 !
  ! Initialise everything:-
  !
	exit_status = ss$_normal! No errors yet.
	tape_mode = -1%		! No tape device (yet).
	sixbit_recsiz = 0%	! Use ascii restore mode.
	sl_ssname = ''		! No particular save set.
  !
  !
  ! Now loop around executing commands:-
  !   (until we get an error reading one)
  !
	cmd_status = ss$_normal
	    while cmd_status and 1%
	    cmd_status = lib$get_input( cmd_input, "/" )
	    if cmd_status and 1% then
		cmd_input = edit$(cmd_input,8%)
		cmd_verb_end = instr(1%,cmd_input,' ')
		cmd_verb_end = len(cmd_input) + 1% unless cmd_verb_end
		cmd_verb = edit$(left(cmd_input,cmd_verb_end-1%),511%)
		cmd_parameters = edit$(right(cmd_input,cmd_verb_end+1%),8%)
		select cmd_verb
		    case 'DIR'
			restore_flag = 0%
			direct_flag = -1%
			sl_files = edit$(cmd_parameters,511%)
			gosub 3000
		    case 'RESTORE'
			restore_flag = -1%
			direct_flag = -1%
			sl_files = edit$(cmd_parameters,511%)
			gosub 3000
		    case 'TAPE'
			cmd_status = tape_init(cmd_parameters,2%)
			got_ss_flag = 0%
		    case 'FILE'
			cmd_status = tape_init(cmd_parameters,1%)
			got_ss_flag = 0%
		    case 'REWIND'
			cmd_status = tape_rewind
			got_ss_flag = 0%
		    case 'SKIP'
			cmd_status = ots$cvt_ti_l( cmd_parameters, skip_count )
			if cmd_status and 1% then
			    cmd_status = tape_skip_file( skip_count )
			    got_ss_flag = 0%
			end if
		    case 'SSNAME'
			sl_ssname = cmd_parameters
		    case 'HELP'
			cmd_status = bur_get_help( cmd_parameters,	&
				"SYSPUB:10BACKUP.HLB", -1% )
		    case 'EXIT'
			cmd_status = rms$_eof	! Set up exit status.
		    case 'SIXBIT'
			cmd_status = ots$cvt_ti_l( cmd_parameters, sixbit_recsiz )
			if cmd_status and 1% then
			    if sixbit_recsiz < 0% or sixbit_recsiz > 32763% then
			    cmd_status = bms_sixbitsize
			    sixbit_recsiz = 0%	! Use ASCII mode then.
			    end if
			else
			    sixbit_recsiz = 0%
			end if
		    case ''			! Ignore nothing.
		    case else			! What was that?
			cmd_status = bms_unrecmd
		end select			! Command is processed.
	!
		if (cmd_status and 1%) = 0% then ! Report errors.
		    if cmd_status <> rms$_eof then
			call bur_signal( cmd_status by value )
			if (exit_status and 1%) or			&
				(cmd_status and 7%) > (exit_status and 7%) then
			    exit_status = cmd_status
			end if
			cmd_status = ss$_normal	! Accept further commands.
		    end if
		end if
	    end if
	    next
	!
	if cmd_status <> rms$_eof then		! Not eof? - then bomb.
	    call sys$exit(cmd_status by value)	! Command input error.
	end if
	!
	if tape_mode = 1% or tape_mode = 2% then
	    call tape_close			! Finish with the tape.
	end if
  !
	call sys$exit( exit_status by value )	! Exit with worst status.












3000 !
  !
  !
  ! Read initial tape record, don't read when we already have a
  ! record - like when we found beginning of save set in a previous
  ! read. If the record is a label then go print it's info.
  !
	if tape_mode <> 1% and tape_mode <> 2% then
	    cmd_status = bms_notape		! No tape or file specified.
	else
	    if got_ss_flag = 0% then		! Already have start of ss?
		gosub 9000			! Read first record then.
		if read_status and 1% then
		    if g$type(0%) = t$lbl then
			gosub 7500		! Process t$lbl block.
		    else
			got_ss_flag = -1%	! Assume block is ss start.
		    end if
		end if
	    end if
	    if read_status and 1% then
		gosub 3500			! Process junk on tape.
	    end if
	    if read_status = bms_endofile then
		cmd_status = ss$_normal		! Reached tape end - all OK.
	    else
		cmd_status = read_status	! Pass back status value
	    end if
	end if
  !
	return






3500 !
  !
  !
  ! Loop through all the save sets processing the ones which have
  ! a name matching the user specified name.
  !
	ss_loop_flag = 0%
	    until ss_loop_flag or (read_status and 1%) = 0%
	    if got_ss_flag = 0% then
		gosub 9000			! Get a save set block.
	    end if
	    if read_status and 1% then
		if g$type(0%) = t$beg or g$type(0%) = t$con then
		    ssname = blk_get_text( o$ssnm, 0%, g$lnd(0%) )
		    if sl_ssname = '' then
			gosub 4000		! Process current save set.
		    else
			if sl_ssname = ssname then
			    gosub 4000		! Process this save set.
			    ss_loop_flag = -1%	! No more save sets.
			else
			    call tape_skip_file( 1% )
			    got_ss_flag = 0%	! Skip to next save set.
			end if
		    end if
		else
		    call bur_signal( bms_notssblk by value )
		end if				! Dunno what that block was.
	    end if
	    next
  !
	return



	


4000 !
  !
  !
  ! Process a save set. First dump the save set header then loop
  ! through the save set records handling the files it contains.
  !
	gosub 8000		! Print save set info.
	infile_flag = 0%	! Not yet in any file.
	read_recseq = g$seq(0%)	! Set initial block sequence.
	gosub 9000		! Read first record.
	got_ss_flag = 0%	! Not at start of save set now.
	fl_loop_flag = 0%	! Reset loop control flag.
	    until fl_loop_flag or (read_status and 1%) = 0%
	    select g$type(0%)
		case t$fil
		    gosub 5000		! Check sequence number.
		    if read_status and 1% then
			gosub 6000	! Handle t$fil block.
			gosub 9000	! Read next block.
		    end if
		case t$end
		    gosub 5000		! Check sequence number.
		    if read_status and 1% then
			gosub 8000	! Handle t$end block.
		    end if
		    fl_loop_flag = -1%	! End of save set.
		case t$ufd, t$com
		    gosub 5000		! Check sequence number.
		    gosub 9000		! Read next block.
		case t$beg, t$con
		    got_ss_flag = -1%	! Remember we already have ss start.
		    fl_loop_flag = -1%
		case else
		    call bur_signal( bms_unexpectype by value)
	    end select			! Who was that masked man?
	    next
	!
	if infile_flag then		! Still in file at end of save set?
	    if sl_restore_flag then
		call file_close		! Tidy up by closing file.
	    end if
	    if read_status and 1% then	! Report error unless already have error.
		call bur_signal( bms_nofilend by value )
	    end if
	end if
  !
	return






5000 !
  !
  !
  ! Increment & check sequence number. If wrong sequence number
  ! in a save set record then something has gone wrong.
  !
	read_recseq = read_recseq + 1%	! Increment sequence number.
	if g$seq(0%) <> read_recseq then
	    read_status = bms_seqerr	! Oops - can't have that.
	end if
  !
	return







6000 !
  !
  !
  ! Handle a t$fil record. If block contains start of file then set up
  ! the file. Next check for any file data and finally check for end of
  ! file.
  !
  !					  Check for start of file.
	if bur_flag_set( g$flag(0%), gf$sof by value ) then
	    if infile_flag then		! New file - check if expected.
		call bur_signal( bms_filenoeof by value )
		if sl_restore_flag then
		    call file_close	! Tidy up and close current file.
		end if
	    end if
	    infile_flag = -1%		! We are in a new file.
	    gosub 7000			! Go find file name - attributes etc.
	    if sl_restore_flag then	! Open output file if restoring.
		call file_init( left$(fl_name,9%)+'.'+left$(fl_ext,3%) )
	    end if
	end if
	!
	!				  Check for file data.
	if g$siz(0%) > 0% then		! If data in block use it.
	    if infile_flag then
		if sl_restore_flag then	! Write data to file.
		    if sixbit_recsiz <= 0% then
			call bur_write_ascii( g$siz(0%),		&
				g$data(g$lnd(0%),0%) by ref,		&
				file_recsiz, file_buffer by desc )
		    else
			call bur_write_sixbit( g$siz(0%),		&
				g$data(g$lnd(0%),0%) by ref,		&
				file_recsiz, file_buffer by desc,	&
				sixbit_recsiz )
		    end if
		end if
	    else			! Data but no file?
		call bur_signal( bms_datanofile by value )
	    end if
	end if
	!
	!				  Check for end of file.
	if bur_flag_set( g$flag(0%), gf$eof by value ) then
	    if infile_flag then		! File end - check we have a file.
		if sl_restore_flag then
		    call file_close
		end if
	    else
		call bur_signal( bms_eofnofile by value )
	    end if			! File end but no file?
	    infile_flag = 0%
	end if
  !
	return





7000 !
  !
  !
  ! Have got a t$fil record containing start of file:-
  ! Extract file name and attributes from block and
  ! see if file is to be selected.
  !
	nm_blk = blk_locate( o$name, 0%, g$lnd(0%) )
	if nm_blk >= 0% then			! Find name block and get name.
	    nm_len = nm_blk + blk_len
	    fl_name = blk_get_text( 2%, nm_blk+1%, nm_len )
	    fl_ext = blk_get_text( 3%, nm_blk+1%, nm_len )
	else
	    fl_name = ''			! Oops, no name block?
	    fl_ext = ''
	    call bur_signal( bms_noname by value )
	end if
  !
  !
  ! Now see if the file is on our list of files to select:-
  !
	if sl_files = '' then			! Select particular files?
	    sl_restore_flag = restore_flag
	    sl_direct_flag = direct_flag	! This file is selected.
	else
	    sl_restore_flag = 0%		! Assume we won't select file.
	    sl_direct_flag = 0%
	    sl_sear = 1%			! Start search at start.
		until sl_sear > len(sl_files)
		sl_locat = pos(sl_files,',',sl_sear)
		sl_locat = len(sl_files)+1% unless sl_locat
		sl_name = seg$(sl_files,sl_sear,sl_locat-1%)
		sl_sear = pos(sl_name,'.',1%)
		if sl_sear then			! If extension then extract it.
		    sl_ext = right$(sl_name,sl_sear+1%)
		    sl_name = left$(sl_name,sl_sear-1%)
		else
		    sl_ext = ''			! No extension.
		end if
		sl_sear = sl_locat + 1%		! Rememeber where we got to.
		if sl_name = '*' or sl_name = fl_name then
		    if sl_ext = '*' or sl_ext = fl_ext then
			sl_restore_flag = restore_flag
			sl_direct_flag = direct_flag
		    	sl_sear = len(sl_files) + 1%
		    end if			! Does file match list?
		end if
		next				! Have decided about the file.
	end if
  !
  !
  ! If file is selected for directory info then get attributes
  ! and print them:-
  !
	if sl_direct_flag then		! If directory we want attributes.
	    fl_blk = blk_locate( o$file, 0%, g$lnd(0%) )
	    if fl_blk >= 0% then	! Find attribute block and get atributes.
		if g$data(fl_blk+a$mode,0%) > 1% then  ! .IOASL
		    fl_size = ( g$data(fl_blk+a$leng,0%) + 127% ) / 128%
		else
		    fl_size = ( g$data(fl_blk+a$leng,0%) + 639% ) / 640%
		end if
		fl_date = bur_get_date( g$data(fl_blk+a$writ,0%) )
	    else
		fl_size = 0%		! Oops, no attribute block.
		fl_date = ''
		call bur_signal( bms_noattributes by value )
	    end if			! Print directory information.
	    print using "'LLLLLLLL.'LLLLL#########  'LLLLLLLLLLLLLLLLLLL", &
		    fl_name, fl_ext, fl_size, fl_date
	end if
  !
	return






7500 !
  !
  !
  ! Got a t$lbl record. Boring. Print info if we are doing
  ! a directory.
  !
	if direct_flag then		! Report on label block.
	    print "Start of tape: "; bur_get_sixbit( 1%, g$vary(l$rlnm,0%) ); &
		" Written at: "; bur_get_date( g$vary(l$date,0%) )
	    print "Device: "; bur_get_sixbit( 1%, g$vary(l$dev,0%) );	&
		" Density:"; density(g$vary(l$mtch,0%) and 7%);
	    if g$vary(l$mtch,0%) and 16% then
		print " 7-track"
	    else
		print " 9-track"
	    end if
	    print
	end if
  !
	return






8000 !
  !
  !
  ! Got a t$beg, t$con or t$end record. If doing a directory
  ! then print information.
  !
	if direct_flag then		! Report save set info.
	    print
	    select g$type(0%)
		case t$beg
		    print
		    print "Start";
		case t$con
		    print
		    print "Continuation";
		case t$end
		    print "End";
	    end select
	    print ' of Save Set: '; ssname;				&
		'  Written at: '; bur_get_date( g$vary(s$date,0%) )
	    print 'Under System: '; blk_get_text( o$sysn, 0%, g$lnd(0%) ); &
		'  On: '; bur_get_sixbit( 1%, g$vary(s$dev,0%) )
	    print "Density:"; density(g$vary(s$mtch,0%) and 7%); " Tape:";
	    if g$vary(s$mtch,0%) and 16% then
		print " 7-track"
	    else
		print " 9-track"
	    end if
	    print
	end if
  !
	return




	    

9000 !
  !
  !
  ! Read tape blocks until we get a goodun:-
  !		(or give up)
  ! This means if we get an error we should keep reading until
  ! we get a good block which must have its repeat block flag set.
  !
	rd_loop_flag = 0%
	    until rd_loop_flag		! Read tape ignoring repeat blocks.
	    gosub 9600			!  (we have read blocks OK so far)
	    if read_status and 1% then
		if bur_flag_set( g$flag(0%), gf$rpt by value ) = 0% then
		    rd_loop_flag = -1%	! Not a repeat - exit.
		end if
	    else
		rd_loop_flag = -1%	! Oops, exit with error.
	    end if			!  (now we expect a repeat block)
	    next
	!
	!					  Check for error.
	if (read_status and 1%) = 0% then	! Have to try error recovery.
	    if read_status <> bms_endofile then	! End of tape is OK.
		read_save_status = read_status	! Will report original error status
		read_retries = 0%		! if we cannot recover.
		    until (read_status and 1%) or		&
			read_status = bms_endofile or read_retries > 4%
		    gosub 9600
		    read_retries = read_retries + 1%
		    next
		if read_status and 1% then	! Must have repeat block after error.
		    if bur_flag_set( g$flag(0%), gf$rpt by value ) = 0% then
			read_status = read_save_status
		    end if			! Report original error on failure.
		end if
	    end if
	end if
  !
	return








9600 !
  !
  !
  ! Get a tape block. If it has the write length we unpack it into
  ! quadword format and check that it seems to be OK. ie it has the
  ! correct checksum, its type is in range etc. If we read a tape
  ! mark, (good zero byte record) then ignore it and get another
  ! block (our higher level processing doesn't need tape marks).
  !
	read_status = ss$_normal	! Prepare to skip tape marks.
	tape_blocksize = 0%
	    until (read_status and 1%) = 0% or tape_blocksize <> 0%
	    read_status = tape_read	! Read in a block.
	    if read_status and 1% then	! If OK then check it out.
		if tape_blocksize = 2720% then
		    call c36_unpack( 544% by value, tape_buffer by ref, tape_block by ref )
		    if g$type(0%) >= 0% and g$type(0%) <= t$max then
			if g$lnd(0%) >= 0% and g$siz(0%) >= 0% and		&
					g$lnd(0%)+g$siz(0%) <= 512% then
			    if bur_flag_set( g$flag(0%), gf$nch by value ) = 0% then
				read_chksum = g$chk
				g$chk = string$(8%,0%)
				call c36_chksum( 544% by value, tape_block by ref, g$chk by ref )
				if g$chk <> read_chksum then
				    read_status = bms_checksum
				end if
			    end if
			else
			    read_status = bms_badheader
			end if		! g$lnd or g$siz is bad.
		    else
			read_status = bms_badtype
		    end if		! g$type is bad.
		else
		    if tape_blocksize <> 0% then
			read_status = bms_badrecsize
		    end if		! Tape block size is bad.
		end if
	    end if
	    next			! Loop until not a tape mark.
  !
	return







9800 !
  !
  !
  ! Function to get ascii text from a particular overhead block:-
  ! Locate the overhead block and pass its contents back as an
  ! ascii string.
  !
	def string blk_get_text( long blk_sear, long blk_beg, long blk_end )
	blk_beg = blk_locate( blk_sear, blk_beg, blk_end )
	if blk_beg >= 0% then		! Get text from block.
	    blk_get_text = bur_get_ascii( blk_len-1%, g$data(blk_beg+1%,0%) )
	else
	    blk_get_text = ''		! Could not find block.
	end if
  !
	end def






9900 !
  !
  !
  ! Function to locate a particular overhead block:-
  ! Overhead blocks contain overhead information written into
  ! the data area of the block. eg an o$name block.
  !
	def long blk_locate( long blk_sear, long blk_beg, long blk_end )
	blk_locate = -1%		! Assume we won't find the block.
	    until blk_beg >= blk_end	! Loop until we give up.
	    call c36_hfwd( g$data(blk_beg,0%), blk_typ, blk_len )
	    if blk_typ = blk_sear then
		blk_locate = blk_beg	! Found the block, say where.
		blk_beg = blk_end	! Give up the search
	    else
		if blk_len > 0% then
		    blk_beg = blk_beg + blk_len
		else			! Step to next block.
		    blk_beg = blk_end
		end if			! If the block is found note that we
	    end if			! implicitly return blk_len as the
	    next			! blocks length.
  !
	end def







9999	end