         TITLE    '                  M  A  P  '                                 
         SPACE    2                                                             
*                                                                               
*                                                                               
***********************************************************************         
*                                                                     *         
#SYSTEM  SET      'CP-R'            SYSTEM ASSEMBLING FOR (CP-R = RBM) *        
*                                                                     *         
***********************************************************************         
         SPACE    2                                                             
         SYSTEM   SIG7                                                          
*                                                                               
*                                                                               
        DO       (#SYSTEM='CP-V')                                               
         SYSTEM   BPM               DEFINE CP-V (BPM) STYLE SYSTEM CAL PROCS    
        ELSE     (#SYSTEM='CP-R')                                               
         SYSTEM   CPR               DEFINE CPR STYLE SYSTEM CAL PROCS           
        FIN                                                                     
         SPACE    2                                                             
#COLS    EQU      6                 DEFAULT NUM OF COLS PER CHART               
#PRNTPOS EQU      112               PRINT POSITIONS AVAILABLE                   
#ITEMS   EQU      1024              MAX TABLE SIZE; MAX ITEMS PROCESSABLE       
PAGENO   EQU      98                START COLUMN FOR PAGE NUMBERING             
         TITLE    '      A  N  A  L  Y  Z  E    M  A  P '                       
         SPACE    2                                                             
         DEF      MAP               NAME OF MODULE; START OF MODULE             
         DEF      ANALMAP           ENTRY POINT FOR MAP PRINT                   
         REF      U:PCB             TEMP STACK FOR PUSH/PULL                    
         REF      F:X3              INPUT MAP DCB                               
         REF      PAGE              PAGE NUMBER COUNT IN ROOT                   
         REF      MAPPAGE           START PAGE NUMBER OF THE MAP OUTPUT         
         REF      M:LO                                                          
         REF      #LINES            CELL IN ROOT WITH LINES PER PAGE            
         REF      ANALYZE           START OF ROOT                               
*                                                                               
*                                                                               
*                           REGISTER DEFINITIONS                                
*                                                                               
R0       EQU       0                                                            
R1       EQU       1                                                            
R2       EQU       2                                                            
R3       EQU       3                                                            
R4       EQU       4                                                            
R5       EQU       5                                                            
R6       EQU       6                                                            
R7       EQU       7                                                            
R8       EQU       8                                                            
R9       EQU       9                                                            
R10      EQU      10                                                            
R11      EQU      11                                                            
R12      EQU      12                                                            
R13      EQU      13                                                            
R14      EQU      14                                                            
R15      EQU      15                                                            
         PAGE                                                                   
         SPACE    3                                                             
PUSH     CNAME    1,(#SYSTEM='CP-V')  PUSH REGISTERS INTO STACK                 
PULL     CNAME    0,(#SYSTEM='CP-V')  PULL REGISTERS FROM STACK                 
         PROC                                                                   
         DO       NUM(AF)=1         SAVE ONLY ONE REGISTER                      
LF(1)    GEN,1,7,4,20    NAME(2),X'8'+NAME(1),AF(1),U:PCB                       
         ELSE     NUM(AF)>1         SAVE MULTIPLE REGISTERS                     
LF(1)    LCI      AF(1)&X'F'                                                    
         GEN,1,7,4,20     NAME(2),X'A'+NAME(1),AF(2),U:PCB                      
         FIN                                                                    
         PEND                                                                   
*                                                                               
*                                                                               
*                                                                               
TRM      CNAME                                                                  
         PROC                                                                   
         DO       NUM(AF)=1                                                     
LF(1)    BAL,14   AF(1)                                                         
         ELSE                                                                   
LF(1)    BAL,AF(2) AF(1)                                                        
         FIN                                                                    
         PEND                                                                   
         PAGE                                                                   
         SPACE    2                                                             
ANALYZ2  EQU      %         START OF MODULE                                     
         SPACE    2                                                             
*************************************************************************       
*                                                                               
*           THE PROCEDURE DEFINITIONS THAT FOLLOW AND THE CODE AT THE END       
*        OF THIS MODULE WERE MOVED HERE FROM A SYSTEM FILE SO THAT THIS         
*        MODULE COULD BE ASSEMBLED WITH RELEASED SYSTEMS (SIG7 & CPR).          
*          THE SYSTEM FILE MAY BE RECREATED, AND THE PROCEDURES AND CODE        
*        USED IN A MORE GENERAL WAY, FROM THE LINES BETWEEN                     
*                 *%BEGIN       AND        *%END       .                        
*          SOME FEATURES ARE DISABLED BY COMMENTING THEM OUT WITH               
*        '*%' IN COLUMNS 1 AND 2.  THEY MAY BE RECOVERED BY AN EDIT             
*        COMMAND OF THE FORM                                                    
*        SE <*%BEGIN> - <*%END>,1,2; RF; /*%/ D                                 
*                                                                               
*          THE PROCEDURES ARE THEN DEFINED BY A SYSTEM LINE                     
*                 SYSTEM      <SYSTEM>                                          
*        AND THE CODE BY A STATEMENT AFTER THE 'INDEX' TABLE BY                 
*                 %DEFS       CODE                                              
*                                                                               
*        THE CODE SHOULD BE MOVED INTO A PROC '%DEF' THAT EITHER                
*        GENERATES DEFS AND THE CODE IF 'CODE' IS THE AF, OR 'REFS' IF          
*        'EXTERNAL' IS THE AF.                                                  
*                                                                               
*                                                                               
*%BEGIN  PROC DEFS                                                              
         TITLE    '  % R O U T I N E   P R O C E D U R E S'                     
         SPACE    2                                                             
*#SYSTEM SET      'CP-R'            SET DEFAULT SYSTEM                          
         SPACE    2                                                             
         OPEN     ARG,ARGA                                                      
         SPACE    2                                                             
***********************************************************************         
*                                                                               
*                                                                               
*                 LOAD PARAMETER REGISTER FOR A % ROUTINE.                      
*        CALL:                                                                  
*              LF ARG,REG  AF(I)                                                
*                 WHERE LF IS THE LABEL FIELD FROM THE %ROUTINE CALL,           
*                       REG IS THE REGISTER TO BE LOADED IF THERE IS            
*                       AN ARGUMENT PRESENT, AND                                
*                       AF(I) IS THE I-TH ARGUMENT TO THE %ROUTINE.             
*                 IF AF(I) IS NULL,  LF  IS DEFINED BY A RES 0                  
*                                                                               
ARG      CNAME                                                                  
         PROC                                                                   
         DO       NUM(AF)>0         AN ARGUMENT GIVEN ?                         
          DO       TCOR(AF,S:INT,S:C)>0    IS IT A CONSTANT ?                   
           DO       SCOR(AF,R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,;   IS IT A           
                            R10,R11,R12,R13,R14,R15)>0        REGISTER ?        
LF          LW,CF(2)  AF            CONSTANT = REGISTER, LOAD VALUE             
           ELSE                     SCOR = 0                                    
LF          LI,CF(2)  AF            ELSE LOAD NUMERIC VALUE = CONSTANT          
           FIN                                                                  
          ELSE                      TCOR = 0; NOT A CONSTANT                    
LF         LW,CF(2)  AF                 NO, SYMBOL; LOAD FROM IT                
          FIN                                                                   
         ELSE                                                                   
          DO       NUM(LF)>0        IS THERE A LABEL ?                          
LF         RES      0               DEFINE IT                                   
           FIN                                                                  
         FIN                                                                    
         PEND                                                                   
***********************************************************************         
         SPACE    3                                                             
***********************************************************************         
*                                                                               
*                                                                               
*        LOAD ADDRESS PARAMETER FOR A % ROUTINE                                 
*        CALL:                                                                  
*              LF ARGA,REG   AF(I)                                              
*                 WHERE  LF  IS THE LABEL FIELD FROM THE %ROUTINE CALL,         
*                        REG IS THE REGISTER TO BE LOADED, IF THERE             
*                          IS AN ARGUMENT PRESENT, AND                          
*                        AF(I)  IS THE I-TH ARGUMENT TO THE %ROUTINE            
*                 IF AF(I) IS NULL, LF IS DEFINED BY A  RES  0                  
*                                                                               
ARGA     CNAME                                                                  
         PROC                                                                   
         DO       NUM(AF)>0         AND PARAMETERS ?                            
          DO       ((NUM(AF)=1)&(AFA(1)=0))                                     
LF         LI,CF(2)   AF                                                        
          ELSE                                                                  
LF         LW,CF(2)   AF                                                        
          FIN                                                                   
         ELSE                                                                   
          DO       NUM(LF)>0                                                    
LF         RES      0                                                           
          FIN                                                                   
         FIN                                                                    
         PEND                                                                   
***********************************************************************         
         SPACE    3                                                             
CLRPL    CNAME                                                                  
         PROC                                                                   
LF       BAL,14   %1                CLEAR THE PRINT LINE                        
         PEND                                                                   
         SPACE    3                                                             
SETCP    CNAME                                                                  
         PROC                                                                   
LF       ARG,15   AF                GET NEW CP VALUE                            
         BAL,14   %2                SET IT                                      
         PEND                                                                   
         SPACE    3                                                             
STEPCP   CNAME                                                                  
         PROC                                                                   
LF       ARG,15   AF                GET STEP VALUE                              
         BAL,14   %3                SET IT                                      
         PEND                                                                   
         SPACE    3                                                             
CHAR     CNAME                                                                  
         PROC                                                                   
LF       ARG,15   AF                GET CHARACTER IF GIVEN                      
         BAL,14   %4                STORE AWAY                                  
         PEND                                                                   
         SPACE    3                                                             
CHARS    CNAME    1                                                             
PRTCHR   CNAME    0                                                             
         PROC                                                                   
LF       ARG,1    AF(1)             GET STRING LENGTH                           
         ARGA,2   AF(2)             AND START ADDRESS                           
         DO       NUM(AF(3))>0      OFFSET GIVEN ?                              
          DO       TCOR(AF(3),S:INT)     IF PARAM AN INTEGER                    
           LI,0     AF(3)&X'FFFFF'         INSURE POSITIVE                      
          ELSE                                                                  
           ARG,0    AF(3)                  ELSE GET SAME                        
          FIN                                                                   
         ELSE                                                                   
          DO1      NUM(AF)>0        SET DEFAULT ONLY IF PARAMS GIVEN            
          LI,0     0                ELSE START AT 1ST CHARACTER                 
         FIN                                                                    
         DO       NAME                                                          
          BAL,14   %5                STORE CHARACTERS                           
         ELSE                                                                   
          BAL,14   %15              PRINT CHARACTER STRING                      
         FIN                                                                    
         PEND                                                                   
         SPACE    3                                                             
STRNG    CNAME    1                                                             
PRTTXT   CNAME    0                                                             
         PROC                                                                   
LF       ARGA,2   AF                LOAD ADDRESS OF TEXTC STRING                
         DO       NAME                                                          
          BAL,14   %6                STORE STRING                               
         ELSE                                                                   
          BAL,14   %16              STORE AND PRINT STRING                      
         FIN                                                                    
         PEND                                                                   
         SPACE    3                                                             
TIME     CNAME                                                                  
         PROC                                                                   
LF       ARG,15   AF                GET TIME                                    
         BAL,14   %7                CONVERT AND STORE                           
         PEND                                                                   
         SPACE    3                                                             
INTGR    CNAME                                                                  
         PROC                                                                   
         DO       NUM(LF)>0                                                     
LF        RES      0                                                            
         FIN                                                                    
         OPEN     I                                                             
         DO       NUM(AF(1))>0                                                  
I         SET      SCOR(AF(1),DEC,HEX,BIN)                                      
           DO       I>0                                                         
            DO1      I=1                                                        
            LI,0     10             SET DECIMAL                                 
            DO1      I=2                                                        
            LI,0     16             SET HEX                                     
            DO1      I=3                                                        
            LI,0     2              SET BINARY                                  
           ELSE                                                                 
            ARG,0    AF(1)          SET BASE                                    
           FIN                                                                  
         FIN                                                                    
*                                                                               
         DO       NUM(AF(2))>0                                                  
I         SET      SCOR(AF(2),SPAC,ZERO)                                        
           DO       I>0                                                         
            DO1      I=1                                                        
            LI,1     C' '           SET LEADING SPACES                          
            DO1      I=2                                                        
            LI,1     C'0'           SET LEADING ZEROES                          
           ELSE                                                                 
            ARG,1    AF(2)          GET LEADING/FILL CHARACTER                  
           FIN                                                                  
         FIN                                                                    
*                                                                               
         DO       NUM(AF(3))>0                                                  
          ARG,2     AF(3)           SET NUMBER OF DIGIT PLACES                  
         FIN                                                                    
         DO       NUM(AF(4))>0      VALUE PARAM GIVEN?                          
          ARG,15   AF(4)              YES, GET VALUE TO CONVERT                 
         FIN                                                                    
         CLOSE    I                                                             
         BAL,14   %8                CONVERT AND ENTER                           
         PEND                                                                   
         SPACE    3                                                             
DATE     CNAME                                                                  
         PROC                                                                   
LF       BAL,14   %9                GET AND ENTER DATE                          
         PEND                                                                   
         SPACE    3                                                             
XDMP     CNAME                                                                  
         PROC                                                                   
LF       ARGA,0   AF(1)             SET START ADDRESS                           
         ARGA,1   AF(2)             SET END ADDRESS                             
         DO       NUM(AF(3))>0                                                  
          ARGA,2   AF(3)            SET RELATIVE ADDRESS                        
         ELSE                                                                   
          DO1      NUM(AF)>0        IF NO PARAMS, LEAVE AS SET BY USER          
          LW,2     0                ELSE SET RELATIVE TO START ADDRESS          
         FIN                                                                    
         BAL,14   %10               DUMP                                        
         PEND                                                                   
         SPACE    3                                                             
PRNT     CNAME    1                                                             
PRTUP    CNAME    0                                                             
         PROC                                                                   
         DO       NAME                                                          
LF        BAL,14   %11              SIMPLY PRINT THE LINE                       
         ELSE                                                                   
LF        ARG,15   AF               GET UPSPACE COUNT,                          
          BAL,14   %12              THEN PRINT WITH UPSPACE                     
         FIN                                                                    
         PEND                                                                   
         SPACE    3                                                             
EJECT    CNAME                                                                  
         PROC                                                                   
LF       BAL,14   %13               EJECT PRINTER TO 1ST LINE OF NEW PAGE       
         PEND                                                                   
         SPACE    3                                                             
PRTPAG   CNAME                                                                  
         PROC                                                                   
LF       BAL,14   %14               PAGE THE PRINTER, PRINT PL                  
         PEND                                                                   
         SPACE    3                                                             
*%REDIR    CNAME                                                                
*%         PROC                                                                 
*%         OPEN     I,J,L1,L2,L3                                                
*%J        SET      2                 INDEX TO MEDIA PARAM                      
*%         DO       NUM(AF(1))>0      A FIRST PARAMETERS ?                      
*%          DO       TCOR(AF(1),S:C)  NAME STRING GIVEN ?                       
*%LF         BAL,15   I               LOAD PARAMETER POINTER, SKIP PARAM        
*%           GEN,16,16   0,AF(1)        SET AREA NAME                           
*%           TEXT,8      AF(2)          AND FILE NAME                           
*%J          SET       3              SET INDEX OF NEXT PARAM                   
*%I          RES      0                                                         
*%          ELSE                                                                
*%LF         ARGA,15   AF(1)        GET ADDRESS OF PACKET OR SWITCH             
*%          FIN                                                                 
*%         FIN                                                                  
*%         DO       (J=2&TCOR(AF(1),S:INT))   IF NO STRING & AF(1)=CONST        
*%          DO       AF(1)<0                                                    
*%           DO       NUM(AF(J))>0      MEDIA PARAMETER GIVEN ?                 
*%            DO        1                                                       
*%            GOTO,SCOR(AF(J),SAVE,DEL,NOP) L1,L2,L3   DECODE PARAM IF ONE      
*%             ARG,0    AF(J)               GET AS A VALUE                      
*%            ELSE                                                              
*%L1           LI,0     +1            SET TO SUBMIT, SAVE FILE                  
*%            ELSE                                                              
*%L2           LI,0     -1            SET TO SUBMIT, DELETE FILE                
*%            ELSE                                                              
*%L3           LI,0     00            SET TO NOT SUBMIT                         
*%            FIN                                                               
*%*                                                                             
*%           ELSE                                                               
*%            LI,0     0                  SET DO NOT SUBMIT                     
*%           FIN                                                                
*%          FIN                                                                 
*%         FIN                                                                  
*%         BAL,14   %18               CALL REDIRECT                             
*%         CLOSE    I,J,L1,L2,L3                                                
*%         PEND                                                                 
         SPACE    3                                                             
*                                                                               
*                                                                               
*%END    PROC DEFS                                                              
         TITLE    '      A  N  A  L  Y  Z  E    M  A  P  '                      
         SPACE    2                                                             
MAP      EQU      %         START OF MAP PRINT PROCESSOR                        
ANALMAP  EQU      MAP            NAME OF MODULE FOR ROOT                        
         LI,R10   0                 SET NO ERROR CODE FOR RETURNS TO ROOT       
         PUSH     16,R14            SAVE ALL ENTRY RETISTERS                    
         LW,R0    PAGE              MOVE PAGE NUMBER OF FIRST PAGE              
         STW,R0   MAPPAGE           FOR TABLE OF CONTENTS OUTPUT                
         MTW,+1   MAPPAGE           STEP PAGE NUMBER FOR START                  
*                                                                               
*                                                                               
RESTART  EQU      %         RESTART POINT IF RESTART IS POSSIBLE                
         CLRPL                      CLEAR PRINT LINE TO INIT IT                 
*                                                                               
******** CAL1,1   OPENFPT           OPEN INPUT FILE; TEST IF THERE              
*                                                                               
         CAL1,1   REWFPT            REWIND MAP INPUT TO BEGIN OF FILE           
*                                                                               
*                                                                               
         LW,R0    #LINES            GET LINES PER PRINTER PAGE FROM ROOT        
         AI,R0    -2                COMPUTE LINES PER PAGE AVAILABLE            
         STW,R0   PAGESIZE          FOR DATA,                                   
         STW,R0   LINESPP           AND LINES AVAIL ON CURRENT PAGE             
         PAGE                                                                   
         SPACE    2                                                             
PART1    EQU      %         GET PATCH, BKG, FGD INFO                            
         LI,R7    0                 SET ENTRY TABLE EMPTY                       
         LI,R9    MAPNAMEA          SET LOC OF NAMES TO TEST                    
*                                                                               
PART1A   EQU      %         START BUILDING TABLE ENTRIED                        
         BAL,R14  READCARD          GET A NAME ON A NEW LINE                    
         B        PART1A            GET NEXT CARD IF BLANKS AT START            
*                                                                               
         CW,R10   MAPBREAK          END OF START INFO ?                         
         BE       PART1B              YES, GET NAME OF SYSTEM                   
*                                                                               
         SLD,R10  -8                MASSAGE NAME TO INSURE IT IS 7              
         LI,R0    C' '              CHARACTERS LONG AND THE 8TH                 
         STB,R0   R10               CHARACTER IS A BLANK                        
         SCD,R10  8                                                             
*                                                                               
         BAL,R14  FINDNAME          FIND ITEM IN LIST                           
         B        PART1A            NOT THERE, SKIP IT                          
         BAL,R14  GETADDR                                                       
         BAL,R14  CVTADDR           CONVERT TO HEX                              
         STW,R0   MAPINFO,R6        AND SAVE IT                                 
         B        PART1A            AND GET NEXT LINE                           
         PAGE                                                                   
         SPACE    2                                                             
PART1B   EQU      %         GET NAME OF SYSTEM FROM MAP BREAK LINE              
         CW,R11   SYSRBM            IS THE SYSTEM 'RBM' ?                       
         BNE      PART1END            NO, ASSUME 'CPR'; LEAVE NAMES             
*                                                                               
         LD,R10   RBMOLAY           CHANGE NAME OF LAST OVERLAY TO BE           
         STD,R10  ENDOLAYS          RBM'S - 'TERM', NOT CPR'S 'MMROOT'.         
*                                                                               
*                                                                               
PART1END EQU      %         END OF PART 1                                       
         PAGE                                                                   
         SPACE    2                                                             
PART2    EQU      %         END OF PROCESSING BKG, PATCH, FMBOX, INFO           
         LI,R7    0                 SET NO ENTRIES IN TABLE                     
         LI,R8    BA(CARDEND)       SET NEED A NEW LINE                         
*                                                                               
*                                                                               
*                                                                               
*                                                                               
PART2B   EQU      %         GET NEXT NAME TO PROCESS                            
         BAL,R14  GETNAME           GET A NAME                                  
         B        PART2C            BLANK, END OF A GROUP FOUND                 
*                                                                               
         BAL,R14  ENCODE            CONVERT FOR ORDERING                        
         AI,R7    1                 STEP INDEX                                  
         STD,R10  NAMES,R7          STORE NAME AWAY                             
         BAL,R14  GETADDR           GET THE ADDRESS PART                        
         BAL,R14  CVTADDR           AND CONVERT IT TO HEX                       
         STW,R0   MAPADDRS,R7       SAVE ADDRESS                                
         B        PART2B            AND THEN GET ANOTHER NAME                   
*                                                                               
*                                                                               
PART2C   EQU      %         END OF ''SYSTEM'' LOW CORE TABLES                   
         LW,R0    MAPADDRS,R7       GET ADDRESS OF OLAYFWA                      
         STW,R0   MAPINFO+1                                                     
         STW,R7   TABLSCNT          SET NUMBER OF TABLE ENTRIES                 
         PAGE                                                                   
         SPACE    2                                                             
PART2D   EQU      %         GET NEXT NAME                                       
         BAL,R14  GETNAME                                                       
         B        PART2D            BLANK, TRY AGAIN                            
*                                                                               
         CW,R10   MAPBREAK          END OF THE INPUT LINES ?                    
         BE       PART2E              YES, OUTPUT THIS TABLE                    
*                                                                               
         BAL,R14  ENCODE            CONVERT FOR ORDERING                        
         AI,R7    1                 STEP TO NEXT FREE ENTRY                     
         STD,R10  NAMES,R7                                                      
         BAL,R14  GETADDR                                                       
         BAL,R14  CVTADDR           AND CONVERT                                 
         STW,R0   MAPADDRS,R7       SAVE IT                                     
         B        PART2D            AND GET NEXT ENTRY                          
         PAGE                                                                   
*                                                                               
*                                                                               
PART2E   EQU      %         OUT MAPS OF ROLAY, PROLAY INFO                      
         STW,R7   MAPADDRS          SET LENGTH OF TABLE                         
         BAL,R14  ALPHATIZ          ALPHABETIZE                                 
         LI,R2    PROLAYA           ENTER TITLE INTO LINE                       
         TRM      PAGEHDR           VIA PAGE HEADER PRINTER                     
         BAL,R14  TABLEOUT          PRINT THE TABLE                             
         BAL,R14  NUMERTIZ          ORDER BY ADDRESS                            
         LI,R2    PROLAYN           ENTER NUMERICAL ORDER TITLE                 
         TRM      PAGEHDR           ON A NEW PAGE                               
         LW,R7    MAPADDRS          GET LENGTH OF TABLE AGAIN                   
         BAL,R14  TABLEOUT          AND PRINT TABLE                             
*                                                                               
         SW,R7    TABLSCNT          ADJUST COUNT TO GET REFS/DEFS               
         STW,R7   REFDEFS           AND SAVE THIS COUNT                         
*                                                                               
*                                                                               
PART2END EQU      %                                                             
         PAGE                                                                   
         SPACE    2                                                             
PART4    EQU      %         START PROCESSING OVERLAYS                           
         LI,R7    0                 SET TABLE EMPTY                             
         LI,R8    BA(CARDEND)       SET NEED A NEW LINE                         
*                                                                               
PART4A   EQU      %         GET NAMES                                           
         BAL,R14  GETNAME                                                       
         B        PART4A            BLANK, SKIP IT                              
*                                                                               
         LD,R12   R10               SAVE NAME                                   
         BAL,R14  ENCODE            FIX UP                                      
         AI,R7    1                                                             
         STD,R10  NAMES,R7          ENTER IN TABLE                              
         BAL,R14  GETADDR           GET THE ADDRESS                             
         BAL,R14  CVTADDR           MAKE HEX                                    
         STW,R0   MAPADDRS,R7       AND SET                                     
         STW,R7   INDEX,R7          AND SET OVID NUMBER                         
         CD,R12   ENDOLAYS          LAST PROLAY ?                               
         BNE      PART4A              NO, GET NEXT NAME                         
*                                                                               
*                 OUTPUT OVERLAY INDEX MAP                                      
         STW,R7   MAPADDRS          SET LENGTH OF THE TABLE NOW                 
         STW,R7   OVLYCNT           SAVE NUMBER OF OVERLAYS                     
         STW,R8   INDEX             SAVE LINE POINTER                           
         LI,R0    4                 SET NUMBER OF COLS/PAGE                     
         STW,R0   NUMCOLS                                                       
         LW,R0    PAGESIZE          ADJUST LINES AVAIL THIS PAGE TO             
         AI,R0    -3                REFLECT THE HEADER LINES                    
         STW,R0   LINESPP           ALREADY PRINTED                             
         LI,R0    OLAYMAP           SET NEW ITEM PRINT ROUTINE                  
         STW,R0   OUTSUB                                                        
         LI,R2    OLAYIDS           OUT OVERLAY NAMES TITLE                     
         TRM      PAGEHDR           ON A NEW PAGE                               
         PRTUP    2                                                             
         PRTTXT   OMAP1             PRINT LINE 1 COL HEADERS                    
         PRTTXT   OMAP2             AND LINE 2 OF HEADER                        
         LI,R2    OLAYIDS           RESET NEW PAGE HEADER LINE                  
         BAL,R14  TABLEOUT          PRINT THE TABLE                             
*                                                                               
         BAL,R14  ALPHATIZ          ORDER TABLE                                 
         LI,R2    OLAYIDSN          OUT OVERLAY NAMES IN NUMERICAL ORDER        
         TRM      PAGEHDR           TITLE ON A NEW PAGE                         
         PRTUP    2                                                             
         PRTTXT   OMAP1                                                         
         PRTTXT   OMAP2                                                         
         LW,R0    PAGESIZE          ADJUST LINES AVAIL THIS PAGE TO             
         AI,R0    -3                REFLECT THE HEADER LINES                    
         STW,R0   LINESPP           ALREADY PRINTED                             
         LI,R2    OLAYIDSN          RESET NEW PAGE HEADER LINE                  
         LW,R7    MAPADDRS          GET LENGTH                                  
         BAL,R14  TABLEOUT                                                      
         PAGE                                                                   
*                                                                               
*                                                                               
*                           CONVERT OVERLAY LENGTHS TO LOAD ADDRESSES           
*                                   WHICH ARE = OVLYFWA                         
         LW,R8    MAPINFO+1         GET ADDRESS OF OVERLAY AREA                 
         LW,R6    MAPADDRS          SET LENGTH TO TEST                          
         LI,R9    X'200'            SET MAX LENGTH TO TEST AGAINST              
*                                                                               
PART4D   EQU      %                                                             
         CW,R9    MAPADDRS,R6       IS IT A LENGTH ?                            
         BL       PART4E              NO                                        
*                                                                               
         STW,R8   MAPADDRS,R6         YES, SET TO START ADDR                    
*                                                                               
PART4E   EQU      %                                                             
         BDR,R6   PART4D                                                        
*                                                                               
*                          CONTINUE READING OLAY ENTRY POINTS                   
         LW,R7    MAPADDRS          RECOVER LENGTH OF TABLE                     
         LD,R12   ZEROS             SET INITIAL LOWEST NAME FOUND               
         LW,R8    INDEX             RECOVER LINE POINTER                        
*                                                                               
PART4G   EQU      %                                                             
         BAL,R14  GETNAME                                                       
         B        PART4G            BLANK                                       
*                                                                               
         BAL,R14  ENCODE            ENCODE NAME                                 
         CD,R10   R12               IS NAME LOWER IN ORDER ?                    
         BL       PART4K              YES, TEST IF END OF ENTRYS                
*                                                                               
         STD,R10  R12               SAVE NEW HIGHEST ORDER NAME                 
*                                                                               
PART4H   EQU      %         STORE NAME IN TABLE                                 
         AI,R7    1                                                             
         STD,R10  NAMES,R7          SAVE NAME                                   
         BAL,R14  GETADDR                                                       
         BAL,R14  CVTADDR                                                       
         STW,R0   MAPADDRS,R7                                                   
         STW,R7   INDEX,R7          SET EPIEP INDEX                             
         B        PART4G            AND GET NEXT NAME                           
*                                                                               
*                                                                               
PART4K   EQU      %         TEST IF AT END OF ENTRY POINT NAMES                 
         LB,R1    R10               FETCH 1ST CHAR OF NAME                      
         LB,R1    XLATEOUT,R1       DECODE TO EBCDIC                            
         CI,R1    C':'              AT START OF ':' NAMES                       
         BE       PART4H              YES, ALLOW THEM TO PASS                   
         PAGE                                                                   
         SPACE    2                                                             
         STW,R7   MAPADDRS          SAVE LENGTH OF TABLE                        
         STW,R7   ENTRYCNT          SET NUMBER OF ENTRY POINTS                  
         STD,R10  NAMES             SAVE LAST NAME READ                         
         STW,R8   INDEX             AND CURRENT LINE POINTER INDEX              
*                                                                               
*                          REORDER OVERLAY NAMES TO INDEX ORDER                 
         LW,R6    OVLYCNT           GET NUMBER OF NAMES TO REORDER              
*                                                                               
PART4L   EQU      %         OUTER LOOP; SET CANDIDATE FOR NEXT HIGHEST          
         LW,R5    R6                COPY INDEX OF FIRST TO TEST                 
         LW,R8    INDEX,R6          AND SET ITS INDEX VALUE                     
*                                                                               
PART4M   EQU      %         INNER LOOP; FIND LOWEST INDEX LEFT                  
         CW,R8    INDEX,R5          TEST NEXT ENTRY                             
         BGE      PART4N              NOT THIS ONE                              
*                                                                               
         LD,R10   NAMES,R6          INTERCHANGE NAMES                           
         LD,R12   NAMES,R5                                                      
         STD,R10  NAMES,R5                                                      
         STD,R12  NAMES,R6                                                      
         LW,R10   MAPADDRS,R6       INTERCHANGE ENTRY ADDRESSES                 
         XW,R10   MAPADDRS,R5                                                   
         STW,R10  MAPADDRS,R6                                                   
         XW,R8    INDEX,R5          AND FINALLY OVLY INDEX                      
         STW,R8   INDEX,R6                                                      
*                                                                               
PART4N   EQU      %                                                             
         BDR,R5   PART4M            LOOP FOR NEXT ITEM TO TEST                  
*                                                                               
         BDR,R6   PART4L            LOOP TO FIND NEXT ENTRY                     
         PAGE                                                                   
         SPACE    2                                                             
*                           OUT ENTRY POINT TABLES IN 3 FORMATS                 
*                                                                               
*                           OUT ENTRY POINTS BY ID NUMBER                       
         LI,R2    OLAYENTI                                                      
         TRM      PAGEHDR           OUT TITLE LINE ON NEW PAGE                  
         PRNT                       SPACE A LINE                                
         PRTTXT   OMAP1A            OUT COLUMN HEADERS                          
         PRTTXT   OMAP2                                                         
         LW,R0    PAGESIZE          ADJUST LINES LEFT ON PAGE BY                
         AI,R0    -3                THOSE USED FOR THE HEADERS                  
         STW,R0   LINESPP                                                       
         LI,R2    OLAYENTI          SET ADDRESS OF TITLE LINE AGAIN             
         TRM      TABLEOUT          OUT THE TABLE                               
*                                                                               
*                          OUT ENTRY POINTS IN ALPHABETICAL ORDER               
         BAL,R14  ALPHATIZ          ORDER TABLE                                 
         LI,R2    OLAYENTA          OUT HEADER LINE ON A NEW                    
         TRM      PAGEHDR           PAGE, PRINT ON NEW PAGE                     
         PRNT                       SPACE ANOTHER LINE                          
         PRTTXT   OMAP1A                                                        
         PRTTXT   OMAP2                                                         
         LI,R2    OLAYENTA          RESET PAGE HEADER ADDRESS                   
         LW,R0    PAGESIZE          ADJUST LINES OF DATA FOR FIRST              
         AI,R0    -3                PAGE TO                                     
         STW,R0   LINESPP           MAKE ROOM FOR EXTRA HEADERS                 
         BAL,R14  TABLEOUT          OUT A TABLE                                 
*                                                                               
*                                                                               
*                          OUT ENTRY POINTS BY ASCENDING ADDRESSES              
         BAL,R14  NUMERTIZ          ORDER BY ADDRESS                            
         LI,R2    OLAYENTN          OUT HEADER LINE ON A NEW                    
         TRM      PAGEHDR           PAGE                                        
         PRNT                       SPACE ANOTHER LINE                          
         PRTTXT   OMAP1A                                                        
         PRTTXT   OMAP2                                                         
         LI,R2    OLAYENTN          RESET PAGE HEADER ADDRESS                   
         LW,R0    PAGESIZE          ADJUST LINES OF DATA FOR FIRST              
         AI,R0    -3                PAGE TO                                     
         STW,R0   LINESPP           MAKE ROOM FOR THE HEADERS                   
         LW,R7    MAPADDRS          SET LENGTH AGAIN                            
         BAL,R14  TABLEOUT          OUT IT THIS WAY                             
*                                                                               
*                                                                               
         LI,R0    MAPENTRY          RESET OUT ITEM ROUTINE                      
         STW,R0   OUTSUB                                                        
         LI,R0    #COLS                                                         
         STW,R0   NUMCOLS           AND COLUMNS PER PAGE                        
*                                                                               
PART4END EQU      %                                                             
         PAGE                                                                   
         SPACE    1                                                             
PART5    EQU      %         OUT EXIT POINTS                                     
         LI,R7    0                 SET TABLE EMPTY AGAIN                       
         LD,R10   NAMES             RECOVER FIRST NAME                          
         LW,R8    INDEX             AND LINE POINTER                            
         B        PART5C            ENTER LOOP                                  
*                                                                               
PART5B   EQU      %         GET NEXT NAME                                       
         BAL,R14  GETNAME                                                       
         B        PART5B            BLANK NAME                                  
*                                                                               
         CD,R10   SYSNAMEA          FOUND ''SYSTEM'' YET ?                      
         BE       PART5E              YES, SAVE MAJOR CPR ADDRESSES             
*                                                                               
         BAL,R14  ENCODE            FIX UP NAME                                 
*                                                                               
PART5C   EQU      %         ENTRY FOR 1ST ITEM; FOUND IN PART 4                 
         AI,R7    1                                                             
         STD,R10  NAMES,R7          SAVE NAME                                   
         BAL,R14  GETADDR                                                       
         BAL,R14  CVTADDR                                                       
         STW,R0   MAPADDRS,R7                                                   
         B        PART5B            GET NEXT NAME                               
*                                                                               
PART5E   EQU      %                                                             
         STW,R7   MAPADDRS          SAVE LENGTH                                 
         STW,R7   EXITCNT           SAVE NUMBER OF EXIT POINTS                  
         STW,R8   INDEX             SAVE LINE POINTER                           
         BAL,R14  ALPHATIZ          ORDER TABLE                                 
         LI,R2    OLAYEXIT          OUT TITLE TO LINE                           
         TRM      PAGEHDR           ON A NEW PAGE                               
         BAL,R14  TABLEOUT                                                      
         PAGE                                                                   
         SPACE    2                                                             
PART6    EQU      %         MAJOR ''SYSTEM'' ADDRESSES                          
         LI,R9    MAPNAMEA          SET NAME OF LOOK-UP TABLE                   
         LW,R8    INDEX             RECOVER LINE POINTER                        
         LD,R10   SYSNAMEA          FAKE RECOVERY OF LAST NAME SCANNED          
         B        PART6B            HOP INTO SEARCH LOOP                        
*                                                                               
PART6A   EQU      %                                                             
         BAL,R14  GETNAME                                                       
         B        PART6A            BLANK, SKIP IT                              
*                                                                               
PART6B   EQU      %         ENTRY FOR ''SYSTEM'' FOUND                          
         CW,R10   MAPBREAK          END OF INPUT ?                              
         BE       PART6E              YES, OUT INFO AND STOP                    
*                                                                               
         SCD,R10  -8                SHIFT OUT LAST CHAR TO 1ST CHAR             
         LI,R0    C' '              CONVERT IT TO A SPACE TO INSURE             
         STB,R0   R10               LAST CHAR OF NAME IS A BLANK                
         SCD,R10  8                 CONVERT BACK TO LEFT JUSTIFIED              
         BAL,R14  FINDNAME          FIND TABLE INDEX                            
         B        PART6A            NOT FOUND, SKIP IT                          
*                                                                               
         BAL,R14  GETADDR           GET IT ADDRESS                              
         BAL,R14  CVTADDR                                                       
         STW,R0   MAPINFO,R6        AND SAVE IT                                 
         B        PART6A            GET NEXT ITEM                               
*                                                                               
*                                                                               
PART6E   EQU      %         ENDOF ''SYSTEM'' INFO:                              
PART6END EQU      %                                                             
         PAGE                                                                   
         SPACE    2                                                             
PART7    EQU      %         OUT NAMES OF UNDEFINED ENTRY/EXIT POINTS            
         LI,R5    0                 NONE FOUND YET                              
         STW,R5   UNDEFCNT          SET NO UNDEFINED EXITS                      
         LI,R6    0                 START SCAN AT NAME 1                        
*                                                                               
PART7A   EQU      %         PROCESS NEXT ENTRY NAME                             
         AI,R6    1                 STEP TO NEXT IN LIST                        
         CW,R6    R7                HAS THE LAST BEEN TESTED ?                  
         BGE      PART7B              YES, SEE WHAT TO PRINT                    
*                                                                               
         LW,R10   MAPADDRS,R6       IS THE ADDRESS DEFINED ( NOT 0)?            
         BGZ      PART7A              YES, SKIP IT                              
*                                                                               
         AI,R5    1                 SET TO NEXT FREE ENTRY                      
         LD,R10   NAMES,R6                                                      
         STD,R10  NAMES,R5          MOVE TO START OF TABLE                      
         B        PART7A            AND TEST NEXT                               
*                                                                               
PART7B   EQU      %         ANY NAMES FOUND ?                                   
         LW,R7    R5                SET LENGTH; ANY ENTRIES ?                   
         BLEZ     PART7END            NO, EXIT THIS PART                        
*                                                                               
         STW,R5   UNDEFCNT          SET NUMBER OF UNDEFINED WE FOUND            
         LI,R0    10                SET 10 ITEMS PER LINE                       
         STW,R0   NUMCOLS                                                       
         LI,R0    OUTNAME           SET NAME OF ROUTINE                         
         STW,R0   OUTSUB            TO CONVERT AND OUTPUT NAME                  
         LI,R2    UNDEFED           OUT UNDEFINED ENTRY'S TITLE                 
         TRM      PAGEHDR                                                       
         TRM      TABLEOUT          AND PRINT THE TABLE                         
         LI,R0    #COLS             RESET NUMBER OF COLUMNS                     
         STW,R0   NUMCOLS                                                       
         LI,R0    MAPENTRY          RESET OUT SUBROUTINE                        
         STW,R0   OUTSUB                                                        
*                                                                               
*                                                                               
PART7END EQU      %         END OF SECTION                                      
         PAGE                                                                   
         SPACE    2                                                             
PART8    EQU      %         OUT MAJOR CP-R ADDRESSES                            
         LW,R7    MAPNAME           GET LENGTH OF TABLE                         
         LW,R6    R7                                                            
*                                                                               
PART8A   EQU      %         MOVE TO NAME/INDEX TABLE                            
         LD,R10   MAPNAME,R6                                                    
         STD,R10  NAMES,R6                                                      
         LW,R10   MAPINFO,R6                                                    
         STW,R10  MAPADDRS,R6                                                   
         BDR,R6   PART8A                                                        
*                                                                               
         LI,R0    3                 SET NUMBER OF COLUMNS TO 3                  
         STW,R0   NUMCOLS           TO GET SMALL VERTICLE TABLE                 
         LI,R0    60                SET ONLY 60 COLS AVAIL TO PRINT 3           
         STW,R0   #PRTCOLS          ITEMS TO KEEP CLOSE TOGETHER                
         LI,R2    MAPLIMS           OUT TITLE OF MAJOR INFO ON A                
         TRM      PAGEHDR           NEW PAGE                                    
         BAL,R14  TABLEOUT                                                      
*                                                                               
PART8END EQU      %                                                             
         PAGE                                                                   
         SPACE    2                                                             
PART9    EQU      %         PRINT OUT DISC/RAD ALLOCATIONS                      
         LI,R0    PART9C            CHANGE ERROR AND ABNORMAL EXITS TO          
         STW,R0   READFPT+2         IGNORE MISSING AREA ALLOCATIONS             
         STW,R0   READFPT+3         AND EXIT NORMALLY;                          
         LI,R2    DISCALOC          OUT HEADER LINE                             
         TRM      PAGEHDR                                                       
         PRTUP    2                                                             
*                                                                               
PART9A   RES      0         READ A MAP LINE                                     
         TRM      READCARD          READ A LINE                                 
         NOP      %                 IGNORE ANY BLANK LINES                      
         CW,R10   MAPBREAK          AT END OF THE DATA ?                        
         BE       PART9C              YES, EXIT                                 
*                                                                               
         SETCP    10                INDENT 10 COLUMNS                           
         CHARS    80,CARDIMAG       OUT THE LINE                                
         PRNT                       PRINT THE LINE, AND                         
         B        PART9A            LOOP FOR ANOTHER                            
*                                                                               
*                                                                               
PART9C   EQU      %         END OF ALLOCATION PRINT                             
*                                                                               
*                                                                               
PART9END EQU      %         END OF THIS PART                                    
         PAGE                                                                   
         SPACE    2                                                             
PARTEND  EQU      %         END OF PROCESSING                                   
*                                                                               
*                                                                               
*                                                                               
         CAL1,1   REWFPT            INSURE MAP FILE AT BEGINNING                
******** CAL1,1   CLOSEFPT          CLOSE FILE TO INSURE AT BEGINNING           
*                                                                               
*                                                                               
END      EQU      %         ERROR END                                           
         PULL     16,R14            RECOVER REGISTERS                           
         AW,R14   RETURNSW          ADJUST ADDRESS BY RETURN CODE SW            
         B        *R14              RETURN TO ROOT TO CONTINUE                  
         PAGE                                                                   
         SPACE    2                                                             
READERR  EQU      %         READ ERROR; SAY WHY                                 
         LI,R2    EARLYEND                                                      
         B        COMMONER                                                      
*                                                                               
*                                                                               
*                                                                               
OPENERR  EQU      %        UNABLE TO OPEN INPUT FILE                            
         LB,R2    R10               GET ERROR CODE TO SEE AND CHECK             
         CI,R2    X'2E'             WAS THE FILE ALREADY OPENED ?               
         BE       *R8                 YES, CONTINUE AS IF ALL OK                
*                                                                               
         LI,R2    OPNERR                                                        
         B        COMMONER                                                      
*                                                                               
*                                                                               
*                                                                               
REWINDER EQU      %         ERROR REWINDING MAP INPUT FILE                      
         LI,R2    REWERR            SET ERROR MESSAGE                           
         B        COMMONER          AND GO TO COMMON PROCESSOR                  
*                                                                               
*                                                                               
*                                                                               
CLOSERR  EQU      %         UNABLE TO CLOSE FILE                                
         LB,R2    R10               GET ERROR CODE                              
         CI,R2    X'0A'             IS FILE ALREADY CLOSED ?                    
         BE       *R8                 YES, CONTINUE AS IF NORMAL                
*                                                                               
         LI,R2    CLSERR                                                        
         B        COMMONER                                                      
         PAGE                                                                   
         SPACE    2                                                             
COMMONER EQU      %         COMMON ERROR CODE PRINT                             
         LCI      0                 SAVE REGISTERS                              
         STM,R0   REGSAVE           EXCEPT R2                                   
         STRNG                      OUT MESSAGE AT R2                           
         STRNG    ERRMSG1           OUT NAME OF ITEM FOLLOWING                  
         INTGR    HEX,ZERO,8,R10    ENTER ERROR CODE, DCB/FPT ADDRESS           
         STRNG    ERRMSG2                                                       
         INTGR    HEX,ZERO,8,R8     OUT ADDR + 1 OF CAL                         
         STRNG    ERRMSG3                                                       
         INTGR    HEX,ZERO,8,R13    OUT POSSIBLE RETURN ADDR                    
         PRTPAG                     PRINT ON A NEW PAGE                         
         PRTUP    3                 SPACE A FEW LINES                           
         PRTTXT   REGMSG            IDENTIFY REGISTERS                          
         XDMP     REGSAVE,REGSAVE+15,REGSAVE                                    
         PRTUP    3                                                             
         PRTTXT   FPTMSG            IDENTIFY FPT/DCB                            
         LW,R1    R10               GET ADDRESS OF FPT/DCB                      
         AI,R1    16                DUMP TWO LINES WORTH                        
         LW,R0    R10               SET START ADDRESS                           
         LW,R2    R10               SET END   ADDRESS                           
         XDMP                       DUMP                                        
*                                                                               
         STRNG    ROOTXDMP          PUT OUT TITLE FOR DUMP OF ROOT              
         PRTPAG                     SKIP TO A NEWPAGE                           
         PRTUP    3                 SKIP A FEW LINES                            
         LI,R0    ANALYZE           SET START ADDRESS = PROGRAM START           
         LI,R1    ANALYZ2-1         SET END = BEGIN THIS SEGMENT - 1            
         LW,R2    R0                SET RELATIVE TO BEGIN OF ROOT               
         XDMP                       DUMP IT                                     
*                                                                               
         LI,R6    #ITEMS            SET CONVERT  NAME TABLES TO NORMAL          
*                                                                               
POP      EQU      %         CONVERT NAMES TO NORMAL EBCDIC                      
         LD,R10   NAMES,R6          FETCH A NAME                                
         TRM      DECODE            CONVERT IT                                  
         STD,R10  NAMES,R6          STORE IT BACK                               
         BDR,R6   POP               LOOP FOR ALL IN TABLE                       
*                                                                               
         STRNG    OLAYXDMP          OUT TITLE FOR THIS PART OF DUMP             
         PRTPAG                     ON A NEW PAGE                               
         PRTUP    3                 SKIP A FEW LINES                            
         XDMP     ANALYZ2,THEEND,ANALYZ2                                        
*                                                                               
        DO       (#SYSTEM='CP-R')                                               
         STRNG    RESTXDMP          OUT TITLE FOR THE REST OF THE CODE          
         PRTPAG                                                                 
         PRTUP    3                                                             
         LI,R1    X'1FFFF'          SET END OF VIRTUAL = END OF DUMP            
         XDMP     THEEND,,THEEND    DUMP                                        
        FIN                                                                     
*                                                                               
         PRTPAG                     SKIP TO A NEWPAGE                           
         MTW,-1   RETURNSW          SET ERROR: RETURN = LINE ADDRESS            
         B        END               AND EXIT                                    
         TITLE    'UTILITY SUBROUTINES'                                         
         SPACE    2                                                             
*********         COMMON EXIT PROCEDURE                                         
*                                                                               
*                                                                               
EXIT2    AI,R14   1                 EXIT AT LINK + 2                            
*                                                                               
*                                                                               
EXIT1    AI,R14   1                 EXIT AT LINK + 1                            
*                                                                               
*                                                                               
EXIT0    B        *R14              EXIT AT LINK + 0                            
EXIT     EQU      EXIT0                                                         
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
GETNAME  EQU      %         GET A NAME FROM INPUT LINE                          
         LW,R1    R8                COPY BYTE ADDRESS OF NEXT CHAR              
         LD,R10   BLANKS            INIT NAME TO BLANKS                         
         LI,R2    16                SET MAX NUM OF CHARS TO SCAN                
*                                                                               
GETNAME1 EQU      %         SCAN INPUT FOR A NAME                               
         AI,R1    1                 STEP TO NEXT CHARACTER                      
         CI,R1    BA(CARDEND)       OFF END OF INPUT CARD ?                     
         BGE      READCARD            YES, GET NEXT INPUT LINE                  
*                                                                               
         LB,R0    0,R1              GET NEXT CHAR                               
         CI,R0    C' '              END OF NAME FIELD ?                         
         BNE      GETNAME2            YES                                       
*                                                                               
         BDR,R2   GETNAME1          AND GET NEXT CHAR                           
         STW,R1   R8                SAVE POINTER                                
         B        EXIT0             EXIT AT BLANKS FOUND EXIT                   
*                                                                               
GETNAME2 EQU      %                                                             
         LI,R2    8                 SET TO SCAN 8 CHARACTERS MAX                
         AI,R1    -1                BACK UP TO RESCAN LAST CHAR                 
*                                                                               
GETNAME3 EQU      %         PICK UP 1ST 8 CHARS OF NAME                         
         AI,R1    1                                                             
         CI,R1    BA(CARDEND)                                                   
         BGE      GETNAME4          IF CARD END, ASSUME END OF NAME             
         LB,R0    0,R1              GET THE CHARACTER                           
         CI,R0    C'='              END OF NAME ?                               
         BE       GETNAME4                                                      
*                                                                               
         CI,R2    0                 8TH CHARACTER STORED ?                      
         BE       GETNAME3            YES, SKIP THIS ONE                        
*                                                                               
         STB,R0   R10               NO, SAVE CHARACTER                          
         SCD,R10  8                 MOVE IT TO THE END                          
         BDR,R2   GETNAME3                                                      
         B        GETNAME3                                                      
*                                                                               
GETNAME4 EQU      %                                                             
         STW,R1   R8                SAVE ADDR OF LAST CHAR                      
         CD,R10   BLANKS            IS THE NAME STILL BLANKS ?                  
         BE       EXIT0               YES, RETURN A BLANK                       
*                                                                               
GETNAME5 EQU      %         LEFT JUSTIFY THE NAME                               
         LB,R0    R10               GET THE LEFT-MOST BYTE                      
         CI,R0    C' '              A BLANK ?                                   
         BNE      EXIT1               NO, NOW LEFT JUSTIFIED; EXIT              
*                                                                               
         SCD,R10  8                 LEFT 1 CHAR, PUT BLANK AT END               
         B        GETNAME5          AND TRY AGAIN                               
*                                                                               
*                                                                               
*                                                                               
READCARD EQU      %         READ A CARD INTO THE INPUT BUFFER                   
         LW,R13   R14               SAVE RETURN ADDRESS FOR ERRORS              
         CAL1,1   READFPT           READ IT                                     
         LI,R8    BA(CARDIMAG)-1    INITIALIZE IMAGE POINTER                    
         B        GETNAME           AND GET 1ST NAME ON CARD                    
         PAGE                                                                   
         SPACE    2                                                             
PAGEHDR  EQU      %         PRINT PAGE HEADER ON NEW PAGE; STEP PAGE NO         
         PUSH     R14               SAVE LINK                                   
         PUSH     R2                SAVE ADDRESS OF HEADER TEXT                 
         STRNG    MAPHEAD           OUT CONSTANT PART OF TITLE                  
         PULL     R2                RECOVER LOC OF TITLE MSG                    
         PUSH     R2                AND SAVE IT AGAIN FOR CALLER                
         STRNG                      OUT IT                                      
         SETCP    PAGENO            SET CP FOR 'PAGE '                          
         STRNG    QPAGEQ            ENTER IT                                    
         MTW,+1   PAGE              STEP PAGE NUMBER                            
         INTGR    DEC,SPAC,3,PAGE   ENTER IT                                    
         PRTPAG                     PAGE THE PRINTER                            
         PULL     R2                RECOVER TITLE ADDRESS                       
         PULL     R14               AND LINK                                    
         B        *R14              RETURN                                      
         PAGE                                                                   
*                                                                               
*                                                                               
GETADDR  EQU      %         GET ADDRESS                                         
         LW,R1    R8                GET BYTE ADDR OF NEXT CHAR                  
*                                                                               
GETADDR1 EQU      %         SCAN FOR A '='                                      
         LB,R0    0,R1                                                          
         CI,R0    C'='              THE EQUAL FOUND                             
         BE       GETADDR2            YES, SCAN NUMBER                          
*                                                                               
         CI,R0    C' '              IS IT A BLANK ?                             
         BNE      GETADDR2            NO, ASSUME START OF ADDRESS               
*                                                                               
         AI,R1    1                                                             
         B        GETADDR1          STEP TILL FOUND                             
*                                                                               
GETADDR2 EQU      %         SCAN A NUMBER                                       
         LD,R10   BLANKS            CLEAR CHAR ACCUMULATOR                      
*                                                                               
GETADDR3 EQU      %         PICK UP CHARS UNTIL A BLANK                         
         AI,R1    1                 STEP TO NEXT CHAR                           
         LB,R0    0,R1              GET THE CHAR                                
         CI,R0    C' '              END OF INPUT ?                              
         BE       GETADDR4            YES                                       
*                                                                               
         STB,R0   R10               SAVE IT                                     
         SCD,R10  8                 PUT IN ITS PLACE AT END                     
         B        GETADDR3          AND GET NEXT DIGIT                          
*                                                                               
GETADDR4 EQU      %         END OF SCAN                                         
         STW,R1   R8                SAVE POINTER                                
         LW,R10   R11               COPY TO FIRST WORD                          
         B        EXIT0             AND RETURN                                  
         PAGE                                                                   
         SPACE    2                                                             
CVTADDR  EQU      %         CONVERT EBCDIC ADDRESS TO HEXADECIMAL               
         LI,R1    -4                NUMBER OF DIGITS                            
         LI,R0    0                 ACCUMULATOR GETS 0                          
*                                                                               
CVTADDR1 EQU      %         PROCESS A DIGIT                                     
         LB,R15   R11,R1            GET NEXT DIGIT                              
         CI,R15   C'0'              A ZERO ?                                    
         BGE      %+2                 YES, OK AS IS                             
*                                                                               
         AI,R15   X'FA'-X'C1'       ADJUST TO X'FA' TO X'FF'                    
         AND,R15  M4                REMOVE ZONE BITS                            
         SLS,R0   4                 MAKE ROOM FOR NEW DIGIT IN ACC              
         OR,R0    R15               AND ADD IT IN                               
         BIR,R1   CVTADDR1          AND THEN GET NEXT DIGIT                     
*                                                                               
         B        EXIT0             RETURN                                      
         PAGE                                                                   
*                                                                               
*                                                                               
ENCODE   EQU      %         ENCODE NAME IN R10,R11                              
         LI,R1    -8                NUMBER OF CHARS                             
*                                                                               
ENC      EQU      %         DO EACH CHAR                                        
         LB,R2    R12,R1                                                        
         LB,R2    XLATEIN,R2        CONVERT CHAR                                
         STB,R2   R12,R1            PUT NEW CHARACTER BACK IN THE NAME          
         BIR,R1   ENC               LOOP FOR ALL 8 CHARACTERS                   
         B        EXIT0                                                         
*                                                                               
*                                                                               
DECODE   EQU      %         CONVERT NAME BACK TO NORMAL EBCDIC                  
         LI,R1    -8                SET NUMBER OF CHARS TO CONVERT              
*                                                                               
DECODEA  EQU      %         DO A CHATACTER                                      
         LB,R2    R12,R1            FETCH THE CHARACTER                         
         LB,R2    XLATEOUT,R2       CONVERT TO EBCDIC                           
         STB,R2   R12,R1            PUT BACK IN THE NAME                        
         BIR,R1   DECODEA           LOOP FOR NEXT CHARACTER                     
         B        EXIT0             RETURN TO CALLER                            
*                                                                               
*                                                                               
FINDNAME EQU      %         LOOK A NAME UP IN CPRNAME TABLE                     
         LW,R6    *R9               GET LENGTH OF THE TABLE                     
*                                                                               
FN       EQU      %                                                             
         CD,R10   *R9,R6            THIS THE ENTRY ?                            
         BE       EXIT1               YES, SAY WE FOUND IT                      
         BDR,R6   FN                ELSE TRY ANOTHER ENTRY                      
         B        EXIT              NOT FOUND; ERROR EXIT                       
         TITLE    'OUTPUT SUBROUTINES'                                          
         SPACE    2                                                             
ALPHATIZ EQU      %         ORDER TABLE ALPHABETICALLY                          
         LW,R6    R7                COPY LENGTH                                 
*                                                                               
ALP1     EQU      %         OUTTER LOOP                                         
         LW,R5    R6                                                            
         LD,R8    NAMES,R6          GET CURRENT LAST NAME PROSPECT              
*                                                                               
ALP2     EQU      %         INNER LOOP                                          
         CD,R8    NAMES,R5          IS THIS A LATER NAME ?                      
         BG       ALP3                NO, KEEP CURRENT PROSPECT                 
*                                                                               
         LD,R10   NAMES,R5          SWITCH ENTRIES                              
         STD,R8   NAMES,R5                                                      
         STD,R10  NAMES,R6          SETTING NEW PROSPECT                        
         STD,R10  R8                                                            
         LW,R10   INDEX,R6          SWITCH INDIX VALUES TOO                     
         XW,R10   INDEX,R5                                                      
         STW,R10  INDEX,R6                                                      
         LW,R10   MAPADDRS,R6                                                   
         XW,R10   MAPADDRS,R5                                                   
         STW,R10  MAPADDRS,R6                                                   
*                                                                               
ALP3     EQU      %         STEP TO NEXT OF INNER LOOP                          
         BDR,R5   ALP2                                                          
*                                                                               
         BDR,R6   ALP1              OUTTER LOOP                                 
*                                                                               
         B        EXIT              RETURN                                      
         PAGE                                                                   
*                                                                               
NUMERTIZ EQU      %         ORDER TABLE BY ASCENDING ADDRESSES                  
         LW,R6    R7                COPY LENGTH OF TABLE                        
*                                                                               
NUM1     EQU      %                                                             
         LW,R5    R6                                                            
         LW,R8    MAPADDRS,R6                                                   
*                                                                               
NUM2     EQU      %         INNER LOOP                                          
         CW,R8    MAPADDRS,R5                                                   
         BL       NUM3              WRONG ORDER; SWITCH                         
         BG       NUM4              RIGHT ORDER; LEAVE AS IS                    
*                                                                               
         LD,R10   NAMES,R6          ORDER EQUALS ALPHABETICALLY                 
         CD,R10   NAMES,R5                                                      
         BGE      NUM4                                                          
*                                                                               
NUM3     EQU      %         FIX ORDER                                           
         LD,R10   NAMES,R6                                                      
         LD,R12   NAMES,R5                                                      
         STD,R10  NAMES,R5                                                      
         STD,R12  NAMES,R6                                                      
         LW,R10   INDEX,R6                                                      
         XW,R10   INDEX,R5                                                      
         STW,R10  INDEX,R6                                                      
         XW,R8    MAPADDRS,R5                                                   
         STW,R8   MAPADDRS,R6                                                   
*                                                                               
NUM4     EQU      %         END OF INNER LOOP; ONE ITEM DONE                    
         BDR,R5   NUM2                                                          
*                                                                               
         BDR,R6   NUM1                                                          
         B        EXIT                                                          
         PAGE                                                                   
         SPACE    2                                                             
TABLEOUT EQU      %         OUT A TABLE                                         
*                                   NUMCOLS HAS NUMBER COLS PER PAGE            
*                                   OUTSUB HAS ADDR OF ENTRY CONVER-            
*                                          SION SUBROUTINE                      
*                                   R7 HAS NUMBER OF ITEMS TO OUTPUT            
*                 ROUTINE COMPUTES START INDICIES FOR EACH OF THE               
*                 NUMCOLS COLUMNS AND OUTPUT ITEMS SO THAT THE TABLE            
*                 IS ORDERED COLUMN WISE                                        
*                                                                               
*                                                                               
         PUSH     R14               SAVE LINK                                   
         STW,R2   HEADER            SAVE LOC OF PAGE HEADER                     
         STW,R7   NUMITEMS          SAVE NUMBER YET TO PRINT                    
*                                                                               
         LI,R0    1                 SET INDEX VALUE 1ST COL, 1ST PAGE           
         STW,R0   SPC1              IN START PRINT COL 1                        
         LI,R8    0                 COMPUTE START COLUMNS NUMBERS               
         LW,R9    #PRTCOLS          FOR EACH OF THE COLUMNS BASED ON            
         DW,R8    NUMCOLS           NUMBER OF PRINT POSITIONS TO USE            
         LI,R1    1                 SET TO START WITH 1ST COLUMN                
*                                                                               
T00      EQU      %                                                             
         STW,R0   SCP0,R1           STORE CP VALUE                              
         AW,R0    R9                STEP BY WIDTH OF ITEM                       
         AI,R1    1                 STEP CP TABLE POINTER                       
         CW,R1    NUMCOLS           DONE THE LAST ?                             
         BLE      T00                 NO, LOOP                                  
         PAGE                                                                   
*                                                                               
*                                                                               
T01      EQU      %         SEE IF MORE THAN 1 PAGE NEEDED                      
         LW,R15   R7                COPY NUMBER OF ITEMS TO PRINT               
         LI,R8    0                                                             
         LW,R9    NUMCOLS           NUMCOLS*'N' = ITEMS PER PAGE                
         MW,R8    LINESPP           'N' = LINES PER PAGE (35 USUALLY)           
         CW,R9    R15               WILL ALL FIT ON ONE PAGE ?                  
         BLE      T02                 NO , R9 = NUMBER TO PRINT                 
*                                                                               
         LW,R9    R15               YES, SET TO PRINT ONLY WHAT INPUT           
*                                                                               
T02      EQU      %         COMPUTE COL START INDICIES, FULL COLS               
         LI,R8    0                                                             
         DW,R8    NUMCOLS           NUMBER OF COLS WITH NUMROWS ITEMS           
         AI,R9    1                 FIX NUM/COL                                 
         STW,R9   NUMROWS           AND NUM OF COLS WITH 1 FEWER ITEMS          
         AI,R8    1                 LAST FULL COL = R8 TH COL                   
         LI,R1    1                 INDEX TO SCAN COL START INDICIES            
         CI,R8    1                 DO WE FILL ALL COLUMNS EXACTLY ?            
         BNE      T03                 NO, NEED THE PARTIAL LAST LINE            
*                                                                               
         MTW,-1   NUMROWS           YES, DON'T PRINT EXTRA BLANK LINE           
         PAGE                                                                   
         SPACE    2                                                             
T03      EQU      %                                                             
         LW,R0    SPC0,R1           NEXT TO PRINT = START TO PRINT              
         STW,R0   PC0,R1            FOR EACH COLUMN                             
         CW,R1    R8                END OF FULL COLUMNS ?                       
         BNE      T04                 NO,,MORE FULL COLUMNS                     
*                                                                               
         AI,R9    -1                1 ITEM LESS PER COL AFTER THIS COL          
*                                                                               
T04      EQU      %                                                             
         AW,R0    R9                NEXT SPC = LAST SPC + NUM / COL             
         STW,R0   SPC1,R1                                                       
         AI,R1    1                 STEP TO NEXT COLUMN POINTERS                
         CW,R1    NUMCOLS           DONE LAST YET                               
         BLE      T03                 NO, DO ANOTHER                            
         PAGE                                                                   
         SPACE    2                                                             
         PRNT                       SPACE A LINE                                
*                                                                               
T10      EQU      %         START PRINTING                                      
         LI,R7    1                 PRINT COLUMN INDEX = 1ST COL                
*                                                                               
T11      EQU      %         PROCESS A COLUMN ITEM                               
         LW,R6    PC0,R7            GET INDEX FOR TABLE ITEM                    
         CW,R6    SPC1,R7           AT END OF THE COLUMN YET ?                  
         BGE      T13                 YES, END OF PRINT                         
*                                                                               
         LW,R15   SCP0,R7           GET COLUMN POINTER FOR THE COLUMN           
         SETCP                                                                  
         BAL,R14  *OUTSUB           PROCESS THE ITEM                            
         MTW,+1   PC0,R7            STEP TO PROCESS NEXT NEXT TIME              
         AI,R7    1                 STEP TO NEXT COLUMN                         
         CW,R7    NUMCOLS           LAST COLUMN                                 
         BLE      T11               DO NEXT                                     
*                                                                               
T13      EQU      %         END OF ONE ROW                                      
         PRNT     ,                 PRINT THE LINE                              
         MTW,-1   NUMROWS           STEP ROW COUNT;  DONE YET ?                 
         BGZ      T10                 NO, DO ANOTHER                            
         PAGE                                                                   
         SPACE    2                                                             
         LW,R0    PAGESIZE          RESET LINES PER PAGE TO ITS                 
         STW,R0   LINESPP           DEFAULT OF 35                               
         LW,R7    NUMITEMS          GET LENGTH OF TABLE                         
         LW,R6    NUMCOLS           GET INDEX OF LAST ITEM PRINTED+1            
         LW,R15   PC0,R6                                                        
         STW,R15  SPC1              AND SET AS 1ST TO PRINT ON NEXT PAGE        
         AI,R15   -1                GET INDEX OF LAST ACTUALLY PRINTED          
         SW,R7    R15               COMPUTE NUMBER LEFT TO PRINT                
         BLEZ     T20                 NONE, EXIT NOW                            
*                                                                               
         LW,R2    HEADER            GET PAGE HEADER                             
         TRM      PAGEHDR           PUT ON NEXT PAGE                            
         B        T01               DO NEXT PAGE WORTH                          
*                                                                               
*                                                                               
T20      EQU      %         EXIT                                                
         LW,R7    NUMITEMS          RESET NUMBER OF ITEMS COUNT                 
         PULL     R14                                                           
         B        EXIT0                                                         
         PAGE                                                                   
         SPACE    2                                                             
MAPENTRY EQU      %         OUT A MAP ENTRY                                     
*                                   R14 = LINK;  R6  = TABLE INDEX              
         PUSH     R14               SAVE LINK                                   
         TRM      OUTNAME           CONVERT THE NAME                            
         CHAR     '='               OUT THE EQUALS                              
         LW,R15   MAPADDRS,R6       GET ASSOCIATED ADDRESS                      
         INTGR    HEX,SPAC,4        4 HEX DIGITS LEADING SPACES                 
         PULL     R14                                                           
         B        EXIT0             RETURN                                      
         PAGE                                                                   
         SPACE    2                                                             
OLAYMAP  EQU      %         OUT THE OVERLAY TABLE WITH ID NUMBERS               
         PUSH     R14                                                           
         LW,R15   INDEX,R6          GET ID                                      
         INTGR    DEC,SPAC,3                                                    
         CHAR     C' '                                                          
         CHAR     C'('                                                          
         LW,R15   INDEX,R6          GET INDEX AGAIN                             
         INTGR    HEX,ZERO,3                                                    
         CHAR     C')'                                                          
         CHAR     C' '                                                          
         TRM      OUTNAME           CONVERT AND OUTPUT THE NAME                 
*                                                                               
*        CHAR     C' '              SPACE A POSITION                            
         LI,R15   C' '              SPACE BETWEEN NAME, ADDRESS                 
         LI,R5    X'200'            GET MAX LEN OF A OLAY                       
         CW,R5    MAPADDRS,R6        ENTRY POINT ?                              
         BL       OLAYMAPY            YES, OUT S SPAC                           
         LI,R15   '-'               ELSE A '-'                                  
*                                                                               
OLAYMAPY EQU      %         OUT '-' OR ' ' BEFORE LEN OR LOC                    
         CHAR                                                                   
         LW,R15   MAPADDRS,R6        GET ADDRESS                                
         INTGR    HEX,SPAC,4                                                    
         PULL     R14                                                           
         B        EXIT0                                                         
         PAGE                                                                   
         SPACE    2                                                             
OUTNAME  EQU      %         CONVERT A NAME AND ENTER IN PRINT LINE              
         PUSH     R14               SAVE RETURN                                 
         LD,R10   NAMES,R6          GET ITS NAME                                
         LI,R5    8                 NUMBER OF CHARS TO DECODE                   
*                                                                               
OUTNAME1 EQU      %                                                             
         LB,R1    R10               GET A CHAR                                  
         LB,R15   XLATEOUT,R1                                                   
         CHAR                                                                   
         SLD,R10  8                 SHIFT TO NEXT CHAR                          
         BDR,R5   OUTNAME1                                                      
*                                                                               
         PULL     R14                                                           
         B        EXIT0                                                         
         TITLE    ' CONSTANTS, TEMPS, SWITCHES, ETC.'                           
         BOUND    8                                                             
*                                                                               
*                                                                               
BLANKS   TEXT     '        '        DOUBLE WORD OF BLANKS                       
*                                                                               
ZEROS    DATA,8   0                 WORD OF ZEROS OR ENCODED BLANKS             
*                                                                               
MAPBREAK TEXT     '****    '        TITLE LINE BEGINNINGS IN MAP                
*                                                                               
ENDOLAYS TEXT     'MMROOT  '        END OF OVERLAY NAMES                        
*                                                                               
*        NAME USED TO DETERMINE TYPE OF SYSTEM MAP WAS CREATED BY               
*                                                                               
SYSRBM   TEXT     ' RBM    '        NAME IN MAPBREAK FOR A RBM SYSTEM           
*                                                                               
*                                                                               
*                                                                               
*        NAMES USED FOR PROCESSING AN 'RBM' SYSTEM MAP.                         
*                                                                               
RBMOLAY  TEXT     'TERM    '        LAST OVERLAY NAME IN RBM                    
         PAGE                                                                   
         SPACE    2                                                             
M4       DATA     X'0000000F'       SINGLE HEX DIGIT MASK                       
*                                                                               
*                                                                               
LISTSW   DATA     0                 0 => DO NOT LIST INPUT; 1 => LIST           
PAGESIZE DATA     35                COMPUTED MAX DATA LINES PER PAGE            
LINESPP  DATA     35                LINES OF DATA PER PAGE                      
*                                                                               
RETURNSW DATA     1         RETURN CODE SWITCH:                                 
*                                   0 => ERROR IN MAP PROCESSING                
*                                   1 => NO ERRORS                              
*                                                                               
*                                                                               
*                                                                               
CARDIMAG RES      20                INPUT CARD IMAGE                            
CARDEND  TEXT     '    '            END OF IMAGE; INSURE BLANKS                 
         PAGE                                                                   
         SPACE    2                                                             
        DO       (#SYSTEM='CP-V')                                               
*                                                                               
,OPENFPT  M:OPEN,L    F:X3,(ERR,OPENERR),(ABN,OPENERR)                          
*                                                                               
,READFPT  M:READ,L    F:X3,(ERR,READERR),(ABN,READERR),(SIZE,80),;              
                          (BUF,CARDIMAG),(WAIT)                                 
*                                                                               
,REWFPT   M:REW,L     F:X3                                                      
*                                                                               
,CLOSEFPT M:CLOSE,L  F:X3,(SAVE)                                                
         PAGE                                                                   
         SPACE    2                                                             
        ELSE     (#SYSTEM='CP-R')                                               
         PAGE                                                                   
         SPACE    2                                                             
*                                                                               
OPENFPT  M:OPEN,FPT    F:X3,(ERR,OPENERR),(ABN,OPENERR),TYPE2                   
*                                                                               
READFPT  M:READ,FPT   F:X3,(ERR,READERR),(ABN,READERR),(SIZE,80),;              
                  (BUF,CARDIMAG),TYPE2,WAIT                                     
*                                                                               
REWFPT   M:REW,FPT    F:X3,(ERR,REWINDER),(ABN,REWINDER),TYPE2,WAIT             
*                                                                               
CLOSEFPT M:CLOSE,FPT  F:X3,(ERR,CLOSERR),(ABN,CLOSERR)                          
*                                                                               
*                                                                               
        FIN                                                                     
         PAGE                                                                   
         SPACE    2                                                             
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                           TABLEOUT ROUTINE DATA                               
*                                                                               
#PRTCOLS DATA     #PRNTPOS          NUMBER OF PRINT COLS TO USE                 
NUMCOLS  DATA     #COLS             COLUMNS PER PAGE                            
NUMROWS  DATA     0                 ROWS PER PAGE  (35 MAX)                     
NUMITEMS DATA     0                 NUMBER OF ITEMS YET TO PRINT                
OUTSUB   DATA     MAPENTRY          ROUTINE TO PROCESS AN ENTRY                 
HEADER   DATA     0                 ADDRESS OF MAP TITLE LINE                   
*                                                                               
*                                                                               
SPC0     EQU      %-1      START PRINT COLUMN WITH ITEM (SPCN)                  
SPC1     RES      12                MAX OF 12 COLUMNS                           
*                                                                               
*                                                                               
PC0      EQU      %-1      NEXT ITEM TO PRINT IN COLUMN                         
PC1      RES      12                                                            
*                                                                               
*                                                                               
SCP0     EQU      %-1       START COLUMN POINTER FOR COULMN                     
         RES      12                                                            
         PAGE                                                                   
         SPACE    2                                                             
MAPHEAD  TEXTC    'SYSGEN MAP -  '                                              
QPAGEQ   TEXTC    'PAGE '           PAGE NUMBER TEXT                            
PROLAYA  TEXTC    ' TABLES AND DATA',;                                          
                  '  -  ORDERED BY NAME '                                       
PROLAYN  TEXTC    ' TABLES AND DATA',;                                          
                  '  -  ORDERED BY ADDRESS'                                     
OLAYIDS  TEXTC    ' OVERLAY NAMES AND IDS',;                                    
                  '  -  ORDERED BY ID NUMBER '                                  
OLAYIDSN TEXTC    ' OVERLAY NAMES AND IDS',;                                    
                  '  -  ORDERED BY NAME '                                       
OLAYENTI TEXTC    ' OVERLAY ENTRY POINTS',;                                     
                  '  -  ORDERED BY ID NUMBER '                                  
OLAYENTA TEXTC    ' OVERLAY ENTRY POINTS AND ID NUMBERS',;                      
                  '  -  ORDERED BY NAME '                                       
OLAYENTN TEXTC    ' OVERLAY ENTRY POINTS AND ID NUMBERS',;                      
                  '  -  ORDERED BY ADDRESS'                                     
OLAYEXIT TEXTC    ' OVERLAY EXIT POINTS',;                                      
                  '  -  ORDERED BY NAME '                                       
UNDEFED  TEXTC    ' UNDEFINED ENTRY/EXIT POINTS '                               
MAPLIMS  TEXTC    '      MONITOR ADDRESSES AND SYSGEN TABLE SIZES'              
*                                                                               
OMAP1    TEXTC    'DEC  HEX  OVERLAY -LEN/     ',;                              
                  'DEC  HEX  OVERLAY -LEN/     ',;                              
                  'DEC  HEX  OVERLAY -LEN/     ',;                              
                  'DEC  HEX  OVERLAY -LEN/     '                                
*                                                                               
OMAP1A    TEXTC    'DEC  HEX  OVERLAY ENTRY     ',;                             
                   'DEC  HEX  OVERLAY ENTRY     ',;                             
                   'DEC  HEX  OVERLAY ENTRY     ',;                             
                   'DEC  HEX  OVERLAY ENTRY     '                               
OMAP2    TEXTC    'OVLY ID   NAME      LOC     ',;                              
                  'OVLY ID   NAME      LOC     ',;                              
                  'OVLY ID   NAME      LOC     ',;                              
                  'OVLY ID   NAME      LOC     '                                
*                                                                               
DISCALOC TEXTC    ' DISC/RAD AREA ALLOCATION'                                   
         PAGE                                                                   
         SPACE    2                                                             
*                                                                               
CLSERR   TEXTC    'ERROR CLOSING FILE '                                         
*                                                                               
EARLYEND TEXTC    'END OF FILE FOUND TOO SOON: '                                
OPNERR   TEXTC    'UNABLE TO OPEN FILE '                                        
REWERR   TEXTC    'ERROR REWINDING ''MAP'' INPUT FILE'                          
ERRMSG1  TEXTC    '   R10 CODE='                                                
ERRMSG2  TEXTC    '   CAL ADDR='                                                
ERRMSG3  TEXTC    '   RET ADDR='                                                
REGMSG   TEXTC    '            REGISTERS:'                                      
FPTMSG   TEXTC    '            FPT/DCB IN ERROR:'                               
ROOTXDMP TEXTC    '  PCB AND ROOT'                                              
OLAYXDMP TEXTC    '  OVERLAY SEGMENT FOR MAP PRINT (2)'                         
RESTXDMP TEXTC    '  ROOT PART 2 AND BLOCKING BUFFERS'                          
         PAGE                                                                   
         SPACE    2                                                             
*                                   TRANSLATE TABLES                            
CXC      CNAME                                                                  
         PROC                                                                   
         LIST     0                                                             
         OPEN     I                                                             
         DO       AF(2)<0                                                       
I         DO       -(AF(2))                                                     
           DATA,1   AF(1)+I-1                                                   
           FIN                                                                  
         ELSE                                                                   
          DO       AF(2)>0                                                      
            DO1     AF(2)                                                       
            DATA,1   AF(1)                                                      
          ELSE                                                                  
           DATA,1   AF(1)                                                       
          FIN                                                                   
         FIN                                                                    
         CLOSE    I                                                             
         LIST     1                                                             
         PEND                                                                   
         PAGE                                                                   
         SPACE    2                                                             
XLATEIN  EQU      %         CONVERT EBCDIC TO INTERNAL SORT CODES               
         CXC      65,64             X'00' - X'3F'  64 ILLEGAL CHARS             
         CXC      0                 X'40'          SPACE                        
         CXC      65,9              X'41' - X'49'                               
         CXC      1,-7              X'4A' - X'50'  `.<(+|&                      
         CXC      65,9              X'51' - X'59'                               
         CXC      8,-8              X'5A' - X'61'  !%*);~-/                     
         CXC      65,8              X'62' - X'69'                               
         CXC      16,-6             X'6A' - X'6F'  ^,%ž>?                       
         CXC      65,10             X'70' - X'79'                               
         CXC      22,-6             X'7A' - X'7F'  :#@'="                       
         CXC      65                X'80'                                       
         CXC     28,-9              X'81' - X'89'  LOWER CASE A - I             
         CXC      65,7              X'8A' - X'90'                               
         CXC      37,-9             X'91' - X'99'  LOWER CASE J - R             
         CXC      65,8              X'9A' - X'A1'                               
         CXC      46,-8             X'A2' - X'A9'  LOWER CASE S - Z             
         CXC      65,23             X'AA' - X'C0'                               
         CXC     28,-9              X'C1' - X'C9'  UPPER CASE A - I             
         CXC      65,7              X'CA' - X'D0'                               
         CXC      37,-9             X'D1' - X'D9'  UPPER CASE J - R             
         CXC      65,8              X'DA' - X'E1'                               
         CXC      46,-8             X'E2' - X'E9'  UPPER CASE S - Z             
         CXC      65,6              X'EA' - X'EF'                               
         CXC     54,-10             X'F0' - X'F9'  0 - 9                        
         CXC      65,6              X'FA' - X'FF'                               
         PAGE                                                                   
         SPACE    2                                                             
         BOUND    4                                                             
*                                                                               
*                                                                               
XLATEOUT EQU      %         TRANSLATE TABLE FOR PRINTING                        
*                                   CODE TO EBCDIC                              
*                                                                               
         TEXT     ' `.<(+|&!%*);~-/^,%ž>?:#@''="',;                             
                  'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'                        
         LIST     0                                                             
         OPEN     I                                                             
I        DO      192                                                            
         DATA,1   I+63                                                          
         FIN                                                                    
         CLOSE    I                                                             
         LIST     1                                                             
         PAGE                                                                   
         SPACE    2                                                             
*        CHARACTER CODES DEFINITIONS.                                           
*                                                                               
*                                                                               
*        CHAR    CODE    CHAR    CODE    CHAR    CODE    CHAR    CODE           
*                                                                               
*        SPACE    00     UPCARROT 10       E      20       U      30            
*        CENT     01       ,      11       F      21       V      31            
*          .      02       %      12       G      22       W      32            
*          <      03     UNDERLIN 13       H      23       X      33            
*          (      04       >      14       I      24       Y      34            
*          +      05     QUESTION 15       J      25       Z      35            
*          |      06       :      16       K      26       0      36            
*          &      07       #      17       L      27       1      37            
*        BANG     08       @      18       M      28       2      38            
*          %      09       '      19       N      29       3      39            
*          *      0A       =      1A       O      2A       4      3A            
*          )      0B     QUOTES   1B       P      2B       5      3B            
*          ;      0C       A      1C       Q      2C       6      3C            
*        NOT      0D       B      1D       R      2D       7      3D            
*          -      0E       C      1E       S      2E       8      3E            
*          /      0F       D      1F       T      2F       9      3F            
*                                                                               
*                                                                               
*                                                                               
         PAGE                                                                   
         BOUND    8                                                             
         SPACE    2                                                             
MAPNAMEA DATA     12,0    TABLE TO LOOK UP NAMES OF MAJOR ADDRESSES             
         TEXT     'OVLYFWA '                                                    
         TEXT     'PATCH F '                                                    
SYSNAMEA TEXT     'RBM     '        THESE NAMES DO NOT CHANGE FROM              
SYSENDA  TEXT     'RBMEND  '        SYSTEM TO SYSTEM                            
         TEXT     'FGD.  F '                                                    
         TEXT     'BCKG. F '                                                    
*                                                                               
         TEXT     'FMBOX F '                                                    
         TEXT     'BYTSIM  '                                                    
         TEXT     'CVSIM   '                                                    
         TEXT     'DECSIM  '                                                    
         TEXT     'DELTA   '                                                    
         TEXT     'FPSIM   '                                                    
         PAGE                                                                   
         SPACE    2                                                             
MAPNAME  DATA     18,0      TABLE USED TO PRINT MAJOR ADDRESSES                 
         TEXT     'OVLYFWA '                                                    
         TEXT     'PATCHFWA'                                                    
SYSNAME  TEXT     'CPR     '                                                    
SYSEND   TEXT     'CPREND  '                                                    
         TEXT     'FGD. FWA'                                                    
         TEXT     'BKG. FWA'                                                    
*                                                                               
         TEXT     'FMBOX   '                                                    
         TEXT     'BYTSIM  '                                                    
         TEXT     'CVSIM   '                                                    
         TEXT     'DECSIM  '                                                    
         TEXT     'DELTA   '                                                    
         TEXT     'FPSIM   '                                                    
         PAGE                                                                   
         SPACE    2                                                             
*                          SYSGEN TABLE SIZES                                   
*                                                                               
*                                                                               
         TEXT     'TABLES  '                                                    
         TEXT     'REF/DEFS'                                                    
         TEXT     'OVERLAYS'                                                    
         TEXT     'ENTRYS  '                                                    
         TEXT     'EXITS   '                                                    
         TEXT     ' UNDEF''D'                                                   
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
MAPINFO  EQU      %-1                                                           
*                                                                               
OLAYFWA  DATA     0                 ADDR OF OVERLAY AREA                        
PATCHFWA DATA     0                 ADDR OF PATCH AREA                          
MONSTART DATA     0                 ADDR OF MONITOR START                       
MONEND   DATA     0                 ADDR OF MONITOR END                         
         RES      8                 REST OF THE VARIOUS ADDRESSES               
*                                                                               
*                                                                               
*                          SIZES OF SYSGEN TABLES                               
*                                                                               
*                                                                               
TABLSCNT DATA     0                 ENTRYS IN TABLE PART                        
REFDEFS  DATA     0                 NUMBER OF REFS AND DEFS                     
OVLYCNT  DATA     0                 NUMBER OF OVERLAYS                          
ENTRYCNT DATA     0                 NUMBER OF ENTRY POINTS (INCL OVLY)          
EXITCNT  DATA     0                 NUMBER OF EXIT POINTS                       
UNDEFCNT DATA     0                 NUMBER OF UNDEFINED EXITS                   
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
REGSAVE  RES      16                SAVED REGISTERS ON ERRORS                   
         PAGE                                                                   
         BOUND    8                                                             
         SPACE    2                                                             
NAMES    DATA     0,0               LENGTH OF TABLE                             
         RES,8    #ITEMS          SYMBOL FROM SYSTEM'S MAP                      
*                                                                               
*                                                                               
MAPADDRS DATA     0                 TEMP LENGTH OF TABLE                        
         RES      #ITEMS          ADDRESS/VALUE FOR SYMBOL IN 'NAMES'           
*                                                                               
*                                                                               
*                                                                               
INDEX    DATA     0                 TEMP FOR LINE IMAGE POINTER                 
         RES      #ITEMS          INDEX/OTHER VALUE FOR 'SYMBOL'                
         TITLE    'PRINT SYSTEM CODE '                                          
         SPACE    2                                                             
*%BEGIN  CODE DEFS                                                              
*                                                                               
*                                                                               
*                                                                               
*%         PAGE                                                                 
         SPACE    3                                                             
         OPEN     R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15         
         OPEN     %EXIT,%CP,%PL,%PLLEN,%TEMP,%TEMPEND,%%:#DIG,%OPENSW           
         OPEN     %:1,%:1A,%:2,%:3,%:4A,%:4,%:4B,%:5,%:5A,%:5B,%:6              
         OPEN     %:7,%:7A,%:7B,%:73600,%:760,%:7TEMP                           
         OPEN     %:8,%:8A,%:8B,%:8C,%:8D,%:8E,%:8F,%:9,%:9A,%:9B,%:9C          
         OPEN     %:10,%:10A,%:10B,%:10C,%:10D,%:10E,%:10F,%:10G,%:10H          
         OPEN     %:10I,%:10J,%:10K,%:10L,%:10M,%:10N,%:10P                     
         OPEN     %10BEG,%10END,%10REL,%10INDNT,%10DUP,%10ROUND,%10MASK         
         OPEN     %10XLATE,%10PAG,%10RETSW,%10TRAP,%:10U,%:10V,%:10W            
         OPEN     %:10X,%10UNMAP,%10WORDS                                       
         OPEN     %10CPHEX,%10CPSR1,%10CPSR2,%10CPABS                           
         OPEN     %:11,%:11A,%LODCB                                             
         OPEN     %:12A,%:12B,%:12C,%:12D,%:12E,%:12F,%:12G,%:12H,%:12I         
         OPEN     %:12W,%:12,%:12X,%:12E1,%:12BLIN,%UP,%:14,%:15,%:16           
         OPEN     %:18,%:18A,%:18B,%:18C,%:18D,%:18E,%:18F,%:18H                
         OPEN     %:18MED,%:18X6,%:18X4,%:18X3,%:18X2,%:18X1,%:18X0             
         OPEN     %:18ALT,%:18USER,%:18DCB,%:18OPEN,%:18UP,%:18LINS             
         OPEN     %:18PAGN,%:18M:LO,%:18DEL,%:18NDEL                            
         OPEN     TRM,PUSH,PULL        SAVE OLD PROC DEFS                       
         PAGE                                                                   
         SPACE    3                                                             
R0       EQU       0                                                            
R1       EQU       1                                                            
R2       EQU       2                                                            
R3       EQU       3                                                            
R4       EQU       4                                                            
R5       EQU       5                                                            
R6       EQU       6                                                            
R7       EQU       7                                                            
R8       EQU       8                                                            
R9       EQU       9                                                            
R10      EQU      10                                                            
R11      EQU      11                                                            
R12      EQU      12                                                            
R13      EQU      13                                                            
R14      EQU      14                                                            
R15      EQU      15                                                            
         PAGE                                                                   
         SPACE    2                                                             
PUSH     CNAME    1,(#SYSTEM='CP-V')  PUSH REGISTERS INTO STACK                 
PULL     CNAME    0,(#SYSTEM='CP-V')  PULL REGISTERS FROM STACK                 
         PROC                                                                   
         DO       NUM(AF)=1         SAVE ONLY ONE REGISTER                      
LF(1)    GEN,1,7,4,20    NAME(2),X'8'+NAME(1),AF(1),U:PCB                       
         ELSE     NUM(AF)>1         SAVE MULTIPLE REGISTERS                     
LF(1)    LCI      AF(1)&X'F'                                                    
         GEN,1,7,4,20     NAME(2),X'A'+NAME(1),AF(2),U:PCB                      
         FIN                                                                    
         PEND                                                                   
*                                                                               
*                                                                               
*                                                                               
TRM      CNAME                                                                  
         PROC                                                                   
         DO       NUM(AF)=1                                                     
LF(1)    BAL,14   AF(1)                                                         
         ELSE                                                                   
LF(1)    BAL,AF(2) AF(1)                                                        
         FIN                                                                    
         PEND                                                                   
         PAGE                                                                   
         SPACE    2                                                             
*%%DEFS    CNAME                                                                
*%         PROC                                                                 
*%        DO        (SCOR(AF(1),INTERNAL,CODE,EXPAND,GEN))=0                    
*%         REF      %0,%1,%2,%3,%4,%5,%6,%7,%8,%9                               
*%         REF      %10,%11,%12,%14,%15,%16,%18,%19                             
*%         SPACE    1                                                           
*%        ELSE                                                                  
*%         TITLE    '     % R O U T I N E   D E F S   A N D   R E F S '         
*%         SPACE    2                                                           
*%         DEF      %0,%1,%2,%3,%4,%5,%6,%7,%8,%9                               
*%         DEF      %10,%11,%12,%14,%15,%16,%18,%19                             
*%         REF      M:LO                                                        
*%         DEF      F:ALTLO           ALTERNATE OUTPUT FILE DCB                 
         TITLE    '         %   D E F I N I T I O N S'                          
         SPACE    2                                                             
%0       DATA     %PL               LOCATION OF CURRENT PRINT LINE              
*                                                                               
         DATA     %CP               LOCATION OF CHARACTER POINTER               
*                                                                               
*                                                                               
%1       B        %:1       CLEAR THE PRINT LINE                                
%2       B        %:2       SET CP                                              
%3       B        %:3       STEP CP                                             
%4       B        %:4       STORE CHARACTER                                     
%5       B        %:5       STORE TEXT STRING                                   
%6       B        %:6       STORE TEXTC STRING                                  
%7       B        %:7       STORE TIME                                          
%8       B        %:8       CONVERT AND STORE INTEGER                           
%9       B        %:9       ENTER DATE                                          
%10      B        %:10      HEXDUMP MEMORY                                      
%11      B        %:11      PRINT PRINT LINE                                    
%12      B        %:12      PRINT PRINT LINE, UPSPACE CONTROL                   
         DATA   0 %:13      PAGE PRINTER AND OUT HEADER IF ANY                  
%14      B        %:14      PAGE PRINTER AND PRINT THE PRINT-LINE               
%15      B        %:15      PRINT A TEXT STRING                                 
%16      B        %:16      PRINT A TEXTC STRING                                
         DATA     0                 %17                                         
*%%18      B        %:18      REDIRECT THE M:LO DCB                             
         PAGE                                                                   
         SPACE    2                                                             
%19      DATA     0      %19+0      SWITCH, CLEAR LINE AFTER PRINT              
         DATA     0      %19+1      ROUTINE NAME, PRE-OUTPUT PROCESSOR          
         DATA     1      %19+2      SWITCH, OUTPUT DESTINATION                  
*                                   SWITCH = 0  => NO OUTPUT                    
*                                   SWITCH = 1  => PRINTER ONLY                 
*                                   SWITCH = 2  => CONSOLE ONLY                 
*                                   SWITCH = 3  => BOTH                         
         DATA     0      %19+3      LINES PRINTED PER PAGE                      
         DATA     0      %19+4      LOCATION OF PAGE HEADER LINE                
         DATA     0      %19+5      CP FOR ENTERING PAGE NUMBER                 
         DATA     0      %19+6      PAGE NUMBER OF NEXT PAGE                    
         DATA     0      %19+7      SPARE                                       
         DATA     0      %19+8      SPARE                                       
         DATA     0      %19+9      SPARE                                       
*                                                                               
*                                                                               
         RES      10                ROOM FOR MORE FUNCTIONS                     
         PAGE                                                                   
         SPACE    3                                                             
*                                                                               
         BOUND    8                                                             
*                                                                               
*                                                                               
%UP      DATA     0         LINES TO UPSPACE BEFORE PRINTING NEXT LINE          
%CP      DATA     1                 CHARACTER POINTER FOR %:0 PL                
%PL      RES      34                PRINT LINE                                  
%PLLEN   EQU      132               MAX VALUE OF %CP,  PRINT LINE               
*                                                                               
*                                                                               
%TEMP    RES      8                 CONVERSION WORKSPACE (%:8)                  
%TEMPEND EQU      %                END OF TEMP WORKSPACE                        
*                                                                               
*                                                                               
%%:#DIG  EQU      (%TEMPEND-%TEMP)*4    MAX # DIGITS IN AN INTEGER              
*                                                                               
*                                                                               
%:7TEMP  DATA     0,0               DOUBLE WORD TEMP                            
*                                                                               
*                                                                               
%OPENSW  DATA     0                 PRINT FILE NOT YET OPENED                   
*                                                                               
%LODCB   DATA     M:LO              ADDRESS OF CURRENT OUTPUT DCB               
         TITLE    '          C L E A R   P L  /  S E T   C P '                  
***********************************************************************         
*                                                                               
*                            C L E A R   T H E   P R I N T   L I N E            
*                                                                               
*                                                                               
%:1      RES      0         CLEAR PRINT LINE                                    
         PUSH     7,R14             SAVE WORKING REGISTERS                      
%:1A     LI,R1    %PLLEN            NUMBER OF WORDS TO BLANK                    
         LI,R15   ' '                                                           
         STB,R15  *%0,R1            BLANK IT 4 CHARACTERS AT A TIME             
         BDR,R1   %-1                                                           
         LI,R1    1                 SET %CP  TO COLUMN 1                        
         STW,R1   *(%0+1)           SET THE CP TO 1ST CHAR, CHAR 0              
*                                                                               
%EXIT    EQU      %         NORMAL EXIT FROM MOST ROUTINES                      
         PULL     7,R14                                                         
         B        *R14              RETURN                                      
***********************************************************************         
*                                                                               
*                            S E T   C P   T O   (15)                           
*                                                                               
*                                                                               
%:2      RES      0         SET CP TO (15)                                      
         CI,R15   %PLLEN            AT OR BEYOND END OF LINE ?                  
         BG       %+3                 YES, SET AT BEGINNING                     
         CI,R15   1                 BEFORE BEGINNING ?                          
         BGE      %+2                 NO, OK                                    
         LI,R15   1                 SET AT FIRST CHARACTER                      
         STW,R15  *(%0+1)           SET POINTER                                 
         B        *R14              RETURN WITH CP SET                          
         TITLE    '          S T E P   C P   /  S T O R E   C H A R'            
***********************************************************************         
*                                                                               
*                            S T E P   C P   B Y   (15)                         
*                                                                               
*                                                                               
%:3      RES      0         STEP CP BY (15)                                     
         AW,R15   *(%0+1)           ADD CURRENT POINTER TO GET NEW              
         B        %:2               SET TO THAT VALUE, WITH TESTS               
***********************************************************************         
*                                                                               
*                            S T O R E   C H A R   I N   (15)  I N   P L        
*                                                                               
*                                                                               
%:4A     PUSH     R14               SAVE RETURN ADDRES                          
         TRM      %:11              PRINT CURRENT LINE                          
         PULL     R14               RECOVER RETURN ADDRESS                      
         B        %:4B              AND RE-ENTER STORE CHAR LOOP                
*                                                                               
%:4      RES      0         STORE CHARACTER INTO PRINT LINE                     
         PUSH     R1                SAVE WORK REGISTER                          
%:4B     LW,R1    *(%0+1)           FETCH CURRENT CP                            
         BLEZ     %:4A              IF CP < 1, PRINT LINE NOW                   
         CI,R1    %PLLEN            IS LINE AT END ?                            
         BG       %:4A                YES, PRINT CURRENT LINE FIRST             
*                                                                               
         STB,R15  *%0,R1            STORE THE CHARACTER                         
         MTW,+1   *(%0+1)           STEP CP TO NEXT CHARACTER                   
         PULL     R1                RESTORE THE WORK REGISTER                   
         B        *R14              RETURN                                      
         TITLE    '          S T O R E   S T R I N G ,   T E X T C'             
*                                                                               
*                                                                               
*                                                                               
%:5      RES      0         STORE TEXT FORM STRING IN PRINT LINE                
         PUSH     7,R14             SAVE REGISTERS                              
%:5A     XW,R1    R0                CHANGE GET INDEX, CHAR COUNT                
*                                                                               
%:5B     LB,R15   *R2,R1            FETCHA CHARACTER                            
         TRM      %:4               STORE IT                                    
         AI,R1    1                 STEP FETCH POINTER                          
         BDR,R0   %:5B              STEP COUNT AND LOOP IF MORE                 
         B        %EXIT             RETURN                                      
*                                                                               
*                                                                               
*                                                                               
%:6      RES      0         STORE TEXTC FORM STRING IN LINE                     
         PUSH     7,R14             SAVE REGISTERS                              
         LB,R1    *R2               FETCH COUNT TO STORE                        
         LI,R0    1                 SET INDEX OF 1ST IN 1ST WORD                
         B        %:5A              ENTER %:5 LOOP                              
         TITLE    '          S T O R E   (15)  A S   T I M E '                  
*                                                                               
*                                                                               
*                                                                               
%:7      RES      0         STORE (15) AS TIME IN PRINT LINE                    
         PUSH     7,R14             SAVE REGISTERS                              
         LW,R1    R15               COPY AND TEST NUMBER OF SECS                
         BGEZ     %:7A              POSITIVE, SO OK                             
         LI,R15   '-'               NEGATIVE, ENTER MINUS SIGN                  
         TRM      %:4                                                           
%:7A     LAW,R15  R1                SET ABSOLUTE VALUE                          
         LI,R14   0                 CLEAR LEFT HALF OF NUMBER                   
         DW,R14   %:73600           COMPUTE NUMBER OF HOURS                     
         STW,R14  %:7TEMP+1         SAVE MINUTES, SECS                          
         LI,R0    10                ENTER IN PRINT LINE IN DECIMAL              
         LI,R1    '0'               WITH LEADING ZEROS                          
         LI,R2    2                 IN A 2 PLACE FIELD                          
         TRM      %:8                                                           
         LI,R15   ':'               ENTER THE COLON                             
         TRM      %:4                                                           
         LD,R14   %:7TEMP           FETCH MIN, SEC; CLR LEFT HALF               
         DW,R14   %:760             COMPUTER MINUTES                            
         STW,R14  %:7TEMP+1         SAVE SECONDS                                
         TRM      %:8               ENTER THE MINUTES                           
         LI,R15   ':'               AND THE COLON                               
         TRM      %:4                                                           
         LW,R15   %:7TEMP+1         FETCH SECONDS                               
         TRM      %:8               ENTER THEM                                  
         B        %EXIT             RETURN                                      
*                                                                               
%:73600  DATA     3600              SECONDS PER HOUR                            
%:760    DATA     60                SECONDS PER MINUTE                          
         TITLE    '          S T O R E   I N T E G E R'                         
*                                                                               
*                                                                               
*                                                                               
%:8      RES      0         CONVERT AN INTEGER TO DEC/HEX NUMBER                
         PUSH     7,R14             SAVE SOME REGISTERS                         
         AI,R2    -%%:#DIG          ADJUST FOR INTERNAL COUNTING                
         LI,R3    %%:#DIG-1         SET MAX DIGITS TO GENERATE                  
%:8A     LI,R14   0                 STRIP OFF HIGH ORDER DIGITS                 
         DW,R14   R0                ACCORDING TO BASE IN R0                     
         STB,R14  %TEMP,R3          1 AT A TIME AND SAVE                        
         BDR,R3   %:8A              UNTIL ALL ARE DONE                          
         STB,R15  %TEMP             SAVE LAST DIGIT                             
*                                                                               
         LI,R3    -%%:#DIG          SET LOOP COUNT FOR CONVERSION               
*                                                                               
%:8B     RES      0         PROCESS EACH DIGIT, TEST FOR 0, LEADING             
*                                   ZERO/CHAR, SIGNIFICANCE, ETC                
         LB,R15   %TEMPEND,R3       FETCH NEXT DIGIT FROM LEFT                  
         CI,R15   0                 A ZERO ?                                    
         BNEZ     %:8C                NO, SET SIGNIFICANCE, OUT IT              
         CI,R3    -1                ON LAST DIGIT ?                             
         BE       %:8C                YES, INSURE A PRINTABLE CHAR              
         CI,R2    0                   YES, HAVE SIG YET ?                       
         BGE      %:8D                YES, OUT DIGIT                            
         B        %:8F                NO, SKIP IT                               
*                                                                               
%:8C     LAW,R2   R2                DIGIT FOUND; SET SIGNIFICANCE               
         LI,R1    '0'               AND ZEROS = 0'S                             
%:8D     OR,R15   R1                INSERT LEADING ZERO/FILLER                  
         CI,R15   X'FA'             HEX DIGIT ?                                 
         BL       %:8E                NO, NORNAL DECIMAL                        
         AI,R15   -(X'FA'-X'C1')      YES, ADJUST -X'39'                        
%:8E     BAL,R14  %:4               OUT THE CHARACTER                           
%:8F     AI,R2    1                 STEP SIGNIFICANCE COUNTER                   
         BIR,R3   %:8B              GET NEXT DIGIT IF ANY MORE                  
         B        %EXIT             RETURN                                      
         TITLE    '          E N T E R   D A Y S   D A T E'                     
*                                                                               
*                                                                               
*                                                                               
%:9      RES      0         GET AND ENTER TODAY'S DATE IN PRINT LINE            
         PUSH     7,R14             SAVE REGISTERS                              
         CAL1,8   %:9B              GET DATE AND FUNNY TIME                     
         LI,R0    2                 SET POS OF 1ST CHAR IN LAST WRD             
         LI,R1    2                 OUT ONLY 2 CHARS, THE YEAR                  
         LI,R2    %:9C+3            FROM THE LAST WORD                          
         TRM      %:5               ENTER                                       
*                                                                               
%:9A     LI,R0    1                 SET TO GET ' MON DD'                        
         LI,R1    7                 GET THE 7 CHARS ' MON DD'                   
         LI,R2    %:9C+1            FROM THE 1ST WRD FF                         
         B        %:5A              ENTER THE STRING AND EXIT                   
*                                                                               
%:9B     GEN,8,24 X'10',%:9C        FPT CODE, LOC OF TEXT BUFFER                
%:9C     TEXT     'HH:MM JAN 04,"74'                                            
         TITLE    '         M E M O R Y   D U M P'                              
*                                                                               
*                                                                               
*                                                                               
%:10     RES      0         PRINT MEMORY FROM (0) TO (1) REL TO (2)             
         PUSH     8,R14                                                         
         M:TRAP   %10TRAP,(TRAP,NAO)    TRAP BAD ADDRESSES                      
         AND,R0   %10ROUND          ROUND START DOWN TO MULTIPLE OF 8           
         AND,R1   %10MASK           MASK OFF NON-ADDRESS PART OF                
         AND,R2   %10MASK           INPUT ADDRESSES                             
         CW,R0    R1                ANYTHING TO DUMP AT ALL ?                   
         BG       %:10P               NO, EXIT NOW                              
*                                                                               
         STW,R0   R4                SAVE LIMITS, RELATIVE VALUES                
         STW,R1   %10END                                                        
         STW,R2   %10REL                                                        
         TRM      %:11              PRINT LINE TO CLEAR, RESET CP               
         LI,R2    %10HDR            OUT COLUMN HEADERS                          
         TRM      %:16              PRINT TEXTC STRING                          
         B        %:10F             ENTER MAIN PRINT LOOP                       
*                                                                               
*                                                                               
%:10A    RES      0         TEST FOR AND DON'T PRINT DUPLICATE LINES            
         LI,R15   %:10D-1           SET TRAP RETURN ADDRESS                     
         STW,R15  %10RETSW                                                      
         LW,R3    R4                COPY START LOC OF NEXT LINE                 
         LI,R0    -1                SET DUP LINE COUNTER                        
         LW,R2    %19+3             HOW MANY LINES LEFT ON PAGE ?               
         CI,R2    2                 AT LEAST TWO ?                              
         BGE      %:10B               NOT END OF PAGE, CONTINUE                 
*                                                                               
         LI,R2    %10HDR            OUT COLUMN HEADERS ON NEW PAGE              
         TRM      %:6               ENTER LINE FO`IRST                          
         TRM      %:14              PRINT ON A NEW PAGE                         
*                                                                               
%:10B    AI,R3    8                 STEP TO START OF NEXT LINE                  
         CW,R3    %10END            GOING OFF END OF DUMP ?                     
         BGE      %:10D               YES, ALWAYS PRINT LAST LINE               
*                                                                               
         LI,R2    -8                SET NUMBER OF WORDS PER LINE                
%:10C    LW,R15   *R3,R2            TEST IF LINE IS A DUPLICATE                 
         CW,R15   *4,R2             I.E., EACH WRD = WRD-8                      
         BNE      %:10D               NO, NOT A DUP                             
         BIR,R2   %:10C             ELSE TEST NEXT WORD                         
         AI,R0    +1                STEP DUP LINE COUNT                         
         B        %:10B             AND TEST NEXT LINE                          
         PAGE                                                                   
*                                                                               
*                                                                               
%:10D    RES      0          END OF DUP LINES: BACK TO NEXT TO PRINT            
         AI,R3    -8                POINT AT START OF LINE TO PRINT             
         LI,R15   %:10U-1           RESET TRAP RETURN TO NORMAL                 
         STW,R15  %10RETSW                                                      
         MTW,+00  R0                AT LEAST TWO DUPLICATE LINES ?              
         BLEZ     %:10F               NO, PRINT NORMALLY                        
         LI,R2    %10DUP            POINT AT DUPLICATION MSG                    
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
%:10E    RES      0         ENTER DUP/UNALLOC MESSAGE                           
         LI,R15   %10INDNT          SET MESSAGE INDENTATION                     
         TRM      %:2               START AT END OF ADDRESS FIELD + 1           
         TRM      %:6               ENTER 1ST PART                              
         LI,R2    %10WORDS          THEN ENTER COMMOM PART                      
         TRM      %:6                                                           
         LI,R15   %10INDNT+10       ENTER START LOC                             
         TRM      %:2                                                           
         LW,R15   R4                                                            
         LI,R0    16                                                            
         LI,R1    '0'                                                           
         LI,R2    5                                                             
         TRM      %:8               ENTER                                       
         LI,R15   %10INDNT+19                                                   
         TRM      %:2               ENTER END LOC IN ITS PLACE                  
         LW,R15   R3                                                            
         AI,R15   -1                ADJUST DOWN TO ACTUAL ADDR                  
         TRM      %:8               ENTER IT                                    
         LI,R15   %10INDNT+57       ENTER NUMBER OF WORDS IN HEX                
         TRM      %:2                                                           
         LW,R15   R3                                                            
         SW,R15   R4                                                            
         TRM      %:8                                                           
         LI,R15   %10INDNT+50       POINT AT DEC LENGTH SLOT                    
         TRM      %:2                                                           
         LW,R15   R3                                                            
         SW,R15   R4                                                            
         LI,R0    10                DECIMAL,                                    
         LI,R1    ' '               WITH LEADING BLANKS,                        
         LI,R2    5                 FOR 5 DIGITS                                
         TRM      %:8               ENTER LENGTH IN DECMAL                      
         LW,R4    R3                SET NEW START ADDRESS FOR NEXT LINE         
         B        %10Q              GO PRINT LINE; TEST END CONDITIONS          
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
%:10F    RES      0         CONVERT NEXT LINE AND PRINT IT                      
         STW,R4   %10BEG            SET WHERE THIS LINE STARTS                  
         LI,R15   %10CPHEX          SET START COLUMN FOR HEX OUTPUT             
         TRM      %:2                                                           
         LI,R5    8                 SET NUMBER OF WORDS PER LINE                
*                                                                               
%:10H    RES      0         FIND NEXT WORD TO ENTER INTO THE LINE               
         CW,R4    %10END            AT END OF DUMP ?                            
         BG       %:10L               YES, ENTER GRAPHICS                       
*                                                                               
         LI,R15   2                 SPACE 2 SPACES BEFORE THE WORD              
         CI,R5    3                 STARTING A GROUP OF 4 ?                     
         BANZ     %:10I               NO, IN A GROUP                            
         AI,R15   1                   YES, SKIP 3 SPACES                        
%:10I    TRM      %:3               SKIP CP AHEAD                               
         LI,R2    8                 SET TO UNPACK 8 DIGITS                      
         LW,R1    *R4               FETCH WORD TO UNPACK                        
*                                                                               
*                           UNPACK A WORD INTO THE LINE                         
%:10J    LI,R0    0                 CLEAR EVEN HALF OF REG PAIR                 
         SLD,R0   4                 SHIFT A DIGIT INTO REG 0                    
         AI,R0    X'F0'             MAKE A DIGIT                                
         CI,R0    X'F9'             IS IT A DECIMAL DIGIT ?                     
         BLE      %:10K               YES, PRINT AS IS                          
         AI,R0    -(X'FA'-X'C1')    CONVERT TO HEX DIGIT 'A',...                
%:10K    LW,R15   R0                COPY DIGIT TO OUTPUT REG                    
         TRM      %:4               OUT THE DIGIT'S CHAR                        
         BDR,R2   %:10J             LOOP FOR NEXT                               
         AI,R4    1                 AND STEP TO NEXT                            
         BDR,R5   %:10H             DO NEXT IF LINE NOT FULL                    
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
%:10L    LI,R15   %10CPSR1          SET CP TO START OF GRAPHICS                 
         TRM      %:2               AREA                                        
         LI,R15   '*'               AND ENTER THE START '*'                     
         TRM      %:4                                                           
         LW,R2    %10BEG            SET LOC OF 1ST WORD OF LINE                 
         SW,R2    R4                COMPUTE NUM OF BYTES IN LINE                
         SLS,R2   2                 -( (LAST-FIRST)*4 )                         
*                                                                               
%:10M    LI,R15   '.'               SET GRAPHIC FOR NON-GRAPHIC                 
         LB,R1    *R4,R2            FETCH CHARACTER TO BE PRINTED               
         CI,R1    X'40'             IS IT NON-PRINTABLE ?                       
         BAZ      %:10N               YES, USE THE '.' IN REG 15                
         CI,R1    X'C0'             A LETTER OR DIGIT COLUMN ?                  
         BL       %+2                 NO,ASSUME SPECIAL GRAPHIC COL             
         AI,R1    -X'C0'            ADJUST TO 1ST TO COLS                       
         LB,R15   %10XLATE,R1       AND TRANSLATE TO ITS PRINTABLE              
%:10N    TRM      %:4               ENTER GRAPHIC CHAR IN LINE                  
         BIR,R2   %:10M             LOOP FOR NEXT                               
*                                                                               
         LI,R15   %10CPSR2          SET TO END OF GRAPHICS                      
         TRM      %:2                                                           
         LI,R15   '*'               AND ENTER THE RIGHT '*'                     
         TRM      %:4               TO SURROUND THE GRAPHICS                    
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
         LI,R15   %10CPABS          SET START COLUMN FOR ABSOLUTE ADDRESS       
         TRM      %:2                                                           
         LW,R15   %10BEG            COPY FOR PRINTING                           
         LI,R0    16                SET HEX,                                    
         LI,R1    '0'               LEADING ZEROS,                              
         LI,R2    5                 FOR 5 DIGITS, WE                            
         TRM      %:8               ENTER START ADDRESS                         
         LI,R15   ' '               SET SEPARATOR CHAR                          
         TRM      %:4               ENTER A SPACE BETWEEN ADDRESSES             
         LW,R5    %10BEG            COMPUTE RELATIVE ADDRESS                    
         SW,R5    %10REL                                                        
         BGEZ     %:10G             IF > 0 , THEN PRINT AS IS                   
         LI,R15   '-'               ELSE ENTER '-', ABS OF ADDR                 
*                                                                               
*                                                                               
%:10G    TRM      %:4               ENTER SEPARATOR CHAR                        
         LAW,R15  R5                SET ADDRESS TO PRINT                        
         TRM      %:8               ENTER RELATIVE ADDRESS                      
*                                                                               
%10Q     TRM      %:11              PRINT THE LINE                              
         CW,R4    %10END            HAVE WE PROCESSED LAST WORD ?               
         BLE      %:10A               NO, DO ANOTHER LINE                       
*                                                                               
%:10P    RES      0         END OF DUMP; RESET SYSTEM AND EXIT                  
         M:TRAP   (ABORT,NAO)                                                   
         PULL     8,R14             RECOVER REGISTERS                           
         B        *14                                                           
         PAGE                                                                   
         SPACE    2                                                             
%:10U    RES      0         SCAN TO FIND NEXT ALLOCATED PAGE                    
         LW,R3    R4                COPY ADDRESS THAT IS NOT HERE               
         AND,R3   %10PAG            ROUND TO A PAGE BOUNDARY                    
         LI,R15   %:10V-1           SET NEW RETURN ADDRESS                      
         STW,R15  %10RETSW          INDICATES SCANNING PAGES                    
*                                                                               
%:10V    AI,R3    X'200'            STEP TO NEXT PAGE                           
         CW,R3    %10END            GONE PAST END OF DUMP ?                     
         BG       %:10X               YES, STOP AT THAT ADDR                    
         LW,R15   *R3               TRY TO ACCESS WORD; %:10V IF ERROR          
%:10W    RES      0         SET UP TO OUT UNALLOCATED PAGES MSG                 
         LI,R15   %:10U-1           RESET RETURN TO NORMAL ADDRESS,             
         STW,R15  %10RETSW          INDICATING DOING THE DUMP                   
         LI,R2    %10UNMAP          SET UN-ALLOCATED MESSAGE                    
         B        %:10E             PRINT MESSAGE, CONTINUE DUMP                
*                                                                               
%:10X    LW,R3    %10END            SET LAST ADDR AS END OF                     
         AI,R3    1                 UN-ALLOCATTED MEMORY                        
         B        %:10W             AND OUT MESSAGE                             
*                                                                               
*                                                                               
********************  TRAP HANDLER FOR XDUMP  *************************         
%10TRAP  LI,R3    X'1FFFF'          SET MASK FOR P-COUNTER IN PSD               
         LW,R2    %10RETSW          GET RETURN ADDRESS                          
        DO1      (#SYSTEM='CP-V')  IF IN CP-V,                                  
         AI,R2    1                 STEP P-COUNTER TO ACTUAL ADDRESS            
         STS,R2   *R1               SET IN PSD                                  
         M:TRTN                     AND TRY AGAIN                               
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
%10BEG   DATA     0                 START OF A LINE ADDRESS                     
%10END   DATA     0                 LAST WORD TO DUMP                           
%10REL   DATA     0                 RELATIVE ADDRESS                            
%10MASK  DATA     X'1FFFF'          ADDRESS MASK                                
%10ROUND DATA     X'1FFF8'         ROUND TO MULITPLE OF 8                       
%10PAG   DATA     X'1FE00'          ROUND TO A PAGE BOUNDARY                    
%10RETSW DATA     %:10U-1          RETURN ADDR FOR TRAPS                        
%10CPHEX EQU      13                START COLUMN FOR HEX MEMORY DUMP            
%10CPSR1 EQU      99                COLUMN FOR '*' BEFORE GRAPHICS              
%10CPSR2 EQU      132               COLUMN FOR '*' AFTER GRAPHICS               
%10CPABS EQU      1                 START COLUMN FOR ABSOLUTE ADDRESSES         
%10INDNT EQU      12                                                            
%10DUP   TEXTC    'LOCATIONS XXXXX TO XXXXX IDENTICAL TO ABOVE LINE.'           
%10UNMAP TEXTC    'LOCATIONS XXXXX TO XXXXX NOT MAPPED FOR PROGRAM. '           
%10WORDS TEXTC    ' DDDDD (XXXXX) WORDS.'                                       
%10HDR   TEXTC    ' ABS    REL    ',;                                           
                  '   0/8       1/9       2/A       3/B     ',;                 
                  '   4/C       5/D       6/E       7/F     ',;                 
                  '  0/8|1/9|2/A|3/B|4/C|5/D|6/E|7/F|'                          
%10XLATE TEXT     '.ABCDEFGHI.......JKLMNOPQR......'                            
         TEXT     '..STUVWXYZ......0123456789......'                            
         TEXT     ' .........`.<(+|&.........!%*);~'                            
         TEXT     '-/........^,%ž>?..........:#@''="'                           
         TITLE    '          P R I N T   T H E   P R I N T   L I N E'           
*                                                                               
*                                                                               
*                                                                               
%:11     RES      0         PRINT THE CURRENT LINE                              
         PUSH     7,R14             SAVE REGISTERS                              
%:11A    RES      0         ENTRY FOR %:15, %:16 PRINT ROUTINES                 
         LI,R15   1                 SET UPSPACE 1 LINE AFTER PRINT              
         B        %:12A             DO COMMON PRINT PROCESSING                  
*                                                                               
*                                                                               
*                                                                               
%:12     RES      0          PRINT AND UPSPACE (15)  LINES                      
         PUSH     7,R14             SAVE REGISTERS                              
*                                                                               
*                                                                               
%:12A    RES      0                                                             
         MTW,+00  %19+1             PREPROCESS THE PRINT LINE ?                 
         BEZ      %:12B               NO, JUST PROCESS                          
*                                                                               
         EXU      %19+1             CALL ON USER PREPROCESSOR                   
*                                                                               
*                                                                               
%:12B    EQU      %         OPEN M:LO IF THIS IS THE FIRST CALL                 
         LW,R2    %19+2             FETCH DESTINATION SWITCH                    
         CI,R2    1                 OUTPUT TO PRINTER ?                         
         BAZ      %:12F               NO, DON'T OPEN PRINT FILE                 
         MTW,+00  %OPENSW           IS PRINT FILE OPENED ?                      
         BGZ      %:12C               YES, PRINT NORMALLY                       
*                                                                               
*%         M:OPEN   *%LODCB,(BTD,0),(BUF,*%0)                                   
*%        DO       (#SYSTEM='CP-V')                                             
*%         M:DEVICE *LODCB,(VFC)     SET VFC ON                                 
*%         M:DEVICE *LODCB,(PAGE)   SKIP TO TOP OF A NEW PAGE SO WE CAN         
*%         M:DEVICE *LODCB,(NLINES)  GET NUMBER OF LINES PER PAGE               
*%         LW,R0    R8              COPY NUMBER OF LINES TO EXPECTED REG        
*%        ELSE     (#SYSTEM='CP-R')                                             
*%         M:VFC   *LODCB,(VFC)      SET VFC ON                                 
*%         LB,R0    K:PAGE            GET NUMBER OF LINES FROM SYSTEM CELL      
*%        FIN                                                                   
*****************************   THE FOLLOWING LINE DOES NOT GO IN THE SYSTEM    
         LW,R0    #LINES            GET NUMBER AS COMPUTED IN ROOT              
*                                                                               
*                                                                               
         STW,R0   %OPENSW           AND USE TO MARK FILE OPENED                 
         STW,R0   %19+3             SET LINES REMAINING ON PAGE                 
         PAGE                                                                   
*                                                                               
%:12C    EQU      %         OUTPUT LINE TO PRINTER (FILE)                       
         PUSH     3,R8              SAVE REGS CHANGED ON ERRORS                 
         LI,R0    0                 INIT A WORD OF ZEROES                       
         LW,R1    %UP               R1 (VFC) <= PREVIOUS UPSPACE COUNT          
         LW,R15   R15               IS UPSPACE AFTER PRINT REQUESTED?           
         BGZ      %:12E               YES, PROCESS QUICKLY                      
*                                                                               
*                           INHIBIT UPSPACE AFTER PRINT                         
         STW,R0   %UP                 NO, RESET PREVIOUS UPSPACE                
         AWM,R15  %19+3             STEP LINES PRINTED                          
         SW,R1    R15               ADD CURR UPSPACE TO PREVIOUS                
         BEZ      %:12D             TOTAL = 0 ==> OVER PRINT                    
*                                                                               
         AI,R1    X'C0'-1           UPSPACE TOTAL - 1 BEFORE PRINT              
         STB,R1   %:12BLIN          OF A BLANK LINE                             
         M:WRITE  *%LODCB,(BUF,%:12BLIN),(SIZE,4),(WAIT),;                      
                  (ERR,%:12X),(ABN,%:12X)                                       
*                                   SPACE THE N-1 BLANK LINES                   
*                                                                               
%:12D    EQU      %         SET TO PRINT LINE WITH UPSPACE INHIBITED            
         LI,R1    X'E0'             UPSPACE 0 AFTER PRINT                       
         B        %:12E1            PRINT THE USER'S LINE NOW                   
         PAGE                                                                   
         SPACE    2                                                             
%:12E    EQU      %         UPSPACE AFTER PRINT;                                
         LCW,R14  R15               DECREMENT LINES LEFT ON PAGE BY             
         AWM,R14  %19+3             LINES TO PRINT THIS TIME                    
         STW,R15  %UP               SET NEW 'PREVIOUS UPSPACE COUNT'            
         MTW,-1   %UP               -1 FOR AUTO UPSPACE AFTER PRINT             
         AI,R1    X'C0'             SET UPSPACE BEFORE PRINT CONTROL            
         CI,R15   X'F0'             PAGE CONTROL SPECIFIED ?                    
         BL       %:12E1              NO, PRINT LINE WITH GIVEN VFC             
*                                                                               
*%%               CHECKS MUST ALSO BE MADE FOR %19+3 =< 0  AND THEN             
*%%               RESET %19+3 TO %OPENSW AND FAKE A PAGE EJECT                  
*                                                                               
         STW,R0   %UP               RESET 'PREVIOUS UPSPACE' TO NONE            
         LW,R1    R15               AND SET VFC = PAGE CONTROL                  
         LW,R15   %OPENSW           RESET LINES LEFT ON PAGE                    
         STW,R15  %19+3             TO ACCOUNT FOR THIS LINE'S PRINT            
         PAGE                                                                   
         SPACE    2                                                             
%:12E1   EQU      %         SET VFC, WRITE THE LINE                             
         STB,R1   *(%0)             STORE VFC AT START OF LINE                  
         M:WRITE  *%LODCB,(BUF,*%0),(SIZE,133),(WAIT),;                         
                  (ERR,%:12X),(ABN,%:12X)                                       
         PULL     3,R8              RECOVER POSSIBLE LOST REGS                  
*                                                                               
%:12F    CI,R2    2                 TYPEWRITTER OUTPUT REQUESTED ?              
         BAZ      %:12I               NO, TEST CLEAR                            
*                                                                               
         LI,R1    %PLLEN            SET TO SEARCH FOR LAST                      
         LI,R15   ' '               NON-BLANK CHARACTER                         
*                                                                               
%:12G    CB,R15   *%0,R1            TEST CHARS FROM END OF LINE                 
         BNE      %:12H             FOUND END OF TYPE LINE                      
         BDR,R1   %:12G             TEST ANOTHER                                
*                                                                               
         LI,R1    1                 ALL BLANKS; SET 1 CHAR LONG                 
%:12H    LB,R15   *%0               SAVE VFC BYTE                               
         STB,R1   *%0               SET LENGTH FOR TYPE                         
         M:TYPE   (MESS,*%0)                                                    
         STB,R15  *%0               RESTORE VFC BYTE                            
         PAGE                                                                   
         SPACE    2                                                             
%:12I    MTW,+00  %19               ARE WE TO CLEAR THE LINE ?                  
         BEZ      %:1A                YES, DO SO                                
*                                                                               
         B        %EXIT             RETURN                                      
         SPACE    1                                                             
***********************************************************************         
*                                                                               
*        ERROR ROUTINE FOR THE PRINTER                                          
*                                                                               
%:12X    EQU      %                                                             
        DO       (#SYSTEM='CP-R')                                               
         LB,R10   R10               GET ERROR CODE                              
         CI,R10   X'30'             IS IT INOP, OPER REQ'D ?                    
         BE       %:12W               YES, WAIT A BIT                           
         CI,R10   X'4D'               OTHER INOP PROBLEM ?                      
         BNE      *R8                   NO, RETURN AND SUFFER                   
*                                                                               
%:12W    EQU      %                 WAIT A WHILE BEFORE RETRYING                
         M:STIMER (TIME,10),(WAIT),(INTVL),(IGNERR)                             
         AI,R8    -1                BACK UP TO RETRY THE CAL                    
         B        *R8               AND DO SO                                   
        ELSE     (#SYSTEM='CP-V')                                               
         B        *R8               RETURN NOW IGNORING THE ERROR               
        FIN      #SYSTEM                                                        
*                                                                               
*                           BLANK LINE FOR UPSPACING BEFORE PRINTING            
%:12BLIN TEXT     '    '            VFC BYTE, 3 BYTES OF BLANKS                 
         TITLE    '          P R I N T / P A G E   R O U T I N E S'             
*                                                                               
*                                                                               
*                                                                               
%:14     RES      0         PAGE PRINTER WITH LINE AS HEADER                    
         PUSH     7,R14             SAVE REGISTERS                              
         LI,R15   X'F1'             SET PAGE EJECT                              
         B        %:12A             AND PRINT AS USUAL                          
*                                                                               
*                                                                               
*                                                                               
%:15     RES      0          PRINT STRING OF LEN (1) AT (2)                     
         PUSH     7,R14                                                         
         TRM      %1                CLEAR PRESENT LINE                          
         TRM      %5                ENTER STRING                                
         B        %:11A             PRINT THE STRING AS USUAL                   
*                                                                               
*                                                                               
*                                                                               
%:16     RES      0          PRINT STRING                                       
         PUSH     7,R14             SAVE REGISTERS                              
         TRM      %1                CLEAR THE LINE                              
         TRM      %6                STORE THE STRING IN THE LINE                
         B        %:11A             PRINT THE STRING AS USUAL                   
         TITLE    '          R E D I R E C T   M : L O '                        
*                                                                               
*                                                                               
*                                                                               
*%%:18     EQU      %         REDIRECT THE M:LO DCB OUTPUT                      
*%*                               CERTAIN OPTIONS REQUIRE 'MEDIA'               
*%         PUSH     3,R8              SAVE REGISTERS ALTERED BY CALS            
*%         PUSH     7,R14             AND  USUAL REGISTERS                      
*%         LI,R9    0                 SET NO ERRORS FOUND                       
*%         LI,R10   0                 SET ERROR CODE TO ZERO (%:18 ERROR)       
*%         LW,R14   R0                COPY MEDIA SWITCH IF PRESENT              
*%         LW,R15   R15               DETERMINE ACTION REQUESTED                
*%         BLEZ     %:18B               RESTORE TO M:LO DCB                     
*%*                                                                             
*%*                           SET TO ALTERNATE DCB                              
*%         CW,R9    %:18USER+1        DO WE HAVE A FILE NAME YET ?              
*%         BNE      %:18A               YES, JUST SWITCH DESTINATION            
*%*                                                                             
*%         STW,R15  %:18USER+1        SET FILE NAME GIVEN                       
*%         CI,R15   1                 USE THE DCB AS DEFN'D EXTERNALLY ?        
*%         BE       %:18A               YES, DO NOT ALTER DCB                   
*%*                                                                             
*%         LCI      3                 ELSE MOVE FILE NAME                       
*%         LM,R1    *R15              TO OUR INTERNAL STORAGE                   
*%         STM,R1   %:18USER                                                    
*%*                                                                             
*%        DO       #SYSTEM='CP-R'                                               
*%*                                                                             
*%*                                                                             
*%         M:ASSIGN   F:ALTLO,(ERR,%:18X3),(FILPTR,%:18USER)                    
*%*                                                                             
*%*                                                                             
*%        ELSE     #SYSTEM='CP-V'                                               
*%         B        %:18X3            GIVE ERROR FOR NOW                        
*%        FIN                                                                   
*%*                                                                             
*%*                                                                             
*%*                                                                             
*%*                                                                             
*%%:18A    EQU      %         SET UP TO TEST, DO SWITCH                         
*%         LI,R1    %:18ALT           POINT AT NEW DEF INFO                     
*%         LI,R2    %:18M:LO          AND AT CURRENT                            
*%         LW,R0    %:18DCB,R1        GET ADDRESS OF THE DCB                    
*%         CW,R0    %LODCB            ARE WE ALREADY THERE ?                    
*%         BNE      %:18C               NO, OK TO SWITCH; DO SO                 
*%*                                                                             
*%         B        %:18X1            REPORT ERROR NUMBER 1                     
*%         PAGE                                                                 
*%         SPACE    2                                                           
*%%:18B    EQU      %         SET OUTPUT TO M:LO DCB                            
*%         LI,R1    %:18M:LO          NAME OF NEW DESTINATION                   
*%         LI,R2    %:18ALT           NAME OF OLD, REPLACED DESTINATION         
*%         LW,R0    %:18DCB,R1        GET ADDRESS OF THE DCB                    
*%         CW,R0    %LODCB            ALREADY SET THERE ?                       
*%         BE       %:18X2            YES, GIVE ERROR NUMBER 2                  
*%*                                                                             
*%%:18C    EQU      %         SWITCH OUTPUT DESTINATIONS                        
*%         STW,R0   %LODCB            SET NEW ADDRESS OF THE DCB TO USE         
*%         LW,R0    %:18OPEN,R1                                                 
*%         XW,R0    %OPENSW           SWITCH OPEN SWITCH DEFINITIONS            
*%         STW,R0   %:18OPEN,R2                                                 
*%         LW,R0    %:18UP,R1                                                   
*%         XW,R0    %UP               SWITCH SAVED UPSPACE COUNT                
*%         STW,R0   %:18UP,R2                                                   
*%         LW,R0    %:18LINS,R1                                                 
*%         XW,R0    %19+3             SWITCH LINES PRINTED THIS PAGE            
*%         STW,R0   %:18LINS,R2                                                 
*%         LW,R0    %:18PAGN,R1                                                 
*%         XW,R0    %19+6             SWITCH PAGE NUMBER                        
*%         STW,R0   %:18PAGN,R2                                                 
*%         PAGE                                                                 
*%         SPACE    2                                                           
*%         LW,R15   R15               CLOSE OUTPUT REQUESTED ?                  
*%         BGEZ     %:18H               NO, EXIT NOW                            
*%*                                                                             
*%*                           CLOSE OUTPUT DESTINATION; CLEAR NAME              
*%         MTW,+00  %:18ALT+%:18OPEN  WAS FILE OPENED ?                         
*%         BLEZ     %:18D               NO, DON'T TRY TO CLOSE                  
*%*                                                                             
*%         M:CLOSE  F:ALTLO,(ERR,%:18X4),(ABN,%:18X4)                           
*%*                                                                             
*%%:18D    EQU      %         CLOSED; TEST MEDIA ACTION REQUEST                 
*%        DO       #SYSTEM='CP-R'                                               
*%         LW,R0    %:18DEL           SET TO DELETE THE FILE                    
*%         LW,R14   R14               WHAT ACTION WAS REQUESTED ?               
*%         BGZ      %:18F               NONE, ERASE NAME                        
*%         BEZ      %:18E               DELETE AFTER COPY; SET FPT SO           
*%*                                                                             
*%         LW,R0    %:18NDEL          DO NOT DELETE; RESET FPT INFO             
*%*                                                                             
*%%:18E    EQU      %         SET REQUEST MEDIA ACTION; DO REQUEST              
*%         AW,R0    %:18ALT           SET LOC OF DCB WITH THE FILENAME          
*%         STW,R0   %:18MED           STORE CODE BITS                           
*%*                                                                             
*%,%:18MED M:MEDIA  F:ALTLO,(ERR,%:18X6)                                        
*%*                                                                             
*%        ELSE                                                                  
*%         LI,R10   0                 SET ERROR CODE = 0                        
*%         B        %:18X6            REPORT ERROR FOR CP-V                     
*%        FIN                                                                   
*%         PAGE                                                                 
*%         SPACE    2                                                           
*%%:18F    EQU      %         CLEAR FILE NAME; RESET FOR NEW DEFINITION         
*%         LI,R0    0                                                           
*%         STW,R0   %:18ALT+%:18OPEN                                            
*%         STW,R0   %:18ALT+%:18UP    RESET UPSPACE COUNT                       
*%         STW,R0   %:18ALT+%:18LINS  LINES PER PAGE                            
*%         STW,R0   %:18ALT+%:18PAGN  AND CURRENT PAGE NUMBER                   
*%         STW,R0   %:18USER+0                                                  
*%         STW,R0   %:18USER+1                                                  
*%         STW,R0   %:18USER+2        CLEAR FILE NAME                           
*%*                                                                             
*%*                                                                             
*%%:18H    EQU      %         RETURN TO CALLER                                  
*%         PULL     7,R14             RECOVER PARAM, WORK REGITERS              
*%         PULL     3,R8              RECOVER REGS USED FOR CALS                
*%         AI,R14   1                 STEP TO OK ADDRESS                        
*%         B        *R14              AND RETURN                                
*%*                                                                             
*%*                                                                             
*%         PAGE                                                                 
*%         SPACE    2                                                           
*%%:18X6   EQU      %         ERROR IN MEDIA REQUEST                            
*%         AI,R9    2                 STEP ERROR NUMBER                         
*%*                                                                             
*%%:18X4   EQU      %         ERROR CLOSING ALTERNATE DCB                       
*%         AI,R9    1                 STEP ERROR NUMBER                         
*%*                                                                             
*%%:18X3   EQU      %         ERROR ASSIGNING FILE TO DCB                       
*%         AI,R9    1                 STEP ERROR NUMBER                         
*%*                                                                             
*%%:18X2   EQU      %         OUTPUT ALREADY AT ALTERNATE                       
*%         AI,R9    1                 STEP ERROR NUMBER                         
*%*                                                                             
*%%:18X1   EQU      %         OUTPUT ALREADY AT M:LO DCB                        
*%         AI,R9    1                 SET ERROR NUMBER                          
*%*                                                                             
*%%:18X0   EQU      %         COMMON CAL ERROR PROCESSOR                        
*%         PULL     7,R14                                                       
*%         LW,R15   R9                SET ERROR CODE NUMBER                     
*%         LB,R0    R10               SET FPT ERROR CODE                        
*%         PULL     3,R8              RECOVER REST OF REGISTERS                 
*%         B        *R14              EXIT AT ERROR EXIT                        
*%         PAGE                                                                 
*%         SPACE    2                                                           
*%%:18ALT  RES      0         ALTERNATE DCB INFORMATION TABLE                   
*%         DATA     F:ALTLO           ADDRESS OF THE DCB                        
*%         DATA     0                 %OPENSW                                   
*%         DATA     0                 %UP SAVED UPSPACE COUNT                   
*%         DATA     0                 %13+3 LINES PRINTED PER PAGE              
*%         DATA     0                 %13+6 PAGE NUMBER OF CURRENT PAGE         
*%*                                                                             
*%%:18USER DATA     0,0,0             USER FILE NAME                            
*%*                                                                             
*%*                                                                             
*%%:18DCB  EQU      0                 OFFSET TO DCB NAME IN A TABLE             
*%%:18OPEN EQU      1                 OFFSET TO OPENSW                          
*%%:18UP   EQU      2                 OFFSET TO UPSPACE COUNT                   
*%%:18LINS EQU      3                 OFFSET TO LINES PER PAGE                  
*%%:18PAGN EQU      4                 OFFSET TO PAGE NUMBER                     
*%*                                                                             
*%%:18M:LO RES      0         M:LO DCB INFORMATION TABLE                        
*%         DATA     M:LO              ADDRESS OF THE DCB                        
*%         DATA     0,0,0,0           OTHER INFO FILLED IN WHEN SWITCHED        
*%*                                                                             
*%*                                                                             
*%%:18DEL  DATA     X'59A00000'       DELETE FILE AFTER MEDIA COPY              
*%%:18NDEL DATA     X'59800000'       RETAIN FILE AFTER MEDIA COPY              
*%         PAGE                                                                 
*%         SPACE    2                                                           
*%        DO       #SYSTEM='CP-R'                                               
*%*                                                                             
*%*                                                                             
*%F:ALTLO  GEN,8,24 7,0               ALT LO DCB FOR CP-R                       
*%         GEN,8,24 7,0                                                         
*%         DATA     0,0,0                                                       
*%         DATA     0,0               FILENAME                                  
*%*                                                                             
*%*                                                                             
*%        ELSE     #SYSTEM='CP-V'                                               
*%*                                                                             
*%*                                                                             
*%F:ALTLO  DSECT    1                                                           
*%*                                                                             
*%F:ALTLO  M:DCB    (FILE,,),(OUT),(RECL,133),(TRIES,7),(VFC),(SAVE)            
*%*                                                                             
*%         USECT    %:18                                                        
*%*                                                                             
*%*                                                                             
*%        FIN                                                                   
         TITLE    'END OF %  ROUTINES'                                          
*                                                                               
*%*                                                                             
*%        FIN                         END OF CODE GENERATION                    
*%       PEND                                                                   
*%*                                                                             
*%*                                                                             
*%*                                                                             
*%*                                                                             
         SPACE    3                                                             
         CLOSE    R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15         
         CLOSE    %EXIT,%CP,%PL,%PLLEN,%TEMP,%TEMPEND,%%:#DIG,%OPENSW           
         CLOSE    %:1,%:1A,%:2,%:3,%:4A,%:4,%:4B,%:5,%:5A,%:5B,%:6              
         CLOSE    %:7,%:7A,%:7B,%:73600,%:760,%:7TEMP                           
         CLOSE    %:8,%:8A,%:8B,%:8C,%:8D,%:8E,%:8F,%:9,%:9A,%:9B,%:9C          
         CLOSE    %:10,%:10A,%:10B,%:10C,%:10D,%:10E,%:10F,%:10G,%:10H          
         CLOSE    %:10I,%:10J,%:10K,%:10L,%:10M,%:10N,%:10P                     
         CLOSE    %10BEG,%10END,%10REL,%10INDNT,%10DUP,%10ROUND,%10MASK         
         CLOSE    %10XLATE,%10PAG,%10RETSW,%10TRAP,%:10U,%:10V,%:10W            
         CLOSE    %:10X,%10UNMAP,%10WORDS                                       
         CLOSE    %10CPHEX,%10CPSR1,%10CPSR2,%10CPABS                           
         CLOSE    %:11,%:11A,%LODCB                                             
         CLOSE    %:12A,%:12B,%:12C,%:12D,%:12E,%:12F,%:12G,%:12H,%:12I         
         CLOSE    %:12W,%:12,%:12X,%:12E1,%:12BLIN,%UP,%:14,%:15,%:16           
         CLOSE    %:18,%:18A,%:18B,%:18C,%:18D,%:18E,%:18F,%:18H                
         CLOSE    %:18MED,%:18X6,%:18X4,%:18X3,%:18X2,%:18X1,%:18X0             
         CLOSE    %:18ALT,%:18USER,%:18DCB,%:18OPEN,%:18UP,%:18LINS             
         CLOSE    %:18PAGN,%:18M:LO,%:18DEL,%:18NDEL                            
         CLOSE    TRM,PUSH,PULL     RECOVER OLD PROC DEFS                       
         SPACE    3                                                             
*%         END                                                                  
*%                                                                              
*%                                                                              
*%END       OF CODE THAT COULD BE A 'SYSTEM'                                    
         PAGE                                                                   
         SPACE    2                                                             
THEEND   END      MAP                                                           
