*                 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      ';'
*
*
         PAGE
 REF NAMSCAN,CHARSCAN,DECSCAN,DECCNVRT,PLB,CBUF
 REF M:C,M:OC,M:LO,M:LL,M:DO,M:PO,M:BO,M:LI,M:SI,M:BI
 REF M:SL,M:SO,M:CI,M:CO,M:AL,M:EI,M:EO,M:GO
 DEF MTUP,PFIL,WEOF,REW
*
*
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      %
WEOF     EQU      %
REW      EQU      %
         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
         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
         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
         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.
         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
         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
         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
         TEXTC    'NO R.PAREN.'
*
BACKKEY  LW,R4    PLB,R7            GET IMAGE
         CW,R4    BACKTEXT
         BE       BACK01
         BAL,R4   CLOSEOUT
         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

