;  Program Pack 

;    Deletes extra blanks in a file to conserve space:
;       Initial blanks are removed,
;       Consecutive blanks are replaced by just one blank,
;       At most one trailing blank will be output.

;    Before this program can be run, the user must assign the
;       actual file or device names to Input: and Output:.
;       For example:
;         $ ASSIGN Sys$Input INPUT:
;         $ ASSIGN Packed.Dat OUTPUT:
;         $ RUN PACK

;  .... Declare files ....
InFAB:  $FAB    FNM = <Input:>    ; FAB for input
OutFAB: $FAB    FNM = <Output:>,- ; FAB for output
                RAT = CR          ;   use carriage return (and
                                  ;   line feed) after each line

;  .... Declare records ....
InRAB:  $RAB    FAB = InFAB, -    ; Associate InRAB with FAB
                UBF = InBuf, -    ;   specify buffer
                USZ = BufLen, -   ;   specify buffer length
                ROP = PMT, -      ;   prompt terminal user
                PBF = Prompt, -   ;   prompt buffer
                PSZ = PromptLen   ;   prompt length
OutRAB: $RAB    FAB = OutFAB, -   ; Associate OutRAB with FAB
                RBF = OutBuf      ;   specify buffer

;  .... Declare buffers ....
BufLen = 80
InBuf:  .BLKB   BufLen            ; Input buffer
OutBuf: .BLKB   BufLen            ; Output buffer
Prompt: .ASCII  'Enter string: '
PromptLen = . - Prompt            ; Calculate length of prompt


;  .... Begin main program ....

        .ENTRY   Pack, 0

;  .... Initialize files and records ....
        $OPEN    FAB = InFAB      ; Open input file
        BSBW     ErCheck
        $CREATE  FAB = OutFAB     ; Create output file
        BSBW     ErCheck
        $CONNECT RAB = InRAB      ; Connect input record
        BSBW     ErCheck
        $CONNECT RAB = OutRAB     ; Connect output record
        BSBW     ErCheck

;  .... Begin loop by getting record ....
NextRecord:
        $GET     RAB = InRAB      ; Input a record
        CMPL     R0, #RMS$_EOF    ; Check for end of file
        BNEQ     Cont             ;   and
        BRW      Done             ;   branch if finished
Cont:   BSBW     ErCheck          ; Check for other errors

;  .... Use subroutine to pack record into OutBuf and put its
;          length into R3 ....
        BSBW     PackRecord

;  .... Output packed record ....
        MOVW     R3, OutRAB+RAB$W_RSZ
                                  ; Move length to RSZ field
        $PUT     RAB = OutRAB
        BSBW     ErCheck

;  .... Repeat ....
        BRB      NextRecord

;  .... Finished, terminate run ....

Done:   $CLOSE   FAB = InFAB      ; Close input file
        BSBW     ErCheck
        $CLOSE   FAB = OutFAB     ; Close output file
        BSBW     ErCheck
        $EXIT_S


;  .... Subroutine to pack InBuf into OutBuf ....
;     (uses R0 to R5)

Blank = ^A" "

;  .... Initialize  (and specify register usage) ....
PackRecord:
        MOVAB    InBuf, R0        ; R0: address next char. in InBuf
        MOVAB    OutBuf, R1       ; R1: address next char. in OutBuf
        MOVW     InRAB+RAB$W_RSZ, R2
                                  ; R2: number char. left in InBuf
        CLRW     R3               ; R3: number char. in OutBuf
        MOVB     #Blank, R4       ; R4: last char. in OutBuf
                                  ;     (will skip initial blanks)
                                  ; R5: next char. in InBuf

;  .... Process next character in InBuf ....
NextChar:
        TSTW     R2               ; Any characters left?
        BLEQ     Return           ;   if not, terminate loop
        MOVB     (R0)+, R5        ; Get next character
        CMPB     R5, #Blank       ; Is it a blank?
        BNEQ     MoveChar         ;   if not, move it
        CMPB     R4, #Blank       ; Was last character also a blank?
        BEQL     Count            ;   if so, don't move it
MoveChar:
        MOVB     R5, (R1)+        ; Move character to OutBuf
        MOVB     R5, R4           ;   and save last character in R4
        INCW     R3               ; Increment count of char. in OutBuf

;  .... Get ready for next character ....
Count:  DECW     R2               ; Decrement char. count in InBuf
        BRB      NextChar         ; Repeat

;  .... Return ....
Return: RSB


;  .... Subroutine to check for errors ....

ErCheck:
        BLBC     R0, Stop         ; Terminate if error
        RSB                       ;   otherwise return
Stop:   $EXIT_S  R0               ; Error termination

        .End     Pack