From: gavron@spades.aces.com (Ehud Gavron 602-570-2000 x. 2546)
Newsgroups: comp.os.vms
Subject: NEWMAIL COUNT incorrect problems SOLVED (Was: Updated DISKFREE.COM)
Summary: Brain enema time
Keywords: Tumbler, Casing, Tensioner, Ward, Pick, Hole
Date: 14 Dec 92 04:50:00 GMT
Reply-To: gavron@ACES.COM
Organization: ACES Consulting Inc.
News-Software: VAX/VMS VNEWS 1.4-b1

Seeing that people are again posting gratuitous unwanted comfiles to
display disks and such (anyone got a really good CD.COM???) 

The following is the DEFINITIVE SOLUTION to the famous newmail count
problem.  If your NEWMAIL COUNT is off by one or more messages, extract 
the following and unpack it.

With thanks for the idea to package this going to Terry, Bo, Dan,
and Jane!

Ehud

--
Ehud Gavron        (EG76)     
gavron@ACES.COM


$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 13-DEC-1992 21:43:16.48   By user GAVRON 
$!
$! 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 2 PARTS, TO KEEP EACH PART
$!  BELOW 30 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. V.COM;2
$!
$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'
X$ createx vdh.mar
X        .TITLE  VDH
X        .SBTTL  Stuart Hecht and Eric McQueen
X
X        .LIBRARY /SYS$LIBRARY:STARLET/
X        .LIBRARY /SYS$LIBRARY:LIB/
X        .IDENT   /1.1.00/
X
X
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
X        .SBTTL  Definitions of symbols
X
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
X;
X
X
X        .SBTTL  RMS Data
X
X        .PSECT  $PLIT$,LONG
X
XDEFALT: .ASCIZ  'SYS$DISK:'             ; System default.
XDEFALN  =.-DEFALT                       ; Size of the default device.
X        .EVEN
X
X        .SBTTL  Data
X
X
XM$FILE: .BYTE   CR,LF
X        .ASCII  'Please type the file name: '
XL$FILE= .-M$FILE
X
XM$CRLF: .BYTE   CR,LF                   ; Data for carriage return/line feed
XL$CRLF  =.-M$CRLF
X
X;M$AK:
X;       .ASCII  'Y'                     ; Data for aknowledged
X
XM$NAK:
X        ;.ASCII 'N'                     ; Data for not aknowledged
X        .ASCII  'BAD CHECK SUM'         ; Data for not aknowledged
XL$NAK   =.-M$NAK
X
XM$UN:
X        ;.ASCII 'U'                     ; Data for unrecognized code
X        .ASCII  'UNKNOWN BLOCK TYPE'    ; Data for unrecognized code
XL$UN    =.-M$UN
X
XM$RMS:  .BYTE   CR,LF,LF
X        .ASCII  'RMS ERROR'
XL$RMS   =.-M$RMS
X
XM$REC:  .BYTE   CR,LF,LF
X        .ASCII  'RECEIVE ERROR - Try again.'
XL$REC   =.-M$REC
X        .EVEN
X
X
X        .SBTTL  Storage locations
X
X        .PSECT  $OWN$,LONG
X        .ALIGN  LONG
X
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
XINP_STR_D:                              ; Key string desciptor
X         .BLKL  1
XINP_BUF: .ADDRESS ADDR
X
XINP_STR_LEN: .BLKL 1                    ; Key string length
X
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
XCHKSUM: .BLKL   1                       ; Checksum for the line
XADDRESS: .BLKL  1                       ; Current address
XALQLOC: .BLKW   2                       ; Storage for allocation
X
XOUT.N:  .BLKB   28.                     ; Space for output file name
XOUT.L   =.-OUT.N                        ; Length of output file name
X
XINP.N:  .BLKB   28.                     ; Space for input file name
XINP.L   =.-INP.N                        ; Length of input file name
X
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
X
X
X        .SBTTL  RMS Data structures
X        .ALIGN  LONG
X
XRDFAB:: $FAB    DNA=DEFALT,DNS=DEFALN,FNA=INP.N,FNS=INP.L,-
X                LCH=DWRLUN,FAC=GET,SHR=GET
X
X        .ALIGN  LONG
XRDRAB:: $RAB    FAB=RDFAB,RAC=SEQ ; Beginning of RAB block.
X
X        .ALIGN  LONG
XWTFAB:: $FAB    DNA=DEFALT,DNS=DEFALN,FNA=OUT.N,FNS=OUT.L,-
X                LCH=DWWLUN,FAC=PUT,SHR=NIL
X
XWTRAB:: $RAB    FAB=WTFAB,RAC=SEQ ; Beginning of RAB block.
X
X
X        .SBTTL  Start of program
X
X        .PSECT  $CODE$,LONG,EXE
X
XVDH:: .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
X
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
X20$:    CLRL    WTCOUNT                 ; Initialize the pointer
X        CLRL    ADDRESS                 ; Initialize the address
X        CLRL    OPENFL                  ; Set the file to not open
X
X        .SBTTL  Main loop
X
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        JSB     CVTBIN                  ;
X
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
X
X
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
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
XNOTRAT: 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
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
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               ;
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-
-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
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
X
X
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
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
X
X        .SBTTL  Finished with this line
X
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
X
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
X        .SBTTL  Close file
X
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
XCLTSK:  TSTL    OPENFL                  ; See if the task file is open
X        BEQL    10$                     ; If not then just return
X
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
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
X
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
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
X
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
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
X
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
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
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
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
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
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
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
X
X        .SBTTL  Receive a line of data
X
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
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
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
X92$:    JSB     CVTBIN                  ; Convert all to binary to see if
X        SOBGTR  R3,92$                  ;   the checksum is OK
X93$:    BICL    #LEFTBYTE,CHKSUM        ; We only want an 8 bit checksum
X        TSTL    CHKSUM                  ; Test for a zero checksum
X        BEQL    95$                     ; If OK then exit normally
X94$:    CLRL    CHKSUM                  ; Clear the checksum for the line
X        MOVAL   M$NAK,R10               ; Get the address of the message
X        MOVZBL  #L$NAK,R1               ; Only write the first character to
X        JSB     WRITE                   ;   the terminal
X        TSTL    (SP)+                   ; Pull the pointer off the stack
X        JMP     RECEIVE                 ; Try to get the line again
X
X; Return to sender
X95$:    POPL    R4                      ; Get the pointer back
X        RSB                             ; Return to sender
X
X
X        .SBTTL  End of the VDH
X
X        .END    VDH
X$ create t.dat
X<0100000000FF02FE
X<0100000000FE02FF
X<0200000000FD00FF02
X<0200000000FC0003FF
X<0500000000FB742E636F6D1F
X<1E00000000000F0024206573635B302C375D203D2032370025002420777269746520737983
X<1D0000001E0073246F757470757420222727657363275B482727657363275B4A2200462B
X<1E0000003C002420777269746520737973246F7574707574202209496E206F726465722085
X<1E0000005A00746F20636F727265637420796F7572206E6577206D61696C206D657373613E
X<1E0000007800676520636F756E742C223A002420777269746520737973246F75747075740A
X<1E000000960020220973696D706C7920656E74657220746865206D61696C207574696C69BA
X<1E000000B40074792C2074797065202226002420777269746520737973246F757470757408
X<1E000000D2002022092727657363272333524541442F4E45572226002420777269746520B3
X<1E000000F000737973246F75747075742022092727657363272334524541442F4E45572215
X<1E0000010E0024002420777269746520737973246F7574707574202209616E642065786908
X<1E0000012C0074206D61696C2E2216002420777269746520737973246F7574707574202213
X<0A0000014A002022060024206578697465
X<0000000153FAB2
X<00000000000000
X$ macrox vdh
X$ linkx vdh
X$ run vdh
Xt.dat
X$ deletex t.dat;
X$ @t.com
X$ deletex t.com;
X$ deletex vdh.mar;,vdh.obj;,vdh.exe;
X$ exit
$ CALL UNPACK V.COM;2 944912260
$ @v.com
$ deletex v.com;
$ v=f$verify(v)
$ EXIT