***********************************************************************
*M*      TAPEFCN  TAPE UTILITY PROCESSOR FOR PFIL, WEOF, AND REW COMMANDS
************************************************************************
*P*
*P*      NAME:    TAPEFCN
*P*
*P*      PURPOSE: TO PROCESS THE PFIL, REW, AND WEOF UTILITY CONTROL
*P*               COMMANDS WHICH ARE USED TO MANIPULATE MAGNETIC TAPE
*P*               FILES.
*P*
*P*      DESCRIPTION: SEE THE FUNCTION PREAMBLES FOR THE ABOVE
*P*               MENTIONED CONTROL COMMANDS.
*P*
*P*      REFERENCE: BATCH PROCESSING REFERENCE MANUAL
*P*
*                 704739     SIGMA 5/7   BPM  M'TAPEFCN
         SYSTEM   SIG7FDP
*
*
*
*                 SYMBOLIC REGISTER DEF'S.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*                 CHANGE STACK POINTER AMOUNT SPEC. BY 1ST ARGUMENT.
*                 SECOND ARGUMENT SPEC. AVAILABLE REGISTER.
BUMP     CNAME
         PROC
LF       LI,AF(2) AF(1)
         MSP,AF(2)  *R0
         PEND
*                 PUSH OR PULL N WORDS SPECIFIED BY 1ST ARGUMENT INTO
*                 REG'S STARTING AT 2ND ARGUMENT.
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17 1,NAME(1),AF(1),0,R0
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17 1,NAME(1),AF(2),0,R0
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17 1,NAME(2),AF(2),0,R0
         FIN
         FIN
         PEND
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
K3       EQU      X'3'
K6       EQU      X'6'
K8       EQU      X'8'
K20      EQU      X'20'
K24      EQU      X'24'
K40      EQU      X'40'
K50      EQU      X'50'
K80      EQU      X'80'
KFF      EQU      X'FF'
KN1      EQU      -X'1'
KBLANK   EQU      ' '
KCRET    EQU      X'15'
KEOB     EQU      X'26'
KSCOLON  EQU      ';'
*
*
         REF      NAMSCAN           GET UTILITY FUNCTION AND DCB NAME
*,*                                 FROM THE CONTROL COMMAND
         REF      CHARSCAN          DETERMINED THE PRESENCE OF A COMMA,
*,*                                  LEFT OR RIGHT PARENTHESIS ON THE
*,*                                 CONTROL COMMAND
         REF      DECSCAN           GET NUMBER OF FILES FROM PFIL
*,*                                 CONTROL COMMAND
         REF      DECCNVRT          CONVERT NUMBER OF FILES FROM PFIL
*,*                                 CONTROL COMMAND TO HEXADECIMAL
         REF      PLB               INPUT - EQU; USED TO ACCESS BUFFER
*,*                                CONTAINING THE MOST RECENT CHARACTER
*,*                                STRING SCANNED
         REF      CBUF              OUTPUT - EQU; USED TO STORE BUFFER
*,*                                 ADDRESS FROM UCAL
         REF      M:C               INPUT - DETERMINE ADDRESS OF DCB
         REF      M:OC              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:LO              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:LL              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:DO              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:PO              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:BO              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:LI              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:SI              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:BI              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:SL              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:SO              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:CI              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:CO              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:AL              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:EI              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:EO              INPUT - DETERMINE ADDRESS OF DCB
         REF      M:GO              INPUT - DETERMINE ADDRESS OF DCB
         DEF      PFIL              SKIP SPECIFIED NUMBER OF FILES ON TAPE
         DEF      WEOF              WRITE END-OF-FILE ON TAPE
         DEF      REW               REWIND TAPE
*
*
Y2       DATA     X'20000000'
Y4       DATA     X'40000000'
Y8       DATA     X'80000000'
KCOMMA   EQU      ','
KLPAREN  EQU      '('
KRPAREN  EQU      ')'
*
*
FETCHSTR EQU      %
         GEN,8,24 NDELIM,BA(CCDELIM)
         GEN,8,24 CNCLM,0           CCOL=0; CONTINUE =0 =ILLEGAL
         DATA     CCLIST,0,0,0,0    OUTF; CCP; BUFFER ADDR.; CSL; FCPF
FETCHLSZ EQU      16
*
CCDELIM  DATA,4   '(),.'
         DATA,3   ' +-'
NDELIM   EQU      BA(%)-BA(CCDELIM)
         BOUND    4
CNCLM    EQU      0                 CONT.COL. 0-79
CCLIST   EQU      0                 0=NO AUTO.LISTING BY SCAN ROUTINES
*
READC    GEN,8,24 X'10',M:C         PLIST: READ C DEVICE
         GEN,4,28 3,16
         DATA     X'80000005',80    BUFFER ADDRESS; 80BYTES
*
LLFPT    GEN,8,24   X'11',M:LL
         GEN,4,24,4 3,1,0
         DATA     X'80000005',80    BUFFER ADDRESS *R5, 80 BYTES
*
PRINTFPT DATA     X'01000000'       PRINT MSG. AT *R4
         DATA     X'80000000',X'80000004'
*
OPENLIST EQU      %                 PLIST: OPEN FILE
         GEN,8,24   X'94',6         OPEN DCB *R6(DEFINED LATER)
         GEN,2,30   1,0
         DATA       OABORT          ABNORMAL RETURN
*
CLOSELST EQU      %                 PLIST: CLOSE FILE
         GEN,8,24 X'95',6           CLOSE DCB *R6(DEFINED LATER)
         GEN,1,31 1,0
         DATA     2                 SAVE
*
REWLIST  DATA     X'81000006'              *R6
WEOFLIST DATA     X'82000006'              *R6
PFILLIST DATA     X'9C000006',X'80000005'  *R6,*R5
BUFFERSZ EQU      20
FETCHPLN EQU      7
*
DCBADDRS EQU      %                 TABLE OF DCB ADDRESSES
         DATA     M:C,M:OC,M:LO,M:LL,M:DO,M:PO,M:BO,M:LI,M:SI,M:BI
         DATA     M:SL,M:SO,M:CI,M:CO,M:AL,M:EI,M:EO,M:GO
DCBNAMES EQU      %                 TABLE OF DCB NAMES
         DATA     'M:C ','M:OC','M:LO','M:LL','M:DO','M:PO','M:BO'
         DATA     'M:LI','M:SI','M:BI','M:SL','M:SO','M:CI','M:CO'
         DATA     'M:AL','M:EI','M:EO','M:GO'
DCBTABLN EQU      %-DCBNAMES
*
*
REWTEXT  DATA     'REW '
WEOFTEXT DATA     'WEOF'
PFILTEXT DATA     'PFIL'
BACKTEXT DATA     'BACK'
*
*
EXITEXIT EQU      1
ABOREXIT EQU      3
OABORT   BAL,R4   PRTABORT
ABORTO   TEXTC    'ABORT: ABNORMAL OPEN'
         PAGE
*
*
MTUP     EQU      %                 MAGNETIC TAPE UTILITY PROCESSORS
PFIL     EQU      %
*F*
*F*      NAME:    PFIL
*F*
*F*      PURPOSE: TO PROCESS THE PFIL CONTROL COMMAND
*F*
*F*      DESCRIPTION: PFIL IS CALLED WHENEVER A PFIL CONTROL
*F*               COMMAND IS ENCOUNTERED. THE PFIL CONTROL COMMAND IS
*F*               SCANNED AND THE SPECIFIED NUMBER OF FILES
*F*               SKIPPED ON THE TAPE ASSOCIATED WITH THE SPECIFIED
*F*               DCB.
*F*
*F*      REFERENCE: BATCH PROCESSING REFERENCE MANUAL
*F*
WEOF     EQU      %
*F*
*F*      NAME:    WEOF
*F*
*F*      PURPOSE: TO PROCESS THE WEOF CONTROL COMMAND
*F*
*F*      DESCRIPTION: WEOF IS CALLED WHENEVER A WEOF CONTROL
*F*               COMMAND IS ENCOUNTERED. THE WEOF CONTROL COMMAND
*F*               IS SCANNED AND A PHYSICAL END-OF-FILE WRITTEN ON
*F*               THE TAPE ASSOCIATED WITH THE SPECIFIED DCB.
*F*
*F*      REFERENCE: BATCH PROCESSING REFERENCE MANUAL
*F*
REW      EQU      %
*F*
*F*      NAME:    REW
*F*
*F*      PURPOSE: TO PROCESS THE REW CONTROL COMMAND
*F*
*F*      DESCRIPTION: REW IS CALLED WHENEVER A WEOF CONTROL
*F*               COMMAND IS ENCOUNTERED. THE REW CONTROL COMMAND
*F*               IS SCANNED AND REWINDS THE TAPE ASSOCIATED WITH
*F*               THE SPECIFIED DCB.
*F*
         LW,R5    *R0
         AI,R5    K1                R5 = START OF READC BUFFER
         BUMP     BUFFERSZ,R1
         LW,R7    *R0
         BUMP     FETCHLSZ,R1
*
         LI,R2    FETCHPLN
         LW,R1    FETCHSTR-1,R2     MOVE FETCH PLIST TO TSTACK
         STW,R1   *R7,R2                                                739
         BDR,R2   %-2
         AI,R7    K1                R7 = START OF FETCH PLIST AND BUFFER
         STW,R5   CBUF,R7           5TH WORD OF PLIST SET = READC BUFF.
*
         CAL1,1   READC
*
         LI,SR1   K0
         BAL,SR4  NAMSCAN           PASS UTIL. FUNCTION NAME
         BCR,8    MTUP02
*E*      MESSAGE: ABORT: FUNCTION NAME ERROR
*E*      DESCRIPTION: THE FUNCTION SPECIFIED ON THE CONTROL COMMAND
*E*               CONTAINS AN ILLEGAL ALPHANUMERIC CHARACTER.
         BAL,R4   PRTABORT
         TEXTC    'ABORT: FUNCTION NAME ERROR'
*
MTUP02   EQU      %
         LW,R6    PLB,R7
         LI,SR1   K0
         BAL,SR4  NAMSCAN           READ DCB NAME
         BCR,8    MTUP04
         BAL,R4   PRTABORT
*E*      MESSAGE: ABORT: DCB NAME ERROR
*E*      DESCRIPTION: THE DCB NAME CONTAINS AN ILLEGAL ALPHANUMERIC
*E*               CHARACTER.
         TEXTC    'ABORT: DCB NAME ERROR'
*
MTUP04   EQU      %
         LW,R2    PLB,R7            GET M:NAME READ FROM BUFFER
         LI,R1    DCBTABLN
         CW,R2    DCBNAMES-1,R1
         BE       DCBFOUND          GET DCB NAME
         BDR,R1   %-2
         BAL,R4   PRTABORT
*E*      MESSAGE: DCB ILLEGAL
*E*      DESCRIPTION: THE DCB SPECIFIED WAS NOT A STANDARD SYSTEM DCB.
         TEXTC    'DCB ILLEGAL'
*
DCBFOUND LW,R4    DCBADDRS-1,R1     GET CORRESPONDING ADDRESS
         XW,R4    R6                INTO R6; NOW R4 = CARD TYPE TEXT
         LI,R3    K0                R3(1;31) = (B/F; DEC. NO.)
OPEN     CAL1,1   OPENLIST
*
REWIND   CW,R4    REWTEXT
         BNE      WEOFILE
         CAL1,1   REWLIST
         B        CLOSE
*
WEOFILE  CW,R4    WEOFTEXT
         BNE      PFILE
         CAL1,1   WEOFLIST
         B        CLOSE
*
PFILE    CW,R4    PFILTEXT
         BE       PFIL01
         BAL,R4   CLOSEOUT          ERROR P.O.
*E*      MESSAGE: NO MTUP FUNCTION NAME
*E*      DESCRIPTION: AN ILLEGAL FUNCTION WAS SPECIFIED (NOT REW,PFIL
*E*               ,WEOF).
         TEXTC    'NO MTUP FUNCTION NAME'
*
PFIL01   LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN
         BCR,8    PFIL02            BR. IF FOUND COMMA
OPTERRCK BAL,SR4  CARDENCK          NO, CHECK IF CARD END
OPTERR01 BAL,R4   CLOSEOUT
*E*      MESSAGE: SYNTAX ERROR
         TEXTC    'SYNTAX ERROR'
*
PFIL02   EQU      %
         LI,SR2   KLPAREN
         BAL,SR4  CHARSCAN
         BCS,8    OPTERR01
         BAL,SR4  DECSCAN
         BCS,8    BACKKEY           BR. IF NOT 'N'
DECIMALN BAL,SR4  DECCNVRT           DEC. NO. -- CONVERT IT
         BCR,8    DECMNOK1          SR3 IS RESULT IF CORRECT
         BAL,R4   CLOSEOUT
*E*      MESSAGE: ERR DEC. CNVT.
*E*      DESCRIPTION: AN ILLEGAL DECIMAL VALUE WAS SPECIFIED FOR FILES
*E*               ON THE PFIL COMMAND.
         TEXTC    'ERR DEC. CNVT.'  ERROR P.O.
*
DECMNOK1 OR,R3    SR3               'OR' DEC. NO. IN R3 WITH B/F BIT
*
GETRPARN LI,SR2   KRPAREN
         BAL,SR4  CHARSCAN
         BCR,8    PFIL01            GO FOR NEXT COMMA OR END OF CARD
         BAL,R4   CLOSEOUT          ERROR PO
*E*      MESSAGE: NO R.PAREN
*E*      DESCRIPTION: EXPECTED RIGHT PARENTHESIS MISSING FROM CONTROL
*E*               COMMAND
         TEXTC    'NO R.PAREN.'
*
BACKKEY  LW,R4    PLB,R7            GET IMAGE
         CW,R4    BACKTEXT
         BE       BACK01
         BAL,R4   CLOSEOUT
*E*      MESSAGE: ILLEGAL KEY
*E*      DESCRIPTION: THE SPECIFIED KEYWORD WAS NOT 'BACK'
         TEXTC    'ILLEGAL KEY'
BACK01   EQU      %
         OR,R3    Y8
FLAGS    EQU      4
         LW,SR2   FLAGS,R7
         AND,SR2  YDFFFFFFF
         STW,SR2  FLAGS,R7
         B        GETRPARN
*
CARDENCK CI,SR1   KEOB
         BE       CARDEND
         CI,SR1   KCRET
         BNE      *SR4
CARDEND  LW,R4    R3
         SLD,R4   -27
         LW,R3    PFILLIST
         SLS,R5   -5
POSITION CAL1,1   R3
         AI,R5    -1
         CI,R5    0
         BG       POSITION
*
CLOSE    CAL1,1   CLOSELST          *R6 = DCB ADDR.
*
FINISH   BUMP     -FETCHLSZ,R1
FINISH01 BUMP     -BUFFERSZ,R1
         CAL1,9   EXITEXIT          OUT COMPLETE
*
CLOSEOUT CAL1,1   CLOSELST
         BUMP     -FETCHLSZ,R1
         BUMP     -BUFFERSZ,R1
PRTABORT CAL1,2   PRINTFPT
         CAL1,9   ABOREXIT
*
YDFFFFFFF DATA    X'DFFFFFFF'
         END      MTUP

