;-*-Fundamental-*-
.title ASC_TO_BIN Convert ascii-ified binary files back to binary.
;This program is the inverse of BIN_TO_ASC, which see.

.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_in_name_prompt:	.ascid "Input (asciified) file: "
d_out_name_prompt:	.ascid "Output (binary) file: "
d_not_fab:		.ascid "First input record does not appear to be a FAB."
d_not_seq_prompt:	.ascid "Input file is not sequental, or has weird record type. <ret> to proceed>"
d_not_80:		.ascid "An input file record was not 80 bytes long."
d_report: 		.ascid "There were !SL input records, and !SL output records."


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,usz=80

outfab:	$fab
outrab:	$rab fab=outfab

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

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

d_input_records:.blkl 2
d_output_record:.blkl 2

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

	calls #0,open_sysinout
	clrl in_rec_count
	clrl out_rec_count
	calls #0,get_buffers
	calls #0,get_in_file
	calls #0,get_the_fab
	calls #0,get_out_file
	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_buffers,^m<r2>
	movl #32256,r2
	pushl r2
	calls #1,get_vm
	movl r2,d_output_record
	movl r0,d_output_record+4
	mull2 #8,r2				;number of bits
	divl2 #6,r2				;number of nibbles, becoming bytes
	addl2 #80+6,r2				;round to record boundary
	pushl r2
	calls #1,get_vm
	movl r2,d_input_records
	movl r0,d_input_records+4
	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?
	  bneq 50$
	cmpb infab+fab$b_rfm,#fab$c_fix		;is it fixed length records?
	  bneq 50$
	cmpw infab+fab$w_mrs,#80		;are they 80 bytes long?
	  bneq 50$
	brw 60$
50$:	pushaq d_not_seq_prompt
	pushaq d_out_name			;a random place to read into
	calls #1,read_prompt
60$:	$connect rab=inrab
	  check connect_infile
	ret

.entry get_the_fab,^m<r2,r3,r4,r5,r6>
	movaq d_output_record,r2		;addr of desc
	pushaq (r2)
	calls #1,get_record
	cmpw r0,#fab$c_bln			;is it the right length to be a fab?
	bneq 20$
	movab @4(r2),r6				;get fab addr
	cmpb fab$b_bln(r6),#fab$c_bln		;is the stored length right?
	bneq 20$
	cmpb fab$b_bid(r6),#fab$c_bid		;does it have a fab's id?
	bneq 20$
	  brw 30$				;br if so
20$:	pushaq d_not_fab
	calls #1,type_out
	movl #rms$_iop,r0			;just to create an error
	check not_fab
	bpt
30$:	movc3 #fab$c_bln,(r6),outfab		;copy the fab
	movab outfab,r2
	$fab_store fab=(r2),dna=#0,dns=#0,nam=#0,shr=#0,fac=put,fop=sqo
	clrw fab$w_ifi(r2)
	ret

.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 copy_file,^m<>
5$:	pushaq d_output_record
	calls #1,get_record			;get a record
	tstl r0					;was it eof?
	bgeq 10$				;skip if so
	  ret					;else return
10$:	movw r0,outrab+rab$w_rsz		;store record length
	movl d_output_record+4,outrab+rab$l_rbf	;store buffer addr
	$put rab=outrab
	  check put_copy_file
	incl out_rec_count
	brb 5$					;go for another

;;the arg is addr desc to fill.
.entry get_record,^m<>
	pushaq d_input_records
	calls #1,get_input_records
	tstl r0
	bgeq 10$
	  ret
10$:	pushl r0				;save
	pushaq @4(ap)				;output desc
	pushaq d_input_records
	pushl r0
	calls #3,cvt_records
	popl r0					;restore byte count
	ret

;;the single arg is a desc. It points to some space to buffer input (ascii) records.
;;If there's not enough room, more room is consed and the desc is altered to
;;point to it.  The return value is the number of bytes in the binaryification
;;of the input buffer records.
.entry get_input_records,^m<r2,r3,r4,r5,r6,r7>
	movq @4(ap),r6				;desc to storage
	movzwl r6,r6
	cmpl r6,#80
	bgeq 10$				;br if room there
	movl 4(ap),r2				;addr of desc
	movw #800,(r2)
	pushl #800				;a reasonable default?
	calls #1,get_vm
	movl r0,4(r2)
	movzwl #800,r6
	movl r0,r7
10$:
	movl r7,inrab+rab$l_ubf			;addr of single input record
	$get rab=inrab
	cmpl r0,#rms$_eof
	bneq 20$
	  mnegl #1,r0
	  ret
20$:	check get_get_record
	cmpw inrab+rab$w_rsz,#80
	beql 30$
	  brw not_80
30$:	incl in_rec_count
	;;we need to compute how many input bytes worth of buffering is needed.
	pushab (r7)				;arg
	calls #1,decode_rec_length		;get # bytes in output (binary) record
	pushl r0				;save
	ashl #3,r0,r0				;number of bits in output record
	addl2 #6-1,r0				;rounding
	divl2 #6,r0				;number of 6 bit nibbles -> bytes
	addl2 #6,r0				;include byte count
	addl2 #80-1,r0				;rounding
	divl2 #80,r0				;number of 80-byte records
	mull2 #80,r0				;number of bytes in those records
	pushl r0				;save
	cmpl r0,r6				;does it exceed the current buffer?
	bleq 40$				;br if it's ok
	  movl r0,r6
	  pushl r0				;number needed
	  calls #1,get_vm			;get it
	  movl r0,r7
	  movq r6,@4(ap)			;set arg desc
40$:	popl r6					;recover number of input bytes
	;;state of the world:
	;;r6 has # bytes to be read, including the first record (which already has
	;;been read); r7 has addr of enough buffer to hold all that. inrab+rab$l_ubf
	;;points to the first ascii record.  On the stack is the number of bytes
	;;to go in the output record (to be returned as this routine value).
	cmpl inrab+rab$l_ubf,r7			;has the buffer been switched?
	beql 50$
	  movc3 #80,inrab+rab$l_ubf,(r7)	;move stuff into new buffer
	  movl r7,inrab+rab$l_ubf		;and point to it
50$:	addl2 #80,inrab+rab$l_ubf		;address next record
	subl2 #80,r6				;number of bytes yet to read
	bleq 60$				;br if all done
	$get rab=inrab
	  check get_get_record_2
	cmpw inrab+rab$w_rsz,#80
	beql 55$
	  brw not_80
55$:	incl in_rec_count
	brw 50$					;go for some more
60$:	popl r0					;return the number of output bytes
	ret

not_80:	pushaq d_not_80
	calls #1,type_out
	bpt

;;the single arg is addr of 6 bytes
.entry decode_rec_length,^m<r2,r3>
	movl 4(ap),r1				;byte addr
	clrl r0					;accumulated sum
	clrl r2					;byte index
10$:	subb3 #^a"0",(r1)[r2],r3		;get byte as machine number
	movzbl r3,r3				;extend to longword
	mull2 #10,r0				;shift previous result
	addl2 r3,r0				;add in this digit
	acbl #5,#1,r2,10$			;loop for another
	ret

;;4(ap) is number of bytes to put into output
;;8(ap) is desc to input, 
;;12(ap) is desc to output
.entry cvt_records,^m<r2,r3,r4,r5>
	cmpl 4(ap),@12(ap)			;does outout room reqd exceed room avbl?
	bleq 10$				;br if ok
	pushl 4(ap)				;get room needed
	calls #1,get_vm
	movl 12(ap),r1				;addr of output desc
	movl r0,4(r1)				;store new address there
10$:	movl 8(ap),r0				;desc to input
	addl3 #6,4(r0),r3			;input buf addr, skipping byte count
	movl 12(ap),r0				;output desc addr
	movl 4(r0),r1				;output buf addr
	ashl #3,4(ap),r5			;number of bits
	decl r5					;don't count that last fencepost
	clrl r4					;bit number
		;r0 temp
		;r1 output buf addr
		;r3 input byte addr
		;r4 bit #
		;r5 last bit #
;----here it is, fans, the inner loop
30$:	subb3 #^a" ",(r3)+,r0			;get byte, deasciiify
	insv r0,r4,#6,(r1)			;store nibble
	acbl r5,#6,r4,30$			;br for more
;----end of inner loop
	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 asc_to_bin