PACK
          IDENT  PACK,PACK,PACK 
          ABS 
          SST 
          SYSCOM B1 
          ENTRY  PACK 
          ENTRY  RFL= 
          TITLE  PACK - PACK FILE TO ONE RECORD.
*COMMENT  PACK - PACK FILE TO ONE RECORD. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       PACK - PACK FILE TO ONE RECORD. 
*         W.T. SACKETT.  71/01/20.
          SPACE  4
***       PACK REMOVES ALL *EOR* AND *EOF* MARKS FROM A SPECIFIED FILE
*         AND COPIES IT AS ONE RECORD TO ANOTHER FILE.  IF NO THIRD 
*         PARAMETER IS SPECIFIED, THE READ IS FROM *BOI* TO *EOI*.
*         DIRECT ACCESS FILES MAY BE PACKED.  PACK(A) AND PACK(A,A) 
*         RETAIN FILE TYPES.  IN PACK(A,B), B REMAINS AS SPECIFIED
*         PRIOR TO THE PACK.
          SPACE  4,10 
***       THE COMMAND.
* 
*         PACK(IFILE,OFILE,NR)
* 
*         IFILE  NAME OF FILE TO BE PACKED. 
*         OFILE  NAME OF FILE TO RECEIVE PACKED DATA. 
*         NR     IF A THIRD PARAMETER IS SPECIFIED, IFILE IS NOT
*                REWOUND BEFORE THE PACK OCCURS.
*         PACK(A) = PACK(A,A).
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * PACK COMPLETE.* 
*         * PACK PARAMETER ERROR.* - NO FILE NAMES, NULL OUTPUT FILE
*           OR TOO MANY PARAMETERS. 
*         * INCORRECT INPUT FILE.* - ATTEMPT TO PACK INPUT FROM A 
*           FILE ASSIGNED TO A TIME-SHARING TERMINAL. 
          SPACE  4
          ORG    110B 
 PACK     SB1    1           (B1) = 1 
          SX6    SBUF        ENTER POINTER TO OUTPUT BUFFER 
          SA6    B0 
          SA1    ACTR        CHECK ARGUMENT COUNT 
          MX0    42          (X0) LEFT " 0 IF INDIRECT ACCESS INPUT FILE
          SB7    X1-1 
          NG     B7,ERR1     IF NO PARAMETERS 
          RETURN SCR,R
          SA3    ARGR        FIRST PARAMETER
          SA2    I
          BX5    X0*X3       (X5) = INPUT FILE NAME IF RENAME NEEDED
          ZR     X5,ERR1     IF NO INPUT FILE NAME
          BX6    -X0*X2 
          BX7    X5+X6
          SA7    A2 
          GT     B7,B1,PAC1  IF NO REWIND BEFORE PACK 
          REWIND I
 PAC1     ZR     B7,PAC2     IF ONE PARAMETER 
          SA1    A3+B1       NEXT PARAMETER 
          IX2    X1-X3
          ZR     X2,PAC2     IF PACK(A,A) 
          ZR     X1,ERR1     SECOND PARAMETER INDICATED BUT NULL
          SA2    SCR
          BX3    X0*X1
          BX1    -X0*X2 
          BX6    X3+X1
          MX5    0           (X5) = 0 IF TWO FILES SPECIFIED
          SA6    SCR
          SB7    B7-2 
          GE     B7,B1,ERR1  IF INCORRECT PARAMETER COUNT 
 PAC2     SA1    I           SET FILE NAME IN *FILINFO* BLOCK 
          SA2    FINB 
          BX1    X0*X1
          BX6    X1+X2
          SA6    A2 
          FILINFO  A2        GET FILE INFORMATION 
          SA1    FINB+1      CHECK FILE TYPE AND DEVICE TYPE
          MX0    -6 
          BX7    X7-X7       CLEAR RANDOM INDEX 
          BX2    -X0*X1 
          LX1    59-16
          SX0    X2-2        SET BACKCOPY FLAG FOR QUEUED FILE
          ZR     X0,PAC3     IF QUEUED FILE 
          SX0    X2-4        SET BACKCOPY FLAG FOR DIRECT ACCESS FILE 
          ZR     X0,PAC3     IF DIRECT ACCESS FILE
          NG     X1,ERR2     IF FILE TYPE *TT*
          LX1    59-15-59+16
          NG     X1,PAC3     IF FILE ON MASS STORAGE
          BX0    X0-X0       SET BACKCOPY FLAG FOR TAPE FILE
 PAC3     SA7    I+6
 PAC4     READEI I
 PAC5     READW  I,WBUF,WBUFL 
          NG     X1,PAC6     IF END OF INFORMATION
          WRITEW SCR,WBUF,WBUFL 
          EQ     PAC5        GO FINISH READ 
  
 PAC6     SB7    B6-WBUF
          WRITEW SCR,WBUF,B7
          WRITER X2 
          REWIND X2,R 
          ZR     X5,END      IF TWO DIFFERENT FILES 
          BX7    X5 
          SX2    I
          NZ     X0,PAC8     IF BACKCOPY NOT REQUIRED 
          SA3    PACA 
          NZ     X3,PAC7     IF BACKCOPY COMPLETE 
          SX6    B1 
          SA6    A3 
          REWIND X2,R 
          SA1    X2          SWITCH NAMES IN FET
          SA3    SCR
          BX6    X1 
          BX7    X3 
          SA6    A3 
          SA7    X2 
          REWIND A3,R 
          EQ     PAC4        COPY SCR TO I
  
 PAC7     RETURN  I          RETURN SCRATCH FILE
          EQ     END         END PACK 
  
 PAC8     SA7    SCR+6       SET FET FOR *LFM* RENAME 
          RECALL I
          STATUS I,P         GET FILE STATUS
          SA1    I+5         GET FNT ENTRY
          MX0    -6 
          BX0    -X0*X1 
          SX1    X0-NDST
          NZ     X1,PAC9     IF NOT *NO-AUTO-DROP* STATUS 
          SETFS  SCR,NAD     RESTORE *NAD* STATUS 
 PAC9     RENAME SCR
 END      MESSAGE (=C* PACK COMPLETE.*) 
          ENDRUN
  
 ERR1     MESSAGE (=C* PACK PARAMETER ERROR.*)
          ABORT 
  
 ERR2     MESSAGE (=C* INCORRECT INPUT FILE.*)
          ABORT 
  
 PACA     CON    0           BACKCOPY FLAG
  
 FINB     BSS    0           *FILINFO* PARAMETER BLOCK
          VFD    42/0,6/5,12/1
          BSSZ   4
          SPACE  4
*         COMMON DECKS. 
* 
*CALL     COMCCIO 
*CALL     COMCLFM 
*CALL     COMCRDW 
*CALL     COMCSYS 
*CALL     COMCWTW 
*CALL     COMCMAC 
*CALL     COMSLFD 
* 
*         FETS AND BUFFERS. 
 WBUFL    EQU    100B 
 BUFL     EQU    1001B
 I        RFILEB IBUF,BUFL,(FET=8),(WSA=WBUF,WBUFL) 
 SCR      RFILEB SBUF,BUFL,FET=8),(WSA=WBUF,WBUFL)
          USE    LITERALS 
 IBUF     EQU    *
 WBUF     EQU    IBUF+BUFL
 SBUF     EQU    WBUF+WBUFL 
 RFL=     EQU    SBUF+BUFL
          SPACE  4
          END 
