         PSYS     0                                                             
OLAYFLAG EQU      'DBS1'                                                        
         SYSTEM   OPTIONS                                                       
         DO       #DEBUG                                                        
         SYSTEM   CPRMON                                                        
         PSYS     0                                                             
         SYSTEM   OLAYBASE                                                      
         DEF      A:DBS1            DEBUG SCAN PART 1                           
         DEF      :#SCAN                                                        
         DEF      :#WKSQZ           WORKSPACE SQUEEZE                           
         DEF      SCANOUT           RETURN FROM :#SCAN                          
         DEF      DBERR4            OUTAGE TO OVERLAY DBS2                      
         DEF      USRIN4            OUTAGE TO OVERLAY DBS2                      
         DEF      TTDEBUG                                                       
         DEF      TTDBUGX           OUTAGE FROM TTDBUG                          
*        REF      CSEARCH,OSEARCH   OVERLAY-S2                                  
*        REF      USEARCH           OVERLAY-S2                                  
         ORG      0                                                             
:#DBERR4 LW,R8    :#DBERR,R2                                                    
DBERR4   B        *R8                                                           
:#USRIN4 LW,R8    :#USRIN,R2                                                    
USRIN4   B        *R8                                                           
         TITLE    '       **** :#SCAN **** '                                    
**********************                                                          
**                  **                                                          
**       :#SCAN     **                                                          
**                  **                                                          
**********************                                                          
*                                                                               
*                                   THIS SCAN WILL RETURN WHEN IT FINDS         
*                                     A DELIMITER.                              
*                                                                               
*                                   THE CALL IS    BAL,R8   SCAN                
*                                       WHERE  R7 CONTAINS THE ADDRESS          
*                                          OF THE INPUT PARAMETER TABLE.        
*                                                                               
*                                   THE INPUT PARAMETER TABLE IS AS             
*                                       FOLLOWS                                 
*                                                                               
*                                       WORD 0                                  
*                                           BYTE 0 CONTAINS                     
*                                                                               
*                                           SCAN MODE=0 SCAN NEXT FIELD         
*                                                    =1 SCAN LAST FIELD         
*                                                    =2 NEW BUFFER              
*                                                    =3 SET FOR LAST FIELD      
*                                                                               
*                                           BYTE 1-3 CONTAINS                   
*                                                                               
*                                                    WORD ADDRESS OF THE        
*                                                    BUFFER TO BE               
*                                                    SCANNED                    
*                                                                               
*                                       WORD 1                                  
*                                           BYTE 0 CONTAINS                     
*                                                                               
*                                           FIELD MODE=0 IGNORE FIELD           
*                                                     =1 SCAN FOR SYMBOL        
*                                                     =2 SCAN FOR A HEX         
*                                                         OR DEC NUMBER         
*                                                     =3 SCAN FOR A DEC         
*                                                         NUMBER OR A           
*                                                         SYMBOL                
*                                                                               
*                                           NUMBER MODE=0 IGNORE NUMBER         
*                                                      =1 CONVERT TO HEX        
*                                                      =2 CONVERT TO DEC        
*                                                      =7 RETURN THE            
*                                                          FIRST 8 CHAR         
*                                                          SCANNED              
*                                                                               
*                                           SYMBOL MODE=0 IGNORE SYMBOL         
*                                                      =1 SEARCH THE            
*                                                          SYSTEM SYMBOL        
*                                                          TABLE                
*                                                      =2 SEARCH THE            
*                                                          USER SYMBOL          
*                                                          TABLE                
*                                                      =3 SEARCH BOTH           
*                                                          SYMBOL TABLES        
*                                                      =4 SEARCH THE            
*                                                          OP-CODE TABLE        
*                                                      =5 SEARCH THE            
*                                                          COMMAND TABLE        
*                                                      =6 RETURN THE            
*                                                          FIRST BYTE           
*                                                          POSITION AND         
*                                                          THE COUNTOF          
*                                                          CHAR TO THE          
*                                                          DELIM                
*                                                      =7 RETURN THE            
*                                                          FIRST 8 CHAR         
*                                                          SCANNED              
*                                                                               
*                                           BLANK MODE=0 IGNORE LEADING         
*                                                         BLANKS                
*                                                     =1 INCLUDE ALL            
*                                                         BLANKS                
*                                                                               
*                                       WORD 2                                  
*                                           BYTE 0 CONTAINS                     
*                                                                               
*                                                    THE SIZE OF THE            
*                                                     DELIMITER STRING          
*                                                                               
*                                           BYTE 1-3 CONTAIN                    
*                                                                               
*                                                    THE FWA OF THE             
*                                                     DELIMITER STRING.         
*                                                     EACH DELIMITER IS         
*                                                     A SINGLE BYTE             
*                                                                               
*                                   SCAN EXITS WITH                             
*                                                                               
*                                       R7  -  UNCHANGED                        
*                                                                               
*                                       R8,R9  CONTAIN A VALUE                  
*                                                                               
*                                              R8= A CONVERTED HEX VALUE        
*                                                  A CONVERTED DEC VALUE        
*                                                  A USER SYMBOL VALUE          
*                                                  A SYSTEM SYMBOL VALUE        
*                                                  AN OP CODE VALUE             
*                                                  A COMMAND VALUE              
*                                                  A CHARACTER STRING           
*                                                    POINTER-R9 HAS             
*                                                    FIRST 4 CHAR OF STRING     
*                                                                               
*                                              IF R9=NONZERO                    
*                                              R8 AND R9 HAVE UP TO             
*                                                  EIGHT EBCDIC CHAR            
*                                                  WITH TRAILING BLANKS         
*                                                                               
*                                       R10                                     
*                                                                               
*                                           BYTE 0 CONTAINS                     
*                                                                               
*                                           STATUS=0 FIELD IS EMPTY             
*                                                 =1 HEX NUMBER SCANNED         
*                                                 =2 DEC NUMBER SCANNED         
*                                                 =3 USER SYMBOL SEARCH         
*                                                 =4 SYSTEM SYMBOL              
*                                                     SEARCH                    
*                                                 =5  OP-CODE SEARCH            
*                                                 =6  COMMAND SEARCH            
*                                                 =7  CHARACTER STRING          
*                                                 =8  EBCDIC SYMBOL             
*                                                 =9  END OF BUFFER             
*                                                 =A  STATUS UNSURE             
*                                                 =B  FIELD IGNORED             
*                                                                               
*                                           BYTE 1 CONTAINS                     
*                                                                               
*                                           ERROR CODE                          
*                                                 =0 NO ERROR                   
*                                                 =1 ILLEGAL SCAN MODE          
*                                                 =2 ILLEGAL FIELD MODE         
*                                                 =3 ILLEGAL NUMBER MODE        
*                                                 =4 ILLEGAL REQUEST-           
*                                                     NUMBER MODE               
*                                                 =5 ILLEGAL SYMBOL MODE        
*                                                 =6 ILLEGAL BLANK  MODE        
*                                                 =7 SYSTEM SYMBOL              
*                                                     UNDEFINED                 
*                                                 =8 USER SYMBOL                
*                                                     UNDEFINED                 
*                                                 =9 OP-CODE UNDEFINED          
*                                                 =A COMMAND UNDEFINED          
*                                                 =B ILLEGAL CHARACTER          
*                                                                               
*                                           BYTE 2 CONTAINS                     
*                                                                               
*                                                 FIELD SCANNED NUMBER          
*                                                                               
*                                           BYTE 3 CONTAINS                     
*                                                                               
*                                                 DELIMETER FOUND               
*                                                                               
*                                                                               
*  REGISTERS USED                                                               
*   R2,R3,R4,R5,R6,R7,R8,R9,R10,R11                                             
*  REGISTERS SAVED                                                              
*  NONE                                                                         
         PAGE                                                                   
*************************                                                       
*        :#SCAN INIT     *                                                      
*************************                                                       
:#SCAN   RES      0                                                             
         STW,R8   :#RETRN,R2        SAVE RETURN                                 
         LW,R7    IPTSLIST,R7                                                   
         LB,R8    *R7               GET SCAN   MODE                             
         CI,R8    0                                                             
         BE       FLDINIT           SCAN   NEXT FIELD                           
         CI,R8    1                                                             
         BE       FLDRST            SCAN   LAST FIELD                           
         CI,R8    2                                                             
         BE       BUFINIT           SCAN   NEW BUFFER                           
         CI,R8    3                                                             
         BE       FLDRST                                                        
         B        SCMDER1           ILLEGAL SCAN   MODE VALUE                   
FLDRST   MTW,-1   :#FLDCT,R2                                                    
         B        FLDIN1                                                        
BUFINIT  LI,R9    0                                                             
         STW,R9   :#CHRPS,R2                                                    
         STW,R9   :#FLDCT,R2        SET SO :#SCHPS WILL BE SET TO               
         STW,R9   :#SCHPS,R2        START OF THE FIRST FIELD                    
         B        FLDIN1                                                        
FLDINIT  LW,R9    :#ECHPS,R2        SET START OF FIELD TO OLD END OF            
         AI,R9    1                 FIELD                                       
         STW,R9   :#SCHPS,R2                                                    
         STW,R9   :#CHRPS,R2                                                    
FLDIN1   LI,R9    0                                                             
         STW,R9   :#CHRCT,R2                                                    
         STW,R9    :#FLDST,R2                                                   
         STW,R9   :#ERCOD,R2                                                    
         STW,R9   :#DELIM,R2                                                    
         LW,R9    :#ALBLK           ALL BLANKS                                  
         STW,R9   :#SYMBL,R2                                                    
         LW,R4    :#SBLPT,R2                                                    
         AI,R4    1                                                             
         STW,R9   *R4                                                           
         AI,R4    1                                                             
         STW,R9   *R4                                                           
         LI,R9    0                                                             
         STW,R9   :#SYCCT,R2                                                    
         STW,R9   :#HXMOD,R2                                                    
         STW,R9   :#SYMOD,R2                                                    
         STW,R9   :#SSMOD,R2                                                    
         CI,R8    3                                                             
         BNE      BLNKCK            DO SCAN                                     
         LW,R4    :#SCHPS,R2        NO SCAN                                     
         AI,R4    -1                SET :#SCHPS TO :#SCHPS-1                    
         LI,R9    12                SET STATUS                                  
         STW,R9   :#FLDST,R2                                                    
         B        VALDON            DO NORMAL TERMINATION                       
         PAGE                                                                   
*************************                                                       
*      SKIP BLANKS       *                                                      
*************************                                                       
BLNKCK   LW,R5    0,R7              GET BUFFER   ADDRESS                        
         AW,R5    R2                                                            
         LW,R4    :#CHRPS,R2        CHAR POSITION                               
         LB,R11   *R5,R4            GET FIRST CHAR                              
         MTW,1    :#CHRCT,R2                                                    
         LI,R6    7                 GET BLANK  CONVERT   MODE                   
         LB,R9    *R7,R6                                                        
         BE       SKPBLNK           IGNORE LEADING BLANKS                       
         CI,R9    1                                                             
         BE       CKDELIM           SAVE ALL BLANKS                             
         B        BMDER1            ILLEGAL VALUE                               
SKPBLLP  AI,R4    1                 GET CHAR                                    
         LB,R11   *R5,R4            INCREMENT CHARACTER   POSITION              
SKPBLNK  CI,R11   X'40'             SPACE                                       
         BE       SKPBLLP                                                       
         B        CKDELIM           FIRST NONBLANK CHAR IN R11                  
         PAGE                                                                   
*************************                                                       
*     :#DELIMITER   CHECK *                                                     
*************************                                                       
CKNEXTC  AI,R4    1                                                             
         LB,R11   *R5,R4                                                        
         MTW,1    :#CHRCT,R2                                                    
CKDELIM   LI,R6   8                 CHECK CHAR IN R11 FOR DELIM                 
         LB,R6    *R7,R6            GET :#DELIM COUNT                           
         AI,R6    -1                                                            
         LW,R3    2,R7              :#DELIM STRING ADDRESS                      
CKDELLP  CB,R11   *R3,R6                                                        
         BE       DELFND            :#DELIM FOUND                               
         AI,R6    -1                                                            
         BGE      CKDELLP           CONTINUE CHECK                              
         B        SCCK              NO :#DELIM FOUND                            
DELFND   STW,R11  :#DELIM,R2                                                    
         MTW,1    :#FLDCT,R2        INCREMENT FIELD COUNT                       
         B        PROCFLD                                                       
SCCK     CI,R11    ';'              IGNORE IF SEMI-COLON                        
         BE       CKNEXTC           GET NEXT CHAR                               
         CI,R11   X'15'             END OF LINE                                 
         BNE      CARET                                                         
ENDLN    AI,R4    -1                INSURE THAT NEXT SCAN   WILL FIND NL        
         B        DELFND                                                        
CARET    CI,R11   X'0D'             TRY FOR CARRIAGE RETURN                     
         BNE      ALFCK             NO - TRY ALPHA CHAR.                        
         B        ENDLN             YES - END OF LINE                           
         PAGE                                                                   
*************************                                                       
*    ALPHABETIC   CHECK  *                                                      
*************************                                                       
ALFCK    CLM,R11  ALFLIM            CHECK CHAR IN R11 FOR ALF                   
         BCR,9    HEXCK             IS ALPHABETIC                               
         CLM,R11  NUMLIM            CHECK FOR NUMERIC                           
         BCR,9    PACHAR            IS NUMERIC                                  
         LB,R3    ALFCHR            CHECK FOR WEIRD ALF-GET SIZE OF TBL         
ALFCKLP  CB,R11   ALFCHR,R3                                                     
         BE       SETSYM            MATCH FOUND                                 
         BDR,R3   ALFCKLP                                                       
         LI,R3    4                 ILLEGAL CHARACTER                           
         LB,R3    *R7,R3            CK FOR IGNORE MODE                          
         BNE      ICHER1            ERROR                                       
         B        PACHAR            CHARACTER   WILL BE PACKED BUG IGNORED      
HEXCK    CLM,R11  HEXLIM            CHECK FOR A-F                               
         BCS,9    SETSYM            SET SYM FLAG                                
         MTW,1    :#HXMOD,R2        SET HEX FLAG                                
         B        PACHAR                                                        
SETSYM   MTW,1    :#SYMOD,R2                                                    
PACHAR   LW,R9    :#SBLPT,R2         PACK CHARACTERS INTO :#SYMBL               
         LW,R3    :#SYCCT,R2                                                    
         CI,R3    12                SEE IF :#SYMBL FULL                         
         BGE      CKNEXTC           GET NEXT CHARACTER                          
         STB,R11  *R9,R3            NOT FULL                                    
         MTW,1    :#SYCCT,R2                                                    
         B        CKNEXTC                                                       
         PAGE                                                                   
*************************                                                       
*     PROCESS FIELD      *                                                      
*************************                                                       
PROCFLD  LW,R9    :#CHRCT,R2                                                    
         CI,R9    1                                                             
         BG       NOTEMP                                                        
         LI,R8    0                 EMPTY FIELD :#RETRN                         
         STW,R8   :#FLDST,R2        SET FIELD STATUS                            
         B        VALDON                                                        
NOTEMP   MTW,0    :#SYMOD,R2        CHECK FOR NON-HEX CHAR-THIS IMPLIES         
         BE       CKHX              A :#SYMBL                                   
FLDMCK   LI,R3    4                 IS A :#SYMBL-SEARCH IF REQUEST SO           
         LB,R3    *R7,R3            STATES---GET FIELD MODE                     
         BE       IGNOR             IGNORE FIELD                                
         CI,R3    1                                                             
         BE       CKSYMD            MODE IS SCAN   FOR :#SYMBL                  
         CI,R3    3                                                             
         BNE      FMDER1            ILLEGAL FIELD MODE VALUE                    
         PAGE                                                                   
*************************                                                       
*      CHECK :#SYMBL     *                                                      
*************************                                                       
CKSYMD   LI,R3    6                 MODE IS SCAN   FOR :#SYMBL                  
         LB,R3    *R7,R3            GET :#SYMBL CONVERT                         
         BE       IGNOR                                                         
         CI,R3    1                                                             
         BE       SSER              SEARCH SYSTEM TABLE                         
         CI,R3    2                                                             
         BE       USER              SEARCH USER   TABLE                         
         CI,R3    3                                                             
         BNE      %+3                                                           
         MTW,1    :#SSMOD,R2        SEARCH BOTH TABLES                          
         B        USER                                                          
         CI,R3    4                                                             
         BE       OSER              SEARCH OP-CODE TABLE                        
         CI,R3    5                                                             
         BE       CSER              COMMAND SEARCH                              
         CI,R3    6                                                             
         BE       GETSTG            :#RETRN THE SIZE AND START OF A STRNG       
         CI,R3    7                                                             
         BE       NSER              NO SEARCH-:#RETRN THE CHARACTERS            
         B        SYMDER1           ILLEGAL :#SYMBL MODE VALUE                  
         PAGE                                                                   
*************************                                                       
*       CHECK HEX        *                                                      
*************************                                                       
CKHX     MTW,0    :#HXMOD,R2                                                    
         BE       CKDCHX                                                        
         LI,R3    4                 HEX CHAR-SEE IF HEX REQUESTED               
         LB,R3    *R7,R3                                                        
         BE       IGNOR                                                         
         CI,R3    2                                                             
         BNE      FLDMCK            NOT HEX REQUEST-SEE IF :#SYMBL RQST         
         LI,R3    5                 CHECK NUMBER   MODE                         
         LB,R3    *R7,R3                                                        
         BE       IGNOR                                                         
         CI,R3    1                                                             
         BNE      NMDER2            NUMBER MODE ERROR                           
CNHX     LI,R3    0                 CONVERT   TO HEX                            
         LI,R8    0                                                             
CNHXLP   LW,R14   :#SBLPT,R2                                                    
         LB,R14    *R14,R3                                                      
         CI,R14   X'40'             CHECK FOR BLANK                             
         BE       HEXVAL            VALUE   DONE                                
         SLS,R8   4                                                             
         CLM,R14  HEXLIM                                                        
         BCS,9    %+2                                                           
         AI,R14   X'39'             CONVERT   X'C1' TO X'FA' ETC.               
         AND,R14  :#M4              GET LOW 4 BITS                              
         OR,R8    R14                                                           
         AI,R3    1                                                             
         B        CNHXLP                                                        
HEXVAL   LI,R3    1                                                             
         STW,R3   :#FLDST,R2                                                    
VALDON   LI,R9    0                 SET R10 FOR :#RETRN                         
         STW,R9   :#ERCOD,R2                                                    
SCANRET   LW,R3   :#FLDST,R2                                                    
         STB,R3   R10                                                           
         LW,R3    :#ERCOD,R2        NO ERRORS                                   
         LI,R6    1                 SETERROR   BYTE                             
         STB,R3   R10,R6                                                        
         LW,R3    :#FLDCT,R2        :#RETRN FIELD COUNT                         
         LI,R6    2                                                             
         STB,R3   R10,R6                                                        
         LW,R3    :#DELIM,R2        :#RETRN DELIMITER                           
         LI,R6    3                                                             
         STB,R3   R10,R6                                                        
         STW,R4   :#CHRPS,R2                                                    
         STW,R4   :#ECHPS,R2                                                    
         LW,R4    :#RETRN,R2                                                    
SCANOUT  B        *R4                                                           
DECVAL   LW,R8    R9                MOVE   VALUE   TO R8 FOR :#RETRN            
         LI,R3    2                                                             
         STW,R3   :#FLDST,R2                                                    
         B        VALDON                                                        
         PAGE                                                                   
*************************                                                       
*       CHECK DEC        *                                                      
*************************                                                       
CKDCHX   RES      0                 COULD BE HEX OR DEC                         
         LI,R3    4                 IS IT HEX                                   
         LB,R3    *R7,R3                                                        
         BE       IGNOR                                                         
         CI,R3    2                                                             
         BNE      CKDC              NOT HEX                                     
         LI,R3    5                                                             
         LB,R3    *R7,R3                                                        
         BE       IGNOR                                                         
         CI,R3    7                 CHECK FOR EBCDIC                            
         BE       NSER              RETURN FIRST 8 CHAR                         
         CI,R3    1                                                             
         BE       CNHX              IS HEX                                      
         CI,R3    2                                                             
         BNE      NMDER1            ILLEGAL VALUE   IN NUMBER FIELD             
*                                   CONVERT   TO DEC                            
CNDC     LI,R3    0                                                             
         LI,R9    0                                                             
CNDCLP   LW,R14   :#SBLPT,R2                                                    
         LB,R14   *R14,R3                                                       
         CI,R14   X'40'                                                         
         BE       DECVAL            VALUE   DONE-:#RETRN                        
         MI,R9    10                                                            
         AND,R14  :#M4                                                          
         AW,R9    R14                                                           
         AI,R3    1                                                             
         B        CNDCLP                                                        
CKDC     RES      0                                                             
         CI,R3    1                 MAYBE ITS A 'STRING' REQUEST ?              
         BE       FLDMCK            B IF IT IS                                  
         CI,R3    3                 DECIMAL REQUESTED                           
         BNE      FMDER1            ILLEGAL VALUE   IN FIELD MODE               
         LI,R3    5                                                             
         LB,R3    *R7,R3                                                        
         CI,R3    2                                                             
         BNE      NMDER2            CANNOT :#RETRN REQUEST                      
         B        CNDC              CONVERT   TO DECIMAL                        
         PAGE                                                                   
*************************                                                       
*       PRE SEARCH       *                                                      
*************************                                                       
SSER     LI,R3    '%'               CHECK FOR SPECIAL :#SYMBL                   
         LW,R8    :#SBLPT,R2                                                    
         CB,R3    *R8                                                           
         BNE      DSSER             NOT SPECIAL :#SYMBL                         
         LI,R7    1                                                             
         LB,R3    *R8,R7            CHECK NEXT BYTE                             
         LI,R7    0                 SET FOR :#SYMBL DEFINED                     
         CI,R3    ' '                                                           
         BNE      CKCOD             OTHER   CHARACTER PRESENT                   
         LW,R8    :#CURLC,R2        :#SYMBL IS %                                
         B        DSSERX                                                        
CKCOD    LW,R8    R2                CHECK FOR CONDITION CODES                   
         CI,R3    'C'                                                           
         BNE      %+3                                                           
         LI,R8    :#CCSV            GET VALUE   OF CODES                        
         B        DSSERX                                                        
         CI,R3    'F'               CHECK FOR FLOAT CONTROLS                    
         BNE      %+3               LOOK FOR INSTRUCTION ADDRESS                
         LI,R8    :#FLSV                                                        
         B        DSSERX                                                        
         CI,R3    'I'               CHECK FOR INSTRUCTION ADDRS                 
         BNE      DSSER             LOOK FOR NORMAL SYMB                        
         LI,R8    :#SNPSV                                                       
DSSERX   AW,R8    R2                ADJUST BY DATA PAGE ADDRESS                 
         B        DSSER+1                                                       
DSSER    LI,R7    1                 PREVIOUSLY  BAL,R8 SSERACH                  
         LI,R3    4                 SET STATUS                                  
         STW,R3   :#FLDST,R2                                                    
         CI,R7    0                                                             
         BE       VALDON                                                        
         B        SSYER1            UNDEFINED :#SYMBL-SYSTEM                    
USER     BAL,R8   USEARCH                                                       
         LI,R3    3                 SET STATUS                                  
         STW,R3   :#FLDST,R2                                                    
         CI,R7    0                                                             
         BE       VALDON                                                        
         MTW,0    :#SSMOD,R2                                                    
         BNE      SSER                                                          
         B        USYER1            UNDEFINED :#SYMBL-USER                      
OSER     BAL,R8   OSEARCH                                                       
         LI,R3    5                                                             
         STW,R3   :#FLDST,R2                                                    
         CI,R7    0                                                             
         BE       VALDON                                                        
         B        OSYER1            UNDEFINED :#SYMBL-OP CODE                   
NSER     LW,R8    :#SYMBL,R2        NO SEARCH-:#RETRN                           
         LW,R9    :#SYMBL+1,R2                                                  
         LI,R3    8                                                             
         STW,R3   :#FLDST,R2                                                    
         LI,R3    0                                                             
         STW,R3   :#ERCOD,R2                                                    
         B        SCANRET                                                       
GETSTG   LW,R9    :#CHRCT,R2        GET START OF STRING AND COUNT               
         AI,R9    -1                SUBTRACT 1 FOR DELIM                        
         STH,R9   R8                                                            
         LI,R3    1                                                             
         LW,R9    :#SCHPS,R2        RELATIVE START OF STRING                    
         STH,R9   R8,R3                                                         
         LW,R9    :#SYMBL,R2        GET FIRST 4 CHAR OF STRING                  
         LI,R3    7                 SET STATUS                                  
         STW,R3   :#FLDST,R2                                                    
         LI,R3    0                                                             
         STW,R3   :#ERCOD,R2                                                    
         B        SCANRET                                                       
IGNOR    LI,R3    11                IGNORE THE FIELD                            
         STW,R3   :#FLDST,R2                                                    
         B        VALDON                                                        
CSER     RES      0                 COMMAND SEARCH                              
         LI,R7    1                                                             
         LW,R3    :#CHRCT,R2        TEST SYMBOL SIZE                            
         CI,R3    3                 OK, IF NOT GREATER THAN 2                   
         BG       %+2                                                           
         BAL,R8   CSEARCH           SEARCH THE COMMAND TABLE                    
         LI,R3    6                 SET FIELD STATUS                            
         STW,R3   :#FLDST,R2                                                    
         CI,R7    0                                                             
         BE       VALDON                                                        
         B        CSYER1                                                        
         PAGE                                                                   
*************************                                                       
*        CONSTANTS       *                                                      
*************************                                                       
         BOUND    8                                                             
ALFLIM   DATA     X'C1',X'E9'                                                   
NUMLIM   DATA     X'F0',X'F9'                                                   
HEXLIM   DATA     X'C1',X'C6'                                                   
ALFCHR   TEXTC    '%:#@!"%&=?<>\|[{ '                                           
         PAGE                                                                   
*************************                                                       
*         ERRORS         *                                                      
*************************                                                       
NMDER1   LI,R3    3                 ILLEGAL NUMBER MODE VALUE                   
         B        ERRET1                                                        
NMDER2   LI,R3    4                 CANNOT :#RETRN FIELD REQUESTED IN           
         B        ERRET1                                                        
FMDER1   LI,R3    2                 ILLEGAL FIELD MODE VALUE                    
         B        ERRET1                                                        
SCMDER1   LI,R3   1                 ILLEGAL SCAN   MODE VALUE                   
         B        ERRET1                                                        
BMDER1   LI,R3    6                 ILLEGAL BLANK MODE VALUE                    
         B        ERRET1                                                        
ICHER1   STW,R11  :#DELIM,R2        AN ILLEGAL CHARACTER IS PRESENT             
         LI,R3    11                SAVE CHAR IN :#DELIM                        
         B        ERRET1                                                        
SYMDER1   LI,R3   5                 ILLEGAL :#SYMBL MODE VALUE                  
         B        ERRET1                                                        
SSYER1   LI,R3    7                 UNDEFINED :#SYMBL ERROR-SYSTEM              
         LW,R8    :#SYMBL,R2                                                    
         LW,R9    :#SYMBL+1,R2                                                  
         LI,R14   8                 SET FIELD STATUS                            
         B        ERRET                                                         
USYER1   LI,R3    8                 UNDEFINED :#SYMBL ERROR-USER                
         LW,R8    :#SYMBL,R2                                                    
         LW,R9    :#SYMBL+1,R2                                                  
         LI,R14   8                 SET FIELD STATUS                            
         B        ERRET                                                         
OSYER1   LI,R3    9                 UNDEFINED :#SYMBL ERROR-OP CODE             
         LW,R8    :#SYMBL,R2                                                    
         LW,R9    :#SYMBL+1,R2                                                  
         LI,R14   8                 SET FIELD STATUS                            
         B        ERRET                                                         
CSYER1   LI,R3    10                UNDFFINED :#SYMBL ERROR-COMMAND             
         LW,R8    :#SYMBL,R2                                                    
         LW,R9    :#SYMBL+1,R2                                                  
         LI,R14   8                 SET FIELD STATUS                            
         B        ERRET                                                         
ERRET1   LI,R14   10                                                            
ERRET    STW,R14  :#FLDST,R2                                                    
         STW,R3   :#ERCOD,R2        SAVE ERROR STATUS                           
         B        SCANRET                                                       
         PAGE                                                                   
*************************                                                       
*        CONSTANTS       *                                                      
*************************                                                       
:#M4     DATA     X'F'                                                          
:#M8     DATA     X'FF'                                                         
:#M17    DATA     X'1FFFF'                                                      
:#ALBLK  DATA     X'40404040'                                                   
         PAGE                                                                   
*************************                                                       
*       :#SCANIPTS       *                                                      
*************************                                                       
GETNS    DOIPT    NEXT,:#INBF,SYMNUM,;:#SCAN FIRST FIELD OF A LOC               
                  DEC,BOTH,SBLK,'+',;                                           
                  '-','.',',',' ',;                                             
                  '/','''',')','(','*'                                          
GETHEX   DOIPT    NEXT,:#INBF,NUM,; :#SCAN A FIELD PRECEEDED BY A . FOR         
                  HEX,IGN,BLK,'+',;   HEX                                       
                  '-',',',' ','/','''',;                                        
                  ')','('                                                       
GETOP    DOIPT    NEXT,:#INBF,IGN,; :#SCAN FOR DELIM                            
                  IGN,IGN,BLK,'+',;                                             
                  '-',',',' ','/',;                                             
                  ''''                                                          
GETEBC   DOIPT    NEXT,:#INBF,SYM,;                                             
                  IGN,STR,BLK,''''                                              
         PAGE                                                                   
GETOPC   DOIPT    NEXT,:#INBF,SYM,IGN,;                                         
                  OPC,SBLK,',',' '                                              
SETBCK   DOIPT    LASTN,:#INBF,IGN,;                                            
                  IGN,IGN,BLK                                                   
*       FORM IPTS        *                                                      
GETCOM   DOIPT    NEW,:#INBF,SYM,IGN,;                                          
                  COM,BLK,' '                                                   
         PAGE                                                                   
*************************                                                       
*         SCAN IPTS     *                                                       
*************************                                                       
GETEB    DOIPT    NEXT,:#INBF,SYM,; GET THE EBCDIC CHARACTERS                   
                  IGN,EBCD,BLK,',',;                                            
                  ' ','/'                                                       
         PAGE                                                                   
*                                                                               
IPTSLIST RES      0                                                             
         DATA     GETNS             0                                           
         DATA     GETHEX            1                                           
         DATA     GETOP              2                                          
         DATA     GETEBC            3                                           
         DATA     GETOPC            4                                           
         DATA     SETBCK            5                                           
         DATA     GETCOM            6                                           
         DATA     GETEB              7                                          
*                                                                               
         TITLE    '*** :#SQUEEZE ***'                                           
:#WKSQZ  RES      0                                                             
:#SQUEZE RES      0                                                             
         LW,R1    :#WTAB,R2         SQUEEZE THE WORKSPACE                       
         LI,R7    4                                                             
         AW,R7    R1                                                            
SQUZ1    LW,R6    *R7                                                           
         BEZ      SQUZ2             COMMENSE SQUEEZING ON ZERO PACKET           
         AND,R6   :#M8              MASK OUT SIZE                               
         AW,R7    R6                                                            
         CW,R7    1,R1              TEST IF AT END OF WORKSPACE                 
         BL       SQUZ1                                                         
         :#DBERR4 X'8D'             ALREADY TIGHT - NO PACKET                   
SQUZ2    LW,R6    R7                SAVE BEGINING PACKET ADDRESS                
SQUZ3    AI,R7    1                 MOVE FORWARD THRU BLANK SPACE               
SQUZ4    CW,R7    1,R1              TEST FOR WORKSPACE ENDING                   
         BGE      SQUZ11            OUTAGE - END OF SQUEEZE                     
         LW,R8    *R7               TEST FOR MORE ZEROES                        
         BEZ      SQUZ3             YES -                                       
         LB,R8    *R7               NO - ASSUME START OF ENTRY                  
         CI,R8    X'10'             TEST IF NAME (USER) TYPE                    
         BE       SQUZ8             YES                                         
         CI,R8    X'20'             TEST FOR SNAP OR INSERT                     
         BANZ     SQUZ5             YES -                                       
         :#DBERR4 X'8A'             OTHERWISE, UNKNOWN BLOCK                    
SQUZ5    LW,R9    1,R7              TEST IF PROGRAM LINKAGE IS                  
         AND,R9   :#M17             STILL WRITABLE                              
*        BAL,R8   TMVADR                                                        
*        B        SQUZ6             NO, ERROR                                   
*        LW,R0    R0                TEST IF ACCESS CODE IS 00                   
*        BNEZ     SQUZ6             NO, ERROR                                   
         AND,R8   X30                                                           
         SLS,R8   -4                FIX BRANCH ADDITIVE                         
         LW,R0    R7                BUILD LINK WORD                             
         AW,R0    SQUZ12                                                        
         AW,R0    R8                                                            
         CW,R0    *R9               TEST AGAINST CURRENT LINK                   
         BNEZ     SQUZ7             NOT THE SAME - ERROR                        
         LW,R0    R6                BUILD NEW LINK                              
         AW,R0    SQUZ12                                                        
         AW,R0    R8                                                            
         STW,R0   *R9               AND PUT IN PLACE                            
         B        SQUZ9             THEN SHIFT DATA BLOCK                       
*                                                                               
*                                                                               
SQUZ8    LW,R5    1,R7              RE-LINK FLINK AND BLINK                     
         BEZ      %+2                                                           
         STW,R6   2,R5                                                          
         LW,R5    2,R7                                                          
         BEZ      %+2                                                           
         STW,R6   1,R5                                                          
SQUZ9    LW,R5    *R7               GET SIZE OF BLOCK TO SHIFT                  
         AND,R5   :#M8                                                          
         LI,R9    0                                                             
SQUZ10   LW,R8    *R7               AND SHIFT BLOCK                             
         STW,R8   *R6                                                           
         STW,R9   *R7               CLEAR PREVIOUS                              
         AI,R6    1                                                             
         AI,R7    1                                                             
         BDR,R5   SQUZ10                                                        
         B        SQUZ4             CONTINUE SQUEEZE                            
SQUZ11   STW,R6   *R1               UPDATE CURRENT BLOCK                        
         B        :#USRIN4                                                      
SQUZ12   B        0                 BRANCH MASK                                 
SQUZ6    :#DBERR4 X'8B'                                                         
SQUZ7    :#DBERR4 X'8C'                                                         
A:DBS1   RES      0                                                             
         TITLE    '*** TASK TERMINATION DEBUG CLEANUP ***'                      
*                                                                               
*        ENTRY    BAL,R8     TTDEBUG                                            
*                                                                               
*                 R4=TASKID                                                     
*                 R5=LMID                                                       
*                                                                               
*                                                                               
*        ROUTINE USED R0,R1,R6,R11  ALL OTHERS SAVED                            
*                                                                               
*                 NO STACK WORDS ARE USED                                       
*                                                                               
*                                                                               
TTDEBUG  EQU      %                                                             
         LW,R0    LMIPCB,R5                                                     
         LB,R0    R0                                                            
         CI,R0    LMIDEBUG          TASK RUNNING WITH DEBUG                     
         BAZ      TTDBUGX           B IF NO                                     
         LB,R1    STIJID,R4                                                     
         LW,R1    SJI1,R1           JCB ADDRESS                                 
         LW,R0    0,R1                                                          
         CW,R0    XJCBDBG           WITH DEBUG                                  
         BAZ      TTDBUGX           NO - SOME KIND OF GLITCH IGNORE             
         CW,R0    XJCBDB6           INITIALIZED                                 
         BAZ      TTDBUGX           NO - FORGET IT                              
         LW,R6    JCBDBUG,R1        GET DEBUG CONTROL WORD                      
         BEZ      %+2               B IF NO BLOCKING BUFFER                     
         BAL,R11  RELADBUF          RELEASE BUFFER                              
         LW,R6    JCBDBUG+1,R1      GET NEXT BUFFER                             
         BEZ      %+2               B IF NO BUFFER                              
         BAL,R11  RELADBUF                                                      
         DISABLE                                                                
         LW,R0    0,R1              GET FIRST WORD OF JCB                       
         AND,R0   BCFFFFFF          RESET DEBUG CONTROL BITS                    
         STW,R0   0,R1                                                          
         LI,R0    0                                                             
         STW,R0   JCBDBUG,R1        ZERO CONTROL WORDS                          
         STW,R0   JCBDBUG+1,R1                                                  
         ENABLE                                                                 
TTDBUGX  EQU      %                                                             
         B        *R8               EXIT                                        
BCFFFFFF DATA     X'BCFFFFFF'                                                   
*                                                                               
         OLAYEND                                                                
         FIN      #DEBUG                                                        
         END                                                                    
