Category : Alternate Operating Systems - Quarterdeck DesqView, CP/M, etc
Archive   : HEXDEHEX.ZIP
Filename : VMSHEXF.MAR

 
Output of file : VMSHEXF.MAR contained in archive : HEXDEHEX.ZIP
.TITLE HEXIFY
.SBTTL Stuart Hecht and Eric McQueen

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

.IDENT /1.1.01/

;++
;This will take a task file and turn it into hexidecimal strings
;
;MODIFIED:
; 18-APR-1988 Doyle Myers
; 1.1.01 - Disply version number at startup.
;--

.EXTRN LIB$GET_INPUT
.EXTRN LIB$PUT_OUTPUT
.EXTRN DSC$K_DTYPE_T
.EXTRN DSC$K_CLASS_S
.EXTRN SS$_NORMAL
.EXTRN RMS$_EOF
.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$BANNER: .BYTE CR,LF
.ASCII ' VMS HEX, Version 1.1.01'
L$BANNER= .-M$BANNER

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
LNGADR: .BLKL 1

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

MOVAB M$BANNER,R10 ; Display the banner
MOVL #L$BANNER,R1
JSB WRITE

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/ JSB BUFFER ; Put it into the buffer
MOVZBL #12.,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/ JSB BUFFER ; position of the buffer
CLRL R10 ; Move a fake length into the buffer
JSB CVTH ;
MOVZBL ADDRESS+3,R10 ; Get the highest order byte of the
JSB CVTH ; address and put into the buffer
MOVZBL ADDRESS+2,R10 ; Get the 2nd highest order byte of the
JSB CVTH ; address and put into the buffer
MOVZBL ADDRESS+1,R10 ; Get the 2nd lowest order byte of the
JSB CVTH ; address and put into the buffer
MOVZBL ADDRESS,R10 ; Get the lowest order byte of the
JSB CVTH ; address and 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



  3 Responses to “Category : Alternate Operating Systems - Quarterdeck DesqView, CP/M, etc
Archive   : HEXDEHEX.ZIP
Filename : VMSHEXF.MAR

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/