         TITLE    '** RS1002 - R A D E D I T   S E G M E N T   2 **'            
         LIST     0                                                             
         SPACE    2                                                             
         SYSTEM   SIG7FDP                                                       
         SYSTEM   OPTIONS                                                       
*                                                                               
*                                                                               
*  DEFINITIONS                                                                  
         DEF      RADSEG2,SEG2END   BEGIN, END OF THIS SEGMENT                  
*                                                                               
*  COMMANDS PROCESSORS IN THIS SEGMENT                                          
         DEF      MAP                                                           
         DEF      LMAP                                                          
         DEF      SMAP                                                          
         DEF      SPACE                                                         
         DEF      CATALOG                                                       
         DEF      GDSECTOR                                                      
         DEF      BDSECTOR                                                      
         DEF      DPCOPY                                                        
         DEF      CHKBUSY                                                       
*                                                                               
*  UNIVERSAL REFERENCE TO PUSH/PULL STACK SUPPLIED BY OLOAD                     
         REF      U:PCB                                                         
*                                                                               
*                                                                               
*  DCB'S IN CONTEXT SEGMENT                                                     
         REF      M:C,M:LL,M:OC,M:LO                                            
         REF      M:BI,M:BO,M:X1                                                
         REF      F:SI,F:SI2,SIFNAME                                            
         REF      F:SO,F:SO2,SOFNAME                                            
         REF      F:BI,BIBUFF,BIFNAME                                           
         REF      F:LI                                                          
*                                                                               
*  FPT'S IN CONTEXT SEGMENT                                                     
         REF      READSI,SIBUFF,SIBCNT,SICOMPL                                  
         REF      WRITESO,SOBUFF,SOBCNT,SOCOMPL                                 
         REF      RDDISC,RDDISC4,RDDISC5,RDDISC6                                
         REF      WRDISC,WRDISC4,WRDISC5                                        
         REF      READBI,WRITEBO                                                
         REF      ASNFILE                                                       
         REF      TYPE,TYPE1,TYPE2,TYPRERR                                      
         REF      PRINT,PRINT1,PRINT2                                           
         REF      WRITELO,BYTCNT                                                
         REF      SKIPRSI,SKIPNSI,SKIPRSO,SKIPNSO                               
         REF      SKIPRCD,SKIPRCD1,NUMRECS                                      
         REF      SETRSIZE,SETRSIZ2,SETDCBAT                                    
         REF      STIMER,WAITTIME                                               
*                                                                               
* FPT'S DEFINED IN ROOT1                                                        
         REF      OPENC,OPENLL,OPENOC,OPENANY                                   
         REF      OPENSI,OPENSO,OPENSL,OPFLEIN                                  
         REF      CLOSESO,CLOSESI,CLOSEANY                                      
         REF      CLFLEIN,CLOSEBI,CLOSEBO,CLOSEOC                               
         REF      CLOSELL,CLOSELI,CLOSEX1,CLOSESL                               
         REF      READBIH,READLI,READX1,RDDISCS                                 
         REF      WRITEBOH,WRITEX1,WRDISCS                                      
         REF      REWINDBI,REWINDBO,REWINFBI,REWINDSO                           
         REF      UNLOADBO,SKIPFSO,FSKIPLI,SKIPFILE,SETX1                       
         REF      REWIND,WEOF,UNLOAD                                            
         REF      VFCSO0,VFCSO1,WEOFSO,WEOFBO                                   
         REF      MODESI0,MODESO0,MODESI1,MODESO1                               
         REF      MODESODD,MODESOND                                             
         REF      ASNAREA,ASNDEV,ASNOPLB                                        
         REF      GETAINFO,GETFILNM,GETRSIZE                                    
*                                                                               
*  ERROR MESSAGES IN CONTEXT SEGMENT                                            
         REF      MESS0,MESS2,MESS4,MESS5,MESS9                                 
         REF      MESS14,MESS18,MESS20,MESS21,MESS22,MESS23                     
         REF      MESS40,MESS41                                                 
*                                                                               
*  ERROR MESSAGES IN ROOT1 (RS1000)                                             
         REF      MESS1,MESS7,MESS8,MESS10                                      
         REF      MESS11,MESS16,MESS19,MESS28                                   
         REF      MESS30,MESS31,MESS32,MESS35                                   
*                                                                               
*  MISC VARIABLES IN CONTEXT SEGMENT                                            
         REF      BCKEND,BPEND,BPEND1,BACKSZE,BCKSZE                            
         REF      SPARAM,SPARAMF1,SPARAMF2                                      
         REF      BUFF1,BUFF2,BUFF3,BUFF4                                       
         REF      LIBFLAG,LINEIMAG,COLPTR                                       
         REF      AREANAME,FILENAME,AREA,ACNTNAME                               
         REF      AREAASGN,DEVASGN,OPLBASGN                                     
         REF      GIOCT                                                         
         REF      MAPSW,MAXMASD                                                 
         REF      ERRFCN,ERRORSW,CONESW                                         
         REF      FREECELL,DIRCHAIN,ENDCHAIN                                    
*                                                                               
* DATA DEFINED IN ROOT1                                                         
         REF      ZEROS,BLNK,DCW1,DCW2,DCTDATA,DCBOPENF                         
         REF      FPSP,CKXA,CKXABT                                              
         REF      ILLNMES,ILLTOTL                                               
         REF      M1,M2,M3,M4,M5,M6,M7,M8,M9                                    
         REF      M14,M15,M16,M17,M19,M24,M31                                   
         REF      ML8,ML15,ML16,ML24                                            
         REF      X200000,Y8                                                    
         REF      KWFILE,KWLIB,KWALL                                            
         REF      STATFLAG                                                      
         REF      GIOBITS,GIOOBIT,GIODBIT,GIOFBIT,GIOABIT,GIOFA                 
*                                                                               
*  TABLES IN CONTEXT SEGMENT                                                    
         REF      AREASWS,AREASWSX                                              
         REF      MASTDICT,MASDNAME,MASDBOA,MASDEOA                             
         REF      MASDSIZE,MASDTPC,MASDSPT,MASDWPS                              
         REF      MASDWP,MASDDEVA,MASDDCTI,MASDMODL                             
         REF      MASDZERO,MASDLEOF,MASDFREE,MASDUSED                           
         REF      MASDLOST,MASDNDS,MASDNFIL,MASDFRMT,MASDEND                    
         REF      DIRENAME,DIREBOT,DIREEOT,DIRENSEC                             
         REF      DIREFSIZ,DIRERSIZ,DIREGSIZ,DIRERF                             
         REF      DIREORG,DIRESD,DIRESTAT,DIREXTNT,DIRELEN                      
         REF      DIREESIZ,DIREACNT,DIREFIX,DIREPRIO,DIREEND                    
         REF      DIREUSEC                                                      
         REF      DIREDATE                                                      
         REF      DIREYEAR,DIREMON,DIREDAY,DIREHOUR,DIREMIN                     
         REF      MODULE,EBCDIC,DEFREF,MODIR                                    
*                                                                               
* CONSTANTS USED THROUGH OUT THE SYSTEM                                         
*             AREA INDICIES                                                     
         REF      SPINDEX,FPINDEX,BPINDEX,BTINDEX                               
         REF      XAINDEX,CKINDEX,ISINDEX,OSINDEX                               
*            FILE DIRECTORY FORMAT INDEX DEFINITIONS                            
         REF      DIRSIZE,DIRLHDR,LNDIRHDR                                      
         REF      DIRINFO,DIRNEXT,DIRIDW1,DIRIDW2                               
         REF      DIRNAM1,DIRNAM2,DIRFLGS,DIRLEN,DIRGRSZ,DIRFSIZ                
         REF      DIRBOT,DIREOT,DIRXTNT,DIRESIZ,DIRACT1,DIRACT2                 
         REF      DIRUNB,DIRBLK,DIRCOMP,DIRSEQN,DIRDIRC                         
*            VALUES SET AND USED BY 'UNPKDIRE'                                  
         REF      ORGUNB,ORGBLK,ORGCOMP                                         
         REF      FILDELTD,FILBDTRK,FILGOODF,FILENTRY,LDIREHDR                  
*             VALUES USED TO BUILD LINKED CORE DIRECTORIES                      
         REF      BACLINK,FWDLINK,XBACLINK,XFWDLINK,SIZEDIR                     
*                                                                               
*  ROUTINES IN ROOT1                                                            
         REF      EXEC,EXEC1                                                    
         REF      SCAN,PROCSCN,TYPRNT,PROCKYIN                                  
         REF      GETIOID,GETFID,GETDEV,GETOPLB,GETANY                          
         REF      ABORT,END,ABNERR,ABNADDR,ERADDR                               
         REF      ABNCONT,ABNRETRY,ABNABORT,WPERR,OPENERR                       
         REF      ERROROUT,ERRORINA,ERROR%PL,OUTFILNM,OUT%MSG                   
         REF      ERROR01,ERROR02,ERROR04,ERROR05,ERROR06                       
         REF      ERROR10,ERROR11,ERROR19,ERROR28,ERROR35,ERROR41               
         REF      GETFSTSD,GETNXTSD,GET1SFIL,GETNXFIL                           
         REF      GETAX,UNPKMASD,UNPKDIRE,GAN,PACKDIRE                          
         REF      FNDROM                                                        
*                                                                               
*  GENERAL PRINT-LINE / PRINT ROUTINES                                          
         REF      %PL               PRINT LINE BUFFER                           
         REF      %CP               CURRENT CHARACTER POSITION IN %PL           
         REF      %TITLINE          TITLE LINE FOR PAGE HEADERS                 
         REF      %19@3             LINES REMAINING ON PAGE                     
         REF      %19@4             SWITCH: TITLE LINE TO BE OUTPUT             
         REF      %1        CLEAR THE PRINT LINE                                
         REF      %2        SET CP                                              
         REF      %3        STEP CP                                             
         REF      %4        STORE CHARACTER                                     
         REF      %5        STORE TEXT STRING                                   
         REF      %6        STORE TEXTC STRING                                  
         REF      %7        STORE TIME                                          
         REF      %8        CONVERT AND STORE INTEGER                           
         REF      %9        ENTER DATE                                          
         REF      %11       PRINT PRINT LINE                                    
         REF      %12       PRINT PRINT LINE, UPSPACE CONTROL                   
         REF      %13       PAGE PRINTER AND OUT ANY TITLE LINE                 
         REF      %14       PAGE PRINTER AND PRINT THE PRINT-LINE               
         REF      %15       PRINT A TEXT STRING                                 
         REF      %16       PRINT A TEXTC STRING                                
*                                                                               
*                                                                               
*  REFERENCES PARTICULAR TO SEGMENT 2                                           
         REF      MAPTABLE,MAPEBCDC,MAPDEFRF,MAPMODIR                           
         REF      NFIL                                                          
         REF      READAFPT,RABUF,RABYTES,RASEC                                  
         REF      READBFPT,RBBUF,RBBYTES,RBSEC                                  
         REF      WRITAFPT,WABUF,WABYTES,WASEC                                  
         REF      WRITBFPT,WBBUF,WBBYTES,WBSEC                                  
         REF      CHKFPT                                                        
         REF      DPFLAGS,NEXTSEC,ENDSEC,SECTX,SECTSIZE                         
         REF      #TOZERO,INMAXS,OUTMAXS,OFFSEC                                 
*                                                                               
*                                                                               
DCTINDEX EQU      SECTX                                                         
*                                                                               
*                                                                               
FROMLIM  EQU      BUFF4                                                         
TOLIM    EQU      BUFF4+2                                                       
         TITLE    '** RS1002 - PROCEDURE DEFINITIONS **'                        
         SPACE    2                                                             
PUSH     CNAME    1                 PUSH REGISTERS INTO STACK                   
PULL     CNAME    0                 PULL REGISTERS FROM STACK                   
         PROC                                                                   
        DO       NUM(AF)=1          SAVE ONLY ONE REGISTER ?                    
LF(1)    GEN,8,4,20        X'8'+NAME,AF(1),U:PCB                                
        ELSE     NUM(AF)=0          SAVE MULTIPLE REGISTERS                     
LF(1)    LCI      AF(1)&X'F'                                                    
         GEN,8,4,20        X'A'+NAME,AF(2),U:PCB                                
        FIN                                                                     
         PEND                                                                   
         SPACE    2                                                             
BIFFGD   CNAME    4                                                             
         PROC                                                                   
LF       LC       *STATFLAG                                                     
         GEN,1,7,4,3,17  AFA(1),X'68',NAME,AF(2),AF(1)                          
         PEND                                                                   
*                                                                               
*                                                                               
ERRP     CNAME                      DEFINE ERR FUNCTION TABLES                  
         PROC                                                                   
         DO       NUM(AF)>0                                                     
LF        GEN,8,24  AF(1),AF(2)     DEFINE A FUNCTION WORD                      
         ELSE                                                                   
LF        GEN,32    0               ELSE SET END OF LIST                        
         FIN                                                                    
         PEND                                                                   
         OPEN     Q,I                                                           
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                                                           
         LIST     0                 DO NOT LIST % ROUTINE PROCS                 
         SPACE    3                                                             
************************************************************************        
*                                                                               
         OPEN     ARG,ARGA                                                      
         SPACE    2                                                             
***********************************************************************         
*                                                                               
*                                                                               
*                 LOAD REGISTER WITH ARGUMENT FOR A % ROUTINE.                  
*        CALL:                                                                  
*              LF ARG,REG  AF(I)                                                
*                 WHERE LF IS THE LABEL FIELD FROM THE %ROUTINE CALL,           
*                       REG IS THE REGISTER TO BE LOADED IF THERE IS            
*                       AN ARGUMENT PRESENT, AND                                
*                       AF(I) IS THE I-TH ARGUMENT TO THE %ROUTINE.             
*                 IF AF(I) IS NULL,  LF  IS DEFINED BY A RES 0                  
*                                                                               
ARG      CNAME                                                                  
         PROC                                                                   
         DO       NUM(AF)>0         AN ARGUMENT GIVEN ?                         
          DO       TCOR(AF,S:INT,S:C)>0    IS IT A CONSTANT ?                   
           DO       SCOR(AF,R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,;   IS IT A           
                            R10,R11,R12,R13,R14,R15)>0        REGISTER ?        
LF          LW,CF(2)  AF                LOAD VALUE FROM WORD (REG)              
           ELSE                     SCOR = 0  ==> CONSTANT                      
LF          LI,CF(2)  AF                LOAD CONSTANT                           
           FIN                                                                  
          ELSE                      TCOR = 0 ==> NOT A CONSTANT                 
LF         LW,CF(2)  AF                 IT IS A SYMBOL; LOAD FROM IT            
          FIN                                                                   
         ELSE                                                                   
          DO       NUM(LF)>0        IS THERE A LABEL ?                          
LF         RES      0               DEFINE IT                                   
          FIN                                                                   
         FIN                                                                    
         PEND                                                                   
***********************************************************************         
         SPACE    3                                                             
***********************************************************************         
*                                                                               
*                                                                               
*        LOAD PARAMETER REGISTER WITH ARGUMENT ADDRESS FOR A % ROUTINE          
*        CALL:                                                                  
*              LF ARGA,REG   AF(I)                                              
*                 WHERE  LF  IS THE LABEL FIELD FROM THE %ROUTINE CALL,         
*                        REG IS THE REGISTER TO BE LOADED, IF THERE             
*                          IS AN ARGUMENT PRESENT, AND                          
*                        AF(I)  IS THE I-TH ARGUMENT TO THE %ROUTINE            
*                 IF AF(I) IS NULL, LF IS DEFINED BY A  RES  0                  
*                                                                               
ARGA     CNAME                                                                  
         PROC                                                                   
         DO       NUM(AF)>0         AND PARAMETERS ?                            
          DO       ((NUM(AF)=1)&(AFA(1)=0))                                     
LF         LI,CF(2)   AF                                                        
          ELSE                                                                  
LF         LW,CF(2)   AF                                                        
          FIN                                                                   
         ELSE                                                                   
          DO       NUM(LF)>0                                                    
LF         RES      0                                                           
          FIN                                                                   
         FIN                                                                    
         PEND                                                                   
***********************************************************************         
         SPACE    3                                                             
CLRPL    CNAME                                                                  
*                          CLEAR CURRENT PRINT LINE                             
         PROC                                                                   
LF       BAL,R14  %1                CLEAR THE PRINT LINE                        
         PEND                                                                   
         SPACE    3                                                             
SETCP    CNAME                                                                  
*                          SET CHARACTER POINTER (CP)                           
*                 R15 <= NEW VALUE OF CP                                        
         PROC                                                                   
LF       ARG,R15  AF                GET NEW CP VALUE                            
         BAL,R14  %2                SET IT                                      
         PEND                                                                   
         SPACE    3                                                             
STEPCP   CNAME                                                                  
*                           STEP CP LEFT OR RIGHT                               
*                 R15 <= CP STEP VALUE                                          
*                                   R15 > 0 ==>  RIGHT                          
*                                   R15 = 0 ==>  NO CHANGE                      
*                                   R15 < 0 ==>  LEFT                           
*                 R15 IS RETURNED WITH NEW VALUE OF CP                          
         PROC                                                                   
LF       ARG,R15  AF                GET STEP VALUE                              
         BAL,R14  %3                SET IT                                      
         PEND                                                                   
         SPACE    3                                                             
CHAR     CNAME                                                                  
*                          STORE CHARACTER IN PL                                
*                 R15 <= CHARACTER TO STORE, IN RIGHTMOST BYTE                  
         PROC                                                                   
LF       ARG,R15  AF                GET CHARACTER IF GIVEN                      
         BAL,R14  %4                STORE AWAY                                  
         PEND                                                                   
         SPACE    3                                                             
CHARS    CNAME    %5                                                            
PRTCHR   CNAME    %15                                                           
*                           STORE CHARACTER (TEXT) STRING  (,AND PRINT)         
*                 R2  <= WORD ADDRESS OF START OF 'TEXT' STRING                 
*                 R1  <= NUMBER OF CHARACTERS TO STORE                          
*                 R0  <= BYTE INDEX RELATIVE TO R2 OF 1ST CHARACTER             
         PROC                                                                   
LF       ARG,R1   AF(1)             GET STRING LENGTH                           
         ARGA,R2  AF(2)             GET START ADDRESS                           
         DO       NUM(AF(3))>0      OFFSET GIVEN ?                              
          ARG,R0   AF(3)            GET OFFSET                                  
         ELSE                                                                   
          DO1      NUM(AF)>0        SET DEFAULT ONLY IF PARAMS GIVEN            
          LI,R0    0                ELSE START AT 1ST CHARACTER                 
         FIN                                                                    
         BAL,R14  NAME              CALL REQUESTED ROUTINE                      
         PEND                                                                   
         SPACE    3                                                             
STRNG    CNAME    %6                                                            
PRTTXT   CNAME    %16                                                           
*                           STORE TEXTC STRING (, AND PRINT)                    
*                 R2  <= ADDRESS OF START OF TEXTC STRING                       
         PROC                                                                   
LF       ARGA,R2  AF                LOAD ADDRESS OF TEXTC STRING                
         BAL,R14  NAME                                                          
         PEND                                                                   
         SPACE    3                                                             
TIME     CNAME                                                                  
*                           CONVERT AND STORE INTEGER AS TIME                   
*                 R15 <= TIME, IN SECONDS, TO BE CONVERTED                      
         PROC                                                                   
LF       ARG,R15  AF                GET TIME                                    
         BAL,R14  %7                CONVERT AND STORE                           
         PEND                                                                   
         SPACE    3                                                             
INTGR    CNAME                                                                  
*                           CONVERT AND STORE INTEGER                           
*                 R0  <= BASE OF CONVERSION (10 = DEC, 16 = HEX, 2 = BIN)       
*                 R1  <= FILL CHARACTER FOR LEADING UNUSED POSITIONS            
*                 R2  <= WIDTH OF FIELD (NUMBER OF DIGITS TO OUTPUT)            
*                 R15 <= INTEGER TO CONVERT (AS A 32 POSITIVE INTEGER)          
         PROC                                                                   
         DO       NUM(LF)>0                                                     
LF        RES      0                                                            
         FIN                                                                    
         OPEN     I                                                             
         DO       NUM(AF(1))>0                                                  
I         SET      SCOR(AF(1),DEC,HEX,BIN)                                      
           DO       I>0                                                         
            DO1      I=1                                                        
            LI,0     10             SET DECIMAL                                 
            DO1      I=2                                                        
            LI,0     16             SET HEX                                     
            DO1      I=3                                                        
            LI,0     2              SET BINARY                                  
           ELSE                                                                 
            ARG,R0   AF(1)          SET BASE                                    
           FIN                                                                  
         FIN                                                                    
*                                                                               
         DO       NUM(AF(2))>0                                                  
I         SET      SCOR(AF(2),SPAC,ZERO)                                        
           DO       I>0                                                         
            DO1      I=1                                                        
            LI,1     C' '           SET LEADING SPACES                          
            DO1      I=2                                                        
            LI,1     C'0'           SET LEADING ZEROES                          
           ELSE                                                                 
            ARG,R1   AF(2)          GET LEADING/FILL CHARACTER                  
           FIN                                                                  
         FIN                                                                    
*                                                                               
         ARG,R2   AF(3)             SET NUMBER OF DIGIT PLACES                  
         ARG,R15  AF(4)             SET VALUE TO CONVERT                        
         CLOSE    I                                                             
         BAL,R14  %8                CONVERT AND ENTER                           
         PEND                                                                   
         SPACE    3                                                             
DATE     CNAME                                                                  
         PROC                                                                   
LF       BAL,R14  %9                GET AND ENTER DATE                          
         PEND                                                                   
         SPACE    3                                                             
PRNT     CNAME    1                                                             
PRTUP    CNAME    0                                                             
*                 FOR PRTUP:                                                    
*                 R15 <= UPSPACE COUNT IN NUMBER OF LINES; |N| < 8              
*                                   R15 > 0 ==> UPSPACE AFTER PRINT             
*                                   R15 = 0 ==> DO NOT UPSPACE                  
*                                   R15 < 0 ==> UPSPACE BEFORE PRINT            
         PROC                                                                   
         DO       NAME                                                          
LF        BAL,R14  %11              SIMPLY PRINT THE LINE                       
         ELSE                                                                   
LF        ARG,R15  AF               GET UPSPACE COUNT,                          
          BAL,R14  %12              THEN PRINT WITH UPSPACE                     
         FIN                                                                    
         PEND                                                                   
         SPACE    3                                                             
PRTPAG   CNAME                                                                  
         PROC                                                                   
LF       BAL,R14  %14               PAGE THE PRINTER, PRINT PL                  
         PEND                                                                   
         SPACE    3                                                             
EJECT    CNAME                                                                  
*                           POSITION PRINTER AT TOP OF NEW PAGE                 
*                 (IF A TITLE LINE EXISTS, PRINT AT TOP OF PAGE AND             
*                 (POSITION PRINTER AT NEXT LINE.                               
         PROC                                                                   
LF       BAL,R14  %13               EJECT PRINTER TO 1ST LINE OF NEW PAGE       
         PEND                                                                   
         SPACE    3                                                             
         CLOSE    ARG,ARGA                                                      
         LIST     1                                                             
         TITLE    '** RS1002 - OTHER DEFINITIONS **'                            
         SPACE    2                                                             
R0       EQU      0                                                             
R1       EQU      1                                                             
R2       EQU      2                                                             
R3       EQU      3                                                             
R4       EQU      4                                                             
R5       EQU      5                                                             
R6       EQU      6                                                             
R7       EQU      7                                                             
LINK     EQU      8                                                             
R8       EQU      8                                                             
R9       EQU      9                                                             
R10      EQU      10                                                            
R11      EQU      11                                                            
R12      EQU      12                                                            
R13      EQU      13                                                            
R14      EQU      14                                                            
R15      EQU      15                                                            
RLNK     EQU      R14               NEW STANDARD LINKAGE REGISTER               
         PAGE                                                                   
         SPACE    2                                                             
*                           FPT PARAM PRESENT AND FLAG BIT DEFINITIONS          
P0       EQU      1**23                                                         
P1       EQU      1**31                                                         
P2       EQU      1**30                                                         
P3       EQU      1**29                                                         
P4       EQU      1**28                                                         
P5       EQU      1**27                                                         
P6       EQU      1**26                                                         
P7       EQU      1**25                                                         
P8       EQU      1**24                                                         
P9       EQU      1**23                                                         
P10      EQU      1**22                                                         
P11      EQU      1**21                                                         
P12      EQU      1**20                                                         
P13      EQU      1**19                                                         
P14      EQU      1**18                                                         
P15      EQU      1**17                                                         
P16      EQU      1**16                                                         
*                                                                               
F7       EQU      1                                                             
F6       EQU      2                                                             
F5       EQU      4                                                             
F4       EQU      8                                                             
F3       EQU      16                                                            
F2       EQU      32                                                            
F1       EQU      64                                                            
F0       EQU      128                                                           
F8       EQU      256                                                           
         PAGE     BITS AND INDICATORS FOR 'CATALOG'  & 'MAP', 'LMAP'            
*                                                                               
*                 DEFINITION OF CONSTANTS & OFFSETS FOR 'CATALOG'               
*                                                                               
*                           FORMAT OF CHAINED FILE ENTRY                        
FILNAM   EQU      0                 FILE NAME                                   
FILACNT  EQU      2                 ACCOUNT NAME                                
FILAREA  EQU      4                 AREA NUMBER / ORG                           
FILFSIZ  EQU      5                 FILE SIZE, IN RECORDS                       
BLINK    EQU      6                 BAC LINK TO PREVIOUS FILE                   
FLINK    EQU      7                 FWD LINK TO NEXT FILE                       
FILLEN   EQU      8                 NUMBER OF WORDS IN AN ENTRY                 
*                                                                               
*                          COLUMN INDICIES FOR PRINTING FILE INFO               
CPCATORG EQU      2                 FILE'S ORGANIZATION                         
CPCATSIZ EQU      5                 FILE SIZE                                   
CPCATNAM EQU      11                NAME.AREA.ACCOUNT                           
*                                                                               
*                                                                               
*                                                                               
*                 CONSTANTS FOR  'MAP'                                          
*                                                                               
*                                                                               
*                          CONSTANTS FOR COMPUTING RECORDS REMAINING            
BLKSIZE  EQU      256               ASSUMED WORDS/SECTOR AS PER ALLOCATE        
#CRPB    EQU      25                NUMBER OF COMPRESSED RECORDS/BLOCK          
*                                                                               
*                          'DEF' AND 'REF' FLAGS IN 'DEFREF' LIB FILE           
DEFSFLAG EQU      X'4000'           ENTRY IS A 'DEF'                            
REFSFLAG EQU      X'8000'           ENTRY IS A 'REF'                            
DSCTFLAG EQU      X'C000'           ENTRY IS A 'DSECT'                          
         PAGE     COLUMN INDICIES FOR MAP OUTPUT PROCESSING                     
*                                                                               
*                          COLUMN NUMBERS FOR AREA INFORMATION                  
CPAREA   EQU      01                AREA NAME                                   
CPDEVA   EQU      08                DEVICE NAME/ADDRESS                         
CPWPS    EQU      17                WORDS PER SECTOR                            
CPSPT    EQU      25                SECTORS PER TRACK                           
CPBOA    EQU      35                BEGIN OF AREA                               
CPEOA    EQU      44                END   OF AREA                               
CPWP     EQU      54                WRITE PROTECT                               
*                                                                               
*                          COLUMN NUMBERS FOR FILE INFORMATION (MAP, LMAP)      
CPFILE   EQU      01                FILENAME.ACCOUNTNAME                        
CPXTNT   EQU      18                EXTENT NUMBER                               
CPORG    EQU      24                ORGANIZATION (FORMAT)                       
CPFLAGS  EQU      26                RES FGD, FIX, SEQ, DIR FLAGS                
CPBOT    EQU      31                BEGIN OF FILE                               
CPEOT    EQU      38                 END  OF FILE                               
CPGSIZ   EQU      46                GRANULE SIZE                                
CPRSIZ   EQU      55                RECORD  SIZE                                
CPFSSEC  EQU      63                FILE SIZE (SECTORS)                         
CPFSIZ   EQU      70                FILE    SIZE                                
CPREMAIN EQU      78                RECORDS REMAINING                           
CPESIZ   EQU      85                EXTENSION FILE SIZE                         
CPDATE   EQU      93                DATE LAST WRITTEN                           
CPPRIO   EQU      93                PRIORITY FOR IS & OS FILES                  
*                                                                               
*                          COLUMN NUMBERS FOR SHORT MAP INFORMATION             
CPFSIZS  EQU       1                FILE SIZE                                   
CPFILES  EQU       8                FILE NAME AND ACCOUNT NAME                  
*                                                                               
*                          COLUMN NUMBERS FOR LIBRARY INFORMATION               
CPLNUM   EQU       1                NUMBER OF ROM IN LIBRARY                    
CPLNAME  EQU       6                MODULE NAME                                 
CPLMODX  EQU      20                MODULE INDEX IN MODULE FILE                 
CPLLEN   EQU      26                NUMBER OF RECORDS IN MODULE                 
CPLDEFS  EQU      31                START OF DEF NAMES                          
CPLREFS  EQU      60                START OF REF NAMES                          
         PAGE                                                                   
         SPACE    2                                                             
*                           REFERENCES TO MONITOR TABLES                        
*                                                                               
K:NUMDA  EQU      X'14B'            HIGHEST VALID MASTD INDEX VALUE             
K:DCT1   EQU      X'176'            NUMBER OF DEVICE ENTRIES                    
K:DCT16  EQU      X'177'            DEVICE TYPE INDEX ADDRESS                   
K:MDNAME EQU      X'212'            ADDRESS OF MDNAME TABLE                     
K:MONTH  EQU      X'1EA'                                                        
         TITLE    '** RS1002 - CONSTANTS AND MESSAGES FOR SEG 2 **'             
         SPACE    2                                                             
RADSEG2  EQU      %         START OF THE SEGMENT                                
*                                                                               
*                                                                               
*                                                                               
*                           TEXT CONSTANTS FOR 'MAP', 'LMAP'                    
         BOUND    4                                                             
FORMATC  DATA,1   'U','B','C'       FORMAT INDICATORS FOR MAP OUTPUT            
         BOUND    4                                                             
WRITEMOD TEXT     '  ',;            WRITE MODE NOT SET                          
                  'D ',;            WRITTEN DIRECTLY                            
                  'S ',;            WRITTEN SEQUENTIALLY                        
                  'SD'              BOTH SET SOMEHOW                            
         BOUND    4                                                             
*                  0   1   2   3   4   5    INDEX                               
WPVAL    DATA,1   'P','B','F','S','M','X'   WRITE PROTECTION CODES              
         PAGE                                                                   
         SPACE    2                                                             
         BOUND    4                                                             
AHDR0    TXTC     'AREA:'           'SMAP' HEADER FOR AREA INFO                 
AHDR1    TXTC     'AREA   DEVICE-  WORDS/  SECTORS/  BEGIN    ',;               
                  'END     WRITE'                                               
AHDR2    TXTC     '       ADDRESS  SECTOR  TRACK     SECTOR   ',;               
                  'SECTOR  PROTECT'                                             
*                                                                               
FILHDR0  TXTC     '#RECS  FILENAME.ACCOUNT'                                     
FILHDR1  TXTC     '                         FLGS AREA RELATIVE',;               
                  '  GRANULE  RECORD  FILE   FILE   APPROX  EXTEND ',;          
                  '  DATE'                                                      
FILHDR2  TXTC     'FILENAME.ACCOUNT XTNT         BEGIN  END   ',;               
                  '  SIZE     SIZE    SIZE   SIZE   RECORDS SIZE   ',;          
                  '  LAST'                                                      
FILHDR3  TXTC     '                      ORG     SECTOR SECTOR',;               
                  '  (BYTES)  (BYTES) (SECS) (RECS) REMAIN  (SECS) ',;          
                  '  WRTN'                                                      
DASHES   TXTC     '   --'           MARKER,COMPRESSED RECS REMAIN <0            
*                                                                               
SUMRY    TXTC     'AREA CONTAINS NO FILES'                                      
SUMRY1   TXTC     'REMAINING SECTORS:  '                                        
SUMRY2   TXTC     'SECTORS RECOVERABLE:'                                        
SUMRY3   TXTC     'NUMBER OF FILES:    '                                        
SUMRYX   TXTC     'AREA HAS AN INVALID DIRECTORY'                               
*                                                                               
MAPLIBTL TXTC     ' MAP OF LIBRARY IN AREA'                                     
MAPLIBMD TXTC     '     MODULE NAME  INDEX  LEN  DEFS'                          
MAPLIBRF TXTC     'REFS'                                                        
         PAGE                                                                   
         SPACE    2                                                             
*                 MESSAGE TEXT FOR 'BDSECTOR'                                   
*                                                                               
BDSECMF  TXTC     'FILE '           PREFIX FOR 'FID' WHEN FILE ALTERED          
BDSECMD  TXTC     ' DESTROYED'                                                  
BDSECMT  TXTC     ' TRUNCATED'                                                  
*                                                                               
*                                                                               
*                 MESSAGES FOR 'CATALOG'                                        
*                                                                               
CATHEADR TXTC     'ORG #RECS NAME'                                              
CATAREA  TXTC     'AREA'                                                        
CATACNT  TXTC     'ACCOUNT'                                                     
CATNFILS TXTC     'NO FILES'                                                    
CATFILE  EQU      BDSECMF                                                       
CATNXIST TXTC     ' DOES NOT EXIST'                                             
CAT#FILS TXTC     ' FILES LISTED.'                                              
CATOFLOW TXTC     'SORT SPACE EXHAUSTED. SEARCH STOPPED ON FILE '               
         TITLE    '** RS1002 - M A P    &   S M A P   **'                       
         SPACE    2                                                             
SPACE    EQU      %                 SPACE REMAINING COMMAND                     
         LI,R0    -1                                                            
         B        MAPSMAP                                                       
MAP      EQU      %         'MAP'   PRINT DIRECTORY MAP (S)                     
         LI,R0    1                 SET DOING 'MAP'                             
         B        MAPSMAP           GO DO COMMON PROCESSING FOR MAP, SMAP       
*                                                                               
         SPACE    3                                                             
SMAP     EQU      %         'SMAP'  PRINT SHORT DIRECTORY MAP(S)                
         LI,R0    0                 SET DOING 'SMAP'                            
*                                                                               
         SPACE    3                                                             
MAPSMAP  EQU      %         'MAP' & 'SMAP'  COMMON PROCESSING                   
         STW,R0   MAPSW             SET WHICH IS BEING DONE                     
         LI,RLNK+1 1                SET BT, CK, IS, OS OK IN 'GAN'              
         BAL,RLNK GAN               PROCESS AREA NAMES                          
         B        ERROROUT            ERROR OF SOME SORT; REPORT AS IS          
*                                                                               
         LW,R0    K:NUMDA           SET HIGHEST AREA TO PROCESS                 
         STW,R0   MAXMASD           SET MAX MASTD INDEX TO PROCESS              
*                                                                               
         LI,R4    -1                 SET TO PROCESS THE FIRST AREA              
         PAGE                                                                   
         SPACE    2                                                             
MAPS     EQU      %         START NEXT MAP ON A NEW PAGE                        
         EJECT                      PAGE PRINTER                                
*                                                                               
MAPS0    EQU      %         TEST IF DONE. START NEXT AREA IF NOT                
         AI,R4    1                 STEP TO NEXT AREA                           
         CW,R4    MAXMASD           IS THIS THE END OF THE REQUESTS ?           
         BG       MAPSEXIT            YES, EXIT                                 
*                                                                               
         LB,R0    AREASWS,R4        IS THIS AREA TO BE DONE ?                   
         BEZ      MAPS0               NO, STEP TO NEXT                          
*                                                                               
         STW,R4   AREA              **** SAVE AREA INDEX ****                   
         BAL,R14  UNPKMASD          UNPACK MASTER DICTIONARY FOR AREA           
         NOP      %                 AREA MUST BE ALLOCATED; SEE GAN             
*                                                                               
         BAL,R14  MAPHEADR          OUT AREA INFO TO PRINTER                    
         CLM,R4   CKXABT            IS AREA CK, XA, OR BT ?                     
         BCS,6    MAPS1               NO, OK TO SEARCH FOR DIRECTORY            
         B        MAPS              YES, NO DIRE; STEP TO NEXT NOW              
         PAGE                                                                   
         SPACE    2                                                             
MAPS1    RES      0         READ AND START PROCESSING 1ST DIRECTORY             
         BAL,RLNK GET1SFIL          POINT AT FIRST FILE IN DIRECTORY            
         B        MAPS35            ERROR: REPORT BAD DIRECTORY                 
         B        MAPS30            EMPTY: REPORT NO FILES                      
         B        MAPS3             ENTRY: PROCESS FIRST ENTRY                  
*                                                                               
*                                                                               
MAPS2    RES      0         GET NEXT FILE ENTRY                                 
         BAL,RLNK GETNXFIL          GET ADDRESS OF NEXT ENTRY IN R5             
         B        MAPS35            ERROR: REPORT BAD DIRECTORY                 
         B        MAPS21            DONE:  OUTPUT SUMMARY INFORMATION           
*        B        MAPS3             ENTRY: PROCESS                              
*                                                                               
*                                                                               
MAPS3    RES      0         DISPLAY AN ENTRY'S INFORMATION                      
         BAL,R14  UNPKDIRE          UNPACK THE ENTRY                            
         LW,R3    DIRESTAT          WHAT IS THE STATUS OF THE ENTRY ?           
         CI,R3    FILDELTD          IS THE ENTRY A DELETED FILE ?               
         BLE      MAPS18              YES, ACCOUNT FOR THE SPACE                
*                                                                               
         BAL,R14  FILHEADR          OUT COLUMN HEADERS FOR FILES                
*                                                                               
*                           OUT FILENAME, ACCOUNT                               
         MTW,+00  MAPSW             IS A SHORT ('SMAP') BEING DONE ?            
         BEZ      MAPS40              YES, PROCESS IT                           
         BLZ      MAPS10            SPACE REM COMMAND                           
*                                                                               
         SETCP    CPFILE            SET CP FOR START OF FILE NAME               
         CHARS    8,DIRENAME        OUT ALL 8 CHARS OF FILE NAME                
         LD,R0    DIREACNT          DO NOT OUTPUT ACCOUNT NAME                  
         CD,R0    BLNK              IF IT IS ALL BLANKS (ABSENT)                
         BE       MAPS4               NOT PRESENT; SKIP OUTPUT                  
*                                                                               
         CHAR     C'.'              OUT SEPARATOR CHARACTER                     
         CHARS    8,DIREACNT        THEN OUT THE NAME                           
*                                                                               
MAPS4    RES      0         OUT BOT, EOT, ORG, ETC.                             
         SETCP    CPBOT             SET CP FOR START SECTOR                     
         INTGR    DEC,SPAC,5,DIREBOT    AND OUT IT                              
         SETCP    CPEOT             SET CP FOR EOT                              
         INTGR    ,,,DIREEOT                                                    
         CI,R3    FILGOODF          IS THE ENTRY A FILE ?                       
         BNE      MAPS10              NO, BADTRACK; SKIP SIZE INFO              
*                                                                               
         SETCP    CPORG             SET PRINT LINE POSITION FOR FORMATS         
         LW,R1    DIREORG           GET ORGANIZATION (FORMAT) CODE              
         LB,R15   FORMATC,R1        FROM CODE TABLE                             
         CHAR                       PUT IN PRINT LINE                           
         SETCP    CPGSIZ            SET COLUMN POINTER (CP) FOR GRAN            
         INTGR    DEC,SPAC,5,DIREGSIZ   OUTPUT GRANULE SIZE                     
         SETCP    CPRSIZ            SET CP FOR RECORD SIZE                      
         INTGR    ,,,DIRERSIZ       AND OUTPUT IT                               
         SETCP    CPFSIZ            SET CP FOR FILE SIZE                        
         INTGR    ,,,DIREFSIZ       AND OUTPUT                                  
         SETCP    CPFSSEC           SET CP FOR FSIZE (SECTORS)                  
         INTGR    ,,,DIREUSEC                                                   
         MTW,+0   DIREESIZ          YES, CAN FILE BE EXTENDED ?                 
         BEZ      MAPS4A            NO,NEVER;SKIP XTNT,ESIZ PRINT               
*                                                                               
         SETCP    CPESIZ            OUT EXTENSION SIZE AND                      
         INTGR    ,,,DIREESIZ                                                   
         SETCP    CPXTNT            AND THE EXTENSION NUMBER                    
         INTGR    ,,4,DIREXTNT                                                  
*        DECODE THE DATE CELL INTO PARTS                                        
*        DATE CELL BIT DIVISION: Y(4),M(4),D(8),HOUR(8),MIN(8)                  
         SPACE                                                                  
MAPS4A   EQU      %                                                             
         LW,R0    DIREDATE                                                      
         BEZ      MAPSS4A                                                       
         LI,1     2                                                             
         LB,R2    DIREDATE,R1       HOUR                                        
         STW,R2   DIREHOUR                                                      
         LI,R1    3                                                             
         LB,R2    DIREDATE,R1       MIN                                         
         STW,R2   DIREMIN                                                       
         LW,R1    DIREDATE          YEAR                                        
         SLS,R1   -28                                                           
         AI,R1    80                                                            
         STW,R1   DIREYEAR                                                      
         LB,2     DIREDATE                                                      
         AND,2    =X'F'                                                         
         AI,2     -1                MONTH(1-12) TO INDEX(0-11)                  
         LW,R0    K:MONTH,R2        GET BCD CHAR OF MONTH                       
         AND,R0   M24                                                           
         SLS,R0   8                                                             
         AI,R0    X'40'                                                         
         SCS,R0   -8                                                            
         STW,R0   DIREMON                                                       
         LI,1     1                                                             
         LB,2     DIREDATE,R1       DAY                                         
         STW,2    DIREDAY                                                       
*                                                                               
         SPACE    2                                                             
*        OUTPUT THE DATE                                                        
         SPACE    1                                                             
         SETCP    CPDATE                                                        
         INTGR    DEC,SPAC,2,DIREDAY                                            
         CHARS    4,DIREMON                                                     
         CHAR     C','                                                          
         CHAR     C''''                                                         
         INTGR    DEC,SPAC,2,DIREYEAR                                           
         SETCP    CPDATE+11                                                     
         INTGR    DEC,SPAC,2,DIREHOUR                                           
         CHAR     C':'                                                          
         INTGR    DEC,SPAC,2,DIREMIN                                            
         LW,R1    DIREMIN                                                       
         CI,R1    10                                                            
         BG       MAPSS4A                                                       
         SETCP    CPDATE+14                                                     
         CHAR     C'0'              DO LEADING 0                                
MAPSS4A  EQU      %                                                             
*                                                                               
MAPS5    RES      0         OUTPUT RESFGD, FIX, SEQ, DIR FLAGS                  
         SETCP    CPFLAGS           POINT AT POSITION FOR FLAG INFO             
         LW,R15   DIRERF            GET SW: 0 => NO; 1 => YES                   
         MI,R15   C'R'              GET FLAG IN R15 AND TEST IF SET             
         BEZ      %+2                 NOT SET; DON'T OUTPUT IT                  
         CHAR                       SET: OUT THE INDICATOR                      
         LW,R15   DIREFIX           GET AND TEST 'FIX' FLAG THE SAME            
         MI,R15   C'F'              WAY                                         
         BEZ      %+2                                                           
         CHAR                                                                   
         SETCP    CPFLAGS+2                                                     
         LW,R15   DIRESD            GET FLAGS AND CONVERT TO A HALF             
         SLS,R15  1                 WORD INDEX                                  
         CHARS    2,WRITEMOD,R15    AND ENTER THE 2 CHAR CODE                   
         LW,R15   AREA              TEST IF THIS IS A SYMBIONT AREA?            
         CW,R15   ISINDEX            IF FILES HAVE A PRIORITY ?                 
         BE       %+3                 YES,                                      
         CW,R15   OSINDEX                                                       
         BNE      MAPS6               NO, NO PRIORITIES                         
*                                                                               
         SETCP    CPPRIO                                                        
         INTGR    DEC,SPAC,2,DIREPRIO                                           
*                                                                               
MAPS6    RES      0                                                             
         PAGE                                                                   
*                                                                               
*        RECORDS REMAINING IS COMPUTED AS FOLLOWS:                              
*                                                                               
*                                (      DIRENSEC     )                          
*                      (     )   (-------------------)                          
*  RECORDS REMAINING = ( RPB ) * ( ( SSS + BPS - 1 ) ) - DIREFSIZ               
*                      (     )   ( (---------------) )                          
*                                ( (       BPS     ) )                          
*                                                                               
* WHERE: BPS = MASDWPS*4   (BYTES PER SECTOR)                                   
*                                                                               
*        SSS = 256*4 BYTES PER SECTOR FOR ORG=COMPRESSED, BLOCKED               
*            = DIRERSIZ              FOR ORG=UNBLOCKED                          
*                                                                               
*        RPB = 25 RECORDS PER 256 WORD BLOCK FOR ORG = COMPRESSED               
*                                                                               
*              (   256  )                                                       
*            = (--------)                    FOR ORG = BLOCKED                  
*              (DIRERSIZ)                                                       
*                                                                               
*            = 1                             FOR ORG = UNBLOCKED                
*                                                                               
*                                                                               
*NOTES:  1. FOR ORG = COMPRESSED, BLOCKED; BLOCKSIZE IS BASED ON A 256          
*           WORDS PER SECTOR SECTOR SIZE.                                       
*        2. FOR ORG = COMPRESSED; 10 WORDS PER RECORD WAS ASSUMED DURING        
*           ALLOCATION ((256/10) = 25 =RPB) AND IS ASSUMED HERE TOO.            
*        3. FOR ORG = UNBLOCKED; RPB IS NOT USED, SO IS SET TO 1 TO             
*           MAKE THE MULTIPLY A NO OPERATION.                                   
*        4. THE NUMBERS 256 AND 25 ABOVE THE CURRENT VALUES OF THE              
*           SYMBOLS BLKSIZE AND #CRPB, RESPECITVELY.                            
         PAGE                                                                   
         SPACE    2                                                             
*                           COMPUTE SPACE REMAINING                             
         SETCP    CPREMAIN          POSITION PRINT LINE FOR VALUE               
         LI,R11   1                 SET RPB IN CASE UNBLOCKED                   
         LW,R9    DIRERSIZ          GET RECORD SIZE                             
         BEZ      MAPS10            IF ZERO, SKIP REMAIN REC CALCU'N            
*                                                                               
         LW,R1    DIREORG           REFETCH FILE ORGANIZATION                   
         CI,R1    ORGUNB            IS FILE ORG = UNBLOCKED ?                   
         BE       MAPS8               YES, START COMPUTATIONS                   
*                                                                               
         LI,R11   #CRPB             SET RPB FOR ORG = COMPRESSED                
         CI,R1    ORGCOMP           IS THE FILE ORG = COMPRESSED ?              
         BE       MAPS7               YES, 'SSS'                                
*                                                                               
         LI,R11   BLKSIZE*4         COMPUTE 'RPB', REC PER BLOCK                
         LI,R10   0                                                             
         DW,R10   DIRERSIZ          INTO R11  (R11 <= RPB)                      
*                                                                               
MAPS7    EQU      %         SET 'SSS' FOR COMPRESSED, BLOCKED FILES             
         LI,R9    BLKSIZE*4         256 WORD SECTORS ASSUMED                    
*                                                                               
MAPS8    EQU      %         COMPLETE COMPUTATION OF SPACE REMAINING             
         LW,R15   DIRENSEC          SECTORS AVAILABLE FOR FILE                  
         LW,R10   MASDWPS           WORDS PER SECTOR                            
         SLS,R10  2                 CONVERTED TO BYTES (R10 <= BPS)             
         AW,R9    R10               SSS + BPS                                   
         AI,R9    -1                SSS + BPS - 1                               
         LI,R8    0                                                             
         DW,R8    R10               (SSS + BPS - 1)/BPS                         
         LI,R14   0                                                             
         DW,R14   R9                (NSEC)/((SSS+BPS-1)/BPS)                    
         MW,R15   R11               ((NSEC)/((SSS+BPS-1)/BPS)) * RPB            
         SW,R15   DIREFSIZ          RECORDS AVAILABLE - RECORDS WRITTEN         
         BLZ      MAPS9             NEGATIVE!  ENTER DASHES INSTEAD             
*                                                                               
         INTGR    DEC,SPAC,5        OUT RECORDS REMAINING                       
         B        MAPS10            CONTINUE TO PRINT LINE                      
*                                                                               
MAPS9    EQU      %         REMAINING RECORD COUNT NEGATIVE: MARK IT            
         STRNG    DASHES            MARK COUNT AS HAVING NO VALUE               
*                                                                               
*                                                                               
*                                                                               
MAPS10   RES      0         COUNT A FILE                                        
         MTW,+1   MASDNFIL          STEP NUMBER OF FILES PRINTED                
*                                                                               
MAPS11   RES      0         PRINT A LINE OF MAP INFORMATION                     
         MTW,+0   MAPSW                                                         
         BLZ      MAP11A            SPACE REMAINING ONLY                        
         PRNT                       PRINT THE LINE OF FILE INFO                 
MAP11A   EQU      %                                                             
         LW,R15   DIREEOT           GET END SECTOR AND TEST                     
         CW,R15   MASDSIZE          IF END SECTOR BEYOND END OF AREA ?          
         BG       MAPS35              YES, ERROR                                
*                                                                               
         MTW,+0   DIRENSEC          IS THE FILE SIZE NEGATIVE ?                 
         BLZ      MAPS35              YES, ASSUME A BAD DIRECTORY               
*                                                                               
MAPS12   EQU      %         TEST IF SECTORS LOST; LAST EOF + 1 = BOT ?          
         LW,R0    MASDLEOF          GET END OF LAST FILE PROCESSED              
         AI,R0    1                 AND STEP TO NEXT START                      
         CW,R0    DIREBOT           ANY SPACE LOST BETWEEN FILES ?              
         BG       MAPS35             NO: BUT DIRE IS MESSED UP!!!               
*                                                                               
         BE       MAPS14              NO, SET NEW LAST EOF                      
*                                                                               
         LW,R1    DIREBOT           GET START OF THIS FILE                      
         SW,R1    R0                MINUS END OF LAST = LOST SPACE              
         AWM,R1   MASDLOST          ACCOUNT FOR THE SECTORS                     
*                                                                               
MAPS14   EQU      %         SET NEW LAST EOF FOR NEXT FILE                      
         LW,R0    DIREEOT           COPY END OF THIS FILE                       
         STW,R0   MASDLEOF          AS LAST EOF FOR NEXT PASS THROUGH           
         B        MAPS2             GO TEST FOR AND GET NEXT ENTRY              
*                                                                               
*                                                                               
*                                                                               
MAPS18   EQU      %         PROCESS A DELETED ENTRY: ACCOUNT FOR SPACE          
         LW,R0    DIRENSEC          ADD ITS SIZE TO DELETED SPACE               
         AWM,R0   MASDUSED          COUNT TO ACCOUNT FOR THE SPACE              
         B        MAPS12            AND TEST IF SPACE LOST AS USUAL             
         PAGE                                                                   
         SPACE    2                                                             
MAPS21   EQU      %         END OF DIRECTORY; WHAT WAS FOUND ??                 
         LW,R15   MASDFREE          BEGIN AVAIL SPACE                           
         SW,R15   MASDLEOF           - (END OF LAST FILE + 1)                   
         AI,R15   -1                 = SPACE LOST AFTER LAST FILE               
         BLZ      MAPS35            IF OVERLAP, GIVE ERROR                      
*                                                                               
         AWM,R15  MASDLOST          ADD LOST SPACE TO COUNT                     
         PRTUP    2                 SPACE 2 BLANK LINES                         
         CAL1,1   CLFLEIN           CLOSE FILE                                  
         MTW,00   MASDNFIL          WERE ANY FILES FOUND AND PRINTED ?          
         BNEZ     MAPS22              YES, DON'T PRINT NO FILES                 
*                                                                               
         PRTTXT   SUMRY             PRINT 'NO FILES'                            
         PRNT                       SPACE A LINE                                
         B        MAPS23            TEST IF SUMMARIES TO BE PRINTED             
*                                                                               
MAPS22   RES      0         PRINT NUMBER OF FILES IN AREA                       
         STRNG    SUMRY3            OUT 'NUMBER OF FILES:' MESSAGE              
         INTGR    DEC,SPAC,5,MASDNFIL    AND THE COUNT                          
         PRTUP    2                 PRINT LINE AND SPACE ANOTHER                
*                                                                               
MAPS23   RES      0         LIST SPACE AVAILABLE, RECOVERABLE IF 'MAP'          
         MTW,+0   MAPSW             IS A SHORT ('SMAP') BEING DONE ?            
         BEZ      MAPS                YES, SKIP SUMMARIES                       
*                                                                               
         STRNG    SUMRY1            ENTER SECTORS REMAINING MESSAGE             
         LW,R15   MASDSIZE          SIZE OF AREA - FIRST FREE                   
         SW,R15   MASDFREE          = SPACE NOT USED, OR AVAILABLE              
         INTGR    DEC,SPAC,5        CONVERT TO OUTPUT LINE                      
         PRNT                       PRINT THE LINE                              
         STRNG    SUMRY2            ENTER SECTORS RECOVERABLE MESSAGE           
         LW,R15   MASDLOST          SECTORS RECOVERABLE =                       
         AW,R15   MASDUSED          LOST TO TRUNCATE + DELETED                  
         SW,R15   MASDNDS           - ADDITIONAL DIRECTORY SECTORS              
         INTGR    DEC,SPAC,5                                                    
         PRNT                       PRINT THE INFORMATION                       
         B        MAPS              TEST IF ANOTHER AREA IS TO BE DONE          
         PAGE                                                                   
         SPACE    2                                                             
MAPS30   EQU      %         DIRE CLEARED OR INITIALIZED: NO FILES               
         CAL1,1   CLFLEIN           CLOSE INPUT FILE                            
         PRTTXT   SUMRY             'NO FILES'                                  
         B        MAPS              AND GO GET ANOTHER AREA IF ANY              
*                                                                               
*                                                                               
*                                                                               
MAPS35   EQU      %         DIRECTORY INCONSISTENT OR IN ERROR                  
         CAL1,1   CLFLEIN           CLOSE FILE                                  
         PRTTXT   SUMRYX            OUT MESSAGE INDICATING MESS UP              
         B        MAPS              AND TRY ANOTHER AREA                        
*                                                                               
*                                                                               
*                                                                               
MAPSEXIT EQU      %         END OF MAPPING;  CLEAN UP AND EXIT                  
         B        EXEC1             AND RETURN TO THE EXEC FOR NEW TASK         
         PAGE                                                                   
         SPACE    2                                                             
MAPS40   EQU      %         FORM A LINE OF MAP OUTPUT FOR 'SMAP'                
         CI,R3    FILGOODF          IS FILE A REAL FILE ?                       
         BNE      MAPS11              NO, BADSECTORS; DON'T OUT IT              
*                                                                               
         SETCP    CPFILES           SET POSITION FOR 'SMAP'S FILENAME           
         CHARS    8,DIRENAME        OUT ALL 8 CHARS OF FILE NAME                
         LD,R0    DIREACNT          DO NOT OUTPUT ACCOUNT NAME                  
         CD,R0    BLNK              IF IT IS ALL BLANKS (ABSENT)                
         BE       MAPS41              NOT PRESENT; SKIP OUTPUT                  
*                                                                               
         CHAR     C'.'              OUT SEPARATOR CHARACTER                     
         CHARS    8,DIREACNT        THEN OUT THE NAME                           
*                                                                               
MAPS41   RES      0         ENTER RECORD COUNT IF A GOOD FILE                   
         SETCP    CPFSIZS           SET TO COLUMN FOR RECORD COUNT              
         INTGR    DEC,SPAC,5,DIREFSIZ    OUTPUT NUMBER OF RECORDS               
         B        MAPS10            GO PRINT LINE                               
         PAGE                                                                   
         SPACE    1                                                             
MAPHEADR EQU      %         PRINT MAP HEADER:  MASTER DICTIONARY INFO           
         PUSH     5,R14             SAVE RETURN, WORK REGISTERS                 
         MTW,+0   MAPSW             WHAT TYPE OF MAP IS BEING DONE?             
         BEZ      MAPHEADS          'SMAP'; OUT SHORT HEADER                    
*                                                                               
         PRTTXT   AHDR1             PRINT THE TWO LINES OF AREA                 
         PRTTXT   AHDR2             HEADERS                                     
         SETCP    CPAREA            SET COLUMN FOR AREA NAME                    
         CHARS    3,MASDNAME,1      OUT AREA NAME THUS: ' AA'                   
         SETCP    CPDEVA            POINT AT COLUMN FOR DEVICE ADDR             
         CHARS    5,MASDDEVA        OUT DEV ADDR; 5 CHARS FROM MASDDEVA         
         SETCP    CPWPS             SET PLACE FOR WORDS PER SECTOR              
         INTGR    DEC,SPAC,5,MASDWPS   OUT DECIMAL, 5 DIGITS                    
         SETCP    CPSPT             SPACE OVER FOR SECTORS PER TRACK            
         INTGR    ,,,MASDSPT        OUT DEC, 5 DIGITS, LEADING SPACES           
         SETCP    CPBOA             OUT STARTING SECTOR OF AREA                 
         INTGR    ,,,MASDBOA        AGAIN IN DECIMAL                            
         SETCP    CPEOA             OUT END SECTOR ADDRESS                      
         INTGR    ,,,MASDEOA                                                    
         SETCP    CPWP              SET TO OUT WRITE PROTECT                    
         LW,R1    MASDWP            GET PROTECT CODE AS INDEX                   
         LB,R15   WPVAL,R1          TO CHARACTER FOR CODE                       
         CHAR                       AND OUT IT                                  
         LI,R15   2                 PRINT AND SPACE ANOTHER LINE                
*                                                                               
MAPHEADX EQU      %         SPACE PRINTER AFTER HEADER AND EXIT                 
         PRNT                       PRINT THE LINE                              
         PRTUP                      SPACE BY COUNT IN R15                       
         PULL     5,R14             RECOVER REGISTERS                           
         B        *R14              AND RETURN                                  
*                                                                               
*                                                                               
MAPHEADS EQU      %         OUT SHORT HEADER FOR 'SMAP'                         
         STRNG    AHDR0             OUT HEADER 'AREA:'                          
         CHARS    3,MASDNAME,1      OUT AREA NAME - ' AA'                       
         LI,R15   1                 SPACE ONLY 1 BLANK LINE AFTER HEADERR       
         B        MAPHEADX          GO TO COMMON PRINT, EXIT CODE               
         PAGE                                                                   
         SPACE    2                                                             
FILHEADR EQU      %         PRINT COLUMN HEADERS FOR FILE INFO                  
         MTW,+0   MASDNFIL          HAS A FILE BEEN FOUND YET ?                 
         BGZ      *R14                YES, HEADER ALREADY OUT; EXIT             
*                                                                               
         PUSH     R14               SAVE RETURN                                 
         MTW,+00  MAPSW             WHAT TYPE OF MAP IS IT ?                    
         BEZ      FILHEADS            SHORT MAP; OUT SHORT HEADER               
         BLZ      FILHEADX          'SPACE'; NO FILE HEADER                     
*                                                                               
         PRTTXT   FILHDR1           PRINT THE 3 LINES OF THE FULL               
         PRTTXT   FILHDR2           FILE HEADERS                                
         PRTTXT   FILHDR3                                                       
*                                                                               
FILHEADX EQU      %         RETURN                                              
         PULL     R14               RECOVER LINK                                
         B        *R14              AND EXIT                                    
*                                                                               
*                                                                               
*                                                                               
FILHEADS EQU      %         PRINT SHORT HEADER                                  
         PRTTXT   FILHDR0           OUT THE ONE SHORT LINE                      
         B        FILHEADX          AND THEN EXIT                               
         TITLE    '** RS1002 - L M A P    **'                                   
         SPACE    2                                                             
LMAP     EQU      %         'LMAP'  PRINT DIRECTORY AND LIBRARY MAP(S)          
         CI,R6    1                 ARE MORE PARAMETERS EXPECTED ?              
         BNE      ERROR02             NO, ERROR; MUST HAVE A PARAMETER          
*                                                                               
         LW,R0    0                 ZERO OUT SP, FP AREA'S SWITCHES             
         STW,R0   AREASWS           (ONLY 1ST 2 WILL BE LOOKED AT)              
         LI,R0    LMAPERF           SET 'LMAP'S ERR FUNCTION FOR LIBRARY        
         STW,R0   ERRFCN            READ ERRORS                                 
*                                                                               
LMAP1    EQU      %         SCAN AN AREA NAME                                   
         BAL,LINK SCAN              GET SOMETHING                               
         CI,R6    0                 WAS ANYTHING FOUND WRONG ?                  
         BGE      LMAP2               NO, CHECK IF A LEGAL AREA                 
*                                                                               
         CI,R10   C'.'              WAS ERROR CAUSED BY AN AREA PREFIX ?        
         BNE      ERROR02             NO, REAL ERROR: 'ERROR ITEM XX'           
         B        LMAP1             YES, SKIP THE '.' AND GET AREA              
*                                                                               
LMAP2    RES      0         CHECK FOR LEGAL LIBRARY AREA NAME                   
*                                                                               
         BAL,RLNK GETAX             GET AREA INDEX IF LEGAL                     
         B        ERROR02             NOT OK, ERROR 2; ERROR IN ITEM XX         
*                                                                               
         CI,R1    FPINDEX           IS IT 'SP' OR 'FP' AREA ?                   
         BG       ERROR02             NO, ALSO AN ERROR                         
*                                                                               
         BAL,R14  UNPKMASD          GET AREA INFO; IS AREA ALLOCATED ?          
         B        ERROR02             IT ISN'T; ERROR IN ITEM XX                
*                                                                               
         LI,R0    X'FF'             SET MARKER FOR THE AREA                     
         STB,R0   AREASWS,R1        TO SAY IT IS TO BE MAPPED                   
         CI,R6    2                 WAS THIS THE LAST AREA GIVEN ?              
         BNE      LMAP1               NO, GET ANOTHER                           
*                                                                               
         LI,R0    FPINDEX           SET MAX INDEX FOR AREA SCAN = FP            
         STW,R0   MAXMASD           SET MAX MASTD INDEX TO PROCESS              
*                                                                               
         LI,R4    -1                 SET TO PROCESS THE FIRST AREA              
*                                                                               
*                                                                               
MAPLMAP  EQU      %         START NEXT LMAP ON A NEW PAGE                       
         PRTPAG                     PAGE THE PRINTER                            
*                                                                               
MAPLIB   EQU      %         TEST IF DONE. START NEXT AREA IF NOT                
         AI,R4    1                 STEP TO NEXT AREA                           
         CW,R4    MAXMASD           IS THIS THE END OF THE REQUESTS ?           
         BG       MAPSEXIT            YES, EXIT                                 
*                                                                               
         LB,R0    AREASWS,R4        IS THIS AREA TO BE DONE ?                   
         BEZ      MAPLIB              NO, STEP TO NEXT                          
*                                                                               
         STW,R4   AREA              **** SAVE AREA INDEX ****                   
         BAL,R14  UNPKMASD          UNPACK MASTER DICTIONARY FOR AREA           
         NOP      0                 AREA ALLOCATION CHECKED ABOVE.              
         LW,R1    BACKSZE           CLEAR BACKGROUND BUFFER SPACE               
         AI,R1    -1                ADJUST FOR INDEX 0                          
         LI,R0    0                                                             
*                                                                               
         STW,R0   *BPEND,R1         INITIALIZE HOLES IN TABLES TO ZERO          
         BDR,R1   %-1                                                           
*                                                                               
         LI,R1    6                 STORE AREA INDEX, (IN R4) INTO              
         STB,R4   F:LI,R1           'TYPE' FIELD OF LIBRARY DCB                 
         LW,R0    BPEND             SET READ ADDRESS TO START OF THE            
         STW,R0   F:LI+2            CLEARED SPACE                               
         LI,R7    3                 SET NUMBER OF FILES TO READ                 
*                                                                               
MLIB0    EQU      %         READ IN EACH OF THE LIBRARY FILES                   
         LD,R0    MODULE,R7         FETCH NAME OF THE FILE                      
         STD,R0   F:LI+5            AND PUT IT IN THE MAP' DCB                  
MAPREAD  CAL1,1   READLI            READ THE RECORD (FILE)                      
         LW,R0    F:LI+2            FETCH READ BUFFER ADDRESS                   
         AND,R0   M17               REMOVE TYC CODE                             
         STW,R0   MAPTABLE,R7       SAVE AS BASE OF THE TABLE IN MEMORY         
         LW,R1    F:LI+4            GET LENGTH OF RECORD IN BYTES               
         SLS,R1   -19               CONVERT TO WORDS                            
         AI,R1    1                 INSURE 1 ITEM'S WORTH OF ZEROED FILL        
         AWM,R1   F:LI+2            AND SET AS NEW READ ADDRESS                 
         CAL1,1   CLOSELI           CLOSE DCB TO ALLOW CHANGES                  
         BDR,R7   MLIB0             DONE LAST?.  LOOP IF NOT DONE               
*                                                                               
*                                                                               
         STRNG    MAPLIBTL          OUT MAP TITLE                               
         CHARS    3,MASDNAME,1      OUT NAME FROM DIRE BLOCK                    
         PRTUP    2                 PRINT LINE AND SPACE A LINE                 
         STRNG    MAPLIBMD          OUT COLUMN HEADERS FOR MODULES, ETC         
         SETCP    CPLREFS           STEP OVER TO 'REF' COLUMN                   
         STRNG    MAPLIBRF          AND ENTRY 'REF' IN LINE                     
         PRTUP    2                 PRINT COLUMN HEADER                         
         PAGE                                                                   
         SPACE    2                                                             
*                 START PROCESSING LIBRARY:  EACH MODULE IS PROCESSED           
*        AS FOLLOWS:                                                            
*                                                                               
*        THE NEXT ENTRY IN THE DEFREF IS FOUND. IT INDICATES IF IT IS           
*        THE LAST OR NOT. IF NOT THE LAST, THE LENGTH FIELD IS NON-ZERO.        
*        IF THE ENTRY IS NOT DELETED ('MODIR' INDEX IS NOT -1), THE             
*        'MODIR' INDEX IS USED TO GET THE MODULE'S 'MODULE FILE RECORD          
*        NUMBER' AND ITS NAME FROM THE 'MODIR' FILE.                            
*        NEXT, EACH DEF OR REF ENTRY IN THE 'DEFREF' ENTRY IS SCANNED           
*        LOOKING FOR THE NEXT DEF (OR REF, DEPENDING ON WHICH IS                
*        BEING MOVED FOR PRINTING), AND WHEN THE NEXT IS FOUND, IT IS           
*        USED AS AN INDEX TO THE 'EBCDIC' FILE TO GET THE EBCDIC                
*        CHARACTER STRING FOR THE NAME TO ENTER IN THE OUTPUT LINE.             
*                                                                               
*        WHEN ALL THE DEF'S AND REF'S IN AN ENTRY ARE PROCESSED, OR AN          
*        ENTRY WAS DELETED AND IS TO BE SKIPPED, THE LENGTH OF THE              
*        ENTRY IS ADDED TO THE POINTER TO GET THE NEXT ENTRY.                   
*        (I.E., POINTER <= POINTER + LENGTH OF CURRENT ENTRY).                  
         PAGE                                                                   
*                                                                               
*                                                                               
*        REGISTER USAGE:                                                        
*                                                                               
*        R0:      PARAM TO % ROUTINES                                           
*        R1:      PARAM TO % ROUTINES; TEMP FOR COMPUTING A PARAM               
*        R2:      PARAM TO % ROUTINES; TEMP FOR COMPUTING A PARAM               
*        R3:      INDEX TO SCAN 'DEFREF' TABLE ENTRY                            
*        R4:      MODULE COUNTER (NUMBER OF MODULE IN LIBRARY)                  
*        R5:      POINTER TO 'DEFREF' TABLE ENTRY, A HALF-WORD ADDRESS          
*        R6:      TEMP                                                          
*        R7:                                                                    
*        R8:      COUNT OF NUMBER OF DEFS (REFS) PER LINE  ( = 3 )              
*        R9:      MASK/SWITCH, WHETHER LOOKING FOR DEFS OR REFS                 
*        R10:     NUMBER OF ENTRIES IN A 'DEFREF' TABLE ENTRY                   
*        R11:     DEF  ( INDEX TO WHERE TO RESUME SEARCH FOR THE NEXT           
*        R12:     REF  ( DEF/REF TO BE PRINTED                                  
*        R13:     SWITCH; ZERO IF NOTHING MOVED TO PRINTLINE                    
*        R14:     LINK TO % ROUTINES                                            
*        R15:     PARAM TO % ROUTINE SETCP; WHERE TO PRINT NEXT DEF/REF         
         PAGE                                                                   
         SPACE    2                                                             
         LI,R4    1                 SET STARTING AT MODULE 1                    
         LW,R5    MAPDEFRF          SET POINTER TO FIRST ITEM IN THE            
         SLS,R5   1                 'DEFREF' TABLE (OR FILE)                    
*                                                                               
MLIB11   EQU      %         PROCESS THE (NEXT) ENTRY                            
         LH,R10   0,R5              GET LENGTH; IS IT END OF TABLE ?            
         BEZ      MLIBEXIT            YES, DONE WITH LIBRARY; EXIT              
*                                                                               
         LW,R6    R5                COPY INDEX AND STEP TO GET NEXT             
         AI,R6    1                 HALFWORD                                    
         LH,R6    0,R6              GET 'MODIR' INDEX; IS IT DELETED ?          
         BLZ      MLIB19              YES, SKIP OVER IT                         
*                                                                               
         SETCP    CPLNUM            POSITION CP FOR MODULE NUMBER               
         INTGR    DEC,SPAC,3,R4     OUT MODULE NUMBER (COUNT)                   
         CHAR     C'.'                                                          
         AI,R4    1                 STEP COUNT                                  
         SETCP    CPLNAME           SET WHERE TO PUT NAME IN OUTPUT LINE        
         AND,R6   M16               REMOVE EXTENDED SIGN AND SET                
         LW,R2    MAPMODIR          ADDR OF ENTRY IN 'MODIR' --                 
         LW,R0    R6                COPY INDEX AND CONVERT IT TO A              
         SLS,R0   1                 BYTE DISPLACEMENT FROM 'MAPMODIR'           
         AI,R0    4                 STEP OVER RECORD NO, NUMBER OF RECS         
         LI,R1    8                 SET LENGTH OF NAME = 8 CHARACTERS           
         CHARS                      OUT NAME TO PRINT LINE BUFFER               
         SETCP    CPLMODX           POSITION TO 'MODULE INDEX'                  
         LH,R15   *MAPMODIR,R6      AND GET MODULE'S POSITION IN FILE           
         AND,R15  M16                                                           
         INTGR    DEC,ZERO,4        OUT INDEX, 4 DIGITS, DEC, LEADING 0         
         SETCP    CPLLEN            SET CP FOR RECORDS IN THE MODULE            
         AI,R6    1                                                             
         LH,R15   *MAPMODIR,R6      FETCH IT                                    
         AND,R15  M16                                                           
         INTGR    ,SPAC,3           AND ENTER IT                                
         LI,R11   1                 SET INITIAL INDICIES FOR DEF AND REF        
         LI,R12   1                 ITEMS IN 'DEFREF' TABLE'S ENTRY             
*                                                                               
MLIB12   EQU      %         PRODUCE A LINE OF DEF/REF INFO                      
         SETCP    CPLDEFS           DEF'S START IN COLUMN 27                    
         LW,R3    R11               SET INDEX WHERE SEARCH RESUMES              
         LI,R13   0                 SET NONE FOUND, NONE PRINTED                
         LI,R9    DEFSFLAG          SET LOOKING FOR DEFS AND/OR DSECTS          
*                                                                               
MLIB13   EQU      %         SET LIMITS, SWITCHES FOR DEFS (OR REFS)             
         LI,R8    3                 SET NUMBER PER LINE                         
*                                                                               
MLIB14   EQU      %         FIND NEXT DEF (REF) TO PUT IN LINE                  
         AI,R3    1                 STEP TO NEXT 'DEFREF' ENTRY                 
         CW,R3    R10               REACHED END OF THE MODULE'S ENTRY ?         
         BGE      MLIB16              YES, TEST IF NEED TO DO 'REFS'            
*                                                                               
         LW,R1    R5                COPY ENTRY'S START INDEX                    
         AW,R1    R3                AND POINT AT THE ITEM TO TEST               
         LH,R2    0,R1              FETCH IT                                    
         CI,R2    DEFSFLAG          IS IT DEF OR DSECT ?                        
         BAZ      MLIB15              NO, LEAVE AS IS                           
*                                                                               
         AND,R2   M15               YES, REMOVE DEF FLAG                        
*                                                                               
MLIB15   EQU      %         ENTRY IS CONVERTED TO DEF OR REF, NOT DSECT         
         CW,R2    R9                IS IT THE TYPE WE ARE LOOKING FOR ?         
         BAZ      MLIB14              NO, SKIP IT AND TRY ANOTHER               
*                                                                               
         AND,R2   M14                 YES, REMOVE DEF/REF FLAGS                 
         LB,R1    *MAPEBCDC,R2      USE AS INDEX TO GET LENGTH OF NAME          
         AI,R1    -1                ADJUST, AS LENGTH INCLUDES LEN BYTE         
         LW,R0    R2                COPY INDEX FOR CHARACTER STRING             
         AI,R0    1                 OUTPUT DISPLACEMENT INDEX                   
         LW,R2    MAPEBCDC          MOVE NAME TO PRINT LINE                     
         CHARS                                                                  
         AI,R15   9                 STEP TO SPOT FOR NEXT NAME                  
         SETCP                      AND SET CP THERE                            
         LI,R13   1                 SET AT LEAST 1 DEF/REF OUTPUT               
         BDR,R8   MLIB14            THIS GROUP DONE?. LOOP IF NOT               
*                                                                               
MLIB16   EQU      %         GROUP OF DEFS (REFS) DONE; TEST WHICH               
         CI,R9    DEFSFLAG          WERE THE DEFS JUST PROCESSED ?              
         BNE      MLIB17              NO, REFS; OUT LINE, LOOP                  
*                                                                               
         SETCP    CPLREFS           SET START COLUMN FOR REF'S                  
         LW,R11   R3                SAVE INDEX OF LAST DEF FOUND                
         LI,R9    REFSFLAG          SET DOING REFS                              
         LW,R3    R12               SET INDEX TO LAST REF FOUND                 
         B        MLIB13            AND GO DO MORE OF THEM                      
*                                                                               
MLIB17   EQU      %         GROUP OF REFS JUST PROCESSED; SAVE INDICIES         
         LW,R12   R3                SAVE WHERE LAST REF WAS FOUND               
         PRNT                       PRINT LINE (A BLANK IF NO ENTRIES)          
         CI,R13   0                 WAS ANYTHING FOUND THIS LINE ?              
         BNEZ     MLIB12              YES, DO ANOTHER LINE                      
*                                                                               
MLIB19   EQU      %         END OF AN ENTRY; GET READY FOR ANOTHER              
*        PRNT                                                                   
         AW,R5    R10               STEP TO NEXT LIB MODULE'S ENTRY             
         B        MLIB11            GO TEST IF ANOTHER ENTRY TO GO              
         PAGE                                                                   
         SPACE    2                                                             
MLIBABND EQU      %         ERROR READING LIBRARY: NOT ENUF BUFFER SPACE        
         LI,R15   MESS19            SET LOC OF THE ERROR MESSAGE                
         BAL,LINK TYPRNT            OUT IT TO LL, AND OC MAYBE                  
         B        MLIB20            PREPARE TO EXIT                             
*                                                                               
*                                                                               
MLIBERR  EQU      %         ERROR READING LIBRARY; EOD OR NOT FOUND             
         STRNG    MESS10            ENTER 'AREA XX HAS NO LIB' MSG              
         SETCP    6                 POSITION THE THE 'XX'                       
         CHARS    2,MASDNAME,2      AND ENTER AREA NAME                         
         PRNT                       PRINT THE ERROR MESSAGE                     
*                                                                               
MLIB20   EQU      %         CLEAN UP DCB FOR LIBRARY                            
         PRNT                       OUT A LINE TO CLEAR PENDING UPSPACE         
         LW,R0    F:LI              IS THE DCB STILL (EVER) OPEN ?              
         CW,R0    DCBOPENF          AS INDICATED BY OPEN FLAG ?                 
         BAZ      MLIBEXIT            NO, EXIT NOW                              
*                                                                               
         CAL1,1   CLOSELI           YES, CLOSE IT NOW                           
*                                                                               
*                                                                               
MLIBEXIT RES      0         END OF A LIBRARY MAP: LOOP FOR POSSIBLE OTHER       
         LW,R4    AREA              RECOVER INDEX TO AREA JUST MAPPED           
         B        MAPLMAP           SEE IF ALL DONE                             
         PAGE                                                                   
*                          ERROR FUNCTIONS FOR LMAP                             
LMAPERF  ERRP     X'05',MLIBERR     !EOD: DIRE READS ==> NO LIBS                
         ERRP     X'4A',MLIBABND    BUFFER/BYTE COUNT ERR: DIRE READS           
         ERRP     X'2E',OPENERR     OPEN OPENED FILE: IGNORE                    
         ERRP     X'0A',0           CLOSE CLOSED DCB: IGNORE                    
         ERRP     X'00',MLIBERR     ALL OTHER ERRORS                            
         TITLE    '** RS1002 - GOOD SECTOR PROCESSOR **'                        
         SPACE    2                                                             
*******************                                                             
*                 *                                                             
*  GOOD SECTOR    *                                                             
*                 *                                                             
*******************                                                             
*                                                                               
*                                                                               
*        INPUT:   FROM COMMAND,   DEVICE,SECTOR,SECTOR-SECTOR                   
*                                                                               
*        OUTPUT:  REMOVED BADSECTOR ENTRIES IN DIRE FOR INDICATED GOOD          
*                 SECTORS.                                                      
*                                                                               
*        FUNCTION: ADJUST OR DELETE BADSECTOR ENTRIES MARKED GOOD.              
*                                                                               
*        CALL:    B    GDSECTOR                                                 
*                                                                               
*        CALLS:   GET1SFIL,GETNXFIL,UNPKDIRE,PACKDIRE,UNPKMASD,  AND            
*                 LOCAL SUBS GBSDEV,GBSLIM,READDIR,WRITEDIR                     
         PAGE                                                                   
         SPACE    2                                                             
*  REGISTER USAGE:                                                              
*                                                                               
*        R0 :     TEMP WORK REGISTER                                            
*        R1 :     DEVICE'S DCT INDEX: SET BY GBSDEV                             
*        R2 :     BOT OF GOODSECTOR AREA: SET BY GBSLIM                         
*        R3 :     EOT OF GOODSECTOR AREA: SET BY GBSLIM                         
*        R4 :     NUMBER OF DIRECTORY SECTORS: SET BY READDIR (NOT USED)        
*        R5 :     DIRE ADDRESS FOR UNPKDIRE                                     
*        R6 :     DIRE ADDRESS FOR PACKDIRE TO PACK INTO                        
*        R7 :     ADDRESS OF DIRE SECTOR BUFFER: SET BY READDIR = BUFF1         
*        R8 :     ADDR OF DIRE CHAIN TAIL, = ENDCHAIN (READDIR)                 
*        R9 :     ZERO    )                                                     
*        R10:     ZERO    > BAC & FWD LINKS OF CHAIN ENTRIES (READDIR)          
*        R11:     ZERO    )                                                     
*        R12:     TEMP                                                          
*        R13:     TEMP                                                          
*        R14:     AS RLNK, LINK REGISTER TO SUBROUTINES                         
*        R15:     TEMP WORK REGISTER                                            
*                                                                               
*                                                                               
*                                                                               
GDSECTOR RES      0         DEFINE BADSECTORS AS NOW GOOD SECTORS               
         BAL,RLNK GBSDEV            GET DEVICE NAME, INDEX                      
*                                                                               
GDSEC1   RES      0         PROCESS A GOOD SECTOR OR SECTOR RANGE               
         CI,R6    2                 ARE ALL PARAMETERS PROCESSED ?              
         BGE      EXEC1               YES, GET NEXT COMMAND                     
*                                                                               
         LW,R1    DCTINDEX          GET DEVICE'S INDEX FOR AREA SCAN            
         BAL,RLNK GBSLIM            GET LIMITS OF GOOD SECTORS                  
         PUSH     2,R6              SAVE SCAN PARAMETERS                        
         PUSH     R11               AND ALSO THE ITEM NUMBER                    
         BAL,RLNK READDIR           READ DIRE AND LINK UP IN BKG BUFFER         
         B        ERROR41           ERROR IN DIRE: REPORT AND ABORT CMND        
         B        GDSEC45           EMPTY DIRE: PRETEND WE ARE DONE             
*        B        GDSEC10           DIRE READ: PROCESS ENTRIES                  
*                                                                               
GDSEC10  RES      0         START SEARCH FOR BADSECTOR ENTRIES                  
         LW,R5    DIRCHAIN          POINT AT FIRST ENTRY IN CHAIN               
*                                                                               
GDSEC11  RES      0         PROCESS THE NEXT DIRE ENTRY                         
         BAL,RLNK UNPKDIRE          GET INFO ABOUT THE DIRE ENTRY               
         LW,R0    DIRESTAT          WHAT TYPE OF ENTRY IS IT ?                  
         CI,R0    FILBDTRK          IS IT A BADSECTOR ENTRY ?                   
         BNE      GDSEC40             NO, SKIP IT                               
*                                                                               
         CW,R2    DIREBOT           DOES GOODSECTORS START AFTER BOT ?          
         BG       GDSEC30             YES, NO CHANGE TO BOT OF ENTRY            
*                                                                               
         CW,R3    DIREBOT           DOES IT CHANGE ENTRY AT ALL ?               
         BL       GDSEC40             NO, SKIP ON TO LOOK FOR ANOTHER           
*                                                                               
GDSEC20  RES      0         GOODSECTORS INCLUDE BEGIN OF BADSECTOR ENTRY        
         CW,R3    DIREEOT           IS ALL OF BADSECTOR AREA NOW GOOD ?         
         BGE      GDSEC25             YES, MAKE SPACE AVAILABLE                 
*                                                                               
         STW,R3   DIREBOT           NO, UPDATE BADSECTOR BOT TO END OF          
         MTW,+1   DIREBOT           GOODSECTORS + 1                             
         B        GDSEC35           GO UPDATE ENTRY IN CORE                     
*                                                                               
GDSEC25  RES      0         ENTIRE BADSECTOR AREA NOW GOOD                      
         STD,R10  DIRENAME          SET NAME = DELETED ENTRY                    
         STW,R10  DIRESTAT          AND STATUS = DELETED, ALSO                  
         B        GDSEC35           GO UPDATE ENTRY IN CORE                     
*                                                                               
*                                                                               
GDSEC30  RES      0         DOES GOOD AREA AFFECT BAD ENTRY AT ALL              
         CW,R2    DIREEOT           DO AREAS OVERLAP ?                          
         BG       GDSEC40             NO, ENTIRELY AFTER BADSECTOR ENTRY        
*                                                                               
         CW,R3    DIREEOT           IS GOOD ENTIRELY WITHIN BAD ?               
         BL       GDSEC40             YES, DON'T GIVE ANYTHING BACK             
*                                                                               
         STW,R2   DIREEOT           EXTENDS BEYOND; FREE SPACE; SET EOT         
         MTW,-1   DIREEOT           BADSECTOR = BOT GOODSECTOR - 1              
*                                                                               
GDSEC35  RES      0         UPDATE AN ENTRY IN CORE CHAIN                       
         LW,R6    R5                                                            
         BAL,RLNK PACKDIRE          PUT INFO BACK IN CHAINED DIRE               
         MTW,+1   MASDNFIL          SET AT LEAST 1 ENTRY ALTERED                
*                                                                               
GDSEC40  RES      0         STEP TO NEXT ENTRY IN CHAIN IF PRESENT              
         LW,R5    FWDLINK,R5        GET LINK TO NEXT; IS THERE NEXT ?           
         BNEZ     GDSEC11             YES, PROCESS IT                           
*                                                                               
         MTW,+00  MASDNFIL          WAS ANYTHING CHANGED IN DIRE ?              
         BEZ      GDSEC45             NO, DON'T WRITE DIRE; STOP NOW            
*                                                                               
         BAL,RLNK WRITEDIR          WRITE OUT UPDATED DIRECTORY                 
*                                                                               
GDSEC45  RES      0         PROCESS LISTED SECTORS OR SECTOR RANGES             
         PULL     R11               RECOVER ITEM COUNT                          
         PULL     2,R6              AND SCAN PARAMETERS                         
         B        GDSEC1            SEE IF MORE TO DO                           
         SPACE    2                                                             
*******************                                                             
*                 *                                                             
*   BAD SECTOR    *                                                             
*                 *                                                             
*******************                                                             
*                                                                               
*                                                                               
*        INPUT:   FROM COMMAND,  DEVICE,SECTOR,SECTOR-SECTOR                    
*                                                                               
*        OUTPUT:  BAD SECTOR ENTRIES IN DIRE FOR BAD SECTORS                    
*                                                                               
*        FUNCTION: DELETE FILES STARTING IN THE BAD SECTORS AND                 
*                  TRUNCATE FILES ENDING IN THE BAD SECTORS. CREATE             
*                  A 'BADSECTOR' DIRECTORY ENTRY FOR THE BAD SECTORS.           
*                                                                               
*        CALL:    B    BDSECTOR      FROM EXEC1 IN RS1000                       
*                                                                               
*        CALLS:   GET1SFIL,GETNXFIL,UNPKDIRE,PACKDIRE,UNPKMASD,  AND            
*                 LOCAL SUBS GBSDEV,GBSLIM,READDIR,WRITEDIR,BDSNEWFL,BDSECFIL   
         PAGE                                                                   
         SPACE    2                                                             
*  REGISTER USAGE:                                                              
*                                                                               
*        R0 :     TEMP WORK REGISTER                                            
*        R1 :     DEVICE'S DCT INDEX: SET BY GBSDEV                             
*        R2 :     BOT OF GOODSECTOR AREA: SET BY GBSLIM                         
*        R3 :     EOT OF GOODSECTOR AREA: SET BY GBSLIM                         
*        R4 :     NUMBER OF DIRECTORY SECTORS: SET BY READDIR (NOT USED)        
*        R5 :     DIRE ADDRESS FOR UNPKDIRE                                     
*        R6 :     DIRE ADDRESS FOR PACKDIRE TO PACK INTO                        
*        R7 :     ADDRESS OF DIRE SECTOR BUFFER: SET BY READDIR = BUFF1         
*        R8 :     ADDR OF DIRE CHAIN TAIL, = ENDCHAIN (READDIR)                 
*        R9 :     ZERO    )                                                     
*        R10:     ZERO    > BAC & FWD LINKS OF CHAIN ENTRIES (READDIR)          
*        R11:     ZERO    )                                                     
*        R12:     TEMP                                                          
*        R13:     TEMP                                                          
*        R14:     AS RLNK, LINK REGISTER TO SUBROUTINES                         
*        R15:     TEMP WORK REGISTER                                            
*                                                                               
*                                                                               
*                                                                               
BDSECTOR RES      0         PROCESS BAD SECTOR DECLARATIONS                     
         BAL,RLNK GBSDEV            GET DEVICE NAME                             
*                                                                               
BDSEC1   RES      0         PROCESS A SECTOR OR SECTOR RANGE                    
         CI,R6    2                 ARE WE ALL DONE WITH COMMAND ?              
         BGE      EXEC1               YES, GET NEXT COMMAND                     
*                                                                               
         LW,R1    DCTINDEX          GET DEVICE'S INDEX                          
         BAL,RLNK GBSLIM            PROCESS LIMITS OF BAD SECTORS               
         PUSH     2,R6              SAVE SCAN INFO FOR LATER                    
         PUSH     R11               SAVE ITEM COUNT                             
         BAL,RLNK READDIR           READ IN ALL DIRE AND LINK IN BKG            
         B        ERROR41           ERROR IN DIRE: ABORT COMMAND                
         B        BDSEC48           DIRE EMPTY: CREATE A NEW DIRE               
*        B        BDSEC2            DIRE IN BKG: START PROCESSING               
*                                                                               
BDSEC2   RES      0         TEST IF A DIRE SECTOR IS TO BE BAD                  
         CW,R2    BUFF3,R4          IS THE DIRE SECTOR IN THE RANGE ?           
         BG       BDSEC4              NO, TEST NEXT DIRE SECTOR                 
         CW,R3    BUFF3,R4                                                      
         BL       BDSEC4              NO, STEP TO NEXT DIRE SECTOR              
*                                                                               
         LW,R0    MASDFREE          YES, FIND A NEW DIRE SECTOR                 
         CW,R0    MASDSIZE          ROOM FOR A NEW SECTOR IN AREA ?             
         BG       ERROR01             NO, GIVE ERROR AND STOP                   
*                                                                               
         MTW,+1   MASDFREE          YES, USE NEXT FREE SECTOR                   
         STW,R0   BUFF3,R4          AND MARK IT NO LONGER AVAILABLE             
         B        BDSEC2            THEN RETEST THE NEW DIRE SECTOR             
*                                                                               
BDSEC4   RES      0         LOOP TO TEST ALL DIRE SECTORS                       
         BDR,R4   BDSEC2            IF NOT DONE, LOOP                           
*                                                                               
*                                                                               
BDSEC10  RES      0         START SEARCH OF FILES FOR USE OF BAD SECTORS        
         LW,R5    DIRCHAIN          GET START FILE ON LINKED CHAIN              
*                                                                               
BDSEC11  RES      0         PROCESS NEXT FILE ON CHAIN                          
         BAL,RLNK UNPKDIRE          GET BOT, EOT                                
         CW,R2    DIREBOT           IS BAD SECTOR AFTER BOT ?                   
         BG       BDSEC30            YES, SEE IF IN FILE AT ALL                 
*                                                                               
         CW,R3    DIREBOT           BAD SECTORS OVER LAP FILE BEGIN ?           
         BGE      BDSEC20             YES, MUST DESTROY THE FILE                
*                                                                               
*                           NEED TO CREATE A NEW BADSECTOR ENTRY                
         BAL,RLNK BDSNEWFL          BUILD A NEW BADSECTOR FILE ENTRY            
         LW,R1    BACLINK,R5        INSERT BEFORE CURRENT FILE                  
         BEZ      %+2                 NO PREVIOUS FILE: NEW IS NOW 1ST          
         STW,R6   FWDLINK,R1                                                    
         STW,R1   BACLINK,R6        SET LINK TO OLD PREV IF ONE                 
         STW,R6   BACLINK,R5        LINK BAC TO NEW FROM CURRENT                
         STW,R5   FWDLINK,R6        LINK FWD TO CURRENT FROM NEW FILE           
         B        BDSEC44           GO WRITE UPDATED DIRE WITH NEW FILE         
*                                                                               
BDSEC20  RES      0         BADSECTORS OVERLAY BEGIN OF FILE                    
         STW,R2   DIREBOT         SET NEW BEGIN OF BADSECTOR ENTRY              
         LW,R0    DIRESTAT          IS THE DESTROYED FILE A BADSECTOR ?         
         CI,R0    FILBDTRK          AND ALREADY DESTROYED ?                     
         BNE      BDSEC22             NO, MUST CHANGE ITS STATUS                
*                                                                               
         CW,R3    DIREEOT           DOES NEW END FALL WITHIN OLD RANGE ?        
         BLE      BDSEC44             YES, NOTHING ELSE CHANGES                 
         B        BDSEC24           NO, LOOK FOR OTHER DESTROYED FILES          
*                                                                               
BDSEC22  RES      0         PROCESS DESTROYED FILES OR DELETED FILES            
         CI,R0    FILDELTD          IS THE FILE A DELETED ENTRY ?               
         BE       BDSEC24             YES, NO NEED FOR INFO MESSAGE             
*                                                                               
         BAL,RLNK BDSECFLD          OUT 'FILE DESTROYED', AND DELETE IT         
*                                                                               
BDSEC24  RES      0         CONVERT DESTROYED FILE TO BADSECTOR ENTRY           
         STW,R3   DIREEOT           USE DESTROYED ENTRY AS THE BAD ONE          
         LI,R0    -1                CHANGE NAME                                 
         STW,R0   DIRENAME                      TO SAY                          
         STW,R0   DIRENAME+1                           BAD SECTORS              
         LD,R0    BLNK              CLEAR ACCOUNT NAME                          
         STD,R0   DIREACNT                                                      
         LI,R0    0                 ALSO CLEAR EXTENSION INFO                   
         STW,R0   DIREXTNT                                                      
         STW,R0   DIREESIZ                                                      
         LI,R0    FILBDTRK          SET STATUS = BAD AREAS                      
         STW,R0   DIRESTAT                                                      
         LW,R6    R5                POINT WHERE TO STORE THE ENTRY              
         BAL,RLNK PACKDIRE          STORE ALTERED ENTRY IN BKG CHAIN            
*                                                                               
BDSEC26  RES      0         LOOK FOR OTHER DESTROYED FILE ENTRIES               
         LW,R5    FWDLINK,R5        DOES ANOTHER FILE FOLLOW ?                  
         BEZ      BDSEC28             NO, TEST IF NEXT FREE IS OK               
*                                                                               
         BAL,RLNK UNPKDIRE          GET INFO ON NEXT FILE                       
         CW,R3    DIREBOT           IS THIS FILE DESTROYED TOO ?                
         BL       BDSEC44             NO, NOTHING ELSE CHANGES; CLEAN UP        
*                                                                               
         LW,R0    DIRESTAT          FILE IS DESTROYED: MSG NEEDED ?             
         CI,R0    FILGOODF          IS IT AN ACTIVE FILE ?                      
         BNE      BDSEC27             NO, NO NEED FOR DESTROYED MSG             
*                                                                               
         BAL,RLNK BDSECFLD          OUT 'FILE DESTROYED', AND DELETE IT         
*                                                                               
BDSEC27  RES      0         REMOVE FILE FROM LIST                               
         LW,R4    BACLINK,R5                                                    
         LW,R1    FWDLINK,R5                                                    
         BEZ      %+2                                                           
         STW,R4   BACLINK,R1                                                    
         STW,R1   FWDLINK,R4                                                    
         B        BDSEC26           TEST NEXT FILE ENTRY                        
*                                                                               
BDSEC28  RES      0         BAD AREA NO LONGER DESTROYES A FILE                 
         CW,R3    MASDFREE          DOES BAD SECTORS INCLUDE FREE ONES ?        
         BGE      BDSEC42           YES, UPDATE FREE SECTOR                     
         B        BDSEC44           NO, WRITE UPDATED DIRE                      
         PAGE                                                                   
         SPACE    2                                                             
BDSEC30  RES      0         TEST IF END OF FILE IN BADSECTORS                   
         CW,R2    DIREEOT           BAD SECTORS WITHIN FILE ?                   
         BG       BDSEC40             NO, TEST NEXT FILE                        
*                                                                               
         LW,R0    DIRESTAT          YES, IS THIS A VALID FILE ?                 
         CI,R0    FILBDTRK          IS IT A BADSECTOR ENTRY ?                   
         BNE      BDSEC32             NO, SEE ABOUT GIVING A MSG                
*                                                                               
         CW,R3    DIREEOT           IS BADSECTOR WITHIN OLD BADSECTOR ?         
         BLE      EXEC1               YES, DUP BAD ENTRY: IGNORE IT             
*                                                                               
         LW,R2    DIREEOT           MAKE NEW BAD SECTOR START AFTER             
         AI,R2    1                 OLD BAD SECTOR ENTRY                        
         B        BDSEC40           AND CONTINUE LOOKING FOR OVERLAPS           
*                                                                               
BDSEC32  RES      0         TRUNCATE FILE AT START OF BAD AREA                  
         STW,R2   DIREEOT           SET NEW EOT ON THE FILE                     
         MTW,-1   DIREEOT                                                       
         LW,R6    R5                REPACK TRUNCATED FILE ENTRY                 
         BAL,RLNK PACKDIRE          TO SHOW NEW EOT                             
         CI,R0    FILGOODF          IS IT AN ACTIVE FILE ?                      
         BNE      BDSEC40             NO, LOOK FOR DESTROYED FILES              
*                                                                               
         BAL,RLNK BDSECFLT          OUT 'FILE TRUNCATED', AND DO IT             
         PAGE                                                                   
         SPACE    2                                                             
BDSEC40  RES      0         STEP TO NEXT FILE ENTRY                             
         LW,R5    FWDLINK,R5        STEP TO NEXT: IS THERE ONE ?                
         BNEZ     BDSEC11             YES, TEST IT                              
*                                                                               
*                           NO FILE DESTROYED: CREATE NEW BAD AREA ENTRY        
         BAL,RLNK BDSNEWFL          CREATE THE BAD SECTOR ENTRY                 
         LW,R8    ENDCHAIN          GET CURRENT TAIL OF CHAIN, THEN             
         LW,R1    R8                COPY SAVED ADDRESS OF LAST ENTRY            
         LCI      4                 SET LINKS TO PREVIOUS ENTRY                 
         STM,R8   BACLINK,R6        IN NEW ENTRY                                
         STW,R6   FWDLINK,R1        AND LINK PREVIOUS ENTRY TO NEW              
*                                                                               
BDSEC42  RES      0         BAD SECTORS INCLUDE CURRENT NEXT FREE SECTOR        
         AI,R3    1                 SET NEXT FREE = LAST BADSECTOR + 1          
         STW,R3   MASDFREE          EVEN IF IT GOES TO END OF AREA              
*                                                                               
BDSEC44  RES      0         WRITE OUT UPDATED DIRE AND CLEAN UP                 
         BAL,RLNK WRITEDIR          WRITE THE DIRE                              
         PULL     R11               RECOVER ITEM COUNTER                        
         PULL     2,R6              RECOVER SCAN PARAMS                         
         B        BDSEC1            AND SEE IF ANOTHER SET OF SECTORS           
*                                                                               
*                                                                               
BDSEC48  RES      0         NO FILES IN AREA: CREATE A NEW DIRECTORY            
         BAL,RLNK BDSNEWFL          CREATE THE BAD SECTOR ENTRY                 
         B        BDSEC42           UPDATE NEXT FREE SECTOR AND FINISH          
         TITLE    '** RS1002 - SUBROUTINES FOR GDSECTOR/BDSECTOR **'            
*                                                                               
*        FUNCTION:  SCANS DEVICE NAME, VALIDATES IT TO BE A DISC OR RAD,        
*                   AND SETS ITS DCT INDEX IN R1 AND DCTINDEX.                  
*                                                                               
GBSDEV   RES      0         GET DEVICE NAME AND ITS DCT INDEX                   
         BAL,LINK SCAN              GET DEVICE NAME                             
         CI,R6    -1                ERRORS FOUND ?                              
         BLE      ERROR02             YES, GIVE 'ERROR ITEM XX'                 
         CI,R6    2                 DO ANY SECTOR NUMBERS FOLLOW ?              
         BGE      ERROR02             NO, ALSO 'ERROR ITEM XX'                  
         CI,R10   5                 IS NAME 5 CHARS, DEVICE LENGTH, LONG ?      
         BNE      ERROR02             NO, 'ERROR ITEM XX'                       
*                                                                               
         LH,R1    R8                IS THE DEVICE A DISK OR RAD ?               
         AND,R1   M16                                                           
         CI,R1    C'DC'                                                         
         BE       %+3                 RAD, OK                                   
         CI,R1    C'DP'                                                         
         BNE      ERROR02             NOT LEGAL DEVICE: 'ERROR ITEM XX'         
*                                                                               
         LH,R1    *K:DCT1           LOOK NAME UP TO TEST IF VALID               
         SLD,R8   -24               ADJUST NAME TO DCT FORMAT                   
         OR,R8    DCTDATA                                                       
*                                                                               
GBSDEV1  RES      0         SEARCH LIST OF DEVICE NAMES FOR INPUT NAME          
         CD,R8    *K:DCT16,R1                                                   
         BE       GBSDEV2           FOUND: LEGAL NAME                           
         BDR,R1   GBSDEV1           LOOP TO TEST ALL DEVICES                    
         B        ERROR02           ILLEGAL NAME: 'ERROR ITEM XX'               
*                                                                               
GBSDEV2  RES      0         DEVICE FOUND: SAVE DCT INDEX                        
         STW,R1   DCTINDEX          SAVE INDEX FOR AREA TESTING                 
         B        *RLNK             RETURN TO CALLER                            
         PAGE                                                                   
*                                                                               
*        FUNCTION:  SCANS SECTOR NUMBERS AND DETERMINES WHAT AREA THEY          
*                   ARE IN, SETS UP THE F:BI DCB TO POINT TO IT, AND            
*                   ADJUSTS THE SECTOR LIMITS TO AREA RELATIVE ADDRESSES        
*                                                                               
*        RETURNS: R2  AREA RELATIVE BOT OF SECTOR LIMITS                        
*                 R3  AREA RELATIVE EOT OF SECTOR LIMITS                        
*                                                                               
GBSLIM   RES      0         GET SECTOR LIMITS, DETERMINE AREA                   
         PUSH     RLNK              SAVE RETURN ADDRESS                         
         LW,R0    4                 SET TO SCAN SECTOR NUMBERS IN               
         STW,R0   SPARAMF1          DECIMAL                                     
         BAL,LINK SCAN              GET 1ST SECTOR                              
         LW,R2    R8                COPY BEGIN SECTOR                           
         CI,R6    -1                WAS AN ERROR FOUND ?                        
         BG       GBSLIM2             NO, ONLY 1 SECTOR IN RANGE                
         CI,R10   C'-'              WAS THE LAST CHAR A RANGE INDICATOR ?       
         BNE      ERROR02             NO, REAL ERROR: 'ERROR ITEM XX'           
*                                                                               
         BAL,LINK SCAN              GET END OF RANGE                            
         CI,R6    -1                ANY ERRORS IN THIS ?                        
         BLE      ERROR02             YES, REPORT                               
*                                                                               
GBSLIM2  RES      0         SET END SECTOR: DETERMINE AREA                      
         LW,R3    R8                SET END SECTOR                              
         LI,R4    SPINDEX           START SEARCH WITH 1ST AREA                  
         CW,R2    R3                ARE LIMITS IN ORDER ?                       
         BG       ERROR02             NO, GIVE ERROR: 'ERROR ITEM XX'           
*                                                                               
GBSLIM4  RES      0         SEARCH FOR AREA CONTAINING START SECTOR             
         STW,R4   AREA              SET AREA TO TEST                            
         BAL,RLNK UNPKMASD          GET AREA INFO                               
         B        GBSLIM6           ERROR: SKIP AREA                            
         CW,R1    MASDDCTI          ON THE DEVICE SPECIFED ?                    
         BE       GBSLIM10            YES, TEST IF WITHIN SECTOR LIMITS         
*                                                                               
GBSLIM6  RES      0         NOT THIS AREA; STEP TO NEXT                         
         AI,R4    1                 STEP TO NEXT AREA                           
         CW,R4    K:NUMDA           HAVE WE TESTED ALL POSSIBLE AREA ?          
         BLE      GBSLIM4             NO, DO ANOTHER                            
         B        ERROR02           IN NO AREA; REPORT ERROR IN RANGE           
*                                                                               
GBSLIM10 RES      0         TEST IF BAD SECTORS ARE IN THIS AREA                
         CW,R2    MASDBOA           DOES BDSECTOR BOT FALL IN AREA ?            
         BL       GBSLIM6             NO, TRY ANOTHER AREA                      
         CW,R2    MASDEOA                                                       
         BG       GBSLIM6                                                       
*                                                                               
         SW,R2    MASDBOA           ADJUST TO AREA RELATIVE SECTORS             
         BEZ      ERROR02           ERROR IF SECTOR 0, THE DIRE SECTOR          
         SW,R3    MASDBOA                                                       
         CW,R3    MASDEOA           IS LAST SECTOR WITHIN THE AREA ?            
         BLE      %+2                 YES, KEEP IT                              
         LW,R3    MASDEOA           ELSE SET LAST BAD SECTOR = AREA EOA         
         PULL     RLNK              RECOVER LINK                                
         CLM,R4   CKXABT            IS AREA MAINTAINED BY RADEDIT ?             
         BCS,6    *RLNK               YES, CONTINUE PROCESSING                  
         B        ERROR11           ELSE GIVE 'AREA NOT MAINTAINED...'          
         PAGE                                                                   
         SPACE    2                                                             
*        FUNCTION:  READ DIRECTORY AND FORM A LINKED CHAIN OF ENTRIES           
*                   IN BKG SPACE. STORE NUMBER OF DIRECTORY SECTORS IN          
*                   BUFF3, AND DIRE SECTOR ADDRESSES IN BUFF3+1...              
*                                                                               
*        RETURNS: R4 :  NUMBER OF DIRE SECTORS                                  
*                 R6 :  ADDRESS OF NEXT AVAILABLE WORD IN BKG SPACE             
*                 R7 :  ADDRESS OF BUFF1                                        
*                 R8 :  = ENDCHAIN, ADDR OF TAIL OF DIRE CHAIN                  
*                 R9 :  ZERO                                                    
*                 R10:  ZERO                                                    
*                 R11:  ZERO                                                    
*                                                                               
*        EXITS:   LINK+0:  ERROR IN DIRECTORY FORMAT OR SECTOR ADDRESSES        
*                 LINK+1:  NO FILE ENTRIES IN DIRECTORY                         
*                 LINK+2:  DIRECTORY CHAINED SUCCESSFULLY                       
*                                                                               
*                                                                               
READDIR  RES      0         READ IN AND LINK UP THE AREA'S DIRECTORY            
         PUSH     6,RLNK            SAVE RETURN, BOT & EOT OF BADSECTORS        
         LI,R7    BUFF1             SET ADDRESS OF DIRE READ BUFFER             
         STW,R7   BIBUFF            AND SET AS READ/WRITE ADDRESS               
         LW,R6    BPEND             SET START OF DIRE CHAIN IN BKG              
         STW,R6   DIRCHAIN                                                      
         LI,R8    BUFF4             SET TEMP PREVIOUS ENTRY ADDRESS             
         LI,R9    0                 SET FWDLINK = NONE                          
         LD,R10   ZEROS             AND NO EXTENSION INFO                       
         LI,R4    1                 SET CURRENT NUMBER OF DIRE SECTORS          
         STW,R9   BUFF3,R4          AND 1ST SECTOR IS ALWAYS 0                  
*                                                                               
         BAL,RLNK GET1SFIL          GET 1ST FILE IN DIRE                        
         B        READIRX0          ERROR: RETURN SAME                          
         B        READIRX1          EMPTY: RETURN SAME                          
*        B        READIR1           ENTRY: STORE IN CHAIN                       
*                                                                               
READIR1  RES      0         ENTRY FOUND; ENTER ON CHAIN IN BKG                  
         BAL,RLNK UNPKDIRE          UNPACK TO GET LENGTH                        
         BAL,RLNK PACKDIRE          MOVE TO CHAIN                               
         LW,R1    R8                GET ADDRESS OF PREVIOUS                     
         STW,R6   FWDLINK,R1        AND POINT IT TO THIS ONE                    
         LCI      4                 AND POINT THE NEW ONE BACK TO IT            
         STM,R8   BACLINK,R6                                                    
         LW,R8    R6                UPDATE LINKS FOR NEXT ENTRY                 
         MTW,+00  DIREESIZ          CAN THE FILE BE EXTENDED ?                  
         BEZ      READIR9             NO, A SIMPLE FILE                         
*                                                                               
         PUSH     R5                SAVE DIRE UNPACK POINTER                    
*                      LINK EXTENT UP WITH OTHERS IN SAME FILE                  
         LD,R2    DIRENAME          LOOK THROUGH BCKG BUFFER FOR OTHER          
         LD,R12   DIREACNT          EXTENTS OF THIS FILE                        
         LW,R15   DIREXTNT          AND LINK THEM UP IN ORDER                   
         LW,R5    DIRCHAIN          GET START OF NORMAL CHAIN                   
*                                                                               
READIR2  RES      0         TEST NEXT ENTRY FOR SAME FILE                       
         CW,R5    R6                AT END OF FILE CHAIN ?                      
         BGE      READIR8             YES, 1ST OR ONLY EXTENT; DONE             
*                                                                               
         BAL,RLNK UNPKDIRE          GET NAME, STATUS OF NEXT FILE               
         LW,R0    DIRESTAT          IS IT A REAL FILE  ?                        
         CI,R0    FILGOODF                                                      
         BNE      READIR7             NO, BADTRACK: SKIP IT                     
*                                                                               
         CD,R2    DIRENAME          PART OF SAME FILE ?                         
         BNE      READIR7             NO, TRY FOR A NEXT                        
*                                                                               
         CD,R12   DIREACNT          YES, IN SAME ACCOUNT ?                      
         BNE      READIR7           NO, SOME OTHER FILE                         
*                                                                               
READIR3  RES      0         SAME FILE: FIND ORDERED PLACE FOR XTNT              
         CW,R15   DIREXTNT          WHICH WAY IN XTNT CHAIN TO SCAN ?           
         BLE      READIR5             BACK UP; NEW XTNT # < THIS ONE            
*                                                                               
         LW,R1    XFWDLINK,R5       FWD: IS CURRENT ONE THE LAST ONE ?          
         BEZ      READIR4             YES, PUT AT THE END                       
*                                                                               
         LW,R5    R1                NO, LINK TO NEXT IN CHAIN                   
         BAL,RLNK UNPKDIRE          GET ITS EXTENT NUMBER                       
         B        READIR3           AND TEST AGAIN                              
*                                                                               
READIR4  RES      0         NEW EXTENT HIGHEST NUMBERED: PUT AT END             
         STW,R6   XFWDLINK,R5                                                   
         STW,R5   XBACLINK,R6                                                   
         B        READIR8           CLEAN UP AND DO NEXT FILE                   
*                                                                               
READIR5  RES      0         BACK UP LINKS TO FIND PLACE FOR NEW XTNT            
         LW,R1    XBACLINK,R5       ARE WE AT BEGINNING NOW ?                   
         BEZ      READIR6             YES, PUT NEW ONE AT BEGINNING             
*                                                                               
         LW,R5    R1                NO, POINT AT PREVIOUS ENTRY AND             
         BAL,RLNK UNPKDIRE          GET ITS NUMBER                              
         CW,R15   DIREXTNT          HAVE WE GONE FAR ENOUGH ?                   
         BL       READIR5             NO, BACK UP ANOTHER                       
*                                                                               
         LW,R1    XFWDLINK,R5       YES, INSERT NEW AFTER CURRENT:              
         STW,R6   XFWDLINK,R5       SAVE OLD FWD LINK, SET TO POINT AT          
         STW,R5   XBACLINK,R6       NEW ENTRY; NEW PTS BACK AT CURR             
         LW,R5    R1                SET OLD NEXT AT CURRENT &                   
*                                                                               
READIR6  RES      0         LINK UP CURRENT AND NEXT ENTRIES                    
         STW,R5   XFWDLINK,R6                                                   
         STW,R6   XBACLINK,R5                                                   
         B        READIR8           GO CLEAN UP AND GET NEXT NEW FILE           
*                                                                               
READIR7  RES      0         LOOK DOWN BCKG FILES FOR NEXT IN CHAIN              
         LW,R5    FWDLINK,R5        GET LINK TO NEXT FILE                       
         B        READIR2           AND TEST IF AT END YET                      
*                                                                               
READIR8  RES      0         DONE WITH EXTENT LINK-UP; RECOVER DIRE PTR          
         PULL     R5                GET POINTER TO UNPACK DIRE SECTORS          
*                                                                               
READIR9  RES      0         STEP POINTERS TO INCLUDE FILE IN CHAIN              
         AI,R6    SIZEDIR           POINT AT NEXT POSSIBLE ENTRY                
         LW,R0    R6                SEE IF ROOM FOR THE NEXT                    
         AI,R0    SIZEDIR                                                       
         CW,R0    BCKEND            WILL NEXT ENTRY FIT ?                       
         BG       ERROR19             NO, SAY NOT ENUF ROOM & ABORT             
*                                                                               
         AW,R5    DIRELEN           STEP TO NEXT ENTRY IN DIRE SECTOR           
         CW,R5    MASDEND           ARE WE DONE IN THE SECTOR ?                 
         BL       READIR1             NO, DO THE NEXT                           
*                                                                               
         MTW,+00  DIRINFO,R7        IS THIS THE LAST DIRE SECTOR ?              
         BGZ      READIRX2            YES, ALL DONE; RETURN                     
*                                                                               
         LW,R0    DIRNEXT,R7        NO, GET ADDRESS OF NEXT DIRE SECTOR         
         AI,R4    1                 STEP DIRE SECTOR COUNT AND                  
         STW,R0   BUFF3,R4          SAVE ITS ADDRESS                            
         BAL,RLNK GETNXFIL          READ NEXT DIRE SECTOR & SET POINTERS        
         B        READIRX0          ERROR: REPORT IT                            
         B        READIRX2          AT END: CLEAN UP AND RETURN                 
         B        READIR1           NEXT ENTRY: PROCESS IT                      
*                                                                               
*                                                                               
READIRX2 RES      0         DIRE CHAINED IN BKG SUCCESSFULLY                    
         AI,R9    1                 SET EXIT INDEX = OK                         
*                                                                               
READIRX1 RES      0         AREA IS CLEARED; CONTAINS NO FILE ENTRIES           
         AI,R9    1                 SET EXIT INDEX = EMPTY                      
*                                                                               
READIRX0 RES      0         ERROR IN DIRE; RETURN TO PROCESS CONDITION          
         STW,R6   FREECELL          SAVE ADDR OF NEXT CHAIN ENTRY               
         STW,R8   ENDCHAIN           AND ADDR OF LAST CHAIN ENTRY               
         STW,R4   BUFF3             AND NUMBER OF DIRE SECTORS                  
         LW,R5    DIRCHAIN          CLEAR BACK LINK TO BUFF4 FROM               
         STW,R10  BACLINK,R5        FIRST ENTRY IN THE CHAIN                    
         PULL     6,RLNK            RECOVER SAVE REGISTERS                      
         AW,RLNK  R9                ADJUST BY EXIT INDEX                        
         LI,R9    0                 INSURE R9 STAYS = 0                         
         B        *RLNK             RETURN                                      
         PAGE                                                                   
         SPACE    2                                                             
*        FUNCTION:  CREATE A 'BADSECTOR' ENTRY IN BKG SPACE, AND TO             
*                   ADJUST DIRE SECTOR INDICIES AND COUNTS TO INSURE            
*                   ROOM FOR IT IN THE DIRECTORY WHEN REWRITTEN.                
*                                                                               
*        RETURNS: R6:  ADDRESS OF ENTRY IN BKG SPACE                            
*                                                                               
*                                                                               
BDSNEWFL RES      0         CREATE A NEW BADSECTOR ENTRY FOR DIRE CHAIN         
         LW,R0    MASDEND           WILL THE NEW DIRE ENTRY FIT IN THE          
         SW,R0    BIBUFF            LAST DIRE SECTOR THAT WAS READ ?            
         AI,R0    DIRSIZE+2*#DFACNT    (THAT IS, WILL ANOTHER DIRE SECTOR       
         CW,R0    MASDWPS           BE REQUIRED ? )                             
         BL       BDSNF1              FITS, SO JUST FORM THE ENTRY              
*                                                                               
         LW,R0    MASDFREE          IS THERE ANOTHER SECTOR FREE ?              
         CW,R0    MASDSIZE                                                      
         BG       ERROR01             NO, DISC OVERFLOW ERROR                   
*                                                                               
         MTW,+1   MASDFREE          YES, USE IT; STEP TO NEW NEXT FREE          
         MTW,+1   BUFF3             STEP COUNT OF DIRE SECTORS NEEDED           
         LW,R1    BUFF3             AND STORE ITS ADDR IN LIST                  
         STW,R0   BUFF3,R1                                                      
         LI,R0    DIRLHDR           FUDGE SPACE IN DIRE SECTOR TO SHOW          
         AW,R0    BIBUFF            LOTS OF ROOM                                
         STW,R0   MASDEND                                                       
*                                                                               
BDSNF1   RES      0         FORM THE BADSECTOR ENTRY                            
         LI,R1    -(DIREEND-DIRENAME)    CLEAR DIRE ENTRY                       
         LI,R0    0                                                             
         STW,R0   DIREEND,R1                                                    
         BIR,R1   %-1                                                           
*                                                                               
         LD,R0    BLNK              SET ACCOUNT NAME, IF ANY, TO                
         STD,R0   DIREACNT          TO DEFAULT                                  
         LI,R0    DIRSIZE+2*#DFACNT   SET DIRE ENTRY = MAX NEEDED EVER          
         STW,R0   DIRELEN                                                       
         LI,R0    1                 SET FILE'S STATUS = 'BAD AREA'              
         STW,R0   DIRESTAT                                                      
         STW,R2   DIREBOT           SET ITS LIMITS                              
         STW,R3   DIREEOT                                                       
         LW,R6    FREECELL          POINT WHERE TO BUILD IT IN BKG              
         AI,R6    SIZEDIR           IS THERE ENOUGH ROOM FOR THE                
         CW,R6    BCKEND            ENTRY WHEN BUILT ?                          
         BGE      ERROR19             NO, 'NOT ENUF ROOM' AND ABORT             
*                                                                               
         XW,R6    FREECELL          GET ADDR ON NEW ENTRY; SET NEW NEXT         
         LCI      2                 CLEAR LINKS NOW BECAUSE WE DON'T            
         STM,R10  BACLINK,R6        COME BACK HERE AFTER PACKING THE            
         STM,R10  XBACLINK,R6       ENTRY IN BKG SPACE VIA PACKDIRE             
         LI,R0    DIRSIZE+2*#DFACNT    MAKE ROOM FOR A MAX SIZED ENTRY          
         AWM,R0   MASDEND           AND SAY THAT MUCH ROOM USED IN DIRE         
         B        PACKDIRE          MOVE ENTRY, RETURN TO CALLER                
         PAGE                                                                   
         SPACE    2                                                             
*        FUNCTION:  REWRITE THE DIRECTORY FROM CHAINED DIRE IN BKG.             
*                   THE NUMBER OF DIRE SECTORS TO USE IS IN BUFF3, AND          
*                   THE SECTOR ADDRESS TO WRITE THE DIRE OM START AT            
*                   BUFF3+1.                                                    
*                                                                               
*                                                                               
WRITEDIR RES      0         REWRITE UPDATED DIRECTORY                           
         PUSH     RLNK              SAVE WHO TO RETURN TO                       
         LI,R7    BUFF1             SET WHERE TO BUILD THE DIRE SECTORS         
         STW,R7   BIBUFF            AND WHERE TO WRITE THEM FROM                
         LW,R5    BPEND             POINT AT 1ST DIRE ENTRY IN CHAIN            
         LI,R4    1                 POINT AT 1ST DIRE SECTOR TO WRITE           
         LW,R0    BUFF3,R4          GET ADDRESS OF 1ST DIRE SECTOR              
         STW,R0   WRDISC5           AND SET AS 1ST SECTOR TO WRITE              
*                                                                               
WRITDIR1 RES      0         INIT A DIRE SECTOR, SET SECTOR'S DISC ADDR          
         LW,R1    MASDWPS                                                       
         AI,R1    -1                SET LENGTH TO CLEAR                         
         LI,R0    0                                                             
         STW,R0   *R7,R1            CLEAR THE DIRE                              
         BDR,R1   %-1                                                           
*                                                                               
         LW,R6    R7                SET START OF WHERE TO BUILD DIRE            
         LI,R10   DIRLHDR           FORM DIRE HEADER IN R10 - R13               
         LW,R11   MASDFREE          SET NEXT FREE SECTOR FOR LAST PASS          
         LD,R12   DCW1              SET CONTROL WORDS                           
         LCI      4                 SET HEADER                                  
         STM,R10  DIRINFO,R7                                                    
         AW,R6    DIRINFO,R7        POINT AT 1ST ENTRY IN DIRE SECTOR           
*                                                                               
WRITDIR2 RES      0         ENTER AN ENTRY INTO THE DIRE                        
         BAL,RLNK UNPKDIRE          GET THE NEXT ENTRY                          
         AW,R10   DIRELEN           WILL IT FIT IN THE SECTOR ?                 
         CW,R10   MASDWPS           WILL IT FIT IN THE SECTOR ?                 
         BGE      WRITDIR3            NO, WRITE SECTOR & START ANOTHER          
*                                                                               
         BAL,RLNK PACKDIRE          YES, MOVE IT TO DIRE SECTOR                 
         STW,R10  DIRINFO,R7        SET NEW SIZE OF INFO IN SECTOR              
         AW,R6    DIRELEN           POINT WHERE NEXT WILL GO                    
         LW,R5    FWDLINK,R5        IS THERE ANOTHER ENTRY TO PROCESS ?         
         BNEZ     WRITDIR2            YES, SEE IF IT WILL FIT                   
*                                                                               
         CAL1,1   WRDISC            WRITE LAST DIRE SECTOR OUT                  
         PULL     RLNK              RECOVER CALLER'S RETURN                     
         B        *RLNK             AND GO BACK                                 
*                                                                               
WRITDIR3 RES      0         DIRE SECTOR FULL; WRITE IT; PREP FOR NEXT           
         LW,R0    DIRINFO,R7        SET DIRE CONTINUED FLAG                     
         OR,R0    Y8                                                            
         STW,R0   DIRINFO,R7                                                    
         AI,R4    1                 POINT AT NEXT DIRE SECTOR TO WRITE          
         LW,R0    BUFF3,R4          GET ITS ADDRESS                             
         STW,R0   DIRNEXT,R7        AND SET AS LINK IN THE DIRE                 
         CAL1,1   WRDISC            WRITE DIRE                                  
         STW,R0   WRDISC5           SET WHERE TO WRITE NEXT DIRE SECTOR         
         B        WRITDIR1          AND PREP THE NEW DIRE SECTOR BUFFER         
         PAGE                                                                   
*                                                                               
*        FUNCTION:  PRINT MESSAGE 'FILE FILENAME.AREA.ACCOUNT' WITH             
*                   EITHER '.AREA' OR '.ACCOUNT' OR BOTH SKIPPED IF             
*                   THEY ARE BLANKS, FOLLOWED BY SUFFIX WORD.                   
*                                                                               
*                   BDSECFLD  APPENDS 'DESTROYED';                              
*                   BDSECFLT  APPENDS 'TRUNCATED'                               
*                                                                               
*                                                                               
BDSECFLD RES      0         OUT 'DESTROYED' MESSAGE                             
         PUSH     6,RLNK                                                        
         LI,R3    BDSECMD           POINT AT MESSAGE TO APPEND TO NAME          
         B        BDSECFL1          GO FORM COMMON PART OF MESSAGE              
*                                                                               
BDSECFLT RES      0         OUT 'TRUNCATED' MESSAGE                             
         PUSH     6,RLNK                                                        
         LI,R3    BDSECMT           POINT AT MESSAGE TO APPEND TO NAME          
*                                                                               
BDSECFL1 RES      0         OUT COMMON 'FILENAME.AREA.ACCOUNT '                 
         STRNG    BDSECMF           ENTER THE 'FILE ' PART                      
         CHARS    8,DIRENAME        ENTER THE FILE'S NAME                       
         CHAR     C'.'              THEN AREA NAME SEPARATOR                    
         CHARS    2,MASDNAME,2      FOLLOWED BY THE AREA NAME                   
         LD,R0    DIREACNT          TEST IF AN ACCOUNT NAME IS PRESENT          
         BEZ      BDSECFL2            NO, ALL ZEROS: SKIP PRINTING IT           
*                                                                               
         CD,R0    BLNK              IS A NAME THE DEFAULT BLANKS' ?             
         BE       BDSECFL2            YES, SKIP IT AND EXIT                     
*                                                                               
         CHAR     C'.'              ENTER ACCOUNT NAME SEPARATOR                
         CHARS    8,DIREACNT                                                    
         B        BDSECFL3          GO APPEND WHAT HAPPENED                     
*                                                                               
BDSECFL2 RES      0                                                             
         STEPCP   9                 SPACE OVER '.ACCOUNT' FIELD                 
*                                                                               
BDSECFL3 RES      0         APPEND SUFFIX TELLING WHAT HAPPENED TO FILE         
         LW,R2    R3                POINT AT REQUIRED SUFFIX                    
         STRNG                      AND APPEND IT TO THE FILENAME               
         PRNT                       PRINT THE WARNING MESSAGE                   
         MTW,+00  XFWDLINK,R5       DO ANY EXTENTS FOLLOW ?                     
         BEZ      BDSECFL8            NO, NONE TO DELETE                        
*                                                                               
         PUSH     2,R5              SAVE ENTRY PACK, UNPACK POINTERS            
         LI,R0    0                 SET 0 TO CLEAR LINKS                        
         LI,R1    FILDELTD          SET = DELETED ENTRY STATUS                  
*                                                                               
BDSECFL4 RES      0         UPDATE ENTRY TO NEW STATUS; LOOK FOR NEXT           
         LW,R6    R5                SAVE STATUS OF ENTRY IN BLOCK NOW           
         BAL,RLNK PACKDIRE          AND SET DELETED STATUS FOR LATER 1S         
         LI,R6    0                 SET XTNT FWD LINK FROM CURRENT TO           
         XW,R6    XFWDLINK,R5       TO NONE AFTER GETTING IT. A NEXT ?          
         BEZ      BDSECFL6            NO FOLLOWING XTNTS TO DELETE.             
*                                                                               
         LW,R5    R6                YES, POINT AT NEXT XTNT IN FILE             
         STW,R0   XBACLINK,R5       AND CLEAR LINK TO PREVIOUS                  
         BAL,RLNK UNPKDIRE          GET STATUS OF EXTENT                        
         STW,R1   DIRESTAT          AND SET TO 'DELETED'                        
         B        BDSECFL4          GO UPDATE ENTRY, LOOK FOR ANOTHER           
*                                                                               
BDSECFL6 RES      0         ALL EXTENTS DELETED; RECOVER ORIGINAL ENTRY         
         PULL     2,R5                                                          
         BAL,RLNK UNPKDIRE          PUT ENTRY WE HAD BACK IN BLOCK              
*                                                                               
BDSECFL8 RES      0         FILE TRUNCATED/DELETED: PROCESSING CONTINUES        
         PULL     6,RLNK                                                        
         B        *RLNK                                                         
         TITLE    '** RS1002 - C A T A L O G  **'                               
*                                                                               
*                                                                               
*        FUNCTION: DISPLAY ORG AND SIZE EITHER OF INDIVIDUALLY NAMED            
*                  FILES OR OF ALL FILES IN A GIVEN ACCOUNT AND/OR AREA         
*                                                                               
*        CALL:    B     CATALOG     FROM RS1000                                 
*                                                                               
*        INPUT:   PARAMETERS ON COMMAND LINE                                    
*                                                                               
*        OUTPUT:  LISTED FILE INFO ON THE M:LO DCB                              
*                                                                               
*        CALLS:   GETFID,SCAN,UNPKMASD,GET1SFIL,GETNXFIL,GETAX,                 
*                 UNPKDIRE,OUTFILNM, AND %ROUTINES                              
*                                                                               
*        FORMATS OF COMMAND:                                                    
*                                                                               
*        FORM 'A' INFORMATION ON A PARTICULAR FILE OR LIST OF FILES.            
*                                                                               
*        FORM 'B' INFORMATION ON FILES BY ACCOUNT AND/OR AREA.                  
*                 IT IS SUBDIVIDED INTO 3 TYPES:                                
*                 TYPE 0: ALL FILES IN AN ACCOUNT IN A GIVEN AREA;              
*                 TYPE 1: ALL FILES IN AN ACCOUNT;                              
*                 TYPE 2: ALL FILES IN A GIVEN AREA.                            
*                                                                               
*                                                                               
CATALOG  RES      0         DISPLAY CATALOG OF USER'S FILES                     
         LI,R0    0                 CLEAR AREAS TO SCAN FOR ACNTS               
         LI,R1    -(AREASWSX-AREASWS)                                           
         STW,R0   AREASWSX,R1                                                   
         BIR,R1   %-1                                                           
*                                                                               
         LD,R14   BLNK              INITIALIZE FILENAME.AREA.ACCOUNT            
         STD,R14  FILENAME          TO NOTHING GIVEN                            
         STW,R0   AREANAME                                                      
         STD,R0   ACNTNAME                                                      
         LW,R8    Y8                SET FROM AND TO LIMITS = 1ST                
         LI,R9    0                                                             
         STD,R8   FROMLIM                                                       
         LW,R8    M31                                                           
         LI,R9    -1                AND LAST POSSIBLE NAMES                     
         STD,R8   TOLIM                                                         
*                                                                               
         CI,R6    2                 ANY PARAMS TO THE COMMAND ?                 
         BGE      CAT11               NO, ASSUME DEFAULT ACCOUNT                
*                                                                               
         BAL,LINK GETFID            GET FILE AND/OR AREA OR ACCOUNT             
         CI,R6    -1                ANY ERRORS FOUND ?                          
         BLE      ERROR02             YES, REPORT 'ERROR ITEM XX'               
*                                                                               
         LD,R14   BLNK              LOOK TO SEE IF A FILENAME WAS GIVEN         
         CD,R14   FILENAME          TO REQUEST SPECIFIC FILES ONLY              
         BNE      CAT60               PRESENT; DO INDIVIDUAL FILES              
         PAGE                                                                   
         SPACE    2                                                             
*        DO FORM 'B' PROCESSING: FILES BY ACCOUNT AND/OR AREA                   
*                                                                               
         CI,R6    2                 DO LIMIT PARAMS FOLLOW ?                    
         BGE      CAT10               NO, USE DEFAULTS, = ALL FILES             
*                                                                               
         BAL,LINK SCAN              GET POSSIBLE 'FROM' NAME                    
         CI,R6    -1                ANY ERRORS ?                                
         BG       CAT2                NO, NO MISSING 'FROM' NAME                
*                                                                               
         CI,R10   C'-'              CAUSED BY '-' RANGE SEPARATOR ?             
         BE       CAT1                YES, ASSUME DEFAULT 'FROM' NAME           
*                                                                               
         CI,R10   C','              WAS IT ALTERNATE RANGE SEPARATOR ?          
         BNE      ERROR02             NO, ILLEGAL FORMAT: ERROR ITEM XX         
*                                                                               
CAT1     RES      0         UPDATE 'FROM' NAME IF NOT BLANKS                    
         CD,R8    BLNK              WAS A NAME ACTUALLY GIVEN ?                 
         BE       CAT3                NO, LEAVE DEFAULT AS IS                   
*                                                                               
         STD,R8   FROMLIM           SET NEW 'FROM' NAME                         
         B        CAT3              AND GET 'TO' NAME (MUST BE GIVEN)           
*                                                                               
CAT2     RES      0         GET 'TO' NAME IF INDICATED                          
         STD,R8   FROMLIM           STORE SCANNED 'FROM' NAME                   
         CI,R6    2                 AT END OF INPUT ?                           
         BGE      CAT10               YES, NO 'TO' NAME                         
*                                                                               
CAT3     RES      0                                                             
         BAL,LINK SCAN              GET 'TO' NAME                               
         CI,R6    -1                ANY ERRORS ?                                
         BLE      ERROR02             YES, GIVE 'ERROR ITEM XX'                 
*                                                                               
         STD,R8   TOLIM             SET NEW 'TO' NAME                           
         CW,R8    FROMLIM           ARE LIMITS IN ORDER, FROM =< TO ?           
         BL       ERROR02             NO, WRONG ORDER: 'ERROR ITEM XX'          
*                                                                               
*                                                                               
CAT10    RES      0         DECIDE TYPE OF AREA SCAN TO DO                      
         LI,R15   2                 SET DOING A PARTICULAR AREA ONLY            
         STW,R15  MAPSW             (TYPE = 2)                                  
         LW,R15   GIOCT             GET P-BITS FOR WHAT WAS ENTERED;            
         CW,R15   GIOABIT           IS ACCOUNT INDICATED AS PRESENT ?           
         BAZ      CAT18               NO, IN GIVEN AREA ONLY                    
*                                                                               
         LD,R14   ACNTNAME          WAS AN ACCOUNT NAME REALLY GIVEN ?          
         BNEZ     CAT12               YES, USE IT                               
*                                                                               
CAT11    RES      0         ACCOUNT DEFAULTED: GET IT                           
         CAL1,7   GETACNT           GET ACCOUNT AND USER NAME                   
         LCI      2                 MOVE ACCOUNT NUMBER TO ITS NORMAL           
         LM,R8    BUFF4+4           PLACE IN ACNTNAME                           
         STM,R8   ACNTNAME          AS IF IT HAD BEEN ENTERED                   
*                                                                               
CAT12    RES      0         PROCESS AREA SPECIFICATIONS                         
         LI,R0    0                 SET DOING BY AREA.ACCOUNT                   
         STW,R0   MAPSW             (TYPE = 0)                                  
         CW,R0    AREANAME          WAS AN AREA NAME GIVEN ?                    
         BNE      CAT18               YES, USE IT                               
*                                                                               
         MTW,+1   MAPSW             NO, SET SCAN BY ACCOUNT (TYPE=1)            
         LI,R0    X'FF'             AND MARK ALL VALID AREAS                    
         LW,R1    K:NUMDA           GET NUMBER OF AREAS TO MARK TO SCAN         
*                                                                               
CAT13    RES      0         MARK AREA TO BE SCANNED IF LEGAL                    
         CLM,R1   CKXABT            CAN IT HAVE ANY FILES ?                     
         BCS,6    %+2                 YES, MARK IT                              
         B        CAT14               NO, SKIP IT                               
*                                                                               
         STB,R0   AREASWS,R1        MARK TO SCAN FOR FILES                      
*                                                                               
CAT14    RES      0                                                             
         BDR,R1   CAT13                                                         
*                                                                               
         STB,R0   AREASWS           INCLUDE SP AREA TOO                         
         B        CAT19             START SCANNING FOR FILES                    
*                                                                               
CAT18    RES      0         SET GIVEN AREA ONLY TO SCAN FOR FILES               
         LW,R8    AREANAME          GET AREA NAME SCANNED BY 'GETFID'           
         SCS,R8   16                LEFT JUSTIFY NAME                           
         BAL,RLNK GETAX             TEST FOR VALID AREA, GET INDEX              
         B        ERROR04             NOT VALID; REPORT THE ERROR               
         CLM,R1   CKXABT            CAN IT HAVE ANY FILES ?                     
         BCS,6    %+2                 YES, MARK IT                              
         B        ERROR05           ELSE GIVE ERROR IN IT                       
*                                                                               
         MTB,-1   AREASWS,R1        SET FLAG = X'FF' FOR PROCESSING             
CAT19    RES      0                                                             
         BAL,RLNK CAT20             SET UP DIRECTORY                            
         B        CAT50                                                         
         PAGE                                                                   
         SPACE    2                                                             
CAT20    RES      0         START SCAN OF AREAS FOR FILES TO LIST               
         PUSH     RLNK                                                          
*                                                                               
         LI,R0    0                                                             
         STW,R0   NFIL              ZERO NR OF FILES FOUND                      
*                                                                               
         LW,R1    BPEND                                                         
         STW,R1   DIRCHAIN          SET START OF DIRECTORY IMAGE                
*                                                                               
         LW,R8    M31                                                           
         LI,R9    -1                R8,9 IS LARGEST FILE NAME                   
         LD,R10   R8                R10,11 IS LARGEST ACNT NAME                 
         LW,R12   R10               R12 IS LARGEST AREA NAME                    
         LD,R14   ZEROS             FLINK, BLINK OF ZERO                        
         LCI      8                                                             
         STM,R8   0,R1              SET AN ENTRY WHICH SORTS LAST               
*                                                                               
         AI,R1    FILLEN                                                        
         STW,R1   FREECELL          SET NEXT AVAILABLE ENTRY                    
*                                                                               
         LI,R4    SPINDEX           START SCANNING IN THE SP AREA               
*                                                                               
CAT22    RES      0         PROCESS THE NEXT AREA                               
         LB,R0    AREASWS,R4        IS THE AREA TO BE PROCESSED ?               
         BEZ      CAT49               NO, SKIP IT                               
*                                                                               
         STW,R4   AREA              SET AREA INDEX                              
         BAL,RLNK UNPKMASD          GET AREA INFO                               
         B        CAT48             CAN'T HAPPEN, BUT IF IT DOES...             
*                                                                               
         BAL,RLNK GET1SFIL          GET A FILE, TEST DIRE STATUS                
         B        CAT48             ERROR IN DIRE; SKIP AREA, DO NEXT           
         B        CAT48             EMPTY:  STEP TO NEXT AREA                   
*        B        CAT24             ENTRY FOUND: PROCESS IT                     
*                                                                               
CAT24    RES      0         PROCESS AN ENTRY; SEE IF TO KEEP IT                 
         BAL,RLNK UNPKDIRE          GET NAME, ACCOUNT, ETC                      
         LW,R0    DIRESTAT          IS IT AN ACTIVE FILE ?                      
         CI,R0    FILGOODF          THAT IS, NOT DELETED OR BDSECTOR ?          
         BNE      CAT42              NOT ACTIVE; SKIP IT                        
*                                                                               
         LD,R14   ACNTNAME          ARE WE 'CAT' ING ALL ACCOUNTS ?             
         BEZ      CAT26               YES, SEE IF IN RANGE                      
*                                                                               
         CD,R14   DIREACNT          IS FILE IN CORRECT ACCOUNT ?                
         BNE      CAT42               NO, SKIP IT                               
*                                                                               
CAT26    RES      0         TEST IF FILE IS WITHIN DISPLAY LIMITS               
         LD,R8    DIRENAME          GET NAME AND TEST IF WITHIN LIMITS          
         CD,R8    FROMLIM           IS IT OUTSIDE THE LIMITS ?                  
         BL       CAT42               BEFORE START: SKIP FILE                   
*                                                                               
         CD,R8    TOLIM                                                         
         BG       CAT42             AFTER LAST: SKIP FILE                       
*                                                                               
CAT30    RES      0         FIND FILE ON CHAIN IF THERE, ELSE ADD IT            
         LW,R7    DIRCHAIN          GET ADDR OF LOWEST (START) FILE             
*                                                                               
CAT32    RES      0         TEST NEXT FILE ON CHAIN                             
         LCI      5                 GET FILE'S NAME, ACNT & AREA ID             
         LM,R8    FILNAM,R7         FROM THE CHAIN ENTRY                        
         CD,R8    DIRENAME          TEST WHERE FILE FITS IN CHAIN:              
         BL       CAT33             NAME COMES AFTER THIS ENTRY; STEP           
         BG       CAT35             COMES BEFORE; NOT THERE; ADD IT             
         CD,R10   DIREACNT          SAME FILENAME: IN SAME ACCOUNT ?            
         BL       CAT33               NO, IN LATER ACCOUNT; STEP                
         BG       CAT35              IN PREVIOUS ACCOUNT; ADD IT                
         LH,R12   R12               REMOVE ORG INFO; GET AREA ID ONLY           
         CW,R12   AREA              SAME FILE.ACCOUNT: IN SAME AREA ?           
         BE       CAT40              YES, SAME FILE: STEP RECORD COUNT          
*                                                                               
CAT33    RES      0         STEP TO NEXT FILE ON CHAIN                          
         LW,R7    FLINK,R7          POINT AT NEXT                               
         B        CAT32             AND TEST IT                                 
*                                                                               
CAT35    RES      0         ADD NEW ENTRY TO CHAIN IN ALPHABETICAL ORDER        
         LW,R6    FREECELL          GET ADDRESS OF NEXT FREE SPACE              
         AI,R6    FILLEN            IS THERE ROOM FOR ANOTHER ENTRY             
         CW,R6    BCKEND            BEFORE THE END OF MEMORY ?                  
         BGE      CAT44               NO, OVERFLOW: TERMINATE SEARCH            
*                                                                               
         XW,R6    FREECELL          SET NEW END, GET LOC OF NEW ENTRY           
         LD,R8    DIRENAME                                                      
         LD,R10   DIREACNT                                                      
         LW,R12   AREA              FORM ENTRY IN REGS                          
         SLS,R12  16                COMBINE AREA AND ORG IN WORD 5              
         OR,R12   DIREORG                                                       
         LI,R13   0                 AND NO RECORDS YET                          
         LCI      6                                                             
         STM,R8   FILNAM,R6         STORE ALL BUT LINKS                         
         STW,R7   FLINK,R6          INSERT BEFORE NEXT HIGHEST NAME             
         LW,R1    BLINK,R7          IS THERE A PREVIOUS ENTRY ?                 
         BEZ      CAT37               NO, A NEW START OF THE CHAIN              
*                                                                               
         STW,R6   FLINK,R1          LINK OLD PREVIOUS TO NEW ENTRY              
         B        CAT39             AND CONTINUE LINKING UP                     
*                                                                               
CAT37    RES      0         NEW START OF CHAIN FOUND; SET HEAD ADDRESS          
         STW,R6   DIRCHAIN          SET NEW START                               
*                                                                               
CAT39    RES      0                                                             
         STW,R1   BLINK,R6          POINT NEW ENTRY AT ANY PREVIOUS             
         STW,R6   BLINK,R7          AND CURRENT AT PREVIOUS                     
         LW,R7    R6                MAKE NEW ENTRY CURRENT                      
         MTW,+1   NFIL              STEP NUMBER OF FILES FOUND                  
*                                                                               
CAT40    RES      0         INCLUDE THIS EXTENT'S RECORDS IN COUNT              
         LW,R0    DIREFSIZ                                                      
         AWM,R0   FILFSIZ,R7        STEP RECORD COUNT TOTAL                     
*                                                                               
CAT42    RES      0         GET NEXT FILE IN AREA'S DIRECTORY                   
         BAL,RLNK GETNXFIL          POINT AT NEXT IF ANY                        
         B        CAT48             ERROR: ABORT AREA, DO NEXT                  
         B        CAT48             DONE:  STEP TO NEXT AREA                    
         B        CAT24             ENTRY: PROCESS AS BEFORE                    
*                                                                               
*                                                                               
CAT44    RES      0         TABLE SPACE EXHAUSTED; TERMINATE SCAN               
         LW,R0    K:NUMDA           FUDGE AREA INDEX TO FORCE END OF            
         STW,R0   AREA              AREA SCANNING                               
         STRNG    CATOFLOW          OUT MESSAGE SAYING WE HAVE STOPPED          
         CHARS    8,DIRENAME        OUT NAME OF LAST SCANNED FILE               
         CHAR     C'.'                                                          
         CHARS    2,MASDNAME,2      AND CURRENT AREA NAME                       
         LD,R0    DIREACNT          IS THERE AN ACCOUNT NAME ?                  
         BEZ      CAT46               NO, SKIP OUTPUTTING IT                    
         CD,R0    BLNK              OR IS IT ALL BLANKS ?                       
         BE       CAT46              WHICH IS ALSO NO NAME                      
*                                                                               
         CHAR     C'.'                                                          
         CHARS    8,DIREACNT                                                    
*                                                                               
CAT46    RES      0         PRINT TERMINATION MESSAGE                           
         PRNT                                                                   
*                                                                               
CAT48    RES      0         DONE WITH AN AREA:  PROCESS NEXT                    
         CAL1,1   CLFLEIN           CLOSE IT                                    
         LW,R4    AREA              GET SAVED AREA INDEX                        
*                                                                               
CAT49    RES      0         STEP TO NEXT AREA: TEST IF ALL PROCESSED            
         AI,R4    1                                                             
         CW,R4    K:NUMDA           HAVE WE DONE ALL AREAS ?                    
         BLE      CAT22             NO, DO THIS NEXT ONE                        
         PULL     RLNK                                                          
         B        *RLNK                                                         
         PAGE                                                                   
         SPACE    2                                                             
CAT50    RES      0         READY TO OUT DISPLAY                                
         EJECT                      SKIP PRINTER TO A NEW PAGE                  
         LW,R6    MAPSW             GET TYPE OF CAT TO DISPLAY SWITCH           
         B        %+1,R6            OUT HEADER AS PER TYPE                      
         B        CAT51    TYPE=0   IN AREA.ACCOUNT                             
         B        CAT52    TYPE=1   IN ACCOUNT                                  
         B        CAT53    TYPE=2   IN AREA                                     
*                                                                               
*                                                                               
CAT51    RES      0         AREA AND ACCOUNT GIVEN                              
         STRNG    CATAREA           OUT 'AREA'                                  
         CHAR     C'.'              AND SEPARATER                               
         STRNG    CATACNT           AND 'ACCOUNT'                               
         STEPCP   2                 SPACE 2 CHARACTERS                          
         CHARS    2,AREANAME,2      OUT THE AREA NAME                           
         CHAR     C'.'              THE '.' AGAIN                               
         CHARS    8,ACNTNAME        AND THE ACCOUNT                             
         B        CAT54             GO START FILE PRINT                         
*                                                                               
CAT52    RES      0         ACCOUNT GIVEN                                       
         STRNG    CATACNT           OUT 'ACCOUNT'                               
         STEPCP   2                                                             
         CHARS    8,ACNTNAME        OUT THE GIVEN ACCOUNT NAME                  
         B        CAT54             GO START FILE PRINT                         
*                                                                               
CAT53    RES      0         AREA GIVEN                                          
         STRNG    CATAREA           OUT 'AREA'                                  
         STEPCP   2                                                             
         CHARS    2,AREANAME,2      AND THE AREA NAME                           
*                                                                               
CAT54    RES      0         PRINT TITLE LINE; TEST FOR NO FILES                 
         PRTUP    3                 PRINT LINE, SPACE 2 MORE                    
         MTW,+00  NFIL              WERE ANY FILES FOUND ?                      
         BEZ      CAT59               NO, SAY NONE                              
         LW,R15   NFIL              COPY AND SAVE FILE COUNT FOR                
         STW,R15  MASDNFIL          PRINTING SUMMARY LINE                       
         PRTTXT   CATHEADR          OUT COLUMN HEADERS                          
         LW,R7    DIRCHAIN          POINT AT FIRST FILE IN LIST                 
*                                                                               
CAT55    RES      0         PROCESS A FILE ON THE CHAIN                         
         SETCP    CPCATORG          POINT WHERE ORG CODE GOES                   
         LW,R1    FILAREA,R7        GET WORD WITH ORG CODE IN IT                
         AND,R1   M3                EXTRACT IT                                  
         LB,R15   FORMATC,R1        GET THE CODE                                
         CHAR                       AND ENTER IT                                
         SETCP    CPCATSIZ          POINT WHERE RECORD COUNT GOES               
         LW,R15   FILFSIZ,R7        GET THE COUNT                               
         INTGR    DEC,SPAC,5        ENTER IT                                    
         SETCP    CPCATNAM          POINT WHERE THE FILE'S NAME GOES            
         LW,R2    R7                POINT AT START OF NAME STRING               
         CHARS    8                 OUT 8 CHARS FROM CHAIN ENTRY                
         CHAR     '.'                                                           
         LW,R1    FILAREA,R7        GET AREA INDEX                              
         LH,R1    R1                REMOVE ORG INFO                             
         LH,R8    *K:MDNAME,R1      GET NAME IN R8                              
         CHARS    2,R8,2            ENTER AREA NAME IN MESSAGE                  
*                                                                               
         LCI      2                 GET ACCOUNT NAME AND ENTER IF IT            
         LM,R0    FILACNT,R7        IS PRINTABLE                                
         CD,R0    ZEROS             IS IT A DEFAULTED 0 ?                       
         BE       CAT57               YES, SKIP OUTPUTTING IT                   
*                                                                               
         CD,R0    BLNK              IS NAME THE DEFAULT NAME ?                  
         BE       CAT57               YES, ALL BLANKS; SKIP IT                  
*                                                                               
         CHAR     C'.'              ENTER THE SEPARATER                         
         LW,R2    R7                POINT R2 AT CHAIN ENTRY                     
         CHARS    8,,8              ENTER 2ND 8 CHARS IN CHAIN ENTRY            
*                                                                               
CAT57    RES      0         PRINT LINE; STEP TO NEXT ENTRY; COUNT FILES         
         PRNT                                                                   
         LW,R7    FLINK,R7          POINT AT NEXT ENTRY                         
         MTW,-1   NFIL              HAVE WE DONE ALL BUT LAST ENTRY ?           
         BGZ      CAT55               NO, DO NEXT                               
*                                                                               
         PRNT                       SPACE A LINE FROM LAST FILE OUTPUT          
         INTGR    DEC,ZERO,1,MASDNFIL   OUT NUMBER OF FILES, LEFT               
         STRNG    CAT#FILS          JUSTIFIED, FOLLOWED BY THE REST             
*                                                                               
CAT58    RES      0         END OF LIST; CLEAN UP AND EXIT                      
         PRTUP    2                 SPACE 2 LINES                               
         PRNT                       AND AGAIN TO CLEAR PENDING UPSPACE          
         B        EXEC1             GO GET NEXT COMMAND                         
*                                                                               
*                                                                               
CAT59    RES      0         NO FILES FOUND; REPORT THIS                         
         PRTTXT   CATNFILS          SAY 'NO FILES'                              
         B        CAT58             AND THEN CLEAN UP AS USUAL                  
         PAGE                                                                   
         SPACE    2                                                             
*        DO FORM 'A' PROCESSING:  INDIVIDUALLY NAMED FILES                      
*                                                                               
*                                                                               
CAT60    RES      0         PROCESS A LIST OF FILENAMES                         
         LI,R0    CATERFS           SET ERROR FUNCTION TO OURS                  
         STW,R0   ERRFCN                                                        
         PRTTXT   CATHEADR          OUT COLUMN HEADERS                          
*                                                                               
CAT61    RES      0         GET INFO FOR NAMED FILE                             
         PUSH     2,R6                                                          
         LW,R0    GIOCT             GET WHAT OPTIONS WERE GIVEN                 
         LW,R1    GIOFA             AND SET UP TO ASSIGN A DCB TO IT            
         STS,R0   ASNFILE+1                                                     
         LI,R2    F:BI              SET DCB TO BE USED                          
         CAL1,1   ASNFILE           ASSIGN GIVEN FILE TO THE DCB                
         CAL1,1   OPENANY           OPEN IT TO TEST IF IT EXISTS                
         CAL1,1   GETFILNM          GET FILENAME.AREA.ACCOUNT FOR SURE          
         CAL1,1   CLOSEANY          INSURE IT IS CLOSED                         
         LCI      2                                                             
         LM,R8    FILENAME          GET FILE NAME                               
         STD,R8   FROMLIM           SET IT AS LOWER SCAN BOUND                  
         STD,R8   TOLIM             AND UPPER AS WELL                           
         LW,R8    AREANAME          GET AREA NAME                               
         SLS,R8   16                LEFT-JUSTIFY AREA NAME                      
         BAL,RLNK GETAX             CONVERT TO AN INDEX                         
         B        CAT68             SHOULDNT FAIL, BUT . . .                    
         LI,R0    -1                                                            
         STB,R0   AREASWS,R1        SET WHICH AREA TO SCAN                      
         BAL,RLNK CAT20             SET UP DIRECTORY (ONE ENTRY)                
         LW,R7    DIRCHAIN          POINTER TO 1ST DIRE ENTRY                   
         LW,R0    NFIL                                                          
         BEZ      CAT68             ALSO SHOULDNT HAPPEN                        
         SETCP    CPCATORG          OUT ORG                                     
         LW,R1    FILAREA,R7        GET AREA INDEX AND ORG CODE                 
         AND,R1   M3                EXTRACT ORG CODE                            
         LB,R15   FORMATC,R1        GET ORG CODE                                
         CHAR                       ENTER IT                                    
         SETCP    CPCATSIZ                                                      
         LW,R15   FILFSIZ,R7        GET RECORD COUNT                            
         INTGR    DEC,SPAC,5        AND OUT RECORD COUNT                        
         STEPCP   1                 SPACE AWAY 1 SPACE AND                      
         BAL,RLNK OUTFILNM          OUT FILENAME.AREA.ACCOUNT                   
*                                                                               
CAT64    RES      0         ENTRY FOR FILE DOES NOT EXIST                       
         PRNT                       PRINT INFO LINE                             
         PULL     2,R6                                                          
         CI,R6    2                 ANY MORE NAMES LISTED ?                     
         BGE      CAT65               NO, CLEAN UP AND EXIT                     
*                                                                               
         BAL,LINK GETFID            GET NEXT NAME                               
         CI,R6    -1                ANY ERRORS ?                                
         BLE      ERROR02             YES, REPORT AS 'ERROR ITEM XX'            
         LI,R0    0                                                             
         LI,R1    AREASWSX-AREASWS  NR WORDS OF AREA SWITCHES                   
         STW,R0   AREASWS-1,R1      CLEAR THEM                                  
         BDR,R1   %-1                                                           
         B        CAT61             PROCESS NEXT FILE NAME                      
*                                                                               
*                                                                               
CAT65    RES      0         END OF FILENAME LIST: EXIT                          
         PRNT                       CLEAN UP ANY PENDING UPSPACES               
         B        EXEC1             AND GO GET NEXT COMMAND                     
         PAGE                                                                   
         SPACE    2                                                             
CATERFS  ERRP     X'03',CAT68       NONEXIST FILE                               
         ERRP     X'FF',0           ALL OTHER ERRORS AS PER ROOT                
*                                                                               
*                                                                               
CAT68    RES      0         FILE DOES NOT EXIST                                 
         STRNG    CATFILE           ENTER 'FILE '                               
         BAL,RLNK OUTFILNM          OUT NAME, AREA, ACCOUNT, ETC                
         STRNG    CATNXIST          AND THAT IT 'DOES NOT EXIST'                
         B        CAT64             OUT LINE, CONTINUE PROCESSING               
*                                                                               
*                                                                               
*                                                                               
GETORG   GEN,1,7,1,7,16   1,X'09',1,0,R2    GET ASSIGN FOR DCB IN R2            
         DATA             P1+P8             ERROR ADDR; ORG CODE                
         DATA             ABNERR            ERROR ROUTINE ADDRESS               
         PZE              *DIREORG          LOC OF WORD TO GET ORG CODE         
*                                                                               
*                                                                               
GETACNT  GEN,8,1,23    X'4E',1,0    STATUS CALL; P0; 0                          
         DATA          P1+P14       ERROR AND ACCOUNT NAME BLOCK                
         DATA          ABNERR                                                   
         DATA          BUFF4+4      LOC TO STORE ACCOUNT NAME, ETC              
         TITLE    '** RS1002 - DPCOPY DATA, DCBS, AND FPTS **'                  
         SPACE    2                                                             
*%*READAFPT EQU   %                                                             
*%*      GEN,8,24 X'10',F:SI                                                    
*%*      DATA     P1+P2+P3+P4+P8+P10                                            
*%*      DATA     ABNERR                                                        
*%*      DATA     ABNERR                                                        
*%*RABUF DATA     0                 BUFFER ADDRESS                              
*%*RABYTES DATA   1024                                                          
*%*RASEC DATA     0                 SECTOR NUMBER                               
*%*      DATA     0                                                             
*%**                                                                            
*%*READBFPT EQU   %                                                             
*%*      GEN,8,24 X'10',F:SI                                                    
*%*      DATA     P1+P2+P3+P4+P8+P10                                            
*%*      DATA     ABNERR                                                        
*%*      DATA     ABNERR                                                        
*%*RBBUF DATA     0                 BUFFER ADDRESS                              
*%*RBBYTES DATA   1024                                                          
*%*RBSEC DATA     0                 SECTOR NUMBER                               
*%*      DATA     0                                                             
*%**                                                                            
*%*WRITAFPT EQU   %                                                             
*%*      GEN,8,24 X'11',F:SO                                                    
*%*      DATA     P1+P2+P3+P4+P8+P10                                            
*%*      DATA     ABNERR                                                        
*%*      DATA     ABNERR                                                        
*%*WABUF DATA     0                 BUFFER ADDRESS                              
*%*WABYTES DATA   1024                                                          
*%*WASEC DATA     0                 SECTOR BUMBER                               
*%*      DATA     0                                                             
*%**                                                                            
*%*WRITBFPT EQU   %                                                             
*%*      GEN,8,24 X'11',F:SO                                                    
*%*      DATA     P1+P2+P3+P4+P8+P10                                            
*%*      DATA     ABNERR                                                        
*%*      DATA     ABNERR                                                        
*%*WBBUF DATA     0                                                             
*%*WBBYTES DATA   1024                                                          
*%*WBSEC DATA     0                                                             
*%*      DATA     0                                                             
*%**                                                                            
*%*CHKFPT EQU     %                                                             
*%*      GEN,8,24 X'29',READAFPT                                                
*%*      DATA     P1+P2+P3+P10                                                  
*%*      DATA     ABNERR                                                        
*%*      DATA     ABNERR                                                        
*%*      DATA     CHKBUSY                                                       
*%**                                                                            
*%**                                                                            
*%*DPFLAGS  EQU   %                                                             
*%*NEXTSEC  DATA  0                 NEXT SECTOR TO BE READ                      
*%*ENDSEC   DATA  0                 LAST SECTOR TO BE READ                      
*%*SECTX    DATA  0                 # OF SECTORS IN BUFFER                      
*%*OFFSEC   DATA  0                 OFFSET FROM SECTOR READ TO                  
*                                   SECTOR TO WRITE                             
*%*SECTSIZE DATA  0                 SECTOR SIZE IN BYTES, IN HW 0               
*%*INMAXS   DATA  0                 LAST SECTOR ON INPUT DEVICE                 
*%*OUTMAXS  DATA  0                 LAST SECTOR ON OUTPUT DEVICE                
*                                                                               
*%*#TOZERO  EQU   %-DPFLAGS                                                     
         PAGE                                                                   
         SPACE    2                                                             
DPOPTAB  RES      0         LEGAL OPTIONS' 1ST TWO CHARACTERS                   
         DATA     'DP'              DISC INPUT                                  
         DATA     'DC'              RAD INPUT                                   
         DATA     'CK'              CHECK-READ / CHECK-WRITE                    
         DATA     'SS'              START SECTOR                                
         DATA     'NS'              NUMBER OF SECTORS                           
         DATA     'OS'              OUTPUT START SECTOR FOR OFFSET COPY         
#OPTIONS EQU      %-DPOPTAB                                                     
*                                                                               
DPOPTPRO EQU      %                                                             
         B        DPOPT             DISC INPUT                                  
         B        DPOPT             RAD INPUT                                   
         B        CKOPT             CHECK-READ, -WRITE                          
         B        SSOPT             START READ SECTOR                           
         B        NSOPT             NUMBER OF SECTORS                           
         B        OSOPT             OUTPUT OFFSET OPTION                        
*                                                                               
*                                                                               
KWNSEC   TEXT     'NSEC'                                                        
KWOSEC   TEXT     'OSEC'                                                        
         TITLE    '** RS1002 - DISK PACK COPY MAIN ROUTINE **'                  
DPCOPY   EQU      %                                                             
         LI,R0    DPERF             SET ERR FUNCTION TABLE ADDRESS              
         STW,R0   ERRFCN                                                        
         LI,R1    #TOZERO                                                       
         LI,R0    0                                                             
         STW,R0   DPFLAGS-1,R1                                                  
         BDR,R1   %-1                                                           
         LI,R1    -9                GENERATE F4 MASK                            
         LS,R0    READAFPT+1                                                    
         STW,R0   READAFPT+1                                                    
         LS,R0    READBFPT+1                                                    
         STW,R0   READBFPT+1                                                    
         LS,R0    WRITAFPT+1        RESET CHECK READ FLAGS                      
         STW,R0   WRITAFPT+1                                                    
         LS,R0    WRITBFPT+1                                                    
         STW,R0   WRITBFPT+1                                                    
*                                                                               
         LW,R0    BACKSZE           GET SIZE OF BUFFER AREA IN WORDS            
         CI,R0    512               SIZE NEEDED                                 
         BL       DP20              MESSAGE 19                                  
         SLS,R0   -8                DIVIDE BY 256 YEILDS # OF SECTORS           
*                                   IN TOTAL BUFFER                             
         CI,R0    1                 EVEN OR ODD                                 
         BAZ      %+2               B IF EVEN                                   
         AI,R0    -1                THROW AWAY ODD SECTOR BUFFER                
         SLS,R0   -1                DIVIDE BY TWO YEILDS # OF SECTORS           
         CI,R0    60                LIMIT TRANSFERS TO 60KB                     
         BLE      %+2               B IF WITHIN LIMITS                          
         LI,R0    60                SET TO S0 SECTORS OR 60KB                   
         STW,R0   SECTX             IN ONE TRANSFER                             
         LW,R2    R0                                                            
         SLS,R2   10                GIVES BYTE COUNT FOR TRANSFER               
         STW,R2   RABYTES                                                       
         STW,R2   RBBYTES                                                       
         STW,R2   WABYTES                                                       
         STW,R2   WBBYTES                                                       
         SLS,R0   8                 TIMES 256                                   
         AW,R0    BPEND             GIVES ADDRESS OF B BUFFER                   
         AND,R0   M17               MASK                                        
         STW,R0   RBBUF             INITIALIZE FPT'S                            
         STW,R0   WBBUF                                                         
         LW,R0    BPEND             ADDRESS OF A BUFFER                         
         AND,R0   M17                                                           
         STW,R0   RABUF                                                         
         STW,R0   WABUF                                                         
         LI,R0    0                 SET START SECTORS = 0                       
         STW,R0   RASEC                                                         
         STW,R0   WASEC                                                         
         STW,R0   RBSEC                                                         
         STW,R0   WBSEC                                                         
*        INITIALIZATION IS COMPLETE                                             
DP01     EQU      %                                                             
         BAL,R8   SCAN                                                          
         CI,R6    0                 ANY ERRORS                                  
         BL       DP03              B IF YES                                    
         LW,R0    R8                                                            
         SLS,R0   -16               RIGHT JUSTIFY                               
         LI,R1    #OPTIONS          NUMBER OF KEYWORD OPTIONS                   
DP02     CW,R0    DPOPTAB-1,R1      IS IT THIS KEYWORD                          
         BE       DP04              B IF YES                                    
         BDR,R1   DP02              B FOR NEXT KEYWORD                          
*                                                                               
DP03     B        ERROR02           ERROR ITEM XX                               
*                                                                               
DPERR    B        ERROROUT          OUT SOME ERROR MESSAGE                      
         PAGE                                                                   
         SPACE    2                                                             
DP04     EQU      %                                                             
         B        DPOPTPRO-1,R1     GO TO ROUTINE                               
*                                                                               
*                                                                               
DP05     EQU      %                                                             
         CI,R6    2                 END OF CARD                                 
         BNE      DP01              B IF NO                                     
         MTW,+1   ERRFCN            DISALLOW 'UNABLE TO ASSIGN' ERRORS          
         LW,R8    KWNSEC            SET OPTION TO REPORT IF ERRORS              
         LW,R0    INMAXS            SET MAX SECTOR TO COPY                      
         LW,R15   ENDSEC            WAS ONE SPECIFIED ?                         
         BNEZ     DP06                YES, USE ONE GIVEN EXPLICITLY             
*                                                                               
         STW,R0   ENDSEC            NO, SET MAX AS LAST                         
         B        DP07              CHECK START AS LEGAL                        
*                                                                               
DP06     RES      0         INSURE NOT COPYING OFF END OF DISC                  
         LW,R1    NEXTSEC           START SECTOR + NUMBER TO COPY               
         AWM,R1   ENDSEC            = LAST TO COPY                              
         CW,R0    ENDSEC            IS COMPUTED LAST > DISC ?                   
         BL       ERROR05             YES, ERROR IN 'NSEC'                      
*                                                                               
DP07     RES      0         CHECK IF ENOUGH ROOM ON OUTPUT DISC                 
         LW,R0    NEXTSEC           IS START SECTOR                             
         CW,R0    ENDSEC                            < END SECTOR ?              
         BG       ERROR05             NO, ERROR; REPORT IN 'NSEC'               
*                                                                               
         LW,R15   OFFSEC            WAS AN OUTPUT SECTOR GIVEN ?                
         BEZ      DP08                NO, OFFSET = 0                            
*                                                                               
         SW,R15   NEXTSEC           COMPUTE ADJUSTMENT TO READ SECTOR           
         STW,R15  OFFSEC            ADDRESS TO GET WRITE SECTOR ADDR            
*                                                                               
DP08     RES      0         CHECK NOT EXCEEDING OUTPUT DISC LIMITS              
         LW,R8    KWOSEC            SET OPTION THAT WILL HAVE ERRORS            
         LW,R0    R15               COPY OFFSET                                 
         AW,R0    NEXTSEC           IS START WRITE SECTOR < BEGIN SEC ?         
         BLZ      ERROR05             YES, REPORT ERROR IN 'OSEC'               
         CW,R15   OUTMAXS           IS LAST SECTOR > END OF DISC ?              
         BG       ERROR05             YES, REPORT ERROR FOR THIS TOO            
*                                                                               
*                                                                               
DP10     EQU      %                                                             
**       START DOUBLE BUFFER OPERATIONS                                         
         BAL,R9   READA                                                         
         B        DP13              B IF LAST READ STARTED                      
         BAL,R9   READB                                                         
         B        DP14              B IF LAST READ STARTED                      
DP11     EQU      %                                                             
**       START MAIN DOUBLE BUFFER LOOP                                          
         BAL,R9   CHKRA                                                         
         BAL,R9   WRITEA                                                        
         BAL,R9   CHKRB                                                         
         BAL,R9   WRITEB                                                        
         BAL,R9   CHKWA                                                         
         BAL,R9   READA                                                         
         B        DP12              B IF LAST READ STARTED                      
         BAL,R9   CHKWB                                                         
         BAL,R9   READB                                                         
         B        DP14              B IF LAST READ STARTED                      
         B        DP11                                                          
*                                                                               
DP12     EQU      %                                                             
**       END MAIN DOUBLE BUFFER LOOP                                            
         BAL,R9   CHKWB                                                         
DP13     EQU      %                                                             
         BAL,R9   CHKRA                                                         
         BAL,R9   WRITEA                                                        
         BAL,R9   CHKWA                                                         
         B        DP15                                                          
DP14     EQU      %                                                             
         BAL,R9   CHKRA                                                         
         BAL,R9   WRITEA                                                        
         BAL,R9   CHKWA                                                         
         BAL,R9   CHKRB                                                         
         BAL,R9   WRITEB                                                        
         BAL,R9   CHKWB                                                         
DP15     EQU      %                                                             
         CAL1,1   CLOSESI           CLOSE THE INPUT AND                         
         CAL1,1   CLOSESO           OUTPUT DCBS                                 
         B        EXEC1             END                                         
*                                                                               
DP20     EQU      %                                                             
         LI,R15   MESS19                                                        
         B        DPERR                                                         
*                                                                               
         TITLE    '** RS1002 - READ SUBROUTINE **'                              
READA    EQU      %                 READ INTO BUFFER A                          
         LI,R2    WRITAFPT                                                      
         LI,R3    READAFPT                                                      
         B        READ01                                                        
READB    EQU      %                 READ INTO BUFFER B                          
         LI,R2    WRITBFPT                                                      
         LI,R3    READBFPT                                                      
READ01   EQU      %                                                             
         AI,R9    1                 SET TO TAKE NORMAL EXIT                     
         LW,R0    NEXTSEC           NEXT SECTOR TO TRANSFER                     
         AW,R0    SECTX             NUMBER OF SECTORS TO TRANSFER               
         CW,R0    ENDSEC            ARE WE DONE                                 
         BGE      READ03            B IF THIS IS LAST TRANSFER                  
READ02   EQU      %                                                             
         LW,R1    NEXTSEC                                                       
         STW,R1   6,R3              SET KEY IN READ FPT                         
         STW,R0   NEXTSEC           UPDATE FOR NEXT READ                        
         CAL1,1   0,R3              INITIATE THE READ                           
         B        *R9               RETURN                                      
*                                                                               
READ03   EQU      %                                                             
         AI,R9    -1                TAKE LAST READ EXIT                         
         AI,R0    -1                                                            
         CW,R0    ENDSEC                                                        
         BE       READ02            BONT CHANGE BYTE COUNT                      
         LW,R0    ENDSEC                                                        
         SW,R0    NEXTSEC                                                       
         AI,R0    1                 YEILDS NUMBER OF SECTORS TO READ            
         MH,R0    SECTSIZE          GET BYTE COUNT                              
         STW,R1    5,R3                 SET IN READ FPT                         
         STW,R1    5,R2                 SET IN WRITE FPT                        
         AW,R0    NEXTSEC                                                       
         B        READ02                                                        
*                                                                               
         TITLE    '** RS1002 - WRITE SUBROUTINE **'                             
WRITEA   EQU      %                 WRITE FROM A BUFFER                         
         LI,R2    READAFPT                                                      
         LI,R3    WRITAFPT                                                      
         B        WRIT00                                                        
WRITEB   EQU      %                 WRITE FROM B BUFFER                         
         LI,R2    READBFPT                                                      
         LI,R3    WRITBFPT                                                      
WRIT00   EQU      %                                                             
         LW,R0    6,R2              GET START SECTOR FROM LAST READ             
         AW,R0    OFFSEC            OFFSET FOR WRITE, AND                       
         STW,R0   6,R3              SET IN SRITE FPT                            
         CAL1,1   0,R3              INITIATE WRITE                              
         B        *R9                                                           
*                                                                               
         TITLE    '** RS1002 - CHECKING ROUTINES **'                            
CHKRA    EQU      %                 RHECK READ FROM BUFFER A                    
         LI,R2    READAFPT                                                      
         B        CHECK00                                                       
CHKRB    EQU      %                 CHECK READ FROM BUFFER B                    
         LI,R2    READBFPT                                                      
         B        CHECK00                                                       
CHKWA    EQU      %                 CHECK WRITE FROM BUFFER A                   
         LI,R2    WRITAFPT                                                      
         B        CHECK00                                                       
CHKWB    EQU      %                 CHECK WRITER FROM BUFFER B                  
         LI,R2    WRITBFPT                                                      
CHECK00  EQU      %                                                             
         LW,R3    M17               MASK                                        
         STS,R2   CHKFPT            SET FPT ADDRESS IN CHECK FPT                
CHKBUSY  EQU      %                                                             
         CAL1,1   CHKFPT            CHECK THE OPERATION                         
         B        *R9               DONE                                        
         TITLE    '** RS1002 - OPTION PROCESSING ROUTINES **'                   
         SPACE    2                                                             
DPOPT    RES      0         PROCESS 'DP' AND 'DC' OPTIONS: INPUT, OUTPUT        
         CI,R6    0                 IS IT END OF SUBFIELD                       
         BNE      DP03              B IF NO - ERROR                             
         CI,R10   5                 FIVE CHARACTERS SCANNED                     
         BNE      DP03              B IF NO - ERROR                             
         LCI      2                                                             
         STM,R8   DEVASGN           SET NAME FOR ASSIGNMENT TO F:SI             
         LI,R2    F:SI              POINT AT INPUT DCB                          
         CAL1,1   ASNDEV            ASSIGN THE DEVICE TO THE DCB                
         CAL1,1   GETAINFO          GET ITS DEVICE CONSTANTS                    
         CAL1,1   CLOSEANY          AND RECLOSE IT                              
         LW,R0    MASDWPS           COPY SECTOR SIZE                            
         STW,R0   SECTSIZE                                                      
         LW,R0    MASDEOA           ALSO COPY LAST SECTOR ADDRESS               
         STW,R0   INMAXS            FOR LIMIT CHECKING                          
         BAL,R8   SCAN              GET OUT DEVICE                              
         CI,R6    0                 END OF FIELD OR END OF CARD                 
         BLE      DP03              B IF NO - ERROR                             
         CI,R10   5                 FIVE CHAR SCANNED                           
         BNE      DP03              B IF NO                                     
         LCI      2                                                             
         STM,R8   DEVASGN           SET DEVICE NAME                             
         LI,R2    F:SO              SET NAME OF OUTPUT DCB                      
         CAL1,1   ASNDEV            ASSIGN THE DEVICE TO IT                     
         CAL1,1   GETAINFO          GET DEVICE CONSTANTS                        
         CAL1,1   CLOSEANY          AND LEAVE IT CLOSED                         
         LW,R0    MASDWPS           DO INPUT AND OUTPUT DEVICES                 
         CW,R0    SECTSIZE          HAVE THE SAME SECTOR SIZE ?                 
         BNE      ERROR02             NO, THEY MUST: GIVE ERROR                 
*                                                                               
         SLS,R0   2                 CONVERT TO A BYTE COUNT                     
         STH,R0   SECTSIZE          AND SAVE                                    
         LW,R0    MASDEOA           COPY END SECTOR ADDRESS FOR                 
         STW,R0   OUTMAXS           LIMIT CHECKS LATER                          
         B        DP05                                                          
*                                                                               
CKOPT    RES      0         PROCESS CHECK-READ AND CHECK-WRITE OPTIONS          
         CI,R6    0                 IS IT END OF EIELD OR END OF CARD           
         BLE      DP03              NO - ERROR                                  
         LI,R1    F4                CHECK BIT                                   
         CW,R8    ='CKRD'           IS IT CHECK READ                            
         BNE      CKOPT1            B IF NO                                     
         STS,R1   READAFPT+1                                                    
         STS,R1   READBFPT+1                                                    
         B        DP05              BO BACK FOR NEXT OPTION                     
CKOPT1   EQU      %                                                             
         CW,R8    ='CKWT'           CHECK WRITE                                 
         BNE      ERROR05             NO, GIVER ERROR IN OPTION 'CKXX'          
         STS,R1   WRITAFPT+1                                                    
         STS,R1   WRITBFPT+1                                                    
         B        DP05                                                          
*                                                                               
SSOPT    RES      0         PROCESS START SECTOR OPTION                         
         CI,R6    0                 IS IT END OF SUBFIELD                       
         BNE      DP03              NO - ERROR                                  
         BAL,R2   SSOPT1            GET OPTION                                  
         STW,R8   NEXTSEC                                                       
         B        DP05                                                          
*                                                                               
SSOPT1   RES      0         SCAN A SECTOR NUMBER                                
         LI,R1    4                 SET FOR DECIMAL CONVERSION                  
         STW,R1   SPARAMF1                                                      
         BAL,R8   SCAN              SET PARAMERER                               
         LI,R1    1                 SET FOR EBCDIC                              
         STW,R1   SPARAMF1          RESET SCAN CONVERSION                       
         CI,R6    0                                                             
         BLE      DP03              B IF ERROR                                  
         B        *R2               RETURN                                      
*                                                                               
NSOPT    RES      0         PROCESS NUMBER OF SECTORS OPTION                    
         CI,R6    0                 IS IT END OF SUBFIELD                       
         BNE      DP03              BIF NO - ERROR                              
         BAL,R2   SSOPT1            GET PARAMETER                               
         MTW,0    R8                                                            
         BEZ      DP03              B IF ZERO SECTORS                           
         AI,R8    -1                REDUCE BY 1 FOR ENDSEC                      
         STW,R8   ENDSEC                                                        
         B        DP05              RETURN FOR NEXT CHAR                        
*                                                                               
OSOPT    RES      0         PROCESS WRITE OFFSET OPTION                         
         CI,R6    0                 DOES A SUBFIELD FOLLOW ?                    
         BNE      ERROR02             NO, NO SECTOR NUMBER: ERROR               
*                                                                               
         BAL,R2   SSOPT1            GET START WRITE SECTOR NUMBER               
         STW,R8   OFFSEC            AND SAVE                                    
         B        DP05              GET NEXT OPTION IF ANY                      
*                                                                               
*                                                                               
*                                                                               
*                                                                               
DPERF    RES      0         ERROR FUNCTION TABLE FOR DPCOPY                     
         ERRP     X'01',ERROR02     UNABLE TO OPEN DCB; ERROR IN NAME           
         ERRP     X'03',ERROR02     UNABLE TO ASSIGN DCB; ERROR IN NAME         
         ERRP     X'30',ABNABORT    ABORT, OPERATOR INTERVENTION                
         ERRP     X'FF',0           CONTINUE WITH ROOT'S FOR ALL ELSE           
         TITLE    '** RS1002 - RADEDIT SEGMENT 2 **'                            
         SPACE    2                                                             
SEG2END  EQU      ((%-RADSEG2)+511)/512 # PAGES REQUIRED FOR SEGMENT            
         END                                                                    
