         PSYS     0                                                             
OLAYFLAG EQU      'DBC2'                                                        
         SYSTEM   OPTIONS                                                       
         DO       #DEBUG                                                        
         SYSTEM   CPRMON                                                        
         SYSTEM OLAYBASE                                                        
         DEF      A:DBC2            DEBUG COMMANDS PART2                        
         DEF      :#CONSG                                                       
         DEF      :#TINIT                                                       
         DEF      :#TRAPIN                                                      
         DEF      :#ASSGN                                                       
         DEF      :#REMOV                                                       
         DEF      DBERR2            OUTAGE TO OVERLAY-DBS2                      
         DEF      USRIN2            OUTAGE TO OVERLAY-DBS2                      
         DEF      TRAPRTN           OUTAGE FROM TRAP -DBS2                      
*        REF      :#TRAPEX          OVERLAY-S2                                  
*        REF      :#SCAN            OVERLAY-S1                                  
*        REF      :#SCNLCX          OVERLAY-S3                                  
CUR      EQU      0                                                             
MAXTYPE  EQU      X'40'                                                         
         ORG      0                                                             
:#DBERR2 LW,R8    :#DBERR,R2                                                    
DBERR2   B        *R8                                                           
:#USRIN2 LW,R8    :#USRIN,R2                                                    
USRIN2   B        *R8                                                           
ERRETN   DATA     :#DBERR2          POINTER FOR CAL ERRORS                      
         TITLE    '***  :#CONSG ***'                                            
*************************                                                       
*         :#CONSG        *                                                      
*************************                                                       
*  COMMAND SYNTAX                                                               
*  C (A,D,E)  NAME                                                              
*  A CAL1,7 IS GENERATED   TO DO THE                                            
*        REQUIRED SEGMENT OPERATION                                             
:#CONSG  RES      0                                                             
         AI,R8    X'51'             52 FOR A ,53 FOR D ,54 FOR E                
         STW,R8   :#CNSMD,R2                                                    
         BAL,R8   :#SCNLCX          GET SEGMENT NAME   (NUMBER)                 
         B        :#DBERR2                                                      
         GETEMF                                                                 
         BE       ILNER1                                                        
         CLM,R8   SEGLIM                                                        
         BCS,9    ILNER3                                                        
         LW,R6    :#CNSMD,R2                                                    
         STB,R6   R8                SET TYPE FOR CAL                            
         OR,R8    :#Y008                                                        
         STW,R8   :#SGFPT,R2        SET FOR CAL                                 
         CAL1,7   :#SGFPT,R2                                                    
         LI,R7    :#QSGFPT+2                                                    
         LB,R7    *R2,R7            GET STATUS                                  
         CI,R7    1                                                             
         BNE      ILCER1            ERROR RETURN                                
         B        :#USRIN2                                                      
ILNER1   :#DBERR2  X'A1'            ILLEGAL FIELD-NO SEGMENT NUMBER             
ILNER3   :#DBERR2  X'A2'            ILLEGAL SEGMENT NUMBER                      
ILCER1   :#DBERR2  X'A3'            ILLEGAL COMPLETION STATUS                   
         BOUND    8                                                             
SEGLIM   DATA     1                                                             
         DATA     32767                                                         
         TITLE    '***  TINIT  ***'                                             
*************************                                                       
*        :#TINIT         *                                                      
*************************                                                       
* THIS ROUTINE MAKES A CAL TO SET THE TRAP ENTRY TO DEBUG AT TRAPIN             
* IT SETS :#SNPSV TO THE ENTRY ADDRESS                                          
* IT MAKES ASSIGNMENT OF DEBUG OPLABELS                                         
* AND IT MAKES ITITIAL COMMAND REQUEST FROM USER                                
:#TINIT  RES      0                                                             
         LW,R6    :#STDLB+2,R2      SAVE STANDARD ERROR EXIT                    
         LW,R3    INITEADR                                                      
         STW,R3   :#STDLB+2,R2      SET INITIAL ERROR EXIT                      
         LI,R3    :#NUMOPL                                                      
INIT1    LI,R0    :#DBOPLB-1        PICK UP OPLABEL                             
         AW,R0    R2                                                            
         LW,R15   *R0,R3                                                        
         STW,R15  :#STDLB,R2                                                    
         AND,R15  :#M17                                                         
         STW,R15  :#DEVFPT+2,R2                                                 
         LW,R15   :#DVTYPE,R2       TEST IF OPLABLE DEFAULT                     
         BEZ      %+2               YES - SKIP ASSIGNMENT                       
         CAL1,7   :#STDLB,R2        ASSIGN OPLB TO DEBUG DEVICE                 
         LI,R0    :#DEVDCB-1        GET FPT ADDRESS                             
         AW,R0    R2                                                            
         LW,R15   *R0,R3                                                        
         BLZ      %+3               SKIP IF NEGATIVE                            
         AW,R15   R2                ADJUST TO DATA AREA                         
         STW,R15  :#DEVFPT,R2       SET AS FPT                                  
         CAL1,1   :#DEVFPT,R2       LINK OPLABEL TO DCB                         
         BDR,R3   INIT1                                                         
         STW,R6   :#STDLB+2,R2                                                  
INIT2    RES      0                                                             
         LW,R0    :#TSNAM,R2                                                    
         BEZ      INIT3             OUT IF UNDER TEST                           
         LW,R14   TRPFPT            SET FPT IN REGISTERS                        
         LW,R15   TRPFPT+1                                                      
         AW,R14   R2                ADJUST DATA PAGE ADDRESS                    
         CAL1,8   R14               SET DEBUG ENTRY FOR TRAPS                   
         AND,R14  :#M17                                                         
         OR,R14   INITMSK           SET FPT FOR SPECIAL CAL                     
         CAL1,8   R14                                                           
         SETBUF   :#INMSG,:#INMSZ   OUTPUT INITIALIZATION MESS                  
         LW,R8    ERRETN                                                        
         STW,R8   :#CALERR,R2                                                   
         CAL1,1   :#WRFPT,R2                                                    
INIT3    RES      0                                                             
         B        :#USRIN2          FOREGO THE FOLLOWING                        
         LI,R0    :#DBTEST          PROVIDE LINKAGE FOR TESTING                 
         AW,R0    R2                                                            
         STW,R0   :#REG0+2,R2                                                   
         B        :#USRIN2          MAKE INITIAL REQUEST FOR COMMANDS           
*                                                                               
*                                                                               
*                                                                               
INITEADR DATA     INITERR                                                       
INITERR  LI,R15   :#OPLMSG                                                      
         AW,R15   R2                                                            
         STW,R6   :#CUSYM,R2        NOTE CURRENT(LAST) SYSTEM SYMBOL            
         STW,R15  :#ERRMSG+2,R2                                                 
         LW,R0    :#TSNAM,R2                                                    
         STW,R0   :#LBERRT,R2                                                   
         LW,R0    :#TSNAM+1,R2                                                  
         STW,R0   :#LBERRT+1,R2                                                 
         CAL1,2   :#ERRMSG,R2       TYPE DEVICE ASSIGN ABORT                    
         CAL1,9   8                 TERMINATE TASK                              
*                                                                               
*                                                                               
INITMSK  DATA     X'0E000000'                                                   
         TITLE    '***  TRAPIN  ***'                                            
*************************                                                       
*        TRAPIN          *                                                      
*************************                                                       
:#TRAPIN RES      0                 PRINT OUT TRAP-SAVE LOC AND GO TO           
*                                   USERIN                                      
         SLS,R9   -28               GET ONLY CC                                 
         :#CNIFX  :#CONVL                                                       
         LW,R9    :#CONVL+1,R2                                                  
         LI,R7    1                                                             
         LI,R0    :#TRPNM+1                                                     
         AW,R0    R2                                                            
         STB,R9   *R0,R7                                                        
         LW,R1    :#TBFLAG,R2       GET TRAP TYPE  VALUE                        
         LB,R9    R1                                                            
         LCI      3                                                             
         LM,R12   :#TRPBF,R2                                                    
         STM,R12  :#INBF,R2                                                     
         CW,R9    BREAKNR           TEST FOR BREAKIN                            
         BNE      TPIN1             SKIP IF NOT                                 
         LCI      3                                                             
         LM,R12   BREAKWD                                                       
         STM,R12  :#TRPBF,R2                                                    
         LW,R12   :#PRTBF,R2                                                    
         LW,R13   PRMPMSK                                                       
         STS,R12  :#TRPBF,R2                                                    
         B        TPIN2             SKIP FORWARD                                
TPIN1    RES      0                                                             
         :#CNIFX  :#CONVL           CONVERT TO HEX                              
         LW,R9    :#CONVL+1,R2                                                  
         LI,R7    1                                                             
         LI,R0    :#TRPNM                                                       
         AW,R0    R2                                                            
         STH,R9   *R0,R7                                                        
TPIN2    RES      0                                                             
         CW,R1    :#INTODB,R2       TEST INTERNAL/EXTERNAL TRAP                 
         BNE      NOTRST            OUT, INTERNAL TO DEBUG                      
         LW,R1    *PCBPOINT         CONTINUE, EXTERNAL TO DEBUG                 
         LW,R9    -18,R1            TOP OF PSD                                  
         LB,R14   R9                SAVE CONDITION CODES                        
         AND,R9   :#M17                                                         
*                                   OTHERWISE, TRAP FROM USER PROGRAM           
STRTP    SLD,R14  -4                                                            
         STW,R14  :#CCSV,R2                                                     
         SLS,R3   -28                                                           
         STW,R3   :#FLSV,R2                                                     
         STW,R9   :#SNPSV,R2                                                    
         STW,R9   :#OLSNP,R2                                                    
         LCI      8                 SAVE REGISTERS-                             
         LM,R8    -8,R1                                                         
         STM,R8   :#REG0+8,R2                                                   
         LCFI     8                                                             
         LM,R8    -16,R1                                                        
         STM,R8   :#REG0,R2                                                     
NOTRST   LW,R9    :#TBFLAG,R2       GET TRAPING ADDRESS                         
         AND,R9   :#M17                                                         
         :#CNIFS  :#TRPAD           AND CONVERT TO CHARACTERS                   
         SETBUF   :#TRPBF,:#TRPBS                                               
         LW,R8    ERRETN                                                        
         STW,R8   :#CALERR,R2                                                   
         CAL1,1   :#WRFPT,R2        GIVE USER A MESSAGE                         
         LCI      3                                                             
         LM,R12   :#INBF,R2                                                     
         STM,R12  :#TRPBF,R2                                                    
         LI,R7    X'1FFFF'          TRAP RETURN TO TRPRT                        
         LW,R6    :#USRIN,R2                                                    
         BDR,R6   %+1                                                           
         LW,R8    :#TBFLAG,R2                                                   
         LW,R9    :#INTODB,R2                                                   
         LW,R1    *PCBPOINT         GET STACK POINTER                           
         STS,R6   -18,R1            CHANGE RETURN ADDRESS                       
         STW,R2   -14,R1            RESTORE WITH DATA LINK                      
TRAPRTN  B        :#TRAPEX          GO EXIT TRAP                                
*                                                                               
TRPFPT   GEN,8,24 X'14',:#TRAP                                                  
         GEN,8,8,8,8      0,X'7F',X'80',3 RECEIVE ALL TRAPS                     
*                                                                               
BREAKNR  DATA     X'51'             BREAK NUMBER                                
BREAKWD  TEXT     ':BREAKIN    '                                                
PRMPMSK  DATA     X'FF000000'                                                   
         TITLE    ':#ASSIGN'                                                    
*************************                                                       
*         :#ASSGN       *                                                       
*************************                                                       
*  COMMAND FORMAT                                                               
*  A  OPLABEL,DEVICE OR FILE OR OP LABEL                                        
*  A  DO,LPA02  OR   D1,FILE   OR  PO                                           
:#ASSGN  RES      0                                                             
         :#SCAN   :#GETEB           GET FIRST SET OF CHAR                       
         GETERR                                                                 
         BNE      ILOER             NOT AN OP LABEL-ERROR                       
         GETDLM                                                                 
         CI,R6    ','                                                           
         BNE      ILDER                                                         
         LH,R5    R8                PUT OP LABEL IN FPT                         
         LI,R4    1                 SET FOR SECOND HALFWORD                     
         LI,R0    :#STDLB                                                       
         AW,R0    R2                                                            
         STH,R5   *R0,R4                                                        
         :#SCAN   :#GETEB           GET NEXT ARGUMENT                           
         LI,R4    2                                                             
         LB,R5    R8,R4             GET THIRD CHAR                              
         CI,R5    X'40'                                                         
         BE       NOTDV                                                         
         LI,R15   :#DORFNM          SET ADDRESS TO DEVICE                       
         LI,R14   X'A0'             SET P BITS (DEVICE)                         
ASSG1    AW,R15   R2                ADJUST TO DATA PAGE                         
SETS     RES      0                                                             
         LI,R5    :#STDLB+1                                                     
         AW,R5    R2                                                            
         STB,R14  *R5                                                           
         STW,R15  :#STDPRM,R2       SET FPT PARAMETER                           
         STW,R8   :#DORFNM,R2       SAVE DEVICE OR FILE ID.                     
         STW,R9   :#DORFNM+1,R2                                                 
         LW,R0    ERRETN                                                        
         STW,R0   :#CALERR,R2                                                   
         CAL1,7   :#STDLB,R2                                                    
         B        :#USRIN2                                                      
NOTDV    GETDLM                     MUST BE FILE OR OP-LABEL-CK DELIM           
         CI,R6    ','                                                           
         BE       ISFILE            MUST BE FILE                                
         LI,R3    X'F0'             CHECK FOR  0                                
         CB,R3    R8                                                            
         BNE      %+2                                                           
         LI,R8    0                 SET OPLABEL TO NUMERIC ZERO                 
         LW,R15   R8                                                            
         SLS,R15  -16                                                           
         LI,R14   X'C0'             SET P BITS (OPLABEL)                        
         B        SETS                                                          
ISFILE   SCS,R8   16                LEFT JUSTIFY AREA NAME                      
         STW,R8   :#AREANM,R2       SAVE AREA                                   
         :#SCAN   :#GETEB           GET FILE NAME                               
         GETERR                                                                 
         BNE      ILFER                                                         
         LI,R15   :#AREANM          SET ADDRESS FOR FPT                         
         LI,R14   X'90'             SET P BITS (FILE)                           
         B        ASSG1                                                         
         PAGE                                                                   
ILOER    :#DBERR2 X'131'            FIRST PARAMETER MUST BE OP-LABEL            
ILDER    :#DBERR2 X'132'            ILLEGAL DELIMITER                           
ILFER    :#DBERR2 X'133'            ILLEGAL FILE NAME                           
         TITLE    '***  :#REMOV  ***'                                           
*************************                                                       
*         :#REMOV        *                                                      
*************************                                                       
*  R      LOC,LOC....                                                           
*  RS                                                                           
*  RI                                                                           
*  R :#REMOVS  ALL SNAPSHOTS FROM THE SPECIFIED LOCATIONS                       
*  RS :#REMOVS  ALL SNAPSHOTS                                                   
*  RI :#REMOVS  ALL INSERTS                                                     
*  IF NO LOCATIONS ARE PRESENT ALL PATCHES OF                                   
*    THE DESIGNATED TYPE WILL BE :#REMOVD                                       
*                                                                               
         PAGE                                                                   
:#REMOV  RES      0                                                             
         LI,R1    0                 COUNT OF LOCATIONS TO :#REMOV               
         STW,R8   R15               SAVE TYPE OF :#REMOV                        
GETLOC   BAL,R8   :#SCNLCX                                                      
         B        :#DBERR2                                                      
         GETEMF                                                                 
         BE       NOLCK                                                         
         LI,R10   :#MDBF            SAVE LOCATION                               
         AW,R10   R2                                                            
         STW,R8   *R10,R1                                                       
         AI,R1    1                                                             
         CI,R7    '/'                                                           
         BNE      NOLCK             STATEMENT SCANNED                           
         B        GETLOC                                                        
NOLCK    CI,R1    0                 SEE IF LOCATIONS TO PROCESS                 
         BE       NOLOC                                                         
         CI,R15   1                 SEE IF  R  COMMAND                          
         BNE      ILRER2                                                        
         LI,R4    0                 AT LEAST ONE LOCATION-DO :#REMOV            
LOCLP    LI,R7     :#MDBF           R4 HAS ENTRY INTO PATCH ELEMENT :#ADRS      
         AW,R7     R2                                                           
         LW,R7    *R7,R4                                                        
         BAL,R10  REPCON            REPLACE CONTENTS                            
         B        ILRER1            CANT DO IT                                  
         AI,R4    1                                                             
         CW,R4    R1                                                            
         BL       LOCLP                                                         
         B        :#USRIN2          DONE-ALL LOCS PROCESSED                     
         PAGE                                                                   
NOLOC    CI,R15   3                 SEE IF RI OR RS                             
         BG       RMVN              REMOVE NAME                                 
         BE       RMVI              REMOVE INSERTS                              
         CI,R15   2                                                             
         BE       RMVS              REMOVE SNAPS                                
         :#DBERR2 X'83'             R MUST HAVE LOCS SPECIFIED                  
RMVN     LB,R0    0                 REMOVE ALL USER NAMES                       
         LW,R7    :#FRSYM,R2        GET FIRST NAME ENTRY                        
         LW,R6    R7                WHICH IS A SYSTEM NAME                      
RMVN1    LW,R5    2,R7              SAVE NEXT ENTRY ADDRESS                     
         LB,R8    *R7               TEST TYPE - SYSTEM OR USER                  
         CI,R8    X'10'                                                         
         BE       RMVN2             OUT IF USER                                 
         STW,R7   2,R6              OTHERWISE, LINK CURRENT                     
         LW,R6    R7                SYSTEM TO PREVIOUS SYSTEM                   
         B        RMVN3                                                         
RMVN2    LI,R4    3                 REMOVE USER NAME                            
         LB,R4    *R7,R4                                                        
         STW,R0   *R7                                                           
         AI,R7    1                                                             
         BDR,R4   %-2                                                           
RMVN3    LW,R7    R5                TEST IF A NEXT ENTRY                        
         BNEZ     RMVN1             YES - GO TO TOP OF LOOP                     
         STW,R0   2,R6              FINALIZE LAST SYSTEM NAME                   
         STW,R6   :#CUSYM,R2                                                    
         B        :#USRIN2          AND EXIT                                    
RMVS     LI,R7    X'30'                                                         
         BAL,R8   RMVTP             :#REMOV  ALL 70-3F                          
         B        :#USRIN2                                                      
RMVI     LI,R7    X'20'             :#REMOV  ALL 20-2F                          
         B        RMVS+1                                                        
RMVTP    RES      0                 :#REMOV  ALL ELEMENTS OF A GIVEN TYPE       
         STW,R7   :#ELTYP,R2                                                    
         STW,R8   :#RMRET,R2        SAVE RETURN                                 
         LW,R4    :#WTAB,R2         GET TOP OF CURRENT TABLE                    
         LW,R13   *R4               GET CURRENT END                             
         AI,R4    4                 POINT TO FIRST EXPECTED ELEMENT             
         LW,R12   R4                DEFAULT :#CURLC-TOP OF TABLE                
DONXT    CW,R13   R4                SEE IF DONE                                 
         BLE      RMVDN                                                         
         LI,R1    3                                                             
         LB,R11   *R4,R1            GET SIZE                                    
         LB,R10   *R4               SEE IF ELEMENT                              
         BE       ELSER             NOT ELEMENT-LOOK   FOR ONE                  
         AND,R10  :#KF0             GET TOP BITS                                
         AW,R11   R4                GET TO TOP OF NEXT ELEMENT                  
         XW,R11   R4                KEEP   TOP OF ELEMENT IN R11                
         CW,R10   :#ELTYP,R2        IS ELEMENT CORRECT TYPE                     
         BNE      NODLT             DO NOT DELETE                               
         LW,R7    R11               GET TOP OF ELEMENT                          
         LW,R7    1,R7              GET LOC PATCHED                             
         BAL,R10  REPCON            REMPVE ELEMENT                              
         B        DELEL             ERROR-DONT REPLACE CONTENTS -BUT DELETE LOC 
         B        DONXT                                                         
RMVDN    LW,R8    :#WTAB,R2         DONE-RECOVER   SPACE-SET :#CURLC TO         
         STW,R12  *R8                                                           
*                                   THE END OF THE HIGHEST ELEMENT LEFT         
         LW,R8    :#RMRET,R2        RETURN                                      
         B        *R8                                                           
ELSER    RES      0                                                             
         LB,R10   *R4                                                           
         BNE      DONXT             CHECK TYPE                                  
         AI,R4    1                 GET NEXT WORD                               
         B        ELSER             CONTINUE SEARCH                             
NODLT    LW,R12   R4                SAVE CURRENT LOC-MAY BE CURRENT END         
         B        DONXT             SEE IF DONE                                 
DELEL    :#RLSPC  *R11               DELETE ELEMENT IN TABLE                    
         B        DONXT                                                         
         PAGE                                                                   
REPCON   RES      0                 REPLACE CONTENTS AND REPLACE ELEMENT        
         BAL,R6   :#CKSI            CHECK FOR INSERT   OR SNAP                  
         B        *R10                                                          
         CI,R14   X'20'                                                         
         BE       INSBFT                                                        
         CI,R14   X'21'                                                         
         BE       INSAFT                                                        
         CI,R14   X'22'                                                         
         BE       INSRP                                                         
         LW,R6    2,R5              GET     OLD CONTENTS                        
DORMV    STW,R6   *R7               PUT INTO LOC                                
         :#RLSPC  *R5                                                           
         AI,R10   1                                                             
         B        *R10                                                          
INSBFT   LI,R6    -2                                                            
         LI,R3    3                 GET OLD CONTENTS                            
         LB,R3    *R5,R3            GET SIZE                                    
         AW,R3    R5                                                            
         AW,R3    R6                DISPLACE BY -2                              
         LW,R6    *R3                                                           
         B        DORMV             FINISH :#REMOV                              
INSAFT   LW,R6    2,R5                                                          
         B        DORMV                                                         
INSRP    LI,R6    -1                                                            
         B        INSBFT+1          GET OLD CONTENTS                            
         PAGE                                                                   
*:#REGISTERS   USED                                                             
*  R4,R6,R7,R14,R15                                                             
:#CKSI   RES      0                                                             
         LW,R14   *R7               GET B INSTRUCTION                           
         LW,R15   :#YFFFE           SEE IF B INST                               
         CS,R14   :#BR                                                          
         BNE      *R6                                                           
         LW,R5    R14               GET ELEMENT POINTER                         
         AI,R5    -2                SEE IF INSERT-GET   TOP OF ELEMENT          
         LB,R14   *R5               GET BYTE 0                                  
         LI,R15   X'F0'             CHECK ONLY TOP 4 BITS OF BYTE               
         CS,R14   :#K20                                                         
         BE       CKSRT             INSERT   FOUND                              
         AI,R5    -1                CHECK FOR SNAP                              
         LB,R14   *R5                                                           
         CS,R14   :#K30                                                         
         BNE      *R6               NOT SNAP                                    
CKSRT    AI,R6    1                 FOUND RETURN                                
         B        *R6                                                           
         PAGE                                                                   
ILRER1   :#DBERR2  X'81'            :#REMOV  LOC NOT AN :#INSRT OR SNAP         
ILRER2   :#DBERR2  X'82'            RS AND RI CANNOT HAVE LOCS                  
         PAGE                                                                   
*************************                                                       
*        :#RLSPC         *                                                      
*************************                                                       
*        CALL IS  BAL,R8  :#RLSPC                                               
*                 R7 CONTAINS THE FWA OF THE SPACE TO BE RELEASED               
*                                                                               
*                 ON RETURN  R7 CONTAINS THE SIZE OF THE SPACE RELEASED         
*                 THE ELEMENT POINTED TO BY R7 WILL BE ZEROED-IF                
*                    THE END OF THE ELEMENT IS THE END OF THE TABLE             
*                    THE TABLE   END POINTER   WILL BE :#MOVED                  
*REGISTERS     USED                                                             
* R5,R6,R7,R8,R9                                                                
         PAGE                                                                   
:#RLSPC  RES      0                 REMOVE   ONE ELEMENT                        
         STW,R8   :#SPCRT,R2                                                    
         AND,R7   :#M17                                                         
         LB,R9    *R7               CHECK TYPE                                  
         CI,R9    MAXTYPE                                                       
         BGE      TYPER1                                                        
         LI,R6    3                                                             
         LB,R9    *R7,R6            GET SIZE                                    
         LW,R5    R9                SAVE SIZE                                   
         CI,R9    32                                                            
         BGE      TYPER2                                                        
         AW,R9    R7                RELEASE SIZE WORDS-GET LAST WORD            
*                                      ADDRESS-                                 
         :#STORE  *R5,*R7,0         CLEAR ELEMENT                               
         LW,R7    :#WTAB,R2                                                     
         CW,R9    CUR,R7            SEE IF SPACE CAN BE RECOVERED               
         BE       RECOV                                                         
         B        RECOV+1           NO RECOVERY   -RETURN                       
TYPER1   :#DBERR2 X'FF1'            TYPE TOO LARGE                              
TYPER2   :#DBERR2 X'FF2'            SIZE TOO LARGE                              
         PAGE                                                                   
* THINK ABOUT   WAY TO RECOVER   MORE THAN                                      
*    LAST ELEMENT WITHOUT TOTAL SPACE                                           
*    RESTRUCTURING                                                              
RECOV    RES      0                 RECOVER   SPACE                             
         STW,R6   CUR,R7            START IN R6                                 
         LW,R8    :#SPCRT,R2                                                    
         B        *R8                                                           
         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                                                           
         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                                           
*                                                                               
*                                                                               
         PAGE                                                                   
:#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                      
         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           
         PAGE                                                                   
*************************                                                       
*        CONSTANTS       *                                                      
*************************                                                       
:#M17    EQU      M17                                                           
:#KA     EQU      XA                                                            
:#K20    EQU      X20                                                           
:#K30    EQU      X30                                                           
:#KF0    EQU      XF0                                                           
:#Y008   EQU      Y008                                                          
:#YFFFE  EQU      YFFFE                                                         
:#BR     B        0                                                             
A:DBC2   RES      0                                                             
         OLAYEND                                                                
         FIN      #DEBUG                                                        
         END                                                                    
