         SYSTEM   OPTIONS                                                       
         DO       #TJE                                                          
         DEF      TEL1                                                          
         DEF      TELEXEC           EXECECUTE A TEL COMMAND                     
         DEF      TELERROR          COMMON ERROR PROCESSING                     
         DEF      TEL1EXIT          EXIT FROM COMMAND EXECUTION                 
         DEF      CNTRLEXT          EXIT FROM CONTROL/BREAK ENTRY               
         PCC      0                                                             
         PSYS     0                                                             
OLAYFLAG EQU      'TEL1'                                                        
         SYSTEM   CPRMON                                                        
         PSYS     1                                                             
         SYSTEM   OLAYBASE                                                      
         TITLE    '** TEL1 **'                                                  
         ORG      0                                                             
         PAGE                                                                   
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                                                          
*                                                                               
TEL1EXIT B        TELREAD           EXIT TO READ COMMAND                        
TELREADX EQU      TEL1EXIT                                                      
         PAGE                                                                   
ERRLINK  B        TELERROR                                                      
TELEXEC  RES      0                 EXECUTE TEL COMMANDS                        
TEL1     EQU      TELEXEC                                                       
         LW,R1    ERRLINK                                                       
         STW,R1   ERROR,R2                                                      
         LW,R1    TYPECMND,R2                                                   
         B        EXECMND,R1                                                    
EXECMND  DATA     0                                                             
         B        STOPIT                                                        
         B        STARTIT                                                       
         B        GOTOIT                                                        
         B        CONTINUE                                                      
         B        QUITIT                                                        
         B        EXTERM                                                        
         B        EXITER                                                        
         B        DEBUGIT                                                       
         B        SETNAMER                                                      
         B        INITER                                                        
         B        RUNIT                                                         
         B        CANCELIT                                                      
         B        JOBSTAT                                                       
         B        BATCHIT                                                       
         B        MEDIAIT                                                       
         B        MESAGEIT                                                      
         B        STDLABEL                                                      
         B        OFFER                                                         
         B        TABER                                                         
         B        RUNIT                                                         
         B        TCATIT                                                        
         PAGE                                                                   
TABER    RES      0                 SHIFT TABS TO TEMP SPACE                    
         LW,R1    TELJCBAD,R2                                                   
         LW,R1    JCBTABS,R1                                                    
         LI,R3    4                                                             
         LI,R8    TABSET                                                        
         AW,R8    R2                                                            
         LW,R0    *R8                                                           
         STW,R0   *R1                                                           
         AI,R1    1                                                             
         AI,R8    1                                                             
         BDR,R3   %-4                                                           
         B        TELREADX                                                      
*                                                                               
*                                                                               
CONTINUE RES      0                                                             
GOTOIT   RES      0                                                             
         LW,R0    CNTRLFLG,R2       TEST IF ON CONTROL/BREAK                    
         BNEZ     %+2                                                           
         ERR      E:E1              NO - COMMAND INAPPROPRIATE                  
         LI,R0    0                 OTHERWISE - CLEAR AND RETURN                
         STW,R0   CNTRLFLG,R2                                                   
         STW,R0   INTELFLG,R2                                                   
         LW,R0    TELTPRTN,R2       TAAP RETURN CAL                             
CNTRLEXT B        R0                EXECUTE RETURN CAL                          
         PAGE                                                                   
RUNIT    RES      0                 SETUP FOR TEX TO INITIATE                   
         LW,R1    RUNASN1           GET ERROR ADDR P-BIT                        
         OR,R1    GIOCT,R2          MERGE I/O ID P-BITS                         
         STW,R1   RUNASN+1,R2       PUT INTO ASSIGN FPT                         
         CAL1,1   RUNASN,R2         ASSIGN DCB TO RUN FILE                      
         LI,R10   0                                                             
         LW,R1    BRUNERR                                                       
         STW,R1   ERROR,R2          SET ERR/ABN ADDRESS                         
         CAL1,1   RUNOPEN,R2        OPEN RUN FILE                               
RUNERR   RES      0                 ALL RETURNS COME HERE                       
         LW,R0    ERRLINK                                                       
         STW,R0   ERROR,R2          RESTORE ERR/ABN RETURN                      
         LB,R0    R10                                                           
         BEZ      RUN1              B IF NORMAL RETURN                          
         CI,R0    3                                                             
         BNE      TELERROR          B IF NOT NONEXIST FILE                      
         LW,R0    FILEAREA,R2       GET AREA NAME                               
         LI,R1    1                                                             
         LH,R0    R0,R1             SIGN-EXTEND IT                              
         CH,R0    MDNAME                                                        
         BE       TELERROR          B IF IT IS SP                               
         LI,R1    S:SPAI                                                        
         CH,R0    MDNAME,R1                                                     
         BNE      TELERROR          B IF NOT SP ALTERNATE                       
         LI,R0    'SP'                                                          
         STW,R0   FILEAREA,R2       CHANGE TO SP IF IT WAS SP ALT               
         B        RUNIT             TRY AGAIN                                   
*                                                                               
RUN1     RES      0                                                             
         CAL1,1   RUNCLOSE,R2       CLOSE THE DCB                               
*        WE KNOW THE FILE EXISTS NOW.                                           
         LW,R1    TELJCBAD,R2       GET JCB ADDRESS                             
         LI,R7    3+#DFACNT*2                                                   
         BAL,R8   GETTEMP           GET BLOCK FOR LM FILE ID                    
         B        TELNOTS           REPORT NO TSPACE AND ADDRESS                
         STW,R7   JCBNXLM,R1        SAVE TSPACE ADDRESS                         
         ENABLE                                                                 
         LCI      3+#DFACNT*2                                                   
         LM,R10   GIOCT+1,R2        GET LM FILE ID                              
         STM,R10  *R7               SAVE IN TSPACE FOR TEX                      
         LI,R0    -TJEDBG-1                                                     
         LW,R7    LINEINDX,R2       GET LINE INDEX                              
         BAL,R8   TJESET            CLEAR DEBUG BIT                             
         LW,R0    DBUGFLAG,R2                                                   
         BEZ      %+3               SKIP ON NO DEBUGING                         
         LI,R0    TJEDBG                                                        
         BAL,R8   TJESET            OTHERWISE SET DEBUG                         
         BAL,R7   NAMESET           DO SET CAL FOR TSKNAME                      
         B        QUITIT            AND TERMINATE TEL                           
*                                                                               
*                                                                               
TJESET   RES      0                 MAKE TJE BIT SETTINGS                       
         DISABLE                    COOL IT FOR BIT MANIPULATION                
         LB,R9    DCTTJE,R7                                                     
         LW,R0    R0                                                            
         BLZ      %+3               SKIP FOR RESET                              
         OR,R9    R0                SET APPROPRIATE BIT                         
         B        %+2                                                           
         AND,R9   R0                RESET APPROPRIATE BIT                       
         STB,R9   DCTTJE,R7                                                     
         ENABLE                                                                 
         B        *R8                                                           
*                                                                               
RUNASN1  EQU      BITABLE           CAL ERROR ADDRESS P-BIT                     
BRUNERR  B        RUNERR            ERR/ABN FOR RUNFILE OPEN                    
         PAGE                                                                   
INITER   RES      0                 EXECUTE THE INITIATE CAL                    
         INT,R7   FILEAREA,R2       GET AREA NAME                               
         AW,R7    INTR1             MERGE INIT CAL CODE                         
         STW,R7   INITFPT,R2        SET IN INIT FPT                             
         LW,R8    GIOCT,R2          GET FILE ID P-BITS                          
         AND,R8   ACNTBIT           EXTRACT ACNT NAME P-BIT                     
         OR,R8    INTR2             MERGE REST OF P- AND F- BITS                
         LW,R0    PRISEC,R2                                                     
         CI,R0    2                                                             
         BE       %+2               B IF PRIMARY INIT                           
         OR,R8    X20               SECONDARY INIT F-BIT                        
         LW,R0    DBUGFLAG,R2                                                   
         BEZ      %+2               B IF DEBUG NOT REQUESTED                    
         OR,R8    X8                DEBUG F-BIT                                 
         STW,R8   INITFPT+1,R2      SET P- AND F- BITS IN INIT FPT              
         LW,R8    INITPRTY,R2       R8 = PRIORITY                               
         STW,R8   INITFPT+5,R2      STORE IN INIT FPT                           
         LCI      2                                                             
         LM,R8    TASKNAME,R2       GET TASK NAME                               
         STM,R8   INITFPT+3,R2      PUT IN INIT FPT                             
         CAL1,7   INITFPT,R2        DO INIT CAL                                 
         CERR     C:ER1                                                         
         LW,R0    DBUGFLAG,R2                                                   
         BEZ      TELREADX          B IF DEBUG NOT REQUESTED                    
         CAL1,9   9                 RELEASE CONSOLE FOR DEBUG USE               
         B        TELREADX                                                      
*                                                                               
INTR1    DATA     X'48800000'                                                   
INTR2    DATA     P1+P3+P4+P8+F3+F5                                             
ACNTBIT  EQU      BITABLE+13        ACNT NAME P-BIT                             
*                                                                               
*                                                                               
MEDIAIT  RES      0                 EXECUTE THE MEDIA CAL                       
         LW,R8    MDIA2             MEDIA P-BITS                                
         OR,R8    GIOCT,R2          FILE ID P-BITS                              
         STW,R8   MEDFPT+1,R2       SET IN MEDIA FPT                            
         CAL1,7   MEDFPT,R2         REQUEST MEDIA OPERATION                     
         CERR     C:ER2                                                         
         B        TELREADX                                                      
*                                                                               
MDIA2    DATA     P1+P4                                                         
         PAGE                                                                   
MESAGEIT RES      0                 PROCESS OPERATOR MESSAGE                    
         LW,R1    LINEINDX,R2       GET LINE IDENTIFICATION                     
         LD,R12   DCT16,R1          GET LNXXX                                   
         SLD,R12  8                 L-ALIGN THE BANG,BANG                       
         OR,R13   X40               MERGE TRAILING BLANK                        
         LW,R14   MESG1             4 ASTERISKS                                 
         LCI      3                                                             
         STM,R12  TELOUT,R2         SET MESSAGE PREFIX                          
         LI,R4    TELOUT                                                        
         AW,R4    R2                MESSAGE OUTPUT AREA POINTER                 
         LI,R5    12                MESSAGE OUTPUT AREA INDEX/BYTE CT           
         LW,R6    MSGPTR,R2         MESSAGE INPUT AREA POINTER                  
         SLS,R6   -2                CHANGE TO WORD ADDRESS                      
         AND,R6   X1FFFF                                                        
         LW,R7    MSGPTR,R2                                                     
         SAS,R7   -24               MESSAGE INPUT AREA INDEX                    
         LB,R0    *R6,R7                                                        
         STB,R0   *R4,R5                                                        
         AI,R5    1                                                             
         BIR,R7   %-3               MOVE MESSAGE TO OUTPUT AREA                 
         LD,R8    R4                GET OUTPUT POINTER AND COUNT                
         CAL1,1   OPERFPT,R2                                                    
         CERR     C:ER3                                                         
         B        TELREADX                                                      
*                                                                               
MESG1    TEXT     '****'                                                        
*                                                                               
*                                                                               
OFFER    RES      0                 ABANDON THE LINE                            
         LI,R0    TJEOFF                                                        
         LW,R7    LINEINDX,R2                                                   
         BAL,R8   TJESET                                                        
         B        QUITIT            TERMINATE                                   
         PAGE                                                                   
STDLABEL RES      0                 DO STANDARD LABEL CAL                       
         LW,R7    STDL1             STDLB P- AND F- BITS                        
         OR,R7    GIOCT,R2          MERGE I/O MEDIUM ID P-BITS                  
         STW,R7   STDLBFPT+1,R2     SET IN STDLB FPT                            
         LW,R9    Y8                                                            
         LI,R8    0                                                             
         CW,R7    OPLBBIT                                                       
         BAZ      %+2               B IF NOT OPLABEL ASSIGNMENT                 
         LW,R8    R9                                                            
*        SET INDIRECT PARAMETER FLAG IF OPLABEL ASSIGNMENT,                     
*        RESET INDIRECT PARAMETER FLAG IF DEVICE OR FILE ASSIGNMENT.            
         STS,R8   STDLBFPT+3,R2     SET OR RESET                                
         CAL1,7   STDLBFPT,R2       DO STDLB SERVICE                            
         CERR     C:ER4                                                         
         B        TELREADX                                                      
*                                                                               
STDL1    DATA     P1+F3             ERROR ADDR, WAIT                            
OPLBBIT  EQU      BITABLE+1         P-BIT FOR OPLABEL ASSIGNMENT                
         PAGE                                                                   
DEBUGIT  RES      0                 DO DEBUG CAL                                
         LW,R9    DBGT1                                                         
         LW,R10   DBGT2                                                         
         BAL,R8   SETETNLM          SET ERROR, TASKNAME, LOAD-MODULE            
         CAL1,7   R9                                                            
         CERR     C:ER5                                                         
         CW,R12   TELNAME           TEST IF SELF-DEBUG                          
         BE       TELREADX                                                      
         CAL1,9   9                 EXECUTE WAIT                                
         B        TELREADX                                                      
*                                                                               
DBGT1    DATA     X'65800000'                                                   
DBGT2    DATA     P1+P3+P4                                                      
*                                                                               
*                                                                               
EXTERM   RES      0                 DO EXTERNAL TASK TERMINATION CAL            
         LW,R9    EXTM1                                                         
         LW,R10   EXTM2                                                         
         BAL,R8   SETETNLM          SET ERROR, TASKNAME, LOAD-MODULE            
         CAL1,7   R9                                                            
         CERR     C:ER6                                                         
         B        TELREADX                                                      
*                                                                               
EXTM1    DATA     X'49800040'                                                   
EXTM2    DATA     P1+P3+P4                                                      
*                                                                               
*                                                                               
NAMESET  RES      0                 DO SETNAME CAL                              
         LW,R9    SETN1                                                         
         LW,R10   SETN2                                                         
         BAL,R8   SETETNLM          SET ERROR, TASNAME, LOAD-MODULE             
         CAL1,7   R9                                                            
         CERR     C:ER7                                                         
         B        *R7                                                           
*                                                                               
SETN1    DATA     X'51800000'                                                   
SETN2    DATA     P1+P3+P4+P6+P7                                                
         PAGE                                                                   
SETETNLM LI,R11   TELERROR          SET ERROR, TASKNAME, LOAD-MODULE            
         LW,R12   TASKNAME,R2                                                   
         LW,R13   TASKNAME+1,R2                                                 
         LW,R14   LDMODULE,R2                                                   
         LW,R15   LDMODULE+1,R2                                                 
         B        *R8                                                           
*                                                                               
*                                                                               
STARTIT  LW,R9    STSP1             DO START CAL                                
         B        %+2                                                           
STOPIT   LW,R9    STSP2             DO  STOP CAL                                
         LW,R10   STSP3                                                         
         BAL,R8   SETETNLM          SET ERROR,TASKNAME, LOADMODULE              
         CAL1,7   R9                                                            
         CERR     C:ER8                                                         
         B        TELREADX                                                      
*                                                                               
STSP1    DATA     X'4A800000'                                                   
STSP2    DATA     X'4B800000'                                                   
STSP3    DATA     P1+P3+P4                                                      
*                                                                               
*                                                                               
SETNAMER RES      0                 EXECUTE SET NAME                            
         BAL,R7   NAMESET                                                       
         B        TELREADX                                                      
*                                                                               
QUITIT   RES      0                                                             
         LI,R0    0                                                             
         STW,R0   CNTRLFLG,R2       CLEAR CONTROL FLAG                          
         STW,R0   INTELFLG,R2       CLEAR IN TEL FLAG                           
         CAL1,9   3                 ABORT TEL                                   
*                                                                               
EXITER   CAL1,9   9                 EXIT WITH WAIT                              
         B        TELREADX                                                      
         PAGE                                                                   
BATCHIT  RES      0                 BATCH A JOB                                 
         LW,R7    BTCH1             GET BATCH SERVICE P-BITS                    
         OR,R7    GIOCT,R2          MERGE FILE ID P-BITS                        
         STW,R7   BATCHFPT+1,R2     SET IN JOB (BATCH) FPT                      
         CAL1,7   BATCHFPT,R2       BATCH THE FILE                              
         CERR     C:ER9                                                         
BTCH2    RES      0                                                             
         LW,R9    JOBNUMB,R2                                                    
         BAL,R7   HEXIT             CONVER JOB-NUMBER TO ECBDIC                 
         LI,R14   ' '                                                           
         STB,R14  R15                                                           
         STW,R15  BCDJOBID,R2       SET IN OUTPUT MESSAGE                       
         LI,R8    X'10'                                                         
         LI,R15   BCDTIME                                                       
         AW,R15   R2                                                            
         STB,R8   R15                                                           
         CAL1,8   R15               SET TIME IN MESSAGE                         
         LI,R8    POSTBTCH                                                      
         AW,R8    R2                                                            
         LI,R9    36                                                            
         CAL1,1   WRITEFPT,R2       WRITE OUT BATCHED MESSAGE                   
         CERR     C:ER10                                                        
         B        JBST2             NOW POST THE STATUS LINE                    
*                                                                               
BTCH1    DATA     P1+P4+P5+P6+P7+P8+F1+F3+F4                                    
TCATIT   RES      0                                                             
         CAL1,7   TCATBFPT,R2            ALLOCATE SYMBIONT FILE                 
         LCI      2                                                             
         LM,R8    AFNCAT+1,R2            MOVE FILE NAME TO DCB                  
         STM,R8   CATDCB+5,R2                                                   
         LI,R8    X'5A'                  PUT "BANG" IN CAT COMMAND              
         LW,R9    TELINPUT,R2                                                   
         STB,R8   R9                                                            
         STW,R9   TELINPUT,R2                                                   
         CAL1,1   CATWFPT1,R2            WRITE !JOB TO FILE                     
         CAL1,1   CATWFPT2,R2            WRITE !CAT TO FILE                     
         CAL1,1   CATWFPT3,R2            WRITE !FIN TO FILE                     
         CAL1,1   CATCFPT,R2             CLOSE SYMBIONT FILE                    
         LW,R9    SYMB                   GET SYMBIONT FLAG                      
         CI,R9    SYMBC                  IN AUTO BKG START MODE                 
         BAZ      BTCH2                  NO BRANCH                              
         BAL,R8   BKGSEQ                 YES START BKG                          
         B        BTCH2                  BKG ALREADY STARTED                    
         B        BTCH2                  CONTIN PROCESS AS BATCH COMMAND        
         PAGE                                                                   
JOBSTAT  RES      0                 GET JOB STATUS                              
         CAL1,7   JSTATFPT,R2       GET JOB STATUS                              
         CERR     C:ER11                                                        
*                                                                               
JBST2    RES      0                 RETURN STATUS MESSAGE                       
         LW,R9    JOBNUMB,R2        CONVERT JOB ID.                             
         BAL,R7   HEXIT                                                         
         LI,R14   ' '                                                           
         STB,R14  R15                                                           
         STW,R15  STATRUN+1,R2                                                  
         STW,R15  STATCOMP+1,R2                                                 
         STW,R15  STATWAIT+1,R2                                                 
         STW,R15  STATNONE+1,R2                                                 
         LW,R9    JOBSWAIT,R2       CONVERT WAIT VALUE TO DEC.                  
         AI,R9    -1          IGNORE THIS ONE JUST ENTERED                      
         BAL,R7   DECIMAL                                                       
         SCS,R15  -8                                                            
         LB,R13   R15                                                           
         LW,R14   STATWCNT+1,R2                                                 
         STB,R13  R14                                                           
         STW,R14  STATWCNT+1,R2                                                 
         LI,R14   ':'                                                           
         STB,R14  R15                                                           
         STW,R15  STATWCNT,R2                                                   
         LW,R7    JBSTATUS,R2       SELECT STATUS MESSAGW APPROPRIATE           
         BLZ      TELREADX          B IF TOO SMALL                              
         CI,R7    4                 CHECK STATUS LIMITS                         
         BG       TELREADX          B IF TOO BIG                                
         LW,R8    JBST3,R7          ADDRESS OF MESAGE                           
         LB,R9    R8                                                            
         AW,R8    R2                                                            
         CAL1,1   WRITEFPT,R2                                                   
         CERR     C:ER12                                                        
         B        TELREADX                                                      
JBST3    GEN,8,24 20,STATCOMP                                                   
         GEN,8,24 16,STATRUN                                                    
         GEN,8,24 28,STATWAIT                                                   
         GEN,8,24 24,STATNONE                                                   
         PAGE                                                                   
CANCELIT RES      0                 CNACEL A JOB                                
         CAL1,7   JDELFPT,R2        CANCEL JOB                                  
         CERR     C:ER13                                                        
         B        TELREADX                                                      
         PAGE                                                                   
HEXIT    LI,R1    -8                CONVERT HEX WORD TO ECBDIC                  
HXIT1    LI,R8    0                                                             
         SLD,R8   4                                                             
         CI,R8    9                                                             
         BG       %+2                                                           
         AI,R8    X'39'                                                         
         AI,R8    X'B7'                                                         
         STB,R8   16,R1             GENERATE IN 14,15                           
         BIR,R1   HXIT1                                                         
         B        *R7                                                           
*                                                                               
*                                                                               
DECIMAL  RES      0                                                             
         LD,R14   BLANKS                                                        
         LI,R5    ' '               ONE MORE BLANK                              
         LI,R6    7                                                             
         LW,R9    R9                                                            
         BGEZ     %+3                                                           
         LI,R5    '-'                                                           
         LAW,R9   R9                                                            
DECI1    LI,R8    0                                                             
         LW,R9    R9                                                            
         BEZ      DECI2                                                         
         DW,R8    XA                                                            
         AI,R8    '0'                                                           
         STB,R8   R14,R6                                                        
         BDR,R6   DECI1                                                         
DECI2    STB,R5   R14,R6                                                        
         B        *R7                                                           
         PAGE                                                                   
TELNOTS  RES      0                 ERROR RETURN FROM GETTEMP                   
         STB,R15  R10               PUT ERROR CODE WHERE ITS EXPECTED           
TELERROR RES      0                                                             
         LB,R9    R10               CONVERT TYC AND ADDRESS                     
         STB,R9   R8                                                            
         STW,R8   R9                                                            
         BAL,R7   HEXIT             FOR HEXIDECIMAL PRINTOUT                    
         LW,R8    R14                                                           
         SLS,R8   -8                                                            
         AND,R8   TELE2             SEPARATE THE TYC                            
         OR,R8    TELE3                                                         
         STW,R8   TELOUT+1,R2                                                   
         STW,R15  TELOUT+2,R2                                                   
         LW,R8    TELE1                                                         
         STW,R8   TELOUT,R2                                                     
         LI,R8    TELOUT                                                        
         AW,R8    R2                                                            
         LI,R9    12                                                            
         CAL1,1   WRITEFPT,R2                                                   
         B        TELREADX                                                      
*                                                                               
TELE1    DATA     'ERR.'                                                        
TELE2    DATA     X'00FFFF00'                                                   
TELE3    DATA     X'40000040'                                                   
*                                                                               
*                                                                               
         DO       UTS                                                           
TESTIT   LI,R2    BUFFBLCK                                                      
         B        SHFT0                                                         
*                                                                               
         BOUND    1024                                                          
BUFFBLCK RES      265                                                           
         ELSE                                                                   
TESTIT   EQU      0                                                             
         FIN      UTS                                                           
         OLAYEND                                                                
         FIN      #TJE                                                          
         END                                                                    
