;-*-Fundamental-*-
.title BIN_TO_ASC Convert binary files to ascii

;Each 6 bits of binary input record get represented in the ascii
;output record as a char between %x20 and %x7F (space to underscore).

;Each input record is represented in the output file by one or 
;more 80-byte output records.  The first output record for each
;input record starts is prefixed by 6 decimal digits encoding the 
;input record length in bytes.


.macro check text,?tag,?texttag
.save_psect local_block
.psect text_psect
zz'texttag:	.ascid "text"
.restore_psect

	blbs r0,tag
	  pushl r0
	  pushaq zz'texttag
	  calls #2,check_fn
tag:
.endm check

.psect text_psect,nowrt

d_not_seq:		.ascid "Input file is not sequential, or has weird record type."
d_in_name_prompt:	.ascid "Input file name: "
d_out_name_prompt:	.ascid "Output file name: "
d_report: 		.ascid "There were !SL input records, and !SL output records."
d_6zl:			.ascid "!6ZL"

d_in_name:	.long 128
		.address in_name
d_out_name:	.long 128
		.address out_name

.psect data_psect,rd,wrt,long

sysinfab:	$fab fnm=<SYS$INPUT>,fac=get
sysinrab:	$rab fab=sysinfab
sysoutfab:	$fab fnm=<SYS$OUTPUT>,fac=put,org=seq,rat=cr,rfm=var
sysoutrab:	$rab fab=sysoutfab

infab:	$fab fac=get, fop=sqo
inrab:	$rab fab=infab

outfab:	$fab org=seq, rfm=fix, mrs=80, rat=cr, fac=put, fop=sqo
outrab:	$rab fab=outfab

in_name:		.blkb 128		;name of the input file
out_name:	.blkb 128			;name of the output file

out_buffer:	.blkl 1				;address of the output buffer
out_records:	.blkl 1				;number of output records

in_rec_count:	.blkl 1				;input record count
out_rec_count:	.blkl 1				;output record count


.psect code_psect,nowrt
.entry bin_to_asc,^m<r2,r3,r4,r5,r6>

	calls #0,open_sysinout
	clrl in_rec_count
	clrl out_rec_count
	calls #0,get_in_file
	calls #0,get_buffers
	calls #0,get_out_file
	calls #0,send_the_fab
	calls #0,copy_file
	calls #0,close_files
	calls #0,report_stats
	movl #ss$_normal,r0
	ret

.entry open_sysinout,^m<>
	$open fab=sysinfab
	  check open_sysin
	$connect rab=sysinrab
	  check connect_sysin
	$create fab=sysoutfab
	  check create_sysout
	$connect rab=sysoutrab
	  check connect_sysout
	ret


.entry get_in_file,^m<>
	pushaq d_in_name_prompt			;prompt to use
	pushaq d_in_name			;buf to read into
	calls #2,read_prompt			;read the input filename into in_name
	movb r0,infab+fab$b_fns			;store length of the name
	movab in_name,infab+fab$l_fna		;store addr of name
	$open fab=infab				;open the input file
	  check open_infile
	cmpb infab+fab$b_org,#fab$c_seq		;is it a sequential file?
	  beql 10$
	  brw 50$
10$:	cmpb infab+fab$b_rfm,#fab$c_fix		;is it fixed length records?
	  beql 20$
	cmpb infab+fab$b_rfm,#fab$c_var		;or variable?
	  beql 20$
	  brw 50$				;else can't hack it
20$:	$connect rab=inrab
	  check connect_infile
	ret

50$:	pushaq d_not_seq
	calls #1,type_out
	movl #rms$_iop,r0			;just to create an error
	check not_seq_or_fix
	bpt

.entry get_out_file,^m<>
	pushaq d_out_name_prompt		;prompt to use
	pushaq d_out_name			;buf to read into
	calls #2,read_prompt			;read the output filename into out_name
	movb r0,outfab+fab$b_fns		;store length of name
	movab out_name,outfab+fab$l_fna		;store addr of name
	$create fab=outfab			;open the output file
	  check create_outfile
	$connect rab=outrab
	  check connect_outfile
	ret

.entry get_buffers,^m<r2,r3,r4,r5>		;movc5 below clobbers all these
;;get input buffer
	movzwl infab+fab$w_mrs,-(sp)		;number of bytes
	bgtr 10$				;skip unless zero?
	  movl #1024,(sp)			;else pick some reasonable(?) default
	  movl #1024,infab+fab$w_mrs
10$:	calls #1,get_vm				;get a buffer that big
	movl r0,inrab+rab$l_ubf			;store it as input buffer
	movw infab+fab$w_mrs,inrab+rab$w_usz	;store its length
;;get output buffer.  Figure out how many 6-bit nibbles there are, consider
;;them to be bytes, then figure out how many 80-byte records it takes to hold
;;that many bytes, and allocate enough bytes to hold all those records.
	movzwl infab+fab$w_mrs,r0		;size of input record in bytes
	ashl #3,r0,r0				;size of input record in bits
	addl2 #6-1,r0				;rounding for division by 6
	divl2 #6,r0				;number of 6-bit nibbles we want
	addl2 #6,r0				;room for record length prefix
	addl2 #80-1,r0				;rounding for division by 80
	divl2 #80,r0				;number of 80-byte records
	movl r0,out_records			;store that for future reference
	mull2 #80,r0				;number of bytes in those records
	pushl r0				;save
	pushl r0				;argument
	calls #1,get_vm				;get the buffer
	movl r0,out_buffer			;store its address
;;fill last 80 bytes with spaces to make the last record look nice
	addl2 (sp)+,r0				;addr of byte beyond buffer
	movc5 #0,(sp),-				;source operand
	      #^a" ",-				;fill with space
	      #80,-80(r0)			;destination operand
	ret

.entry send_the_fab,^m<>
	pushal infab				;fab address
	pushl #fab$c_bln			;fab length
	calls #2,send_record
	ret

.entry copy_file,^m<>
10$: 	$get rab=inrab				;try to get an input record
	blbs r0,20$				;br if ok
	  brw 50$
20$:	incl in_rec_count
	pushl inrab+rab$l_rbf			;address
	movzwl inrab+rab$w_rsz,-(sp)		;length
	calls #2,send_record
	brw 10$
50$:	cmpl r0,#rms$_eof			;end of file?
	bneq 60$
	  ret
60$:	check get_copy_file
	bpt

.entry send_record,^m<r2,r3,r4,r5>
;;First 6 chars are record length
	movaq -(sp),r0				;addr of desc
	movl #6,(r0)				;length
	movl out_buffer,4(r0)			;addr
	$fao_s ctrstr=d_6zl,outbuf=(r0),p1=4(ap)
	  check fao_send_record
	movl 8(ap),r2				;addr
	movl 4(ap),r3				;length in bytes
	ashl #3,r3,r3				;length in bits
	decl r3					;don't count the last fencepost
	clrl r4					;input bit number
	addl3 #6,out_buffer,r5			;output byte address, incl leading 6 butes
;----here it is, fans, the inner loop
30$:	extzv r4,#6,(r2),r0			;get 6 bits
	addb3 #^a" ",r0,(r5)+			;store their conversion to ascii
	acbl r3,#6,r4,30$			;incr bit number and branch
;----end of inner loop
	subl3 out_buffer,r5,r0			;number of bytes written
	clrl r1					;high order longword for ediv
	ediv #80,r0,r0,r1			;r1 is # of bytes put in last 80-byte record
	tstl r1					;were there any?
	beql 40$				;br if none
	  subl3 r1,#80,r1			;else get # of bytes to fill
	  movc5 #0,(sp),#^a" ",r1,(r5)		;pad them with spaces.
	  movl r3,r5				;r5 gets 1+ last byte addr
40$:	decl r5					;don't count that last fencepost
	;;r5 has addr of last byte to be written
	movl out_buffer,outrab+rab$l_rbf	;addr of buffer piece to write
	movw #80,outrab+rab$w_rsz
60$:	$put rab=outrab
	  check put_copy_file
	incl out_rec_count
	acbl r5,#80,outrab+rab$l_rbf,60$	;incr to next output record
	ret

.entry close_files,^m<>
	$close fab=outfab
	  check close_out
	$close fab=infab
	  check close_in
	ret

.entry report_stats,^m<r2,r3>
	pushl out_rec_count
	pushl in_rec_count
	pushaq d_report
	calls #3,faotype
	ret

;;read line into the buf desc in 4(ap), using prompt desc in 8(ap)
;;return size of line read
.entry read_prompt,^m<r2>
	moval sysinrab,r2
	movq @4(ap),r0				;length, addr of buffer
	movw r0,rab$w_usz(r2)			;buffer size
	movl r1,rab$l_ubf(r2)			;buffer address
	movq @8(ap),r0				;length, addr of prompt
	movb r0,rab$b_psz(r2)			;prompt size
	movl r1,rab$l_pbf(r2)			;prompt address
	bisl2 #rab$m_pmt,rab$l_rop(r2)
	$get rab=(r2)
	  check get_read_prompt
	movzwl rab$w_rsz(r2),r0			;return record size
	ret

.entry faotype,^m<r2,r3>
	movab -100(sp),sp			;room for a buffer
	movab (sp),r2				;addr of buffer
	movaq -(sp),r3				;addr of desc  
	movl #100,(r3)				;length
	movab (r2),4(r3)			;addr
	moval -(sp),r2				;addr of return length
	$faol_s ctrstr=@4(ap),outlen=(r2),outbuf=(r3), prmlst=8(ap)
	  check faol_faotype
	movzwl (r2),(r3)			;store length in desc
	pushaq (r3)
	calls #1,type_out			;write it out
	ret

.entry type_out,^m<r2>
	moval sysoutrab,r2			;address the rab
	movq @4(ap),r0				;length, addr of line to type
	movw r0,rab$w_rsz(r2)			;size
	movl r1,rab$l_rbf(r2)			;addr
	$put rab=(r2)				;write it out
	  check type_out
	ret

.entry get_vm,^m<r2>
	moval -(sp),r2				;addr of longword to get address
	pushal (r2)				;arg
	pushal 4(ap)				;arg
	calls #2,lib$get_vm
	  check get_vm
	movl (r2),r0				;return the address
	ret

.entry check_fn,^m<>
	pushl 4(ap)
	calls #1,type_out
	pushl 8(ap)
	calls #1,lib$signal
	ret

.end bin_to_asc