Google
 

Trailing-Edge - PDP-10 Archives - tops20tools_v6_9-jan-86_dumper - tools/hexify/vmsdeh.mar
There are 3 other files named vmsdeh.mar in the archive. Click here to see a list.
	.TITLE	DEHEX
	.SBTTL	Stuart Hecht

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


;++
;This will take a set hexidecimal strings created by the hexify program and 
;  recreate the source file(s).
;--

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

DWRLUN	=1				; Disk read LUN
DWWLUN	=5				; Disk write LUN
TRUE	=1				; True
FALSE	=0				; False
KNORMAL	=0				; No error
LEFTBYTE=^O377*^O400			; All ones in left byte
HEXOFFSET=7				; Offset to get to 'A from '9+1
CR	=13.				; Carriage return
LF	=10.				; Line feed
MAX.MSG	=256.				; Maximum number of chars from XK
RCV.SOH	=^A/:/				; Receive start of packet
RCV.EOL	=13.				; End of line character
MSB	=128.				; Most significant bit
; Packet types currently supported
PKDATA	=00				; 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 task file
;
	.SBTTL	RMS Data

	.PSECT	$PLIT$,LONG

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


M$FILE:	.BYTE	CR,LF
	.ASCII	'Please type the file name: '
L$FILE=	.-M$FILE

M$CRLF:	.BYTE	CR,LF			; Data for carriage return/line feed
L$CRLF	=.-M$CRLF

;M$AK:
;	.ASCII	'Y'			; Data for aknowledged

M$NAK:
	.ASCII	'N'			; Data for not aknowledged

M$UN:
	.ASCII	'U'			; Data for unrecognized code

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

M$REC:	.BYTE	CR,LF,LF
	.ASCII	'RECEIVE ERROR - Try again.'
L$REC	=.-M$REC
	.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

WTCOUNT: .BLKL	1			; Number of characters written
LENGTH:	.BLKL	1			; Length of data portion of packet
OPENFL:	.BLKL	1			; Tells us if the file is open

CHKSUM:	.BLKL	1			; Checksum for the line
ADDRESS: .BLKL	1			; Current address
ALQLOC:	.BLKW	2			; Storage for allocation

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

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

	.EVEN				; Need to start RDBUF on even boundary
RDBUF:	.BLKB	MAX.MSG			; XK read buffer
	.EVEN
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,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

WTRAB::	$RAB	FAB=WTFAB,RAC=SEQ
					; Beginning of RAB block.
	.SBTTL	Start of program

	.PSECT	$CODE$,LONG,EXE

DEHEX::	.WORD	^M<>
FILE:	MOVAB	M$FILE,R11		; Output the get file name message
	MOVZBL	#L$FILE,R12
	MOVAB	INP.N,R10		; Get the file name
	MOVZBL	#INP.L,R1
	JSB	READ
	TSTL	R0			; Check for no input
	BEQL	FILE			; Go back and get some
;Open the file
	MOVAL	RDFAB,R1		; Put address of FAB into R1.
	$FAB_STORE FAB=R1,FNS=R0	; 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.
; Put address of user buffer and size and record buffer and size in RAB.
	$RAB_STORE RAB=R1,UBF=RDBUF,RBF=RDBUF,USZ=#MAX.MSG,RSZ=#MAX.MSG
	$CONNECT #RDRAB			; Connect to record.
	JSB	RMSERR			; Check for file error
	.SBTTL	Do the real work
;++
; Do the actual work
;--
BEGIN:	MOVAL	M$CRLF,R10		; Get a return/linefeed and output them
	MOVZBL	#L$CRLF,R1
	JSB	WRITE

20$:	CLRL	WTCOUNT			; Initialize the pointer
	CLRL	ADDRESS			; Initialize the address
	CLRL	OPENFL			; Set the file to not open
	.SBTTL	Main loop

; Main loop to get data
DOLIN:
	CLRL	CHKSUM			; Clear the checksum
	JSB	RECEIVE			; Get the line
	JSB	CVTBIN			; Convert it to a real number
	MOVL	R10,LENGTH		; Save the length
	JSB	CVTBIN			; 
	MOVL	R10,R3			; Save high order of address
	ASHL	#8.,R3,R3		; Shift to correct spot
	JSB	CVTBIN			; 
	BISL	R10,R3			; Fill in the low order of address
	JSB	CVTBIN			; 

	CMPL	#PKDATA,R10		; Check to see if this is regular data
	BNEQ	NOTDAT			; If not then check the special cases
; Check for end of hex file
	TSTL	R3			; Check to see if the address is all
	BNEQ	DATST			;  zero, if not then branch
	TSTL	LENGTH			; Check to see if the length is zero
	BNEQ	DATST			;  also, if not then branch
	JMP	FINISH			; Must be end of hex file so finish up
; Regular data to put into the file
DATST:	TSTL	OPENFL			; Check to see if the file is open yet
	BNEQ	DAT1			; If it is then skip the open
	JSB	OPEN			; Open the file
DAT1:	CMPL	R3,ADDRESS		; Check for null compression
	BEQL	10$			; If none compressed then continue past
	CLRL	R10			; Make a null
	JSB	PUT			;  and put it into the file
	INCL	ADDRESS			; Point to next address
	BRW	DATST			; Go see if there are any more nulls
; Go to work on the HEX we got on the line
10$:	MOVL	LENGTH,R2		; Get the length
	TSTL	R2			; See if there is any data
	BEQL	30$			; If not then branch
25$:	JSB	CVTBIN			; Convert it
	JSB	PUT			; Put the character in the file
	INCL	ADDRESS			; Increment the address
	SOBGTR	R2,25$			; Repeat until all done
30$:	BRW	LINDON			; Go finish this line

NOTDAT:	MOVAL	WTFAB,R5		; Get the FAB address
	CMPL	#PKRFM,R10		; Check to see if this is record fmt
	BNEQ	NOTRFM			; If not then don't do this stuff
; Store the Record format (FIX, VAR, ...)
	JSB	CVTBIN			;
	$FAB_STORE FAB=R5,RFM=R10	; Store the record format
	BRW	LINDON			; Go finish this line

NOTRFM:	CMPL	#PKRAT,R10		; Check to see if this is record type
	BNEQ	NOTRAT			; If not then branch
; Store the record type (CR, ...)
	JSB	CVTBIN			;
	$FAB_STORE FAB=R5,RAT=R10	; Store the record type
	BRW	LINDON			; Go finish this line

NOTRAT:	CMPL	#PKMRS,R10		; Check to see if this is max record
	BNEQ	NOTMRS			;  size, branch if not
; Get the maximum record size (512. for tasks)
	JSB	CVTBIN			; Convert high order byte
	MOVL	R10,R3			; Save it
	ASHL	#8.,R3,R3		; Shift it to the high order byte
	JSB	CVTBIN			; Convert low order byte
	BISL	R10,R3			; Put low order word into R3 also
	$FAB_STORE FAB=R5,MRS=R3	; Store the maximum record size
	BRW	LINDON			; Go finish this line

NOTMRS:	CMPL	#PKALQ,R10		; Check to see if this is allocation
	BNEQ	NOTALQ			; If not then branch
; Get the file length (in blocks)
	JSB	CVTBIN			; Convert high order byte
	MOVL	R10,R3			; Save it
	ASHL	#8.,R3,R3		; Shift it to the high order byte
	JSB	CVTBIN			; Convert low order byte
	BISL	R10,R3			; Put low order word into R3 also
	MOVW	R3,ALQLOC		; Save it
	CLRW 	ALQLOC+2		; clear out high word
	$FAB_STORE FAB=R5,ALQ=ALQLOC	; Store the allocation
	BRW	LINDON			; Go finish this line

NOTALQ:	CMPL	#PKFILNM,R10		; Check to see if this is file name
	BNEQ	NOTFILNM		; If not then branch
; Get the file name
	MOVL	LENGTH,R2		; Get the length
	$FAB_STORE FAB=R5,FNS=R2	; Store the file name length
	MOVAB	OUT.N,R3		; Get the output file name address
25$:	JSB	CVTBIN			; Convert next character of the name
	MOVB	R10,(R3)+		; Save the character
	SOBGTR	R2,25$			; Repeat until all done
	MOVAB	M$CRLF,R10		;
	MOVZBL	#L$CRLF,R1		;
	JSB	WRITE			; Output a return/line feed
	MOVAB	OUT.N,R10		;
	MOVL	LENGTH,R1		;
	JSB	WRITE			; Output the file name
	MOVAB	M$CRLF,R10		;
	MOVZBL	#L$CRLF,R1		;
	JSB	WRITE			; Output a return/line feed
	BRW	LINDON			; Go finish this line

NOTFILNM:
	CMPL	#PKEOF,R10		; Check to see if this is end of task
	BNEQ	NOTPKEOF		; If not then branch
; End of ouput file record found
	JSB	CLTSK			; Close the task file
	CLRL	WTCOUNT			; Initialize the pointer
	CLRL	ADDRESS			; Initialize the address
	JMP	LINDON			; Go finish this line

; Unknown code
NOTPKEOF:				; Since we don't know what the code
	MOVAB	M$UN,R10		;   just send the unknown code text to
	MOVZBL	#1,R1			;   the terminal
	JSB	WRITE			;
	JMP	DOLIN			; Go do next input line
	
	.SBTTL	Finished with this line

; Line processed without a problem
LINDON:
;	MOVAB	M$AK,R10		; Get the data address of the 
					;  single character
;	MOVZBL	#1,R1			; Only write single char to terminal
;	JSB	WRITE			; Write to the terminal
	JMP	DOLIN			; Good so do next line
	.SBTTL	Finish up
;++
;Finish up
;--
FINISH:
; Close the file(s)
	JSB	CLTSK			; Close the task file if it isn't yet
	MOVAL	RDFAB,R1		; Get FAB for input file
	$CLOSE	R1			; Close the input file
	JSB	RMSERR			; Check for file error
END:	MOVL	#SS$_NORMAL,R0		; Set up successful completion
	RET
	.SBTTL	Close file

;++
; Close the output file if there is one open
;
; If there is an error the program stops with an RMS error
;
; Registers destroyed:	R0, R1
; The OPENFL state is changed to file not open (OPENFL=0).
;--

CLTSK:	TSTL	OPENFL			; See if the task file is open
	BEQL	10$			; If not then just return

; Write last buffer if needed
	TSTL	WTCOUNT			; See if there is any data not written
	BEQL	8$			; If not then branch
	MOVAL	WTRAB,R1		; Get the RAB address
	$RAB_STORE RAB=R1,RSZ=WTCOUNT	; Put its size into the RAB.
	$WRITE	R1			; Put the buffer of data.
	JSB	RMSERR			; Check for file error

; Close the file
8$:	MOVAL	WTFAB,R1		; Get FAB for output file
	$CLOSE	R1			; Close output file
	JSB	RMSERR			; Check for file error
	CLRL	OPENFL			; Set the state to file not open
10$:	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
; Call with:		R0	Status of last RMS call (automatically stored 
;				  in R0 by RMS after an operation)
;
; Returned:		R0	Status
; Registers destroyed:	R0
; Program stops after error message is displayed if there is any type of 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 RMS error we don't know how to handle
60$:	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	Open the output file
;++
; Create and open the output file and set the file open flag
;
; Registers destroyed:	R0, R1
; Program stops after error message is displayed if there is any type of error.
;--

OPEN:	MOVL	#TRUE,OPENFL		; State that the file is open
	MOVAL	WTFAB,R1		; Put address of FAB into R1.
	$FAB_STORE FAB=R1,FAC=<BIO,GET>	; Set the block I/O in FAB.
	$FAB_STORE FAB=R1,FOP=CTG	; Tell RMS to make the task contiguous
	$CREATE	#WTFAB			; Create the file
	JSB	RMSERR			; Check for file error
	MOVAL	WTRAB,R1		; Put address of RAB into R1.
; Put address of user buffer and record buffer and sizes into RAB
	$RAB_STORE RAB=R1,UBF=WTBUF,RBF=WTBUF,USZ=#512.,RSZ=#512.
	$CONNECT #WTRAB			; Connect to record.
	JSB	RMSERR			; Check for file error
	RSB				; Return to sender
	.SBTTL	Put a character to the file
;++
; Put a character to the output file.
; The buffer is only written when 512. characters have been sent to the routine
; If the file does not end on a boundary then the buffer will have to be 
; written by some other routine.
; 
; Call with:		R10	Contains the character to be put into file
; Registers destroyed:	R1, R10
;
; Program stops after error message is displayed if there is any type of error.
;--

PUT:	PUSHL	R10			; Save the character
	MOVL	WTCOUNT,R10		; Get the offset into the buffer
	MOVB	(SP),WTBUF(R10)		; Put the character
	TSTL	(SP)+			; Restore the stack
	INCL	WTCOUNT			; Increment the offset into the buffer
	CMPL	WTCOUNT,#512.		; Check to see if we are past the end
	BNEQ	10$			; If not then branch
	MOVAL	WTRAB,R1		; Get the RAB address
	$RAB_STORE RAB=R1,RSZ=WTCOUNT	; Put its size into the RAB.
	$WRITE	R1			; Put the buffer of data.
	JSB	RMSERR			; Check for file error
	CLRL	WTCOUNT			; Clear the pointer
10$:	RSB				; Return to sender
	.SBTTL	 Convert to binary
;++
; Convert 2 hexidecimal digits to binary
; Input is from the input buffer pointed to by R4 (it is incremented twice)
;
; Call with:		R4	The pointer into the input buffer
; Returned:		R10	The binary walue
; Registers destroyed:	R10,R1
;--

CVTBIN:
	CLRL	R10			; Clear R10 for the BISB
	BISB	(R4)+,R10		; Get the next digit
	JSB	BIN			;   in place and convert to binary
	ASHL	#4,R10,R10		; Multiply the result by 16
	MOVL	R10,R1			;  and save it
	CLRL	R10			; Clear R10
	BISB	(R4)+,R10		; Get the next digit
	JSB	BIN			; Convert to binary
	BISL	R1,R10			; Set the correct bits for high order
	ADDL2	R10,CHKSUM		; Add the value to the checksum
	RSB				; Return to sender

BIN:	CMPL	R10,#^A/9/		; Check to see if above '9
	BLEQ	1$			; If not then branch
	SUBL2	#HEXOFFSET,R10		; Subtract offset to alphabet
1$:	SUBL2	#48.,R10		; Make binary
	RSB				; Return to sender
	.SBTTL	Receive a line of data

;++
; This will get a line of data from the input device
;
; Returned:		R4	Address of start of data buffer
; Registers destroyed:	R0, R1, R3, R4
;
; A checksum error will cause a NAK to be sent and input to be read again
; A real error will cause an error message to be output and the program to stop
;--

RECEIVE:
; Here to read from a file
	MOVAL	RDRAB,R1		; Get the RAB address
	$GET	R1			; Get the record
	JSB	RMSERR			; Check for file error
	MOVZWL	#MAX.MSG,R3		; Assume we got a full buffer
; Here to check the data we got
RECCHK:	MOVAL	RDBUF,R4		; Get the address of the information
	CLRL	R1			; Clear the data start address 
80$:	BICB	#MSB,(R4)		; Clear parity bit
	CMPB	(R4)+,#RCV.SOH		; Check for start of header
	BNEQ	81$			; If not the just keep going
	MOVL	R4,R1			; Start of header so save it
81$:	SOBGTR	R3,80$			; Repeat until done
	TSTL	R1			; Check to see if we got a SOH
	BNEQ	85$			; If good then skip the jump
	JMP	RECEIVE			; If not then re-read
85$:	MOVL	R1,R4			; Move to R4 for use
	PUSHL	R4			; Save SOH pointer on stack

	JSB	CVTBIN			; Convert all to binary to see if
	MOVL	R10,R3			; Get the length of data
	ADDL2	#4,R3			; Add the length of address and field
					;   type and checksum
	BLSS	94$			; If we have a negative number then 
					;   must have been a bad length
	CMPL	R3,#MAX.MSG/2-1		; If we got some length that is out of
	BGEQ	94$			;   range then NAK right away
92$:	JSB	CVTBIN			; Convert all to binary to see if
	SOBGTR	R3,92$			;   the checksum is OK
93$:	BICL	#LEFTBYTE,CHKSUM	; We only want an 8 bit checksum
	TSTL	CHKSUM			; Test for a zero checksum
	BEQL	95$			; If OK then exit normally
94$:	CLRL	CHKSUM			; Clear the checksum for the line
	MOVAL	M$NAK,R10		; Get the address of the message
	MOVZBL	#1,R1			; Only write the first character to
	JSB	WRITE			;   the terminal
	TSTL	(SP)+			; Pull the pointer off the stack
	JMP	RECEIVE			; Try to get the line again

; Return to sender
95$:	POPL	R4			; Get the pointer back
	RSB				; Return to sender
	.SBTTL	End of the Dehexify

	.END	DEHEX