         PSYS     0                                                             
OLAYFLAG EQU      'DBC3'                                                        
         SYSTEM   OPTIONS                                                       
         DO       #DEBUG                                                        
         SYSTEM   CPRMON                                                        
         PSYS     0                                                             
         SYSTEM   OLAYBASE                                                      
         DEF      A:DBC3            DEBUG COMMANDS PART 3                       
         DEF      :#MODFY                                                       
         DEF      :#RERCHK                                                      
         DEF      :#PATCH                                                       
         DEF      :#DOVAL                                                       
         DEF      :#DODMP                                                       
         DEF      :#SCNDR                                                       
         DEF      DUMPEXIT          OVERLAY OUTAGE - DUMP                       
         DEF      DBERR3            OUTAGE TO OVERLAY-DBS2                      
         DEF      USRIN3            OUTAGE TO OVERLAY-DBS2                      
         DEF      SCNDROUT          RETURN FROM :#SCNDR                         
*        REF      :#SCAN            OVERLAY-S1                                  
*        REF      :#SCNLCX,:#SCNLWX OVERLAY-S3                                  
*        REF      :#SCNWDX          OVERLAY-S3                                  
*        REF      :#DMPRET          OVERLAY-C1                                  
         DO       UTS                                                           
         REF      M:UC,M:LO,F:P1,F:P2                                           
         FIN                                                                    
         ORG      0                                                             
:#DBERR3 LW,R8    :#DBERR,R2                                                    
DBERR3   B        *R8                                                           
:#USRIN3 LW,R8    :#USRIN,R2                                                    
USRIN3   B        *R8                                                           
ERRETN   DATA     :#DBERR3          POINTER FOR CAL ERRORS                      
         TITLE    '***  :#MODFY ***'                                            
*************************                                                       
*         :#MODFY        *                                                      
*************************                                                       
* COMMAND SYNTAX                                                                
* M  LOC/WORD1/WORD2/....../WORDN                                               
* WORD MODIFIED IN CORE AND THE OLD                                             
*    CONTENTS IS PUT INTO THE PATCH                                             
*    TABLE                                                                      
:#MODFY  RES      0                                                             
         LI,R1    2                 SET MIN ELEMENT TO 2                        
         BAL,R8   :#SCNLWX          GET LOC AND WORDS                           
         B        :#DBERR3                                                      
         LI,R5    X'18'             GET TYPE-DO FIRST WORD                      
         STB,R5   R12               SET TYPE                                    
         LI,R5    3                                                             
         STB,R1   R12,R5            STORE   SIZE                                
         STW,R12  :#MDBF,R2                                                     
         LW,R14   R1                INSERT   CHANGES-SAVE OLD CONTENTS          
         AI,R14   -3                REDUCE SIZE TO NUMBER   OF PATCHES -1       
         LW,R4    :#MDBF+1,R2                                                   
         CI,R4    16                                                            
         BGE      MDCR                                                          
         LI,R3    0                 STORE   TO REGISTERS-DONT     SAVE IN       
REGLP    LI,R0    :#MDBF+2           PATCH AREA                                 
         AW,R0    R2                                                            
         LW,R5    *R0,R3                                                        
         LI,R0    :#REG0            REPLACE REGISTER                            
         AW,R0    R2                                                            
         STW,R5   *R0,R4                                                        
         AI,R3    1                                                             
         AI,R4    1                                                             
         AND,R4   :#M4              USE MOD 16                                  
         CW,R3    R14                                                           
         BLE      REGLP             REGISTERS   NOT DONE                        
         B        :#USRIN3                                                      
MDCR     RES      0                                                             
         XW,R14   R5                                                            
MDLP     LI,R3    :#MDBF+2          LOAD NEW CONTENTS                           
         AW,R3    R2                                                            
         LW,R0    :#MDBF+1,R2       XCHANGE WITH NEW CONTENTS                   
         LW,R14   *R3,R5                                                        
         XW,R14   *R0,R5                                                        
         STW,R14  *R3,R5            SAVE OLD CONTENTS                           
         AI,R5    -1                                                            
         BGE      MDLP                                                          
         XW,R14   R5                                                            
         B        :#USRIN3                                                      
         TITLE    '***  :#DUMP   ***'                                           
:#DODMP           RES      0                                                    
         STW,R6   :#DMPRT,R2        SAVE RETURN                                 
         LI,R4    1                 GET TWO BYTE OP LABEL                       
         LH,R4    R10,R4                                                        
         LH,R5    OPTB              GET NUMBER OF LEGAL OP LABELS               
OPLP     CH,R4    OPTB,R5                                                       
         BE       OPFND                                                         
         BDR,R5   OPLP              CONTINUE SEARCH                             
         :#DBERR3 X'92'             NOT FOUND-ILLEGAL OP                        
OPFND    LW,R14   DCBTB,R5          GET PROPER DCB ADDRESS                      
         AW,R14   R2                *SPECIAL ADJUSTMENT HERE                    
         LI,R15   X'1FFFF'                                                      
         STS,R14  :#DPFPT,R2        STORE IN FPT                                
         STW,R9   :#DMPLC,R2                                                    
         MTW,1    :#DMPLC,R2                                                    
         LI,R4    0                 SET SPACER  MODE OFF                        
DOBUF    CW,R9    R8                IF LIMITS INCORRECT                         
         BGE      %+2               :#DUMP FIRST WORD ONLY                      
         LW,R9    R8                                                            
         LB,R7    R10               BUILD BUFFER                                
         CI,R7    'X'               TEST FOR OUTPUT HERE                        
         BNE      CKEB                                                          
         LI,R15   :#CNIFX           CONVERT   TO HEX                            
         LI,R1    8                 SET NUMBER/LINE   TO 8                      
         LI,R14   8                 BYTES/ELEMENT                               
         LI,R3    1                                                             
         B        LNOUT                                                         
CKEB     CI,R7    'E'                                                           
         BNE      CKDC                                                          
         LI,R15   :#CNIFE           EBCDIC                                      
         LI,R1    8                 NUMBER/LINE   = 8                           
         LI,R14   4                                                             
         LI,R3    5                 SPACE COUNT                                 
         B        LNOUT                                                         
CKDC     CI,R7    'D'                                                           
         BNE      CKBN                                                          
         LI,R15   :#CNIFD                                                       
         LI,R1    4                 NUMBER/LINE                                 
         LI,R14   12                                                            
         LI,R3    2                 SPACE COUNT                                 
         B        LNOUT                                                         
CKBN     RES      0                 MUST BE BINARY                              
         LI,R15   :#CNIFB                                                       
         LI,R1    2                 NUMBER/LINE                                 
         LI,R14   32                                                            
         LI,R3    2                                                             
         LI,R4    1                 SET SPACER   MODE ON                        
         PAGE                                                                   
LNOUT    RES      0                 R4-R9 DESTROYED BY CONVERT   ROUTINES       
         STW,R14  :#NCCT,R2                                                     
         STW,R1   :#NLCT,R2                                                     
         STW,R3   :#SPCT,R2                                                     
         STW,R4   :#SPMD,R2                                                     
         SW,R9    R8                GET NUMBER   OF WORDS TO OUTPUT             
         LW,R3    R9                NUMBER   TO :#DUMP-1                        
         AI,R3    1                 CHANGE TO NUMBER   TO :#DUMP                
         LW,R10   R8                FIRST LOC                                   
         CW,R3    :#NLCT,R2         SEE IF LESS THAN 1 LINE                     
         BLE      LNLP              YES                                         
         LW,R9    R8                                                            
         LI,R8    0                 SET FOR DIVIDE                              
         DW,R8    :#NLCT,R2         MAKE START A MULTIPLE                       
         AW,R3    R8                   OF :#NLCT                                
         MW,R9    :#NLCT,R2         INCREASE NUMBER   TO OUTPUT                 
         LW,R10   R9                                                            
LNLP     LW,R14   R2                START OF OUTPUT BT                          
         SLS,R14  2                                                             
         AI,R14   :#QDMPBF+1                                                    
         LW,R1    :#NLCT,R2                                                     
         CI,R3    0                                                             
         BLE      DPDON             :#DUMP  DONE                                
         :#STORE  :#DPBFS,:#DMPBF,*:#ALBLK                                      
         LI,R12   0                 SET :#SPMD TO OFF                           
         XW,R12   :#SPMD,R2         SAVE SPACER MODE                            
         LI,R5    '.'               SET FIRST CHAR AS .                         
         LI,R7    :#DMPBF                                                       
         AW,R7    R2                                                            
         STB,R5   *R7                                                           
         LW,R9    R10               PUT LOCATION NUMBER                         
         :#CNIFX  :#CONVL              ON LINE                                  
         LI,R6    5                                                             
         LW,R5    R2                DO 5 CHARACTERS                             
         SLS,R5   2                                                             
         AI,R5    :#QCONVL+3                                                    
         BAL,R8   MOVBT                                                         
         STW,R12  :#SPMD,R2         RESET OLD SPMD                              
         AI,R14   3                 INSERT   SPACES                             
DPLP     CI,R10   16                SEE IF A REGISTER                           
         BGE      DPLOC             NOT                                         
         LW,R7    R10                                                           
         LI,R9    :#REG0            GET REGISTER                                
         AW,R9    R2                                                            
         LW,R9    *R9,R7                                                        
         B        %+2                                                           
DPLOC    LW,R9    *R10              GET LOC TO :#DUMP                           
         AI,10    1                                                             
         LI,R7    :#CONVL           PLACE TO :#STORE RESULT                     
         AW,R7    R2                                                            
         BAL,R8   *15               GO TO CONVERT   ROUTINE                     
         LW,R6    :#NCCT,R2         GET CHR CT TO MOVE                          
         LW,R5    R2                                                            
         SLS,R5   2                                                             
         AI,R5    :#QCONVL                                                      
         BAL,R8   MOVBT             MOVE   STRING                               
         AW,R14   :#SPCT,R2         MOVE   BUFFER   BY SPACE COUNT              
         AI,R3    -1                DEC NUMBER   TO OUTPUT                      
         BLE      LNDOT             OUTPUT PARTIAL LINE                         
         BDR,R1   DPLP              LINE NOT FULL                               
LNDOT    RES      0                                                             
         LW,R8    ERRETN                                                        
         STW,R8   :#CALERR,R2                                                   
         CAL1,1   :#DPFPT,R2        DO OUTPUT                                   
         LW,R8    :#TBFLAG,R2       TEST FOR INTERVENING TRAP/BREAK             
         BEZ      LNLP              NO- GET NEXT LINE                           
DPDON    LW,R3    :#DMPRT,R2        RETURN                                      
DUMPEXIT B        :#DMPRET                                                      
MOVBT    LI,R11   8                 SET FOR SPACER                              
         STW,R14   R7                                                           
         LB,R14   0,R5              MOVE   R6 WORDS FROM R5 TO R7               
         STB,R14  0,R7                                                          
         AI,R5    1                 NEXT BYTE                                   
         AI,R7    1                 NEXT BYTE                                   
         AI,R11   -1                                                            
         BLE      CKSPR                                                         
CONLP    BDR,R6   MOVBT+2                                                       
         STW,R7   R14                                                           
         B        *R8                                                           
CKSPR    MTW,0    :#SPMD,R2                                                     
         BE       CONLP             NORMAL MODE                                 
         CI,R6    1                 SEE IF LAST CHARACTER                       
         BE       CONLP             IS LAST                                     
         LI,R14   X'60'             USE MINUS FOR SPACER                        
         STB,R14  0,R7              PUT INTO BUFFER                             
         AI,R7    1                                                             
         LI,R11   8                 RESTART SPACER                              
         B        CONLP                                                         
         TITLE    '***  :#SCNDR   ***'                                          
*************************                                                       
*         :#SCNDR        *                                                      
*************************                                                       
* :#SCAN ONE DUMP   REQUEST                                                     
*        CALL IS  BAL,R8 :#SCNDR                                                
*                 NO INPUT PARAMETERS                                           
*                 RETURN  R8 CONTAINS THE STARTING LOC                          
*                         R9 CONTAINS THE FINAL LOC                             
*                         R10 BYTE 0 CONTAINS THE FORMAT IN EBCDIC              
*                         R10 BYTE 2,3 CONTAIN THE EBCDIC OP LABEL              
*                         IF NO ENDING LOC IS PRESENT R9=R8                     
*                         IF NO FORMAT IS PRESENT IF WILL DEFAULT TO X          
*                         IF NO OPLABEL   IS PRESENT A ZERO   WILL BE           
*                            RETURNED                                           
*                 IF THE DELIM   IS / ' BLANK NL THE ROUTINE WILL RETURN        
*                 WITH THE DELIM   IN R7 - ANY OTHER   DELIM WILL CAUSE A       
*                    CAL TO :#DBERR                                             
*                         IF THE FIELD IS EMPTY R8 WILL                         
*                            CONTAIN X'01000000'                                
*  REGISTERS     USED                                                           
*   R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15                                      
         PAGE                                                                   
:#SCNDR   RES     0                                                             
         LW,R12   :#Y01             INITIALIZE START                            
         LI,R13   0                 INITIALIZE END                              
         STW,R8   :#SCDRT,R2                                                    
         BAL,R8   :#SCNLCX          GET FIRST LOC                               
         B        :#DBERRD                                                      
         GETEMF                                                                 
         BE       SCANDND           EMPTY FIELD                                 
         AND,R8   :#M17             TRUNCATE ADDRESS FIELD                      
         CI,R7    0                                                             
         BGE      NOIND             NOT INDIRECT                                
         AND,R7   :#M8              REMOVE   IND BIT                            
         CI,R8    16                LOOK FOR REGISTER                           
         BGE      NOINDX1           NOT                                         
         LW,R6    R8                IS                                          
         LI,R13   :#REG0                                                        
         AW,R13   R2                                                            
         LW,R8    *R13,R6                                                       
         B        NOIND                                                         
NOINDX1  LW,R8    *R8               DO INDIRECT                                 
NOIND    RES      0                                                             
         AND,R8   :#M17             MASK IN CASE OF INDIRECTION                 
         STW,R8   R12               SAVE START LOC IN R12                       
         CI,R7    ','                                                           
         BE       NXLOC             LOOK FOR NEXT LOC                           
         LW,R13   R12               SET START=END                               
         B        SCANDND                                                       
NXLOC    RES      0                 LOOK FORNEXT LOC                            
         BAL,R8   :#SCNLCX                                                      
         B        :#DBERRD                                                      
         STW,R8   R13                                                           
         AND,R13  :#M17             TRUNCATE LOC                                
         CI,R7    0                                                             
         BGE      NOIND2            NOT INDIRECT                                
         AND,R7   :#M8                                                          
         LW,R13   *R8                                                           
         CI,R8    16                LOOK FOR REGISTER                           
         BGE      NOIND2            NOT                                         
         LW,R6    R8                                                            
         LI,R13   :#REG0                                                        
         AW,R13   R2                                                            
         LW,R13   *R13,R6                                                       
NOIND2   RES      0                                                             
         AND,R13  :#M17             MASK IN CASE OF INDIRECTION                 
         MTW,0    :#DMPMD,R2        IS IT SIZE MODE                             
         BE       DLMT              IS NOT                                      
         CI,R13   0                 SEE IF SIZE IS NEG                          
         BLE      ILZER1                                                        
         AW,R13   R12               GENERATE   FINAL LOC                        
         AI,R13   -1                                                            
DLMT     CI,R7    ','                                                           
         BE       GTFMT                                                         
         B        SCANDND           PREPARE TO RETURN                           
GTFMT    RES      0                 LOOK FOR FORMAT                             
         LI,R15   'X'                                                           
         :#SCAN   :#GETEB                                                       
         GETEMF                     TEST EMPTY FIELD                            
         BE       CKFDL1                                                        
         GETSTS                                                                 
         CI,R6    8                                                             
         BNE      ILFER1            ILLEGAL FORMAT SPECIFICATION-:#SCAN         
         LI,R7    1                 LOOK AT SECOND CHAR                         
         LB,R7    R8,R7                                                         
         CI,R7    X'40'             IS IT BLANK                                 
         BNE      CKOPL             NO-NO FORMAT PRESENT                        
         LB,R7    R8                YES-CHECK FOR FORMAT-FIRST BYTE             
         LB,R6    FMT                                                           
FMLP     CB,R7    FMT,R6                                                        
         BE       CKFDL             VALID FORMAT CHARACTER                      
         BDR,R6   FMLP                                                          
         B        ILFER1            INVALID FORMAT 1 CHAR-NOT CORRECT           
CKFDL    RES      0                 CHECK DELIM   AFTER   FORMAT                
         LB,R8    R8                STORE   FORMAT INTO R15                     
         STW,R8   R15                                                           
CKFDL1   GETDLM                                                                 
         LW,R7    R6                GET DELIM                                   
         CI,R7    ','                                                           
         BNE      SCANDND1          PREPARE TO RETURN                           
         :#SCAN   :#GETEB           GET OP LABEL                                
         GETSTS                                                                 
         CI,R6    8                                                             
         BE       CKOPL                                                         
ILOER1   :#DBERRD X'53'             ILLEGAL OP-LABEL-:#SCAN   ERROR             
ILKER1   :#DBERRD X'54'                                                         
         PAGE                                                                   
CKOPL    RES      0                 TWO CHAR-MUST BE OP LABEL                   
         LI,R14   0                 DEFAULT OPLABEL CONDITION                   
         LI,R7    2                                                             
         LB,R7    R8,R7                                                         
         CI,R7    X'40'             COMPARE  THIRD CHAR TO BLANK                
         BNE      ILOER1            ILLEGAL OPLABEL - TOO LONG                  
         SLS,R8   -16                                                           
         STW,R8   R14                                                           
         GETDLM                                                                 
         LW,R7    R6                                                            
         B        SCANDND2                                                      
SCANDND  LI,R15   'X'               DEFAULT FORMAT                              
SCANDND1 LI,R14   0                 DEFAULT FOR OPLABEL                         
SCANDND2 LW,R9    R12               STARTING LOCATION                           
         LW,R10   R13               ENDING LOCATION                             
         LW,R12   R11               SAVE REGISTER                               
         LI,R11   X'10'             TEST ACCESS AS READ                         
         STB,R15  R14               SET FORMAT                                  
*        BAL,R8   TMCKADP           CHECK ADDRESS RANGE                         
*        B        ILRER1            ERROR                                       
         LW,R8    R9                START                                       
         LW,R9    R10               END                                         
         LW,R10   R14               OPLABEL & FORMAT                            
         LW,R11   R12                                                           
         AND,R7   :#M8              CLEAN DELIMITER                             
         LW,R15   :#SCDRT,R2                                                    
         AI,R15   1                                                             
         B        SCNDROUT                                                      
:#DBERRD LW,R15   :#SCDRT,R2                                                    
SCNDROUT B        *R15                                                          
         PAGE                                                                   
ILFER1   :#DBERRD  X'51'            ILLEGAL FORMAT-:#SCAN ERROR                 
ILZER1   :#DBERRD X'52'             ILLEGAL SIZE FOR D                          
ILRER1   :#DBERRD X'55'             INVALID DUMP ADDRESSES                      
FMT      TEXTC    'XDBE'            VALID FORMAT CHARACTERS                     
OPTB     DATA,2   HA(OPTBE)-HA(OPTB)-1                                          
         DATA,2   0,'DL','DO','P1','P2'                                         
OPTBE    RES      0                                                             
         BOUND    4                                                             
DCBTB    DATA     DCBTBE-DCBTB-1                                                
         DO       UTS                                                           
         DATA     M:UC,M:UC,M:LO,F:P1,F:P2                                      
         ELSE                                                                   
         DATA     :#FDL                                                         
         DATA     :#FDL                                                         
         DATA     :#FDO                                                         
         DATA     :#FP1                                                         
         DATA     :#FP2                                                         
         FIN                                                                    
DCBTBE   RES      0                                                             
         TITLE    ':#PATCH'                                                     
************************                                                        
*       :#PATCH         *                                                       
************************                                                        
:#PATCH  RES      0                                                             
         CI,R8    1                                                             
         BNE      PEND              COMMAND IS PATCH END                        
         LW,R4    :#RDFPT,R2        SET FOR BATCH MODE                          
         LI,R14   :#FDP             SET CORRECT DCB                             
         AW,R14   R2                                                            
DOPT     STW,R4   :#BATMD,R2                                                    
         LI,R15   X'1FFFF'          SET READ FPT                                
         STS,R14  :#RDFPT,R2                                                    
         B        :#USRIN3                                                      
PEND     RES      0                                                             
         LW,R14   REWDP             FPT IN REGISTER                             
         AW,R14   R2                                                            
         CAL1,1   R14                                                           
         LW,R14   :#BATMD,R2        RE-SET FPT FOR                              
         LI,R4    0                 ON-LINE ACTION                              
         B        DOPT                                                          
REWDP    GEN,8,1,23  X'01',0,:#FDP                                              
         TITLE    ':#RERCHK'                                                    
:#RERCHK RES      0                 READ ERROR OR ABNORMAL                      
         LW,R8    :#RDCMP,R2                                                    
         LB,R14   R8                                                            
         CI,R14   5                 CHECK FOR EOT,EOD,EOF                       
         BL       EROT                                                          
         CI,R14   7                                                             
         BG       EROT                                                          
         LI,R8    1                 IF EOD ETC. GO TO ON-LINE MODE              
         B        :#PATCH           DO PE COMMAND                               
EROT     :#DBERR3 X'1F2'                                                        
*                                                                               
         TITLE    '***  :#DOVAL  ***'                                           
:#DOVAL  RES      0                 PRINT VALUE   OF WORD                       
         BG       DOPRMT                                                        
         BAL,R8   :#SCNWDX                                                      
         B        :#DBERR3                                                      
         GETEMF                                                                 
         BE       ILWER2                                                        
         LW,R9    R8                CONVERT   TO HEX                            
         :#CNIFX  :#CONVL                                                       
         LW,R6    :#CONVL,R2                                                    
         LW,R7    :#CONVL+1,R2                                                  
         STW,R6   :#VL,R2                                                       
         STW,R7   :#VL+1,R2                                                     
         SETBUF   :#VLBF,16                                                     
         LW,R9    ERRETN                                                        
         STW,R9   :#CALERR,R2                                                   
         CAL1,1   :#WRFPT,R2                                                    
         B        :#USRIN3                                                      
         PAGE                                                                   
DOPRMT   RES      0                                                             
         :#SCAN   :#GETEB                                                       
         GETERR                                                                 
         BNE      ILSER1                                                        
         LB,R4    R8                                                            
         LI,R0    :#PRTBF           USE FIRST BYTE ONLY                         
         AW,R0    R2                                                            
         STB,R4   *R0                                                           
         AI,R0    :#IDBF-:#PRTBF                                                
         STB,R4   *R0                                                           
         AI,R0    :#TRPBF-:#IDBF                                                
         STB,R4   *R0                                                           
         B        :#USRIN3                                                      
ILWER2   :#DBERR3  X'F4'            ILLEGAL WORD                                
ILSER1   :#DBERR3 X'F1'             SCAN ERRER                                  
         TITLE    '***  :#CNIFX ***'                                            
*************************                                                       
*         :#CNIFX        *                                                      
*************************                                                       
*  CONVERT   INTERNAL FORMAT TO HEX CHARACTERS                                  
*        CALL IS  BAL,R8 :#CNIFX                                                
*                 R7 CONTAINS THE ADDRESS WHERE   THE                           
*                    CHARACTERS   ARE TO BE PUT                                 
*                 R9 CONTAINS THE VALUE   TO BE CONVERTED                       
*                 ON RETURN  *R7  CONTAINS THE CHARACTERS                       
*                    RIGHT ADJUSTED WITH LEADING ZERO                           
*                    CHARACTERS                                                 
*  REGISTERS     USED                                                           
*    R4,R5,R6,R7,R8,R9                                                          
:#CNIFX  RES      0                                                             
         LI,R6    7                                                             
         LW,R4    R9                                                            
CNXLP    SLD,R4   -4                                                            
         SLS,R5   -28                                                           
         CI,R5    10                                                            
         BGE      %+3                                                           
         AI,R5    X'F0'             CONVERT   TO NUMERIC CHARACTER              
         B        %+2                                                           
         AI,R5    X'B7'             CONVERT   TO ALF CHARACTER                  
         STB,R5   *R7,R6                                                        
         AI,R6    -1                                                            
         BGE      CNXLP             CONTINUE CONVERSION                         
         B        *R8               DONE-DO RETURN                              
         TITLE    '***  :#CNIFD ***'                                            
*************************                                                       
*         :#CNIFD        *                                                      
*************************                                                       
*  CONVERT   INTERNAL FORMAT TO DECIMAL CHARACTERS                              
*        CALL IS  BAL,R8 :#CNIFD                                                
*                 R7 CONTAINS THE ADDRESS WHERE   THE                           
*                    CHARACTERS   ARE TO BE PUT                                 
*                 R9 CONTAINS THE VALUE   TO BE CONVERTED                       
*                 ON RETURN  *R7     CONTAINS THE CHARACTERS                    
*                    RIGHT ADJUSTED. LEADING ZEROS   WILL BE                    
*                    REPLACED BY CHARACTER   ZEROS.                             
*   REGISTERS     USED                                                          
*    R4,R5,R6,R7,R8,R9                                                          
:#CNIFD  RES      0                                                             
         LI,R4    ' '                                                           
         CI,R9    0                 SEE IF NUMBER IS +OR -                      
         BGE      %+3               WORD IS +                                   
         LCW,R9   R9                                                            
         LI,R4    '-'                                                           
         STB,R4   *R7                                                           
         LI,R6    11                                                            
         LW,R5    R9                                                            
CNDLP    LI,R4    0                                                             
         DW,R4    :#KA              DEVIDE BY 10                                
         AI,R4    X'F0'                                                         
         STB,R4   *R7,R6                                                        
         BDR,R6   CNDLP             CONTINUE FOR 12 CHAR                        
         B        *R8               GET LEADING ZEROS   AUTOMATICALLY           
         TITLE    '**  :#CNIFE **'                                              
*************************                                                       
*         :#CNIFE        *                                                      
*************************                                                       
*  CONVERT   INTERNAL FORMAT TO EBCDIC CHARACTERS                               
*        CALL IS  BAL,R8 :#CNIFE                                                
*                 R7 CONTAINS THE LOCATION WHERE   THE                          
*                    CHARACTERS   ARE TO BE PUT                                 
*                 R9 CONTAINS THE WORD TO BE CONVERTED                          
*                 ON RETURN  *R7 CONTAINS THE CHARACTERS                        
*                    ALL ILLEGAL CHARACTERS   WILL BE                           
*                    REPLACED BY A                                              
*   REGISTERS     USED                                                          
*    R3,R4,R5,R7,R8,R9                                                          
CHRTAB   RES      0                                                             
         TEXTC    ' `.<(+ &!%*);  -/^,% >?:#@''="ABCDEFGHIJKLMNOPQRS';          
                   ,'TUVWXYZ0123456789'                                         
         PAGE                                                                   
:#CNIFE  RES      0                                                             
         LI,R5    3                                                             
BYLP     LB,R4    R9,R5             GET BYTE                                    
         LB,R6    CHRTAB            SEE IF PRINTABLE                            
CHRLP    CB,R4    CHRTAB,R6                                                     
         BE       CHRPR             IS PRINTABLE                                
         BDR,R6   CHRLP                                                         
         LI,R4    '.'               CHAR NOT PRINTABLE-REPLACE   WITH           
CHRPR    STB,R4   *R7,R5                                                        
         AI,R5    -1                                                            
         BGE      BYLP              GET NEXT BYTE                               
         B        *R8               DONE                                        
         TITLE    '**  :#CNIFB **'                                              
*************************                                                       
*         :#CNIFB        *                                                      
*************************                                                       
*  CONVERT   INTERNAL FORMAT TO BINARY CHARACTERS                               
*        CALL IS  BAL,R8  :#CNIFB                                               
*                 R7 CONTAINS THE LOCATION WHERE   THE                          
*                    CHARACTERS   ARE TO BE STORED                              
*                 R9 CONTAINS THE WORD TO BE CONVERTED                          
*                 ON RETURN  *R7        CONTAIN THE                             
*                   CHARACTERS.   ALL CHARACTERS WILL BE                        
*                   EITHER   A 1 OR A 0                                         
*  REGISTERS     USED                                                           
*   R4,R5,R6,R7,R8,R9                                                           
:#CNIFB  RES      0                                                             
         LI,R5    0                                                             
         LI,R4    32                                                            
CNLP     CI,R9    0                                                             
         BL       %+3                                                           
         LI,R6    X'F0'             SET CHAR TO 0                               
         B        %+2                                                           
         LI,R6    X'F1'             SET CHAR TO 1                               
         STB,R6   *R7,R5                                                        
         AI,R5    1                                                             
         SLS,R9   1                 LOOK AT NEXT BIT                            
         BDR,R4   CNLP                                                          
         B        *R8               DONE                                        
         TITLE    ':#CNIFS'                                                     
*************************                                                       
*         :#CNIFS       *                                                       
*************************                                                       
*  CHANGE ADDRESS IN INTERNAL FORMAT TO SYMBOL + HEX                            
*    STORE CHARACTERS INTO SPECIFIED BUFFER                                     
*        CALL IS  BAL,R8   :#CNIFS                                              
*                 R7 CONTAINS THE BUFFER WHERE THE CHARACTERS ARE STORED        
*                 R9 CONTAINS THE VALUE TO BE VONVERTED                         
*                 ON RETURN *R7 CONTAINS A STRING SSSSSSSS+.NNNNN               
*                 WHERE THE S REPRESENT THE CLOSEST SYMBOL                      
*                 BELOW THE ADDRESS AND N REPRESENTS THE                        
*                 DISPLACEMENT FROM THE SYMBOL                                  
*                 THE R7 BUFFER MUST BE 4 WORDS LONG                            
*   REGISTERS USED  R4,R5,R6,R7,R8,R9                                           
*                                                                               
*                                                                               
:#CNIFS  RES      0                                                             
         AND,R9   M17               MASK OFF ADDRESS PART                       
         LI,R6    0                 RESET ADDRESS VALUE                         
         STW,R6   :#CSMVL,R2                                                    
         LW,R6    PCBPOINT          GET START OF TASK                           
         AND,R6   :#M17                                                         
         LW,R4    :#PCBVPT,R2                                                   
         STW,R6   *R4               STORE IN SYMBOL TABLE                       
         LW,R6    :#FRSYM,R2        FIND CLOSEST SYMBOL                         
         BE       SERDON            SYMBOL TABLE END                            
CKSYM    CW,R9    3,R6                                                          
         BGE      SAVESYM                                                       
GETNX    LW,R6    2,R6              GET NEXT SYMBOL                             
         BE       SERDON                                                        
         B        CKSYM                                                         
SAVESYM  LW,R5    3,R6                                                          
         CW,R5    :#CSMVL,R2                                                    
         BL       GETNX                                                         
         STW,R6   :#CSMAD,R2                                                    
         STW,R5   :#CSMVL,R2                                                    
         B        GETNX                                                         
         PAGE                                                                   
SERDON   RES      0                 BUILD OUTPUT BUFFER                         
         LW,R6    :#CSMAD,R2        GET ADDRESS FO SYMBOL                       
         LCI      2                                                             
         LM,R4    4,R6              GET SYMBOL CHARACTERS                       
         STM,R4   0,R7              SET INTO BUFFER                             
         SW,R9    :#CSMVL,R2        GET VALUE TO OUTPUT                         
         STW,R8   :#CSMAD,R2        SAVE RETURN                                 
         STW,R7   :#CSMVL,R2        SAVE BUFFER                                 
         :#CNIFX  :#CONVL           CONVERT DISPLACMENT                         
         LW,R7    :#CSMVL,R2                                                    
         LW,R4    :#CONVL,R2        GET HIGH ORDER CHARACTER                    
         AND,R4   M8                MASK OFF ONE DIGIT                          
         AW,R4    SERD1             ADD IN BLANK,PLUS,PERIOD                    
         STW,R4   2,R7                                                          
         LW,R4    :#CONVL+1,R2      GET LOW 4 CHAR                              
         STW,R4   3,R7                                                          
         LW,R8    :#CSMAD,R2        RETURN                                      
         B        *R8                                                           
SERD1    DATA,1   ' ','+','.',0     BLANK,PLUS,PERIOD,ZERO                      
         PAGE                                                                   
* CALLED BY THE :#STORE PROC                                                    
* REGISTERS USED                                                                
* R5,R6,R7,R8                                                                   
:#STORE  RES      0                                                             
         AI,R5    -1                                                            
         STW,R7   *R6,R5                                                        
         CI,R5    0                                                             
         BG       :#STORE           CONTINUE TO STORE                           
         B        *R8                                                           
         PAGE                                                                   
*  CALLED BY THE :#MOVE PROC                                                    
*  REGISTERS USED                                                               
*  R4,R5,R6,R7,R8                                                               
:#MOVE   RES      0                                                             
         AI,R4    -1                                                            
         LW,R7    *R5,R4                                                        
         STW,R7   *R6,R4                                                        
         CI,R4    0                                                             
         BG       :#MOVE                                                        
         B        *R8                                                           
         PAGE                                                                   
*************************                                                       
*        CONSTANTS       *                                                      
*************************                                                       
:#M4     EQU      M4                                                            
:#M8     EQU      M8                                                            
:#M17    EQU      M17                                                           
:#M24    EQU      M24                                                           
:#KA     EQU      XA                                                            
:#Y01    EQU      Y01                                                           
:#ALBLK  EQU      BLANKS                                                        
A:DBC3   RES      0                                                             
         OLAYEND                                                                
         FIN      #DEBUG                                                        
         END                                                                    
