         TITLE    '          CONTROL CARD PROCESSOR AND TAPE PROCESSOR'         
         SPACE    2                                                             
************************************************************************        
*                                                                      *        
#SYSTEM  SET      'CP-R'                                               *        
*                                                                      *        
************************************************************************        
*                                                                               
*                                                                               
         SPACE    2                                                             
         SYSTEM   SIG7                                                          
*                                                                               
        DO       (#SYSTEM='CP-V')                                               
         SYSTEM   BPM                                                           
        ELSE     (#SYSTEM='CP-R')                                               
         SYSTEM   CPR                                                           
        FIN                                                                     
*                                                                               
*                                                                               
*                                                                               
*                           ENTRIES INTO THE MODLUE                             
*                                                                               
         DEF      READCC                                                        
         DEF      INITIATE                                                      
         DEF      POSTPOSN                                                      
         PAGE                REFERENCES TO EXTERNAL SYMBOLS                     
         REF      CCREAD                                                        
         REF      CRSHBUF                                                       
         REF      CRSHRROS                                                      
         REF      NOTFIRST                                                      
         REF      REWUNLD                                                       
         REF      EOT                                                           
         REF      FCOMMENT                                                      
         REF      LIMITV                                                        
         REF      LIMPTR                                                        
         REF      MAPPAGE                                                       
         REF      MTDEVADD                                                      
         REF      MTDEVADL                                                      
         REF      NOMAP,NOTABLE,NOTRACE,NODUMP  SWS FOR OUTPUT SUPPRESS         
         REF      LOGLINE           LOG IN INPUT LINE ON LL &/OR LO             
         REF      LOGERR            LOG ERROR MESSAGE ON LL &/OR LO             
         REF      NUMDUMPS                                                      
         REF      U:PCB             STACK IN ROOT                               
         REF      K:JCP1                                                        
         REF      CPRAREA,DATAAREA,MAPAREA    NAMES OF INPUT FILES              
*                                                                               
         REF      LL:LO             CORRESPONDENCE CALS FPTS: LL:LO             
         REF      LL:EC             LL TO ERROR CORRECTION DEVICE               
         REF      IN:EC             INPUT DEVICE VS ERROR CORR DEVICE           
         REF      IN:LL             INPUT DEVICE VS LL DEVICE                   
         REF      FGDBKGSW          FGD / BKG SWITCH                            
         REF      INDCB             INPUT DEVICE DCB ADDRESS                    
         REF      ERRDCB            ERROR CORRECTION DEVICE DCB ADDR            
         REF      ATTENDSW          IN ONLINE CORRECTION SWITCH                 
*                                                                               
         REF      M:LL,M:LO              OUTPUT DCBS                            
         REF      F:X1,F:X2,F:X3,F:X4    INPUT FILES, INPUT TAPE DCBS           
         PAGE                                                                   
         SPACE    2                                                             
*                                                                               
*                           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    2                                                             
         OPEN     Q,I                                                           
TXTS     CNAME    0                                                             
TXT      CNAME    0                                                             
TXTC     CNAME    1                                                             
         PROC                                                                   
Q        SET      S:UT(AF)                                                      
I        SET      S:NUMC(Q)                                                     
Q(I+1)   SET      ' '                                                           
Q(I+2)   SET      ' '                                                           
Q(I+3)   SET      ' '                                                           
         DO       NAME=0                                                        
LF       TEXT     S:PT(Q(1),Q(2),Q(3),Q(4))                                     
         LIST     0                                                             
         ORG      %-1                                                           
         TEXT     AF                                                            
         ELSE                                                                   
LF       DATA     (((I)**8+Q(1))**8+Q(2))**8+Q(3)                               
         LIST     0                                                             
         ORG      %-1                                                           
         TEXTC    AF                                                            
         FIN                                                                    
         LIST     1                                                             
         PEND                                                                   
         CLOSE    Q,I                                                           
*                                                                               
*                                                                               
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                                                                   
         PAGE                                                                   
*                                                                               
*                                                                               
COMMLIST RES      0         INDEX   KEYWORDS FOR COMMANDS                       
         TEXT     'COMM'      0     COMMENT CARD                                
         TEXT     'END '      1     END OF INPUT                                
         TEXT     'QUIT'      2     TERMINATE IMMEDIATELY                       
         TEXT     'DUMP'      3     DO DUMP 'N' ON TAPE                         
         TEXT     'TAPE'      4     TAPE INPUT                                  
         TEXT     'DISP'      5     SET OPTIONS,, DO A DISPLAY                  
*                                                                               
        DO       (#SYSTEM='CP-R')   EXTRA OPTIONS FOR CP-R/RBM                  
         TEXT     'DATA'      6     NAME OF DATA FILE FOR TAPE DUMPS            
         TEXT     'CPR '      7     NAME OF CPR/RBM FILE                        
         TEXT     'MAP '      8     NAME OF SYSGEN MAP FILE                     
        FIN                                                                     
#COMM    EQU      %-COMMLIST        NUMBER OF LEGAL COMMANDS                    
*                                                                               
         SPACE    2                                                             
COMMHAND RES      0         ROUTINES THAT HANDLE THE COMMANDS                   
         B        HNDLCOMM    0     COMMENTS                                    
         B        HNDLEND     1     END OF INPUTS                               
         B        HNDLQUIT    2     QUIT                                        
         B        HNDLDUMP    3     DUMP                                        
         B        HNDLTAP0    4     TAPE                                        
         B        HNDLDISP    5     DISPLAY                                     
*                                                                               
        DO       (#SYSTEM='CP-R')                                               
         B        HNDLDATA    6     DATA                                        
         B        HNDLCPR     7     CPR                                         
         B        HNDLMAP     8     MAP                                         
        FIN                                                                     
         PAGE                                                                   
         SPACE    2                                                             
ANLCCBFW TEXT     '    '            INDENT SPACES FOR INPUT LOGGING             
ANLCCBFR RES      80/4              COMMAND INPUT BUFFER                        
*                                                                               
AREAPTR  DATA     0                 POINTER TO AREA NAME BEING SPECIFIED        
*                                                                               
PREWIND  DATA     0                 REWIND BEFORE PROCESSING SW                 
#SKIPS   DATA     0                                                             
SCNPARAM DATA     ANLCCBFR          SCAN CONTROL BLOCK: BUFFER ADDR             
         DATA     1                 CONVERSION TYPE IS EBCDIC                   
         DATA     0                 FIRST TIME ON THIS COMMAND                  
         DATA     RDCMND            ROUTINE TO READ CONTINUATION 5 OF 5         
EBCDUMP  TEXT     'DUMP'                                                        
EBCFILE  TEXT     'FILE'                                                        
EBCIN    TEXT     'IN  '                                                        
EBCNOMA  TEXT     'NOMA'                                                        
EBCNOTA  TEXT     'NOTA'                                                        
EBCNOTR  TEXT     'NOTR'                                                        
EBCNODM  TEXT     'NODU'                                                        
EBCOFF   TEXT     'OFF '                                                        
EBCON    TEXT     'ON  '                                                        
EBCREAL  TEXT     'REAL'                                                        
EBCVIRT  TEXT     'VIRT'                                                        
         PAGE                                                                   
         SPACE    2                                                             
EBCNPKW  EQU      %-1       BASE OF NO PARAMETER KEYWORD TABLE                  
*                 KEYWORD        INDEX  FUNCTION                                
         TEXT     'PRER' WIND      1      0      REWIND BEFORE ANALYSIS         
         TEXT     'PRE '           2      0                                     
         TEXT     'UNLO' AD        3      1      UNLOAD AFTER ANALYSIS          
         TEXT     'UNLD'           4      1                                     
         TEXT     'REWI' ND        5      2      REWIND AFTER ANALYSIS          
         TEXT     'REW '           6      2                                     
#NPKW    EQU      %-1-EBCNPKW                  NUMBER OF KEYWORDS               
*                                                                               
*                                                                               
*                                                                               
M24      DATA     X'00FFFFFF'                                                   
         PAGE                                                                   
         SPACE    2                                                             
ERRMSG   TXT      ' ERROR FIELD XX '                                            
*                                                                               
ERRMSGA  TXT      ' WRITE RESTRICT ON FILE XXXXXXXX.AA '                        
ERRMSGB  TXT      ' NO SUCH FILE:  XXXXXXXX.AA '                                
ERRMSGC  TXT      '  EOT ON CODE FILE: DATA TRUNCATED AT ADDR XXXXX'            
ERRMSGCX EQU      %                 LAST DIGIT+1 OF ADDRESS                     
ERRMSGD  TXT      '  EOT ON MAP FILE'                                           
ERRMSGE  TXT      ' FILES COPIED: ANALYSIS BEGUN'                               
         ORG      %-1               BACK UP TO INSERT A 'CR' AT END             
         DATA     X'D5150000'       'N', 'CR', 'NULL', 'NULL'                   
ERRMSGF  RES      0                 CURRENT END OF MESSAGES                     
*                                                                               
ERRMSGX  TEXT     ' -1 '            FATAL ERROR READING 1ST COMMAND             
*                                                                               
*                                                                               
*                                                                               
@MSG     SET      4*(ERRMSGA-ERRMSG)   SET SIZE OF MESSAGES IN BYTES            
@MSGA    SET      4*(ERRMSGB-ERRMSGA)                                           
@MSGB    SET      4*(ERRMSGC-ERRMSGB)                                           
@MSGC    SET      4*(ERRMSGD-ERRMSGC)                                           
@MSGD    SET      4*(ERRMSGE-ERRMSGD)                                           
@MSGE    SET      4*(ERRMSGF-ERRMSGE)                                           
@MSGX    SET      4*(ERRMSGX+1-ERRMSGX)                                         
        DO       (#SYSTEM='CP-R')                                               
         PAGE                                                                   
*                                                                               
*        ENVIRONMENT FOR GETIOID                                                
*                                                                               
GIOSCAN  CNAME                                                                  
         PROC                                                                   
         LI,R0    1                                                             
         STW,R0   SCAN97            SCAN POSSIBLE FILE ID                       
         STW,R0   1,R7              SCAN EBCDIC                                 
         BAL,R8   SCAN              GET NEXT SUBFIELD                           
         CI,R6    0                                                             
         BL       GIOEXIT           B IF SCAN ERROR                             
         PEND                                                                   
*                                                                               
GIOBITS  DATA     1**(31-1)+1**(31-2)+1**(31-3)+1**(31-13)  P2+P3+P4+P14        
GIOOBIT  DATA     1**(31-1)         P2 (OPLABEL)                                
GIODBIT  DATA     1**(31-2)         P3 (DEVICE)                                 
GIOFBIT  DATA     1**(31-3)         P4 (FILE ID)                                
GIOABIT  DATA     1**(31-13)        P14 (ACCOUNT NAME)                          
GIOFA    DATA     1**(31-3)+1**(31-13)  P4 AND P14                              
GIODEV0  DATA     '0   '            NULL DEVICE NAME                            
BLBLBL   DATA     '   '             3 BLANKS RIGHT-ALIGNED                      
NLBB     DATA     X'155A5A00'       NEW-LINE, BANG, BANG LEFT-ALIGNED           
K:DCT1   EQU      X'176'                                                        
K:DCT16  EQU      X'177'                                                        
K:OPLBS1 EQU      X'178'                                                        
K:MDNAME EQU      X'212'                                                        
         BOUND    8                                                             
NULLDEV  DATA     0,0                                                           
*                                                                               
         TITLE    '***** GETIOID *****'                                         
*                                                                               
*        NAME:    GETIOID                                                       
*                                                                               
*        PURPOSE: SCAN A DEVICE, OPLABEL, OR FILE IDENTIFIER                    
*                 FROM A COMMAND                                                
*                                                                               
*        CALL:    BAL,R8  GETIOID                                               
*                                                                               
*        INPUT:   R9 = ADDRESS OF A MEMORY AREA, THE FIRST                      
*                      WORD OF WHICH INDICATES PERMISSIBLE FORMS AS             
*                      FOLLOWS:                                                 
*                      BIT 1 SET IF AN OPLABEL NAME IS PERMITTED                
*                      BIT 2 SET IF A DEVICE NAME IS PERMITTED                  
*                      BIT 3 SET IF A FILE AND AREA IS PERMITTED                
*                      BIT 13 SET IF AN ACCOUNT NAME IS PERMITTED               
*                      NOTE THAT THESE ARE THE CORRESPONDING                    
*                      P-BITS FOR AN ASSIGN CAL.                                
*                      FOLLOWING THE FIRST WORD MUST BE ENOUGH                  
*                      SPACE FOR THE RETURN AS INDICATED BELOW                  
*                      (SPACE NEED NOT BE ALLOWED FOR NON-                      
*                      PERMISSIBLE NAME TYPES)                                  
*                 R7 = R7 VALUE FOR SCAN                                        
*                                                                               
*        RETURN:  R6 = -1 IF A NON-ALLOWED OR UNRECOGNIZED FORM                 
*                      IS FOUND.  OTHERWISE, AS RETURNED FROM                   
*                      THE LAST SCAN CALL.                                      
*                 R10,R11 AS RETURNED FROM LAST SCAN CALL                       
*                 OTHER REGISTERS UNCHANGED                                     
*                 AREA POINTED BY R9:                                           
*                   FIRST WORD BITS 1, 2, 3, AND 13 SET TO INDICATE             
*                   THE FORM FOUND. OTHER BITS UNCHANGED.                       
*                   FOLLOWING WORDS AS INDICATED BELOW:                         
*                      OPLABEL:  RIGHT-ALIGNED IN ONE WORD                      
*                      DEVICE:  LEFT-ALIGNED WITH TRAILING BLANKS               
*                      IN TWO WORDS                                             
*                      FILE AND AREA:  AREA NAME IN ONE WORD, RIGHT             
*                      ALIGNED, AND FILE NAME IN FOLLOWING TWO                  
*                      WORDS, LEFT-ALIGNED WITH TRAILING BLANKS                 
*                      ACCOUNT NAME: IN TWO WORDS FOLLOWING THE                 
*                      SPACE FOR FILE AND AREA NAMES (WORDS 4                   
*                      AND 5 FOLLOWING THE P-BIT WORD), LEFT-ALIGNED            
*                      WITH TRAILING BLANKS                                     
*                      THIS FORMAT MAY BE USED IN AN ASSIGN CAL FPT.            
*                                                                               
GETIOID  RES      0                                                             
         PUSH     R8                                                            
         PUSH     4,R0                                                          
*                                                                               
         LW,R1    R9                SAFER AND MORE USABLE PLACE                 
         GIOSCAN                    GET NEXT SUBFIELD                           
*                                                                               
*        CHECK TO SEE IF A DEVICE NAME COULD BE IN R8, R9                       
         LW,R0    GIODBIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIO10             B IF NOT PERMITTED                          
         CI,R6    2                                                             
         BG       GIO10             B IF NEW-FORMAT FILE ID                     
         CW,R8    GIODEV0                                                       
         BNE      GIO01             B IF NOT NULL DEVICE                        
         LD,R8    NULLDEV           GET NULL DEVICE ID                          
         B        GIO05                                                         
*****                                                                           
GIO01    RES      0                                                             
         CI,R10   5                                                             
         BNE      GIO10             B IF WRONG LENGTH                           
         SLD,R8   -24               ADJUST TO DCT16 FORMAT                      
         OR,R8    NLBB                                                          
         LH,R2    *K:DCT1           GET DCT NR OF ENTRIES                       
GIO02    RES      0                 SEARCH FOR NAME IN DCT                      
         CD,R8    *K:DCT16,R2                                                   
         BE       GIO03             B IF FOUND                                  
         BDR,R2   GIO02                                                         
         SLD,R8   24                NOT FOUND.  RESTORE NAME                    
         OR,R9    BLBLBL                                                        
         B        GIO10                                                         
*****                                                                           
GIO03    RES      0                                                             
         SLD,R8   24                NAME FOUND. RESTORE TO INPUT FORMAT         
         OR,R9    BLBLBL                                                        
GIO05    RES      0                                                             
*                                                                               
*        DEVICE ID SCANNED. PACK IT AWAY.                                       
         STW,R8   1,R1                                                          
         STW,R9   2,R1                                                          
         LW,R3    GIODBIT                                                       
         B        GIOOKEX           SPLIT                                       
*****                                                                           
GIO10    RES      0                                                             
*                                                                               
*        CHECK TO SEE IF AN OPLABEL NAME COULD BE IN R8                         
         LW,R0    GIOOBIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIO20             B IF NOT PERMITTED                          
         CI,R6    2                                                             
         BG       GIO20             B IF NEW-FORMAT FILE ID                     
         CI,R10   2                                                             
         BG       GIO20             B IF NAME IS TOO LONG                       
         LH,R2    *K:OPLBS1         GET OPLBS1 NR OF ENTRIES                    
         LH,R0    R8                                                            
GIO15    RES      0                 SEARCH FOR NAME IN OPLB                     
         CH,R0    *K:OPLBS1,R2                                                  
         BE       GIO17             B IF FOUND                                  
         BDR,R2   GIO15                                                         
         B        GIO20             B IF NOT FOUND                              
*****                                                                           
GIO17    RES      0                                                             
*                                                                               
*        OPLABEL NAME SCANNED. PACK IT AWAY.                                    
         SLS,R8   -16                                                           
         STW,R8   1,R1                                                          
         LW,R3    GIOOBIT                                                       
         B        GIOOKEX                                                       
*****                                                                           
GIO20    RES      0                                                             
*                                                                               
*        CHECK TO SEE IF AN OLD-FORMAT AREA NAME COULD BE IN R8, R9             
         LW,R0    GIOFBIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIO30             B IF NOT PERMITTED                          
         CI,R6    0                                                             
         BG       GIO30             B IF NEW-FORMAT FILE ID                     
         CI,R10   2                                                             
         BNE      GIO30             B IF WRONG LENGTH                           
*                                                                               
*        OLD FORMAT AREA NAME FOUND. PACK IT AWAY.                              
*                                                                               
         SLS,R8   -16                                                           
         STW,R8   1,R1                                                          
         LW,R3    GIOFBIT           FLAG FOR FILE ID FOUND                      
*                                                                               
*        FILE NAME FOLLOWS AREA NAME                                            
         GIOSCAN                    GET NEXT SUBFIELD                           
         CI,R6    2                                                             
         BG       GIOEREX           B IF A NEW-FORMAT TERMINATOR                
*                                                                               
*        FILE NAME FOUND. PACK IT AWAY.                                         
         STW,R8   2,R1                                                          
         STW,R9   3,R1                                                          
*                                                                               
         LW,R0    GIOABIT                                                       
         CW,R0    *R1               IS AN ACCOUNT NAME REQUESTED                
         BAZ      GIOOKEX           NO, SKIP THIS                               
*                                   YES                                         
         LI,R0    0                                                             
         STW,R0   4,R1                                                          
         STW,R0   5,R1              ZERO IS THE DEFAULT ACCOUNT NAME            
         B        GIOOKEX           DONE.                                       
*****                                                                           
*        ASSUME SCANNED FIELD IS A NEW-FORMAT FILE NAME                         
GIO30    RES      0                                                             
         LW,R3    GIOFBIT                                                       
         CW,R3    *R1                                                           
         BAZ      GIOEREX           B IF FILE ID NOT PERMITTED                  
         STW,R8   2,R1                                                          
         STW,R9   3,R1              SET FILE NAME                               
         LI,R0    0                                                             
         STW,R0   1,R1              SET AREA NAME UNSPECIFIED FOR NOW.          
*                                                                               
         LW,R0    GIOABIT                                                       
         CW,R0    *R1               IS AN ACCOUNT NAME REQUESTED                
         BAZ      GIO31             NO, SKIP THIS                               
*                                   YES                                         
         LI,R0    0                                                             
         STW,R0   4,R1                                                          
         STW,R0   5,R1              ZERO IS THE DEFAULT ACCOUNT NAME            
*                                                                               
GIO31    RES      0                                                             
         CI,R6    3                                                             
         BNE      GIOOKEX           B IF NO MORE FILE ID FIELDS                 
         GIOSCAN                    GET NEXT SUBFIELD                           
*                                                                               
*        CHECK TO SEE IF A NEW-FORMAT AREA NAME COULD BE IN R8, R9              
         CI,R10   0                                                             
         BE       GIO34             B IF NULL (DEFAULT) AREA                    
         CI,R10   2                                                             
         BNE      GIO35             B IF WRONG LENGTH                           
         LB,R2    K:MDNAME          NR OF AREA NAMES                            
GIO33    RES      0                                                             
         AI,R2    -1                                                            
         BLZ      GIO35             B IF NOT AN AREA NAME                       
         LH,R0    *K:MDNAME,R2      GET NEXT NAME FROM TABLE                    
         CH,R0    R8                                                            
         BNE      GIO33             B IF NOT MATCHED                            
*                                                                               
*        AREA NAME FOUND. SET IT.                                               
         SLS,R8   -16                                                           
         STW,R8   1,R1                                                          
*                                                                               
GIO34    RES      0                                                             
         CI,R6    3                                                             
         BNE      GIOOKEX           B IF NO MORE FILE ID FIELDS                 
         GIOSCAN                    GET NEXT SUBFIELD                           
*                                                                               
GIO35    RES      0                                                             
*                                                                               
*        CHECK TO SEE IF AN ACCOUNT NAME COULD BE IN R8, R9                     
         LW,R0    GIOABIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIOEREX           B IF NOT PERMITTED                          
*                                                                               
*        ACCOUNT NAME FOUND. SET IT                                             
         STW,R8   4,R1                                                          
         STW,R9   5,R1                                                          
         OR,R3    GIOABIT           SET ACCOUNT NAME BIT.                       
         CI,R6    3                                                             
         BNE      GIOOKEX           B IF END OF FILE ID                         
*        OTHERWISE, TOO MANY FILE ID FIELDS                                     
*                                                                               
*        NON-SCAN ERROR ENCOUNTERED. SET R6 AND EXIT.                           
GIOEREX  RES      0                                                             
         LI,R6    -1                                                            
         B        GIOEXIT                                                       
*****                                                                           
*        NORMAL EXIT                                                            
*        R1 IS PARAM TABLE POINTER                                              
*        R2 IS P-BITS FOR TYPE OF I/O STREAM NAME FOUND                         
GIOOKEX  RES      0                                                             
         LW,R9    R1                RESTORE R9                                  
         LW,R0    R3                GET NEW P-BIT SETTING                       
         LW,R1    GIOBITS                                                       
         STS,R0   *R9               SET EM                                      
*                                                                               
*        ALL EXIT PATHS MEET HERE                                               
GIOEXIT  RES      0                                                             
         PULL     4,R0              RESTORE OTHER STUFF                         
         PULL     R8                RESTORE LINK                                
GIOEX    B        *R8               RETURN                                      
*****                                                                           
*****                                                                           
        FIN      (#SYSTEM='CP-R')                                               
         PAGE                                                                   
*      SCAN ROUTINE        *************                                        
*                                                                               
*                                                                               
*                                   SCANS ONE SUBFIELD AT A TIME                
*                                                                               
*                                   CALL IS   BAL,R8   SCAN                     
*                                     WHERE  R7=ADD. OF INPUT PARAM.            
*                                     WHICH ARE                                 
*                                                                               
*                                       WORD 1= ADD. OF INPUT BUFFER            
*                                               (MUST START ON WORD BND)        
*                                       WORD 2=1, LEAVE FIELD IN EBCDIC         
*                                             =2, CONVERT TO HEX                
*                                             =4, CONVERT TO DECIMAL            
*                                             =3, CONVERT TO HEX OR BCD         
*                                             =5, CONVERT TO DEC OR BCD         
*                                                                               
*                                       WORD 3=0, FIRST TIME FOR CARD           
*                                             =1, CONTINUE ON CARD              
*                                                                               
*                                       WORD 4=ADDR OF ROUTINE TO               
*                                              PROCESS  ;                       
*                                                                               
*                                   EXITS WITH FOLLOWING:                       
*                                                                               
*                                     R7- UNCHANGED                             
*                                     R8,R9- CONTAIN VALUE                      
*                                       IF R9=0, R8 CONTAINS DEC OR HEX         
*                                            =NONZERO, R8 AND R9 CONTAIN        
*                                               EBCDIC(UNUSED CHAR. HAVE        
*                                               BLANKS)                         
*                                                                               
*                                     R6=0, END OF SUBFIELD                     
*                                       =1, END OF FIELD                        
*                                       =2, END OF CARD                         
*                                       =3, END OF FILE ID FIELD                
*                                       =-1,ERROR IN SUBFIELD OR FIELD          
*                                         ERRORS ARE:                           
*                                           ILLEGAL CHAR.                       
*                                           MORE THAN 8 CHARS.                  
*                                           COL. 80 SCANNED                     
*                                           ILLEGAL PARENTHSES                  
*                                           NO : IN COL. ONE                    
*                                     R10= NO. CHARS. IN FIELD OR SUBF.         
*                                     R11= SUBFIELD NO. IN EBCDIC FOR           
*                                          ERROR FIELD XX ALARM; CHARS.         
*                                          ARE IN BITS 8-23, OTHER CHARS        
*                                          ARE BLANKS                           
*                                                                               
*                                   REGISTERS USED:  R0, R5-R11                 
*                                                    R7 IS UNCHANGED            
*                                   AFTER AN ERROR RETURN, WORD 3 OF            
*                                     INPUT PARAM. MUST BE ZERO                 
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
SCAN     STW,R8   SCAN99            SAVE RETURN ADDRESS                         
         LW,R0    *R7                                                           
         STW,R0   SCAN96            SAVE ADD. OF BUFFER                         
         LW,R0    SCAN92            IS IT A CONT. CARD                          
         BNEZ     SCAN0             NO                                          
         STW,R7   SCAN88            YES, SAVE R7                                
         PUSH     R14               SAVE LINK TO READ COMMAND ROUTINE           
         LW,R14   3,R7              GET ADDRESS OF THE ROUTINE                  
         BAL,R14  *R14              GET CONTINUATION LINE                       
         PULL     R14               RECOVER SAVED LINK REGISTER                 
SCAN0    LW,R8    SCAN89A           HOUSEKEEP R8,R9 TO ALL BLANKS               
         STW,R8   R9                                                            
         LI,R0    -9                                                            
         STW,R0   SCAN93            HOUSEKEEP CHAR. COUNT                       
         LI,R0    0                                                             
         STW,R0   SCAN95            CLEAR COUNT OF HEX CHARS.                   
         LW,R0    2,R7              IS THIS A CONTINUATION                      
         BNEZ     SCAN4             YES                                         
         STW,R0   SCAN90            HOUSEKEEP FIELD FLAG AND                    
         LI,R0    -1                  PARENTHESES FLAG                          
         STW,R0   SCAN91                                                        
SCAN1    LI,R0    X'F0F0'                                                       
         STW,R0   SCAN94            HOUSEKEEP FIELD COUNT                       
         LI,R6    0                                                             
         LB,R0    *SCAN96           IS COLUMN ONE A COLON                       
         CI,R0    X'7A'                                                         
         BNE      %+2               NO, ERROR                                   
         LI,R6    1                 SET TO COL. 2                               
         LI,R0    X'40'                                                         
SCAN2    CB,R0    *SCAN96,R6        SCAN OFF LEADING BLANKS                     
         BNE      SCAN6             NOT BLANK                                   
         AI,R6    1                 STEP INDEX                                  
         CI,R6    80                                                            
         BL       SCAN2             NOT COL. 80 YET                             
         LI,R10   0                 BLANK CARD, SET NO. CHARS=0                 
         LI,R6    2                 SET TO END OF CARD                          
         B        SCAN33            EXIT                                        
SCAN4    LW,R0    SCAN92            IS THIS CONTINUATION                        
         BEZ      SCAN1             YES                                         
         LW,R6    SCAN98            GET COL. INDEX                              
         AI,R6    1                 STEP TO NEXT COL.                           
SCAN6    LW,R11   1,R7              GET INPUT CONVERSION TYPE IN R11            
         LI,R0    0                                                             
         STW,R0   SCAN98            HOUSEKEEP                                   
         MTW,1    SCAN94            STEP FIELD COUNTER IN EBCDIC                
         LI,R5    3                 CHECK FOR OVERFLOW AND RESET IF             
         LI,R0    X'FA'             OVERFLOW                                    
         CB,R0    SCAN94,R5                                                     
         BG       SCAN7             NO OVERFLOW                                 
         LI,R0    X'F0'             RESET FOR OVERFLOW                          
         STB,R0   SCAN94,R5                                                     
         LI,R5    2                                                             
         MTB,1    SCAN94,R5                                                     
SCAN7    LB,R10   *SCAN96,R6        GET NEXT BYTE                               
         CI,R10   X'C1'                                                         
         BL       SCAN25            SPECIAL CHAR.                               
         MTW,1    SCAN93            STEP CHAR. COUNT                            
         BNEZ     SCAN9             NOT TOO MANY CHARS.                         
SCAN8    LI,R6    -1                SET TO ERROR EXIT                           
         B        SCAN33            GO TO EXIT                                  
SCAN9    CI,R10   X'C7'                                                         
         BL       SCAN19            HEX CHAR.                                   
         CI,R10   X'F0'                                                         
         BL       SCAN14            EBCDIC CHAR.                                
         CI,R10   X'FA'                                                         
         BGE      SCAN8             ERROR, ILLEGAL CHAR.                        
         CI,R11   4                 IS FIELD DECIMAL                            
         BL       SCAN19            NO DECIMAL CONVERSION                       
         LI,R11   4                 SET FLAG SO ONLY DECIMAL CONVERSION         
         CW,R8    SCAN89A           IS THIS FIRST CHAR.                         
         BNE      %+2               NO                                          
         LI,R8    0                 YES, CLEAR R8                               
         LW,R9    R8                                                            
         MI,R9    10                CHANGE TO DECIMAL                           
         AI,R10   -X'F0'                                                        
         AW,R9    R10               ADD INTO ACC. SUM                           
         LW,R8    R9                MOVE VALUD TO R8                            
SCAN10   LI,R9    0                 SET EXIT VALUE TO DEC OR HEX                
SCAN11   LW,R0    SCAN91            WAS ) PREVIOUS CHAR.                        
         BEZ      SCAN8             YES, ERROR IN FIELD                         
SCAN12   AI,R6    1                 STEP COL. COUNT                             
         CI,R6    80                COL. 80                                     
         BL       SCAN7             NO                                          
         B        SCAN8             YES, ERROR                                  
SCAN14   LW,R0    R10               CHECK FOR LEGAL EBCDIC CHAR.                
         AND,R0   KXF                                                           
         BEZ      SCAN8             ILLEGAL CHAR.                               
         CI,R0    'A'                                                           
         BGE      SCAN8             ILLEGAL CHAR.                               
         CI,R10   X'E1'                                                         
         BE       SCAN8             ILLEGAL CHAR.                               
SCAN14A  LI,R0    1                                                             
         AND,R11  R0                EBCDIC CONV. REQUESTED                      
         BEZ      SCAN8             NO, ERROR                                   
         LW,R5    SCAN93            GET CHAR. COUNT                             
         AI,R5    8                 GET PROPER BYTE FOR CHAR.                   
         STB,R10  R8,R5             STORE CHAR. IN PROPER BYTE                  
         B        SCAN11                                                        
SCAN19   RES      0                                                             
SCAN20   LI,R0    2                                                             
         AND,R0   R11                                                           
         BEZ      SCAN14A           NOT HEX CONV.                               
         LI,R11   2                 SET TO HEX ONLY                             
         CW,R8    SCAN89A           IS THIS FIRST CHAR.                         
         BNE      SCAN22            NO                                          
         LI,R8    0                 YES, CLEAR R8                               
SCAN22   SLS,R8   4                                                             
         CI,R10   X'F0'                                                         
         BGE      %+2                                                           
         AI,R10   X'39'             CHANGE TO HEX                               
         AI,R10   -X'F0'                                                        
         AW,R8    R10                                                           
         MTW,1    SCAN95            STEP COUNT OF HEX                           
         B        SCAN10            GET NEXT CHAR.                              
SCAN25   RES      0                                                             
         CI,R10   ','               CHECK FOR COMMA                             
         BNE      SCAN35            NO                                          
         LW,R0    SCAN91            YES,GET PARENTHESES FLAG                    
         BGZ      SCAN29            NOT END OF FIELD                            
         LI,R0    -1                                                            
         STW,R0   SCAN91            RESET PARENTHESES FLAG                      
SCAN28   MTW,1    SCAN98            SET EXIT PARAM. FOR END OF FIELD            
SCAN29   MTW,1    SCAN90            STEP FIELD FLAG                             
         LW,R10   SCAN93            GET CHAR. COUNT ON EXIT                     
         AI,R10   9                 CHANGE TO POSITIVE                          
         STW,R6   2,R7              RETURN NEXT CHARACTER POINTER               
SCAN32   XW,R6    SCAN98            SAVE CHAR COUNT AND SET EXIT PM.            
SCAN33   MTW,1    SCAN92            STEP CONT. CARD FLAG                        
         LW,R11   SCAN94            SET R11 TO FIELD NO.                        
         SLS,R11  8                 POSITION TO PROPER BITS                     
         AW,R11   SCAN89            ADD IN BLANKS                               
         LI,R0    0                                                             
         STW,R0   SCAN97            RESET FILE ID SCAN FLAG                     
SCAN33X  B        *SCAN99           EXIT                                        
*                                                                               
SCAN35   CI,R10   X'5D'             RIGHT PARENTH.                              
         BNE      SCAN36            NO                                          
         LW,R0    SCAN91            YES, CHECK LEGALITY                         
         BLEZ     SCAN8             ERROR, RT.PARENTH., BUT NO LEFT             
         MTW,-1   SCAN91            SET PARENTH. FLAG TO RT. PARENTH.           
         B        SCAN12            GET NEXT CHAR.                              
SCAN36   CI,R10   X'4D'             LEFT PARENTHSES                             
         BNE      SCAN37            NO                                          
         MTW,0    SCAN91            YES                                         
         BGZ      SCAN8             ERROR, 2 LFT. PARENTH. IN A ROW             
         LI,R0    1                                                             
         STW,R0   SCAN91            SET TO LEFT PARENTH.                        
         B        SCAN12            GET NEXT CHAR.                              
SCAN37   CI,R10   X'40'             BLANK                                       
         BG       SCAN38            NO, AND NOT SPECIAL CONTROL EITHER          
*                                                                               
*                           ASSUME SPACE AND X'00' - X'3F' ==> END CMD          
SCAN37B  RES      0                                                             
         LW,R0    SCAN91            GET PARENTH. FLAG                           
         BGZ      SCAN8             ERROR, LFT. BUT NO RIGHT                    
         LW,R0    SCAN90            YES, CHECK FIELD                            
         BNEZ     SCAN37C           SPEC. FIELD, SO EXIT                        
         LI,R10   C' '              ASSUME LAST CHAR SCANNED WAS SPACE          
         LI,R0    '.'                                                           
SCAN37A  AI,R6    1                                                             
         CI,R6    80                STRIP OFF BLANKS AFTER MNE. FIELD           
         BE       SCAN37C           END OF CARD, NO SPEC. FIELD                 
         CB,R10   *SCAN96,R6                                                    
         BE       SCAN37A           A BLANK                                     
         BG       SCAN37C           SPECIAL CHAR = END OF INPUT                 
         CB,R0    *SCAN96,R6        IS IT A PERIOD                              
         BE       SCAN37C           YES,TREAT AS END OF CARD                    
         AI,R6    -1                RESET TO LAST BLANK                         
         B        SCAN28            GO TO EXIT WITH END OF FIELD                
SCAN37C  MTW,2    SCAN98                                                        
         B        SCAN29                                                        
SCAN38   CI,R10   X'5E'             ;                                           
         BNE      SCAN39            NO                                          
         LW,R0    SCAN90                                                        
         BEZ      SCAN8             NOT ALLOWED IN MNEMONIC FIELD               
         LW,R0    SCAN91                                                        
         BGZ      SCAN8             ERROR, LFT. PARENTH., BUT NO RIGHT          
         LI,R0    -1                                                            
         STW,R0   SCAN92            SET CONT. CARD FLAG                         
         B        SCAN28                                                        
SCAN39   RES      0                                                             
         CI,R10   '.'                                                           
         BNE      SCAN40            B IF NOT PERIOD                             
         MTW,0    SCAN97                                                        
         BEZ      SCAN37B           B IF NOT SCANNING FILE ID FIELD             
         MTW,3    SCAN98            END OF FILE ID FIELD FLAG                   
         B        SCAN29                                                        
*****                                                                           
SCAN40   RES      0                                                             
         CI,R10   '%'               CHECK FOR LEGAL EBCDIC CHAR                 
         BE       SCAN41            OK                                          
         CI,R10   X'6D'             - CHAR OK                                   
         BE       SCAN41            YES                                         
         CI,R10   ':'                                                           
         BL       SCAN8             ILLEGAL CHAR.                               
         CI,R10   X'7C'                                                         
         BG       SCAN8             ILLEGAL CHAR.                               
SCAN41   MTW,1    SCAN93            OK, STEP CHAR. COUNT                        
         BNEZ     SCAN14A                                                       
         B        SCAN8             ERROR,TOO MANY CHARS.                       
*                                                                               
SCAN88   DATA     0                 SAVE R7 HERE                                
SCAN89   DATA     X'40000040'       BLANKS                                      
SCAN89A  DATA     X'40404040'       EBCDIC BLANKS                               
SCAN90   DATA     0                 FIELD FLAG                                  
SCAN91   DATA     0                 PARENTHESES FLAG                            
SCAN92   DATA     1                 CONT. CARD FLAG                             
SCAN93   DATA     0                 CHAR. COUNT                                 
SCAN94   DATA     0                 FIELD COUNT                                 
SCAN95   DATA     0                 COUNT OF HEX CHARS.                         
SCAN96   DATA     0                 ADD. OF CARD BUFFER                         
SCAN97   DATA     0                 =0 IF PERIOD MEANS END OF CMND              
*                                   =1 IF END OF FILE ID FIELD                  
SCAN98   DATA     0                 COL. INDEX AND EXIT PM. R6                  
SCAN99   DATA     0                 RETURN ADDRESS                              
KXF      DATA      X'F'                                                         
STATFLAG DATA     X'4E'             POINTS TO PCBPOINT                          
         DATA     0                 -JUST FOR TEST ONLY-                        
COLEXTNT EQU      72                LIMIT OF 72 COL IN ALTERNATE                
PARENFLG EQU      SCAN91                                                        
         TITLE    '     COMMAND PROCESSING ROUTINES'                            
*                                                                               
* * * * * * * * * * * * *** * * *                                               
*COLON CONTROL CARD READ ROUTINE                                                
* THE CONTROL CARDS ARE                                                         
*                 :DATA (FILE,<AD>,<FILE-NAME>)                                 
*                 :CPR  (FILE,<AD>,<FILE-NAME>)                                 
*                 :MAP  (FILE,<AD>,<FILE-NAME>)                                 
*                 :TAPE (IN,<DD>),(DUMP,<DUMP#>),(REWIND),;                     
*                       (SKIP,<SKIP#>),(DO,<COUNT>)                             
*                 :DUMP <DUMP#>                                                 
*                 :END                                                          
*                 :DISPLAY (VIRTUAL,<LOWER>,<UPPER>),;                          
*                          (REAL,<LOWER>,<UPPER>)                               
*                 :COMMENT ON                                                   
*                                                                               
*                                                                               
READCC   RES      0         MAIN ENTRY TO OVERLAY                               
         PUSH     R14               SAVE RETURN ADDRESS                         
         LI,R0    0                 RESET TAPE PROCESSING SWITCHES              
         STW,R0   REWUNLD           NO REW/UNLOAD AFTER ANALYSIS                
         LI,R0    -1                                                            
         STW,R0   MTDEVADL          NO INPUT TAPE AT ALL                        
         MTW,+0   NOTFIRST          IS THIS ENTRY FOR ANOTHER ANALYZE ?         
         BEZ      RDCC                NO, FIRST ENTRY                           
*                                                                               
         LI,R1    2                 OUT A 2 CHAR LINE TO EJECT TO               
         LI,R2    ANLCCBFR          A NEW PAGE FOR THE NEW INPUTS               
         LI,R0    X'F140'           OUT 'PAGE EJECT, SPACE'                     
         STH,R0   *R2                                                           
         BAL,R14  LOGLINE           PRINT LINE ON A NEW PAGE                    
*                                                                               
*                                                                               
RDCC     RES      0         READ NEXT INPUT COMMAND                             
         BAL,R14  RDCMND            READ AND LOG NEXT COMMAND LINE              
*                                                                               
PROCESS  RES      0         PROCESS A  :COMMAND  LINE                           
         MTW,2    CCREAD            INDICATE CARD READ                          
         LI,R7    SCNPARAM                                                      
         LI,R1    1                 EBCDIC FIELD                                
         STW,R1   1,7                                                           
         LI,R0    0                                                             
         STW,R0   2,7                                                           
         BAL,R8   SCAN                                                          
         CI,R6    1                                                             
         BL       CRDERR            ERROR IF NOT END OF FIELD                   
         LI,R1    #COMM             COMM                                        
         CW,R8    COMMLIST-1,R1                                                 
         BE       COMMHAND-1,R1     ----AND GO TO CORRECT HANDLER               
         BDR,R1   %-2                                                           
         B        CRDERR                                                        
         PAGE                                                                   
         SPACE    2                                                             
RDCMND   RES      0         GET AN INPUT COMMAND, AND LOG IT                    
         LI,R1    20                CLEAR INPUT BUFFER IN CASE THIS IS          
         LW,R2    ANLCCBFW          CP-V, WHO DOESN'T DO IT FOR US              
         STW,R2   ANLCCBFW,R1                                                   
         BDR,R1   %-1                                                           
*                                                                               
         EXU      PROMPT            SET PROMPT CHAR FOR CP-V                    
         CAL1,1   READCMD           READ INPUT DEVICE FOR NEXT COMMAND          
*                                                                               
REWRITE  RES      0         LOG COMMAND ON OUTPUT DEVICE(S)                     
         LI,R2    ANLCCBFW          SET LOC, SIZE OF LINE TO LOG                
         LI,R1    84                                                            
         B        LOGLINE           GO LOG ON LL, LO, IF NECESSARY              
*                 LOGLINE WILL RETURN TO OUR LINK IN R14                        
         PAGE                                                                   
         SPACE    2                                                             
        DO       (#SYSTEM='CP-R')                                               
*                                                                               
*                           PROCESS SPECIFICATIONS OF INPUT FILES               
HNDLDATA LI,R0    DATAAREA          HERE TO HANDLE DATA CARD                    
         B        HNDLFILE                                                      
HNDLCPR  LI,R0    CPRAREA           HERE TO HANDLE CPR CARD                     
         B        HNDLFILE                                                      
HNDLMAP  LI,R0    MAPAREA           HERE TO HANDLE MAP CARD                     
HNDLFILE STW,R0   AREAPTR                                                       
         BAL,R8   SCAN              CHECK TO BE                                 
         CI,R6    0                   SURE KEYWORD                              
         BL       CRDERR               IS 'FILE'                                
         CI,R6    1                                                             
         BG       CRDERR                                                        
         CW,R8    EBCFILE                                                       
         BNE      CRDERR                                                        
         LW,R9    AREAPTR                                                       
         LW,R8    GIOFA                                                         
         STW,R8   *R9               SET FLAGS TO SCAN FILE ID                   
         BAL,R8   GETIOID                                                       
         CI,R6    2                                                             
         BNE      CRDERR            B IF NOT END OF CMND                        
         B        RDCC                                                          
        FIN                                                                     
         PAGE                                                                   
         SPACE    2                                                             
HNDLTAP0 RES      0                                                             
         LI,R1    100               DEFAULT NUMBER DUMPS FROM TAPE              
         STW,R1   NUMDUMPS                                                      
*                                                                               
HNDLTAPE RES      0                 HERE TO HANDLE TAPE CARD.                   
         LI,R1    1                                                             
         STW,R1   1,R7              EBCDIC                                      
         BAL,R8   SCAN                                                          
         CI,R6    0                                                             
         BL       CRDERR            IF ERROR FOUND, REPORT IT                   
         BE       HNDLTAP4          KEYWORD WITH PARAM; GET PARAM               
         LI,R1    #NPKW             LOOK NAME UP IN NO PARAM KEYWORDS           
*                                                                               
HNDLTAP1 RES      0         TEST IF A VALID PARAMETERLESS OPTION                
         CW,R8    EBCNPKW,R1                                                    
         BE       HNDLTAP2            YES, PROCESS IT                           
         BDR,R1   HNDLTAP1              NOT YET, TEST ON                        
         B        CRDERR            NOT AT ALL: GIVE ERROR                      
*                                                                               
HNDLTAP2 RES      0         VALID KEYWORD: TEST PRE- OR POST- ANALYSIS          
         AI,R1    -1                MAKE ZERO RELATIVE                          
         SLS,R1   -1                ADJUST FOR 2 NAMES PER OPTION               
         CI,R1    0                 IS IT 'PREREWIND' ?                         
         BE       HNDLTPRW            YES, SET TO REWIND BEFORE TAPE COPY       
*                                                                               
         STW,R1   REWUNLD           ELSE SET POST-ANALYSIS OPERATION            
         B        HNDLTXIT          GO TEST IF MORE OPTIONS                     
*                                                                               
HNDLTAP4 RES      0         PROCESS KEYWORDS WITH PARAMETERS                    
         CW,R8    EBCIN                                                         
         BE       HNDLTPDV          GO TO GET DEVICE NUMBER.                    
         CW,R8    L(C'DO  ')                                                    
         BE       HNDLTPDO          HANDLE DO PARAMMETER                        
         CW,R8    L(C'SKIP')                                                    
         BE       HNDLTPSK          HANDLE SKIP PARAMETER                       
         CW,R8    EBCDUMP                                                       
         BNE      CRDERR                                                        
         PAGE                                                                   
         SPACE    2                                                             
HNDLDUMP RES      0         PROCESS 'DUMP' COMMAND                              
         MTW,-1   #SKIPS            FIRST DUMP ON TAPE IS #1                    
         MTW,+1   PREWIND           ALWAYS REWIND FOR DUMP PARAMETER            
         LI,R1    1                                                             
         STW,R1   NUMDUMPS          ONLY DUMP ONCE IF DUMP PARAMETER            
HNDLTPSK RES      0         PROCESS 'SKIP' OPTION                               
         LI,R1    4                                                             
         STW,R1   1,R7              NOW GET NUMBER OF DUMP IN DECIMAL           
         BAL,R8   SCAN                                                          
         CI,R6    1                                                             
         BL       CRDERR                                                        
         CI,R9    0                                                             
         BNE      CRDERR                                                        
         CI,R8    100                                                           
         BG       CRDERR                                                        
         AW,R8    #SKIPS            ADJUST SKIP CT BY 0 OR -1                   
         LW,R9    R8                                                            
         SCS,R8   1                                                             
         AW,R9    R8                                                            
         STW,R9   #SKIPS                                                        
         B        HNDLTXIT          TEST IF MORE TO SCAN                        
*                                                                               
HNDLTPRW RES      0         PROCESS 'PRE' OPTION: REWIND 1ST                    
         MTW,+1   PREWIND                                                       
         B        HNDLTXIT                                                      
*                                                                               
HNDLTPDO RES      0         PROCESS 'DO' OPTION                                 
         LI,R1    4                                                             
         STW,R1   1,R7              CONVERT NUMBER                              
         BAL,R8   SCAN                                                          
         CI,R6    1                                                             
         BL       CRDERR                                                        
         CI,R9    0                                                             
         BNE      CRDERR                                                        
         STW,R8   NUMDUMPS          AND STORE IT                                
         B        HNDLTXIT                                                      
*                                                                               
HNDLTPDV RES      0         PROCESS INPUT DESIGNATION FOR TAPE                  
        DO       (#SYSTEM='CP-V')                                               
         BAL,R8   SCAN              GET DEVICE OR OPLABEL NAME                  
         CI,R6    0                 ANY ERRORS ?                                
         BL       CRDERR              YES, REPORT                               
         STW,R8   MTDEVADD+1        SAVE NAME                                   
         STW,R9   MTDEVADD+2                                                    
         STW,R10  MTDEVADL          AND LENGTH TO KNOW WHICH                    
        ELSE     (#SYSTEM='CP-R')                                               
         LI,R9    MTDEVADD                                                      
         LW,R8    GIOOBIT                                                       
         OR,R8    GIODBIT                                                       
         STW,R8   MTDEVADD          SET TO SCAN DEVICE OR OPLABEL               
         BAL,R8   GETIOID                                                       
         CI,R6    1                                                             
         BL       CRDERR            B IF NOT END OF FIELD                       
         STW,R10  MTDEVADL          SET FLAG: TAPE ID SPECIFIED                 
        FIN                                                                     
*                                                                               
HNDLTXIT RES      0         END OF OPTION: TEST IF MORE ON SAME LINE            
         CI,R6    2                 END OF INPUT FOUND ?                        
         BE       RDCC                YES, READ NEXT COMMAND INPUT LINE         
         B        HNDLTAPE          NO, SCAN NEXT OPTION                        
*                                                                               
*                                                                               
HNDLEND  RES      0         PROCESS 'END' COMMAND                               
         MTW,+00  NOTFIRST          DOING PARAMS FOR 1ST ANALYSIS ?             
         BEZ      HNDLEXIT            YES, MAKE LOOK LIKE DEFAULT               
*                                                                               
         MTW,-2   CCREAD            DON'T COUNT THE :END; OTHERS READ ?         
         BEZ      NORMEXIT            NO, SAY NOTHING READ AND EXIT             
*                                                                               
         LI,R0    -1                SET CONTROLS READ, BUT NO RETURN            
         STW,R0   CCREAD            AFTER ANALYSIS FOR MORE COMMANDS            
         B        NORMEXIT          RETURN TO DO THE ANALYSIS                   
*                                                                               
HNDLQUIT RES      0         PROCESS 'QUIT' COMMAND: FORCE TERMINATION           
         MTW,+1   NOTFIRST          FAKE NOT INITIAL CALL FOR CMMNDS            
*                                                                               
HNDLEXIT RES      0         COMMON EXIT FOR 'END' AND 'QUIT'                    
         LI,R1    0                 SET NO CONTROL CARDS READ                   
         STW,R1   CCREAD                                                        
         B        NORMEXIT          AND EXIT TO STOP IN ROOT                    
         PAGE                                                                   
         SPACE    2                                                             
HNDLCOMM RES      0                 HANDLE COMMENT CARD                         
         BAL,R8   SCAN                                                          
         CI,R6    2                                                             
         BNE      CRDERR                                                        
         LI,R1    1                                                             
         CW,R8    EBCON                                                         
         BE       HNDLC1                                                        
         LI,R1    0                                                             
         CW,R8    EBCOFF                                                        
         BNE      CRDERR                                                        
HNDLC1   STW,R1   FCOMMENT                                                      
         B        RDCC                                                          
*                                                                               
HNDLDISP RES      0                 HANDLE DISPLAY COMMAND                      
         LI,R1    0                                                             
         STW,R1   NOMAP                                                         
         STW,R1   NOTRACE                                                       
         STW,R1   NOTABLE                                                       
         STW,R1   NODUMP                                                        
         CI,R6    2                    IF END OF CARD                           
         BE       NORMEXIT            YES, RETURN TO ROOT                       
*                                   OTHERWISE, READ LIMIT PAIR                  
         LI,R1    LIMITV                                                        
         STW,R1   LIMPTR                                                        
         LI,R1    0                                                             
         STW,R1   LIMITV                                                        
HNDLDLP  RES      0                                                             
         LI,R1    1                                                             
         STW,R1   1,R7              EBCDIC FIELD                                
         BAL,R8   SCAN                                                          
         CI,R6    0                                                             
         BL       CRDERR                                                        
         LI,R1    1                 1  FOR REAL, 0 FOR NONE, -1 FOR VIRT        
         CW,R8    EBCREAL                                                       
         BE       HNDLDGL           GET THE LIMITS                              
         LI,R1    -1                                                            
         CW,R8    EBCVIRT                                                       
         BE       HNDLDGL                                                       
         CW,R8    EBCNOMA                                                       
         BE       HNDLNOMA                                                      
         CW,R8    EBCNOTA                                                       
         BE       HNDLNOTA                                                      
         CW,R8    EBCNOTR                                                       
         BE       HNDLNOTR                                                      
         CW,R8    EBCNODM           'NODUMP'                                    
         BE       HNDLNODM            YES, SET SAME                             
         B        CRDERR                                                        
HNDLNOMA RES      0                                                             
         STW,R1   NOMAP                                                         
         B        HNDLDX                                                        
HNDLNOTA RES      0                                                             
         STW,R1   NOTABLE                                                       
         B        HNDLDX                                                        
HNDLNOTR RES      0                                                             
         STW,R1   NOTRACE                                                       
         B        HNDLDX                                                        
*                                                                               
HNDLNODM RES      0         'NODUMP'                                            
         STW,R1   NODUMP            SET SWITCH FOR DUMP SUPPRESSION             
         B        HNDLDX            SEE IF MORE PARAMETERS                      
*                                                                               
HNDLDGL  RES      0                 HERE TO HANDLE LIMITS                       
         CI,R6    0                                                             
         BNE      CRDERR                                                        
         STW,R6   NODUMP            RESET 'NODUMP' IF LIMITS GIVEN              
         MTW,1    1,R7              CONVERT TO HEX                              
         STW,R1   *LIMPTR                                                       
         BAL,R8   SCAN                                                          
         CI,R6    0                                                             
         BNE      CRDERR                                                        
         CI,R9    0                                                             
         BNE      CRDERR                                                        
         MTW,1    LIMPTR                                                        
         STW,R8   *LIMPTR                                                       
         MTW,1    LIMPTR                                                        
         BAL,R8   SCAN              CONVERT TO HEX                              
         CI,R6    0                                                             
         BLE      CRDERR                                                        
         CI,R9    0                                                             
         BNE      CRDERR                                                        
         STW,R8   *LIMPTR                                                       
         MTW,1    LIMPTR                                                        
         STW,R9   *LIMPTR                                                       
HNDLDX   RES      0                                                             
         CI,R6    2                                                             
         BNE      HNDLDLP                                                       
         B        NORMEXIT                                                      
         TITLE    '     INITIATE ROUTINE'                                       
         SPACE    2                                                             
*INITIATE SETS UP DCB'S F:X1, F:X2 AND F:X3.  IT THEN CHECKS TO SEE             
*IF THERE IS A TAPE DEVICE.  IF SO, THE TAPE DEVICE IS POSITIONED AND           
*ALL THREE FILES ARE READ FROM TAPE INTO THE APPROPIATE FILES.  IN              
*EITHER EVENT TRANSFER IS MADE TO BEGIN THE DISPLAY.                            
*                                                                               
*                                                                               
*                                                                               
INITIATE RES      0         SET UP FILES TO PROCESS                             
         PUSH     R14                                                           
        DO       (#SYSTEM='CP-V')       SET UP DCB ASSIGNMENTS ?                
         MTW,+00  MTDEVADL          IS THERE TAPE INPUT ?                       
         BLEZ     NORMEXIT            NO, EXIT READY TO GO                      
*                                                                               
        ELSE     (#SYSTEM='CP-R')                                               
*                                                                               
         LW,R1    GIOBITS                                                       
         LW,R0    DATAAREA          GET DATA FILE ASSIGN FLAGS                  
         STS,R0   ASGNDFPT+1        SET THEM IN FPT                             
,ASGNDFPT  M:ASSIGN  F:X1,(FILPTR,DATAAREA+1),(ACNTPTR,DATAAREA+4)              
         LW,R0    CPRAREA           GET FLAGS FOR CPR FILE ASSIGN               
         STS,R0   ASGNCFPT+1        SET THEM IN FPT                             
,ASGNCFPT  M:ASSIGN  F:X2,(FILPTR,CPRAREA+1),(ACNTPTR,CPRAREA+4)                
         LW,R0    MAPAREA           GET FLAGS FOR MAP FILE ASSIGN               
         STS,R0   ASGNMFPT+1        SET THEM IN FPT                             
,ASGNMFPT  M:ASSIGN  F:X3,(FILPTR,MAPAREA+1),(ACNTPTR,MAPAREA+4)                
         MTW,0    MTDEVADL                                                      
         BL       NORMEXIT          B IF NO INPUT TAPE SPECIFIED                
         LW,R0    MTDEVADD          GET FLAGS FOR INPUT TAPE ASSIGN             
         LI,R2    MTDEVADD+1        GET POINTER TO DEV/OPLB NAME                
         CW,R0    GIOOBIT                                                       
         BAZ      %+2                                                           
         OR,R2    =X'80000000'      MUST BE INDIRECT FOR OPLABEL                
         STW,R2   ASGNTPTR          SET POINTER IN FPT                          
         STS,R0   ASGNTFPT+1        SET FLAGS IN FPT                            
,ASGNTFPT  M:ASSIGN  F:X4,(DEVPTR,0,ASGNTPTR)                                   
        FIN                                                                     
*                                                                               
MTREWIND RES      0         PROCESS PRE-PROCESS REWIND OF INPUT TAPE            
         MTW,+0   PREWIND           REWIND REQUIRED BEFORE COPY ?               
         BE       MTSKIPF             NO, GO TEST 'SKIP'S                       
*                                                                               
         CAL1,1   REWX4WT           REWIND INPUT TAPE AND WAIT FOR IT           
         LI,R0    0                 RESET REWIND REQUEST                        
         STW,R0   PREWIND                                                       
*                                                                               
MTSKIPF  RES      0         PROCESS SKIP REQUESTS                               
         LW,R1    #SKIPS            ARE ANY REQUIRED ?                          
         BEZ      MTREAD              NO, START FILE COPIES                     
*                                                                               
MTSKIPF1 RES      0         SKIP A FILE ON THE INPUT TAPE                       
         CAL1,1   PFILX4WT          SKIP A TAPEMARK                             
         BDR,R1   MTSKIPF1                                                      
*                                                                               
         LI,R0    0                 RESET SKIP FILE REQUEST/COUNT               
         STW,R0   #SKIPS                                                        
         PAGE                                                                   
         SPACE    2                                                             
MTREAD   RES      0         COPY DUMP FROM TAPE TO 'DATA' FILE                  
         LD,R0    DFILE1ST          SET TO START WRITING AT GRANULE             
         STW,R0   CRSHRROS          ZERO (OR CP-V KEY 1.000)                    
         CAL1,1   OPENX1            OPEN CRASH DATA FILE                        
         CAL1,1   OPENX3            AND SAVED MAP FILE                          
         M:REW    F:X1                                                          
         M:REW    F:X3                                                          
MTRDLP1  RES      0         COPY THE DATA FILE                                  
         CAL1,1   READATA1          READ A PAGE OF CORE DUMP                    
         CAL1,1   WRITDATA          AND WRITE IT TO TEMP FILE                   
         AWM,R1   CRSHRROS          STEP TO NEXT GRANULE (OR KEY)               
         B        MTRDLP1           READ UNTIL AN END OF FILE READ              
         PAGE                                                                   
         SPACE    2                                                             
TABN1    RES      0         PROCESS ERROR READING DATA FROM F:X4                
         LB,R15   R10               FETCH ERROR CODE                            
         CI,R15   X'05'             IS IT A '!EOD' ?                            
         BE       TABN1B              YES, END OF DATA ON TAPE                  
*                                                                               
         CI,R15   X'06'             IS IT 'EOF'  ?                              
         BE       TABN1B            YES, END OF INFO                            
*                                                                               
         CI,R15   X'1C'             IS IT 'EOT' ?                               
         BNE      ERREXIT             NO, FATAL ERROR                           
*                                                                               
TABN1B   RES      0         END OF INPUT DATA FROM F:X4                         
         CW,R0    CRSHRROS          WERE ANY RECORDS MOVED TO FILE ?            
         BE       TABNEOT             NO, MARK END OF TAPE AND STOP             
*                                                                               
MTRDLP2  RES      0         RETURN FOR DATA FILE TRUNCATED ERRORS               
         LI,R0    0                 SET NO RECORDS MOVED TO MAP FILE            
*                                                                               
MTRDLP3  RES      0         COPY MAP FROM TAPE TO 'MAP' FILE                    
         CAL1,1   READATA2          READ A BLOCK OF MAP INFO                    
         CAL1,1   WRITMAP           AND WRITE IT TO MAP TEMP FILE               
         AI,R0    1                 STEP COUNT OF RECORDS MOVE TO MAP FILE      
         B        MTRDLP3           LOOP TO READ NEXT MAP RECORD                
*                                                                               
*                                                                               
TABN2    RES      0         PROCESS ERROR READING MAP FROM F:X4                 
         LB,R15   R10               FETCH ERROR CODE                            
         CI,R15   X'05'             WAS IT  '!EOD' ?                            
         BE       TABN2B              YES, CONTINUE ON WITH PROCESSING          
*                                                                               
         CI,R15   X'06'             WAS IT  'EOF'   ?                           
         BE       TABN2B            YES, END OF INFO                            
*                                                                               
         CI,R15   X'1C'             IS IT 'EOT' ?                               
         BNE      ERREXIT             NO, FATAL ERROR                           
*                                                                               
TABN2B   RES      0         DATA MOVED FROM TAPE (SORT OF) OK; CONTINUE         
******** M:CLOSE  F:X3                                                          
         CAL1,1   PFILX4            SKIP OVER SAVED CPR SYSTEM FILE             
         DO       (#SYSTEM='CP-V')                                              
          MTW,+00  FGDBKGSW         ARE WE RUNNING ON-LINE ?                    
          BEZ      NORMEXIT           NO, BACKGROUND; JUST EXIT                 
          LI,R2    ERRMSGE          YES, TELL USER WE HAVE FINISHED             
          LI,R1    @MSGE            COPYING FILES FROM TAPE                     
          CAL1,1   CRDERRL                                                      
         FIN                                                                    
         B        NORMEXIT                                                      
*                                                                               
*                                                                               
TABNEOT  RES      0         EOT FOUND ON INPUT TAPE; NO MORE DUMPS              
         MTW,1    EOT               SET END OF INPUT FROM TAPE                  
         MTW,+2   REWUNLD           AND FORCE 'REWIND' POST-PROCESSING          
*                                                                               
NORMEXIT RES      0         NORMAL, OK TO CONTINUE EXIT                         
         PULL     R14                                                           
         AI,R14   1                 SET NORMAL, OK EXIT                         
         B        *R14                                                          
*                                                                               
**************************** E R R E X I T *****************************        
*                                                                               
ERREXIT  RES      0         ERROR EXIT; REPORT ERROR TO ROOT                    
         PULL     R14               RECOVER LINK                                
         B        *R14              EXIT; R10 HAS ZERO OR ERROR CODE            
         TITLE    '     POST-PROCESSING ROUTINE'                                
         SPACE    2                                                             
POSTPOSN RES      0         REWIND OR UNLOAD INPUT TAPE IF REQUESTED            
         PUSH     R14               SAVE RETURN LINK                            
         LW,R0    REWUNLD           IS ANY ACTION REQUIRED ?                    
         BLEZ     NORMEXIT            NO, JUST EXIT FINISHED                    
*                                                                               
         CI,R0    1                 IS ACTION AN 'UNLOAD' ?                     
         BNE      POSTPOS1            NO, ASSUME 'REWIND'                       
*                                                                               
         CAL1,1   UNLDX4            UNLOAD INPUT TAPE                           
         B        POSTPOS2          AND GO CLOSE DCB AGAIN                      
*                                                                               
*                                                                               
POSTPOS1 RES      0         REWIND INPUT TAPE                                   
         CAL1,1   REWX4             REWIND THE TAPE                             
*                                                                               
POSTPOS2 RES      0         INSURE TAPE INPUT DCB IS LEFT CLOSED                
         M:CLOSE  F:X4              CLOSE THE DCB                               
         B        NORMEXIT          AND RETURN TO ROOT FOR NEXT TO DO           
         TITLE    '     ERROR PROCESSING ROUTINES'                              
         SPACE    2                                                             
ANLCCABN RES      0         ABNORMAL CONDITION ON COMMAND READ                  
         LB,R10   R10               TEST IF READING CONTROL CARDS               
         CI,R10   X'06'             BANG CARD READ ?                            
         BE       NORMEXIT            YES, ASSUME END OF INPUT                  
*                                                                               
         CI,R10   X'05'             END OF FILE FOUND ?                         
         BE       NORMEXIT            YES, ALSO END OF INPUT                    
*                                                                               
         LW,R11   ERRMSGX           SET DUMMY FIELD NUMBER                      
*                                                                               
CRDERR   RES      0         ERROR FOUND IN INPUT LINE: REPORT                   
         MTW,-2   CCREAD            DON'T COUNT CARD AS BEING READ              
         STW,R11  ERRMSG+3          SET FIELD IN ERROR                          
         LI,R2    ERRMSG            SET LOC, LEN OF ERROR MESSAGE               
         LI,R1    16                AND LOG IT TO THE OUTPUT                    
         BAL,R14  LOGERR            DEVICE(S)                                   
*                                                                               
CRDERR1  RES      0         TEST IF ERROR CORRECTION ALLOWED                    
         MTW,+00  FGDBKGSW          RUNNING ONLINE ?                            
         BGZ      CRDERR2             YES, WE WILL ALLOW CORRECTION             
*                                                                               
         LI,R10   0                 SET NO FATAL TYPE ERROR FOR ROOT            
         MTW,+00  ATTENDSW          IN CP-R ATTEND MODE ?                       
         BEZ      ERREXIT             NO, FATAL ERROR; ABORT                    
         PAGE                                                                   
         SPACE    2                                                             
CRDERR2  RES      0         TEST IF LOG TO ERROR CORR DEVICE                    
         CAL1,1   IN:EC             DID INPUT COME FROM ERROR CORR DEV ?        
         CI,R8    1                 IF SO, HE HAS ALREADY SEEN INPUT            
         BE       CRDERR4             IT DID, TEST IF HE KNOWS ERROR            
*                                                                               
         CAL1,1   LL:EC               NO, ARE WE LOGGING TO THE DEVICE ?        
         CI,R8    1                 IF YES, ERR MSG ALREADY THERE               
         BE       CRDERR3             YES, JUST GET NEW INPUT LINE              
*                                                                               
         M:WRITE  *ERRDCB,(BUF,ANLCCBFW),(SIZE,81),(BTD,3),(WAIT)               
,CRDERRL M:WRITE  *ERRDCB,(BUF,*R2),(SIZE,*R1),(WAIT)    INFORM ONLINER         
*                                                                               
CRDERR3  RES      0         READ CORRECTION INPUT LINE FROM ERR CORR DEV        
         CAL1,1   READEC            READ ERROR CORRECTION DEVICE                
         LI,R14   PROCESS           FUDGE LINK TO THAT OF NORM READ             
         B        REWRITE           AND GO LOG WHEREEVER NECESSARY              
*                                                                               
CRDERR4  RES      0         INPUT FROM ERR CORR DEV; WAS MSG OUTPUT TOO         
         CAL1,1   LL:EC             HAS IT RECEIVED THE ERROR MESSAGE ?         
         CI,R8    1                 IF YES, HE HAS SEEN ALL                     
         BE       RDCC                SO GO GET ANOTHER INPUT LINE              
*                                                                               
         CAL1,1   CRDERRL           LOG ERROR MESSAGE TO CORR DEVICE            
         B        RDCC              AND GET NEXT INPUT FROM THERE               
         PAGE                                                                   
         SPACE    2                                                             
MTERR1   RES      0         ERROR WRITING DATA TO FILE                          
         LI,R1    DATAAREA          SET NAME OF AREA WE ARE USING               
         B        MTERR             GO COMMON PROCESSING                        
*                                                                               
*                                                                               
MTERR3   RES      0         ERROR WRITING MAP TO FILE                           
         LI,R1    MAPAREA           SET NAME OF FILE/AREA USING                 
         B        MTERR             GO COMMON PROCESSING                        
*                                                                               
*                                                                               
MTERR    RES      0         COMMON WRITE TAPE TO FILE ERROR                     
         LW,R15   R10               SAVE ERROR CODE, DCB ADDRESS                
         LB,R10   R10               GET ERROR CODE                              
         CI,R10   WPCODE            IS IT WRITE RESTRICTED ?                    
         BE       WPERR               YES, INFORM USER                          
*                                                                               
         CI,R10   EOTCODE           EOT REACHED ON A FILE ?                     
         BE       EOTERR              YES, DECIDE WHICH, HOW TO PROCESS         
*                                                                               
         CI,R10   X'03'             DOES THE FILE EXIST ?                       
         BNE      FATALERR            NO, GIVE FATAL ERROR                      
*                                                                               
         LI,R2    ERRMSGB+(@MSGB/4)-3    POINT AT MESSAGE                       
         BAL,R14  FIXFNAME          INSERT FILE NAME IN FILE                    
         LI,R2    ERRMSGB           SET LOC OF ERROR MESSAGE                    
         LI,R1    @MSGB             SET LENGTH                                  
         BAL,R14  LOGERR            LOG TO LL AND MAYBE LO                      
         B        FATALERR                                                      
         PAGE                                                                   
         SPACE    2                                                             
WPERR    RES      0         WRITE TO A WRITE RESTRICTED FILE                    
         PUSH     R8                SAVE 'CONTINUE' RETURN                      
         LI,R2    ERRMSGA+(@MSGA/4)-3    POINT AT MESSAGE                       
         BAL,R14  FIXFNAME          INSERT FILE NAME IN MESSAGE                 
         PULL     R14               GET OK RETURN IN OK TO RETURN REG           
         LI,R2    ERRMSGA           SET LOC OF MESSAGE TO OUTPUT                
         LI,R1    @MSGA             AND LENGTH                                  
         LW,R10   R15               RESTORE ERROR CODE                          
         BAL,R15  CMERRMSG          OUT MSG; TEST IF WE CAN CONTINUE            
         B        ERREXIT           CANNOT; EXIT TO ROOT WITH ERROR             
         PAGE                                                                   
         SPACE    2                                                             
FIXFNAME RES      0         INSERT FILE NAME INTO A MESSAGE                     
*        R1       ADDRESS OF GETIOID CONTROL BLOCK FOR FILE ID                  
*        R2       ADDRESS OF INSERT AREA IN MESSAGE                             
*        R14      LINK                                                          
         PUSH     R14               SAVE LINK                                   
         LCI      2                                                             
         LM,R8    2,R1              GET THE FILE NAME                           
         LW,R10   1,R1              AND THEN THE AREA NAME                      
         SLS,R10  8                 SHIFT 1 CHARACTER OFF FRONT                 
         LI,R1    C'.'                                                          
         STB,R1   R10               AND PUT SEPARATOR '.' IN OTHER              
         LI,R14   C' '              SET UP TO SCAN OFF TRAILING BLANKS          
         LI,R1    7                 IN THE FILENAME                             
*                                                                               
FIXFNAM1 RES      0         LOOK FOR LAST NON-BLANK CHAR IN NAME                
         CB,R14   R8,R1                                                         
         BNE      FIXFNAM2            FOUND IT: STORE NAME                      
         SCD,R8   -8                LAST BLANK; MOVE BLANK TO FRONT             
         B        FIXFNAM1          AND LOOK AGAIN                              
*                                                                               
FIXFNAM2 RES      0         NAME RIGHT JUSTIFIED IN R8,R9                       
         LCI      3                 STORE NAME IN MESSAGE                       
         STM,R8   0,R2                                                          
         PULL     R14               RECOVER LINK                                
         B        *R14              RETURN                                      
         PAGE                                                                   
         SPACE    2                                                             
CMERRMSG RES      0         OUT MSG TO LP, OPER IF RECOVERABLE                  
*        R14      ERROR RECOVERED - CONTINUE     EXIT                           
*        R15      UNRECOVERABLE ERROR            EXIT                           
         PUSH     R14               SAVE POSSIBLE RETURN ADDRESS                
         BAL,R14  LOGERR            LOG ERROR TO LL AND LO                      
         PULL     R14               RECOVER LINK                                
         MTW,+00  ATTENDSW          IS RECOVERY POSSIBLE ?                      
         BEZ      *R15                NO, GO TO NO RECOVERY EXIT                
*                                                                               
         CAL1,1   LL:EC             IS MSG ALREADY ON CORR DEV ?                
         CI,R8    1                 THAT IS, IS LL = EC ?                       
         BE       CMERMSGY            YES, WAIT FOR A CONTINUE OR ABORT         
*                                                                               
         M:WRITE  *ERRDCB,(BUF,*R2),(SIZE,*R1),(WAIT)                           
*                                                                               
CMERMSGY RES      0         WAIT FOR COMMAND TO CONTINUE                        
         M:WAIT                     WAIT IF ATTENDED                            
         B        *R14              THEN GO TRY AGAIN                           
         PAGE                                                                   
         SPACE    2                                                             
EOTERR   RES      0         EOT REACHED ON CRASH OR MAP FILE                    
         CI,R1    DATAAREA          IS IT REALLY THE CRASH DATA FILE ?          
         BNE      FATALERR            NO, IMPOSSIBLE ERROR                      
*                                                                               
         LW,R1    CRSHRROS          COMPUTE NUMBER OF RECORDS MOVED             
         AND,R1   M24               STRIP OFF CP-V KEY-LENGTH                   
         DW,R1    DFILEINC          COMPUTE NUMBER OF RECORDS WRITTEN           
         MI,R1    256               AT 256 WORDS PER RECORD                     
         LI,R2    -5                SET TO OUT 5 DIGITS WORTH                   
         SLS,R1   12                OF LAST ADDRESS VALUE                       
*                                                                               
EOTCRS1  RES      0         PICK A DIGIT OF LAST ADDRESS OFF AND STORE          
         LI,R0    0                 CLEAR DIGIT                                 
         SLD,R0   4                 SHIFT NEXT DIGIT INTO R0                    
         AI,R0    C'0'              MAKE IT A GRAPHIC, MOSTLY                   
         CI,R0    C'9'              IS IT A FUNNY X'FA' OR SO ?                 
         BLE      %+2                 NO, A TRUE GRAPHIC                        
         AI,R0    -(X'FA'-X'C1')    ADJUST TO 'A' TO 'F'                        
         STB,R0   ERRMSGCX,R2       STORE THE DIGIT                             
         BIR,R2   EOTCRS1           AND LOOP FOR NEXT DIGIT                     
*                                                                               
         CAL1,1   PFILX4WT          SKIP OVER REST OF FILE                      
         LI,R2    ERRMSGC           POINT AT MESSAGE                            
         LI,R1    @MSGC             AND SET LENGTH                              
         LI,R14   MTRDLP2           SET CONTINUE RETURN EXIT                    
         LW,R15   R14               SET OK & ABORT EXIT = CONTINUE              
         B        CMERRMSG          AND GO OUTPUT MSG, RECOVER IF CAN           
         PAGE                                                                   
         SPACE    2                                                             
FATALERR RES      0         FATAL ERROR; SET R10 ERROR CODE FOR ROOT            
         LW,R10   R15               RESET ORIGINAL ERROR CODE INFO              
         B        ERREXIT           EXIT                                        
         PAGE                                                                   
         SPACE    2                                                             
        DO       (#SYSTEM='CP-V')                                               
*                                                                               
WPCODE   EQU      X'FF'             WHO KNOWS WHAT THIS IS IN CP-V ???!!        
EOTCODE  EQU      X'42'             EOT ON RANDOM FILE                          
*                                                                               
         BOUND    8                                                             
DFILE1ST DATA     X'03000000'+1000    START KEY FOR CP-V KEYED FILES            
DFILEINC DATA     1000                INCREMENT FOR KEYS                        
*                                                                               
PROMPT   M:PC     ':'               CP-V PROMPT CHARACTER                       
,READCMD M:READ,L *INDCB,(WAIT),(BUF,ANLCCBFR),(SIZE,80),(ABN,ANLCCABN)         
,READEC  M:READ,L *ERRDCB,(WAIT),(BUF,ANLCCBFR),(SIZE,80),(ABN,ANLCCABN)        
,OPENX1  M:OPEN,L F:X1,(ABN,MTERR1),(ERR,MTERR1),(OUTIN),(SAVE)                 
,OPENX3  M:OPEN,L F:X3,(ABN,MTERR3),(ERR,MTERR3),(OUTIN),(SAVE)                 
,READATA1 M:READ,L  F:X4,(BUF,CRSHBUF),(SIZE,1024),(WAIT),(ABN,TABN1)           
,WRITDATA M:WRITE,L F:X1,(BUF,CRSHBUF),(SIZE,1024),(WAIT),(NEWKEY),;            
                  (ONEWKEY),(KEY,CRSHRROS),(ABN,MTERR1),(ERR,MTERR1)            
,READATA2 M:READ,L  F:X4,(BUF,CRSHBUF),(SIZE,80),(WAIT),(ABN,TABN2)             
,WRITMAP  M:WRITE,L F:X3,(BUF,CRSHBUF),(SIZE,80),(WAIT),;                       
                  (ERR,MTERR3),(ABN,MTERR3)                                     
,REWX4   M:REW,L  F:X4                                                          
,PFILX4  M:PFIL,L F:X4,(EOF)        SKIP A FILE ON INPUT TAPE                   
UNLDX4   EQU      REWX4             NO UNLOAD, SO JUST REWIND                   
PFILX4WT EQU      PFILX4            ALL I/O IN CP-V IS ALWAYS WAITED            
REWX4WT  EQU      REWX4             ALL I/O IN CP-V IS ALWAYS WAITED            
         PAGE                                                                   
        ELSE     (#SYSTEM='CP-R')                                               
         PAGE                                                                   
         SPACE    2                                                             
WPCODE   EQU      X'42'             WRITE RESTRICT ERROR                        
EOTCODE  EQU      X'1C'             EOT ON CP-R RANDOM FILES                    
*                                                                               
         BOUND    8                                                             
DFILE1ST DATA     0                 START BLOCK NUMBER FOR CP-R DIRECT          
DFILEINC DATA     1                 ACCESS FILES; INCREMENT = 1                 
*                                                                               
PROMPT   NOP      0                 PROMPT SET IN READ CALS FOR CP-R            
READCMD  M:READ,FPT *INDCB,(WAIT),(BUF,ANLCCBFR),(SIZE,80),;                    
                         (ABN,ANLCCABN),(PROMPT,':')                            
READEC   M:READ,FPT *ERRDCB,(WAIT),(BUF,ANLCCBFR),(SIZE,80),;                   
                         (ABN,ANLCCABN),(PROMPT,':')                            
OPENX1   M:OPEN,FPT F:X1,(ABN,MTERR1),(ERR,MTERR1)                              
OPENX3   M:OPEN,FPT F:X3,(ABN,MTERR3),(ERR,MTERR3)                              
READATA1  M:READ,FPT F:X4,(BUF,CRSHBUF),(SIZE,1024),(WAIT),(ABN,TABN1)          
WRITDATA  M:WRITE,FPT F:X1,(BUF,CRSHBUF),(SIZE,1024),(WAIT),;                   
                  (BLOCK,*CRSHRROS),(ABN,MTERR1),(ERR,MTERR1)                   
READATA2  M:READ,FPT F:X4,(BUF,CRSHBUF),(SIZE,80),(WAIT),(ABN,TABN2)            
WRITMAP   M:WRITE,FPT F:X3,(BUF,CRSHBUF),(SIZE,80),(WAIT),;                     
                  (ERR,MTERR3),(ABN,MTERR3)                                     
REWX4    M:REW,FPT  F:X4,(NOCK)     REWIND INPUT TAPE                           
PFILX4   M:PFIL,FPT F:X4,(SKIP),(NOCK)                                          
UNLDX4   M:UNLD,FPT F:X4,(NOCK)     UNLOAD INPUT TAPE                           
PFILX4WT M:PFIL,FPT F:X4,(SKIP),(WAIT)    SKIP TO NEXT FILE, WAIT FOR IT        
REWX4WT  M:REW,FPT  F:X4,(WAIT)     REWIND INPUT TAPE                           
*                                                                               
*                                                                               
        FIN                                                                     
         PAGE                                                                   
         SPACE    2                                                             
         END                                                                    
