Trailing-Edge
-
PDP-10 Archives
-
integ_tools_tops20_v7_30-apr-86_dumper
-
tools/10backup_v2_1/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 v2.1'
!
!
!
! 10BACKUP was written at LaTrobe University when it was realised
! that after our aging KI10 processor was decommissioned, there
! would still be a large number of user tapes around that had been
! written by the DECsystem-10 BACKUP utility. 10BACKUP solves this
! problem by allowing these tape to be read directly onto the VAX,
! even after the DECsystem-10 is gone.
!
! This version of 10BACKUP was set up and tested under VMS V4.1 using
! a TE16 attached to a VAX 11/780 processor. All test tapes were
! produced using BACKUP under TOPS-10 6.03A using a TU40 attached
! to a KI10 processor.
!
!
!
!
! 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.)
! If you have any suggestions or would like any program changes
! then please drop me a line to let me know. I would appreciate
! any feedback so send SPR's to:-
! Paul Nankervis
! Computer Centre
! La Trobe University
! BUNDOORA, 3083
! AUSTRALIA
!
! This program can read its tape input from an RMS file or
! from a foreign mounted tape. If the input is found to be from
! a foreign mounted tape then QIO's are used otherwise RMS is
! called to do the input. The module BIO handles all the tape
! input. For performance BIO multi-buffers its input when using
! QIO's.
!
! Normally the program would directly access the tape using QIO's:-
!
! $ MOUNT/FOREIGN MSA0: 68SURVEY MYTAPE
! $ RUN 10BACKUP
! /TAPE MYTAPE:
! /DIRECTORY ALPHA.*,*YZ.FOR
! .....
! /REWIND
! /SSNAME "My Save Set"
! /DIR *.DAT,*.FOR
! .....
! /REWIND
! /RESTORE AB*YZ.FOR
! /EXIT
! $
!
!
! The program can read its input from an RMS file if need be. This
! is normally only useful for debugging the program:-
!
! $ MOUNT/FOREIGN MTA0:/BLOCK=2720/RECORD=2720
! $ COPY MTA0: 10TAPE.DAT
! $ RUN 10BACKUP
! /TAPE 10TAPE.DAT
! /DIR
! .....
! /REWIND
! /RESTORE *MN*.FOR
! /EXIT
! $
!
!
! When the program reaches the end of input during the processing
! of a save set it assumes that another tape volume must follow.
! In this case it will prompt the user for the name of the next
! tape device if running as an interactive job or reading from an
! RMS file. If reading from a tape in a batch job a message will
! be sent via OPCOM asking the operators to load the next volume.
!
! 10BACKUP prompts for its commands using a '/'. The commands may
! be in lower case and may be abbreviated. They must be seperated
! from any parameters by at least one space or tab character.
! Parameters may be enclosed in double quotes (") in order to preserve
! any special spacing or lowercase characters.
!
! Normally when running 10BACKUP the TAPE command is used as the first
! command to set up access to the tape. After that option setting
! commands such as SSNAME, SIXBIT, OUTPUT_DEFAULT would be used to set
! up any special options. Then RESTORE or DIRECTORY commands may be
! used to actually access the tape.
!
! The commands implemented are:-
!
! TAPE device-name
! DIR [file-names]
! RESTORE [file-names]
! EXIT
! SSNAME [save-set-name]
! OUTPUT_DEFAULT [output-default-file-spec]
! REWIND
! HELP [topic...]
! SKIP file-count
! SIXBIT record-size
!
!
! When running in SIXBIT mode 10BACKUP will produce fixed length
! output records containing the ASCII equivalent of assumed SIXBIT
! input. Each DEC-10 word is broken up into six sixbit characters
! which are converted to ASCII by adding decimal 32. In this way
! every bit of the DEC-10 words can be captured in a VAX file. Naturally
! any binary information in the file which was not SIXBIT would have
! to be converted to the desired format by a user program.
!
!
!
! The source modules that make up the 10BACKUP program are:-
!
! 10BACKUP.BAS the main line program.
! BIO.MAR 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
! $ MACRO 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.
! Some favourites include:
! a) Use VAX CLI command interface.
! b) Handle DATE-75 dates.
! c) Handle device formats other than TM10 (see module C36).
! d) Write of backup tapes?
! e) Better file wildcarding.
! f) Check command parameters better.
!
!
!
!
!
!
!
!
!
%page
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! This is 10BACKUP's mainline to get commands and decide what
! to do with them.
!
! The magic variable in the program is tape_status. It defines
! what state the tape is in according to the following table:-
!
! tape_status condition
!
! -1 the tape device is not open for access
! 0 tape is normal and ready for reads
! 1 reserved
! 2 retryable error detected (internal to process_tape)
! 3 fatal error occured in last tape access
! 4 have reached the end of the tape
!
!
option type = explicit !This helps debugging.
!
!
! First declare a couple of important constants:-
!
declare string constant &
program_version = "10BACKUP v2.1", &
help_library = "SYSPUB:10BACKUP.HLB", &
command_prompt = "/"
!
!
! Declare error status codes:-
!
external long constant &
rms$_eof, bms_unrecmd, bms_notape, &
bms_sixbitsize, bms_endorerr, bms_helperr
!
!
! Declare external functions:-
!
external long function &
lib$get_input, ots$cvt_ti_l, process_tape, &
bur_get_help, bio_tape_init, bio_tape_rewind,&
bio_tape_skip, bio_tape_close
!
! Declare local variables:-
!
declare &
long finished, &
long status_code, &
long tape_status, &
long sixbit_size, &
long skip_count, &
long cmd_verb_size, &
string select_ssnm, &
string output_default, &
string cmd_input, &
string cmd_parameters
!
!
!
! Now for some code,
!
! First initialise everything:-
!
nomargin #0% ! Rotten BASIC and it's margins.
print program_version ! Who are we?
print
tape_status = -1% ! No tape device (yet).
sixbit_size = 0% ! Use ascii restore mode (not sixbit).
select_ssnm = '' ! No particular save set (ie all save sets).
output_default = '' ! No special output defaults.
!
!
! Now loop around executing commands:-
!
finished = 0%
!
until finished
status_code = lib$get_input( cmd_input, command_prompt )
if status_code and 1% then
! Seperate command from parameters.
cmd_input = edit$(cmd_input,441%)
cmd_verb_size = instr(1%,cmd_input,' ')
if cmd_verb_size then !extract parameters
cmd_parameters = right(cmd_input,cmd_verb_size+1%)
if left(cmd_parameters,1%) = '"' then
cmd_parameters = right(cmd_parameters,2%)
if right(cmd_parameters,len(cmd_parameters)) = '"' then
cmd_parameters = left(cmd_parameters,len(cmd_parameters)-1%)
end if
end if
cmd_verb_size = cmd_verb_size - 1%
else
cmd_parameters = ''
cmd_verb_size = len(cmd_input)
end if
! Check to see what command we got.
select left(cmd_input,cmd_verb_size)
case '' ! Ignore nothing.
case left('TAPE',cmd_verb_size)
if tape_status >= 0% then
call bur_chkerr( bio_tape_close )
end if
status_code = bio_tape_init(cmd_parameters)
if status_code and 1% then
tape_status = 0%
else
tape_status = -1%
call bur_wrtmsg( status_code )
end if
case left('DIRECTORY',cmd_verb_size)
if tape_status = 0% then
call bur_chkerr( process_tape( tape_status, 0%, &
sixbit_size, select_ssnm, &
edit$(cmd_parameters,511%), output_default ) )
else
if tape_status < 0% then
call bur_wrtmsg( bms_notape )
else
call bur_wrtmsg( bms_endorerr )
end if
end if
case left('RESTORE',cmd_verb_size)
if tape_status = 0% then
call bur_chkerr( process_tape( tape_status, -1%, &
sixbit_size, select_ssnm, &
edit$(cmd_parameters,511%), output_default ) )
else
if tape_status < 0% then
call bur_wrtmsg( bms_notape )
else
call bur_wrtmsg( bms_endorerr )
end if
end if
case left('EXIT',cmd_verb_size)
finished = -1%
case left('REWIND',cmd_verb_size)
if tape_status >= 0% then
call bur_chkerr( bio_tape_rewind )
tape_status = 0%
else
call bur_wrtmsg( bms_notape )
end if
case left('SSNAME',cmd_verb_size)
select_ssnm = cmd_parameters
case left('OUTPUT_DEFAULT',cmd_verb_size)
output_default = cmd_parameters
case left('HELP',cmd_verb_size)
status_code = bur_get_help( cmd_parameters, help_library, -1% )
if (status_code and 1%) = 0% then
call bur_wrtmsg( bms_helperr, help_library )
call bur_wrtmsg( status_code )
end if
case left('SKIP',cmd_verb_size)
if tape_status = 0% then
status_code = ots$cvt_ti_l( cmd_parameters, skip_count )
if status_code and 1% then
status_code = bio_tape_skip( skip_count )
if status_code and 1% then
tape_status = 0%
else
if status_code = rms$_eof then
tape_status = 4%
else
tape_status = 3%
call bur_wrtmsg( status_code )
end if
end if
else
call bur_wrtmsg( status_code )
end if
else
if tape_status < 0% then
call bur_wrtmsg( bms_notape )
else
call bur_wrtmsg( bms_endorerr )
end if
end if
case left('SIXBIT',cmd_verb_size)
status_code = ots$cvt_ti_l( cmd_parameters, sixbit_size )
if status_code and 1% then
if sixbit_size < 0% or sixbit_size > 32763% then
call bur_wrtmsg( bms_sixbitsize )
sixbit_size = 0% ! Use ASCII mode then.
end if
else
call bur_wrtmsg( status_code )
end if
case else ! What was that?
call bur_wrtmsg( bms_unrecmd )
end select ! Command is processed.
!
! otherwise we got an error reading the command, is it EOF?
!
else
if status_code = rms$_eof then
finished = -1%
else ! Unexpected status
call bur_chkerr( status_code )
end if
end if
next
!
! We have finished, close the tape if it is still open.
!
if tape_status >= 0% then
call bur_chkerr( bio_tape_close )
tape_status = -1%
end if
!
! Exit with the worst program status code encountered.
!
call bur_exit
end ! End of mainline.
3000 function long process_tape( long tape_status, long restore_flag, &
long sixbit_size, string select_ssnm, string select_files, &
string output_default )
!
!
! This module does the actual tape processing. It searches the tape
! for the correct save-set and prints directory information for and
! optionally restores selected files. It is the workhorse of 10BACKUP.
!
option type = explicit !Our little debugging aid.
!
!
! Declare status codes.
!
external long constant &
rms$_eof, ss$_normal, ss$_parity, &
ss$_dataoverun, &
bms_nossend, bms_nosstart, bms_ssnotfound, &
bms_endnoss, bms_endssfile, bms_fileinfile, &
bms_midfile, bms_eofnofile, bms_noname, &
bms_seqerr, bms_gotrptblk, bms_norptblk, &
bms_ignrptblk, bms_excesserrors,bms_chksumerr, &
bms_baddatasize,bms_badblocktype,bms_badrecsize,&
bms_filerdwerr
!
! Declare some external routines.
!
external long function &
lib$get_input, select_file, &
bur_flag_set, bio_tape_init, bio_tape_rewind,&
bio_tape_read, bio_tape_close, bio_tape_skip, &
bio_next_volume
external string function &
bur_get_date, bur_get_ascii, bur_get_sixbit
!
!
! Now set up the parameters describing a BACKUP block,
! these were gleaned from our documentation on BACKUP
! (which was written in 1976 for TOPS-10 6.03A).
!
! 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%
!
!
! Define tape block data locations:-
! (Each 36 bit word is stored in a quadword)
!
! WRDSIZ describes how many of our BASIC integers it
! takes to map out a quadword.
!
declare integer constant wrdsiz = 2%
!
declare integer constant &
g$type = 0%, &
g$seq = g$type + wrdsiz, &
g$rtnm = g$seq + wrdsiz, &
g$flag = g$rtnm + wrdsiz, &
g$chk = g$flag + wrdsiz, &
g$siz = g$chk + wrdsiz, &
g$lnd = g$siz + wrdsiz, &
g$future= g$lnd + wrdsiz, &
g$cust = g$future + 4% * wrdsiz, &
g$vary = g$cust + wrdsiz, &
g$data = g$vary + 20% * wrdsiz
!
!
!
! Set up t$lbl varying word definitions:-
!
declare integer constant &
l$date = g$vary, &
l$fmt = l$date + wrdsiz, &
l$bver = l$fmt + wrdsiz, &
l$mon = l$bver + wrdsiz, &
l$sver = l$mon + wrdsiz, &
l$apr = l$sver + wrdsiz, &
l$dev = l$apr + wrdsiz, &
l$mtch = l$dev + wrdsiz, &
l$rlnm = l$mtch + wrdsiz, &
l$dstr = l$rlnm + wrdsiz
!
!
!
! Set up t$beg, t$con, and t$end varying word definitions:-
!
declare integer constant &
s$date = g$vary, &
s$fmt = s$date + wrdsiz, &
s$bver = s$fmt + wrdsiz, &
s$mon = s$bver + wrdsiz, &
s$sver = s$mon + wrdsiz, &
s$apr = s$sver + wrdsiz, &
s$dev = s$apr + wrdsiz, &
s$mtch = s$dev + wrdsiz
!
!
!
! Set up t$fil varying word definitions:-
!
declare integer constant &
f$pchk = g$vary, &
f$rdw = f$pchk + wrdsiz, &
f$pth = f$rdw + wrdsiz
!
!
!
! Set up o$file block offsets:-
!
declare integer constant &
a$fhln = wrdsiz, &
a$flgs = a$fhln + wrdsiz, &
a$writ = a$flgs + wrdsiz, &
a$alls = a$writ + wrdsiz, &
a$mode = a$alls + wrdsiz, &
a$leng = a$mode + wrdsiz, &
a$bsiz = a$leng + wrdsiz, &
a$vers = a$bsiz + wrdsiz
!
!
! Declare local functions:-
!
declare string function print_sys
declare long function sb_search
declare string function sb_text
declare &
long sb_type, &
long sb_length
!
!
! Declare local variables:-
!
declare &
long sel_ss, &
long in_ss, &
long in_file, &
long write_file, &
long done, &
long status_code, &
long b_wrd(1087), &
string ss_name, &
long file_rdw, &
string file_name, &
string file_type, &
long file_size, &
string file_date, &
long file_at_sb, &
long file_nm_sb, &
long file_nm_sblen, &
long retries, &
long block_seq, &
long block_length, &
long block_address, &
long block_chk(1), &
long block_chksum(1), &
string operator_reply
!
!
!
! First thing to do is to initialize the local variables.
!
in_ss = 0% !Not yet inside a save set.
in_file = 0% !Not yet inside a file.
write_file = 0%
if select_ssnm = '' then
sel_ss = -1% !By default select all save sets.
else
sel_ss = 0% !Only want particular save sets.
end if
!
!
done = 0%
until done !Loop until done.
!
! Read a tape block then decide what to do with it.
!
gosub read_tape
!
! First check to see if we got a block OK:
!
if tape_status then
if in_ss then
if tape_status = 4% then
gosub next_volume
else
call bur_wrtmsg( bms_nossend )
gosub end_ss
done = -1%
end if
else
done = -1%
end if
!
! OK, we got a block, decide what to do with it:
!
else
if block_length > 0% then
select b_wrd(g$type)
case t$fil
if sel_ss then
if in_ss = 0% then
call bur_wrtmsg( bms_nosstart )
block_seq = b_wrd(g$seq)
in_ss = -1%
end if
gosub check_seq
gosub t$fil_block
end if
case t$beg
if in_ss then
call bur_wrtmsg( bms_nossend )
gosub end_ss
end if
if done = 0% then
gosub start_ss
end if
case t$con
if in_ss then
gosub check_seq
gosub ss_block
else
gosub start_ss
end if
case t$end
if sel_ss then
if in_ss = 0% then
call bur_wrtmsg( bms_endnoss )
else
gosub check_seq
gosub end_ss
end if
gosub ss_block
end if
case t$lbl
if sel_ss then
if in_ss then
gosub check_seq
end if
print
print "Volume"; b_wrd(g$rtnm); " of tape: "; &
bur_get_sixbit( 1%, b_wrd(l$rlnm) )
print print_sys( l$date, l$dev, l$mtch )
print
end if
case else
if sel_ss then
if in_ss then
gosub check_seq
end if
end if
end select
else
if sel_ss then
print
print "*** Tape Mark ***"
print
end if
end if
end if
!
next
!
! Well that was easy, we are finished.
!
process_tape = ss$_normal
exit function
start_ss: !
!
! Handle block containing the start of save set.
! Decide whether we want the save set etc:
!
ss_name = sb_text( o$ssnm, g$data, b_wrd(g$lnd) )
if select_ssnm = '' or ss_name = select_ssnm then
gosub ss_block
block_seq = b_wrd(g$seq)
in_ss = -1%
sel_ss = -1%
else
status_code = bio_tape_skip( 1% )
if (status_code and 1%) = 0% then
done = 0%
if status_code = rms$_eof then
tape_status = 4%
call bur_wrtmsg( bms_ssnotfound )
else
tape_status = 3%
call bur_wrtmsg( status_code )
end if
end if
end if
!
return
end_ss: !
!
! End of save set detected.
! Finish with the save set, check we are not
! still processing a file etc:
!
if in_file then
call bur_wrtmsg( bms_endssfile )
gosub end_file
end if
!
in_ss = 0%
if select_ssnm <> '' then
sel_ss = 0%
done = -1%
end if
!
return
t$fil_block: !
!
!
! Handle a t$fil block. If block contains start of file then set up
! the file. Next check for any file data and finally check for end of
! file. A file can start, contain data, and end all in the same tape
! block. The bits in g$flag describe whats going on:
!
!
!
!
! Check for start of file.
if bur_flag_set( b_wrd(g$flag), gf$sof by value ) then
if in_file then ! New file - check if expected.
call bur_wrtmsg( bms_fileinfile )
gosub end_file
end if
gosub new_file ! Go find file name - attributes etc.
end if
!
!
!
if b_wrd(g$siz) > 0% then ! If data in block use it.
if in_file = 0% then
call bur_wrtmsg( bms_midfile )
gosub new_file
end if
if b_wrd(f$rdw) <> file_rdw then
call bur_wrtmsg( bms_filerdwerr )
end if
file_rdw = b_wrd(f$rdw) + b_wrd(g$siz)
if write_file then ! Write data to file.
if sixbit_size > 0% then
call bur_write_sixbit( b_wrd(g$siz), &
b_wrd(g$data+b_wrd(g$lnd)*wrdsiz), sixbit_size )
else
call bur_write_ascii( b_wrd(g$siz), &
b_wrd(g$data+b_wrd(g$lnd)*wrdsiz) )
end if
end if
end if
!
!
!
! Check for end of file.
if bur_flag_set( b_wrd(g$flag), gf$eof by value ) then
if in_file then ! File end - check we have a file.
gosub end_file
else
call bur_wrtmsg( bms_eofnofile )
end if ! File end but no file?
end if
!
!
!
return
new_file: !
!
!
! 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.
!
!
file_nm_sb = sb_search( o$name, g$data, b_wrd(g$lnd) )
if file_nm_sb >= 0% then ! Find name block and get name.
file_nm_sblen = sb_length - 1%
file_name = sb_text( 2%, file_nm_sb+wrdsiz, file_nm_sblen )
file_type = sb_text( 3%, file_nm_sb+wrdsiz, file_nm_sblen )
else
file_name = '' ! Oops, no name block?
file_type = ''
call bur_wrtmsg( bms_noname )
end if
!
!
! Now see if the file is on our list of files to select:-
!
in_file = -1%
file_rdw = 0%
if select_file( file_name, file_type, select_files ) then
gosub print_dir
if restore_flag then
write_file = -1% ! Remember we are restoring the file.
call bio_file_init( file_name+'.'+file_type, output_default )
else
write_file = 0% ! Not restoring the file.
end if
else
write_file = 0% ! File not selected.
end if
!
!
return
print_dir: !
!
! Get file attributes and print directory information.
!
!
!
file_at_sb = sb_search( o$file, g$data, b_wrd(g$lnd) )
if file_at_sb >= 0% then ! Find attribute block and get atributes.
if b_wrd(a$mode) > 1% then ! .IOASL
file_size = ( b_wrd(file_at_sb+a$leng) + 127% ) / 128%
else
file_size = ( b_wrd(file_at_sb+a$leng) + 639% ) / 640%
end if
file_date = bur_get_date( b_wrd(file_at_sb+a$writ) )
print using '\ \.\ \######### \ \', &
file_name, file_type, file_size, file_date
else
print using '\ \.\ \ \ \', &
file_name, file_type, '*** no attribute information ***'
end if ! Print directory information.
!
!
return
end_file: !
!
! Finish with the current file.
!
if write_file then
call bio_file_close ! Tidy up and close current file.
end if
in_file = 0%
!
return
check_seq: !
!
!
! Increment & check sequence number. If wrong sequence number
! in a save set record then something has gone wrong.
!
block_seq = block_seq + 1% ! Increment sequence number.
if b_wrd(g$seq) <> block_seq then
call bur_wrtmsg( bms_seqerr )
block_seq = b_wrd(g$seq)
end if
!
return
ss_block: !
!
!
! Print info from a t$beg, t$con or t$end record.
!
print
select b_wrd(g$type)
case t$beg
print "Start of Save Set: "; ss_name
case t$con
print "Continuation of Save Set: "; ss_name
case t$end
print "End of Save Set: "; ss_name
end select
print "Volume"; b_wrd(g$rtnm);" written by System: "; &
sb_text( o$sysn, g$data, b_wrd(g$lnd) )
print print_sys( s$date, s$dev, s$mtch )
print
!
!
return
read_tape: !
!
!
! 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.
!
retries = 0%
tape_status = 2%
until tape_status <> 2%
gosub read_a_block
select tape_status
case 0%
if retries > 0% then
if block_length > 0% and &
bur_flag_set( b_wrd(g$flag), gf$rpt by value ) then
call bur_wrtmsg( bms_gotrptblk )
else
call bur_wrtmsg( bms_norptblk )
end if
else
if bur_flag_set( b_wrd(g$flag), gf$rpt by value ) then
call bur_wrtmsg( bms_ignrptblk )
tape_status = 2%
end if
end if
case 2%
call bur_wrtmsg( status_code )
retries = retries + 1%
if retries > 4% then
call bur_wrtmsg( bms_excesserrors )
tape_status = 3%
end if
case 3%
call bur_wrtmsg( status_code )
end select
next
!
return
read_a_block: !
!
!
! Read a tape block. Check that it seems Ok, unpack it etc.
! Returned is tape_status containing one of:-
! -1 tape device is not open for access
! 0 normal, tape is open for reading
! 1 * reserved
! 2 * retryable error detected
! 3 fatal (or unknown) error detected
! 4 reached end of tape
! * not returned from this routine
!
status_code = bio_tape_read( block_length, block_address )
!
if status_code and 1% then
if block_length = 2720% then
call c36_unpack( 544% by value, block_address by value, b_wrd(0%) )
call bio_tape_free_buff ! Allow tape buffer to be reused.
if b_wrd(g$type) >= 0% and b_wrd(g$type) <= t$max then
if b_wrd(g$lnd) >= 0% and b_wrd(g$siz) >= 0% and &
b_wrd(g$lnd)+b_wrd(g$siz) <= 512% then
if bur_flag_set( b_wrd(g$flag), gf$nch by value ) then
tape_status = 0%
else
block_chk(0%) = b_wrd(g$chk)
block_chk(1%) = b_wrd(g$chk+1%)
b_wrd(g$chk), b_wrd(g$chk+1%) = 0%
call c36_chksum( 544% by value, b_wrd(0%), block_chksum(0%) )
if block_chksum(0%) = block_chk(0%) and &
block_chksum(1%) = block_chk(1%) then
tape_status = 0%
else
status_code = bms_chksumerr
tape_status = 2%
end if ! Crummy check sum.
end if
else
status_code = bms_baddatasize
tape_status = 2%
end if ! g$lnd or g$siz is bad.
else
status_code = bms_badblocktype
tape_status = 2%
end if ! g$type is bad.
else
if block_length = 0% then
tape_status = 0%
else
status_code = bms_badrecsize
tape_status = 2%
end if ! Tape block size is bad.
end if
else
select status_code
case rms$_eof
tape_status = 4%
case ss$_parity, ss$_dataoverun
tape_status = 2%
case else
tape_status = 3%
end select
end if
!
return
next_volume: !
!
! We have reached the end of the tape and are still inside
! a Save Set. The best thing to do is ask for another tape
! volume:-
!
!
print
print "*** End of Tape ***"
print
print "Another tape volume is required to continue processing of Save Set"
operator_reply = ""
status_code = bio_next_volume( tape_status, operator_reply )
if operator_reply <> "" then
print "Operator Reply: "; operator_reply
end if
if status_code and 1% then
print "10BACKUP is continuing processing of Save Set on new tape volume"
else
if status_code <> rms$_eof then
call bur_wrtmsg( status_code )
else
if tape_status >= 0% then
tape_status = 3%
end if
end if
call bur_wrtmsg( bms_nossend )
gosub end_ss
done = -1%
end if
!
!
return
!
!
! Function to print date written, system name, device name etc.
!
!
def string print_sys( long o_date, long o_dev, long o_mtch )
!
print_sys = 'Written on: ' + bur_get_date( b_wrd(o_date) ) + &
' Using: ' + bur_get_sixbit( 1%, b_wrd(o_dev) ) + &
' At: ' + mid(' 200 556 80016006250', &
(b_wrd(o_mtch) and 7%)*4%-3%,4%) + " bpi (" + &
mid('97',(b_wrd(o_mtch)/16%) and 1%,1%) + '-track)'
!
end def
!
!
! 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 sb_text( long sb_find, long sb_position, long sb_words )
sb_position = sb_search( sb_find, sb_position, sb_words )
if sb_position > 0% then ! Get text from block.
sb_text = bur_get_ascii( sb_length-1%, b_wrd(sb_position+wrdsiz) )
else
sb_text = '' ! Could not find block.
end if
!
end def
!
!
! Function to locate a particular sub-block:-
! Sub-blocks contain overhead information written into
! the data area of the block. eg an o$name block.
! If the sub-block is found we return its location and implicitly
! return sb_length to say how big it is. If sub-the block is not
! found we return -1.
!
def long sb_search( long sb_find, long sb_position, long sb_words )
while sb_words > 0% ! Loop until we give up.
call c36_hfwd( b_wrd(sb_position), sb_type, sb_length )
if sb_type = sb_find then
sb_search = sb_position ! Found the block, say where.
sb_words = 0%
else
if sb_length > 0% then
sb_words = sb_words - sb_length
if sb_words > 0% then
sb_position = sb_position + sb_length * wrdsiz
else
sb_search = -1% ! Sub-Block not found.
end if
else
sb_search = -1% ! Sub-Block not found.
sb_words = 0%
end if
end if
next
!
end def
end function
5000 function long select_file( string file_name, string file_type, &
string select_files )
!
!
! This module checks to see if a particular file should be selected.
! If the file is to be selected 1 is returned, otherwise 0.
! Basically the file name and type are search for in the selected files
! list. Function PATTERN_MATCH is called to see if the file name or
! file type matches any of the names and types in the select_files
! list.
!
option type = explicit
!
!
! Declare internal functions:-
!
declare long function pattern_match
declare &
long data_pos, &
long pattern_pos, &
long star_pos
!
!
! Declare internal variables:-
!
declare &
long name_pos, &
long name_end, &
long type_pos
!
!
if select_files = '' then ! Select specific files?
select_file = 1%
else
select_file = 0%
name_pos = 1% ! Start position of search.
until name_pos > len(select_files)
name_end = pos(select_files,',',name_pos)
if name_end = 0% then
name_end = len(select_files) + 1%
end if
type_pos = pos(select_files,'.',name_pos)
if type_pos = 0% or type_pos > name_end then
type_pos = name_end
end if
if name_pos >= type_pos-1% then
if type_pos = name_end then
select_file = 1%
name_end = len(select_files)
else
if pattern_match(file_type,seg$(select_files,type_pos+1%,name_end-1%)) then
select_file = 1%
name_end = len(select_files)
end if
end if
else
if pattern_match(file_name,seg$(select_files,name_pos,type_pos-1%)) then
if type_pos = name_end then
select_file = 1%
name_end = len(select_files)
else
if pattern_match(file_type,seg$(select_files,type_pos+1%,name_end-1%)) then
select_file = 1%
name_end = len(select_files)
end if
end if
end if
end if
name_pos = name_end + 1%
next ! Have decided about the file.
end if
!
!
exit function
!
!
!
! Function to handle wildcard pattern matches for file names.
! If the match_data matches the pattern then a 1 is returned
! otherwise a 0 is returned. This routine is given some data
! and a pattern to match. The pattern may contain any number
! of * characters for wildcarding. Examples are:
!
! Pattern Data Match
! ======= ==== =====
!
! BILL FRED No
! * FRED Yes
! *ED FRED Yes
! BI*ED FRED No
! FR*ED FRED Yes
! *b*d*f bdf Yes
! *b*d*f abcdef Yes
! *b*d*f adcbef No
!
!
!
def long pattern_match( string match_data, string pattern )
!
pattern_match = 0%
star_pos = pos( pattern, '*', 1% )
if star_pos then
if left( pattern, star_pos-1% ) = left( match_data, star_pos-1% ) then
data_pos = star_pos
pattern_pos = star_pos + 1%
while star_pos
star_pos = pos( pattern, '*', pattern_pos )
if star_pos then
data_pos = pos( match_data, seg$( pattern, pattern_pos, star_pos-1% ), data_pos )
if data_pos then
data_pos = data_pos + ( star_pos - pattern_pos - 1% )
pattern_pos = star_pos + 1%
else
star_pos = 0%
end if
else
if len(match_data) - data_pos >= len(pattern) - pattern_pos then
if right(match_data,len(match_data)-len(pattern)+pattern_pos) = right(pattern,pattern_pos) then
pattern_match = 1%
end if
end if
end if
next
end if
else
if pattern = match_data then
pattern_match = 1%
end if
end if
!
!
end def
end function