From:	MERC::"uunet!WKUVX1.BITNET!FILESERV-Mgr" 10-APR-1992 11:57:43.40
To:	galaxy::gleeve
CC:	
Subj:	FILESERV_TOOLS.01_OF_04

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On  8-APR-1992 16:23:14.91   By user GOATHUNTER (@WKUVX1.BITNET)
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 4 PARTS, TO KEEP EACH PART
$!  BELOW 60 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. [.FILESERV_TOOLS]AAAREADME.TXT;1
$!       2. [.FILESERV_TOOLS]BUILD.COM;1
$!       3. [.FILESERV_TOOLS]DEHEXIFY.MAR;1
$!       4. [.FILESERV_TOOLS]LZDCMP.HEX;1
$!       5. [.FILESERV_TOOLS]MFTU.HEX;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
XThis directory contains LZDCMP.HEX, a hexified decompression program,
XMFTU.HEX, a hexified encoding program, and DEHEXIFY.MAR, a MACRO program
Xto de-hexify .HEX files.
X
XTo build DEHEXIFY and dehexify LZDCMP and MFTU, simply execute the
XBUILD.COM file.
$ CALL UNPACK [.FILESERV_TOOLS]AAAREADME.TXT;1 1531266300
$ create 'f'
X$ say := write sys$output
X$ say "Assembling DEHEXIFY...."
X$ macro dehexify
X$ say "Linking DEHEXIFY...."
X$ link/notrace dehexify
X$ say "DEHEXIFYing MFTU.EXE...."
X$ run dehexify
Xmftu.hex
X$ say "DEHEXIFYing LZDCMP.EXE...."
X$ run dehexify
Xlzdcmp.hex
X$ exit
$ CALL UNPACK [.FILESERV_TOOLS]BUILD.COM;1 1213741228
$ create 'f'
X        .TITLE  DEHEX
X        .SBTTL  Stuart Hecht and Eric McQueen, Stevens Inst of Technology
X`20
X        .LIBRARY /SYS$LIBRARY:STARLET/
X        .LIBRARY /SYS$LIBRARY:LIB/
X        .IDENT   /1.1.03/
X;++
X;1.1.01
X;Updated March 9, 1898, by Susan Webb and Jerry Holliday of Lockheed Aircraf
Vt
X;Systems Co, Marietta, GA, to work for files longer than 64K.  Added lines
X;marked with ";JH".
X;--
X;++
X;1.1.02
X;Updated March 15, 1989, by Tom Allebrandi of Advanced Computer Consulting,
X;Inc, Charlottesville, VA. (ta2@acci.com)
X;
X;On March 14, 1989, I pulled this file and VMSMIT.HEX from Columbia via
X;KERMSRV. After compiling, this utility would not decode the VMSMIT file.
X;The problem was the 1.1.01 fix noted above.
X;
X;I have removed the 1.1.01 fix and coded it so that it works correctly.
X;My changes are marked ";ta2"
X;--
X;++
X;Modified by Jeff Guerber, STX, (xrjrg@lepvax.gsfc.nasa.gov), June 4, 1991.
X;Added the file organization (fab$b_org).  Indexed files were not being
X;treated properly, hopefully this will fix it.  Marked with "JRG".  1.1.03
X;--
X`20
X;++
X;This will take a set hexidecimal strings created by the hexify program and
X;  recreate the source file(s).
X;--
X`20
X        .EXTRN  LIB$GET_INPUT
X        .EXTRN  LIB$PUT_OUTPUT
X        .EXTRN  DSC$K_DTYPE_T
X        .EXTRN  DSC$K_CLASS_S
X        .EXTRN  SS$_NORMAL
X        .MCALL  $FAB                            ; RMS calls
X        .MCALL  $RAB
X        .MCALL  $CLOSE
X        .MCALL  $CONNECT
X        .MCALL  $CREATE
X        .MCALL  $DISCONNECT
X        .MCALL  $GET
X        .MCALL  $OPEN
X        .MCALL  $WRITE
X        .MCALL  $RAB_STORE
X        .MCALL  $FAB_STORE
X`20
X        .SBTTL  Definitions of symbols
X`20
XDWRLUN  =1                              ; Disk read LUN
XDWWLUN  =5                              ; Disk write LUN
XTRUE    =1                              ; True
XFALSE   =0                              ; False
XKNORMAL =0                              ; No error
XLEFTBYTE=`5EO377*`5EO400                    ; All ones in left byte
XHEXOFFSET=7                             ; Offset to get to 'A from '9+1
XCR      =13.                            ; Carriage return
XLF      =10.                            ; Line feed
XMAX.MSG =256.                           ; Maximum number of chars from XK
XRCV.SOH =`5EA/:/                          ; Receive start of packet
XRCV.EOL =13.                            ; End of line character
XMSB     =128.                           ; Most significant bit
X; Packet types currently supported
XPKDATA  =00                             ; Data packet code
XPKRFM   =255.                           ; Record format
XPKRAT   =254.                           ; Record attributes
XPKMRS   =253.                           ; Maximum record size
XPKALQ   =252.                           ; File length(blocks)
XPKFILNM =251.                           ; File name
XPKEOF   =250.                           ; End of task file
XPKORG`09=249.`09`09`09`09; File organization
X;
X`20
X`20
X        .SBTTL  RMS Data
X`20
X        .PSECT  $PLIT$,LONG
X`20
XDEFALT: .ASCIZ  'SYS$DISK:'             ; System default.
XDEFALN  =.-DEFALT                       ; Size of the default device.
X        .EVEN
X`20
X        .SBTTL  Data
X`20
X`20
XM$FILE: .BYTE   CR,LF
X        .ASCII  'Please type the file name: '
XL$FILE= .-M$FILE
X`20
XM$CRLF: .BYTE   CR,LF                   ; Data for carriage return/line feed
XL$CRLF  =.-M$CRLF
X`20
X;M$AK:
X;       .ASCII  'Y'                     ; Data for aknowledged
X`20
XM$NAK:
X        ;.ASCII 'N'                     ; Data for not aknowledged
X        .ASCII  'BAD CHECK SUM'         ; Data for not aknowledged
XL$NAK   =.-M$NAK
X`20
XM$UN:
X        ;.ASCII 'U'                     ; Data for unrecognized code
X        .ASCII  'UNKNOWN BLOCK TYPE'    ; Data for unrecognized code
XL$UN    =.-M$UN
X`20
XM$RMS:  .BYTE   CR,LF,LF
X        .ASCII  'RMS ERROR'
XL$RMS   =.-M$RMS
X`20
XM$REC:  .BYTE   CR,LF,LF
X        .ASCII  'RECEIVE ERROR - Try again.'
XL$REC   =.-M$REC
X        .EVEN
X`20
X`20
X        .SBTTL  Storage locations
X`20
X        .PSECT  $OWN$,LONG
X        .ALIGN  LONG
X`20
XMSGDSC: .BLKW   1                       ; Data block for terminal output
X        .BYTE   DSC$K_DTYPE_T
X        .BYTE   DSC$K_CLASS_S
XADDR:   .ADDRESS ADDR
XLNGADR: .BLKL   1
X`20
XINP_STR_D:                              ; Key string desciptor
X         .BLKL  1
XINP_BUF: .ADDRESS ADDR
X`20
XINP_STR_LEN: .BLKL 1                    ; Key string length
X`20
XWTCOUNT: .BLKL  1                       ; Number of characters written
XLENGTH: .BLKL   1                       ; Length of data portion of packet
XOPENFL: .BLKL   1                       ; Tells us if the file is open
X`20
XCHKSUM: .BLKL   1                       ; Checksum for the line
XADDRESS: .BLKL  1                       ; Current address
XALQLOC: .BLKW   2                       ; Storage for allocation
X`20
XOUT.N:  .BLKB   28.                     ; Space for output file name
XOUT.L   =.-OUT.N                        ; Length of output file name
X`20
XINP.N:  .BLKB   28.                     ; Space for input file name
XINP.L   =.-INP.N                        ; Length of input file name
X`20
X        .EVEN                           ; Need to start RDBUF on even bounda
Vry
XRDBUF:  .BLKB   MAX.MSG                 ; XK read buffer
X        .EVEN
XWTBUF:  .BLKB   512.                    ; Disk write buffer
X        .EVEN
X`20
X`20
X`20
X        .SBTTL  RMS Data structures
X        .ALIGN  LONG
X`20
XRDFAB:: $FAB    DNA=DEFALT,DNS=DEFALN,FNA=INP.N,FNS=INP.L,-
X                LCH=DWRLUN,FAC=GET,SHR=GET
X`20
X        .ALIGN  LONG
XRDRAB:: $RAB    FAB=RDFAB,RAC=SEQ ; Beginning of RAB block.
X`20
X        .ALIGN  LONG
XWTFAB:: $FAB    DNA=DEFALT,DNS=DEFALN,FNA=OUT.N,FNS=OUT.L,-
X                LCH=DWWLUN,FAC=PUT,SHR=NIL
X`20
XWTRAB:: $RAB    FAB=WTFAB,RAC=SEQ ; Beginning of RAB block.
X`20
X`20
X        .SBTTL  Start of program
X`20
X        .PSECT  $CODE$,LONG,EXE
X`20
XDEHEX:: .WORD   `5EM<>
XFILE:   MOVAB   M$FILE,R11              ; Output the get file name message
X        MOVZBL  #L$FILE,R12
X        MOVAB   INP.N,R10               ; Get the file name
X        MOVZBL  #INP.L,R1
X        JSB     READ
X        TSTL    R0                      ; Check for no input
X        BEQL    FILE                    ; Go back and get some
X;Open the file
X        MOVAL   RDFAB,R1                ; Put address of FAB into R1.
X        $FAB_STORE FAB=R1,FNS=R0        ; Tell RMS file name length
X        $OPEN   #RDFAB                  ; Open the file
X        JSB     RMSERR                  ; Check for file error
X        MOVAL   RDRAB,R1                ; Put address of RAB into R1.
X; Put address of user buffer and size and record buffer and size in RAB.
X        $RAB_STORE RAB=R1,UBF=RDBUF,RBF=RDBUF,USZ=#MAX.MSG,RSZ=#MAX.MSG
X        $CONNECT #RDRAB                 ; Connect to record.
X        JSB     RMSERR                  ; Check for file error
X`20
X`20
X        .SBTTL  Do the real work
X;++
X; Do the actual work
X;--
XBEGIN:  MOVAL   M$CRLF,R10              ; Get a return/linefeed and output t
Vhem
X        MOVZBL  #L$CRLF,R1
X        JSB     WRITE
X`20
X20$:    CLRL    WTCOUNT                 ; Initialize the pointer
X        CLRL    ADDRESS                 ; Initialize the address
X        CLRL    OPENFL                  ; Set the file to not open
X`20
X        .SBTTL  Main loop
X`20
X; Main loop to get data
XDOLIN:
X        CLRL    CHKSUM                  ; Clear the checksum
X        JSB     RECEIVE                 ; Get the line
X        JSB     CVTBIN                  ; Convert it to a real number
X        MOVL    R10,LENGTH              ; Save the length
XNAB:    JSB     CVTBIN                  ;
X        BISL    R10,R3                  ; Save a byte of the address
X        ASHL    #8.,R3,R3               ; Make room for next byte
X        SOBGEQ  LNGADR,NAB              ; If there are more than 2 bytes
X        JSB     CVTBIN                  ;
X        BISL    R10,R3                  ; Fill in the low byte of address
X`20
X;ta2 The fix for 1.1.01 converted two more hex values here. As of March
X;    1989, this doesn't appear to be required. The conversion has been
X;    removed.
X`20
X        JSB     CVTBIN                  ;ta2 Pick up the record type code
X`20
X        CMPL    #PKDATA,R10             ; Check to see if this is regular da
Vta
X        BNEQ    NOTDAT                  ; If not then check the special case
Vs
X; Check for end of hex file
X        TSTL    R3                      ; Check to see if the address is all
X        BNEQ    DATST                   ;  zero, if not then branch
X        TSTL    LENGTH                  ; Check to see if the length is zero
X        BNEQ    DATST                   ;  also, if not then branch
X        JMP     FINISH                  ; Must be end of hex file so finish
V up
X; Regular data to put into the file
XDATST:  TSTL    OPENFL                  ; Check to see if the file is open y
Vet
X        BNEQ    DAT1                    ; If it is then skip the open
X        JSB     OPEN                    ; Open the file
XDAT1:   CMPL    R3,ADDRESS              ; Check for null compression
X        BEQL    10$                     ; If none compressed then continue p
Vast
X        CLRL    R10                     ; Make a null
X        JSB     PUT                     ;  and put it into the file
X        INCL    ADDRESS                 ; Point to next address
X        BRW     DAT1                    ; Go see if there are any more nulls
X; Go to work on the HEX we got on the line
X10$:    MOVL    LENGTH,R2               ; Get the length
X        TSTL    R2                      ; See if there is any data
X        BEQL    30$                     ; If not then branch
X25$:    JSB     CVTBIN                  ; Convert it
X        JSB     PUT                     ; Put the character in the file
X        INCL    ADDRESS                 ; Increment the address
X        SOBGTR  R2,25$                  ; Repeat until all done
X30$:    BRW     LINDON                  ; Go finish this line
X`20
X`20
X`20
XNOTDAT: MOVAL   WTFAB,R5                ; Get the FAB address
X        CMPL    #PKRFM,R10              ; Check to see if this is record fmt
X        BNEQ    NOTRFM                  ; If not then don't do this stuff
X; Store the Record format (FIX, VAR, ...)
X        JSB     CVTBIN                  ;
X        $FAB_STORE FAB=R5,RFM=R10       ; Store the record format
X        BRW     LINDON                  ; Go finish this line
X`20
XNOTRFM: CMPL    #PKRAT,R10              ; Check to see if this is record typ
Ve
X        BNEQ    NOTRAT                  ; If not then branch
X; Store the record type (CR, ...)
X        JSB     CVTBIN                  ;
X        $FAB_STORE FAB=R5,RAT=R10       ; Store the record type
X        BRW     LINDON                  ; Go finish this line
X`20
X; Store the file organization (SEQ, IDX, etc).  JRG.
XNOTRAT: CMPL    #PKORG,R10              ; Check to see if this is organizati
Von
X        BNEQ    NOTORG                  ; If not then branch
X        JSB     CVTBIN                  ;
X        $FAB_STORE FAB=R5,ORG=R10       ; Store the organization
X        BRW     LINDON                  ; Go finish this line
X`20
XNOTORG: CMPL    #PKMRS,R10              ; Check to see if this is max record
X        BNEQ    NOTMRS                  ;  size, branch if not
X; Get the maximum record size (512. for tasks)
X        JSB     CVTBIN                  ; Convert high order byte
X        MOVL    R10,R3                  ; Save it
X        ASHL    #8.,R3,R3               ; Shift it to the high order byte
X        JSB     CVTBIN                  ; Convert low order byte
X        BISL    R10,R3                  ; Put low order word into R3 also
X        $FAB_STORE FAB=R5,MRS=R3        ; Store the maximum record size
X        BRW     LINDON                  ; Go finish this line
X`20
XNOTMRS: CMPL    #PKALQ,R10              ; Check to see if this is allocation
X        BNEQ    NOTALQ                  ; If not then branch
X; Get the file length (in blocks)
X        JSB     CVTBIN                  ; Convert high order byte
X        MOVL    R10,R3                  ; Save it
X        ASHL    #8.,R3,R3               ; Shift it to the high order byte
X        JSB     CVTBIN                  ; Convert low order byte
X        BISL    R10,R3                  ; Put low order word into R3 also
X        MOVZWL  R3,ALQLOC               ; Save it
X        $FAB_STORE FAB=R5,ALQ=ALQLOC    ; Store the allocation
X        BRW     LINDON                  ; Go finish this line
X`20
XNOTALQ: CMPL    #PKFILNM,R10            ; Check to see if this is file name
X        BNEQ    NOTFILNM                ; If not then branch
X; Get the file name
X        MOVL    LENGTH,R2               ; Get the length
X        $FAB_STORE FAB=R5,FNS=R2        ; Store the file name length
X        MOVAB   OUT.N,R3                ; Get the output file name address
X25$:    JSB     CVTBIN                  ; Convert next character of the name
X        MOVB    R10,(R3)+               ; Save the character
X        SOBGTR  R2,25$                  ; Repeat until all done
X        MOVAB   M$CRLF,R10              ;
X        MOVZBL  #L$CRLF,R1              ;
X        JSB     WRITE                   ; Output a return/line feed
X        MOVAB   OUT.N,R10               ;
X        MOVL    LENGTH,R1               ;
X        JSB     WRITE                   ; Output the file name
X        MOVAB   M$CRLF,R10              ;
X        MOVZBL  #L$CRLF,R1              ;
X        JSB     WRITE                   ; Output a return/line feed
X        BRW     LINDON                  ; Go finish this line
X`20
X`20
X`20
XNOTFILNM:
X        CMPL    #PKEOF,R10              ; Check to see if this is end of tas
Vk
X        BNEQ    NOTPKEOF                ; If not then branch
X; End of ouput file record found
X        JSB     CLTSK                   ; Close the task file
X        CLRL    WTCOUNT                 ; Initialize the pointer
X        CLRL    ADDRESS                 ; Initialize the address
X        JMP     LINDON                  ; Go finish this line
X`20
X; Unknown code
XNOTPKEOF:                               ; Since we don't know what the code
X        MOVAB   M$UN,R10                ;   just send the unknown code text
V to
X        MOVZBL  #L$UN,R1                ;   the terminal
X        JSB     WRITE                   ;
X        JMP     DOLIN                   ; Go do next input line
X`20
X`20
X        .SBTTL  Finished with this line
X`20
X; Line processed without a problem
XLINDON:
X;       MOVAB   M$AK,R10                ; Get the data address of the
X                                        ;  single character
X;       MOVZBL  #1,R1                   ; Only write single char to terminal
X;       JSB     WRITE                   ; Write to the terminal
X        JMP     DOLIN                   ; Good so do next line
X`20
X`20
X        .SBTTL  Finish up
X;++
X;Finish up
X;--
XFINISH:
X; Close the file(s)
X        JSB     CLTSK                   ; Close the task file if it isn't ye
Vt
X        MOVAL   RDFAB,R1                ; Get FAB for input file
X        $CLOSE  R1                      ; Close the input file
X        JSB     RMSERR                  ; Check for file error
XEND:    MOVL    #SS$_NORMAL,R0          ; Set up successful completion
X        RET
X`20
X        .SBTTL  Close file
X`20
X;++
X; Close the output file if there is one open
X;
X; If there is an error the program stops with an RMS error
X;
X; Registers destroyed:  R0, R1
X; The OPENFL state is changed to file not open (OPENFL=0).
X;--
X`20
XCLTSK:  TSTL    OPENFL                  ; See if the task file is open
X        BEQL    10$                     ; If not then just return
X`20
X; Write last buffer if needed
X        TSTL    WTCOUNT                 ; See if there is any data not writt
Ven
X        BEQL    8$                      ; If not then branch
X        MOVAL   WTRAB,R1                ; Get the RAB address
X        $RAB_STORE RAB=R1,RSZ=WTCOUNT   ; Put its size into the RAB.
X        $WRITE  R1                      ; Put the buffer of data.
X        JSB     RMSERR                  ; Check for file error
X`20
X; Close the file
X8$:     MOVAL   WTFAB,R1                ; Get FAB for output file
X        $CLOSE  R1                      ; Close output file
X        JSB     RMSERR                  ; Check for file error
X        CLRL    OPENFL                  ; Set the state to file not open
X10$:    RSB                             ; Return to sender
X`20
X`20
X        .SBTTL  Output and input to/from terminal
X;++
X; Write data to terminal.
X;       R10     Address of data to output
X;       R1      Length of data
X;--
XWRITE:
X        MOVW    R1,MSGDSC               ; Store the length in the descript b
Vlk
X        MOVL    R10,ADDR                ; Store the address of the ASCII
X        PUSHAQ  MSGDSC                  ; Push the descriptor block address
X        CALLS   #1,G`5ELIB$PUT_OUTPUT     ; Do the output
X        RSB                             ; Return to sender
X`20
X;++
X; Read from the terminal
X;       R10     Address of buffer
X;       R1      Number of characters to read
X;       R11     Input prompt address
X;       R12     Length of prompt
X;
X;Returned:
X;       R0      Number of characters read
X;--
XREAD:
X        MOVL    R1,INP_STR_D            ; Store the buffer length in desc bl
Vock
X        MOVL    R10,INP_BUF             ; Store the buffer address in desc b
Vlk
X        MOVL    R11,ADDR                ; Store prompt address in desc block
X        MOVW    R12,MSGDSC              ; Store length in desctriptor block
X        PUSHAB  INP_STR_LEN             ; Address for string length
X        PUSHAQ  MSGDSC                  ; Push address of prompt descriptor
V blk
X        PUSHAB  INP_STR_D               ; String buffer descriptor
X        CALLS   #3,G`5ELIB$GET_INPUT      ; Get input string value
X        MOVL    INP_STR_LEN,R0          ; Get actual input length back
X        RSB                             ; Return to sender
X`20
X`20
X        .SBTTL  RMS error routine
X;++
X;Check for RMS error
X; Call with:            R0      Status of last RMS call (automatically store
Vd
X;                                 in R0 by RMS after an operation)
X;
X; Returned:             R0      Status
X; Registers destroyed:  R0
X; Program stops after error message is displayed if there is any type of err
Vor.
X;--
XRMSERR:
X        BLBC    R0,60$                  ; If error, go check it out
X        MOVL    #KNORMAL,R0             ; Set up a successful return code.
X        RSB                             ; Return to caller
X`20
X; Here if there is an RMS error we don't know how to handle
X60$:    PUSHL   R0                      ; Save the error code
X        MOVAB   M$RMS,R10               ; Get the address and length of the
X        MOVL    #L$RMS,R1               ;   message to output
X        JSB     WRITE                   ; Output it
X        POPL    R0                      ; Get the error code back
X        RET                             ; Exit program
X`20
X`20
X        .SBTTL  Open the output file
X;++
X; Create and open the output file and set the file open flag
X;
X; Registers destroyed:  R0, R1
X; Program stops after error message is displayed if there is any type of err
Vor.
X;--
X`20
XOPEN:   MOVL    #TRUE,OPENFL            ; State that the file is open
X        MOVAL   WTFAB,R1                ; Put address of FAB into R1.
X        $FAB_STORE FAB=R1,FAC=<BIO,GET> ; Set the block I/O in FAB.
X        ;$FAB_STORE FAB=R1,FOP=CTG      ; Tell RMS to make the task contiguo
Vus
X        $CREATE #WTFAB                  ; Create the file
X        JSB     RMSERR                  ; Check for file error
X        MOVAL   WTRAB,R1                ; Put address of RAB into R1.
X; Put address of user buffer and record buffer and sizes into RAB
X        $RAB_STORE RAB=R1,UBF=WTBUF,RBF=WTBUF,USZ=#512.,RSZ=#512.
X        $CONNECT #WTRAB                 ; Connect to record.
X        JSB     RMSERR                  ; Check for file error
X        RSB                             ; Return to sender
X`20
X        .SBTTL  Put a character to the file
X;++
X; Put a character to the output file.
X; The buffer is only written when 512. characters have been sent to the rout
Vine
X; If the file does not end on a boundary then the buffer will have to be
X; written by some other routine.
X;
X; Call with:            R10     Contains the character to be put into file
X; Registers destroyed:  R1, R10
X;
X; Program stops after error message is displayed if there is any type of err
Vor.
X;--
X`20
XPUT:    PUSHL   R10                     ; Save the character
X        MOVL    WTCOUNT,R10             ; Get the offset into the buffer
X        MOVB    (SP),WTBUF(R10)         ; Put the character
X        TSTL    (SP)+                   ; Restore the stack
X        INCL    WTCOUNT                 ; Increment the offset into the buff
Ver
X        CMPL    WTCOUNT,#512.           ; Check to see if we are past the en
Vd
X        BNEQ    10$                     ; If not then branch
X        MOVAL   WTRAB,R1                ; Get the RAB address
X        $RAB_STORE RAB=R1,RSZ=WTCOUNT   ; Put its size into the RAB.
X        $WRITE  R1                      ; Put the buffer of data.
X        JSB     RMSERR                  ; Check for file error
X        CLRL    WTCOUNT                 ; Clear the pointer
X10$:    RSB                             ; Return to sender
X`20
X        .SBTTL   Convert to binary
X;++
X; Convert 2 hexidecimal digits to binary
X; Input is from the input buffer pointed to by R4 (it is incremented twice)
X;
X; Call with:            R4      The pointer into the input buffer
X; Returned:             R10     The binary walue
X; Registers destroyed:  R10,R1
X;--
X`20
XCVTBIN:
X        CLRL    R10                     ; Clear R10 for the BISB
X        BISB    (R4)+,R10               ; Get the next digit
X        JSB     BIN                     ;   in place and convert to binary
X        ASHL    #4,R10,R10              ; Multiply the result by 16
X        MOVL    R10,R1                  ;  and save it
X        CLRL    R10                     ; Clear R10
X        BISB    (R4)+,R10               ; Get the next digit
X        JSB     BIN                     ; Convert to binary
X        BISL    R1,R10                  ; Set the correct bits for high orde
Vr
X        ADDL2   R10,CHKSUM              ; Add the value to the checksum
X        RSB                             ; Return to sender
X`20
XBIN:    CMPL    R10,#`5EA/9/              ; Check to see if above '9
X        BLEQ    1$                      ; If not then branch
X        SUBL2   #HEXOFFSET,R10          ; Subtract offset to alphabet
X1$:     SUBL2   #48.,R10                ; Make binary
X        RSB                             ; Return to sender
X`20
X`20
X        .SBTTL  Receive a line of data
X`20
X;++
X; This will get a line of data from the input device
X;
X; Returned:             R4      Address of start of data buffer
X; Registers destroyed:  R0, R1, R3, R4
X;
X; A checksum error will cause a NAK to be sent and input to be read again
X; A real error will cause an error message to be output and the program to s
Vtop
X;--
X`20
XRECEIVE:
X; Here to read from a file
X        MOVAL   RDRAB,R1                ; Get the RAB address
X        $GET    R1                      ; Get the record
X        JSB     RMSERR                  ; Check for file error
X        MOVZWL  #MAX.MSG,R3             ; Assume we got a full buffer
X; Here to check the data we got
XRECCHK: MOVAL   RDBUF,R4                ; Get the address of the information
X        CLRL    R1                      ; Clear the data start address
X80$:    BICB    #MSB,(R4)               ; Clear parity bit
X        SUBB3   #RCV.SOH,(R4)+,R0       ; Check for start of header
X        BLSS    81$                     ; If not, just keep going
X        CMPB    R0,#2                   ; There are 3 possible headers
X        BGTR    81$                     ; Not a header
X        MOVZBL  R0,LNGADR               ; Amount of extra bytes in the addre
Vss
X        MOVL    R4,R1                   ; Start of header so save it
X81$:    SOBGTR  R3,80$                  ; Repeat until done
X        TSTL    R1                      ; Check to see if we got a SOH
X        BNEQ    85$                     ; If good then skip the jump
X        JMP     RECEIVE                 ; If not then re-read
X85$:    MOVL    R1,R4                   ; Move to R4 for use
X        PUSHL   R4                      ; Save SOH pointer on stack
X`20
X        JSB     CVTBIN                  ; Convert all to binary to see if
X                                        ;   checksum is correct
X        MOVL    R10,R3                  ; Get the length of data
X        ADDL2   #4,R3                   ; Add the length of address and fiel
Vd
X                                        ;   type and checksum
X        ADDL2   LNGADR,R3               ; If long address, skip more bytes
X        BLSS    94$                     ; If we have a negative number then
X                                        ;   must have been a bad length
X        CMPL    R3,#MAX.MSG/2-1         ; If we got some length that is out
V of
X        BGEQ    94$                     ;   range then NAK right away
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-
