OSTAPE   TITLE '...OS tape to CMS disk utility'
         MACRO
&NAME    $TXT  &MSG,&MSG2
         LCLC  &A,&B
&A       SETC  '&NAME'.'L'
&B       SETC  '*-'.'&NAME'.'-01'
&NAME    DC    AL1(&A)
         DC    C&MSG
&A        EQU   (&B)
         MEND
         SPACE 01
         MACRO
&NAME    $MSG  &MSG
         LCLC  &A
         AIF   ('&MSG' EQ '').BP00
&A       SETC  '&MSG'.'-'.'&SYSECT'
&NAME    LA    R15,&MSG                  ==> MESSAGE
.BP00    ANOP
         BAL   R14,LINEDIT             ISSUE MESSAGE
         MEND
         SPACE 01
         MACRO
&NAME    $CP   &MSG
         LCLC  &A
         AIF   ('&MSG' EQ '').BP00
&A       SETC  '&MSG'.'-'.'&SYSECT'
&NAME    LA    R15,&MSG                  ==> CP COMMAND
.BP00    ANOP
         BAL   R14,DIAG08              ISSUE CP COMMAND
         MEND
         SPACE 01
         MACRO
&NAME    $CMS  &MSG
         LCLC  &A
         AIF   ('&MSG' EQ '').BP00
&A       SETC  '&MSG'.'-'.'&SYSECT'
&NAME    LA    R1,&MSG                   ==> CMS COMMAND
.BP00    ANOP
         BAL   R14,SVC202                CALL CMS COMMAND
         MEND
         EJECT
*****
**         Columbia University Center for Computer Activities
**
**                          OSTAPE
**
**              Written by Eric M Bitterman on 10/31/84
**
**  This program will read thru an OS formatted tape and copy the
**  files on it to a CMS disk, based on the name in the HDR rec.
**
**  To copy this program from tape to a CMS disk, issue the following
**  commands:
**       TAPE REW
**       TAPE FSF
**       FILEDEF  INMOVE TAP1 (RECFM VB LRECL 13000 BLOCK 13000)
**       FILEDEF OUTMOVE DISK OSTAPE ASSEMBLE A (RECFM V LRECL 100)
**       MOVEFILE
**       COPYFILE OSTAPE ASSEMBLE A (RECFM F LRECL 80)
**
**  To generate this program just enter the following CMS commands:
**       ASSEMBLE OSTAPE
**       LOAD OSTAPE
**       GENMOD OSTAPE
**       NUCXLOAD OSTAPE
**
**  To install the files, the installation tape must be attached
**  as 181 and then just enter:  OSTAPE and away it goes.
**
**  The format of this command is:
**       OSTAPE    COPYALL              ( a b d y z )
**                 DUMP fn ft fm        ( a b d y )
**                 DVOL1                ( d e )
**                 GENEXEC fn ft fm     ( a b d )
**                 LOAD fn ft fm        ( b c d )
**                 MODESET              ( d )
**                 SCAN fn ft           ( b c d )
**                 tapcmd nn            ( d )
**                 WVOL1 volser owner   ( d e )
**
**  tapcmd    = BSR BSF ERG FSR FSF REW RUN WTM
**  nn        = number of times this function is to be issued
**  fn/ft/fm  = CMS filename, type and mode
**
**  Options
**  -------
**  a        WTM | NOWTM  BLKSIZE  {4096 | 800}
**  b        PRINT | NOPRINT  TERM  DISK
**  c        EOT  EOF nn
**  d        TAPn  DEN  density  cuu
**  e        REWIND  LEAVE
**  y        APPEND
**  z        INPUT  cuu  OUTPUT  cuu
**
*****
         EJECT
OSTAPE   CSECT
         USING OSTAPE,R12
         B     12(,R15)                SKIP AROUND LITERAL
         DC    CL8'OSTAPE'
         STM   R14,R12,12(R13)         SAVE ENTRY REGISTERS
         LA    R12,00(,R15)            FIX BASE REGISTER
         LA    R14,WORK                ==> OUR SAVE AREA
         USING WORK,R13
         ST    R13,04(,R14)            .....CHAIN BACKWARD
         ST    R14,08(,R13)            .....CHAIN FORWARD
         LR    R13,R14                 ==> OUR SAVE AREA
*****
**  Check for any options.
*****
CHK4OPT  DS   0H
         CLI   08(R1),X'FF'            ARE THERE ANY?
         BE    NOFUNC                  ..... No,  then load to disk
         LA    R15,TAPLIST-10          ==> LIST OF VALID FUNCTIONS
CHK4OPT1 DS   0H
         LA    R15,10(,R15)            BUMP TO NEXT ENTRY
         CLI   00(R15),X'FF'           END OF LIST?
         BE    BADFUNC                 .....YES,  THEN ERROR
         CLC   08(08,R1),00(R15)       MATCH?
         BNE   CHK4OPT1                ..... NO,  THEN CONTINUE
         LH    R15,08(,R15)            GET DISPL TO PROCESS RTN
         B     00(R15,R12)             GO PROCESS OPTION
$FUNC    DS   0H
         MVC   TAPECTL1,08(R1)         MOVE IN THE FUNCTION
         BAL   R14,TAPECOM             ISSUE TAPE COMMAND
         BNZ   BADTAPE                 ....., NG,  THEN ERROR$TXT
         B     RETURN                  DONE
         EJECT
$DUMP    DS   0H
$COPY    DS   0H
$DVOL    DS   0H
$GENX    DS   0H
$LOAD    DS   0H
$MODE    DS   0H
$SCAN    DS   0H
$WVOL    DS   0H
         $MSG  MSG999W                 WARN USER
         LA    R15,04                  SET RETURN CODE
         B     RETURN                  DONE
NOFUNC   DS   0H
*****
**  Rewind the tape to its loadpoint.
*****
         BAL   R14,TAPEREW             REWIND TAPE
         BNZ   BADTAPE                 ..... NG,  THEN ERROR MESSAGE
*****
**  Read thru the file looking for HDR1 records, extract the CMS
**  filename and then FSF the tape.
*****
READ     DS   0H
         BAL   R14,RDTAPE              READ NEXT TAPE RECORD
         BZ    NOTEOF                  .... OK,  SKIP
         CH    R15,=H'02'              WAS IT END OF TAPE?
         BNE   BADTAPE                 ..... NO,  THEN TAPE ERROR
         CLI   EOF,X'FF'               WAS LAST OPERATION EOF?
         BE    BADTAPE                 .....YES,  THEN DONE
         MVI   EOF,X'FF'               SET EOF FLAG
         B     READ
         EJECT
NOTEOF   DS   0H
         MVI   EOF,X'00'               INIT TO ZERO
         CLC   =C'HDR1',BUFFER
         BNE   READ                    ..... NO,  THEN CONTINUE
*****
**  This is the HDR1 now extract the CMS filename.
*****
         LA    R0,17                   MAX LENGTH TO SCAN
         LA    R1,BUFFER+04            ==> BEGIN OF FILEID
         LR    R2,R1                   .....AND HERE TOO
         LA    R3,FN                   ==> WHERE TO STASH VALUE
         LA    R4,02                   SET NUMBER OF FIELDS TO FIND
GETVAL   DS   0H
         MVC   00(08,R3),SPACE         INIT FIELD TO BLANKS
GETVAL1  DS   0H
         CLI   00(R1),C'.'             FOUND?
         BE    GETVAL2                 .....YES,  THEN SKIP
         CLI   00(R1),C' '             FOUND?
         BE    GETVAL2                 .....YES,  THEN SKIP
         LA    R1,01(,R1)              BUMP TO NEXT CHARACTER
         BCT   R0,GETVAL1              CONTINUE
GETVAL2  DS   0H
         LR    R15,R1                  COPY OVER
         SR    R15,R2                  CALC LENGTH OF DATA
         BCTR  R15,R0                  .....AND SET RELATIVE TO ZERO
         C     R15,=F'07'              IS FIELD LENGTH OK?
         BNH   *+08                    .....YES,  THEN SKIP
         L     R15,=F'07'              OTHERWISE SET TO MAX LENGTH
         LTR   R15,R15                 CHECK TO SEE THIS IS VALID
         BM    GETVAL3                 .... NG,  ITS < 00
         MVC   00(*-*,R3),00(R2)       *** EXECUTED INSTRUCTION ***
         EX    R15,*-06                MOVE IN VALUE
         B     GETVAL4
GETVAL3  DS   0H
         MVC   00(08,R3),=CL8'EMB'
GETVAL4  DS   0H
         LA    R1,01(,R1)              BUMP PAST THE DELIMETER
         LR    R2,R1                   .....AND COPY HERE
         LA    R3,08(,R3)              BUMP TO NEXT RESULT FIELD
         BCT   R4,GETVAL               CONTINUE
*****
**  Issue message giving name of this CMS file.
*****
         MVC   S1(08),FN               MOVE IN THE FILENAME
         MVC   S2(08),FT               .....FILETYPE
         MVC   S3(02),FM               .....AND THE FILEMODE
         $MSG  MSG101I                 ISSUE MESSAGE
         EJECT
*****
**  Read in the HDR2 record and extract the LRECL and BLKSIZE.
*****
         BAL   R14,RDTAPE              READ NEXT TAPE RECORD
         MVC   INLRECL(05),BUFFER+10   MOVE IN THE LRECL
         MVC   OUTLRECL(05),BUFFER+10  .....AND HERE TOO
         MVC   INBLOCK(05),BUFFER+05   MOVE IN THE BLOCKSIZE
*****
**  Now skip over any extra HDRx type records.
*****
         BAL   R14,TAPEFSF             FSF
*****
**  Issue the FILEDEF and MOVEFILE commands inorder to copy the
**  program on the tape over to a CMS disk.
*****
         $CMS  FINIS                   CLOSE ALL FILES
         $CMS  INMOVE                  DEFINE MOVEFILE INPUT
         $CMS  OUTMOVE                 DEFINE MOVEFILE OUTPUT
         $CMS  MOVEFILE                COPY DATA
         BNZ   NGMOVE
*****
**  Skip over the EOF file.
*****
         BAL   R14,TAPEFSF
         B     READ                    GET NEXT FILE
         EJECT
RDTAPE   DS   0H
         MVC   TAPECTL1,KREAD          SETUP TO DO READ
         LA    R1,BUFFER               ==> TAPE BUFFER
         STCM  R1,B'0111',TAPECTL4     .....AND SAVE BUFFER ADDR
         LA    R1,80                   GET BUFFER LENGTH
         ST    R1,TAPECTL5             .....AND SAVE IN PLIST
         ST    R14,SAVR14              SAVE RETURN ADDRESS
         BAL   R14,TAPECOM             ISSUE TAPEIO REQUEST
         L     R14,SAVR14              RESTORE RETUN ADDRESS
         L     R0,TAPECTL6             GET LENGTH OF DATA READ
         LTR   R15,R15                 SET CONDITION CODE
         BR    R14                     RETURN
NGMOVE   DS   0H
         LR    R2,R15                  SAVE RETURN CODE
         $MSG  MSG102E
         LR    R15,R2                  RESTORE RETURN CODE
         B     RETURN                  DONE
BADFUNC  DS   0H
         $MSG  MSG998E                 ISSUE ERROR MESSAGE
         LA    R15,04                  SET BAD RETURN CODE
         B     RETURN                  DONE
BADTAPE  DS   0H
         LR    R2,R15                  COPY RETURN CODE HERE
         SLL   R15,01                  MULTIPLY BY TWO
         LA    R15,TPERRS-02(R15)      ==> MESSAGE DISPLACEMENT
         LH    R15,00(,R15)            GET MESSAGE DISPLACEMENT
         AR    R15,R12                 ==>MESSAGE TEXT
         $MSG  ,
         LR    R15,R2                  RESTORE RETURN CODE
RETURN   DS   0H
         L     R13,04(,R13)            ==> PREV SAVE AREA
         L     R14,12(,R13)            RESTORE RETURN ADDRESS
         LM    R0,R12,20(R13)          .....AND THESE TOO
         BR    R14                     ALL DONE
TAPEFSF  DS   0H
         MVC   TAPECTL1,KFSF           FORWARD SPACE THE TAPE
         B     TAPECOM
TAPEREW  DS   0H
         MVC   TAPECTL1,KREW           REWIND TAPE TO LOAD POINT
TAPECOM  DS   0H
         LA    R1,TAPECTL              ==> TAPE PLIST
SVC202   DS   0H
         NOPR  R14
         SVC   202
         DC    AL4(01)
         LTR   R15,R15
         BR    R14
         EJECT
LINEDIT  DS   0H
       LINEDIT TEXTA=(R15),RENT=NO,DOT=NO,COMP=NO,DISP=ERRMSG,         X
               SUB=(CHARA,S1,CHARA,S2,CHARA,S3),                       X
               MF=(E,EDWORK)
         MVC   S1(SUBLEN),S1-01        SET TO BLANKS
         BR    R14                     RETURN
         EJECT
         LTORG
WORK     DC   9D'00'
SAVR14   DC    F'00'                   SAVE REGISTER R14 HERE
BUFFER   DC    CL80' '                 TAPE BUFFER
SPACE    DC    CL8' '
EOF      DC    X'00'
INMOVE   DS   0D
         DC    CL8'FILEDEF'
         DC    CL8'INMOVE'
         DC    CL8'TAP1'
         DC    CL8'('
         DC    CL8'RECFM'
         DC    CL8'VB'
         DC    CL8'LRECL'
INLRECL  DC    CL8'200'
         DC    CL8'BLOCK'
INBLOCK  DC    CL8'4000'
         DC   8X'FF'
OUTMOVE  DS   0D
         DC    CL8'FILEDEF'
         DC    CL8'OUTMOVE'
         DC    CL8'DISK'
FN       DC    CL8'        '
FT       DC    CL8'        '
FM       DC    CL8'A1      '
         DC    CL8'('
         DC    CL8'RECFM'
         DC    CL8'VB'
         DC    CL8'LRECL'
OUTLRECL DC    CL8'300'
         DC   8X'FF'
FINIS    DS   0D
         DC    CL8'FINIS'
         DC    CL8'*'
         DC    CL8'*'
         DC    CL8'*'
         DC   8X'FF'
MOVEFILE DS   0D
         DC    CL8'MOVEFILE'
         DC   8X'FF'
         EJECT
*****
**  TAPEIO plist.
*****
TAPECTL  DS   0D
         DC    CL8'TAPEIO'
TAPECTL1 DC    CL8'FSF'                FUNCTION
TAPECTL2 DC    CL4'0181'               DEVICE ADDRESS
TAPECTL3 DC    BL1'0'                  MODE
TAPECTL4 DC    AL3(00)                 BUFFER ADDRESS
TAPECTL5 DC    F'00'                   BUFFER LENGTH
TAPECTL6 DC    F'00'                   NUMBE OF BYTES READ
         DC   8X'FF'
TAPLIST  DS   0D
*****
**  Standalone functions.
*****
KREW     DC    CL8'REW     ',AL2($FUNC-OSTAPE)
         DC    CL8'RUN     ',AL2($FUNC-OSTAPE)
         DC    CL8'ERG     ',AL2($FUNC-OSTAPE)
         DC    CL8'BSR     ',AL2($FUNC-OSTAPE)
         DC    CL8'BSF     ',AL2($FUNC-OSTAPE)
         DC    CL8'FSR     ',AL2($FUNC-OSTAPE)
KFSF     DC    CL8'FSF     ',AL2($FUNC-OSTAPE)
         DC    CL8'WTM     ',AL2($FUNC-OSTAPE)
*****
**  Hi level functions.
*****
         DC    CL8'DUMP    ',AL2($DUMP-OSTAPE)
         DC    CL8'COPYALL ',AL2($COPY-OSTAPE)
         DC    CL8'DVOL1   ',AL2($DVOL-OSTAPE)
         DC    CL8'GENEXEC ',AL2($GENX-OSTAPE)
         DC    CL8'LOAD    ',AL2($LOAD-OSTAPE)
         DC    CL8'MODESET ',AL2($MODE-OSTAPE)
         DC    CL8'SCAN    ',AL2($SCAN-OSTAPE)
         DC    CL8'WVOL1   ',AL2($WVOL-OSTAPE)
         DC   2X'FF'
KREAD    DC    CL8'READ'
TPERRS   DS   0H
         DC    AL2(MSG204I-OSTAPE)    RC=01
         DC    AL2(MSG205I-OSTAPE)    RC=02
         DC    AL2(MSG206I-OSTAPE)    RC=03
         DC    AL2(MSG207I-OSTAPE)    RC=04
         DC    AL2(MSG208I-OSTAPE)    RC=05
         DC    AL2(MSG209I-OSTAPE)    RC=06
         DC    AL2(00)                Place holder
         DC    AL2(MSG210I-OSTAPE)    RC=08
         EJECT
         DC    C' '
S1       DC    CL8' '
S2       DC    CL8' '
S3       DC    CL8' '
SUBLEN    EQU   (*-S1)
EDWORK LINEDIT MF=L,MAXSUBS=03
MSG101I  $TXT  '........ ........ ..'
MSG102E  $TXT  'MOVEFILE terminated with a non-zero return code'
MSG204I  $TXT  'Invalid function or parameter list'
MSG205I  $TXT  'END-OF-FILE or END-OF-TAPE encountered'
MSG206I  $TXT  'Permanent I/O error'
MSG207I  $TXT  'Illegal device id specified'
MSG208I  $TXT  'Tape not attached'
MSG209I  $TXT  'Tape is file protected'
MSG210I  $TXT  'Incorrect length'
MSG998E  $TXT  'Invalid or omitted OSTAPE function'
MSG999W  $TXT  'Function not implemented'
         PRINT NOGEN
        REGEQU ,
         END