*UPDATED 10/26/71 AR #6129
*
*
* TERMINAL BATCH ENTRY SUBSYSTEM CONTROLS THE INSERTION OF TERMINAL
* JOBS INTO THE BATCH QUEUE OF A SYMBIONT UTS SYSTEM.
*
* PROGRAMMER- R. ALLAN RAMACHER.
*
*** THIS PROGRAM HAS BEEN MODIFIED TO ALLOW FIELD
*** AND STRING SUBSTITUTION AS FILE(S) IS READ.
*** ALL ADDITIONS ARE FLAGGED BY COMMENT CARDS
*** PRECEDED BY '***'     RICK SINATRA
***
*
*        LINKING COMMAND TO PRODUCE LM
         SPACE
*LINK (NP)(J0) XBATCHBO,BATCHBO,ERRMSGE.:C01BO ON XBATCH
         TITLE    'TERMINAL BATCH ENTRY SUBSYSTEM'
*
*
         SYSTEM SIG7
         SYSTEM      BPM
BATCHD   CSECT    0
         DEF      BATCHD
BATCHPP  CSECT    1
         DEF      BATCHPP
F:BATCH  DSECT    1
F:BATCH  M:DCB    (FILE),(DEVICE,'LO')
         ORG,1    BA(F:BATCH)+3     CHANGE DCB TO DEVICE
         GEN,8    3
         USECT    BATCHPP
         OPEN     PLOC,ULOC,USECT
ULOC     SET      %
BATCHTX  CSECT    1
         DEF      BATCHTX
PLOC     SET      %
         ORG      ULOC
USECT    CNAME
         PROC
LF       SET      %
         ORG      AF
         PEND
BAR      FNAME
         PROC
         PEND     AF**2
TYPE     CNAME
         PROC
LF(1)    CAL1,1   PLOC
ULOC     USECT    PLOC
         LIST     0
         GEN,8,7,17 X'11',,F:BATCH
         DATA     X'34000000'
         GEN,15,17 0,%+3
         DATA     S:NUMC(AF)
         DATA     0                 BTD=0
         TEXT     AF
PLOC     USECT    ULOC
         LIST     1
         PEND
PUSH     CNAME    X'09',X'0B'
PULL     CNAME    X'08',X'0A'
         PROC
         DO       NUM(AF)=1
LF       GEN,8,4,3,17 NAME(1),AF(1),,TSTACK
         ELSE
         DO       AF(1)=1
LF       GEN,8,4,3,17 NAME(1),AF(2),,TSTACK
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,8,4,3,17 NAME(2),AF(2),,TSTACK
         FIN
         FIN
         PEND
CALL     CNAME
         PROC
         LOCAL    I
LF       BAL,15   AF(1)
I        DO       NUM(AF(2))
         DATA     AF(2,I)
         FIN
         PEND
RETURN   CNAME
         PROC
LF       B        *15
         PEND
         CLOSE    PLOC,ULOC,USECT
BIL      COM,1,7,4,3,17 AFA,X'68',9,AF(2),AF(1)
BOL      COM,1,7,4,3,17 AFA,X'69',9,AF(2),AF(1)
BQEZ     COM,1,7,4,3,17 AFA,X'68',3,AF(2),AF(1)
DEBUG    EQU      1
REAL     EQU      0
         DO       REAL
         OPEN     CMD,TXC,R
CMD      EQU      'BATCH ALLAN'
TXC      SET      S:NUMC(S:UT(CMD))
R        SET      TXC-TXC/4*4
J:CCBUF  TEXT     CMD
         RES,1    (R-4)*(R>0)
         DATA,1   X'15'
         BOUND    4
J:PUF    GEN,8,8,16  TXC+1,6,0
         ELSE
         REF      J:CCBUF
         REF      J:PUF
         CLOSE    CMD,TXC,R
         FIN
         REF      M:EI              M:OPEN, M:READ AND M:CLOSE DCB
         REF      M:BO
         REF      JB:PRIV
         REF      J:ABC
         REF      J:JIT
         REF      J:ACCN
J:UNAME  EQU      AM+9
         REF      ERRMSGE
         REF      MODE              1=GHOST,0=NONGHOST
***
*** REF/DEF FOR FIELD AND STRING REPLACEMENT MODIFICATION
***
         DEF      READREC,BINCDS,CARD,ARG,TELARS,ALTBACK
         DEF      FLAG,ABNADD,PRIOR
         REF      EXSW,ALTREAD
         REF      MOD1,MOD2,ABORT,BATDUN,COMMAND
         REF      TYPSET            'T' OPTION SW
***
***      END OF MODIFICATION
***
         PCC      0
         TITLE    'SYMBOLIC EQUS FOR GENERAL REGISTERS'
*
*
R        EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
         TITLE    'ERROR MESSAGES AND DIAGNOSICS'
*
IDTEXT   TEXT     ' 
ID=     SUBMITTED '
JOBWTTXT TEXT     'WAITING:    TO RUN'
         RES,1    -2
         DATA,1   X'15'
TJOB     TEXT     '  . TERMINAL JOB'
EH@      TEXT     'EH? @   '
         TITLE    'STATIC DATA'
*
         USECT    BATCHD
STKSZ    EQU      16
         BOUND    8
TSTACK   GEN,15,17 0,STACK-1
         GEN,16,16 STKSZ,0
STACK    RES      STKSZ
AM       RES,1    22*4
CONTROL  RES      1
CARD     RES,1    500               *** BIG CARD BUFFER
SYMB     RES      256
ARS      RES      1
RCCDS    RES      1
PRIOR    RES      1
POINT    RES      1
PRIORBCD RES      1
ARG      RES      1
FLAG     RES      1
TELARS   RES      1
WHICH    DATA     0                 ***
ACCNC    DATA     0                 HOLDS ACCN LENGTH
ACCNL    DATA     0
         USECT    BATCHPP
*
*
CCS      EQU      %-1               TABLE OF CONTROL COMMAND OPTIONS
         TEXT     '!JOB'
         TEXT     '!BIN'
         TEXT     '!FIN'
         TEXT     '!EOD'
NCCS     EQU      %-CCS             TABLE SIZE
         PAGE
         BOUND    8
F0F9     DATA     '0','9'
C1C6     DATA     'A','F'
BLNKCARD GEN,8,5,19 79,,BA(CARD)+1
DLMTS    RES      0
         DATA,1   0
         DATA,1   ','
         DATA,1   '.'
         DATA,1   ';'
         DATA,1   '('
         DATA,1   ')'
         DATA,1   '-'
#DLMTS   EQU      BA(%)-BA(DLMTS)-1
*
BLANK    DATA,1   X'40'
         BOUND    4
*
BINCDS   EQU      %
         DATA,1   0                 FILLER
         DATA,1   X'38'             COMPRESSED
         DATA,1   X'18'             LAST COMPRESSED
         DATA,1   X'3C'             BINARY
         DATA,1   X'1C'             LAST BINARY
         BOUND    4
*
BCDRCC   GEN,16,8,8 80,0,1
EODRCC   GEN,16,8,8 80,1,1
BINRCC   GEN,16,8,8 108,2,1
*
HEX      TEXT     '0123456789ABCDEF'
LBE      TEXT     'LBE     '
WHO      DATA     J:UNAME+3,LBE+3   ***
***
         TITLE    'LIMIT OPTION PARAMETER TABLES'
* OPEN FILE P-LIST
*
OPENFILE GEN,8,7,17 X'14',0,M:EI
         DATA     X'47000209'       WORDS 2,6,7,8 & FLAGS 3,9,12
         DATA     ABNADD            OPEN ABNORMAL ADDRESS
         DATA     1                 CONSECUTIVE ORGANIZATION
         DATA     1                 SEQUENTIAL ACCESS
         DATA     1                 IN MODE
*
* READ FILE P-LIST
*
READFILE GEN,8,7,17 X'10',0,M:EI
***
*** THE P-LIST HAS BEEN CHANGED TO INSURE THAT BTD=0
***
         DATA     X'F4000000'       WORDS 1,2,3,4,6
***
         DATA     ABNADD            READ ERROR ADDRESS
         DATA     ABNREAD           READ ABNORMAL ADDRESS
         DATA     CARD
         DATA     120
         DATA     0                 *** BTD=0
*
* CLOSE FILE P-LIST
*
CLOSFILE GEN,8,7,17 X'15',0,M:EI
         DATA     X'80000000'       WORD 2
         DATA     2                 SAVE FILE
*
* GET PAGE P-LIST
*
GETPAGE  GEN,8,7,17 X'08',0,1
*
* FREE PAGE P-LIST
*
FREEPAGE GEN,8,7,17 X'09',0,1
*
READAM   GEN,8,7,17 X'2D',,M:BO
         DATA     X'30000000'
         DATA     AM
         DATA     22*4
         PAGE
*
* BATCH P-LIST
*
*
BATCH    GEN,8,7,17 X'2F',0,M:BO
         DATA     X'F0000000'       WORDS 1,2,3 & 4
         DATA     ABNADD            ABNORMAL ADDRESS
         DATA     SYMB
         DATA     1                 FUNCTION IS INPUT
         PZE      *R10              PRIORITY/LAST FLAG
*
* STATUS CHECK P-LIST
*
JOBSTAT  GEN,8,7,17 X'2F',0,M:BO
         DATA     0
* OUTPUT P-LIST
*
OUTLIST  GEN,8,7,17 X'11',,F:BATCH
         DATA     X'34000000'       WORDS 3,4,6
         PZE      *R2               BUFFER ADDRESS
         PZE      *R1               BUFFER SIZE
         DATA     1                 BYTE DISPLACEMENT
*
CMDMSG   GEN,8,7,17 X'11',,F:BATCH
         DATA     X'34000000'
         DATA     CARD              **
         PZE      *ARS
         DATA     0                 BTD=0
*
MSG      GEN,8,7,17 X'11',,F:BATCH
         DATA     X'34000000'
         PZE      *R14
         PZE      *R1
         DATA     0                 BTD=0
*
WRITERR  EQU      %
         GEN,8,24 X'11',F:BATCH
         DATA     X'34000000'
         PZE      *R3
         PZE      *R4
         DATA     0                 BTD=0
         TITLE    'SYMBOLIC PAGE DISPLACEMENTS'
*
OPEN     EQU      0                 OPEN CAL FPT
TDFPT    EQU      400               TIME AND DATE FPT
ID       EQU      401               USER ID
TIMEDATE EQU      406
STATUS   EQU      430
EHMSG    EQU      440
         TITLE    'OPEN EDIT FILE AND READ A RECORD'
*
START    EQU      %
         M:OPEN   F:BATCH,(OUT),(SAVE)
         CAL1,8   GETPAGE           PAGE ADDRESS IS RETURNED IN R9
         LW,R7    R9                PUT ADDRESS IN AN INDEX REGISTER
         LB,R     J:JIT
         CI,R     X'80'
         BANZ     NOLINE
         LI,R3    79
         LB,R     J:CCBUF,R3
         CI,R     ' '
         BNE      %+2
         BDR,R3   %-3
         AI,R3    1
         B        START1
NOLINE   EQU      %
         LB,R3    J:PUF
         AI,R3    -1                DROP CR
START1   EQU      %
         LI,R1    0
         LB,R     J:CCBUF,R1
         AI,R1    1
         CI,R     ' '
         BE       %-3
         AI,R1    5
***
*** MODIFICATION TO BAL TO REPLACEMENT ROUTINE.
*** THE BATCH COMMAND WITH POSSIBLE REPLACEMENT
*** REQUESTS IS IN J:CCBUF WITH R3 POINTING TO END.
*** MOD1 MOVES THE DATA IN J:CCBUF INTO 'COMMAND' AND
*** HANDLES ANY CONTINUATIONS. R3 IS MODIFIED. WHEN MOD1
*** RETURNS, R3 POINTS AT LAST CHARACTER OF LAST FILE NAME
***
***
         BAL,15   MOD1
***
         STW,R1   ARG
         SW,R3    R1
         BLZ      BWHAT
         STW,R3   TELARS
RESTART   EQU     %
         LI,R     -1                JOB SWITCH IS USED FOR FILES
         STW,R    FLAG
         STW,R    PRIOR
         LW,R1    R7                GET PAGE ADDRESS
         AI,R1    OPEN+7            ADD DISPLACEMENT TO OPEN CAL FPT
         SLS,R1   2                 MAKE BYTE
         OR,R1    =X'38000000'      BLANK OPEN CAL VARIABLE LENGTH
         MBS,R    BA(BLANK)         PARAMETER ENTRY AREA
         LCI      6
         LM,R     OPENFILE          OPEN CAL FIXED LENGTH PARAMETERS
         STM,R    OPEN,R7           ARE TRANSFERED TO PAGE
         LW,R     =X'01000808'      GET CONTROL WORD FOR FID
         STW,R    OPEN+6,R7         APPEND TO FIXED LENGTH PARAMETERS
         LW,R     =X'02000202'      GET CONTROL WORD FOR ACCOUNT
         STW,R    OPEN+15,R7        APPEND TO FIXED LENGTH PARAMETERS
         LW,R     =X'03010202'      GET CONTROL WORD FOR PASSWORD
         STW,R    OPEN+18,R7        APPEND TO FIXED LENGTH PARAMETERS
         LW,R1    ARG
         LI,R2    OPEN+7            GET DISPLACEMENT TO FILE NAME ENTRY
         LW,R4    R7                GET PAGE ADDRESS
         AI,R4    OPEN+7            ADD DISPLACEMENT TO FILE NAME ENTRY
         LW,R3    R7                GET PAGE ADDRESS
         SLS,R3   2                 MAKE BYTE INDEX
         STW,R3   R6                SAVE IT
         AI,R3    1                 SAVE BYTE FOR TEXTC FORMAT
         LI,R5    11
         LI,R     0
         STB,R    *R4               ZERO BYTE COUNT
         BAL,R15  TELSCAN           GET FILE NAME
         B        OPENCAL+3
         LW,R3    R6                RESTORE BYTE INDEX
         AI,R2    9                 ADD POINTER TO ACCOUNT ENTRY
         AI,R4    14                ADD POINTER TO DUMMY LOCATION
         LI,R5    8                 MAXIMUM ACCOUNT 8 CHACACTERS
         LI,R     0
         STB,R    *R4               ZERO BYTE COUNT
         BAL,R15  TELSCAN           GET ACCOUNT
         B        OPENCAL+6
         LW,R3    R6                RESTORE BYTE INDEX
         AI,R2    3                 ADD POINTER TO PASSWORD ENTRY
         AI,R4    1                 ANOTHER DUMMY LOCATION
         LI,R5    8                 MAXIMUM PASSWORD 8 CHARACTERS
         LI,R     0
         STB,R    *R4               ZERO BYTE COUNT
         BAL,R15  TELSCAN           GET PASSWORD
         B        OPENCAL
         B        SYNTAXTL
OPENCAL  EQU      %
         AI,R4    -1                DROP BACK TO EXAMINE ACCOUNT
         MTB,0    *R4               ACCOUNT PRESENT IN COMMAND LINE
         BNEZ     %+4
         LCI      2
         LM,R     J:ACCN            NO-USE LOG ON ACCT
         STM,R    OPEN+16,R7
         CAL1,1   OPEN,R7           M:OPEN
         LI,R11   MSJBCC            ERROR ADDRESS FOR MISSING JOB CMD
READREC  EQU      %
         LW,R14   EXSW              READ WHICH FILE?
         BNEZ     ALTREAD           F:ALT
         CAL1,1   READFILE          M:READ
         LI,R14   CARD
         LH,R1    M:EI+4            GET ARS ***
         SLS,R1   -1
ALTBACK  EQU      %                 RETURN HERE AFTER READ
         STW,R1   ARS
         AI,R1    -1
         LB,R5    CARD,R1
*ELIMINATE CONTROL CHARACTERS AT END OF LINE
         CI,R5    X'40'
         BG       %+4
         LI,R5    ' '
         STB,R5   CARD,R1
         MTW,-1   ARS
***
*** MODIFICATION TO BATCH TO BAL TO MOD2 WHERE INPUT
*** ITEM FROM USER'S FILE IS EXAMINED FOR SPECIAL
*** COMMANDS (DEFAULT,EOF,ETC) WHICH ARE ABSORBED
*** WITH A RETURN TO READREC.  DATA IMAGES FROM THE
*** FILE ARE PROCESSED BY THE REPLACEMENT ROUTINE AND
*** THE IMAGE IS RETURNED WITH THE LENGTH CORRECTED
*** AND BATCH SHOULD NEVER KNOW THE DIFFERENCE.
***
         DEF      ARS               RECORD LENGTH
         BAL,15   MOD2
         LI,R6    1
         LB,R5    CARD
         CI,R5    '!'               CONTROL COMMAND
         BE       DENSE
         LI,R2    4
         CB,R5    BINCDS,R2
         BE       *R11
         BDR,R2   %-2
         LI,R6    0
DENSE    EQU      %
         LI,R2    80
***
*** FOLLOWING INSTRUCTION CHANGED FROM M:EI+13 TO ARS
***
         SW,R2    ARS               ***
         BEZ      NOFILL
         BLZ      LOSTDATA
         LI,R1    BA(CARD)
***
*** THE ADDRESS OF THE FOLLOWING INSTRUCTION HAS
*** BEEN CHANGED FROM M:EI+13 TO ARS SINCE ARS
*** IS MODIFIED IN THE EXTERNAL MODIFICATION ROUTINE
*** TO REFLECT THE RECORD SIZE AFTER EXPANSION OR
*** CONTRACTION.
***
         AW,R1    ARS               ***
***
         STB,R2   R1
         MBS,R    BA(BLANK)
NOFILL   EQU      %
         CI,R6    0
         BE       *R11
         LI,R2    4
         LI,R1    0
DENSE1   EQU      %
         LB,R5    *R14,R1
         AI,R1    1
         CI,R5    ' '
         BE       DENSE1
         STB,R5   R4
         SCS,R4   8
         BDR,R2   DENSE1
         STW,R1   POINT
         LB,R     *R14,R1
         CI,R     ' '               BLANK
         BE       %+2               IF 4TH CHAR IS BLANK,OK
         LI,R4    0                 CLOBBER R4 SO FOLLOWING
*                                   CHECK FAILS
*  THIS ALLOWS BANG CARDS WHOSE FIRST THREE CHARACTERS
*  ARE 'BIN', 'EOD' ETC.
         TITLE    'CONTROL COMMAND HANDLER'
* THIS ROUTINE DETERMINES IF A GIVEN INPUT RECORD
* IS A CONTROL COMMAND. IF A CONTROL COMMAND IS FOUND,
* A CORRESPONDING ENTRY NUMBER IS DETERMINED FROM
* A TABLE SEARCH. THIS ENTRY NUMBER IS USED AS A
* BRANCH INDEX TO TRANSFER PROGRAM CONTROL. OTHER
* RECORDS ARE MOVED DIRECTLY TO THE SYMBOINT BUFFER.
*
CMHDLR   EQU      %
         LI,R6    -NCCS+1           GET COMPLIMENT OF TABLE SIZE
         CW,R4    CCS+NCCS,R6       CCS=COMMAND TABLE; NCCS=TABLE SIZE
         BE       CMVECTOR          CONTROL COMMAND MATCH
         BIR,R6   CMHDLR+1          TABLE SEARCH LOOP CONTROL
CMVECTOR EQU      %
         B        *R11
         EXU      %+NCCS,R6         BRANCH ACCORDING TO CONTROL COMMAND
         B        JOBCC             JOB CONTROL COMMAND
         B        BINCC             BIN CONTROL COMMAND
         B        FINCC             FIN CONTROL COMMAND
         B        EODCC             EOD CONTROL COMMAND
         B        RCDCNTR
         B        BINREC
*
MSJBCC   EQU      %
         LI,R11   CMVECTOR+1
         CI,R6    -NCCS+1
         BE       *R11
MSJBCMD  TYPE     'MISSING JOB COMMAND'
         B        EXIT
*
BWHAT    EQU      %
         TYPE     'BATCH WHAT?'
         B        EXIT
         TITLE    'JOB CONTROL COMMAND ROUTINE'
*
* CHECK JOB CONTROL COMMAND FOR CORRECT ACCOUNT, NAME
* AND PRIORITY. DIAGNOSTICS ARE SENT TO USER IF ERROR FOUND
*
JOBCC    EQU      %
         LW,R10   PRIOR             PRIORITY SERVES AS LAST FLAG
         BLZ      JOBCC1
         BAL,R15  BATCHCAL          BATCH CAL TIME
JOBCC1   EQU      %
         CAL1,1   READAM
         LW,R1    POINT
         CW,R1    ARS
         BE       JOBMAKE
         LI,R2    8
         MTW,-1   R2
         LB,R3    J:ACCN,R2         COMPUTE BYTE COUNT
         CI,R3    ' '               OF ACCOUNT NAME
         BE       %-3
         STW,R2   ACCNL             COUNT
         LI,R2    J:ACCN            GET JIT ADDRESS OF USER ACCOUNT
         LI,R3    -1                INDEX FOR ACCOUNT VALIDITY CHECK
         STW,R3   ACCNC             RESET COUNT
         LI,R8    %+1
         BAL,R15  GETCHAR           GET ACTIVE CHARACTER FROM ACCOUNT
         B        JOBCC2            FIRST COMMA DELIMITS ACCOUNT
         BAL,R15  VLDCHCK           DOES ACCOUNT MATCH LOG-IN ACCOUNT
         B        JOBERR1           NO: INFORM USER ABOUT PROBLEM
JOBCC2   EQU      %
         LB,R10   JB:PRIV           BYPASS LENGTH CHECK IF
         CI,R10   X'C0'             PRIV>=C0
         BGE      %+4
         LW,R     ACCNL             SEE IF LENGTHS MATCH
         CW,R     ACCNC
         BNE      JOBERR1           NO. ISSUE MESSAGE
         MTW,0    R3                TEST FOR ILLEGAL COMMAND SYNTAX
         BLZ      JOBERR3           IF PRESENT, INFORM USER OF PROBLEM
         CW,R1    ARS               CHECK IF NAME EXISTS
         BG       JOBERR3           ERROR
         LI,R2    12                COMPUTE BYTE COUNT
JCC2L    MTW,-1   R2                OF ACCOUNT
         LB,R3    J:UNAME,R2
         CI,R3    ' '
         BE       JCC2L
         CI,R3    0                 ZERO AND BLANK MEAN
         BE       JCC2L             THE SAME
         STW,R2   ACCNL             COUNT
         LI,R3    -1                INDEX FOR NAME VALIDITY CHECK
         STW,R3   ACCNC             RESET COUNT
         LI,R2    J:UNAME
         LI,R8    %+1
         BAL,R15  GETCHAR           GET CHARACTER FROM NAME
         B        JOBCC3            SECOND COMMA DELIMITS NAME
         BAL,R15  VLDCHCK           DOES NAME MATCH LOG-IN NAME
         B        JOBERR2           NO: INFORM USER OF PROBLEM
JOBCC3   EQU      %
         LB,R10   JB:PRIV           BYPASS LENGTH CHECK IF
         CI,R10   X'C0'             PRIV>=C0
         BGE      %+4
         LW,R     ACCNL             CHECK LENGTHS
         CW,R     ACCNC
         BNE      JOBERR2           NO. ISSUE MESSAGE
         MTW,0    R3                ANOTHER SYNTAX CHECK
         BLZ      JOBERR3           IF PRESENT, INFORM USER OF PROBLEM
         CW,R1    ARS               DOES PRIORITY EXIST
         BG       JOBCC6            NO
         BAL,R15  GETCHAR           GET JOB PRIOTITY
         B        JOBERR3           JOB COMMAND SYNTAX ERROR
         STW,R    PRIORBCD
         CLM,R    F0F9
         BCR,9    JOBCC4+1          YES:CONVERT TO HEX
         CLM,R    C1C6              PRIORITY BETWEEN A AND F
         BCR,9    JOBCC4            YES:CONVERT TO HEX
         B        JOBCC5
JOBCC4   EQU      %
         AI,R     9                 CONVERT TO HEX
         SLS,R    28                CLIP LEADING 'F' OR 'C'
         SLS,R    -8                MAX PRIORITY BITS 8-11 J:ABC
         LW,R1    =X'00F00000'      COMPARE SELECTIVE MASK
         CS,R     J:ABC             CHECK PRIORITY
         BG       JOBCC5            VALUE EXCEEDED LEGAL MAXIMUM
         SLS,R    -20               RIGHT JUSTIFY PRIORITY
         STW,R    PRIOR             SAVE FOR USE IN LIMIT ROUTINE
         B        JOBCC7
JOBCC5   EQU      %
         CAL1,1   CMDMSG
         TYPE     'ILLEGAL PRIORITY'
         B        EXIT              ABORT JOB
JOBCC6   EQU      %
         LI,R     1                 USER DID NOT SPECIFY PRIORITY;
         STW,R    PRIOR             DEFAULT HIM (HER) TO 1 PRIORITY
         LI,R     X'F1'
         STW,R    PRIORBCD
JOBCC7   EQU      %
         LI,R9    84
         LW,R12   BCDRCC
         B        ENTRY1            JOB COMMAND IS OK
JOBERR1  EQU      %
         CAL1,1   CMDMSG
         TYPE     'ILLEGAL ACCOUNT'
         B        EXIT              ABORT JOB
JOBERR2  EQU      %
         CAL1,1   CMDMSG
         TYPE     'ILLEGAL NAME'
         B        EXIT              ABORT JOB
JOBERR3  EQU      %
         B        SYNTAX
*
*
JOBEXT1  EQU      %
         CAL1,1   CMDMSG
         TYPE     'BLANK NOT ALLOWED IN XACCT FIELD'
         B        EXIT
*
JOBEXT2  EQU      %
         CAL1,1   CMDMSG
         TYPE     'XACCT FIELD NOT TERM. BY RT. PAREN.'
         B        EXIT
*
*
JOBMAKE  EQU      %
         LW,R2    MODE              0=NON GHOST
         LW,R2    WHO,R2            1=GHOST
         STW,R2   WHICH             FOR ACCOUNT NAME
         AI,R1    1
         LI,R2    -8
         LB,R     J:ACCN+2,R2
         CI,R     ' '
         BE       %+4
         STB,R    CARD,R1                                       #6129
         AI,R1    1
         BIR,R2   %-5
         LI,R     ','
         STB,R    CARD,R1                                       #6129
         AI,R1    1
         LI,R2    -12
JM1      EQU      %
         LB,R     *WHICH,R2         ***
         CI,R     ' '
         BE       JM2
         CI,R     0
         BE       JM2
         STB,R    CARD,R1                                       #6129
         AI,R1    1
         BIR,R2   JM1
JM2      EQU      %
         LI,R     ','
         STB,R    CARD,R1                                       #6129
         AI,R1    1
         LW,R2    J:ABC
         SLS,R2   8
         SLS,R2   -28
         STW,R2   PRIOR
         LB,R     HEX,R2
         STB,R    CARD,R1                                       #6129
         STW,R    PRIORBCD
         AI,R1    1
         LI,R2    -16
         LB,R     TJOB+4,R2
         STB,R    CARD,R1                                       #6129
         AI,R1    1
         BIR,R2   %-3
         B        JOBCC7
         TITLE    'LIMIT CONTROL COMMAND ROUTINE'
         TITLE    'FIN, BIN AND EOD CONTROL COMMANDS'
*
* FIN CONTROL COMMAND
*
FINCC    EQU      %
*
* BIN CONTROL COMMAND
*
BINCC    EQU      %
         CAL1,1   CMDMSG
         TYPE     'COMMAND REJECTED'
         B        READREC           GO READ ANOTHER RECORD
         PAGE
BINREC   EQU      %
         LW,R12   BINRCC
         LI,R9    112
         B        CONTU
*
* EOD CONTROL COMMAND
*
EODCC    EQU      %
         LW,R12   EODRCC
         LI,R9    84
         B        CONTU
*
RCDCNTR  EQU      %
         LW,R12   BCDRCC
         LI,R9    84
CONTU    EQU    %
         LCW,R    R9
         AWM,R    RCCDS
         BGEZ     ENTRY2
         LI,R10   -1                FULL; SET CONTINUATION FLAG
         BAL,R15  BATCHCAL
*
ENTRY1   EQU      %
         LI,R     (256-3)*4
         SW,R     R9
         STW,R    RCCDS
         LI,R13   BA(SYMB+1)
*
ENTRY2   EQU      %
         STW,R12  CONTROL
         LI,R12   BA(CONTROL)
         STB,R9   R13
         MBS,R12  0                 MOVE INBUF TO SYMBUF
         B        READREC           GO READ ANOTHER RECORD
         TITLE    'SUBROUTINES'
*
* FLAG BUFFER COMPLETE AND ISSUE M:JOB
* R10 = FLAG FOR CONTINUATION OR END OF JOB
* R15 = LINKAGE
*
BATCHCAL EQU      %
         PUSH     R15
         SLS,R13  -2
         LI,R     X'4001'
         STW,R    *R13
*IF 'T' OPTION WAS SPECIFIED ON BATCH COMMAND, OR IF
*ABORT SWITCH IS SET BECAUSE OF ERRORS, DONT DO CAL
*
         LW,R     TYPSET
         AW,R     ABORT
         BNEZ     %+2
         CAL1,1   BATCH             M:JOB
         CI,R10   -1                CONTINUATION FLAG
         BE       BEXIT
***
*** USER'S FILE HAS ENDED.  BAL INTO EXTERNAL SUBROUTINE
*** TO REMOVE ANY REMAINING DEFAULT REQUESTS
***
         BAL,R2   BATDUN            ***
***
*** IF R10 IS NOT NEGATIVE, BATCH IS READY TO ENTER
*** THE SYMBIONT FILE AS A JOB.  BEFORE THAT, CHECK
*** THE ABORT FLAG IN THE EXTERNAL MODIFICATION ROUTINE.
*** IF ZERO, CONTINUE; ELSE ABORT THE ENTIRE JOB BY
*** EXITING TO MONITOR IMMEDIATELY.
***
         LW,R2    ABORT
         AW,R2    TYPSET            NO MSG IN IN T MODE
         BNEZ     EXIT              IF NON-ZERO
***
         LW,R2    R7
         AW,R2    =X'10000000'+TIMEDATE
         STW,R2   TDFPT,R7
         LCI      5                 TEXT SIZE
         LM,R     IDTEXT            GET TEXT FOR ID MESSAGE
         LC       J:JIT             IS IT AN ON-LINE JOB
         BCS,8    %+2               YES
         AW,R     =X'002B0000'      NO, BLANK OUT CARRIAGE RETURN
         LCI      5
         STM,R    ID,R7
         CAL1,8   TDFPT,R7          GET CURRENT TIME AND DATE
         LW,R2    R7
         AI,R2    ID
         LI,R3    5
         LI,R1    4
         STH,R8   R4
         CALL     HEX2PRNT
         LI,R1    35
         CAL1,1   OUTLIST           OUTPUT DIRECTLY
         CAL1,1   JOBSTAT
         CI,R8    2
         BE       BWAIT
         TYPE     'RUNNING'
         B        BEXIT
BWAIT    EQU      %
         LCI      5
         LM,R     JOBWTTXT
         LC       J:JIT             IS IT AN ON-LINE JOB
         BCS,8    %+2               YES
         AW,R4    =X'00002B00'      NO, BLANK OUT CARRIAGE RETURN
         LCI      5
         STM,R    STATUS,R7
         LW,R14   R7
         AI,R14   STATUS
         LI,R1    8
         STW,R10  R5
         CALL     BIN2BCD
         LI,R1    19
         CAL1,1   MSG
BEXIT    EQU      %
         PULL     R15
         RETURN
         PAGE
         PAGE
SYNTAX   EQU    %
         CAL1,1   CMDMSG
SYNTAXTL EQU      %
         STW,R1   R5
         LCI      2
         LM,R     EH@
         STM,R    EHMSG,R7
         LW,R14   R7
         AI,R14   EHMSG
         LI,R1    5
         CALL     BIN2BCD
         LI,R1    8
         CAL1,1   MSG
         B        EXIT
*
* SCAN TEL COMMAND LINE
* R2 AND R3 = POINTERS TO FID P-LIST ENTRY
* R15 = RETURN LINKAGE
*
TELSCAN  EQU      %
         MTW,-1   TELARS
         BLZ      *R15
         LB,R     COMMAND,R1        SCAN TEL CMND LINE
         AI,R1    1
         CI,R     ','                MULTIPLE JOBS
         BNE      %+4
         STW,R1   ARG
         MTW,1    FLAG
         B        *R15
         CI,R     ' '               IGNORE BLANKS
         BE       TELSCAN
         CI,R      X'05'            IGNORE TABS
         BE       TELSCAN
         CI,R     '.'               PERIODS ARE DELIMITERS
         BNE      %+3
         AI,R15   1
         B        *R15              RETURN
         STB,R    *R2,R3            STORE IN OPEN FPT
         AI,R3    1                 INCREMENT INDEX
         MTB,1    *R4               KEEP BYTE COUNT
         CB,R5    *R4               CHECK FOR TRUNCATION
         BGE      TELSCAN           CONTINUE
         B        SYNTAXTL
         PAGE
*
* GET A CHARACTER FROM JOB CONTROL COMMAND
* NORMAL RETURN: ACTIVE CHARACTER FOUND;
* ABNORMAL RETURN: DELIMITER FOUND.
* R15 = LINKAGE
*
GETCHAR  EQU      %
         LB,R     CARD,R1
         AI,R1    1                 BUMP INDEX
         CW,R1    ARS
         BG       *R15              AT END, RETURN
         CI,R     ' '               BLANKS ARE IGNORED
         BE       GETCHAR
         CI,R     X'05'             TABS ARE IGNORED
         BE       GETCHAR
         CI,R     '('               ALLOW XACCT FIELD ON JOB CC
         BE       EXTEND
         CI,R     ','               COMMAS DELIMIT
         BE       *R15              DELIMITER EXIT
         AI,R15   1
         MTW,1    ACCNC             INCREMENT COUNT
         B        *R15              NORMAL EXIT
*
* CHECK VALIDITY OF CHARACTER FROM JOB COMMAND
* NORMAL RETURN: CONTINUE SCAN
* ABNORMAL RETRUN: NAME OR ACCOUNT ERROR
* R8  = CONTINUE SCAN LINKAGE
* R15 = ERROR RETURN LINKAGE
*
VLDCHCK  EQU      %
         AI,R3    1                 BUMP INDEX
*        IF USER HAS C0 PRIV., BYPASS SAME-ACCT CHECK
         LB,R10   JB:PRIV
         CI,R10   X'C0'
         BGE      *R8
         CB,R     *R2,R3            JOB COMMAND VALIDITY CHECK
         BNE      *R15              ERROR EXIT
         B        *R8               CONTINUE SCAN
*
         PAGE
*
*PROVISIONS FOR EXTENDED ACCOUNTING FIELD ON JOB CONTROL COMMAND
*  ASSUMED TO FOLLOW NAME FIELD
*   DELIMITERS ARE ( AND )
*    CONTENTS NOT ESSENTIAL;CCI WILL TAKE 24 CHARACTERS
*
EXTEND   EQU      %
         LB,R     CARD,R1
         AI,R1    1
         CW,R1    ARS
         BG       JOBCC6            END,CHECK SYNTAX
         CI,R     ' '
         BE       JOBEXT1           BLANK NOT ALLOWED IN THIS FIELD
         CI,R     ','
         BE       JOBEXT2           COMMA IS NO DELIMITER HERE
         CI,R     '('
         BE       JOBEXT2           NO FOOLING
         CI,R     ')'
         BE       GETCHAR           OK,RT PAREN. FND,CONTINUE
         B        EXTEND            SCAN FOR MORE CHAR.
         PAGE
* CONVERT HEX NUMBER TO PRINTABLE BCD EQUIVALENT
* R9 = NUMBER TO BE CONVERTED
* R4 = NUMBER OF CHARACTERS
* R2 AND R3 = POINTERS FOR RESULT
* R14 = RETURN LINKAGE
*
HEX2PRNT EQU      %                 CONVERT 4 BIT HEX CODE TO BCD
         LI,R5    0
         SCD,R4   4
         LB,R5    HEX,R5
         STB,R5   *R2,R3
         AI,R3    1
         BDR,R1   HEX2PRNT
         RETURN
*
BIN2BCD  EQU      %
         PUSH     R15
         LI,R15   1
         LI,R4    0
         DW,R4    =10
         BQEZ     BIN2BCD1+1
         PUSH     R4
         AI,R15   1
         B        BIN2BCD+2
BIN2BCD1 EQU      %
         PULL     R4
         AI,R4    '0'
         AI,R1    1
         STB,R4   *R14,R1
         BDR,15   BIN2BCD1
         PULL     R15
         RETURN
         TITLE    'ABNORMAL AND ERROR RETURNS'
*
ABNADD   EQU      %
         LI,11    X'0300'           ABC=ER0
         SCD,10   8                 KEY FORMAT FOR ERRMSGE
         SLS,10   -1
         SCD,10   8
         STW,11   12
         LH,R     M:EI              CHECK IF M:EI IS OPEN BEFORE CLOSING
         CI,R     X'20'
         BAZ      ABNADD5
         CAL1,1   CLOSFILE          YES, CLOSE IT
ABNADD5  LI,R2    M:EI              USE M:EI DCB
         LI,3     AM                HANDY BUFFER
         LI,4     22*4              AND ITS SIZE
         BAL,11   ERRMSGE           GET THE MESSAGE
         CAL1,1   WRITERR           AND PUT IT OUT
         B        EXIT              ABORT JOB
         PAGE
ABNREAD  EQU      %
         LB,R10   R10
         CI,R10   X'06'
         BE       EOF
         CI,R10   X'05'             OR END-DATA
         BE       EOF               FOR UNFMT TAPE
LOSTDATA TYPE     'DATA LOST'
         B        EXIT
EOF      EQU      %
         LW,R10   PRIOR             PRIORITY SERVES AS LAST FLAG
         BLZ      MSJBCMD
         BAL,R15  BATCHCAL          BATCH CAL TIME
EXIT     EQU      %
         LH,R     M:EI
         CI,R     X'20'
         BAZ      %+2
         CAL1,1   CLOSFILE          CLOSE EDIT FILE
         M:CLOSE  F:BATCH,(SAVE)      ***
         MTW,0    FLAG
         BLZ      %+2
         B        RESTART
         CAL1,8   FREEPAGE          FREE USED PAGE
         CAL1,9   1                 UTS EXIT CAL
         TITLE
PATCH    RES      100
         DEF      PATCH
         END      START

