$! ...................... Cut between dotted lines and save. .....................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.03 20-Oct-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user GJC
$! on 24-OCT-1990 13:05:49.64.
$!
$! It contains the following 2 files:
$!        ASC2BIN.MAR
$!        BIN2ASC.MAR
$!
$!==============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.03 20-Oct-1988 requires VMS V4.4 or higher."
$ EXIT 44 
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY

b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) );
s_file_spec := GET_INFO( COMMAND_LINE, "output_file" );SET( OUTPUT_FILE
, b_part, s_file_spec ); 
b_errors := CREATE_BUFFER( "{Errors}" );i_errors := 0; 
pat_beg_1 := ANCHOR & "-+-+-+ Beginning";
pat_beg_2 := LINE_BEGIN & "+-+-+-+ Beginning";
pat_end := ANCHOR & "+-+-+-+-+ End";
pat_trail := " " & LINE_END;POSITION( BEGINNING_OF( b_part ) ); LOOP b 
:= SEARCH( pat_trail, FORWARD); EXITIF b=0; POSITION( END_OF( b ) )
; LOOP MOVE_HORIZONTAL( -1 ); EXITIF CURRENT_CHARACTER <> ' '; ERASE_CHARACTER
( 1 ); EXITIF CURRENT_OFFSET=0; ENDLOOP; ENDLOOP; POSITION( BEGINNING_OF
( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE ) = END_OF( b_part )
; s_x := ERASE_CHARACTER( 1 ); 
  IF s_x = "+" THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <
> 0 THEN 
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF; 
  IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN 
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF; 
  IF s_x = "V" THEN 
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL( 1 ); ENDIF; 
  IF s_x = "X" THEN 
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; 
  IF s_x <> "" THEN i_errors := i_errors + 1; s_text := CURRENT_LINE; POSITION
( b_errors ); 
    COPY_TEXT( "The following line could not be unpacked properly:" )
; SPLIT_LINE; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part )
; MOVE_VERTICAL( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP 
  r_x := SEARCH( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x )
; ERASE_CHARACTER( 1 ); 
  IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) ); 
  COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; 
  SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" );ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "ASC2BIN.MAR"
$ CHECKSUM_IS = 522080688
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X;-*-Fundamental-*-
X.title ASC_TO_BIN Convert ascii-ified binary files back to binary.
X;This program is the inverse of BIN_TO_ASC, which see.
X
X.macro check text,?tag,?texttag
X.save_psect local_block
X.psect text_psect
Xzz'texttag:`009.ascid "text"
X.restore_psect
X
X`009blbs r0,tag
X`009  pushl r0
X`009  pushaq zz'texttag
X`009  calls #2,check_fn
Xtag:
X.endm check
X
X.psect text_psect,nowrt
X
Xd_in_name_prompt:`009.ascid "Input (asciified) file: "
Xd_out_name_prompt:`009.ascid "Output (binary) file: "
Xd_not_fab:`009`009.ascid "First input record does not appear to be a FAB."
Vd_not_seq_prompt:`009.ascid "Input file is not sequental, or has weird record t
Xype. <ret> to proceed>"
Xd_not_80:`009`009.ascid "An input file record was not 80 bytes long."
Vd_report: `009`009.ascid "There were !SL input records, and !SL output records.
X"
X
X
Xd_in_name:`009.long 128
X`009`009.address in_name
Xd_out_name:`009.long 128
X`009`009.address out_name
X
X.psect data_psect,rd,wrt,long
X
Xsysinfab:`009$fab fnm=<SYS$INPUT>,fac=get
Xsysinrab:`009$rab fab=sysinfab
Xsysoutfab:`009$fab fnm=<SYS$OUTPUT>,fac=put,org=seq,rat=cr,rfm=var
Xsysoutrab:`009$rab fab=sysoutfab
X
Xinfab:`009$fab fac=get, fop=sqo
Xinrab:`009$rab fab=infab,usz=80
X
Xoutfab:`009$fab
Xoutrab:`009$rab fab=outfab
X
Xin_name:`009.blkb 128`009`009`009;name of the input file
Xout_name:`009.blkb 128`009`009`009;name of the output file
X
Xin_rec_count:`009.blkl 1`009`009`009`009;input record count
Xout_rec_count:`009.blkl 1`009`009`009`009;output record count
X
Xd_input_records:.blkl 2
Xd_output_record:.blkl 2
X
X.psect code_psect,nowrt
X.entry asc_to_bin,`094m<r2,r3,r4,r5,r6>
X
X`009calls #0,open_sysinout
X`009clrl in_rec_count
X`009clrl out_rec_count
X`009calls #0,get_buffers
X`009calls #0,get_in_file
X`009calls #0,get_the_fab
X`009calls #0,get_out_file
X`009calls #0,copy_file
X`009calls #0,close_files
X`009calls #0,report_stats
X`009movl #ss$_normal,r0
X`009ret
X
X.entry open_sysinout,`094m<>
X`009$open fab=sysinfab
X`009  check open_sysin
X`009$connect rab=sysinrab
X`009  check connect_sysin
X`009$create fab=sysoutfab
X`009  check create_sysout
X`009$connect rab=sysoutrab
X`009  check connect_sysout
X`009ret
X
X.entry get_buffers,`094m<r2>
X`009movl #32256,r2
X`009pushl r2
X`009calls #1,get_vm
X`009movl r2,d_output_record
X`009movl r0,d_output_record+4
X`009mull2 #8,r2`009`009`009`009;number of bits
X`009divl2 #6,r2`009`009`009`009;number of nibbles, becoming bytes
X`009addl2 #80+6,r2`009`009`009`009;round to record boundary
X`009pushl r2
X`009calls #1,get_vm
X`009movl r2,d_input_records
X`009movl r0,d_input_records+4
X`009ret
X
X.entry get_in_file,`094m<>
X`009pushaq d_in_name_prompt`009`009`009;prompt to use
X`009pushaq d_in_name`009`009`009;buf to read into
X`009calls #2,read_prompt`009`009`009;read the input filename into in_name
X`009movb r0,infab+fab$b_fns`009`009`009;store length of the name
X`009movab in_name,infab+fab$l_fna`009`009;store addr of name
X`009$open fab=infab`009`009`009`009;open the input file
X`009  check open_infile
X`009cmpb infab+fab$b_org,#fab$c_seq`009`009;is it a sequential file?
X`009  bneq 50$
X`009cmpb infab+fab$b_rfm,#fab$c_fix`009`009;is it fixed length records?
X`009  bneq 50$
X`009cmpw infab+fab$w_mrs,#80`009`009;are they 80 bytes long?
X`009  bneq 50$
X`009brw 60$
X50$:`009pushaq d_not_seq_prompt
X`009pushaq d_out_name`009`009`009;a random place to read into
X`009calls #1,read_prompt
X60$:`009$connect rab=inrab
X`009  check connect_infile
X`009ret
X
X.entry get_the_fab,`094m<r2,r3,r4,r5,r6>
X`009movaq d_output_record,r2`009`009;addr of desc
X`009pushaq (r2)
X`009calls #1,get_record
X`009cmpw r0,#fab$c_bln`009`009`009;is it the right length to be a fab?
X`009bneq 20$
X`009movab @4(r2),r6`009`009`009`009;get fab addr
X`009cmpb fab$b_bln(r6),#fab$c_bln`009`009;is the stored length right?
X`009bneq 20$
X`009cmpb fab$b_bid(r6),#fab$c_bid`009`009;does it have a fab's id?
X`009bneq 20$
X`009  brw 30$`009`009`009`009;br if so
X20$:`009pushaq d_not_fab
X`009calls #1,type_out
X`009movl #rms$_iop,r0`009`009`009;just to create an error
X`009check not_fab
X`009bpt
X30$:`009movc3 #fab$c_bln,(r6),outfab`009`009;copy the fab
X`009movab outfab,r2
X`009$fab_store fab=(r2),dna=#0,dns=#0,nam=#0,shr=#0,fac=put,fop=sqo
X`009clrw fab$w_ifi(r2)
X`009ret
X
X.entry get_out_file,`094m<>
X`009pushaq d_out_name_prompt`009`009;prompt to use
X`009pushaq d_out_name`009`009`009;buf to read into
X`009calls #2,read_prompt`009`009`009;read the output filename into out_name
X`009movb r0,outfab+fab$b_fns`009`009;store length of name
X`009movab out_name,outfab+fab$l_fna`009`009;store addr of name
X`009$create fab=outfab`009`009`009;open the output file
X`009  check create_outfile
X`009$connect rab=outrab
X`009  check connect_outfile
X`009ret
X
X.entry copy_file,`094m<>
X5$:`009pushaq d_output_record
X`009calls #1,get_record`009`009`009;get a record
X`009tstl r0`009`009`009`009`009;was it eof?
X`009bgeq 10$`009`009`009`009;skip if so
X`009  ret`009`009`009`009`009;else return
X10$:`009movw r0,outrab+rab$w_rsz`009`009;store record length
X`009movl d_output_record+4,outrab+rab$l_rbf`009;store buffer addr
X`009$put rab=outrab
X`009  check put_copy_file
X`009incl out_rec_count
X`009brb 5$`009`009`009`009`009;go for another
X
X;;the arg is addr desc to fill.
X.entry get_record,`094m<>
X`009pushaq d_input_records
X`009calls #1,get_input_records
X`009tstl r0
X`009bgeq 10$
X`009  ret
X10$:`009pushl r0`009`009`009`009;save
X`009pushaq @4(ap)`009`009`009`009;output desc
X`009pushaq d_input_records
X`009pushl r0
X`009calls #3,cvt_records
X`009popl r0`009`009`009`009`009;restore byte count
X`009ret
X
V;;the single arg is a desc. It points to some space to buffer input (ascii) rec
Xords.
X;;If there's not enough room, more room is consed and the desc is altered to
X;;point to it.  The return value is the number of bytes in the binaryification
X;;of the input buffer records.
X.entry get_input_records,`094m<r2,r3,r4,r5,r6,r7>
X`009movq @4(ap),r6`009`009`009`009;desc to storage
X`009movzwl r6,r6
X`009cmpl r6,#80
X`009bgeq 10$`009`009`009`009;br if room there
X`009movl 4(ap),r2`009`009`009`009;addr of desc
X`009movw #800,(r2)
X`009pushl #800`009`009`009`009;a reasonable default?
X`009calls #1,get_vm
X`009movl r0,4(r2)
X`009movzwl #800,r6
X`009movl r0,r7
X10$:
X`009movl r7,inrab+rab$l_ubf`009`009`009;addr of single input record
X`009$get rab=inrab
X`009cmpl r0,#rms$_eof
X`009bneq 20$
X`009  mnegl #1,r0
X`009  ret
X20$:`009check get_get_record
X`009cmpw inrab+rab$w_rsz,#80
X`009beql 30$
X`009  brw not_80
X30$:`009incl in_rec_count
X`009;;we need to compute how many input bytes worth of buffering is needed.
X`009pushab (r7)`009`009`009`009;arg
X`009calls #1,decode_rec_length`009`009;get # bytes in output (binary) record
X`009pushl r0`009`009`009`009;save
X`009ashl #3,r0,r0`009`009`009`009;number of bits in output record
X`009addl2 #6-1,r0`009`009`009`009;rounding
X`009divl2 #6,r0`009`009`009`009;number of 6 bit nibbles -> bytes
X`009addl2 #6,r0`009`009`009`009;include byte count
X`009addl2 #80-1,r0`009`009`009`009;rounding
X`009divl2 #80,r0`009`009`009`009;number of 80-byte records
X`009mull2 #80,r0`009`009`009`009;number of bytes in those records
X`009pushl r0`009`009`009`009;save
X`009cmpl r0,r6`009`009`009`009;does it exceed the current buffer?
X`009bleq 40$`009`009`009`009;br if it's ok
X`009  movl r0,r6
X`009  pushl r0`009`009`009`009;number needed
X`009  calls #1,get_vm`009`009`009;get it
X`009  movl r0,r7
X`009  movq r6,@4(ap)`009`009`009;set arg desc
X40$:`009popl r6`009`009`009`009`009;recover number of input bytes
X`009;;state of the world:
X`009;;r6 has # bytes to be read, including the first record (which already has
V`009;;been read); r7 has addr of enough buffer to hold all that. inrab+rab$l_ub
Xf
X`009;;points to the first ascii record.  On the stack is the number of bytes
X`009;;to go in the output record (to be returned as this routine value).
X`009cmpl inrab+rab$l_ubf,r7`009`009`009;has the buffer been switched?
X`009beql 50$
X`009  movc3 #80,inrab+rab$l_ubf,(r7)`009;move stuff into new buffer
X`009  movl r7,inrab+rab$l_ubf`009`009;and point to it
X50$:`009addl2 #80,inrab+rab$l_ubf`009`009;address next record
X`009subl2 #80,r6`009`009`009`009;number of bytes yet to read
X`009bleq 60$`009`009`009`009;br if all done
X`009$get rab=inrab
X`009  check get_get_record_2
X`009cmpw inrab+rab$w_rsz,#80
X`009beql 55$
X`009  brw not_80
X55$:`009incl in_rec_count
X`009brw 50$`009`009`009`009`009;go for some more
X60$:`009popl r0`009`009`009`009`009;return the number of output bytes
X`009ret
X
Xnot_80:`009pushaq d_not_80
X`009calls #1,type_out
X`009bpt
X
X;;the single arg is addr of 6 bytes
X.entry decode_rec_length,`094m<r2,r3>
X`009movl 4(ap),r1`009`009`009`009;byte addr
X`009clrl r0`009`009`009`009`009;accumulated sum
X`009clrl r2`009`009`009`009`009;byte index
X10$:`009subb3 #`094a"0",(r1)[r2],r3`009`009;get byte as machine number
X`009movzbl r3,r3`009`009`009`009;extend to longword
X`009mull2 #10,r0`009`009`009`009;shift previous result
X`009addl2 r3,r0`009`009`009`009;add in this digit
X`009acbl #5,#1,r2,10$`009`009`009;loop for another
X`009ret
X
X;;4(ap) is number of bytes to put into output
X;;8(ap) is desc to input,`032
X;;12(ap) is desc to output
X.entry cvt_records,`094m<r2,r3,r4,r5>
X`009cmpl 4(ap),@12(ap)`009`009`009;does outout room reqd exceed room avbl?
X`009bleq 10$`009`009`009`009;br if ok
X`009pushl 4(ap)`009`009`009`009;get room needed
X`009calls #1,get_vm
X`009movl 12(ap),r1`009`009`009`009;addr of output desc
X`009movl r0,4(r1)`009`009`009`009;store new address there
X10$:`009movl 8(ap),r0`009`009`009`009;desc to input
X`009addl3 #6,4(r0),r3`009`009`009;input buf addr, skipping byte count
X`009movl 12(ap),r0`009`009`009`009;output desc addr
X`009movl 4(r0),r1`009`009`009`009;output buf addr
X`009ashl #3,4(ap),r5`009`009`009;number of bits
X`009decl r5`009`009`009`009`009;don't count that last fencepost
X`009clrl r4`009`009`009`009`009;bit number
X`009`009;r0 temp
X`009`009;r1 output buf addr
X`009`009;r3 input byte addr
X`009`009;r4 bit #
X`009`009;r5 last bit #
X;----here it is, fans, the inner loop
X30$:`009subb3 #`094a" ",(r3)+,r0`009`009`009;get byte, deasciiify
X`009insv r0,r4,#6,(r1)`009`009`009;store nibble
X`009acbl r5,#6,r4,30$`009`009`009;br for more
X;----end of inner loop
X`009ret
X
X.entry close_files,`094m<>
X`009$close fab=outfab
X`009  check close_out
X`009$close fab=infab
X`009  check close_in
X`009ret
X
X.entry report_stats,`094m<r2,r3>
X`009pushl out_rec_count
X`009pushl in_rec_count
X`009pushaq d_report
X`009calls #3,faotype
X`009ret
X
X;;read line into the buf desc in 4(ap), using prompt desc in 8(ap)
X;;return size of line read
X.entry read_prompt,`094m<r2>
X`009moval sysinrab,r2
X`009movq @4(ap),r0`009`009`009`009;length, addr of buffer
X`009movw r0,rab$w_usz(r2)`009`009`009;buffer size
X`009movl r1,rab$l_ubf(r2)`009`009`009;buffer address
X`009movq @8(ap),r0`009`009`009`009;length, addr of prompt
X`009movb r0,rab$b_psz(r2)`009`009`009;prompt size
X`009movl r1,rab$l_pbf(r2)`009`009`009;prompt address
X`009bisl2 #rab$m_pmt,rab$l_rop(r2)
X`009$get rab=(r2)
X`009  check get_read_prompt
X`009movzwl rab$w_rsz(r2),r0`009`009`009;return record size
X`009ret
X
X.entry faotype,`094m<r2,r3>
X`009movab -100(sp),sp`009`009`009;room for a buffer
X`009movab (sp),r2`009`009`009`009;addr of buffer
X`009movaq -(sp),r3`009`009`009`009;addr of desc `032
X`009movl #100,(r3)`009`009`009`009;length
X`009movab (r2),4(r3)`009`009`009;addr
X`009moval -(sp),r2`009`009`009`009;addr of return length
X`009$faol_s ctrstr=@4(ap),outlen=(r2),outbuf=(r3), prmlst=8(ap)
X`009  check faol_faotype
X`009movzwl (r2),(r3)`009`009`009;store length in desc
X`009pushaq (r3)
X`009calls #1,type_out`009`009`009;write it out
X`009ret
X
X.entry type_out,`094m<r2>
X`009moval sysoutrab,r2`009`009`009;address the rab
X`009movq @4(ap),r0`009`009`009`009;length, addr of line to type
X`009movw r0,rab$w_rsz(r2)`009`009`009;size
X`009movl r1,rab$l_rbf(r2)`009`009`009;addr
X`009$put rab=(r2)`009`009`009`009;write it out
X`009  check type_out
X`009ret
X
X.entry get_vm,`094m<r2>
X`009moval -(sp),r2`009`009`009`009;addr of longword to get address
X`009pushal (r2)`009`009`009`009;arg
X`009pushal 4(ap)`009`009`009`009;arg
X`009calls #2,g`094lib$get_vm
X`009  check get_vm
X`009movl (r2),r0`009`009`009`009;return the address
X`009ret
X
X.entry check_fn,`094m<>
X`009pushl 4(ap)
X`009calls #1,type_out
X`009pushl 8(ap)
X`009calls #1,g`094lib$signal
X`009ret
X
X.end asc_to_bin
$ GOSUB UNPACK_FILE
$ FILE_IS = "BIN2ASC.MAR"
$ CHECKSUM_IS = 422158082
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X;-*-Fundamental-*-
X.title BIN_TO_ASC Convert binary files to ascii
X
X;Each 6 bits of binary input record get represented in the ascii
X;output record as a char between %x20 and %x7F (space to underscore).
X
X;Each input record is represented in the output file by one or`032
X;more 80-byte output records.  The first output record for each
X;input record starts is prefixed by 6 decimal digits encoding the`032
X;input record length in bytes.
X
X
X.macro check text,?tag,?texttag
X.save_psect local_block
X.psect text_psect
Xzz'texttag:`009.ascid "text"
X.restore_psect
X
X`009blbs r0,tag
X`009  pushl r0
X`009  pushaq zz'texttag
X`009  calls #2,check_fn
Xtag:
X.endm check
X
X.psect text_psect,nowrt
X
Vd_not_seq:`009`009.ascid "Input file is not sequential, or has weird record typ
Xe."
Xd_in_name_prompt:`009.ascid "Input file name: "
Xd_out_name_prompt:`009.ascid "Output file name: "
Vd_report: `009`009.ascid "There were !SL input records, and !SL output records.
X"
Xd_6zl:`009`009`009.ascid "!6ZL"
X
Xd_in_name:`009.long 128
X`009`009.address in_name
Xd_out_name:`009.long 128
X`009`009.address out_name
X
X.psect data_psect,rd,wrt,long
X
Xsysinfab:`009$fab fnm=<SYS$INPUT>,fac=get
Xsysinrab:`009$rab fab=sysinfab
Xsysoutfab:`009$fab fnm=<SYS$OUTPUT>,fac=put,org=seq,rat=cr,rfm=var
Xsysoutrab:`009$rab fab=sysoutfab
X
Xinfab:`009$fab fac=get, fop=sqo
Xinrab:`009$rab fab=infab
X
Xoutfab:`009$fab org=seq, rfm=fix, mrs=80, rat=cr, fac=put, fop=sqo
Xoutrab:`009$rab fab=outfab
X
Xin_name:`009`009.blkb 128`009`009;name of the input file
Xout_name:`009.blkb 128`009`009`009;name of the output file
X
Xout_buffer:`009.blkl 1`009`009`009`009;address of the output buffer
Xout_records:`009.blkl 1`009`009`009`009;number of output records
X
Xin_rec_count:`009.blkl 1`009`009`009`009;input record count
Xout_rec_count:`009.blkl 1`009`009`009`009;output record count
X
X
X.psect code_psect,nowrt
X.entry bin_to_asc,`094m<r2,r3,r4,r5,r6>
X
X`009calls #0,open_sysinout
X`009clrl in_rec_count
X`009clrl out_rec_count
X`009calls #0,get_in_file
X`009calls #0,get_buffers
X`009calls #0,get_out_file
X`009calls #0,send_the_fab
X`009calls #0,copy_file
X`009calls #0,close_files
X`009calls #0,report_stats
X`009movl #ss$_normal,r0
X`009ret
X
X.entry open_sysinout,`094m<>
X`009$open fab=sysinfab
X`009  check open_sysin
X`009$connect rab=sysinrab
X`009  check connect_sysin
X`009$create fab=sysoutfab
X`009  check create_sysout
X`009$connect rab=sysoutrab
X`009  check connect_sysout
X`009ret
X
X
X.entry get_in_file,`094m<>
X`009pushaq d_in_name_prompt`009`009`009;prompt to use
X`009pushaq d_in_name`009`009`009;buf to read into
X`009calls #2,read_prompt`009`009`009;read the input filename into in_name
X`009movb r0,infab+fab$b_fns`009`009`009;store length of the name
X`009movab in_name,infab+fab$l_fna`009`009;store addr of name
X`009$open fab=infab`009`009`009`009;open the input file
X`009  check open_infile
X`009cmpb infab+fab$b_org,#fab$c_seq`009`009;is it a sequential file?
X`009  beql 10$
X`009  brw 50$
X10$:`009cmpb infab+fab$b_rfm,#fab$c_fix`009`009;is it fixed length records?
X`009  beql 20$
X`009cmpb infab+fab$b_rfm,#fab$c_var`009`009;or variable?
X`009  beql 20$
X`009  brw 50$`009`009`009`009;else can't hack it
X20$:`009$connect rab=inrab
X`009  check connect_infile
X`009ret
X
X50$:`009pushaq d_not_seq
X`009calls #1,type_out
X`009movl #rms$_iop,r0`009`009`009;just to create an error
X`009check not_seq_or_fix
X`009bpt
X
X.entry get_out_file,`094m<>
X`009pushaq d_out_name_prompt`009`009;prompt to use
X`009pushaq d_out_name`009`009`009;buf to read into
X`009calls #2,read_prompt`009`009`009;read the output filename into out_name
X`009movb r0,outfab+fab$b_fns`009`009;store length of name
X`009movab out_name,outfab+fab$l_fna`009`009;store addr of name
X`009$create fab=outfab`009`009`009;open the output file
X`009  check create_outfile
X`009$connect rab=outrab
X`009  check connect_outfile
X`009ret
X
X.entry get_buffers,`094m<r2,r3,r4,r5>`009`009;movc5 below clobbers all these
X;;get input buffer
X`009movzwl infab+fab$w_mrs,-(sp)`009`009;number of bytes
X`009bgtr 10$`009`009`009`009;skip unless zero?
X`009  movl #1024,(sp)`009`009`009;else pick some reasonable(?) default
X`009  movl #1024,infab+fab$w_mrs
X10$:`009calls #1,get_vm`009`009`009`009;get a buffer that big
X`009movl r0,inrab+rab$l_ubf`009`009`009;store it as input buffer
X`009movw infab+fab$w_mrs,inrab+rab$w_usz`009;store its length
X;;get output buffer.  Figure out how many 6-bit nibbles there are, consider
X;;them to be bytes, then figure out how many 80-byte records it takes to hold
X;;that many bytes, and allocate enough bytes to hold all those records.
X`009movzwl infab+fab$w_mrs,r0`009`009;size of input record in bytes
X`009ashl #3,r0,r0`009`009`009`009;size of input record in bits
X`009addl2 #6-1,r0`009`009`009`009;rounding for division by 6
X`009divl2 #6,r0`009`009`009`009;number of 6-bit nibbles we want
X`009addl2 #6,r0`009`009`009`009;room for record length prefix
X`009addl2 #80-1,r0`009`009`009`009;rounding for division by 80
X`009divl2 #80,r0`009`009`009`009;number of 80-byte records
X`009movl r0,out_records`009`009`009;store that for future reference
X`009mull2 #80,r0`009`009`009`009;number of bytes in those records
X`009pushl r0`009`009`009`009;save
X`009pushl r0`009`009`009`009;argument
X`009calls #1,get_vm`009`009`009`009;get the buffer
X`009movl r0,out_buffer`009`009`009;store its address
X;;fill last 80 bytes with spaces to make the last record look nice
X`009addl2 (sp)+,r0`009`009`009`009;addr of byte beyond buffer
X`009movc5 #0,(sp),-`009`009`009`009;source operand
X`009      #`094a" ",-`009`009`009`009;fill with space
X`009      #80,-80(r0)`009`009`009;destination operand
X`009ret
X
X.entry send_the_fab,`094m<>
X`009pushal infab`009`009`009`009;fab address
X`009pushl #fab$c_bln`009`009`009;fab length
X`009calls #2,send_record
X`009ret
X
X.entry copy_file,`094m<>
X10$: `009$get rab=inrab`009`009`009`009;try to get an input record
X`009blbs r0,20$`009`009`009`009;br if ok
X`009  brw 50$
X20$:`009incl in_rec_count
X`009pushl inrab+rab$l_rbf`009`009`009;address
X`009movzwl inrab+rab$w_rsz,-(sp)`009`009;length
X`009calls #2,send_record
X`009brw 10$
X50$:`009cmpl r0,#rms$_eof`009`009`009;end of file?
X`009bneq 60$
X`009  ret
X60$:`009check get_copy_file
X`009bpt
X
X.entry send_record,`094m<r2,r3,r4,r5>
X;;First 6 chars are record length
X`009movaq -(sp),r0`009`009`009`009;addr of desc
X`009movl #6,(r0)`009`009`009`009;length
X`009movl out_buffer,4(r0)`009`009`009;addr
X`009$fao_s ctrstr=d_6zl,outbuf=(r0),p1=4(ap)
X`009  check fao_send_record
X`009movl 8(ap),r2`009`009`009`009;addr
X`009movl 4(ap),r3`009`009`009`009;length in bytes
X`009ashl #3,r3,r3`009`009`009`009;length in bits
X`009decl r3`009`009`009`009`009;don't count the last fencepost
X`009clrl r4`009`009`009`009`009;input bit number
V`009addl3 #6,out_buffer,r5`009`009`009;output byte address, incl leading 6 bute
Xs
X;----here it is, fans, the inner loop
X30$:`009extzv r4,#6,(r2),r0`009`009`009;get 6 bits
X`009addb3 #`094a" ",r0,(r5)+`009`009`009;store their conversion to ascii
X`009acbl r3,#6,r4,30$`009`009`009;incr bit number and branch
X;----end of inner loop
X`009subl3 out_buffer,r5,r0`009`009`009;number of bytes written
X`009clrl r1`009`009`009`009`009;high order longword for ediv
X`009ediv #80,r0,r0,r1`009`009`009;r1 is # of bytes put in last 80-byte record
X`009tstl r1`009`009`009`009`009;were there any?
X`009beql 40$`009`009`009`009;br if none
X`009  subl3 r1,#80,r1`009`009`009;else get # of bytes to fill
X`009  movc5 #0,(sp),#`094a" ",r1,(r5)`009`009;pad them with spaces.
X`009  movl r3,r5`009`009`009`009;r5 gets 1+ last byte addr
X40$:`009decl r5`009`009`009`009`009;don't count that last fencepost
X`009;;r5 has addr of last byte to be written
X`009movl out_buffer,outrab+rab$l_rbf`009;addr of buffer piece to write
X`009movw #80,outrab+rab$w_rsz
X60$:`009$put rab=outrab
X`009  check put_copy_file
X`009incl out_rec_count
X`009acbl r5,#80,outrab+rab$l_rbf,60$`009;incr to next output record
X`009ret
X
X.entry close_files,`094m<>
X`009$close fab=outfab
X`009  check close_out
X`009$close fab=infab
X`009  check close_in
X`009ret
X
X.entry report_stats,`094m<r2,r3>
X`009pushl out_rec_count
X`009pushl in_rec_count
X`009pushaq d_report
X`009calls #3,faotype
X`009ret
X
X;;read line into the buf desc in 4(ap), using prompt desc in 8(ap)
X;;return size of line read
X.entry read_prompt,`094m<r2>
X`009moval sysinrab,r2
X`009movq @4(ap),r0`009`009`009`009;length, addr of buffer
X`009movw r0,rab$w_usz(r2)`009`009`009;buffer size
X`009movl r1,rab$l_ubf(r2)`009`009`009;buffer address
X`009movq @8(ap),r0`009`009`009`009;length, addr of prompt
X`009movb r0,rab$b_psz(r2)`009`009`009;prompt size
X`009movl r1,rab$l_pbf(r2)`009`009`009;prompt address
X`009bisl2 #rab$m_pmt,rab$l_rop(r2)
X`009$get rab=(r2)
X`009  check get_read_prompt
X`009movzwl rab$w_rsz(r2),r0`009`009`009;return record size
X`009ret
X
X.entry faotype,`094m<r2,r3>
X`009movab -100(sp),sp`009`009`009;room for a buffer
X`009movab (sp),r2`009`009`009`009;addr of buffer
X`009movaq -(sp),r3`009`009`009`009;addr of desc `032
X`009movl #100,(r3)`009`009`009`009;length
X`009movab (r2),4(r3)`009`009`009;addr
X`009moval -(sp),r2`009`009`009`009;addr of return length
X`009$faol_s ctrstr=@4(ap),outlen=(r2),outbuf=(r3), prmlst=8(ap)
X`009  check faol_faotype
X`009movzwl (r2),(r3)`009`009`009;store length in desc
X`009pushaq (r3)
X`009calls #1,type_out`009`009`009;write it out
X`009ret
X
X.entry type_out,`094m<r2>
X`009moval sysoutrab,r2`009`009`009;address the rab
X`009movq @4(ap),r0`009`009`009`009;length, addr of line to type
X`009movw r0,rab$w_rsz(r2)`009`009`009;size
X`009movl r1,rab$l_rbf(r2)`009`009`009;addr
X`009$put rab=(r2)`009`009`009`009;write it out
X`009  check type_out
X`009ret
X
X.entry get_vm,`094m<r2>
X`009moval -(sp),r2`009`009`009`009;addr of longword to get address
X`009pushal (r2)`009`009`009`009;arg
X`009pushal 4(ap)`009`009`009`009;arg
X`009calls #2,g`094lib$get_vm
X`009  check get_vm
X`009movl (r2),r0`009`009`009`009;return the address
X`009ret
X
X.entry check_fn,`094m<>
X`009pushl 4(ap)
X`009calls #1,type_out
X`009pushl 8(ap)
X`009calls #1,g`094lib$signal
X`009ret
X
X.end bin_to_asc
$ GOSUB UNPACK_FILE
$ EXIT