         PSYS     0                                                             
OLAYFLAG EQU      'DBS3'                                                        
         SYSTEM   OPTIONS                                                       
         DO       #DEBUG                                                        
         SYSTEM   CPRMON                                                        
         PSYS     0                                                             
         SYSTEM   OLAYBASE                                                      
         DEF      A:DBS3            DEBUG SCAN PART 3                           
         DEF      :#SCNLCX                                                      
         DEF      :#SCNLWX                                                      
         DEF      :#SCNWDX                                                      
         DEF      :#EXCT                                                        
         DEF      :#QUIT                                                        
         DEF      :#BRNCH                                                       
         DEF      SCNEXIT           RETURN FROM :#SCNXX                         
         DEF      BRAEXIT           OUTAGE- TO OVERLAY DBS2                     
         DEF      DBERR6            OUTAGE- TO OVERLAY DBS2                     
         DEF      USRIN6            OUTAGE- TO OVERLAY DBS2                     
*        REF      :#SCAN            OVERLAY-S1                                  
*        REF      :#DORET                                                       
         ORG      0                                                             
:#DBERR6 LW,R8    :#DBERR,R2                                                    
DBERR6   B        *R8                                                           
:#USRIN6 LW,R8    :#USRIN,R2                                                    
USRIN6   B        *R8                                                           
:#SCNLCX RES      0                 OVERLAY ENTRY -SCNLC                        
         STW,R8   :#S3LINK,R2                                                   
         BAL,R8   :#SCNLC                                                       
         B        ERROREX                                                       
         B        OKRTRN                                                        
:#SCNWDX RES      0                 OVERLAY ENTRY - SCNWD                       
         STW,R8   :#S3LINK,R2                                                   
         BAL,R8   :#SCNWD                                                       
         B        ERROREX                                                       
         B        OKRTRN                                                        
:#SCNLWX RES      0                 OVERLAY ENTRY - SCNLW                       
         STW,R8   :#S3LINK,R2                                                   
         BAL,R8   :#SCNLW                                                       
         B        ERROREX                                                       
         B        OKRTRN                                                        
ERROREX  LW,R9    :#S3LINK,R2                                                   
         B        %+3                                                           
OKRTRN   LW,R9    :#S3LINK,R2                                                   
         AI,R9    1                                                             
SCNEXIT  B        *R9                                                           
         TITLE    '***  :#SCNLC   ***'                                          
*************************                                                       
*        :#SCNLC         *                                                      
*************************                                                       
         PAGE                                                                   
*   SCAN   FOR A LOCATION-THE POSSIBLE SYNTAXES ARE:                            
* SYMBOL                                                                        
* VALUE                                                                         
* SYMBOL-OPERATOR-VALUE                                                         
* RR(ANY OF THE ABOVE)                                                          
* CALL IS BAL,R8  SCNLC                                                         
* THE ROUTINE RETURNS  TO CALL+1-THE LAST DELIMITER     IS RETURNED IN R7       
*     VALID DELIMITERS     ARE , / ' NL  BLK                                    
*       * WILL BE RECOGNIZED PRECEEDING ANY FIELD                               
*           IF FOUND BIT 0 OF R7 WILL BE SET TO 1                               
* IF AN ERROR   IS FOUND THE ROUTINE PRINTS THE ERROR AND REQUESTS NEW          
*     INPUT                                                                     
* RETURN  IS IN R8 -THIS IS THE VALUE   OF THE LOC                              
*  IF BYTE 1 OF R7 IS X'10' THE FIELD IS EMPTY                                  
*  REGISTERS     USED                                                           
*   R2,R3,R4,R5,R6,R7,R8,R9,R10,R11                                             
         PAGE                                                                   
*************************                                                       
*          START         *                                                      
*************************                                                       
:#SCNLC   RES     0                                                             
         STW,R8   :#SCLRT,R2                                                    
         LI,R6    0                                                             
GETIND   STW,R6   :#INDFG,R2                                                    
GETLOC   LI,R8    0                                                             
         STW,R8   :#OPFG,R2               SET OPERATOR   FLAG TO +(ZERO)        
         STW,R8   :#VALUE,R2        START AT 0                                  
         :#SCAN   :#GETNS           SCAN FOR A NUMBER   OR A SYMBOL             
         GETDLM                                                                 
         CI,R6    '('               CHECK FOR ADDRESS RESOL                     
         BE       CKAD              THERE   IS RESOL                            
         GETERR                                                                 
         BNE      SCNER             ERROR FROM :#SCAN                           
         GETSTS                     GET STATUS                                  
         BNE      CKFLD             FIELD PRESENT                               
         GETDLM                     DELIM   CK -LOOK FOR + -                    
         CI,R6    '+'                                                           
         BE       SETUNOP           IGNORE + NO EFFECT                          
         CI,R6    '-'                                                           
         BE       SETUNOP+1                                                     
         CI,R6    '.'                                                           
         BE       SETHEX                                                        
         CI,R6    ''''              CHECK FOR CHAR STRING                       
         BE       SETEBC                                                        
         CI,R6    '*'               LOOK FOR INDIRECR                           
         BE       GETIND            SET INDIRECT FLAG                           
         LW,R7    R6                GET DELIM                                   
         OR,R7    :#Y001            SET EMPTY FIELD                             
SCLRTN   LW,R9    :#SCLRT,R2        RETURN                                      
         AI,R9    1                                                             
         B        *R9                                                           
:#DBERRA LW,R9    :#SCLRT,R2                                                    
         B        *R9                                                           
         PAGE                                                                   
SETUNOP  LI,R6    0                                                             
         STW,R6   :#OPFG,R2                                                     
         :#SCAN   :#GETNS           GET NEXT FIELD                              
         GETDLM                                                                 
         CI,R6    '('               SEE IF ADDRESS RESOL                        
         BE       CKAD              RESOL PRESENT                               
         GETERR                                                                 
         BNE      SCNER                                                         
         GETSTS                                                                 
         BNE      CKFLD             FIELD PRESENT                               
*                                   EMPTY FIELD-LOOK FOR .                      
         GETDLM                     GET DELIMITER                               
         CI,R6    '.'                                                           
         BE       SETHEX                                                        
         :#DBERRA X'11'             EMPTY FIELD SHOULD BE A .                   
         PAGE                                                                   
SETHEX   :#SCAN   :#GETHEX          SET HEX AND DO SCAN                         
         GETERR                                                                 
         BNE      SCNER                                                         
         GETSTS                     GET STATUS                                  
         CI,R6    1                 CHECK    FOR HEX                            
         BNE      HXER              BAD SYNTAX . FOLLOWED BY NONHEX             
PROCVL   MTW,0    :#OPFG,R2         IS HEX-CHECK FOR MINUS                      
         BE       DOPLUS                                                        
         LCW,R8   R8                SUBTRT BECAUSE OF MINUS                     
DOPLUS   AW,R8    :#VALUE,R2                                                    
         STW,R8   :#VALUE,R2                                                    
         B        CKFDLM            CHECK DELIM                                 
HXER     :#DBERRA  X'12'            BAD SYNTAX  . FOLLOWED BY NONHEX            
         PAGE                                                                   
SETEBC   RES      0                 SCAN FOR CHAR STRING                        
         :#SCAN   :#GETEBC                                                      
         GETSTS                                                                 
         CI,R6    7                                                             
         BNE      SCNER1            NOT CHAR STRING                             
         LH,R7    R8                GET CHAR COUNT                              
         CI,R7    4                                                             
         BG       SCNER1            4 CHAR IS MAX ALLOWED                       
         STW,R9   R12               SAVE SYMBOL IN R12                          
         :#SCAN   :#GETHEX          GET DELIM AFTER FINAL '                     
         GETERR                                                                 
         BNE      SCNER1                                                        
         LW,R8    R12                                                           
         B        PROCVL                                                        
         PAGE                                                                   
CKFDLM   RES      0                 SEE IF FIELD DELIM   IS AN OPERATOR         
         GETDLM                                                                 
         CI,R6    '+'                                                           
         BE       SETUNOP                                                       
         CI,R6    '-'                                                           
         BE       SETUNOP+1                                                     
         CI,R6    ')'               LOOK FOR ADDRESS END                        
         BE       DOADR             FINISH RESOLVING                            
         LW,R7    R6                GET DELIMITER                               
         LW,R8    :#VALUE,R2        RETURN  VALUE                               
         MTW,0    :#INDFG,R2        SEE IF INDIRECT                             
         BE       %+3               NO                                          
         LW,R6    :#Y8              SET INDIRECT BIT                            
         OR,R7    R6                                                            
         B        SCLRTN                                                        
CKFLD    CI,R6    2                 CHECK FIELD FOR NUMBER/SYMBOL               
         BE       PROCVL                                                        
         CI,R6    3                                                             
         BE       PROCVL                                                        
         CI,R6    4                                                             
         BE       PROCVL                                                        
         :#DBERRA X'13'             FIELD SHOULD BE A NUMBER OR A SYMBOL        
SCNER    AI,R6    X'20'             SET ERROR :#CLASS                           
         :#DBERRA *R6                                                           
         PAGE                                                                   
CKAD     RES      0                                                             
         GETSTS                                                                 
         CI,R6    0                 LOOK FOR EMPTY FIELD                        
         BE       ADRDF             DEFAULT TO WORD RESOL                       
         CI,R6    8                                                             
         BNE      ILPER1            ILLEGAL PARENTHESIS                         
         LI,R6    2                                                             
         LI,R5    X'40'                                                         
         CB,R5    R8,R6             SEE IF THIRD BYTE IS ZERO                   
         BNE      ILRER1            NO-ILLEGAL ADDRESS RESOLUTION               
         SAS,R8   -16               :#MOVE BYTES TO LOW END                     
         LH,R6    ADRS                                                          
ADRLP    CH,R8    ADRS,R6                                                       
         BE       ADROK             ADRESS RESOL IS VALID                       
         BDR,R6   ADRLP                                                         
ILRER1   :#DBERRA X'14'             NOT VALID RESOLUTION                        
ADROK    LB,R5    ADRVL,R6          GET MUTIPLIER   FOR ADDRESS                 
         STW,R5   :#ADML,R2         SAVE MULTIPLIER                             
         LW,R5    :#VALUE,R2                                                    
         STW,R5   :#ADVAL,R2        SAVE :#VALUE                                
         LW,R5    :#OPFG,R2                                                     
         STW,R5   :#ADOPF,R2        SAVE LAST OPERATOR                          
         B        GETLOC            USE FULL :#SCNLC   FACILITY                 
         PAGE                                                                   
DOADR    RES      0                 CALCULATE ADRESS RESOLUTION                 
         LW,R9    :#VALUE,R2                                                    
         SLS,R9   2                 SET TO BYTE RES                             
         DW,R9    :#ADML,R2                                                     
         MTW,0    :#ADOPF,R2                                                    
         BE       %+2                                                           
         LCW,R9   R9                COMPLEMENT OLD :#VALUE                      
         AW,R9    :#ADVAL,R2                                                    
         STW,R9   :#VALUE,R2                                                    
         :#SCAN   :#GETOP           GET NEXT DELIMITER                          
         GETSTS                     CHECK STATUS                                
         BNE      ILSER1            ILLEGAL SYNTAX AFTER )                      
         GETDLM                                                                 
         CI,R6    ')'               NESTED ( ARE ILLEGAL                        
         BE       ILSER1            ILLEGAL SYNTAX AFTER )                      
         B        CKFDLM            CONTINUE TO PROCESS STRING                  
         PAGE                                                                   
ADRDF    LI,R6    3                 DEFAULT TO WORD ADDRESS                     
         B        ADROK                                                         
         PAGE                                                                   
*                                     LETTERS                                   
ILPER1   :#DBERRA  X'15'            ILLEGAL LEFT PARENTHESIS                    
ILSER1   :#DBERRA  X'16'            ILLEGAL SYNTAX AFTER )                      
SCNER1   :#DBERRA X'17'             ILLEGAL EBCDIC CONSTANT                     
         PAGE                                                                   
*************************                                                       
*          TABLES        *                                                      
*************************                                                       
         BOUND    4                                                             
ADRS     DATA,2   HA(ADRSE)-HA(ADRS)-1                                          
         DATA,2   'BA','HA','WA','DA'                                           
ADRSE    RES      0                                                             
         BOUND    4                                                             
ADRVL    DATA,1   BA(ADRVLE)-BA(ADRVL)-1                                        
         DATA,1   1,2,4,8                                                       
ADRVLE   RES      0                                                             
         BOUND    4                                                             
*                                                                               
         TITLE    '***  :#SCNWD   ***'                                          
*************************                                                       
*        :#SCNWD         *                                                      
*************************                                                       
         PAGE                                                                   
*   :#SCAN   FOR A WORD-THE POSSIBLE SYNTAXES ARE:                              
*ANYTHING VALID AS A LOCATION                                                   
*  SYMBOLIC-OP-CODE,REGISTER      ADDRESS,INDEX                                 
*                                                                               
*        CALL IS  BAL,R8  :#SCNWD                                               
*                                                                               
*        LAST DELIMITER     IS RETURNED  IN R7                                  
*        THE VALUE   IS RETURNED  IN R8                                         
*  IF BYTE 1 OF R7 IS X'01' THE FIELD IS EMPTY                                  
*        ERRORS   CAUSE A TRANSFER TO DBERR                                     
*        POSSIBLE  DELIMITERS     ARE / NL BLNK '                               
*  REGISTERS USED                                                               
*  R2,R3,R4,R5,R6,R7,R8,R9,R10,R11                                              
         PAGE                                                                   
:#SCNWD   RES     0                                                             
         STW,R8   :#SCWRT,R2                                                    
         :#SCAN   :#GETOPC          SEE IF FIRST FIELD IS A MACHINE OP          
         GETSTS                     CHECK FOR OP-CODE FOUND                     
         CI,R6    5                                                             
         BE       DOINS             MUST BE INSTRUCTION                         
         :#SCAN   :#SETBCK          SET SCAN BACK SO CALL TO :#SCNLC IS         
*                                   POSSIBLE                                    
         BAL,R8   :#SCNLC                                                       
         B        :#DBERRB                                                      
SCWRTN   LW,R9    :#SCWRT,R2        RETURN  TO CALL                             
         AI,R9    1                                                             
         B        *R9                                                           
:#DBERRB LW,R9    :#SCWRT,R2                                                    
         B        *R9                                                           
         PAGE                                                                   
DOINS    LW,R7    R8                TAKE VALUE-CODE   AND BUILD INSTR           
         AND,R7   :#M3              GET :#CLASS                                 
         STW,R7   :#CLASS,R2        SAVE CLASS                                  
         STW,R8   :#OPCD,R2         OP CODE                                     
         LI,R7    0                                                             
         STW,R7   :#REG,R2          REGISTER                                    
         STW,R7   :#ADRS,R2         ADDRESS                                     
         STW,R7   :#INDX,R2         INDEX                                       
         STW,R7   :#INDRC,R2                                                    
         GETDLM                                                                 
         CI,R6    X'40'                                                         
         BE       GETADR            NO :#REG LOOK FOR ADRESS FIELD              
         CI,R6    ','                                                           
         BE       GETREG            GET REG                                     
         :#DBERRB X'31'             R,:#ADRS FIELDS MISSING                     
GETREG   BAL,R8   :#SCNLC           GET REGISTER                                
         B        :#DBERRB                                                      
         GETEMF                                                                 
         BE       ILRER2                                                        
         CI,R7    0                 CHECK INDIRECT                              
         BL       ILSER2                                                        
         CI,R7    ' '                                                           
         BNE      ILSER3                                                        
         STW,R8   :#REG,R2          GET ADRESS FIELD                            
GETADR   BAL,R8   :#SCNLC           GET ADDRESS FIELD                           
         B        :#DBERRB                                                      
         GETEMF                                                                 
         BE       ILSER4                                                        
         CI,R7    0                                                             
         BGE      %+3                                                           
         AND,R7   :#M8                                                          
         MTW,1    :#INDRC,R2        SET INDIRECT FLAG                           
         STW,R8   :#ADRS,R2         SAVE ADDRESS                                
         CI,R7    ','                                                           
         BNE      BLDINS            LOOK FOR INDEX FIELD                        
         BAL,R8   :#SCNLC           GET INDEX FIELD                             
         B        :#DBERRB                                                      
         GETEMF                                                                 
         BE       ILSER5            ERROR                                       
         CI,R7    0                 SEE IF INDIRECT-ERROR                       
         BL       ILSER6                                                        
         STW,R8   :#INDX,R2                                                     
         PAGE                                                                   
BLDINS   RES      0                                                             
         LW,R6    :#CLASS,R2                                                    
         B        DOCLS,R6          BRANCH    TO PROPER   :#CLASS HANDLER       
DOCLS    B        CLS0                                                          
         B        CLS1                                                          
         B        CLS2                                                          
         B        CLS3                                                          
         B        CLS4                                                          
         B        CLS5                                                          
         B        CLS6                                                          
         PAGE                                                                   
CLS0     RES      0                 NORMAL MEMORY REF                           
         LW,R6    :#ADRS,R2                                                     
         AND,R6   :#M17             CUT SIZE TO 17 BITS                         
GETINS   STW,R6   :#ADRS,R2                                                     
         LI,R8    0                 SET INS TO 0                                
         LW,R6    :#INDRC,R2                                                    
         SLS,R6   31                MOVE   TO BIT 0                             
         OR,R8    R6                                                            
         LI,R6    0                                                             
         LW,R6    :#OPCD,R2                                                     
         SLS,R6   16                MOVE   TO OP CODE POSITION                  
         AND,R6   :#YFF             GET OP CODE                                 
         OR,R8    R6                OR INTO INSTRUCTION                         
         LW,R6    :#REG,R2          SEE IF REG IS BETWEEN +15 AND -8            
         CI,R6    16                                                            
         BGE      ILSER8                                                        
         CI,R6    -8                                                            
         BL       ILSER8                                                        
         AND,R6   :#M4                                                          
         SLS,R6   20                                                            
         OR,R8    R6                OR IN REGISTER                              
         LW,R6    :#INDX,R2                                                     
         CI,R6    7                                                             
         BG       ILSER7                                                        
         SLS,R6   17                                                            
         OR,R8    R6                OR INDEX INTO INSTRUCTION                   
         OR,R8    :#ADRS,R2                                                     
         AND,R7   :#M8                                                          
         B        SCWRTN                                                        
         PAGE                                                                   
CLS1     RES      0                 LOAD IMMEDIATE                              
         LI,R6    0                                                             
         STW,R6   :#INDRC,R2        CLEAR INDEX AND INDIRECT                    
         STW,R6   :#INDX,R2                                                     
         LW,R6    :#ADRS,R2         LIMIT ADRS TO 20 BITS                       
         AND,R6   :#M20                                                         
         B        GETINS                                                        
         PAGE                                                                   
CLS2     LW,R6    :#OPCD,R2         GET TYPE FROM THIRD DIGIT OF OP-CD          
         AND,R6   :#M8                                                          
         SLS,R6   -4                                                            
         STW,R6   :#REG,R2                                                      
         B        CLS0                                                          
         PAGE                                                                   
CLS3     MTW,0    :#INDRC,R2                                                    
         BNE      CLS3A                                                         
         LW,R6    :#OPCD,R2         NORMAL SHIFT                                
         AND,R6   :#KF0             GET TYPE                                    
         SLS,R6   4                                                             
         LW,R5    :#ADRS,R2                                                     
         AND,R5   :#M7                                                          
         OR,R6    R5                                                            
         B        GETINS                                                        
CLS3A    B        CLS0              MEMORY REF SHIFT                            
         PAGE                                                                   
CLS4     LI,R6    0                                                             
         STW,R6   :#INDRC,R2                                                    
         LW,R5    :#ADRS,R2         PUT FLT CONTROLS AND CC INTO ADRS           
         AND,R5   :#M4                                                          
         SLS,R5   4                                                             
         STW,R5   R6                                                            
         LI,R5    0                 SET INDEX TO 0                              
         XW,R5    :#INDX,R2                                                     
         AND,R5   :#M3                                                          
         OR,R6    R5                                                            
         STW,R6   :#ADRS,R2                                                     
         B        CLS2              MOVE   BITS 8-11 TO :#REG                   
         PAGE                                                                   
CLS5     LW,R6    :#REG,R2          SEE IF REG IS BETWEEN +7 AND -8             
         CI,R6    8                                                             
         BGE      ILSER8                                                        
         CI,R6    -8                                                            
         BL       ILSER8                                                        
         B        CLS0                                                          
         PAGE                                                                   
CLS6     LI,R6    1                                                             
         STW,R6   :#INDX,R2         SET MMC CODE TO 1                           
         B        CLS0                                                          
         PAGE                                                                   
*************************                                                       
*         :#SCNLW       *                                                       
*************************                                                       
*  THIS ROUTINE GETS ONE LOC AND AS                                             
*      MANY WORDS (SEPARATED BY A /)                                            
*      AS ARE PRESENT.                                                          
*  LOC IS PUT INTO :#MDBF.                                                      
*  THE WORDS START IN :#MDBF+1                                                  
*  REGISTERS USED                                                               
*    R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11                                         
         PAGE                                                                   
:#SCNLW  STW,R8   :#SLWRT,R2                                                    
         BAL,R8   :#SCNLC           GET LOCATION                                
         B        :#DBERRC                                                      
         GETEMF                                                                 
         BE       ILLER1            ILLEGAL LOC                                 
         CI,R7    '/'                                                           
         BNE      ILSER9            ILLEGAL SYNTAX-NO WORDS TO MODIFY           
         LI,R9    :#MDBF+1          SAVE LOC                                    
         STW,R8   *R9,R2                                                        
         STW,R8   :#CURLC,R2                                                    
GETNEXT  BAL,R8   :#SCNWD           EVALUATE                                    
         B        :#DBERRC                                                      
         GETEMF                                                                 
         BNE      CKAFLD            EMPTY FIELD                                 
         AND,R7   :#M8              CLEAN DELIMITER                             
         CI,R7    '/'               CHECK DELIM                                 
         BNE      CKEND                                                         
         LI,R8    0                 SET WORD TO ZERO-DEFAULT                    
CKAFLD   LI,R9    :#MDBF                                                        
         AW,R9    R2                                                            
         STW,R8   *R9,R1                                                        
         MTW,1    :#CURLC,R2                                                    
         AI,R1    1                 INCREMENT SIZE                              
         CI,R1    :#MDBFS                                                       
         BGE      ILMER1                                                        
         CI,R7    '/'               CHECK DELIM                                 
         BE       GETNEXT                                                       
CKEND    LW,R9    :#SLWRT,R2        RETURN                                      
         AI,R9    1                                                             
         B        *R9                                                           
:#DBERRC LW,R9    :#SLWRT,R2                                                    
         B        *R9                                                           
         PAGE                                                                   
ILRER2   :#DBERRB  X'32'            EMPTY FIELD WHERE REGISTER   SHOULD BE      
ILSER2   :#DBERRB  X'33'            INDIRECT IN R FIELD                         
ILSER3   :#DBERRB  X'34'            ILLEGAL DELIM   AFTER R FIELD               
ILSER4   :#DBERRB  X'35'            EMPTY ADDRESS FIELD                         
ILSER5   :#DBERRB  X'36'            EMPTY INDEX FIELD AFTER  ,                  
ILSER6   :#DBERRB  X'37'            INDIRECT FLAG IN INDEX FIELD                
ILSER7   :#DBERRB  X'38'            INDEX TOO LARGE                             
ILSER8   :#DBERRB  X'39'            ILLEGAL REGISTER   VALUE                    
ILLER1   :#DBERRC  X'41'            ILLEGAL LOC                                 
ILSER9   :#DBERRC  X'42'            ILLEGAL SYNTAX-NO WORDS TO CHANGE           
ILMER1   :#DBERRC X'43'             TOO MANY MODIFIES                           
         TITLE    ':#EXCT'                                                      
         PAGE                                                                   
*************************                                                       
*         :#EXCT        *                                                       
*************************                                                       
*  COMMAND FORMAT                                                               
*   E (H,B)                                                                     
*  IF NO TASK NAME IS GIVEN THE CURRENT TASK WILL BE USED                       
*   FOR   EB   R8=1    CODE=X'4A'                                               
*         EH   R8=2    CODE=X'4B'                                               
         PAGE                                                                   
:#EXCT   RES      0                                                             
         LI,R15   X'49'                                                         
         AW,R15   R8                                                            
         :#SCAN   :#GETEB           GET TASK NAME                               
         GETSTS                                                                 
         BNE      CKST              START OR STOP THIS TASK                     
         LCI      2                                                             
         LM,R8    :#TSNAM,R2        GET OWN TASK NAME                           
         B        STNM                                                          
CKST     CI,R6    8                                                             
         BNE      ILCHER1           ILLEGAL CHARACTER IN NAME                   
STNM     LCI      3                 PLACE FPT IN REGISTERS                      
         LM,R5    SSFPT                                                         
         STB,R15  R5                                                            
         CAL1,7   R5                                                            
         B        :#USRIN6                                                      
*                                                                               
ILCHER1  :#DBERR6 X'101'            ILLEGAL CHAR                                
         TITLE    ':#QUIT'                                                      
         PAGE                                                                   
*************************                                                       
*         :#QUIT         *                                                      
*************************                                                       
*COMMAND FORMAT                                                                 
* Q (J) TASK NAME                                                               
* IF QJ IS USED NO TASK NAME IS ALLOWED                                         
* FOR    Q   R8=1                                                               
*        QJ  R8=2                                                               
         PAGE                                                                   
:#QUIT   RES      0                                                             
         CI,R8    1                                                             
         BNE      QJOB              DO KILL JOB                                 
         :#SCAN   :#GETEB                                                       
         GETSTS                                                                 
         BNE      QTASK             B IF THERE WAS A NAMED TASK                 
         CAL1,9   8                 TERM CAL                                    
*                                                                               
QTASK    RES      0                                                             
         CI,R6    8                                                             
         BNE      QSER2             B IF BUM TASK NAME                          
         LCI      3                 PLACE FPT INTO REGISTERS                    
         LM,R5    SSFPT                                                         
         AI,R7    2                                                             
         CAL1,7   R5                TERM NAMED TASK                             
         B        :#USRIN6                                                      
QJOB     RES      0                                                             
         LW,R5    KJFPT                                                         
         CAL1,7   R5                KILL THE EXECUTING TASKS JOB                
         CAL1,9   8                                                             
*                                                                               
QSER2    :#DBERR6 X'121'            SCAN ERROR                                  
SSERR    :#DBERR6 X'102'            START-STOP ERROR                            
         :#DBERR6 X'122'            EX TERM ERROR                               
SSFPT    GEN,8,1,23   X'49',1,0     START-STOP FPT                              
         DATA     P1+P3+P4+P10                                                  
         DATA     SSERR             ERROR RETURN                                
KJFPT    GEN,8,1,23  X'64',0,0      KILL CALLING TASKS JOB                      
         TITLE    '***  :#BRNCH   ***'                                          
         PAGE                                                                   
*************************                                                       
*         :#BRNCH        *                                                      
*************************                                                       
* COMMAND SYNTAX                                                                
* B(M) (LOC)(,SNAP LOC)                                                         
* IF THE LOC IS NOT PRESENT ON A B                                              
* A CONTINUE FROM THE LAST SNAP WILL OCCUR                                      
* IF B LOC , :#BRNCH   TO THE LOC                                               
*BM MOVES   THE SNAP AND :#BRNCHES   AS DESIRED                                 
         PAGE                                                                   
:#BRNCH   RES     0                                                             
         CI,R8    1                                                             
         BNE      DOBM                                                          
         BAL,R8   :#SCNLC           DO :#BRNCH                                  
         B        :#DBERR6                                                      
         GETEMF                                                                 
         BE       BRAEXIT                                                       
         STW,R8   :#SNPSV,R2        SET NEW START                               
         B        BRAEXIT                                                       
DOBM     BAL,R8   :#SCNLC           DO :#BRNCH   AND MOVE   SNAP                
         B        :#DBERR6                                                      
         GETEMF                                                                 
         BE       %+2                                                           
         STW,R8   :#LOCSV,R2        SET NEW PLACE TO MOVE   SNAP                
         AND,R7   :#M8                                                          
         CI,R7    ' '                                                           
         BE       MOVSNP                                                        
         CI,R7    NL                                                            
         BE       MOVSNP                                                        
         CI,R7    ','                                                           
         BE       GETSLC            GET SNAP LOC                                
         :#DBERR6 X'D1'                                                         
MOVSNP   MTW,0    :#OLSNP,R2        SEE IF SNAP ACTIVE                          
         BE       ILSNER1                                                       
         LW,R0     :#OLSNP,R2       GET INDEX OF OLD SNAP LOC-ALSO GET          
         LW,R5    *R0                                                           
         LW,R4    R5                :#BRNCH   TO ELEMENT                        
         LW,R3    -1,R5             GET OLD CONTENTS-RESTORE                    
         STW,R3   *R0                                                           
         LW,R0    :#LOCSV,R2        SNAP MOVED                                  
         XW,R4    *R0                                                           
         STW,R4   -1,R5             PUT IN CELL CONTENTS                        
         LW,R4    :#LOCSV,R2                                                    
         STW,R4   -2,R5             SAVE NEW LOC                                
BRAEXIT  B        :#DORET                                                       
GETSLC   RES      0                                                             
         BAL,R8   :#SCNLC           GET NEW BRANCH LOC                          
         B        :#DBERR6                                                      
         GETEMF                                                                 
         BE       %+2                                                           
         STW,R8   :#SNPSV,R2         KEEP PLACE WHERE SNAP WAS                  
         LI,R8    0                 ALWAYS REMOVE   SNAP-NO EXU DONE            
         LI,R5    :#SNPSV                                                       
         AW,R5    R2                                                            
         STB,R8   *R5                                                           
         B        MOVSNP                                                        
ILSNER1  :#DBERR6  X'D2'            NO SNAP ACTIVE                              
         TITLE    'CONSTANTS'                                                   
         PAGE                                                                   
**************************                                                      
*        CONSTANTS       *                                                      
*************************                                                       
:#M3     DATA     7                                                             
:#M4     DATA     X'F'                                                          
:#M7     DATA     X'7F'                                                         
:#M8     DATA     X'FF'                                                         
:#M17    DATA     X'1FFFF'                                                      
:#M20    DATA     X'FFFFF'                                                      
:#KF0    DATA     X'F0'                                                         
:#Y001   DATA     X'00100000'                                                   
:#Y8     DATA     X'80000000'                                                   
:#YFF    DATA     X'FF000000'                                                   
:#ALBLK  DATA     X'40404040'                                                   
A:DBS3   RES      0                                                             
         OLAYEND                                                                
         FIN      #DEBUG                                                        
         END                                                                    
