         SYSTEM   OPTIONS                                                       
         DO       #TJE                                                          
         DEF      TEL3                                                          
         DEF      TEL3RD                                                        
         PCC      0                                                             
         PSYS     0                                                             
OLAYFLAG EQU      'TEL3'                                                        
         SYSTEM   CPRMON                                                        
         PSYS     1                                                             
         SYSTEM   OLAYBASE                                                      
         TITLE    '** TEL3 **'                                                  
CERR     CNAME                                                                  
         PROC                                                                   
AF       RES      0                                                             
         PEND                                                                   
ERR      CNAME                                                                  
         PROC                                                                   
LF       RES      0                                                             
         BAL,R8   TELERROR                                                      
         CERR     AF                                                            
         PEND                                                                   
         PAGE                                                                   
         DO1      UTS                                                           
         REF      M:UC                                                          
BEGINLST RES      0                 LIST FOR ADDRESS MODIFICATION               
         DO1      1-UTS                                                         
         DATA,1   READFPT                                                       
         DATA,1   READFPT+2,READFPT+3                                           
         DATA,1   READFPT+4                                                     
         DATA,1   LINEDCB+3,LINEDCB+4                                           
         DO1      1-UTS                                                         
         DATA,1   WRITEFPT                                                      
         DATA,1   WRITEFPT+2,WRITEFPT+3                                         
         DATA,1   OPERFPT                                                       
         DATA,1   OPERFPT+2,OPERFPT+3                                           
         DATA,1   OPERDCB+3,OPERDCB+4                                           
         DATA,1   RUNDCB+3,RUNDCB+4                                             
         DATA,1   RUNASN,RUNASN+2,RUNASN+3,RUNASN+4                             
         DATA,1   RUNOPEN                                                       
         DATA,1   RUNCLOSE                                                      
         DATA,1   INITFPT+2,INITFPT+5,INITFPT+6                                 
         DATA,1   MEDFPT+2,MEDFPT+3,MEDFPT+4                                    
         DATA,1   STDLBFPT,STDLBFPT+2,STDLBFPT+3,STDLBFPT+4                     
         DATA,1   BATCHFPT+2,BATCHFPT+3,BATCHFPT+4,BATCHFPT+5                   
         DATA,1   BATCHFPT+6,BATCHFPT+7,BATCHFPT+8                              
         DATA,1   JSTATFPT+2,JSTATFPT+3,JSTATFPT+4,JSTATFPT+5                   
         DATA,1   JDELFPT+2,JDELFPT+3                                           
         DATA,1   TELTPRTN                                                      
ENDADRL  RES      0                                                             
         BOUND    4                                                             
*                                                                               
         PAGE                                                                   
TEL3     RES      0                 SET UP TEL WORKSPACE                        
*                                                                               
         LI,R0    X'08'             ENTER MASTER MODE                           
         SCS,R0   -8                                                            
         CAL1,5   R0                                                            
         LPSD,0   TEL101            NOW GET OUT OF MASTER MODE PROTECTED        
         BOUND    8                 AND GET CORRECT WRITE KEY FOR               
TEL101   EQU      %                 MESSING AROUND IN THE MONITOR               
         GEN,12,20  X'004',TEL102   BUT STAY MAPPED                             
         DATA     0                                                             
TEL102   EQU      %                 SALLY FORTHE                                
*                                                                               
*                                                                               
         LB,R7    TCBPOINT                                                      
         LB,R7    STIJID,R7                                                     
         LD,R12   SJI2,R7           GET JOB NAME                                
         LW,R7    SJI1,R7           JCB ADDRESS                                 
         LW,R2    JCBTJEBB,R7       TEST IF BLOCKING BUFFER ASSIGNED            
         BEZ      TEL103            OUT TO MAKE ASSIGNMENT                      
         LW,R2    *R2               IF ASSIGNED, SET BASE INDEX                 
         AND,R2   M17                                                           
         LW,R0    WKAREA            DEBUG BRANCH                                
         STW,R0   LOOKSEE,R2                                                    
         LI,R0    0                                                             
         STW,R0   CNTRLFLG,R2       CLEAR CONTROL ENTRY FLAG                    
         B        TEL3RD            GO TO READ A COMMAND                        
TEL103   EQU      %                                                             
         LI,R3    0                 SET FOR INITIAL ERROR MESSAGES              
         BAL,R5   FINDBB            PICKUP BLOCKING BUFFER                      
         B        ERRORBB                                                       
         LW,R2    *R15                                                          
         AND,R2   M17                                                           
         STW,R15  JCBTJEBB,R7       SAVE BLK.BUF. IN JCB                        
         PAGE                                                                   
SHFT0    RES      0                                                             
         LI,R1    0                                                             
         LI,R4    255               CLEAR ALL OF WORK AREA                      
         STW,R1   *R2,R4                                                        
         BDR,R4   %-1                                                           
         LI,R1    ENDBLOCK-ABSVAL(WKAREA)-1                                     
         LW,R0    WKAREA,R1         SHIFT WORK AREA STUFF                       
         STW,R0   *R2,R1                                                        
         BDR,R1   %-2                                                           
         LW,R0    WKAREA                                                        
         STW,R0   *R2                                                           
         AW,R0    R1                                                            
         LI,R1    0                 ADJUST TEMPLATE REFS                        
         LI,R6    BA(ENDADRL)-BA(BEGINLST)                                      
SHFT2    LB,R0    BEGINLST,R1       LOAD ADJ. POINTER                           
         BEZ      SHFT3             OUT ON NULL ADDRESS                         
         AW,R0    R2                ADD AERA ADDRESS                            
         LW,R4    *R0               PICK UP DATA WORD                           
         AW,R4    R2                                                            
         STW,R4   *R0               AND RESTORE                                 
SHFT3    AI,R1    1                                                             
         BDR,R6   SHFT2                                                         
         DO1      UTS                                                           
         B        TEL3RD            GO TO READ A COMMAND                        
*                                                                               
*                                                                               
         LH,R1    DCT7              USE JOBNAME TO FIND LINE INDEX              
         LD,R14   DCT16,R1                                                      
         SLD,R14  24                                                            
         OR,R15   X404040                                                       
         CD,R12   R14                                                           
         BE       %+3                                                           
         BDR,R1   %-5                                                           
         B        ERRORID                                                       
         STW,R12  JOBNAME,R2                                                    
         STW,R13  JOBNAME+1,R2                                                  
         STW,R1   LINEINDX,R2                                                   
         STW,R7   TELJCBAD,R2       SAVE JCB ADDDRESS IN WORKSPACE              
         LI,R7    7                                                             
         LI,R8    LINEDCB           ENTER LINE INDEX INTO DCB                   
         AW,R8    R2                                                            
         STB,R1   *R8,R7                                                        
*                                   GET TEMP SPACE FOR TABS                     
         LI,R7    4                                                             
         BAL,R8   GETTEMP                                                       
         B        ERRORTS                                                       
         LW,R1    TELJCBAD,R2       SAVE TEMP POINTER                           
         STW,R7   JCBTABS,R1                                                    
         LI,R4    JCBPRMPT          BYTE INDEX FOR PROMPT                       
         LI,R8    '>'               R8 = DEFAULT PROMPT CHAR                    
         STB,R8   *R1,R4            STORE IN JCB                                
         ENABLE                                                                 
         LI,R1    4                 AND CLEAR TAB SPACE                         
         LW,R8    TABS              SET DEFAUT TAB SETTINGS                     
         STW,R8   *R7                                                           
         LI,R8    0                                                             
         AI,R7    1                                                             
         BDR,R1   %-3                                                           
*                                                                               
         LI,R0    OPLBLIST          SET OPLABELS TO CONTROL TERMINAL            
         AW,R0    R2                POINTER TO OPLABEL LIST                     
         LH,R1    *R0               NR OF OPLABELS IN LIST                      
         LI,R7    1                 FOR STORING INTO FPT                 146.010
         LCI      3                                                             
         LM,R8    STDTMNL           GET FPT                                     
         LI,R11   JOBNAME                                                       
         AW,R11   R2                POINTER TO CONTROL TERMINAL NAME            
STDLOOP  RES      0                                                             
         LH,R4    *R0,R1            GET NEXT OPLABEL                            
         STH,R4   R8,R7             PUT IT INTO FPT                      153.010
         CAL1,7   R8                DO THE STDLB                                
         BDR,R1   STDLOOP           LOOP THRU TABLE                             
TEL3RD   B        TELREAD           BRANCH INTO TEL COMMAND READ                
*                                                                               
STDTMNL  GEN,8,1,23  X'62',1,0                                                  
         DATA     P1+P3+F3                                                      
         PZE      ERRORIN                                                       
*                                                                               
TABS     DATA,1   10,19,37,0                                                    
*                                                                               
*                                                                               
ERRORIN  AI,R3    3                                                             
ERRORID  AI,R3    3                                                             
ERRORTS  AI,R3    3                                                             
ERRORBB  RES      0                 BLK. BUFF NOT AVAILABLE                     
         LCFI     7                                                             
         LM,R5    BBERRMSG                                                      
         LCFI     3                                                             
         LM,R12   BBERRMSG+7,R3                                                 
         LB,R1    TCBPOINT                                                      
         LB,R1    STIJID,R1                                                     
         LD,R10   SJI2,R1           JOB NAME- LINE IDENTIFICATION               
         SCD,R10  -8                                                            
         CAL1,2   R5                                                            
         LW,R10   KILLME                                                 178.010
         CAL1,7   R10               JOB IS INVIABLE. KILL IT             178.020
*                                                                        178.030
KILLME   GEN,8,24  X'64',0          KJOB SELF                            178.040
*                                                                               
         PAGE                                                                   
         OLAYEND                                                                
         FIN      #TJE                                                          
         END                                                                    
