Trailing-Edge
-
PDP-10 Archives
-
LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86
-
tools/10backup_v2_3/bur.mar
There are 8 other files named bur.mar in the archive. Click here to see a list.
.title BUR 10BACKUP Utility Routines
.ident 'BUR v2.3'
;
; This module is part of 10BACKUP - a program to read DECsystem-10
; BACKUP tapes in INTERCHANGE mode on a VAX.
;
; This module contains various utility routines for 10BACKUP.
;
; 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.
;
;
;
;
;
;
; BUR_GET_HELP is a function to call LBR$OUTPUT_HELP to provide
; help information.
;
; Called via: STATUS = BUR_GET_HELP( HELP_KEYS, HELP_LIBRARY, HELP_FLAGS )
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_get_help,^M<>
pushab G^LIB$GET_INPUT ;Name of input routine.
pushl 12(AP) ;Flags for help.
pushl 8(AP) ;Name of help library.
pushl 4(AP) ;What to give help on.
clrl -(SP) ;No particular line length.
pushab G^LIB$PUT_OUTPUT ;Name of output routine.
calls #6,G^LBR$OUTPUT_HELP ;Go get help.
;
ret ;Return to caller.
;
;
;
; BUR_FLAG_SET is a function to test whether a bit is set in an
; unpacked DEC-10 word.
;
; Called via: RESULT = BUR_FLAG_SET( WORD, DEC10-BIT BY VALUE )
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_flag_set,^M<>
clrl R0 ;Assume bit is not set.
subl3 8(AP),#35,R1 ;Generate VAX bit number.
bbc R1,@4(AP),10$ ;Is bit clear?
cvtbl #-1,R0 ;Indicate bit was set
;
10$: ret ;Return to caller.
;
;
;
; BUR_GET_DATE is a routine to convert a Universal Date/Time
; in an unpacked DEC-10 word into a string.
;
; Called via: CALL BUR_GET_DATE( DATE_STRING, WORD )
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_get_date,^M<R2,R3,R4>
movl 8(AP),R4 ;Get date quadword address.
movl #52734375,R3 ;Conversion factor.
bicl3 #^XFFFFFFF0,4(R4),R0 ;Get date hi half - no sign extension.
emul (R4),R3,#0,R1 ;Multiply low half.
mull R3,R0 ;Multiply hi half.
tstl (R4) ;Was low half signed?
bgeq 10$ ;No, skip compensation.
addl R3,R0 ;Compensate for sign.
10$: addl R0,R2 ;Add in high half.
ashq #-4,R1,-(SP) ;Shift bits to complete conversion
;
clrl -(SP) ;Conversion flag argument.
pushaq 4(SP) ;Date quadword argument.
pushl 4(AP) ;Output string argument.
clrl -(SP) ;Output length argument.
calls #4,G^LIB$SYS_ASCTIM ;Get ascii time.
;
ret ;Return to caller.
;
;
;
;
; BUR_GET_SIXBIT is a routine for extracting a SIXBIT string from
; a group of unpacked DEC-10 words.
;
; Called via: CALL BUR_GET_SIXBIT( SIXBIT_STRING, WORD_COUNT, WORDS() )
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_get_sixbit,^M<R2,R3,R4,R5,R6>
mull3 #6,@8(AP),R6 ;Get maximum number of chars.
movl 4(AP),R5 ;Get pointer to string desc.
movl dsc$a_pointer(R5),R4 ;Get data address in string.
clrl R3 ;Assume string is right length.
cmpw dsc$w_length(R5),R6 ;Wrong length string?
beql 30$ ;It is OK, go use it.
subl R6,SP ;Make work area on stack.
movl SP,R4 ;Remember work area location.
movb #1,R3 ;Have to copy work area into string.
;
30$: pushl R4 ;Destination argument.
pushl 12(AP) ;Source argument.
pushl @8(AP) ;Number of words argument.
calls #3,G^C36_SIXBIT ;Convert Sixbit data.
;
blbc R3,50$ ;See if data in string or work area.
movl R6,R0 ;Work area length argument.
movl R4,R1 ;Work area address argument.
movl R5,R2 ;Destination descriptor address.
jsb G^LIB$SCOPY_R_DX6 ;Move string to users area.
;
50$: ret ;Return to caller
;
;
;
;
; BUR_GET_ASCII is a routine for extracting an ASCII string from
; a group of unpacked DEC-10 words.
;
; Called via: CALL BUR_GET_ASCII( ASCII_STRING, WORD_COUNT, WORDS() )
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_get_ascii,^M<R2,R3,R4,R5,R6,R7,R8>
mull3 #5,@8(AP),R6 ;Get maximum number of chars.
subl R6,SP ;Make space on stack.
movl SP,R8 ;Remember work area location.
;
pushl R8 ;Destination argument.
pushl 12(AP) ;Source argument.
pushl @8(AP) ;Number of words argument.
calls #3,G^C36_ASCII ;Convert data to ascii.
;
movl R8,R7 ;Address of chars.
10$: locc #0,R6,(R7) ;Look for null character.
beql 20$ ;Exit if none found.
movl R1,R7 ;Remember where we are up to.
skpc #0,R0,(R1) ;Skip over the nulls.
beql 30$ ;Exit at the end.
movl R0,R6 ;Remember how much data left.
movc3 R0,(R1),(R7) ;Shift the data over the nulls.
brb 10$ ;Go do it again.
;
20$: movl R1,R7 ;Where we got up to.
30$: subl3 R8,R7,R0 ;Source string length argument.
movl R8,R1 ;Source string address argument.
movl 4(AP),R2 ;Destination descriptor address.
jsb G^LIB$SCOPY_R_DX6 ;Move string to users area.
;
ret ;Return to caller
;
;
;
;
;
;
; WRTTAB is the translation table for writing ASCII output
; records. Every character is simply output 'as is' with the
; exception of nulls and line feeds. Nulls are simply thrown
; away while line feeds flag the end of a record. If a return
; preceeds the line feed then is is discarded along with the
; line feed before the record is output.
;
.psect data_ro,pic,shr,nowrt,noexe,long
;
wrttab: .byte 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
.byte 0, 11, 12, 13, 14, 15, 16, 17, 18, 19
.byte 20, 21, 22, 23, 24, 25, 26, 27, 28, 29
.byte 30, 31, 32, 33, 34, 35, 36, 37, 38, 39
.byte 40, 41, 42, 43, 44, 45, 46, 47, 48, 49
.byte 50, 51, 52, 53, 54, 55, 56, 57, 58, 59
.byte 60, 61, 62, 63, 64, 65, 66, 67, 68, 69
.byte 70, 71, 72, 73, 74, 75, 76, 77, 78, 79
.byte 80, 81, 82, 83, 84, 85, 86, 87, 88, 89
.byte 90, 91, 92, 93, 94, 95, 96, 97, 98, 99
.byte 100,101,102,103,104,105,106,107,108,109
.byte 110,111,112,113,114,115,116,117,118,119
.byte 120,121,122,123,124,125,126,127
;
;
; BUR_WRITE_ASCII is called to convert a group of unpacked DEC-10
; words to ascii and write them to an output file.
;
; Called via: CALL BUR_WRITE_ASCII( WORD_COUNT, WORDS() )
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_write_ascii,^M<R2,R3,R4,R5,R6>
mull3 #5,@4(AP),R2 ;Get maximum number of chars.
subl R2,SP ;Make space on stack.
movl SP,R3 ;Remember where.
;
pushl R3 ;Destination argument.
pushl 8(AP) ;Source argument.
pushl @4(AP) ;Number of words argument.
calls #3,G^C36_ASCII ;Convert ascii data.
;
movq R2,R0 ;Set up length & address.
movl bio_file_buflen,R3 ;Find out num chars in buffer.
movab bio_file_buffer,R6 ;Get buffer address.
subl3 R3,#bio_file_maxlen,R4 ;Compute remaining room.
movab (R6)[R3],R5 ;Get buffer load address.
;
10$: movtuc R0,(R1),#0,wrttab,R4,(R5) ;Move characters to buffer.
bvc 20$ ;Escape char? - no, what then?
cmpb (R1)+,#10 ;Line feed caused escape?
bneq 50$ ;No, ignore the character then.
cmpl R5,R6 ;Characters in the buffer?
blequ 40$ ;No - don't look in it.
cmpb -(R5),#13 ;Last char a Return?
beql 40$ ;Yes, go write record.
incl R5 ;Put back character.
brb 40$ ;Go write record.
;
20$: tstl R0 ;Any characters left?
bleq 70$ ;No, can exit.
40$: subl3 R6,R5,bio_file_buflen ;Compute current buffer length.
movq R0,R2 ;Save R0 & R1.
calls #0,G^BIO_FILE_WRITE ;Write out the record.
movq R2,R0 ;Recover R0 & R1
movzwl #bio_file_maxlen,R4 ;Reset remaining buffer length.
movl R6,R5 ;Reset current buffer address.
;
50$: sobgtr R0,10$ ;Keep going if more characters.
;
70$: subl3 R6,R5,bio_file_buflen ;Compute current buffer length.
ret ;Return to caller.
;
;
;
;
;
; BUR_WRITE_SIXBIT is called to convert a group of unpacked DEC-10
; words to sixbit and write them to an output file.
;
; Called via: CALL BUR_WRITE_SIXBIT( WORD_COUNT, WORDS(), RECORD_SIZE )
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_write_sixbit,^M<R2,R3,R4,R5,R6,R7>
mull3 #6,@4(AP),R2 ;Get maximum number of chars.
subl R2,SP ;Make space on stack.
movl SP,R3 ;Remember where.
;
pushl R3 ;Destination argument.
pushl 8(AP) ;Source argument.
pushl @4(AP) ;Number of words argument.
calls #3,G^C36_SIXBIT ;Convert sixbit data.
;
movq R2,R0 ;Set up length & address.
movl @12(AP),R6 ;Requested buffer length.
cmpl R6,#bio_file_maxlen ;Requested length too long.
blssu 10$ ;No, stick with maximum length.
movl #bio_file_maxlen,R6 ;Use the maximum length.
10$: movab bio_file_buffer,R7 ;Buffer address.
movl bio_file_buflen,R5 ;Get num of chars in buffer.
subl3 R5,R6,R2 ;Remaining buffer length.
movab (R7)[R5],R3 ;Current load address.
;
20$: cmpl R2,R0 ;Extra characters in output?
bleq 30$ ;No, proceed with move.
movl R0,R2 ;Adjust output size (for no fill)
30$: movc5 R0,(R1),#0,R2,(R3) ;Move characters to buffer.
blss 50$ ;Didn't fill buffer.. can exit.
subl3 R7,R3,bio_file_buflen ;Get current buffer length.
movq R0,R2 ;Save R0 & R1.
calls #0,G^BIO_FILE_WRITE ;Write out the record.
movq R2,R0 ;Recover R0 & R1.
movl R6,R2 ;Reset remaining buffer length.
movl R7,R3 ;Reset current buffer address.
tstl R0 ;Any characters remaining?
bgtr 20$ ;Yup, go do em.
;
50$: subl3 R7,R3,bio_file_buflen ;Pass back current buffer length.
ret ;Return to caller.
;
;
;
; BUR_CHKERR is a routine to check a status code to see if it contains
; an error. All such status codes are fatal.
;
; Called via: CALL BUR_CHKERR( STATUS_CODE )
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_chkerr,^M<>
movl @4(AP),R0 ;Get status code.
blbs R0,10$ ;If no errors just return.
bsbw set_exit_status ;Set exit status.
pushl R0 ;Pass status code by value.
calls #1,G^SYS$EXIT ;Call SYS$EXIT routine.
;
10$: ret ;Return to caller.
;
;
;
; BUR_WRTMSG is a routine to write message information.
;
; Called via: CALL BUR_WRTMSG( STATUS_CODE[, FAO1[, ...] ] )
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_wrtmsg,^M<R2,R3,R4>
movl @4(AP),R0 ;Get status code.
blbs R0,5$ ;Skip set exit status if OK.
bsbb set_exit_status ;Set exit status.
5$: movzbl #1,R4 ;Assume system facility.
extzv #16,#12,R0,R1 ;Get facility code.
beql 80$ ;Zero facility - system message.
cmpl R1,#1 ;Is it RMS facility?
beql 50$ ;Facility is one - RMS message.
clrl R4 ;No FAO arguments yet.
movzbl (AP),R3 ;Get number of arguments.
moval (AP)[R3],R2 ;Point to last argument.
decl R3 ;Already got status argument.
bleq 20$ ;If no FAO args skip set up.
10$: pushl (R2) ;Put argument on stack.
incl R4 ;Remember the argument.
subl #4,R2 ;Point to next argument.
sobgtr R3,10$ ;Do for all arguments.
20$: movw #^X000F,-(SP) ;Put in message options.
movw R4,-(SP) ;Put in FAO argument count.
addl #2,R4 ;Set up vector arg count.
brb 80$ ;Go write the message.
50$: cmpb (AP),#2 ;Is argument present.
bgeq 60$ ;Yes, go use it
clrl -(SP) ;No FAO argument present.
brb 70$ ;Skip on.
60$: pushl @8(AP) ;Get argument
70$: movzbl #2,R4 ;One argument for RMS message.
;
80$: pushl R0 ;Put message code on stack.
movw #^X000F,-(SP) ;Put in message options.
movw R4,-(SP) ;Put in argument count.
movl SP,R5 ;Get address of message vector.
$putmsg_s msgvec=(R5) ;Put the message.
;
ret ;Return to caller.
;
;
; BUR_EXIT is a routine to exit with 'exit_status'
;
; Called via: CALL BUR_EXIT
;
.psect data,rd,wrt,quad
;
exit_status:: .long 1 ;Initial exit status.
;
.psect $code,pic,shr,nowrt,long
;
.entry bur_exit,^M<>
bisl3 #^X10000000,exit_status,R0 ;Get status without message.
$exit_s R0 ;Program exit.
;
set_exit_status::
blbs exit_status,10$ ;Has there been errors?
bicl3 #^XFFFFFFF8,exit_status,-(SP) ;Get last severity.
cmpzv #0,#3,R0,(SP)+ ;Is new severity worse?
blequ 20$ ;No, don't need to remember it.
10$: movl R0,exit_status ;Set exit_status.
20$: rsb ;Return to caller
;
;
;
.end