*DECK     COPYWS - COPY *W* SECTIONS TO *S* RECORDS.
          IDENT  COPYWS,RA.ORG+1,COPYWS 
          ABS 
          B1=1
          TITLE  COPYWS - COPY *W* SECTIONS TO *S* RECORDS. 
          COMMENT  COPY *W* SECTIONS TO *S* RECORDS.
 RA.ARG   EQU    2           CONTROL CARD ARGUMENTS 
 RA.ACT   EQU    64B         ARGUMENT COUNT 
 RA.ORG   EQU    100B        ABSOLUTE PROGRAM ORIGIN
          ORG    RA.ORG+1 
 COPYWS   SPACE  4,8
***       COPYWS - COPY *W* SECTIONS TO *S* RECORDS.
* 
*         R. H. GOODELL.     72/02/03.
* 
*         CONTROL DATA  PROPRIETARY PRODUCT.
*         COPYRIGHT CONTROL DATA CORP. 1972.
 COPYWS   SPACE  4,8
***              *COPYWS* COPIES A FILE IN *W* RECORD FORMAT  TO
*         A  FILE  IN  *S*  RECORD  FORMAT.  ORDINARY *W* RECORD
*         BOUNDARIES ARE ELIDED, END OF SECTION BECOMES  END  OF
*         SCOPE  LOGICAL  RECORD (LEVEL 0), AND END OF PARTITION
*         BECOMES A SCOPE END OF FILE (LEVEL 17).  COPYING STOPS
*         AT END OF INFORMATION.  NEITHER FILE IS REWOUND BEFORE
*         OR AFTER COPYING.  *COPYWS* RUNS UNDER SCOPE 2.0 ONLY.
 COPYWS   SPACE  4,8
***       CONTROL CARD CALL.
* 
*         COPYWS(FROM,TO).
* 
*         FROM   NAME OF FILE TO BE READ, DEFAULT IS *LGO*. 
*         TO     NAME OF FILE TO BE WRITTEN, DEFAULT IS *NEW*.
 COPYWS   SPACE  4,8
**        FILE INFORMATION TABLES.
  
  
 LGO      FILE   BT=,RT=W,MRL=40000,OF=N,CF=N,CM=NO,WSA=BUF 
 NEW      FILE   BT=C,RT=S,MBL=40000,OF=N,CF=N,CM=NO,WSA=BUF
 COPYWS   TITLE  MAIN PROGRAM.
**        COPYWS - MAIN PROGRAM.
  
  
 COPYWS   SB1    1           (B1) = CONSTANT 1
          RJ     PRS         PRESET PROGRAM 
          RJ     ARG         PROCESS ARGUMENTS
          OPENM  LGO,INPUT,N OPEN FILES 
          OPENM  NEW,OUTPUT,N 
          MX3    0           CLEAR RECORD LENGTH
  
*         MAIN LOOP.
  
 CWS1     GET    LGO         READ DATA
          FETCH  LGO,RL,X1
          FETCH  LGO,FP,X2
          ZR,X1  CWS2        IF NO DATA 
          PUTP   NEW,BUF,X1  WRITE DATA 
 CWS2     SX0    #EOP#+#EOI#
          BX6    X0*X2
          IX3    X3+X1       ACCUMULATE RECORD LENGTH 
          NZ,X6  CWS3        IF END OF PARTITION OR INFORMATION 
          SX0    #EOS#
          BX6    X0*X2
          ZR,X6  CWS1        IF NOT END OF SECTION, LOOP
          MX3    0           CLEAR RECORD LENGTH
          WEOR   NEW         TERMINATE SCOPE LOGICAL RECORD 
          JP     CWS1        LOOP 
 CWS3     ZR,X3  CWS4        IF NO DATA PRECEDING EOP/EOI 
          MX3    0           CLEAR NEXT RECORD LENGTH 
          WEOR   NEW         TERMINATE SCOPE LOGICAL RECORD 
 CWS4     SX0    #EOI#
          BX6    X0*X2
          NZ,X6  CWS5        IF END OF INFORMATION
          ENDFILE NEW        WRITE END OF FILE (LEVEL 17) 
          JP     CWS1        LOOP 
  
*         END OF INFORMATION. 
  
 CWS5     CLOSEM LGO         CLOSE FILES
          CLOSEM NEW
          MESSAGE (=C* COPYWS COMPLETE.*) 
          ENDRUN
 COPYWS   TITLE  SUBROUTINES. 
 ARG      SPACE  4,8
**        ARG - PROCESS CONTROL CARD ARGUMENTS. 
  
  
 ARG      EQ     *+1S17      RETURN EXIT
 ARGX     EQU    *
          SA1    RA.ACT      GET ARGUMENT COUNT 
          SB7    X1 
          MX0    42 
          ZR,B7  ARGX        IF NO ARGUMENTS
          SA1    RA.ARG 
          BX6    X0*X1       GET INPUT FILE NAME
          SB7    B7-B1
          ZR,X6  ARG1        IF OMITTED 
          SA6    LGO
 ARG1     ZR,B7  ARGX        IF END OF ARGUMENTS
          SA1    A1+B1
          BX6    X0*X1       GET OUTPUT FILE NAME 
          SB7    B7-B1
          ZR,X6  ARG2        IF OMITTED 
          SA6    NEW
 ARG2     ZR,B7  ARGX        IF END OF ARGUMENTS
          MESSAGE (=C* COPYWS CONTROL CARD ERROR.*) 
          ABORT 
 PRS      SPACE  4,8
**        PRS - PRESET PROGRAM. 
* 
*         ENTRY  (A0) = SCM FIELD LENGTH. 
*         EXIT   FIELD LENGTH INCREASED IF NECESSARY. 
  
  
 PRS      EQ     *+1S17      RETURN EXIT
 PRSX     EQU    *
          SB7    A0-END-8    CHECK FIELD LENGTH 
          PL,B7  PRSX        IF ENOUGH
          MEMORY SCM,PRSA    INCREASE FIELD LENGTH
          JP     PRSX        RETURN 
  
 PRSA     VFD    30/END/1S6*1S6,30/0   MINIMUM FIELD LENGTH REQUEST 
 BUF      SPACE  4,8
**        BUF - WORKING STORAGE AREA. 
  
  
          USE    BUF         FORCE LITERALS OUT 
 BUF      BSS    0           ALLOW ENOUGH ROOM FOR 4000 WORDS 
 END      EQU    *+4000+8+77B PLUS SLOP PLUS ROUNDING 
  
  
          END    COPYWS 
