Google
 

Trailing-Edge - PDP-10 Archives - integ_tools_tops20_v7_30-apr-86_dumper - tools/10backup_v2_1/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.1'
;
; 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	#15,#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