*M*      BATCH1   TERMINAL BATCH ENTRY SUBSYSTEM MAIN ROUTINE
*
*P*      NAME:    BATCH1
*P*      PURPOSE: THE BATCH PROCESSOR READS THE FILE(S) SPECIFIED
*P*               ON THE COMMAND AND INSERTS IT INTO THE SYMBIONT
*P*               STREAM USING A JOBENT CAL.  THE FILE MUST BEGIN
*P*               WITH A JOB CARD.  OPTIONALLY, CONDITIONAL DATA
*P*               REPLACEMENT MAY BE SPECIFIED ON THE BATCH COMMAND
*P*               IN WHICH CASE EACH RECORD IS EXAMINED FOR
*P*               REPLACEMENTS AS IT IS BEING MOVED INTO THE JOB
*P*               STREAM.
*P*
*P*      REFERENCE: BATCH PROCESSING REFERENCE MANUAL.
*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.
*
*
*** 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
*
*        FPTS IN PURE PROCEDURE
*
,,       M:PT     1
*
BATCHD   CSECT    0
         DEF      BATCHD
BATCHPP  CSECT    1
         DEF      BATCHPP
F:BATCH  DSECT    1
F:BATCH  M:DCB    (FILE),(DEVICE,'LO'),(ASN,DEVICE)
*
*
F:AMR    DSECT    1
F:AMR    M:DCB    (ABN,NOAMR),(ERR,NOAMR)
         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
         REF      J:CCBUF
         REF      JB:CCARS          LENGTH OF CMND IN J:CCBUF
         REF      M:EI              M:OPEN, M:READ AND M:CLOSE DCB
         REF      M:BO
         REF      M:RDERR           DCB TO READ ERRMSGE FILE
         REF      JB:PRIV
         REF      J:ABC
         REF      J:JIT
         REF      J:ACCN
         REF      J:UNAME
         REF      M:UC              COC DCB
         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
         DEF      ABNADD2
         DEF      PRIOR
         DEF      BIN2BCD
         REF      EXSW,ALTREAD
         REF      MOD1,MOD2,ABORT,COMMAND
         REF      TYPSET            'T' OPTION SW
         REF      PRINTSET          'P' OPTION SW
         REF      OPEN:ERR
         REF      EXECCNT
         REF      MAINCNT           COUNT OF RECORDS FOR THE MAIN FILE
         REF      DATALOST
         REF      RECNUM
         REF      PRINT
         REF      F:ALT
         REF      GREPREQ
         REF      REPREQ
         REF      REPMADE
         REF      NOREPMADE
***
***      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'
JTAB     TEXT     ',  LINE='
         TEXT     ',  GHOST'
         TEXT     ', REMOTE'
         TEXT     ',  BATCH'
IDTX     TEXT     '   , ID='
FIDTX    TEXT     ' . FILE='
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 0,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
         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      %
         LW,R12   R8                SAVE LINKED TO INDICATOR
         CAL1,8   GETPAGE           PAGE ADDRESS IS RETURNED IN R9
         LW,R7    R9                PUT ADDRESS IN AN INDEX REGISTER
         LC       J:JIT
         BCS,8    NOLINE
         LI,R3    79
         LB,R     J:CCBUF,R3
         CI,R     ' '
         BNE      %+2
         BDR,R3   %-3
         B        START1
NOLINE   EQU      %
         LB,R3    JB:CCARS          GET COMMAND LINE LENGTH
         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    31                SET UP FOR MAXIMUM LENGTH FILE NAME
         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,R1   0                  SET MAIN FILE COUNT TO ZERO
         STW,R1   MAINCNT
         LI,R11   MSJBCC            ERROR ADDRESS FOR MISSING JOB CMD
READREC  EQU      %
         LW,R14   EXSW              READ WHICH FILE?
         BNEZ     ALTREAD           F:ALT
         MTW,1    MAINCNT           COUNT 1 MAIN FILE RECORD
         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
         LB,R5    CARD              GET FIRST BYTE
         LI,R6    1                 ASSUME BINARY
         LI,R2    4                 FOUR TYPE OF BINARY CARD
         CB,R5    BINCDS,R2         DO WE HAVE A BINARY TYPE
         BE       *R11              IF YES GO TO CMVECTOR+1 IF NOT FISRT TIME
         BDR,R2   %-2               LOOP
         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,R6    0
DENSE    EQU      %
         LI,R2    80
***
*** FOLLOWING INSTRUCTION CHANGED FROM M:EI+13 TO ARS
***
         SW,R2    ARS               ***
         BEZ      NOFILL
         BGZ      FILL              FILL IF NEED TO
         MTW,0    EXSW              SEE IF IN THE MIDDLE OF AN EXEC
         BEZ      ABNREAD5          BRANCH IF WE WERE NOT
         LI,R12   F:ALT+23          SET TO ALTERNATE DCB
         LW,R5    EXECCNT           GET THE ALTERNATE COUNT
         B        ABNREAD10         GO TO IT
FILL     EQU      %
         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      %
         STW,R3   FLAG              SET NEGATIVE TO AVOID RESTART
         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      %
         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      %
         CI,R     '.'               SEE IF IT A PERIOD
         BE       JOBERR3           IF PRESENT IDICATE SYNTAX ERROR
         CW,R1    ARS               SEE IF AT END OF CARD
         BG       JOBMAKE0          GO MAKE UP THE JOB CARD
         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,R10   ACCNL             CHECK LENGTHS
         CW,R10   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
         CI,R     '.'               WAS NAME TERMINATED BY PERIOD
         BE       JOBCC6            GIVE HIM DEFAULT IF IT DID
         BAL,R15  GETCHAR           GET JOB PRIOTITY
         B        JOBCC55           SEE HOW WE TERMINATED
         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
JOBCC55  EQU      %
         CI,R     ','               DID WE HAVE DEFAULT PRIORITY
         BNE      JOBERR3           BRANCH IF NOT
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      %
         MTW,0    PRINTSET          ARE WE PRINTING EVERYTHING
         BEZ      JOBCC75           BRANCH IF NOT
         M:WRITE  F:BATCH,(BUF,CARD),(SIZE,80)  WRITE IT OUT
JOBCC75  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
*
*
JOBEXT2  EQU      %
         CAL1,1   CMDMSG
         TYPE     'XACCT FIELD NOT TERM. BY RT. PAREN.'
         B        EXIT
*
*
*
JOBMAKE0 EQU      %
         LW,R1    POINT             RESTORE R1 TO POINT PAST !JOB
*
JOBMAKE  EQU      %
         AI,R1    1
         LI,R2    -8
         LI,R3    J:ACCN+2          GET ACCOUNT NUMBER ADDRESS
         CALL     MVNBLANK          MOVE IT IN UNTIL NO BLANKS
         LI,R     ','
         STB,R    CARD,R1                                       #6129
         AI,R1    1
         LI,R2    -12
         LW,R3    MODE              SEE MODE TYPE 0 = NON-GHOST
         LW,R3    WHO,R3            AND SET UP R3 WITH ADDRESS
         CALL     MVNBLANK          MOVE IN THE USER NAME
         M:RAMR   F:AMR,(BUF,AM),(SIZE,80)
         LI,R     '('               GET LEFT PAREN
         STB,R    CARD,R1
         LI,R3    AM+20             POINT TO END OF EXTENDED ACCOUNTING
         LI,R2    -24
         LB,R     *R3,R2            GET THE FIRST BYTE
         CI,R     ' '               IS IT A BLANK
         BE       NOAMR             BRANCH IF IT IS
         AI,R1    1
JM22     EQU      %
         CALL     MVNBLANK          MOVE IN THE EXTENDED ACCOUNTING
         LI,R     ')'               GET RIGHT PAREN
         STB,R    CARD,R1           STORE IT AWAY
         AI,R1    1
NOAMR    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
JM30FILE EQU      %
         LI,R3    FIDTX+2           GET SOURCE ADDR
         LI,R2    -7                GET THE FILE SIZE
         CALL     MVBLANK           MOVE IN FILE=
         LB,R2    M:EI+23           GET THE SIZE OF THE FILE NAME
         LI,R5    BA(CARD)
         AW,R5    R1                GET THE BYTE ADDR OF CUURENT POS
         STB,R2   R5                SET UP FOR THE MOVE
         LI,R4    BA(M:EI+23)+1     GET THE SOURCE ADDR
         MBS,R4   0                 MOVE THE FILE NAME
         AW,R1    R2
JM40ACCN EQU      %
         LCI      2                 GET THE ACCOUNT # FROM THE DCB
         LM,R2    M:EI+32
         CW,R2    J:ACCN            IS IT FROM THE CURRENT ACCOUNT
         BNE      JM45              BRANCH IF NOT
         CW,R3    J:ACCN+1          CHECK SECOND WORD
         BE       JOB50ID           IF ITS THE SAME GET OUT
JM45     EQU      %
         LI,R2    '.'               SET UP THE PERIOD
         STB,R2   0,R5              STORE THE PERIOD
         AI,R1    1
         LI,R2    -8
         LI,R3    M:EI+34           GET ACCN ADDRESS
         CALL     MVNBLANK          MOVE BUT NO BLANKS
JOB50ID  EQU      %
         LI,R2    -5
         LI,R3    IDTX+2            SET UP 'ID='
         CALL     MVBLANK           MOVE IT IN
         LI,R5    X'FFFF'           GET THE SYSID
         AND,R5   J:JIT
         CALL     BINHEX            CONVERT THE ID TO HEX AND STORE IT
JM60WHO  EQU      %
         LI,R3    0                 SEE WHO WE ARE
         LC       J:JIT
         BCS,2    JMREMOTE          BRANCH IT RAS
         BCS,4    JMGHOST
         BCS,8    JMONLINE
JMBATCH  EQU      %
         AI,R3    1
JMREMOTE EQU      %
         AI,R3    1
JMGHOST  EQU      %
         AI,R3    1
JMONLINE EQU      %
         SLS,R3   1                 DOUNBLE IT
         AI,R3    JTAB+2            POINT TO END OF THE MESSAGE
         LI,R2    -8
         CALL     MVBLANK           MOVE MESSAGE OF WHO IT IS
         LC       J:JIT             SEE WHO WE ARE
         BCR,8    JOBCC7            BRANCH IF NOT ONLINE
         LI,R5    X'FF'             GET THE LINE #
         AND,R5   M:UC+1
         CALL     BINHEX            CONVERT THE LINE # AND STORE IT
         B        JOBCC7            AND GET OUT
         B        JOBCC7
         TITLE    'BINARY TO HEX CONVERSION'
*
*
*  BINARY TO HEX CONVERSION AND STORE
*
*        R5 = VALUE TO CONVERT
*        R15 = LINK REGISTER
*        R1 = INDEX INTO CARD
*
BINHEX   EQU      %
         LW,R2    R5                SEE IF IT IS ZERO
         BNE      BINHEX10          BRANCH IF IT IS NOT
         LI,R     '0'
         B        BINHEX27
BINHEX10 EQU      %
         LI,R2    -8                SET FOR MAX # TO CONVERT
         LI,R3    0                 SET NO SIG YET
BINHEX20 EQU      %
         LI,R4    0
         SLD,R4   4                 GET 4 BITS
         CI,R4    0                 IS IT ZERO
         BNE      BINHEX25          BRANCH IF NOT
         CI,R3    0                 DO WE HAVE SIGNIFICANCE YET
         BE       BINHEX30          BRANCH IF NOT
BINHEX25 EQU      %
         LI,R3    1                 FLAG SIG
         LB,R     HEX,R4            GET THE CHAR
BINHEX27 EQU      %
         STB,R    CARD,R1           STORE IT AWAY
         AI,R1    1
BINHEX30 EQU      %
         BIR,R2   BINHEX20
         RETURN                     GET OUT IF DONE
         TITLE    'MOVE STRING ROUTINES'
*
*  MOVE STRING TO CARD
*
*        R3 = SOURCE ADDRESS
*        R2 = LENGTH (NEGATIVE)
*        R1 = CARD INDEX
*
MVBLANK  EQU      %
         LB,R     *R3,R2            GET THE CHARACTER
         STB,R    CARD,R1           STORE IT AWAY
         AI,R1    1                 POINT TO NEXT BYTE
         BIR,R2   MVBLANK           LOOP
         RETURN
*
MVNBLANK EQU      %
         LB,R     *R3,R2            GET THE BYTE
         BEZ      *R15              IF ZERO GET OUT
         CI,R     ' '               IS IT A BLANK
         BE       *R15              RETURN IF IT IS
         STB,R    CARD,R1           STORE THE BYTE AWAY
         AI,R1    1                 POINT TO NEXT BYTE
         BIR,R2   MVNBLANK          LOOP
         RETURN
         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   ARS               GET THE SIZE
         SLS,R12  16                RIGHT JUSTIFY FOR THE RCC
         OR,R12   BINRCC
         LW,R9    ARS               GET SIZE OF RECORD IE 108-120
         AI,R9    4                 ADD IN 4 FOR CONTROL BYTES
         B        CONTU5
*
* EOD CONTROL COMMAND
*
EODCC    EQU      %
         LW,R12   EODRCC
         LI,R9    84
         B        CONTU
*
RCDCNTR  EQU      %
         LW,R12   BCDRCC
         LI,R9    84
CONTU    EQU    %
         MTW,0    PRINTSET          ARE WE PRINTING EVERYTHING
         BEZ      CONTU5            BRANCH IF  WE ARE NOT PRINTING EVERYTHING
         M:WRITE  F:BATCH,(BUF,CARD),(SIZE,80)    WRITE IT OUT
CONTU5   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
***
*** 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
         BNEZ     EXIT              IF NON-ZERO
         AW,R2    TYPSET            NO MSG IN IN T MODE
         BNEZ     BEXIT             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
         CI,R     '.'               SEE IF ITS A PERIOD
         BE       *R15              BRANCH IF IT IS
         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       JOBEXT2
         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,R2    X'1FFFF'          GET THE DCB ADDRESS
         AND,R2   R10               GET THE OFFENDING DCB ADDRESS
         CI,R2    M:BO              IF ITS M:BO ITS ON THE JOBENT
*                                   CAL1 SO LET IT BO
         BE       ABNADD2
         LI,R12   M:EI+23           LOAD THE FILE NAME
         CALL     OPEN:ERR
         CALL     PRINT             PRINT THE MESSAGE
ABNADD2  EQU      %
         LI,11    X'0300'           ABC=ER0
         SCD,10   8                 KEY FORMAT FOR ERRMSGE
         SLS,10   -1
         SCD,10   8
         STW,11   12
         LI,R2    M:RDERR           USE M:RDERR TO READ ERRMSGE FILE
         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
ABNREAD5 EQU      %
         LI,R12   M:EI+23           SET UP THE RIGHT DCB
         LW,R5    MAINCNT           GET THE RECORD CNT
ABNREAD10 EQU     %
         LI,R1    0
         LI,R14   RECNUM
         CALL     BIN2BCD           CONVERT IT
         LI,R     DATALOST
         CALL     PRINT
         CALL     OPEN:ERR
         CALL     PRINT             PRINT THE WHILE PROCESSING MESSAGE
         B        EXIT
EOF      EQU      %
         LW,R10   PRIOR             PRIORITY SERVES AS LAST FLAG
         BLZ      MSJBCMD
         BAL,R15  BATCHCAL          BATCH CAL TIME
         MTW,0    GREPREQ           WERE GLOBAL REPLACEMENTS REQUIRED
         BNEZ     CHK:REP           SEE IF WE FOUND ANY
         LI,R     0                 SEE IF ANY DEFAULT OR EXEC
         XW,R     REPREQ            WERE FOUND WITH REPLACEMENT STRINGS
         BEZ      EXIT              IF NOT GET OUT
CHK:REP  EQU      %
         LI,R     0                 SEE IF WE MADE ANY
         XW,R     REPMADE
         BNEZ     EXIT              BRANCH IF WE DID
         LI,R     NOREPMADE
         CALL     PRINT
         LI,R12   M:EI+23           GET THE FILE NAME
         CALL     OPEN:ERR
         CALL     PRINT             PRINT THE MESSAGE
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
         USECT    BATCHD
PATCH    RES      100
         DEF      PATCH
         END      START

