.TITLE	HEXIFY
	.SBTTL	Stuart Hecht

	.LIBRARY /SYS$LIBRARY:STARLET/
	.LIBRARY /SYS$LIBRARY:LIB/

	.IDENT	/1.0.00/

;++
;This will take a task file and turn it into hexidecimal strings
;--

	.EXTRN	LIB$GET_INPUT
	.EXTRN	LIB$PUT_SCREEN
	.MCALL	$FAB			; RMS calls
	.MCALL	$RAB
	.MCALL	$CLOSE
	.MCALL	$CONNECT
	.MCALL	$CREATE
	.MCALL	$DISCONNECT
	.MCALL	$READ
	.MCALL	$OPEN
	.MCALL	$PUT
	.MCALL	$RAB_STORE
	.MCALL	$FAB_STORE

	.SBTTL	Definitions of symbols

DWRLUN	=1				; Disk read LUN
DWWLUN	=5				; Disk write LUN
KNORMAL	=0				; No error
EOF	=-1				; End of file error code
LEFTBYTE=^O377*^O400			; All one in left byte
HEXOFFSET=7				; Offset to get to 'A from '9+1
CR	=13.				; Carriage return
LF	=10.				; Line feed
; Packet types currently created
PKDATA	=0				; Data packet code
PKRFM	=255.				; Record format
PKRAT	=254.				; Record attributes
PKMRS	=253.				; Maximum record size
PKALQ	=252.				; File length(blocks)
PKFILNM	=251.				; File name
PKEOF	=250.				; End of file


	.SBTTL	Data

	.PSECT	$PLIT$,LONG
M$FILN:	.BYTE	CR,LF,LF
	.ASCII	'Input file name: '
L$FILN	=.-M$FILN

M$OFLN:	.BYTE	CR,LF,LF
	.ASCII	'Output file name (or return for the default): '
L$OFLN	=.-M$OFLN

M$NEXF:	.BYTE	CR,LF,LF
	.ASCII	'Press return to finish or type the name of another file'
	.BYTE	CR,LF
	.ASCII	'to append to the HEX file: '
L$NEXF	=.-M$NEXF

M$RMS:	.BYTE	CR,LF,LF
	.ASCII	'RMS ERROR'
L$RMS	=.-M$RMS
	.EVEN

	.SBTTL	RMS Data

DEFALT:	.ASCIZ	'SYS$DISK:'		; System default.
DEFALN	=.-DEFALT			; Size of the default device.
	.EVEN


	.SBTTL	Storage locations

	.PSECT	$OWN$,LONG
	.ALIGN	LONG

MSGDSC:	.BLKW	1			; Data block for terminal output
	.BYTE	DSC$K_DTYPE_T
	.BYTE	DSC$K_CLASS_S
ADDR:	.ADDRESS ADDR

INP_STR_D:				; Key string desciptor
	 .BLKL	1
INP_BUF: .ADDRESS ADDR

INP_STR_LEN:				; Key string length
	.BLKL	1


BUCOUNT: .BLKL	1			; Number of character available in the
					;   buffer (returned from RMS)
RDCOUNT: .BLKL	1			; Number of characters read from buffer
WTCOUNT: .BLKL	1			; Number of characters written
CHCOUNT: .BLKL	1			; Number of characters written to buff.
NULCOUNT: .BLKL	1			; Number of nulls not yet written

CHKSUM:	.BLKL	1			; Checksum for the line
ADDRESS: .BLKL	1			; Current address

INP.N:	.BLKB	28.			; Space for input file name
INP.L	=.-INP.N			; Length of input file name
OUT.N:	.BLKB	28.			; Space for output file name
OUT.L	=.-OUT.N			; Length of input file name

RDBUF:	.BLKB	512.			; Disk read buffer
WTBUF:	.BLKB	512.			; Disk write buffer
	.EVEN



	.SBTTL	RMS Data structures
	.ALIGN LONG
RDFAB::	$FAB	DNA=DEFALT,DNS=DEFALN,FNA=INP.N,FNS=INP.L,LCH=DWRLUN,FAC=<GET,BIO>,SHR=GET

	.ALIGN LONG
RDRAB::	$RAB	FAB=RDFAB,RAC=SEQ
					; Beginning of RAB block.


	.ALIGN LONG
WTFAB::	$FAB	DNA=DEFALT,DNS=DEFALN,FNA=OUT.N,FNS=OUT.L,LCH=DWWLUN,FAC=PUT,SHR=NIL,ORG=SEQ,RAT=CR,RFM=VAR

	.ALIGN LONG
WTRAB::	$RAB	FAB=WTFAB,RAC=SEQ
					; Beginning of RAB block.


	.SBTTL	Main line code

	.PSECT	$CODE$,LONG,EXE

	.ALIGN LONG
HEXIFY:: .WORD	^M<>			; For CALLS that is used from operating system
NOINP:
	MOVAB	M$FILN,R11		; Get the input prompt address
	MOVL	#L$FILN,R12
	MOVAB	INP.N,R10		; Get address of input and length
	MOVL	#INP.L,R1		;
	JSB	READ			; Read the input file name
	TSTL	R0			; See if we got anything
	BEQL	NOINP			; If no input then try again
	MOVL	R0,R5			; Save length

	MOVAB	M$OFLN,R11		; Get the address of the prompt
	MOVL	#L$OFLN,R12
	MOVAB	OUT.N,R10		; Get address of output file name
	MOVL	#OUT.L,R1		;  and length
	JSB	READ			; Read the output file name
	MOVL	R0,R3			; Save length
	TSTL	R3			; See if we got any input
	BNEQ	GOTFIL			; Yes so branch

; Here so use the default output file name
	MOVL	R5,R0			; Get the input file length back
	MOVAB	INP.N,R2		; Get input address
	MOVAB	OUT.N,R3		; Point at buffer
	CLRL	R1			; Clear the character count
2$:	CMPB	(R2),#^A/./		; Check for an extension
	BEQL	10$			; If an extension then ignore rest
					;   of line
	MOVB	(R2)+,(R3)+		; Move into the output file name
	INCW	R1			; Increment counter
	SOBGTR	R0,2$			; Branch until done

10$:	MOVB	#^A/./,(R3)+		; Write the extension for output file
	MOVB	#^A/H/,(R3)+		;
	MOVB	#^A/E/,(R3)+		;
	MOVB	#^A/X/,(R3)+		;
	ADDW3	#4,R1,R3		; Get final character count

;++
;Open files
;--
GOTFIL:
;Create output file
	MOVAL	WTFAB,R1		; Put address of FAB into R1.
	$FAB_STORE FAB=R1,FNS=R3	; Tell RMS file name length
	
	$CREATE	#WTFAB			; Create the file
	JSB	RMSERR			; Check for file error
	MOVAL	WTRAB,R1		; Put address of RAB into R1.
	$RAB_STORE RAB=R1,UBF=WTBUF,RBF=WTBUF,USZ=#512.,RSZ=#512.
					; Put address of user buffer in RAB.
	$CONNECT #WTRAB			; Connect to record.
	JSB	RMSERR			; Check for file error
;Open input file
AGAINSAM:
	MOVAL	RDFAB,R1		; Put address of FAB into R1.
	$FAB_STORE FAB=R1,FNS=R5	; Tell RMS file name length
	$OPEN	#RDFAB			; Open the file
	JSB	RMSERR			; Check for file error
	MOVAL	RDRAB,R1		; Put address of RAB into R1.
	$RAB_STORE RAB=R1,UBF=RDBUF,RBF=RDBUF,USZ=#512.,RSZ=#512.
	$CONNECT #RDRAB			; Connect to record.
	JSB	RMSERR			; Check for file error


;++
;Do the actual work
;--
	MOVZWL	#512.,RDCOUNT		; Initialize buffer pointers
	MOVZWL	#512.,BUCOUNT		;
	CLRL	WTCOUNT			;
	CLRL	ADDRESS			; Initialize the address
	CLRL	NULCOUNT		; Initialize the number of nulls
	MOVAL	RDFAB,R5		; Get the FAB address
;Get the Record format (FIX, VAR, ...)
	MOVZBL	#PKRFM,R10		; Set packet type to record format
	JSB	HEADER			; Output the header

	MOVZBL	FAB$B_RFM(R5),R10
	JSB	CVTH			; Put the record format code into buff
	INCL	CHCOUNT			; Increment counter
	JSB	PUTLIN			; Write the line out
;Get the record type (CR, ...)
	MOVZBL	#PKRAT,R10		; Set packet type to record type
	JSB	HEADER			; Output the header
	MOVZBL	FAB$B_RAT(R5),R10
	JSB	CVTH			; Put the record type into buffer
	INCL	CHCOUNT			; Increment counter
	JSB	PUTLIN			; Write the line out
;Get the maximum record size (512. for tasks)
	MOVZBL	#PKMRS,R10		; Set packet type to max record size
	JSB	HEADER			; Output the header
	MOVZWL	FAB$W_MRS(R5),R10
	PUSHL	R10			; Save for low order
	EXTZV	#8.,#8.,R10,R10		; Get high order byte
	JSB	CVTH			; Put the record size into buffer
	INCL	CHCOUNT			; Increment counter
	POPL	R10			; Get size back
	JSB	CVTH			; Put the record size into buffer
	INCL	CHCOUNT			; Increment counter
	JSB	PUTLIN			; Write the line out
;Get the file length (in blocks)
	MOVZWL	#PKALQ,R10		; Set packet type to file length
	JSB	HEADER			; Output the header
	MOVL	FAB$L_ALQ(R5),R10
	PUSHL	R10			; Save for low order
	EXTZV	#8.,#8.,R10,R10		; Get high order byte
	JSB	CVTH			; Put the allocation into buffer
	INCL	CHCOUNT			; Increment counter
	POPL	R10			; Get allocation back
	JSB	CVTH			; Put the low order into the buffer
	INCL	CHCOUNT			; Increment counter
	JSB	PUTLIN			; Write the line out
;Get the file name
	MOVZBL	#PKFILNM,R10		; Set packet type to file name
	JSB	HEADER			; Output the header
	MOVZBL	FAB$B_FNS(R5),R4
	MOVAB	INP.N,R3		; Get the input file name address
25$:	MOVZBL	(R3)+,R10		; Get the next character
	JSB	CVTH			; Buffer the next character of the name
	INCL	CHCOUNT			; Increment counter
	SOBGTR	R4,25$			; Repeat until all done
	JSB	PUTLIN			; Write the line out


;++
; Start moving real data
;--
NEXLIN:
	JSB	GET			; Get a character from the buffer
	CMPL	R10,#EOF		; Check for end of file
	BEQL	FINISH			; If at end the finish up
	TSTL	R10			; Check for null character
	BNEQ	DOLIN			; Not null so just do regular stuff
	INCL	ADDRESS			; Point to next location
	BRB	NEXLIN			;  save space and try again
DOLIN:	PUSHL	R10			; Save the character we have
	MOVZWL	#PKDATA,R10		; Set packet type to plain old data
	JSB	HEADER			; Put the standard header into buffer

	POPL	R10			; Get the original character back
LINAGA:	JSB	CVTHEX			; Convert the character to hex codes
	INCL	ADDRESS			; Point to next location
	INCL	CHCOUNT			; Increment the character count
	CMPL	CHCOUNT,#^O36		; Check to see if we should finish
	BNEQ	LINMOR			;  this line
	JSB	PUTLIN			; Put the whole line to disk
	BRW	NEXLIN			; Go do the next line

LINMOR:	JSB	GET			; Get the next character
	CMPL	R10,#EOF		; Is it an end of file?
	BNEQ	LINAGA			; No, then just handle normally
;	JSB	PUTLIN			; Yes, write the current line
	DECL	ADDRESS			; Reset address to correct value
	BRW	FIN1			; Finish up


	.SBTTL	Finish up

;++
;Finish up
;--
FINISH:
	MOVZBL	#PKDATA,R10		; Set packet type to plain old data
	JSB	HEADER			; Insert the header so the extra
					;  nulls are seen
FIN1:	TSTL	NULCOUNT		; See if no nulls left
	BEQL	FIN			; If none then branch
	CLRL	R10			; Get a null
	DECL	NULCOUNT		; Decrement the counter
	JSB	CVTH			; Convert to HEX (w/o null compression)
FIN:	JSB	PUTLIN			; Put the current buffer to disk
; Write out the end of task file line
	CLRL	CHCOUNT			; Clear character count
	MOVZBL	#PKEOF,R10		; Get end of task file packet type
	JSB	HEADER			; Make the header
	JSB	PUTLIN			; Write the line
; Close the input (task) file
	MOVAL	RDFAB,R1		; Get the FAB for input file
	$CLOSE	R1			; Close input file
	JSB	RMSERR			; Check for file error
; See about another file to append
	MOVAB	M$NEXF,R11		; See if another file should be
	MOVL	#L$NEXF,R12		;   appended to the HEX file
	MOVAB	INP.N,R10		;
	MOVL	#INP.L,R1		; Get address of input and length
	JSB	READ			; Read the input file name
	TSTL	R0			; See if we got anything
	BEQL	LEAVE			; If no input then leave
	MOVL	R0,R5			; Put the length in R5 for the open
	JMP	AGAINSAM		; Repeat process for this file
; Write out end of hex file line		
LEAVE:	CLRL	CHKSUM			; Clear the checksum for this line
	CLRL	CHCOUNT			; Clear character count
	MOVZBL	#^A/:/,R10		; Get the start character
	JSB	BUFFER			; Put it into the buffer
	MOVZBL	#8.,R5			; Get the number of nulls needed
FINREP:	MOVZBL	#^A/0/,R10		; Set the character to 'null'
	JSB	BUFFER			; Put it into the buffer
	SOBGTR	R5,FINREP		; Repeat if not done
	JSB	PUTLIN			; Write the buffer to disk
; Close the HEX file
	MOVAL	WTFAB,R1		; Get FAB for output file
	$CLOSE	R1			; Close output file
	JSB	RMSERR			; Check for file error

END:	
	MOVL	#SS$_NORMAL,R0		; Set up successful completion
	RET				; Exit program

	.SBTTL	Put a data line
;++
;Finish a line up by inserting the length and the checksum and doing a PUT
;--

PUTLIN:
	MOVL	CHCOUNT,R10		; Get the actual character count
	SUBL2	NULCOUNT,R10		; Don't include the nulls since we
					;  won't write them
	CLRL	NULCOUNT		; Clear the null count since the
					;  address will serve to insert nulls
	PUSHL	WTCOUNT			; Save it on the stack
	MOVZBL	#1,WTCOUNT		; Move a one into the char count to get
	JSB	CVTH			;  to the length and then put length in
	POPL	WTCOUNT			; Restore the correct count

	MNEGL	CHKSUM,R10		; Negate it
	JSB	CVTH			; Put the negative checksum into buffer

	JSB	PUT			; Put the line to disk
	RSB				; Return to sender


	.SBTTL	Create the header for the data line
;++
;This routine will put the starting stuff into the buffer
;R10 contains the record type
;--

HEADER:	CLRL	CHKSUM			; Clear the checksum for this line
	CLRL	CHCOUNT			; Clear character count
	PUSHL	R10			; Save the record type
	MOVZBL	#^A/:/,R10		; Move a colon into first char position
	JSB	BUFFER			;   of the buffer
	CLRL	R10			; Move a fake length into the buffer
	JSB	CVTH			;
	MOVZBL	ADDRESS+1,R10		; Get the high order word of the
	JSB	CVTH			;  address and put into the buffer
	MOVZBL	ADDRESS,R10		; Get low order word of address and
	JSB	CVTH			;  buffer it
	POPL	R10			; Get the line record type
	JSB	CVTH			;  and buffer the code
	RSB				; Return to sender

	.SBTTL	Output and input to/from terminal
;++
; Write data to terminal.
;	R10	Address of data to output
;	R1	Length of data
;--
WRITE:
	MOVW	R1,MSGDSC		; Store the length in the descript blk
	MOVL	R10,ADDR		; Store the address of the ASCII
	PUSHAQ	MSGDSC			; Push the descriptor block address
	CALLS	#1,G^LIB$PUT_OUTPUT	; Do the output
	RSB				; Return to sender

;++
; Read from the terminal
;	R10	Address of buffer
;	R1	Number of characters to read
;	R11	Input prompt address
;	R12	Length of prompt
;
;Returned:
;	R0	Number of characters read
;--
READ:
	MOVL	R1,INP_STR_D		; Store the buffer length in desc block
	MOVL	R10,INP_BUF		; Store the buffer address in desc blk
	MOVL	R11,ADDR		; Store prompt address in desc block
	MOVW	R12,MSGDSC		; Store length in desctriptor block
	PUSHAB	INP_STR_LEN		; Address for string length
	PUSHAQ	MSGDSC			; Push address of prompt descriptor blk
	PUSHAB	INP_STR_D		; String buffer descriptor
	CALLS	#3,G^LIB$GET_INPUT	; Get input string value
	MOVL	INP_STR_LEN,R0		; Get actual input length back
	RSB				; Return to sender


	.SBTTL	RMS error routine
;++
;Check for RMS error
;--
RMSERR:
	BLBC	R0,60$			; If error, go check it out
	MOVL	#KNORMAL,R0		; Set up a successful return code.
	RSB				; Return to caller

; Here if there is an error
60$:	CMPL	#RMS$_EOF,R0		; Check for EOF
	BNEQ	70$			; If not then branch
	MOVL	#EOF,R0			; Tell sender we have end of file
	RSB				; Return

; Here if there is an RMS error we don't know how to handle
70$:	PUSHL	R0			; Save the error code
	MOVAB	M$RMS,R10		; Get the address and length of the
	MOVL	#L$RMS,R1		;   message to output
	JSB	WRITE			; Output it
	POPL	R0			; Get the error code back
	RET				; Exit program


	.SBTTL	Get a character from the file
;++
;Get a character from the input file.
;
;	Returned:
;		R10	Contains the character if not at end of file
;			Contains #EOF if at end of file
;--

GET:	MOVL	RDCOUNT,R10		; Get the offset into the buffer
	CMPL	R10,BUCOUNT		; Check to see if we are past the end
	BNEQ	10$			; If not then branch
	MOVAL	RDRAB,R1		; Get the RAB address
	$RAB_STORE RAB=R1,UBF=RDBUF,USZ=#512.
	$READ	R1			; Get the next buffer of data.
	JSB	RMSERR			; Check for file error
	CMPL	R0,#EOF			; Check for end of file error
	BNEQ	5$			; If not then branch
	MOVL	R0,R10			; Move the status to the correct spot
	RSB				; Return with error code
5$:
	MOVZWL	RAB$W_RSZ+RDRAB,R10
	MOVL	R10,BUCOUNT		; Save the record size
	CLRL	R10			; Clear the pointer
	CLRL	RDCOUNT			; . . . 
10$:	MOVZBL	RDBUF(R10),R10		; Get the next character
	INCL	RDCOUNT			; Increment the offset into the buffer
	RSB				; Return to sender

	.SBTTL	Buffer a character of the data line
;++
; Buffer the character in R10
;--

BUFFER:	PUSHL	R10			; Save the character on the stack
	MOVL	WTCOUNT,R10		; Get the offset into the buffer
	CMPL	#512.,R10		; Get too big?
	BGTR	BUFOK
	NOP
BUFOK:	MOVB	(SP),WTBUF(R10)		; Move the character to the buffer
	TSTL	(SP)+			; Remove the junk
	INCL	WTCOUNT			; Increment the pointer
BUFRTS:	RSB				; Return to sender


	.SBTTL	Put a record to the file
;++
;Write the record
;--

PUT:
	MOVL	WTCOUNT,R10		; Get the count
	MOVAL	WTRAB,R1		; Get the RAB address
	$RAB_STORE RAB=R1,RSZ=R10
	$PUT	R1			; Output the record
	JSB	RMSERR			; Check for file error
	CLRL	WTCOUNT			; Clear the counter for next record
	RSB				; Return


	.SBTTL	Convert to Hexadecimal ASCII digits
;++
; Convert a word to 2 ASCII hexadecimal digits
;--

CVTHEX:
	TSTL	R10			; See if this is a null
	BNEQ	CVTH			; If not then just branch
	INCL	NULCOUNT		; A null so just increment the count
	RSB				;  for later and leave

; Convert a word to 2 ASCII hexadecimal digits without null compression
CVTH:	PUSHL	R10			; Save the character on the stack
10$:	TSTL	NULCOUNT		; Check to see if there are nulls
	BEQL	20$			; If not then just branch
	CLRL	R10			; Put a null in R10
	JSB	CVT1			; Put the null in the buffer
	DECL	NULCOUNT		; Decrement null counter
	BRB	10$			; Repeat
20$:	POPL	R10			; Get the original value back

CVT1:	ADDL2	R10,CHKSUM		; Add the value to the checksum
	MOVL	R10,R1			; Save the value
	EXTZV	#4,#4,R10,R10		; Get high order digit
	JSB	HEX			;   in place and convert to Hex
	JSB	BUFFER			; Buffer the Hex character
	EXTZV	#0,#4,R1,R10		; Get right digit
	JSB	HEX			; Convert to Hex
	JSB	BUFFER			; Buffer the Hex character
	RSB				; Return to sender

HEX:	MOVL	R10,R2			; Move the base to R2 
	CMPL	R2,#9.			; Check to see if above '9
	BLEQ	1$			; If not then branch
	ADDL2	#HEXOFFSET,R10		; Add offset to alphabet
1$:	ADDL2	#48.,R10		; Make ASCII
	RSB				; Return to sender


	.SBTTL	End of Hexify

	.END	HEXIFY