         SYSTEM   OPTIONS                                                       
         DO       #TJE                                                          
         DEF      A:TEX2                                                        
         DEF      TESTLOOP          TOP FOR LINE TESTING                        
         DEF      TEXEXEC           COMMMENSE EXECUTION                         
         DEF      ONOFFMSG          REENTER FOR OFF MESSAGES                    
         DEF      ANLERREX          EXIT TO ANALYSE REEOR                       
         DEF      OVERBGEX          EXIT FOR OFF VERBAGE                        
*                                                                               
*        REF      VERACCNT          VERIFY ACCOUNT FORMAT                       
*        REF      PURGEQUE          CLEAR LINE FROM ALL QUEUES                  
*        REF      ANALYSE           ANALYSE THE ERROR CONDITION                 
*        REF      TEXBUFFR          GET BLK. BUF. FOR TEX WORKSPACE             
*        REF      TEXWORKS          DATA WORD OF RESIDENT CODE                  
*        REF      OFFVERBG          CONSTRUCT OFF MESSAGE                       
*        REF      TJE:NUM           NUMBER OF LINES ACCEPTABE                   
*        REF      TJE:NOW           NUMBER OF LINES CURRENT                     
         PSYS     0                                                             
         SYSTEM   SIG9                                                          
OLAYFLAG EQU      'TEX2'                                                        
         PSYS     0                                                             
         SYSTEM   CPRMON                                                        
ZAP      EQU      0                                                             
         DO       ZAP                                                           
R0       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                                                            
         FIN      ZAP                                                           
OCEND    EQU      1*16              OC MESSAGE COMPLETION FLAG                  
LOGEND   EQU      2*16              LINE MESSAGES COMPLETE FLAF                 
INITEND  EQU      4*16              INITIALIZATION COMPLETE FLAG                
DRCBIT   EQU      X'400'                                                        
TOPLOC   RES      0                 TOP OF PROGRAM                              
         TITLE    'REMOTE TERMINAL ENTRY - TEX'                                 
         PSYS     1                                                             
*                                                                               
         SYSTEM   OLAYBASE                                                      
         PAGE                                                                   
CERR     CNAME                                                                  
         PROC                                                                   
AF       RES      0                                                             
         PEND                                                                   
ERR      CNAME                                                                  
         PROC                                                                   
LF       RES      0                                                             
         BAL,R8   TEXERROR                                                      
         CERR     AF                                                            
         PEND                                                                   
EMAP     CNAME                                                                  
         PROC                                                                   
         DATA,2   AF(1)-TOPLOC+AF(2)*512+AF(3)*4096                             
         PEND                                                                   
         PAGE                                                                   
         ORG      0                                                             
TEXEXEC  RES      0                 BEGIN TERMINAL EXECUTIVE                    
         BAL,R11  TEXBUFFR          GET BUFFER BLOCK WORK SPACE                 
         LCFI     5                 INITIALIZE LINKS OF THIS OLAY               
         LM,R12   BEGT1                                                         
         STM,R12  ERROR,R6                                                      
TESTLOOP RES      0                 PREFORM TEST OF SERVICE REQUESTS            
         LW,R6    TEXWORKS                                                      
         LW,R1    TTLP1                                                         
         STW,R1   TESTING,R6                                                    
         CAL1,7   TESTING,R6        TEST                                        
         CERR     C:E13                                                         
         CW,R1    TESTING,R6                                                    
         BE       DCTSCAN           OUT IF NONE COMPLETED                       
         LW,R1    TESTING,R6                                                    
         LI,R2    -1                OTHERWISW -                                 
         LW,R8    *R1,R2            GET CONTINUATION ADDRESS                    
         LB,R7    R8                AND LINE(DEVICE) INDEX                      
         AND,R1   M17                                                           
         LB,R2    DCTTJE,R7                                                     
         CI,R2    TJEKILL           TEST IF LINE IN KILL MODE                   
         BANZ     *R8               YES - DO CONTINUE                           
         CI,R2    TJEACT            TEST IF LINE IS ACTIVE                      
         BANZ     *R8               YES - DO CONTINUE                           
         CI,R2    TJEOFF            TEST IF OFF IS CALLED FOR                   
         BAZ      *R8               NO - DO CONTINUE                            
         B        KILLLINE          OTHERWISE EXERCISE COUP DE GRACE            
TTLP1    DATA     X'42800000'       TESTING FPT                                 
*                                                                               
BEGT1    B        TEXERROR          LINKAGE TO EROR ROUTINE                     
         DATA     ACCFAIL,LINEOFF,REINIT,TESTLOOP                               
         PAGE                                                                   
DCTSCAN  RES      0                 SCAN THE DCTTJE TABLE                       
         LH,R7    DCT7              GET COUNT OF LINES                          
         BEZ      TJEWAIT           IF NULL, ERROR - GIVE UP                    
DCTS1    LB,R5    DCTTJE,R7         LOOK FOR LINE IN USE                        
         BEZ      DCTS3             IFNOT, SKIP                                 
         LI,R5    ENDOUTL-OUTLIST   ENTER BIT TEST LOOP                         
DCTS2    LB,R15   DCTTJE,R7                                                     
         LW,R0    OUTLIST-1,R5      TEST THE SUNDRY BITS                        
         CB,R15   R0                                                            
         BANZ     *R0               FOR BIT THAT'S ON - TAKE ACTION             
         BDR,R5   %-3               LOOP ON STATUS BITS                         
DCTS3    BDR,R7   DCTS1             LOOP ON LINE ENTRIES                        
CONSCAN  EQU      DCTS3             ENTER FOR CONTINUATION OF SCAN              
*                                                                               
*                                                                               
TJEWAIT  CAL1,9   9                 WAIT ON FURRTHER ACTION                     
         B        TESTLOOP          SOMETHING HAPPENED, RESTART                 
*                                                                               
*                                                                               
OUTLIST  RES      0                                                             
         GEN,8,24 TJEINIT,INITTEL                                               
         GEN,8,24 TJEON,ACTION                                                  
         GEN,8,24 TJETEX,CONSCAN                                                
         GEN,8,24 TJEOFF,KILLLINE                                               
         GEN,8,24 TJEKILL,CONSCAN                                               
ENDOUTL  RES      0                                                             
         PAGE                                                                   
ENQUEUE  RES      0                 ENQUEUE ACTION REQUEST                      
         BAL,R3   SEARCHIT          TEST IF LINE AREADY ENQUEUED                
         B        %+2                                                           
         B        *R8               YES - JUST RETURN                           
         LB,R1    *R0               NOT FOUND, ADD TO QUEUE                     
         AI,R1    1                                                             
*  TEST AGAINST QUELIMIT INAPPROPRIATE SINCE THE MAXIMUM NUMBER OF              
*  DCB'S EQUALS THAT LIMIT.                                                     
         STB,R1   *R0               SET NEW COUNT                               
         STB,R7   *R0,R1            SET LINE INDEX IN QUEUE                     
         CI,R1    1                 TEST IF TOP OF QUEUE                        
         BE       *R9               YES - PREFORM ACTION                        
         B        *R8               OTHERWISE, JUST CONTINUE                    
*                                                                               
*                                                                               
DEQUEUE  RES      0                 REMOVE CURRENT QUEUE ENTRY                  
         AW,R0    R6                                                            
         LB,R1    *R0               PICKUP QUEUE LENGTH                         
         AI,R1    -1                REDUCE, AND                                 
         STB,R1   *R0               TEST IF DEPLETED.                           
         BEZ      *R8               IF SO, RETURN EMPTY                         
         LI,R3    0                 OTHERWISE, SQUEEZE THE QUEUE                
         AI,R3    2                                                             
         LB,R9    *R0,R3                                                        
         AI,R3    -1                                                            
         STB,R9   *R0,R3                                                        
         BDR,R1   %-4                                                           
         LI,R1    1                                                             
         LB,R7    *R0,R1            PICKUP CURRENT TOP OF LIST                  
         AI,R8    1                                                             
         B        *R8               AND RETURN                                  
*                                                                               
*                                                                               
GETDCB   LI,R0    DCBLIST                                                       
         BAL,R3   SEARCHIT          TEST IF DCB AREADY LINKED                   
         B        *R8               NO - RETURN DISAPOINTMENT                   
         MI,R1    DCBLKSZ           AND CALCULATE THE ADDRESS                   
         AI,R1    DCBLOCKS-DCBLKSZ+1 OF DCB AREA, DCB PER SE                    
         AW,R1    R6                                                            
         AI,R8    1                                                             
         B        *R8               GOT IT RETURN                               
*                                                                               
*                                                                               
RTRNDCB  RES      0                 RETURN DCB BLOCK AREA                       
         BAL,R8   GETDCB                                                        
         B        *R11              NOT THERE, JUST RETURN                      
         LI,R0    JCBPOINT                                                      
         AW,R0    R1                                                            
         LB,R3    *R0               GET ENDING FLAGS                            
         AND,R3   R9                TURN ONE OFF                                
         STB,R3   *R0                                                           
         CI,R3    INITEND+OCEND+LOGEND                                          
         BANZ     *R11              OUT IF OTHERS WAIT                          
         LI,R0    DCBLIST                                                       
         BAL,R3   SEARCHIT          SEARCH OUT RETURNABLE BLOCK                 
         B        *R11                                                          
         LI,R3    0                                                             
         STB,R3   *R0,R1                                                        
         LB,R0    DCTTJE,R7         TEST IF LINE IS ACTIVE                      
         CI,R0    TJEACT                                                        
         BANZ     *R11              RETURN IF SO                                
         LW,R0    TJE:NOW           OTHERWISE,                                  
         AI,R0    -1                DECREMENT THE NUMBER ACTIVE                 
         STW,R0   TJE:NOW                                                       
         B        *R11                                                          
*                                                                               
*                                                                               
SEARCHIT RES      0                 SEARCH OUT LINE INDEX IN LIST               
         AW,R0    R6                                                            
         LB,R1    *R0                                                           
         CB,R7    *R0,R1                                                        
         BE       1,R3                                                          
         BDR,R1   %-2                                                           
         B        *R3                                                           
*                                                                               
*                                                                               
         PAGE                                                                   
LINKDCB  BAL,R8   GETDCB            TEST FOR DCB ASSIGNED                       
         B        %+2               NOT ASSIGNED                                
         B        *R5               ALREADY ASSIGNED                            
         LB,R1    *R0               FIND A FREE SLOT                            
         LB,R8    *R0,R1                                                        
         BEZ      %+3               YES - GOT IT                                
         BDR,R1   %-2               NO - KEEP LOOKING                           
         B        1,R5              INDICATE ALL IN USE                         
         STB,R7   *R0,R1            MAKE ASSIGNMENT TO FREE SPACE               
         LI,R8    5                                                             
         LI,R0    LOGERCNT          SET LOGON RETRY COUNT                       
         AW,R0    R6                                                            
         STB,R8   *R0,R1                                                        
         BAL,R8   GETDCB            NOW TRY IT                                  
         B        %+1                                                           
         LI,R3    7                 SET LINE INDEX INTO DCB                     
         STB,R7   *R1,R3                                                        
         LI,R0    0                                                             
         STW,R0   JCBPOINT,R1       CLEAR JCB ADDRESS                           
         B        2,R5                                                          
*                                                                               
*                                                                               
         PAGE                                                                   
ACTION   RES      0                                                             
         BAL,R5   LINKDCB           ASSIGN LINE TO DCB AREA                     
         B        ACTIONX           ALREADY LINKED -- PRESUME: RETRY OR,        
*                                   OFF AND THEN ON BEFORE FINAL MESSAGE        
*                                   WRAP UP, SINCE DCTTJE SET ZERO ON           
*                                   LAST MESSAGE - WAIT FOR COMPLETION          
*                                                                               
         B        CONSCAN           NO MORE DCB SPACE AVAIABLE - WAIT           
*                                   UNTIL SOME FREES UP                         
*                                                                               
         RES      0                 DCB PROVIDED - GO FORTHE                    
*                                                                               
LINECHEX LW,R0    TJE:NOW           CHECK AGAINST MAXIMUM LINES                 
         CW,R0    TJE:NUM                                                       
         BGE      OVERFLOW          PASS ON LINE IF AT MAX.                     
         AI,R0    1                 OTHERWISE ADD TO COUNT                      
         STW,R0   TJE:NOW                                                       
         B        LOGON             AND GO FORTHE                               
*                                                                               
OVERFLOW LI,R0    0                 BY-PASS THE LOGON                           
         STB,R0   DCTTJE,R7                                                     
         B        CONSCAN           CONTINUE SCAN OF LINES                      
*                                                                               
ACTIONX  LW,R8    JCBPOINT,R1       CHECK LOGGING STATUS                        
         LB,R8    R8                                                            
         CI,R8    LOGEND+OCEND                                                  
         BANZ     CONSCAN           IF STSTUS, THEN IN KILL MODE                
         B        LOGON             OTHERWIZE, IT'S A RETRY                     
*                                                                               
         PAGE                                                                   
LOGON    RES      0                 WRITE OUT LOGNON MESSAGE                    
         LI,R9    TJETEX            FLAG LOGON PROCESS                          
         BAL,R8   TJESET                                                        
         BAL,R8   NEWLINE           SEND NEW LINE                               
*                                                                               
         LI,R2    LMSGEND-LOGONMSG  MESSAGE SIZE                                
         LI,R0    TIDMSG-1          DISPLACEMENT WITHIN DCB BLOCK               
         AW,R0    R1                ADJUSTMENT TO ADDRESS OF DCB                
         LI,R3    LOGONMSG-1                                                    
         LW,R8    *R3,R2            TRANSFER MESSAGE TO DCB BLOCK               
         STW,R8   *R0,R2                                                        
         BDR,R2   %-2                                                           
         LI,R8    X'10'             SET TIME FPT IN REGISTER                    
         AI,R0    LOGDATE-LOGONMSG+1                                            
         STB,R8   R0                                                            
         CAL1,8   R0                GET TIME                                    
         LW,R0    RITEFPT,R6                                                    
         LI,R3    0                 WRITE OUT FIRST PART OF MESSAGE             
         LI,R0    -DRCBIT-1         SET DRC BIT OFF - INITIALLY                 
         AND,R0   *R1                                                           
LOGON1   RES      0                 CLEAR AND SET THE DRC BIT                   
         STW,R0   *R1                                                           
         B        LOGPT1                                                        
LOGPT3   LI,R3    2                 WRITE OUT PART THREE                        
         LI,R0    DRCBIT            SET DRC ON FOR ACCOUNT READ                 
         OR,R0    *R1                                                           
         B        LOGON1                                                        
LOGPT2   LI,R3    1                 WRITE OUT PART TWO                          
LOGPT1   LB,R0    LOGRTRN,R3        CONSTRUCT CONTINUANCE                       
         AI,R0    LOGON                                                         
         STB,R7   R0                                                            
         STW,R0   -1,R1             SAVE  AS PREFIX TO DCB                      
         LB,R2    LOGADRS,R3                                                    
         AW,R2    R1                OUTPUT ADDRESS                              
         LB,R3    LOGBYTES,R3                                                   
         CAL1,1   RITEFPT,R6        NOW WRITE OUT LOGON MESSAGE                 
         CERR     C:E1                                                          
         B        TESTLOOP          AND PROCEDE                                 
*                                                                               
LOGONMSG RES      0                 TRANSFER LOGON TO DCB SPACE                 
         DATA,2   0,'TE'                                                        
         TEXT     'LEFILE CP-R AT YOUR SERVICE'                                 
TIMELINE RES      0                                                             
         DATA     X'0000D6D5'                                                   
         TEXT     ' AT '                                                        
LOGDATE  RES      0                                                             
TERMNLID DATA     X'155A5A40'       USE SPACE FOR TERMNL ID.                    
         TEXT     ' TERMINAL JO'                                                
LOGLINE  RES      0                                                             
         DATA     X'0000D3D6'                                                   
         TEXT     'GON PLEASE: '                                                
LLINEND  RES      0                                                             
LMSGEND  RES      0                 END-OF-LOGON MEASSAGE                       
*                                                                               
*                                                                               
*                                                                               
PART1    EQU      TIMELINE-LOGONMSG                                             
PART2    EQU      LOGLINE-TIMELINE                                              
PART3    EQU      LLINEND-LOGLINE                                               
*                                                                               
LOGADRS  DATA,1   LOGMSG,LOGMSG+PART1,LOGMSG+PART1+PART2                        
         BOUND    4                                                             
LOGBYTES DATA,1   4*PART1,4*PART2,4*PART3                                       
         BOUND    4                                                             
LOGRTRN  DATA,1   LOGPT2-LOGON,LOGPT3-LOGON,ACTION1-LOGON                       
         BOUND    4                                                             
         PAGE                                                                   
ACTION1  RES      0                                                             
READACC  RES      0                 READ LOGON ACCOUNT                          
         LW,R8    RDAC1             GET CONTINUATION ADDRESS                    
         STB,R7   R8                SET IN DEVICE INDEX                         
         STW,R8   -1,R1             SAVE WORD BEFORE DCB                        
         LI,R0    -DRCBIT-1         CLEAR DRC IN THE DCB                        
         AND,R0   *R1                                                           
         STW,R0   *R1                                                           
         LI,R2    ACCBLK                                                        
         AW,R2    R1                SET INPUT BLOCK ADDRESS                     
         LI,R3    24                SET BYTE COUNT                              
         CAL1,1   READFPT,R6        READ THE ACCOUNT NUMBER(N0-WAIT)            
         CERR     C:E2                                                          
         B        TESTLOOP                                                      
RDAC1    DATA     ACTION2                                                       
         PAGE                                                                   
ACTION2  RES      0                                                             
         BAL,R8   VERACCNT          VERIFY ACCOUNT FORMAT                       
         B        ACCERROR          OUT IF BAD TYPE-IN                          
         LCI      5                                                             
         STM,R11  SJOBFPT+6,R6      SET ACCOUNT/NAME                            
         BAL,R13  LINENAME          FETCH LINE NAME/JOB NAME                    
         LCI      2                                                             
         STM,R14  SJOBFPT+3,R6      SET INTO SJOB FPT                           
         LI,R13   SJOBERR           SETUP TO SET ERROR RETURN                   
         STW,R13  SJOBFPT+2,R6      ERROR ADDRESS                               
         LW,R10   Y01               PRESET SJOB CAL GOOD TYC                    
         CAL1,7   SJOBFPT,R6        DO START JOB AND AI SEARCH                  
         CERR     C:E6                                                          
SJOBERR  LI,R0    1                 PRESET ACCOUNT GOOD FLAG                    
         LB,R13   R10               TYC                                         
         CI,R13   TYCNORM           IS ACCOUNT/JOB GOOD                         
         BE       TEXX01            B IF YES                                    
         CI,13    TYC7B             ACCOUNT FAILURE                             
         BNE      TEXERROR          B IF NO - SOMEOTHER KIND                    
         LI,R0    0                 ACCOUNT FAILURE                             
TEXX01   EQU      %                                                             
         STW,R0   SQTEMP1,R6        SET PASS FAIL FLAG                          
         PAGE                                                                   
         BAL,R8   GETDCB            LINKUP EXISTING DCB BLOCK                   
         ERR      E:E4              NOT FOUND ERROR                             
         LW,R0   SQTEMP1,R6         CHECK ACCOUNT STATUS                        
         BEZ      %+2               SKIP FORWARD ON NO-SHOW                     
         BAL,R8   NEWLINE           OTHERWISE, SET CONTINUATION                 
*                                   AND SPACE PAPER                             
         BAL,R8   TERMID            SET MESSAGE COMMENT                         
         LW,R5    SQTEMP1,R6        RESTORE MESSAGE DISCRIMINATE                
         LI,R8    ACCBLK                                                        
         AW,R8    R1                POINT TO ACCOUNT FIELD                      
         LW,R3    SQTEMP2,R6        ACCOUNT BYTE COUNT                          
         LI,R4    -3                                                            
*                                                                               
ONOFFMSG RES      0                 TERMINAL STATUS MESSAGES                    
         LW,R0    ACNT4,R5          TACK ON COMMENT                             
         LB,R9    R1,R4                                                         
         STB,R9   *R8,R3                                                        
         AI,R3    1                                                             
         BIR,R4   %-3                                                           
         AI,R3    (ACCBLK-TIDMSG)*4                                             
         LW,R4    3,R1              SAVE MSG. BYTE COUNT FOR OC MSG.            
         STB,R3   R4                                                            
         STW,R4   3,R1                                                          
         LW,R0    ACNT5,R5          PICKUP CONTINUATION ADDRESS                 
         STB,R7   R0                SET LINE INDEX                              
         STW,R0   -1,R1             SET CONTINUATION WORD                       
         LI,R2    TIDMSG            SET MESSAGE ADDRESS                         
         AW,R2    R1                ADJUST FOR MESSAGE IN DCB                   
         CAL1,1   RITEFPT,R6                                                    
         CERR     C:E4                                                          
         LW,R5    R5                                                            
         BEZ      TESTLOOP          NO SHOW ACCOUNT EXIT                        
         LI,R9    OCEND+LOGEND                                                  
         BAL,R11  ENDSET            SET ENDING FLAGS, DCB RELEASE               
         LI,R9    OCMESSG           FOR ACCOUNT FOUND                           
         LI,R0    OCQUEUE           WRITE TERMINAL ID. FOR OPERATOR             
         BAL,R8   ENQUEUE                                                       
         B        TESTLOOP          AWAIT COMPLETION OF MESSAGE                 
         PAGE                                                                   
PREINIT  BAL,R8   NEWLINE           SPACE BEFORE INITIAL TEL ENTRY              
*                                                                               
         LI,R9    TJEACT            SET LINE ACTIVE                             
         BAL,R8   TJESET                                                        
         LI,R9    -TJEON-TJETEX-1                                               
         BAL,R8   TJESET            TURN OFF - ON AND TEX BIT                   
         BAL,R13  LINENAME          GET LINE NAME                               
         BAL,R13  GETJCBAD          DETERMINE THE JCB ADDRESS                   
         LW,R8    JCBPOINT,R1                                                   
         LB,R8    R8                SAVE ENDING FLAGS SET                       
         STB,R8   R3                                                            
         STW,R3   JCBPOINT,R1       SAVE JCB INFO WHILE GETTING                 
         LI,R10   0                                                             
         STW,R10  JCBNXLM,R3        INSURE LM FILE ID BLOCK STARTS 0            
REINIT   BAL,R13  LINENAME          GET LINE NAME                               
         LCFI     5                                                             
         LM,R9    SETTEL                                                        
         CAL1,7   R9                PREPARE TEL INITIALIZATION                  
         CERR     C:E7                                                          
         B        INITTEL           GO AND INIT TEL                             
*                                                                               
*                                                                               
*                                                                               
SETTEL   DATA     X'51800000'                                                   
         DATA     P1+P3+P6+P11+P12                                              
         DATA     TEXERROR                                                      
         TEXT     'TEL TEL '                                                    
*                                                                               
ACNT4    DATA     X'00406F6F'       QUESTION MARKS                              
         TEXT     '  ON'                                                        
         TEXT     ' OFF'                                                        
ACNT5    DATA     ACCFAIL,PREINIT   CONTINUATION POINTERS                       
         DATA     ACCFOUND                                                      
*                                                                               
*                                                                               
NEWLINE  STB,R7   R8                SEND OUT LINEFEED/SPACE MESSAGE             
         STW,R8   -1,R1             FIX CONTINUATION WORD                       
         LI,R2    LINEFEED                                                      
         AW,R2    R6                                                            
         LI,R3    1                                                             
         CAL1,1   RITEFPT,R6        WRITE THE NEWLINE                           
         CERR     C:E12                                                         
         B        TESTLOOP                                                      
         PAGE                                                                   
TERMID   LD,R2    DCT16,R7          SET TERMINAL ID. IN MESSAGE                 
         AW,R2    TRMI1                                                         
         SCD,R2   8                                                             
         STW,R2   TIDMSG+3,R1                                                   
         STW,R3   TIDMSG+4,R1                                                   
         LCFI     4                 SHIFT LEADIN COMMENT TO DCB                 
         LM,R2    TERMNLID                                                      
         STM,R2   OPTIDMSG,R1                                                   
         B        *R8                                                           
TRMI1    DATA     X'2B67E600'                                                   
*                                                                               
*                                                                               
GETJCBAD RES      0                 PICK UP THE JCB ADDRESS                     
         LB,R2    SJI3              DETERMINE JCB ADDRESS                       
         LW,R3    SJI1,R2                                                       
         AND,R3   M17                                                           
         CD,R14   SJI2,R2           SEARCH ON JOB NAME                          
         BE       *R13                                                          
         BDR,R2   %-4                                                           
         LI,R3    0                                                             
         B        *R13                                                          
*                                                                               
*                                                                               
LINENAME LD,R14   DCT16,R7          GET LINE NAME                               
         SLD,R14  24                                                            
         OR,R15   X404040                                                       
         B        *R13                                                          
         PAGE                                                                   
KILLLINE RES      0                 TERMINATE LINE ACTIVITY                     
         LB,R2    DCTTJE,R7         TEST FOR NUANCE                             
         CI,R2    TJETEX            QUESTION LOGGIN-ON                          
         BANZ     LINEOFF           YES, CONCURRENT ON/OFF...EXIT               
*                                                                               
         BAL,R13  LINENAME          GET LINE NAME                               
         BAL,R5   LINKDCB           AND TEST DCB LINKUP                         
         B        KILL0             ALREADY LINKED - OK                         
         B        CONSCAN           NO AREA AVAILABLE - BE PAITENT              
         BAL,R13  GETJCBAD                                                      
         STW,R3   JCBPOINT,R1       SAVE JCB ADDRESS                            
KILL0    RES      0                                                             
         LW,R3    JCBPOINT,R1       CHECK IF ACTION PENDING                     
         LB,R8    R3                                                            
         CI,R8    OCEND+LOGEND                                                  
         BANZ     CONSCAN           IF SO, AWAIT COMPLETION                     
         LI,R0    TJEACT                                                        
         CB,R0    DCTTJE,R7                                                     
         BAZ      %+4                                                           
         LCFI     5                 SAVE ACCOUNT BACK IN WORLSPACE              
         LM,R9    JCBACCNT,R3                                                   
         STM,R9   INITBLK,R1                                                    
         LI,R9    -TJEACT-1         MAKE NON-ACTIVE BEFORE KILL                 
         BAL,R8   TJESET                                                        
         LW,R12   KJOBER                                                        
         LW,R13   KJOBER+1                                                      
         CAL1,7   R12               CLOBBER LINE TIL DEAD                       
         LB,R2    SJI3              SEARCH FOR TABLE REMOVAL                    
         CD,R14   SJI2,R2                                                       
         BE       CONSCAN           IF FOUND, WAIT FOR ANOTHER SHOT             
         BDR,R2   %-2                                                           
         BAL,R8   TERMID            SET MESSAGE LEADIN                          
         LW,R14   DLETEFPT                                                      
         LI,R15   1                                                             
         CAL1,7   R14               IF DEAD, DELETE ALL STATUS                  
         LI,R9    TJEKILL           SET KILL-MODE                               
         BAL,R8   TJESET                                                        
         BAL,R8   NEWLINE           AND SPACE PAPER                             
OVERBGEX B        OFFVERBG          CONTINUE CONSTRUCT IN TEX1 OLAY             
*                                                                               
*                                                                               
KJOBER   DATA     X'64800000'                                                   
         DATA     P11+P12+F7                                                    
DLETEFPT DATA     X'C7000001'                                                   
         PAGE                                                                   
ACCFAIL  LI,R0    DCBLIST           ACCOUNT INVALID                             
         BAL,R3   SEARCHIT          FIND DCB INDEX                              
         ERR      E:E6              CAN'T FIND LINKAGE, ERROR                   
ACFL1    LI,R15   LOGERCNT          GET CURRENT RETRY COUNT                     
         AW,R15   R6                                                            
         LB,R5    *R15,R1                                                       
         BDR,R5   ACFL2             OUT ON MORE                                 
         B        LINEOFF           EXIT THE LINE DIRECTLY                      
ACFL2    STB,R5   *R15,R1           RESTORE RETRIES                             
         LI,R5    TJEON             AND START FROM BEGINING                     
         STB,R5   DCTTJE,R7                                                     
         B        TESTLOOP                                                      
*                                                                               
*                                                                               
LINEOFF  RES      0                                                             
         BAL,R8   GETDCB            LINK TO DCB                                 
         B        %+1               BOGUS                                       
         LW,R14   DLETEFPT          CLEAR DCB ACTIVITY                          
         LI,R15   1                                                             
         CAL1,7   R14                                                           
         LI,R0    0                                                             
         STB,R0   DCTTJE,R7         CLEAR LINE FLAGS (KILL)                     
         BAL,R8   NEWLINE                                                       
ACCFOUND LI,R9    -LOGEND-1         LOG MESSAGES TO LINE COMPLETE               
         B        CHECKDCB          MAKE EFFORT TO FREE DCB BLOCK               
*                                                                               
         PAGE                                                                   
ACCERROR RES      0                                                             
         LI,R3    6+LLINEND-LOGLINE ERROR MESSAGE WORD COUNT                    
         LI,R2    LOGLINE-LLINEND                                               
         AW,R2    R9                POINTER TO OUTPUT BLOCK                     
         LW,R15   ACLC2             CLEAR FLAG ERROR LINE                       
         STW,R15  *R2,R3                                                        
         BDR,R3   %-1                                                           
         LW,R0    ACLC1             INSERT LEAD NULLS, IF ANY                   
         STW,R0   *R2                                                           
         LI,R15   '?'               SET FLAG                                    
         STB,R15  *R9,R4                                                        
         LI,R3    4*(6+LLINEND-LOGLINE)    BYTE COUNT                           
         LI,R0    ACCFAIL           SET CONTINUATION WORD                       
         STB,R7   R0                                                            
         STW,R0   -1,R1                                                         
         CAL1,1   RITEFPT,R6        IMPORT KNOWLEDGE                            
         CERR     C:E11                                                         
         B        TESTLOOP          AWAIT PRODDING                              
ACLC1    DATA     X'00004040'                                                   
ACLC2    TEXT     '    '                                                        
*                                                                               
*                                                                               
         PAGE                                                                   
OCMSG0   LI,R8    TESTLOOP                                                      
         STW,R8   RTNLINK,R6                                                    
         BAL,R8   GETDCB            GET WOKSPACE ADDRESS                        
         B        OCMSG1            SKIP IF MISSING                             
         LI,R9    -OCEND-1          OC MESSAGE COMPLETE                         
         BAL,R11  RTRNDCB           MAKE EFFORT TO CLEAR DCB BLOCK              
OCMSG1   LI,R0    OCQUEUE           REMOVE CURRENT MESSAGE INDEX                
         BAL,R8   DEQUEUE                                                       
         B        TESTLOOP          QUEUE EMPTY                                 
         B        OCMSG2                                                        
*                                                                               
*                                                                               
OCMESSG  RES      0                 INITIATE OC MESSAGE                         
         STW,R8   RTNLINK,R6                                                    
OCMSG2   BAL,R8   GETDCB                                                        
         B        OCMSG1            NO WOKSPACE, FORGET IT                      
         LI,R2    OPTIDMSG          SET MESSAGE ADDRESS                         
         AW,R2    R1                                                            
         LW,R3    3,R1                                                          
         LB,R3    R3                MESSAGE BYTE COUNT                          
         AI,R3    4                                                             
         LI,R0    OCMSG0            SET LINE INDEX AND ADDRESS OF RETURN        
         STB,R7   R0                                                            
         STW,R0   OCDCB-1,R6                                                    
         CAL1,1   OCWRITE,R6                                                    
         CERR     C:E5                                                          
LINKRTRN LW,R0    RTNLINK,R6        SUB-FUNCTION RETURN                         
         B        *R0                                                           
         PAGE                                                                   
INITTEL  RES      0                 INITIAL TEL INITIATION                      
         BAL,R5   LINKDCB           FIND WORKSPACE                              
         B        %+2               ALREADY LINKED, VERY GOOD                   
         B        CONSCAN           NO SPACE AVAILABLE, BE PATIENT              
*                                   LINKAGE PROVIDED, NIFTY                     
         LI,R5    INITBLK-1                                                     
         AW,R5    R1                                                            
         LI,R0    INTL1             SET LINE AND ADDRESS FOR RETURN             
         STB,R7   R0                                                            
         STW,R0   *R5                                                           
         AI,R5    1                                                             
         BAL,R13  LINENAME          GET JOB NAME                                
         BAL,R13  GETJCBAD          AND DETERMINE JCB ADDRESS                   
         LB,R1    DCTTJE,R7         GET FLAG BYTE FOR LINE                      
         LI,R9    -TJEDBG-TJEINIT-1 TURN OFF INIT AND DEBUG BITS                
         BAL,R8   TJESET                                                        
*                                                                               
*        SET UP THE INIT FPT                                                    
*                                                                               
         DO1      #DFACNT                                                       
         LI,R0    BLANKS            DEFAULT ACCOUNT NAME                        
         LCI      4                                                             
         LM,R10   INITFPTX          FIRST 4 WORDS OF FPT                        
*        JOB NAME IS IN R14, R15 AS A RESULT OF BAL LINENAME                    
         CI,R1    TJEDBG                                                        
         BAZ      %+2               B IF DEBUG NOT NEEDED                       
         AI,R11   F4                INCLUDE DEBUG F-BIT                         
         LCI      6+#DFACNT*1                                                   
         STM,R10  *R5               PUT FPT IN WORKSPACE                        
*        FPT IS SET UP TO INIT TEL                                              
         LI,R4    0                                                             
         XW,R4    JCBNXLM,R3        GET LMID BLOCK PTR AND ZERO IT              
         BEZ      INTL05            NO LMID BLOCK. INIT TEL.                    
*        ALTER FPT FOR NON-TEL INIT                                             
         LI,R1    X'FFFF'                                                       
         LS,R0    0,R4              GET AREA NAME                               
         STS,R0   0,R5              SET IT IN FPT WORD 0                        
         DO       #DFACNT                                                       
         LCI      2                                                             
         LM,R1    3,R4              GET LOAD MODULE FILE ACCOUNT NAME           
         LW,R0    R5                                                            
         AI,R0    7                 POINTER TO ACNT NAME IN WORKSPACE           
         LCI      3                                                             
         STM,R0   6,R5              PUT POINTER AND NAME IN FPT                 
         FIN                        #DFACNT                                     
*        RELEASE LMID BLOCK                                                     
         XW,R7    R4                GET POINTER, SAVE LINE INDEX                
         BAL,R8   RELTEMP           RELEASE BLOCK                               
         LW,R7    R4                RESTORE LINE INDEX                          
*                                                                               
INTL05   RES      0                                                             
         CAL1,7   *R5               DO INITIATE CAL                             
         CERR     C:E9                                                          
         LCFI     5                                                             
         LM,R9    SETTEL            SET TEL TO TEL                              
         CAL1,7   R9                                                            
         CERR     C:E10                                                         
         LI,R9    INITEND                                                       
         BAL,R11  ENDSET            SET ENDING FLAG, DCB RELEASE                
         B        ACCFOUND                                                      
*                                                                               
*                                                                               
INTL1    RES      0                 INITIATION COMPLETE                         
         LI,R9    -INITEND-1                                                    
CHECKDCB BAL,R11  RTRNDCB           MAKE EFFORT TO RETURN DCB                   
         B        TESTLOOP                                                      
*                                                                               
*                                                                               
INITFPTX RES      0                 BASIC MASK FOR INIT CAL                     
         GEN,8,1,23  X'48',1,'SP'                                               
         DATA     P1+P3+P11+P12+#DFACNT*P14+F2+F5                               
         DATA     TEXERROR                                                      
         TEXT     'TEL '                                                        
*                                                                               
*                                                                               
*                                                                               
TJESET   RES      0                 MAKE TJE BIT SETTINGS                       
         DISABLE                    COOL IT FOR BIT MANIPULATION                
         LB,R0    DCTTJE,R7                                                     
         LW,R9    R9                                                            
         BLZ      %+3               SKIP FOR RESET                              
         OR,R0    R9                SET APPROPRIATE BIT                         
         B        %+2                                                           
         AND,R0   R9                RESET APPROPRIATE BIT                       
         STB,R0   DCTTJE,R7                                                     
         ENABLE                                                                 
         B        *R8                                                           
*                                                                               
*                                                                               
ENDSET   RES      0                 SET ENDING FLAGS FOR DCB RELEASE            
         LI,R0    JCBPOINT          SET ASYNCHRONOUS ENDING FLAGS               
         AW,R0    R1                                                            
         LB,R10   *R0                                                           
         OR,R9    R10                                                           
         STB,R9   *R0                                                           
         B        *R11                                                          
         PAGE                                                                   
TEXERROR RES      0                 PROCESS ALL ERRORS                          
         STW,R1   REGISTR1,R6       SAVE WORK REGISTER                          
         AI,R8    -TOPLOC                                                       
         STW,R8   REGISTR8,R6                                                   
         LH,R1    ERRLIST                                                       
         LH,R8    ERRLIST,R1                                                    
         AND,R8   M9                                                            
         CW,R8    REGISTR8,R6                                                   
         BE       %+3                                                           
         BDR,R1   %-4                                                           
         BAL,R8   TEXERROR+1                                                    
E:E12    RES      0                                                             
         LH,R8    ERRLIST,R1                                                    
ANLERREX B        ANALYSE                                                       
*                                                                               
*                                                                               
RETRY    EQU      1                 INCLUDE TYC                                 
KILL     EQU      0                 INCLUDE TYC                                 
BOGUS    EQU      4                                                             
NOTE     EQU      2                                                             
REDO     EQU      5                 NO TYC                                      
ERRLIST  DATA,2   HA(ERRLEND)-HA(ERRLIST)-1                                     
         EMAP     C:E1,RETRY,1      LINE WRIT                                   
         EMAP     C:E2,RETRY,2      LINE READ                                   
         EMAP     C:E11,RETRY,1     LINE WRITE                                  
         EMAP     C:E4,KILL,4       TERMINAL ID. MESS. FAILURE                  
         EMAP     C:E6,KILL,5       FAIL ON SJOB                                
         EMAP     C:E12,KILL,9      FAIL ON WRITE SPACE                         
         EMAP     C:E9,KILL,12      FAIL ON INIT                                
         EMAP     C:E13,0,13        FAILURE THRU TESTING                        
         EMAP     C:E10,KILL,6      FAIL ON REFRESH OF SETNAME                  
         EMAP     C:E5,NOTE,7       FAIL ON OC WRITE                            
         EMAP     C:E7,KILL,8       FAIL ON SETNAME                             
         EMAP     E:E4,BOGUS,15     LOGIC ERROR                                 
         EMAP     E:E6,BOGUS,15     LOGIC ERROR                                 
         EMAP     E:E12,BOGUS,0     UNMAPPED ERROR                              
ERRLEND  RES      0                                                             
         BOUND    4                                                             
A:TEX2   RES      0                                                             
         OLAYEND                                                                
         FIN      #TJE                                                          
         END                                                                    
