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