         PCC      0                                                             
         TITLE    '** RS1003 - R A D E D I T   S E G M E N T   3 **'            
         SPACE    3                                                             
         SYSTEM   SIG7FDP                                                       
         SYSTEM   OPTIONS                                                       
         SYSTEM   CPR                                                           
*                                                                               
*                                                                               
*  DEFINITIONS                                                                  
         DEF      RADSEG3,SEG3END   BEGIN, END OF THIS SEGMENT                  
*                                                                               
*  COMMAND PROCESSORS IN THIS SEGMENT                                           
         DEF      COPY                                                          
         DEF      SQUEEZE                                                       
         DEF      SKWEZ                                                         
         DEF      CLEAR                                                         
*                                                                               
*                                                                               
*                                                                               
*                 DEBUG SWITCH FOR TRACING STATUS OF SQUEEZE:                   
*                 WHEN SWITCH = 0, NO CODE AND NO SPACE IS USED;                
*                 WHEN SWITCH = 1, EXTRA CODE IS GENERATED TO TAKE              
*                                   SNAPSHOTS OF WHERE WE ARE AND TO            
*                                   DISPLAY THE LINKED DIRE CHAIN               
*                                   IN MEMORY.                                  
*                                                                               
DBGSKWEZ SET      0                 TURN DEBUG TRACE ==>  OFF <==               
         TITLE    '** RS1003 - R A D E D I T   S E G M E N T   3 **'            
         LIST     0                                                             
*                                                                               
*  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      MODULE,EBCDIC,DEFREF,MODIR                                    
         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      DELTRUNC                                                      
         REF      CON2H00                                                       
         REF      SQUZDATE                                                      
         REF      MODULLEN,EBDICLEN,DREFLEN,MODIRLEN                            
         REF      MODULSZE,EBDICSZE,DREFSZE,MODIRSZE                            
         REF      MODULMAX,EBDICMAX,DREFMAX,MODIRMAX                            
*                                                                               
* 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,ABNABORT                      
         REF      ABNCONT,ABNRETRY,WPERR,OPENERR,FATALMSG,DEVINOP               
         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 NEEDED ONLY BY COPY AND SQUEEZE                                   
*                                                                               
         REF      COPYFLGS,COPYFLAG,VFCFLAG,BINFLAG                             
         REF      BBCDFLAG,FBCDFLAG,ASCIFL,ASCOFL                               
         REF      D8HFLAG,D16HFLAG,ADDFLAG,UPDFLAG,CCFLAG                       
         REF      BLKIFLAG,BLKOFLAG,ORGIFLAG,ORGOFLAG                           
         REF      NFIL,INFLAG,OUTFLAG,CREAD,EODFLAG                             
         REF      PNCHFLAG,SIDEVICE,SODEVICE,FLAGTOTL                           
         REF      CDEVICE                                                       
         REF      SQUEZ95,MFENTRY                                               
*                                                                               
*                                                                               
*  SCNMOD VARIABLES                                                             
         REF      CRNTEBD,EBDBYTES,MODBYTES,DRFHWDS                             
         REF      SKIPCKS,NMENOS,EBDBA                                          
         REF      LINKSAVE,TEMP1,TEMPSAVE,TEMP1A                                
         REF      NDEFS,LBAEBC,FBAEBC,DUPDEF,SEQNO                              
         PAGE                                                                   
         SPACE    2                                                             
         LIST     0        DO NOT LIST % ROUTINE PROCS                          
***********************************************************************         
*                                                                               
*                                                                               
*                 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                                                             
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                                                             
PRTPAG   CNAME                                                                  
         PROC                                                                   
LF       BAL,R14  %14               PAGE THE PRINTER, PRINT PL                  
         PEND                                                                   
         SPACE    3                                                             
         CLOSE    ARG,ARGA                                                      
         LIST     1                                                             
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                                                                   
*                                                                               
*                                                                               
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                                                                  
         PROC                                                                   
         DO       NUM(AF)>0                                                     
LF        GEN,8,24 AF(1),AF(2)      ERROR CODE, ERROR PROCESSOR                 
         ELSE                                                                   
LF        GEN,32   0                END OF LIST; ABORT                          
         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                                                                   
         PAGE                          PROCEDURES FOR DEBUG TRACEING            
         SPACE    2                    -----------------------------            
*                           TRACE STATUS AND FLOW OF SQUEEZE                    
SNPSQCHN CNAME    1                 OUT DIRE CHAIN                              
SNPSQMRK CNAME    2                 SHOW WHERE WE ARE                           
SNPSQREG CNAME    3                 OUT REGISTERS                               
SNPSQPTR CNAME    4                 OUT POINTERS, ETC                           
SNPSQENT CNAME    5                 OUT CURRENT ENTRY (AT R5)                   
SNPSQCNT CNAME    6                 COUNT PASSES FOR DELAYED TRACE              
         PROC                                                                   
         DO       DBGSKWEZ                                                      
Q         SET     S:UFV(OUTCHAIN,OUTMARK,OUTREGS,OUTPTRS,OUTENTRY,;             
                                    OUTCOUNT)                                   
          BAL,RLNK  Q(NAME)         CALL DESIRED ROUTINE                        
         FIN      DBGSKWEZ                                                      
         PEND                                                                   
         CLOSE    Q,I                                                           
*                                                                               
         DO1      DBGSKWEZ          IF GENERATING THE CODE...                   
          REF      DEBUGSW          REF THE DYNAMIC TRACE SWITCH                
*                                                                               
*                                                                               
*        DEBUG TRACE/SNAPSHOT ROUTINES FOR SQUEEZE SWITCH SETTINGS:             
*        IF SWITCH 'DBGSKWEZ' IS SET TO 0 (SEE PAGE 1 OF LISTING),              
*        ALL TRACE/SNAP CODE IS ASSEMBLED OUT AND IS NOT EVEN LISTED            
*        IF SWITCH IS SET TO 1, THE CODE AND CALLS TO THE ROUTINES ARE          
*        ASSEMBLED.  OUTPUT IS THEN CONTROLLED BY THE CELL 'DEBUGSW'            
*        IN THE CONTEXT SEGMENT.  SEE THE ROUTINES FOR THE USE AND              
*        SETTINGS OF THIS SWITCH.                                               
         PAGE                                                                   
         SPACE    2                                                             
RADSEG3  RES      0                                                             
R0       EQU      0                                                             
R1       EQU      1                                                             
R2       EQU      2                                                             
R3       EQU      3                                                             
R4       EQU      4                                                             
R5       EQU      5                                                             
R6       EQU      6                                                             
R7       EQU      7                                                             
R8       EQU      8                                                             
R9       EQU      9                                                             
R10      EQU      10                                                            
R11      EQU      11                                                            
R12      EQU      12                                                            
R13      EQU      13                                                            
R14      EQU      14                                                            
R15      EQU      15                                                            
*                                                                               
LINK     EQU      R8                NORMAL LINK REGISTER (OLD)                  
RLNK     EQU      R14               NEW STANDARD LINK REGISTER                  
XLNK     EQU      R15               ALTERNATE LINK REGISTER                     
         PAGE                                                                   
         SPACE    2                                                             
K:NUMDA  EQU      X'14B'            HIGHEST VALID INDEX VALUE (EVEN NO.)        
K:DCT1   EQU      X'176'            NUMBER OF DEVICE ENTRIES                    
K:DCT16  EQU      X'177'            DEVICE TYPE INDEX ADDRESS                   
K:OPLBS1 EQU      X'178'            OP LABEL TABLE ADDRESS                      
K:OPLBS3 EQU      X'179'            DCT INDEX OF OP LABEL                       
K:DCT4   EQU      X'18F'            POINTER TO DCT4 TABLE                       
K:RFT12  EQU      X'203'            CURRENT REC NO. OF FILE                     
         PAGE                                                                   
*                                                                               
*                                                                               
*                 KEYWORDS THAT MAY APPEAR ON A COMMAND CARD                    
*                                                                               
*                                                                               
KWNFIL   TEXT     'NFIL'                                                        
KWIN     TEXT     'IN  '                                                        
KWOUT    TEXT     'OUT '                                                        
*                                                                               
KEYWORDS EQU      %-1       ORDERED TABLE OF COPY OPTIONS; CF COPYFLGS          
*                                                                               
KWVFC    TEXT     'VFC '                                                        
KWBIN    TEXT     'BIN '                                                        
KWFBCD   TEXT     'FBCD'                                                        
KWASCI   TEXT     'ASCI'                                                        
KWASCO   TEXT     'ASCO'                                                        
KWD800   TEXT     'D800'            D800 NORMAL DENSITY FOR TAPES               
KWD1600  TEXT     'D160'            D1600 DOUBLE DENSITY FOR TAPES              
KWADD    TEXT     'ADD '                                                        
KWUPD    TEXT     'UPD '                                                        
KWCC     TEXT     'CC  '                                                        
*                                                                               
#KEYWWP  EQU      %-KEYWORDS-1      NUMBER OF KEYWORDS WITHOUT PARAMS           
*                                                                               
KWBLKI   TEXT     'BLKI'            BLOCKED INPUT                               
KWBLKO   TEXT     'BLKO'            BLOCKED OUTPUT                              
*                                                                               
#KEYWOP  EQU      %-KEYWORDS-1      NUM. KEYWORDS WITH OPTIONAL PARAMS          
*                                                                               
KWORGI   TEXT     'ORGI'            SET ORG OF INPUT TAPE/FILE                  
KWORGO   TEXT     'ORGO'            SET ORG OF OUTPUT TAPE/FILE                 
*                                                                               
#KEYWRDS EQU      %-KEYWORDS-1      NUMBER OF WORDS TO TEST                     
         PAGE                                                                   
         SPACE    2                                                             
MAXRSIZE EQU      X'4000'           MAX RECORD SIZE IN WORDS                    
DEVMASK  EQU      X'8000'           DCB DEVF BIT                                
TYPEMASK DATA     X'00003F00'                                                   
M13      DATA     X'1FFF'                                                       
MASKDCB  DATA     X'FF00010F'       RESET ALL BUT TTL, VFC, ASN                 
*                                                                               
*                                                                               
*                                                                               
*   TABLE OF UNIT RECORD DEVICES                                                
*                                                                               
UNIDEV   RES      0                                                             
         DATA,2   #UNIDEV      TABLE ITEM ZERO HAS NUMBER OF ITEMS              
         DATA,2   'TY'                                                          
         DATA,2   'CR'                                                          
         DATA,2   'LP'                                                          
         DATA,2   'CP'                                                          
         DATA,2   'LN'                                                          
#UNIDEV  EQU      HA(%)-HA(UNIDEV)-1       DEFINE LENGTH OF TABLE               
         BOUND    4                                                             
*                                                                               
*                                                                               
KWORGS   EQU      %-1       LEGAL FILE (TAPE) ORGS                              
         TEXT     'U   '            UNBLOCKED                                   
         TEXT     'B   '            BLOCKED                                     
         TEXT     'C   '            COMPRESSED                                  
#ORGS    EQU      %-KWORGS-1        NUMBER OF ORG CODES                         
         PAGE                                                                   
         SPACE    2                                                             
MESS17   TXTC     'WARNING: RECORD SIZES DIFFER ON INPUT AND ',;                
                  'OUTPUT FILES'                                                
MESS29   TXTC     'REFERENCES TO F4:COM NOT ALLOWED'                            
MESS33   TXTC     'ILLEGAL USE OF COPY'                                         
MESS36   TXTC     'DUPLICATE DEF '                                              
MESS37   TXTC     'ILLEGAL LOAD ITEM '                                          
MESS38   TXTC     'ROM DOES NOT CONTAIN A DEF'                                  
MESS39   TXTC     ' CONVERTING TO H00 FORMAT - EXTENTS UNCOMBINED'              
*                                                                               
MESINROM TXTC     ' IN ROM '                                                    
COPYMSG1 TXTC     ' KEYIN STDLB C,0'                                            
COPYMSG2 TXTC     '!!COPY ENDED, REASSIGN C'                                    
COPYLIBN TXT      '-LIB'                                                        
:EOD     TXT      ':EOD'            EOD MARK FOR CONTROL CARD COPIES            
*                                                                               
*                                                                               
GETFLIMS RES      0         GET PARAMS FOR FILE ASSIGNED TO F:BI                
         GEN,1,7,1,23  1,X'09',1,R2   GET ASSIGN FOR DCB IN R2 (F:BI)           
         DATA          X'86200010'    P1+P6+P7+P11+F3                           
         DATA          ABNERR     P1  ERROR ROUTINE                             
         PZE           *R14       P6  BOT                                       
         PZE           *R15       P7  EOT                                       
         PZE           *R0        P11 RSIZE                                     
         PAGE                                                                   
*                                                                               
BINFORM  DATA,1   11,X'FF',X'9F',X'BF',X'DF',X'78',X'3C',X'1C'                  
         DATA,1   X'38',X'18',X'3B',X'1B'                                       
         BOUND    8                                                             
BINEOD   DATA     X'48281040'       BANG EOD IN COLUMN BINARY                   
         DATA     X'88200000'                                                   
*                                                                               
RESETDCB DATA     X'FFFF7F00'       MASK TO RESET DEVF, DEV/OPLB IN DCB         
LIBREFF  DATA     X'00008000'       'REF' ENTRY FLAG IN LIBRARY                 
LIBDEFF  DATA     X'00004000'       'DEF' ENTRY FLAG IN LIBRARY                 
*                                                                               
*                           F- AND P-BITS FOR COPY'S MODE CALS                  
F1B      DATA     X'00000040'       F1 BIT IN A FPT                             
F3B      DATA     X'00000010'       F3 BIT                                      
F1BF3B   DATA     X'00000050'       F1 AND F3 BITS                              
F4B      DATA     X'00000008'       F4 BIT                                      
NF1B     DATA     X'FFFFFFBF'       RESET F1 BIT                                
*                                                                               
P1B      DATA     X'00000080'       P1 BIT IN RIGHT-MOST BYTE                   
P2B      DATA     X'00000040'       P2 BIT                                      
P3B      DATA     X'00000020'       P3 BIT                                      
         PAGE                                                                   
******** ROUTINE COPY ********                                                  
*                                                                               
*        INPUT    DIRECTIVE PARAMETERS                                          
*                                                                               
*        OUTPUT   AN OBJECT MODULE OR FILE TO THE SPECIFIED DEVICE              
*                                                                               
*        FUNCTION COPIES SINGLE FILES OF DATA FROM ONE DEVICE TO ANOTHER        
*                 ADDS DATA TO AN ALREADY EXISTING FILE OR LIBRARY              
*                                                                               
*        CALL     B  COPY                                                       
*                                                                               
*        SUBROUTINES USED  FINDFILE                                             
*                                                                               
COPY     RES      0                                                             
         LI,R0    COPYERF           SET ERR FUNCTION TABLE ADDRESS FOR          
         STW,R0   ERRFCN            COPY                                        
         LI,R1    0                 INITIALIZE FLAGS                            
         LW,R2    FLAGTOTL                                                      
         STW,R1   EODFLAG                                                       
         STW,R1   COPYFLGS-1,R2                                                 
         BDR,R2   %-1                                                           
         LI,R1    1                                                             
         STW,R1   NFIL              # OF FILES TO COPY =1                       
*                                                                               
*                                                                               
         LW,R1    BACKSZE           GET SIZE OF BUFFER AREA                     
         CI,R1    256               ENOUGH ROOM AVAILABLE ?                     
         BL       ERROR19             NO, GIVE NOT ENOUGH SPACE ERROR           
*                                                                               
         LW,R2    BPEND                                                         
         STW,R2   SIBUFF                                                        
         STW,R2   SOBUFF                                                        
         LI,R2    -1                NO C DEVICE TO WORRY ABOUT                  
         BIFFGD   COPY2             B IF FGD                                    
         LI,R2    1                                                             
         LB,R2    *K:OPLBS3,R2      GET DCT/RFT INDEX FOR C DEVICE              
COPY2    RES      0                                                             
         STW,R2   CDEVICE             FROM OPLBS3 TABLE.                        
         BAL,LINK SCAN                                                          
         CI,R6    2                 WAS ERROR OR END OF STMT FOUND ?            
         BANZ     ERROR02             YES, REPORT IT                            
*                                                                               
         CW,R8    KWIN              IS INPUT TO BE 'IN' ?                       
         BE       COPY10              YES, PROCESS DEVICE OR OPLB               
*                                                                               
         CW,R8    KWLIB                                                         
         BE       COPY55            PROCESS INPUT FIELD 'LIB'                   
         LW,R9    ML24                                                          
         CS,R8    KWFILE                                                        
         BNE      COPY150A          ILLEGAL USE OF COPY                         
         PAGE                                                                   
**********************************************                                  
*                                            *                                  
*  PROCESS INPUT FIELD   (FILE,AA,NNNNNNNN)  *                                  
*                                            *                                  
**********************************************                                  
*                                                                               
*  LEGAL OUTPUT FIELDS ARE:         (FILE,FID)                                  
*                                   (LIB,AA)                                    
*                                   (OUT,OP)                                    
*                                   (OUT,YYNDD)                                 
*                                                                               
         BAL,LINK COPY85            INITIALIZE INPUT DCB AND FPT                
*                                   PROCESS OUTPUT FIELD                        
         MTW,1    COPYFLAG          SET FLAG FOR 'OUT'                          
         BAL,LINK SCAN                                                          
         CI,R6    -1                ERRORS FOUND ?                              
         BLE      ERROR02             YES, GIVE 'ERROR ITEM XX'                 
         LW,R9    ML24                                                          
         CS,R8    KWFILE                                                        
         BNE      COPY5             TEST FOR 'OUT', 'LIB'                       
*                                                                               
**********************************************************                      
*                                                                               
*        OUTPUT FIELD IS (FILE,FID)                                             
*                                                                               
         BAL,LINK COPY85            INITIALIZE OUTPUT DCB AND FPT               
*                                                                               
         BAL,LINK COPYOPTS          PROCESS ANY OPTIONS GIVEN                   
         MTW,0    BINFLAG           WAS 'BIN' GIVEN ?                           
         BNEZ     CPYXBIN             YES, GIVE ERROR                           
*                                                                               
         MTW,0    CCFLAG            WAS 'CC' GIVEN ?                            
         BNEZ     CPYXCC              YES, ERROR                                
*                                                                               
         LW,R15   NFIL              GET NUMBER OF FILES TO COPY                 
         CI,R15   1                 IS IT OTHER THAN 1 ? (IF GIVEN?)            
         BNE      CPYXNFIL            NOT 1, SO ERROR                           
*                                                                               
         MTW,+0   VFCFLAG           IS 'VFC' REQUESTED ?                        
         BNEZ     CPYXVFC             YES, ERROR FOR FILE OUTPUT                
*                                                                               
         B        COPY15            GO PROCESS OTHER OPTIONS                    
         PAGE                                                                   
         SPACE    2                                                             
*        INPUT FIELD IS  (IN,OP)                                                
*                    OR  (IN,YYNDD)                                             
*                                   FROM  'COPY10'                              
*                                                                               
*                    OR  (FILE,FID)                                             
*                                   FROM  'COPY'                                
*                                                                               
*                                                                               
*                                                                               
COPY5    RES      0         TEST FOR LEGAL INPUT SPECIFICATION                  
         CW,R8    KWLIB             IS OUTPUT FIELD (LIB,AA)                    
         BE       COPY30              YES, PROCESS OUTPUT TO A LIB              
*                                                                               
         CW,R8    KWOUT             IS IT (OUT,OP OR YNDD)                      
         BNE      COPY150A          NO, ILLEGAL USE OF COPY                     
*                                                                               
*  OUTPUT FIELD IS (OUT,OP OR YYNDD)                                            
*                                                                               
*   INPUT MAY BE DEVICE, OPLB OR FILE                                           
         CAL1,1   VFCSO0              RESET VERTICAL FORMAT CONTROL             
         MTW,1    OUTFLAG                                                       
         BAL,LINK COPY100                                                       
         BAL,LINK COPYOPTS          GET ANY OPTIONS                             
         LW,R1    SIBCNT                                                        
         MTW,0    INFLAG            IS 'IN' FLAG SET                            
         BEZ      COPY8A              NO, FROM A FILE; RECL = RSIZE             
*                                                                               
*   CHECK IF INPUT DEVICE IS A UNIT RECORD DEVICE                               
         LI,R1    1                                                             
         LH,R2    SIDEVICE,R1       R2= INPUT DEVICE                            
         LH,R1    UNIDEV            R1= # OF TABLE ENTRIES                      
         CH,R2    UNIDEV,R1         IS INPUT FROM UNIT REC DEVICE               
         BE       COPY7               YES, SET DEFAULT IN, OUT RECL             
         BDR,R1   %-2                                                           
*   CHECK IF OUTPUT IS TO A UNIT RECORD DEVICE                                  
         LI,R1    1                                                             
         LH,R2    SODEVICE,R1       R2= OUTPUT DEVICE                           
         LH,R1    UNIDEV            R1= # OF TABLE ENTRIES                      
         CH,R2    UNIDEV,R1         IS OUTPUT TO UNIT REC DEVICE                
         BE       COPY7               YES, SET DEFAULT RECL'S                   
*                                                                               
         BDR,R1   %-2                                                           
         LW,R1    BACKSZE           SET BYTE COUNT = SIZE OF BKGD               
         CI,R1    MAXRSIZE           CORE IF LESS OR EQUAL TO 16K WORDS         
         BLE      %+2                                                           
         LI,R1    MAXRSIZE          LOAD WITH MAXIMUM                           
         SLS,R1   2                 CONVERT TO BYTES                            
         B        COPY8             AND SET AS IN, OUT RECL                     
*                                                                               
COPY7    RES      0         UNIT RECORD DEVICE IS INPUT OR OUTPUT               
         LI,R1    133               SET READ LENGTH = PRINTER LENGTH            
*                                                                               
COPY8    RES      0         SET OUTPUT LENGTH = INPUT LENGTH                    
         STW,R1   SIBCNT            SET MAX BYTES TO READ                       
COPY8A   STW,R1   SOBCNT            SET INITIAL BYTES TO WRITE                  
*                                                                               
         MTW,0    VFCFLAG           WAS VFC REQUESTED ?                         
         BEZ      COPY15              NO, DO NOT SET VFC; TEST MODES            
*                                                                               
         CAL1,1   VFCSO1              YES, TURN IT ON                           
         B        COPY15            GO PROCESS REC SIZES, START COPY            
         PAGE                                                                   
*************************************************                               
*                                               *                               
*  PROCESS INPUT FIELD   (IN,OP) OR (IN,YYNDD)  *                               
*                                               *                               
*************************************************                               
*                                                                               
*  LEGAL OUTPUT FIELDS ARE:         (FILE,FID)                                  
*                                   (LIB,AA)                                    
*                                   (OUT,OP)                                    
*                                   (OUT,YYNDD)                                 
*                                                                               
COPY10   RES      0         PROCESS OUTPUT SPEC FOR DEVICE INPUT                
         MTW,1    INFLAG            SET 'IN' FLAG                               
         BAL,LINK COPY100                                                       
         CI,R6    1                                                             
         BNE      COPY150                                                       
         MTW,1    COPYFLAG                                                      
*                                                                               
         BAL,LINK SCAN              PROCESS OUTPUT FIELD                        
         CI,R6    -1                ANY ERRORS FOUND ?                          
         BLE      ERROR02             YES, GIVE 'ERROR ITEM XX'                 
         LW,R9    ML24                                                          
         CS,R8    KWFILE                                                        
         BNE      COPY5             CHECK FOR 'LIB' OR 'OUT' KEYWORD            
*                                                                               
*  OUTPUT FIELD IS (FILE,AA,NNNNNNNN)                                           
*                                                                               
         BAL,LINK COPY85            INITIALIZE OUTPUT DCB AND FPT               
         BAL,LINK COPYOPTS          GET ANY OPTIONS SPECIFIED                   
         LW,R1    SOBCNT            SET RECORD SIZE IN INPUT FPT=OUTPUT         
         STW,R1   SIBCNT                                    RECORD SIZE         
         MTW,+0   VFCFLAG           WAS 'VFC' REQUESTED ?                       
         BNEZ     CPYXVFC             YES, ERROR FOR FILE OUTPUT                
         PAGE               COMMON OPTIONS PROCESSING FOR ALL COPIES            
         SPACE    2         ----------------------------------------            
COPY15   RES      0         PROCESS INPUT SPECIFICATION OPTIONS                 
         LW,R15   SIBCNT            WILL MAX INPUT RECORD FIT INTO              
         CW,R15   BCKSZE            THE COPY BUFFER ?                           
         BG       ERROR19             NO, ERROR: 'NOT ENUF BCKG SPACE'          
*                                                                               
         LI,R2    F:SI              SET DCB TO MODIFY                           
         BAL,RLNK COPYMODE          SET MODE BITS, RSIZE, ETC IN DCB            
*                                                                               
         LI,R2    F:SO              DO THE SAME FOR THE OUTPUT                  
         BAL,RLNK COPYMODE          SPECIFICATIONS AND DCB                      
*                                                                               
         BAL,RLNK CPYPOSIT          POSITION OUTPUT FILE/TAPE                   
         MTW,+00  INFLAG            IF THIS IS A 'FILE' TO 'FILE' COPY          
         BNEZ     COPY18            WITH NO BLOCKED FILES INDICATED,            
         MTW,+00  OUTFLAG           CHECK IF THE RECORD SIZES ARE THE           
         BNEZ     COPY18            SAME, AND GIVE A WARNING IF NOT.            
         MTW,+00  BLKOFLAG          FOR OTHER CASES, LET THEM DIFFER            
         BNEZ     COPY18            AND IGNORE LOST DATA ERRORS; SPACE          
         MTW,+00  BLKIFLAG          FILL SHORT INPUT RECORDS.                   
         BNEZ     COPY18                                                        
*                                                                               
         LW,R1    SOBCNT            RSIZE MUST BE EQUAL                         
         CW,R1    SIBCNT            ARE THEY ?                                  
         BE       COPY18              YES, ALL IS OK                            
*                                                                               
         XW,R1    SIBCNT            SET SIZE TO READ                            
         CW,R1    SIBCNT            IS INPUT SMALLER THAN OUTPUT RECORD?        
         BGE      COPY16              NO, NO NEED TO SPACE FILL                 
*                                                                               
         LW,R1    SOBCNT            YES, SET TO BLANK FILL BUFFER               
         AI,R1    7                 UP TO SIZE OF OUTPUT RECORD SO AS           
         SLS,R1   -2                BLANK FILL SHORT INPUT RECORDS              
         STW,R1   BLKOFLAG                                                      
*                                                                               
*                                                                               
COPY16   RES      0         OUT WARNING OF DIFFERENT RECORD SIZES               
         LI,R15   MESS17                                                        
         BAL,LINK TYPRNT            TELL USER THINGS HAVE CHANGED               
*                                                                               
COPY18   RES      0         PROCESS SPECIAL 'CC', 'BIN', & C DEVICE READ        
         MTW,0    BINFLAG           'BIN'  REQUESTED ?                          
         BEZ      COPY19              NO, TEST FOR 'CC', 'BIN'                  
*                                                                               
         MTW,0    FBCDFLAG          YES, 'FBCD' ALSO REQUESTED ?                
         BNEZ     CPYXBIN             YES, ERROR IF BOTH SET                    
*                                                                               
COPY19   RES      0         TEST 'CC' INPUT AND RELATED OPTIONS                 
         MTW,0    CCFLAG            'CC' REQUESTING BANG CARD INPUT ?           
         BNEZ     COPY20                YES, VERIFY ITS LEGALITY                
*                                                                               
         MTW,0    BINFLAG           IS THE INPUT TO BE BINARY ('BIN') ?         
         BEZ      COPY24              NO, START THE COPY                        
*                                                                               
         MTW,0    CREAD             IS INPUT FROM THE  C  DEVICE ?              
         BEZ      COPY24              NO, DO THE COPY NORMALLY                  
         B        COPY21             YES, TAKE CARE OF 'C' REASSIGNMENT         
*                                                                               
COPY20   RES      0         INPUT OF 'BANG' CARDS; VERIFY NOT 'BIN'             
         MTW,0    BINFLAG           WAS 'BIN' REQUESTED ?                       
         BNEZ     CPYXBIN             YES, CAN'T DO THAT; ERROR                 
         PAGE                       COPY OF 'BANG' CARDS FROM 'C' DEVICE        
         SPACE    2                 ------------------------------------        
COPY21   RES      0         INPUT FROM 'C' DEVICE; DO REASSIGNMENTS             
         LI,R2    120               READ 120 BYTES IN CC OR BIN MODES           
         STW,R2   SIBCNT                                                        
*                                                                               
         LI,R15   COPYMSG1          YES                                         
         STW,R15  TYPE1                                                         
         LB,R8    *R15              GET BYTE COUNT                              
         STW,R8   TYPE2             STORE IN WRITE FPT                          
         CAL1,1   TYPE              OUTPUT MESSAGE TO OC                        
         CAL1,1   CLOSEOC           CLOSE M:OC                                  
         CAL1,9   9                 COMMANDS (ASSIGN C DEVICE TO 0)             
         BAL,R14  COPY70            COPY TO AN :EOD OR !EOD AND RETURN          
         LI,R15   COPYMSG2          PRINT MSGE. 'REASSIGN C'                    
         STW,R15  TYPE1                                                         
         LB,R8    *R15              GET MESSAGE SIZE IN BYTES                   
         STW,R8   TYPE2             STORE IN FPT                                
         CAL1,1   TYPE              OUTPUT MESSAGE TO OC                        
         CAL1,1   CLOSEOC           CLOSE F:OC                                  
         MTW,0    OUTFLAG           WAS 'OUT' SPECIFIED                         
         BEZ      %+2               NO, BRANCH                                  
         CAL1,1   WEOFSO            YES, WRITE EOF TO OUTPUT DEVICE             
         CAL1,1   CLOSESI           CLOSE F:SI DCB                              
         CAL1,1   CLOSESO           CLOSE F:SO DCB                              
         CAL1,9   9                                                             
         B        EXEC1             RETURN TO EXEC                              
         PAGE                       NORMAL COPY CALL AND END PROCESSING         
         SPACE    2                 -----------------------------------         
*                                                                               
COPY24   EQU      %     COPY: EITHER A REGULAR, NORMAL COPY,                    
*                             OR WITH 'BIN' OPTION NOT FROM 'C' DEVICE          
*                                   THUS NO REASSIGNMENT OF 'C' OPLB            
         BAL,RLNK COPY70            DO THE COPY:                                
         CAL1,1   CLOSESI                                                       
         CAL1,1   CLOSESO                                                       
         B        EXEC1             RETURN TO EXEC.                             
         PAGE                                                                   
         SPACE    2                                                             
*  OUTPUT FIELD IS (LIB,AA)                                                     
*                                                                               
COPY30   RES      0         PROCESS LIBRARY BUILD OR ADD                        
         CI,R6    0                 WAS END OF SUBFIELD FOUND ?                 
         BNE      ERROR02             NO, MUST BE; 'ERROR ITEM XX'              
*                                                                               
COPY30A  RES      0         GET THE LIBRARY'S AREA NAME                         
         BAL,LINK SCAN                                                          
         CI,R6    0                 WAS END OF ITEM OR AN ERROR FOUND ?         
         BE       ERROR02           END OF SUBFIELD; ILLEGAL: ERROR             
         BG       COPY30B           END OF INPUT FIELD: OK                      
*                                                                               
         CI,R10   C'.'              ERROR: CAUSED BY AN AREA PREFIX ?           
         BE       COPY30A             YES, SKIP THE '.' AND GET AREA            
         B        ERROR02           NO, SOME OTHER ERROR; 'ERROR ITEM XX'       
*                                                                               
COPY30B  RES      0         AREA NAME FOUND: VALIDATE IT                        
         BAL,R15  COPY95            CHECK AREA FOR LEGALITY AND IF ALLO.        
         LW,R1    AREA              VERIFY A LIBRARY SPECIFIED                  
         CI,R1    FPINDEX           CAN THE AREA HAVE A LIBRARY ?               
         BG       ERROR10             NO, ERROR; 'AREA XX HAS NO LIB'           
*                                                                               
         CI,R6    2                 ARE ANY OPTIONS SPECIFIED ?                 
         BE       COPY31              NO, JUST START LIB BUILD/ADD              
         BAL,LINK COPYOPTS          GET ANY OPTIONS IF GIVEN                    
         MTW,0    BBCDFLAG                                                      
         BNEZ     CPYXBIN           'BBCD' IN ERROR                             
         MTW,+00  VFCFLAG         ONLY 'ADD' IS ALLOWED...                      
         BNEZ     CPYXVFC           'VFC' IN ERROR                              
         MTW,+00  FBCDFLAG                                                      
         BNEZ     CPYXFBCD                                                      
         MTW,+00  CCFLAG                                                        
         BNEZ     CPYXCC                                                        
         MTW,+00  ASCIFL                                                        
         BNEZ     CPYXASCI                                                      
         MTW,+00  ASCOFL                                                        
         BNEZ     CPYXASCO                                                      
         MTW,+00  BLKOFLAG          'BLKO'                                      
         BNEZ     CPYXBLKO                                                      
         MTW,+00  ORGOFLAG          'ORGO'                                      
         BNEZ     CPYXORGO                                                      
*                                   D800, D1600 & UPD NOT CHECKED               
*                                                                               
*                                                                               
**********************************************************************          
*                                                                    *          
*        BEGIN OF ROUTINE TO CREATE OR ADD TO A LIBRARY              *          
*                                                                    *          
COPY31   RES      0         CREATE NEW LIBRARY OR ADD TO EXISTING ONE           
*                                                                               
COPYSQUZ RES      0         ENTRY TO COPY FOR LIBRARY SQUEEZE REBUILD           
         LI,R0    CLIBERF           SET ERROR FUNCTION PROCESSOR FOR            
         STW,R0   ERRFCN            LIBRARY BUILD COPY                          
         LW,R2    MASDNAME          SET UP AREA AND                             
         STW,R2   AREANAME           FILENAMES OF                               
         LD,R2    MODULE              THE MODULE FILE                           
         STD,R2   FILENAME             TO ASSIGN TO                             
         LW,R2    GIOFBIT               F:SO DCB, THE                           
         LW,R3    GIOFA                  DCB TO USE TO                          
         STS,R2   ASNFILE+1               TO WRITE OUT THE                      
         LI,R2    F:SO                     NEW ROMS AS THEY ARE                 
         CAL1,1   ASNFILE                   ADDED TO THE LIBRARY.               
         CAL1,1   OPENANY           OPEN IT                                     
         LI,R0    M24               SET TO SKIP A VIRTUALLY INFINITE            
         STW,R0   SKIPRCD1          NUMBER OF RECS TO GET TO EOF                
         MTW,-1   ERRFCN            ADJUST ERF TO ACCEPT EOF                    
         CAL1,1   SKIPRCD           COUNT NUMBER OF RECORDS IN FILE             
         MTW,+1   ERRFCN            RESET ERROR PROCESSING                      
         LW,R0    NUMRECS           SET CURRENT SIZE AND                        
*                                                                               
         LI,R1    X'FF'             TEMP FUDGE TO GET INFO FROM RFT             
         LS,R1    F:SO+1            (VIA RFT INDEX IN DCB)                      
         LW,R0    *K:RFT12,R1       UNTIL PREC POSTS ACTUAL NUMBER OF           
         AI,R0    -1                RECORDS SKIPPED                             
*                                                                               
         STW,R0   MODULLEN          SIZE LAST READ FROM DISC AS SIZE            
         STW,R0   MODULSZE          CURRENT SIZE AFTER LAST ROM ADDED.          
         LI,R0    0                 SET NO NEW MODULES ADDED TO MODIR           
         STW,R0   BUFF4             ENTRY BUFFER                                
         STW,R0   EODFLAG           AND WE ARE NOT TO STOP YET                  
         LW,R15   BCKEND            COMPUTE BYTE ADDRESS OF LAST BYTE           
         SLS,R15  2                 IN BACKGROUND BUFFER                        
         AI,R15   3                 FOR USE BY SCNMOD                           
         STW,R15  EBDBA                                                         
         LI,R2    BUFF3             SET UP F:SI,F:SO DCBS WHICH WILL            
         STW,R2   SIBUFF            COPY ROMS TO MODULE FILE.                   
         STW,R2   SOBUFF                                                        
         LI,R2    120                                                           
         STW,R2   SIBCNT                                                        
         STW,R2   SOBCNT                                                        
         LW,R2    BPEND                                                         
         STW,R2   BIBUFF                                                        
*                                                                               
*                           GET CURRENT SIZE OF MODIR FILE                      
         LD,R8    MODIR             SET F:BI TO POINT AT MODIR FILE             
         STD,R8   BIFNAME                                                       
         STD,R8   FILENAME          AND NAME TO OUT IF IT'S NON-EXISTENT        
         LI,R2    F:BI              POINT AT THE DCB TO GET RSIZE               
         CAL1,1   OPENANY           OPEN FILE TO SET DIRE INFO IN RFT           
         CAL1,1   GETFLIMS          GET RSIZE, BOT, EOT FOR FILE                
         CAL1,1   CLOSEANY          AND THEN INSURE IT IS CLOSED.               
         STW,R0   MODIRSZE          SAVE RSIZE AS CURRENT SIZE,                 
         STW,R0   MODIRLEN          SIZE LAST READ FROM DISC.                   
         SW,R15   R14               COMPUTE MAX LENGTH THE RECORD MAY           
         AI,R15   1                 EVER BECOME, AND SAVE TO PREVENT            
         MW,R14   MASDWPS           EVER TRYING TO WRITE ONE THAT BIG.          
         SLS,R15  2                 CONVERT TO BYTES                            
         STW,R15  MODIRMAX          SAVE AWAY AS ABSOLUTE MAX.                  
*                                                                               
         LD,R8    EBCDIC            GET RSIZE OF THE EBCDIC FILE                
         STD,R8   BIFNAME                                                       
         STD,R8   FILENAME          SET NAME IF IT'S NON-EXISTANT               
         CAL1,1   OPENANY           OPEN FILE TO SET DIRE INFO IN RFT           
         CAL1,1   GETFLIMS          GET RSIZE, BOT, EOT                         
         CAL1,1   CLOSEANY          INSURE IT IS CLOSED                         
         STW,R0   EBDICSZE          SET CURRENT LENGTH                          
         STW,R0   EBDICLEN          AND SIZE NOW ON DISC                        
         SW,R15   R14               COMPUTE MAX SIZE IT CAN EVER GET            
         AI,R15   1                                                             
         MW,R14   MASDWPS                                                       
         SLS,R15  2                                                             
         STW,R15  EBDICMAX                                                      
         CW,R0    BCKSZE            WILL IT FIT IN AVAIL MEMORY ?               
         BGE      SEG3X19             NO, GIVE ERROR: 'NOT ENUF MEM'            
*                                                                               
         MTW,+00  ADDFLAG           IS THIS A LIBRARY ADDITION ?                
         BEZ      COPY36              NO, CREATION; DON'T READ OLD LIB          
*                                                                               
         CI,R0    0                 ADDITION; IS THERE A LIB NOW ?              
         BGZ      COPY32              YES, READ IT IN AND PROCESS               
*                                                                               
         STW,R0   ADDFLAG             NO, FORCE A CREATION                      
         B        COPY36            AND GO FIND SIZE OF DEFREF FILE             
*                                                                               
COPY32   RES      0         READ AND INVERT EBCDIC FILE                         
         STW,R0   SETRSIZ2          SET RSIZE IN DCB AS LENGTH TO READ          
         CAL1,1   SETRSIZE                                                      
         CAL1,1   RDDISCS           READ IN THE EBCDIC FILE                     
         CAL1,1   CLOSEANY          AND INSURE IT IS CLOSED                     
         LI,R4    0                 INVERT EBCDIC IN BCKG. BUFFER AND           
         LW,R3    R0                STORE INTO TOP OF BUFFER COMING DOWN        
         AI,R3    -1                                                            
         LW,R5    BCKSZE                                                        
         AI,R5    -1                                                            
         CW,R5    R3                WILL IT FIT IN MEMORY? (ASKED AGAIN)        
         BE       SEG3X19             NO, 'NOT ENUF ROOM' ERROR                 
*                                                                               
COPY33   RES      0         INVERT ONE BYTE OF EBCDIC INFO                      
         LB,R10   *BPEND,R4                                                     
         STB,R10  *BPEND,R5                                                     
         AI,R4    1                                                             
         AI,R5    -1                                                            
         CW,R5    R3                WILL INVERTING CLOBBER FILE                 
         BNE      COPY35            NO                                          
         CI,R0    1                 ONLY THE 1 BYTE LEFT TO INVERT ?            
         BE       COPY35                                                        
         AI,R3    1                 YES. MOVE ALL UNINVERTED BYTES DOWN.        
         LI,R6    0                                                             
COPY34   RES      0                                                             
         LB,R10   *BPEND,R4                                                     
         STB,R10  *BPEND,R6                                                     
         AI,R4    1                                                             
         AI,R6    1                                                             
         CW,R4    R3                ALL BYTES MOVED DOWN                        
         BNE      COPY34                                                        
         LI,R4    0                 YES                                         
         LW,R3    R6                                                            
         AI,R3    -1                                                            
COPY35   RES      0                                                             
         BDR,R0   COPY33            MOVE ANOTHER BYTE                           
*                                                                               
COPY36   RES      0         READ IN DEFREF FILE FOR ADDITIONS                   
         LD,R8    DEFREF            GET SIZE OF DEFREF FILE AND READ            
         STD,R8   BIFNAME           IT INTO BOTTOM OF BUFFER                    
         STD,R8   FILENAME          SET NAME IF IT'S NON-EXISTANT               
         CAL1,1   OPENANY                                                       
         CAL1,1   GETFLIMS          GET RSIZE, BOT, EOT                         
         STW,R0   DREFSZE           SET CURRENT SIZE,                           
         STW,R0   DREFLEN           SIZE LAST READ FROM DISC                    
         SW,R15   R14               COMPUTE MAX SIZE IT MAY EVER GET            
         AI,R15   1                                                             
         MW,R14   MASDWPS                                                       
         SLS,R15  2                                                             
         STW,R15  DREFMAX           AND SAVE AS FILE LIMIT                      
         STW,R0   SETRSIZ2          SET RECORD SIZE IN BYTES INTO DCB           
         CAL1,1   SETRSIZE          AS DEFAULT READ BYTE COUNT                  
         CAL1,1   CLOSEANY          THEN CLOSE IN CASE NO READ TO DO            
         MTW,+00  ADDFLAG           IS THIS A LIB CREATION ?                    
         BEZ      COPY37              YES, DO NOT READ FILE; CREATE IT          
*                                                                               
         LW,R3    EBDICSZE          IS BCKGRND LARGE ENOUGH FOR EBCDIC          
         AW,R3    R0                AND DEFREF FILES AT SAME TIME ?             
         CW,R3    BCKSZE                                                        
         BGE      SEG3X19             NO, 'NOT ENUF BCKG ROOM' ERROR            
*                                                                               
         CAL1,1   RDDISCS           READ IN FILE.                               
         CAL1,1   CLOSEANY          AND INSURE IT IS LEFT CLOSED                
         B        COPY38            AND GO READ ADDITIONS                       
         PAGE                                                                   
         SPACE    2                                                             
COPY37   RES      0         LIBRARY IS, OR WILL BE FORCED, TO EMPTY             
         LI,R0    0                 SET ALL SIZES AND LENGTHS TO                
         STW,R0   MODIRSZE          THEIR EMPTY STATES                          
         STW,R0   EBDICSZE                                                      
         STW,R0   DREFSZE                                                       
         STW,R0   MODULSZE                                                      
         STW,R0   MODIRLEN                                                      
         STW,R0   MODULLEN                                                      
         STW,R0   EBDICLEN                                                      
         STW,R0   DREFLEN                                                       
         STW,R0   BUFF4                                                         
         STW,R0   ADDFLAG                                                       
         CAL1,1   REWINDSO                                                      
         CAL1,1   WEOFSO            MAKE IT EMPTY                               
         PAGE                                                                   
         SPACE    2                                                             
*                           READ NEXT ROM AND ADD TO THE LIBRARY                
COPY38   RES      0                                                             
         BAL,LINK SCNMOD            PROCESS THE MODULE (ROM)                    
         MTW,+1   ADDFLAG           SET ADDING TO EXISTING LIB NOW              
*                                                                               
*                           TEST IF THIS MODULE OVERFLOWS LIB SPACE             
         LW,R0    EBDBYTES          ADDITIONS TO EBCDIC FILE                    
         AW,R0    EBDICSZE          + PREVIOUS LENGTH                           
         CW,R0    EBDICMAX          FIT IN AVAILABLE SPACE ?                    
         BG       COPY46              NO, EOT ON EBCDIC FILE                    
*                                                                               
         LW,R1    DRFHWDS           ADDITIONS TO DEFREF FILE                    
         AW,R1    R1                CONVERTED TO BYTES,                         
         AW,R1    DREFSZE           + PREVIOUS LENGTH STILL                     
         CW,R1    DREFMAX           FIT IN AVAILABLE SPACE ?                    
         BG       COPY47              NO, EOT ON DEFREF FILE                    
*                                                                               
         LW,R2    MODIRSZE          PREVIOUS LENGTH OF MODIR FILE               
         AI,R2    3*4               + SIZE OF 1 ENTRY IN BYTES STILL            
         CW,R2    MODIRMAX          FIT IN ITS AVAILABLE SPACE ?                
         BG       COPY48              NO, EOT ON MODIR FILE                     
*                                                                               
         LW,R3    BUFF4             GET POINTER TO MODIR BUFFER                 
         LCI      3                 UPDATE POINTERS FOR ADDED ENTRY             
         STM,R0   EBDICSZE          SET NEW CURRENT SIZES                       
         LM,R8    MFENTRY           MOVE MODIR ENTRY TO NEXT SPACE IN           
         STM,R8   BUFF4+1,R3        ITS TEMP BUFFER                             
         LH,R9    R8                GET ROM START RECORD NUMBER AND             
         AND,R8   M16               SIZE TO COMPUTE WHERE THE NEW               
         AW,R9    R8                END OF THE MODULE FILE IS                   
         STW,R9   MODULSZE                                                      
         AI,R3    3                 STEP POINTER TO NEXT MODIR ENTRY            
         STW,R3   BUFF4             IN BUFFER AND SAVE FOR NEXT                 
         CI,R3    (256/3)*3         ROOM FOR ANOTHER ENTRY ?                    
         BL       COPY38              YES, GO GET IT                            
*                                                                               
COPY38A  RES      0         UPDATE DISC LIBRARY FILES.                          
*                                   EITHER MODIR BUFFER IS FULL,                
*                                   AN !EOD HAS BEEN READ FROM F:SI,            
*                                   A !COMMAND HAS BEEN READ, OR                
*                                   SOME FILE'S EOT HAS BEEN REACHED.           
*                                                                               
         LD,R8    DEFREF            WRITE OUT DEFREF FILE 1ST TO                
         LW,R0    DREFSZE           FREE BCKG BUFFER                            
         BAL,RLNK COPY160                                                       
*                                                                               
         LW,R7    EBDICSZE          GET NUMBER OF BYTES TO INVERT               
*                                                                               
         LW,R2    BPEND             INITIAL BYTE ADDR.                          
         SLS,R2   2                                                             
*                                                                               
         LW,R3    EBDBA                                                         
         SW,R3    R7                                                            
         AI,R3    1                 LAST BYTE ADDR. OF EBCDIC                   
         LW,R1    EBDBA                                                         
COPY39   RES      0                                                             
         LB,R10   0,R1              FROM                                        
         STB,R10  0,R2              TO                                          
         AI,R1    -1                                                            
         AI,R2    1                                                             
         CW,R2    R3                WOULD LAST EBCDIC BYTE BE CLOBBERED         
         BNE      COPY41                                                        
*                                                                               
         LW,R4    EBDBA             YES. MOVE UNINVERTED BYTES UP.              
         LW,R6    EBDBA                                                         
         SW,R6    R1                                                            
COPY40   RES      0                                                             
         LB,R11   0,R1              FROM                                        
         STB,R11  0,R4              TO                                          
         AI,R1    -1                                                            
         AI,R4    -1                                                            
         CW,R1    R3                                                            
         BGE      COPY40                                                        
         AW,R3    R6                                                            
         LW,R1    EBDBA                                                         
COPY41   RES      0                                                             
         BDR,R7   COPY39                                                        
*                                                                               
         LD,R8    EBCDIC            WRITE OUT THE NEW EBCDIC FILE               
         LW,R0    EBDICSZE                                                      
         BAL,RLNK COPY160                                                       
*                                                                               
         LW,R5    BPEND             SET START ADDR FOR ENTRIES                  
         AI,R5    -1                IN BCKG BUFFER                              
         LW,R0    MODIRLEN          GET SIZE NOW ON DISC                        
         BEZ      COPY43              EMPTY: JUST ADD NEW ENTRIES               
*                                                                               
         LD,R8    MODIR             SET FILENAME, SIZE AND READ IN              
         STD,R8   BIFNAME           THE CURRENT FILE                            
         STW,R0   SETRSIZ2                                                      
         CAL1,1   SETRSIZE          (DCB IN R2 SET BY CALL TO COPY160)          
         CAL1,1   RDDISCS           GET MODIR AS IT IS NOW                      
         CAL1,1   CLOSEANY          CLOSE IT TO REWIND IT                       
         SLS,R0   -2                CONVERT CURRENT LENGTH TO WORDS             
         AW,R5    R0                POINT WHERE TO ADD NEW ENTRIES              
*                                                                               
COPY43   RES      0         ADD NEW ENTRIES TO END OF OLD                       
         LW,R1    BUFF4             GET NUMBER TO ADD                           
         BLEZ     %+1                                                           
*                                                                               
         LW,R0    BUFF4,R1          MOVE THE NEW ENTRIES                        
         STW,R0   *R5,R1                                                        
         BDR,R1   %-2                                                           
*                                                                               
         LD,R8    MODIR             WRITE OUT THE NEW FILE                      
         LW,R0    MODIRSZE                                                      
         BAL,RLNK COPY160                                                       
*                                                                               
         CAL1,1   WEOFSO            TERMINATE MODULE FILE                       
         CAL1,1   CLOSESO                                                       
         MTW,+00  EODFLAG           ARE WE TO STOP NOW ?                        
         BEZ      COPY31              NO, START OVER FROM TOP FOR MORE          
*                                                                               
         MTW,+00  SQUEZ95           YES, IS THIS A SQUEEZE CALL ?               
         BNEZ     SQUEZ110            YES, RETURN THERE; LET IT FINISH          
*                                                                               
         CAL1,1   CLOSESI           NO, NORMAL: CLOSE ROM INPUT                 
         B        EXEC1             AND GO GET NEXT COMMAND                     
         PAGE                                                                   
         SPACE    2                                                             
COPY46   RES      0         EBCDIC FILE REACHES EOT ON CURRENT ROM              
         LD,R8    EBCDIC            SET NAME OF FILE                            
         B        COPY50            GO TO COMMON EOT PROCESSOR                  
*                                                                               
COPY47   RES      0         DEFREF FILE REACHES EOT ON CURRENT ROM              
         LD,R8    DEFREF            SET FILE'S NAME                             
         B        COPY50            GO TO COMMON EOT PROCESSOR                  
*                                                                               
COPY48   RES      0         MODIR FILE REACHES EOT ON CURRENT ROM               
         LD,R8    MODIR             SET FILE'S NAME                             
         B        COPY50            GO TO COMMON PROCESSOR                      
*                                                                               
COPY49   RES      0         MODULE FILE REACHES EOT IN CURRENT ROM              
         LD,R8    MODULE            SET FILE'S NAME                             
         B        COPY50            GO TO COMMON PROCESSOR                      
*                                                                               
COPY50   RES      0         COMMON 'EOT ON FILE NNNNNNNN.AA'                    
         PRNT                       SPACE A LINE                                
         STRNG    MESS35            OUT START OF MESSAGE                        
         CHARS    8,R8,0            OUT FILENAME                                
         CHAR     C'.'              AND SEPARATOR .                             
         CHARS    2,MASDNAME,2      THEN AREA NAME                              
         STRNG    MESINROM          OUT ' IN ROM 'TO SAY WHERE WE               
         CHARS    8,MFENTRY+1       STOPPED.                                    
         BAL,RLNK OUT%MSG           OUT THE MESSAGE                             
*                                                                               
COPY51   RES      0         TERMINATE MODULE FILE AFTER LAST MODULE             
         CAL1,1   REWINDSO          REPOSITION MODULE FILE TO AFTER             
         LW,R0    MODULSZE          LAST COMPLETE MODULE; FILE WILL BE          
         STW,R0   SKIPNSO           TERMINATED AND CLOSED BY THE                
         CAL1,1   SKIPRSO           NORMAL TERMINATION LOGIC AT COPY38A         
*                                                                               
COPY52   RES      0         END OF ROM INPUT; MARK END AND CLEAN UP             
         MTW,+1   EODFLAG           SET THAT WE ARE TO STOP                     
         B        COPY38A           GO WRITE FILES FOR WHAT WE GOT              
*                                                                               
*                                                                               
COPY53   RES      0         FATAL ERROR ON (INPUT?) FILE                        
         BAL,RLNK FATALMSG          OUT THAT THAT IS WHAT HAPPENED              
         B        COPY51            AND TERMINATE BUILD WHERE WE ARE            
         PAGE                                                                   
         SPACE    2                                                             
         ERRP     X'05',0           EOF ON PREC TO EOF; IGNORE                  
*                                                                               
CLIBERF  ERRP     X'05',COPY52      !EOD OR EOF;                                
         ERRP     X'06',COPY52      !CMD;        END OF ROM INPUT; STOP         
         ERRP     X'1C',COPY49      EOT; END OF MODULE FILE FOUND               
         ERRP     X'41',COPY53      IRRECOVERABLE ERROR; STOP BUILD             
         ERRP     X'4A',COPY53      BUFFER ADDR/BYTE COUNT ERROR;               
         ERRP     X'4C',COPY53      INCONSISTENT STATUS; STOP BUILD             
         ERRP     X'4D',COPY53      REQUEST ABORTED BY SYSTEM; STOP             
         ERRP     X'FF',0           OTHERS; CONTINUE PROCESSING IN ROOT         
*                                                                               
         SPACE    2                                                             
COPY160  RES      0         WRITE A LIBRARY FILE                                
         STW,R0   SETRSIZ2          SET BYTE COUNT TO WRITE                     
         STD,R8   BIFNAME           AND NAME OF FILE TO WRITE                   
         LI,R2    F:BI              POINT AT DCB TO MODIFY/USE                  
         CAL1,1   SETRSIZE          SET FILE SIZE IN DCB, RFT                   
         CAL1,1   WRDISCS           WRITE THE RECORD                            
         CAL1,1   CLOSEANY          CLOSE IT                                    
         B        *RLNK             AND RETURN FINISHED                         
         PAGE                                                                   
********************************************                                    
*                                          *                                    
*  PROCESS INPUT FIELD  (LIB,AA,NNNNNNNN)  *                                    
*                                          *                                    
********************************************                                    
*                                                                               
*  LEGAL OUTPUT FIELDS ARE:         (OUT,OP)                                    
*                                   (OUT,YYNDD)                                 
*                                   (FILE,AA,NNNNNNNN)                          
*                                                                               
COPY55   RES      0                                                             
         CI,R6    0                 DO MORE ITEMS FOLLOW ?                      
         BNE      ERROR02             NO, GIVE 'ERROR ITEM XX'                  
         BAL,LINK SCAN              PROCESS LIBRARY FILE (LIB,AA,NNNNNN)        
         CI,R6    0                 AA,                                         
         BNE      SEG3X02           NO PARAMS FOLLOW; ERROR                     
         BAL,R15  COPY95            CHECK AREA FOR LEGALITY AND ALLOC.          
         CI,R1    FPINDEX           CAN THE AREA HAVE A LIBRARY ?               
         BG       ERROR10             NO, ERROR; 'AREA XX HAS NO LIB'           
*                                                                               
         BAL,R15  COPY92            PUT AREA AND ASN(=1) IN INPUT DCB           
         BAL,LINK SCAN              NNNNNNNN)                                   
         CI,R6    1                                                             
         BNE      SEG3X02           IF NO ROM NAME; ERROR IN ITEM               
*                                                                               
         STD,R8   FILENAME          SET, SAVE ROM NAME TO COPY                  
         LD,R14   MODULE            SET UP INPUT DCB TO READ THE                
         STW,R14  SIFNAME           MODULE FILE                                 
         STW,R15  SIFNAME+1         TO ACCESS THE REQUESTED ROM                 
         LI,R0    120               SET READ/WRITE BYTE COUNTS                  
         STW,R0   SIBCNT                                                        
         STW,R0   SOBCNT                                                        
         LI,R0    BUFF3             SET UP TO COPY THROUGH BUFF3 WHERE          
         STW,R0   SIBUFF            RDWRTE EXPECTS AND REQUIRES THE             
         STW,R0   SOBUFF            BUFFER TO BE                                
         BAL,RLNK FNDROM            SEE IF THE ROM EXISTS                       
         B        SEG3ERR             NOT FOUND; OUT ERROR MSG IN R15           
*                                                                               
         LW,R0    *BPEND,R2         GET FIRST WORD IN ROM'S MODIR ENTRY         
         LH,R0    R0                TO GET START RECORD POSITION                
         STW,R0   SKIPRCD1          SET FOR PREC CAL                            
         LI,R2    F:SI              POINT AT THE INPUT DCB                      
         CAL1,1   SKIPRCD           AND POSITION TO FIRST REC OF ROM            
*                                                                               
*                           PROCESS OUTPUT SPECIFICATIONS                       
         MTW,+1   COPYFLAG          SET PROCESSING OUTPUT FIELD                 
         BAL,LINK SCAN              GET OUTPUT DESTINATION KEYWORD              
         CI,R6    -1                WERE ANY ERRORS FOUND ?                     
         BLE      ERROR02             YES, GIVE 'ERROR ITEM XX'                 
*                                                                               
         CW,R8    KWOUT             IS OUTPUT GIVEN BY 'OUT' ?                  
         BE       COPY57              YES, PROCESS OPLABEL/DEVICE               
*                                                                               
         LI,R9    X'FFF00'          NO, SET MASK FOR 1ST 3 LETTERS TEST         
         CS,R8    KWFILE            IS OUTPUT GIVEN BY 'FILE' ?                 
         BNE      SEG3X33             NO, ERROR; ILLEGAL USE                    
*                                                                               
         BAL,LINK COPY85            SET UP OUTPUT DCB TO A FILE                 
         B        COPY58            AND THEN DO COMMON PROCESSING               
*                                                                               
COPY57   EQU      %         'OUT'   OUTPUT IS AN OPLABEL/DEVICE                 
         BAL,LINK COPY100           SET UP OUTPUT DCB TO AN OPLABEL/DEV         
*                                                                               
COPY58   RES      0         PROCESS OPTIONS FOR THE COPY                        
         BAL,LINK COPYOPTS          SCAN OPTIONS FOR COPY                       
*                                                                               
         LW,R15   NFIL              IS NFIL STILL A ONE ?                       
         CI,R15   1                                                             
         BNE      CPYXNFIL            NO, ERROR                                 
*                                                                               
*                           VERIFY NO OPTIONS GIVEN EXCEPT NFIL,1               
         MTW,0    ASCIFL            'ASCI' ?                                    
         BNEZ     CPYXASCI            YES, ERROR                                
         MTW,0    ASCOFL            'ASCO' ?                                    
         BNEZ     CPYXASCO                                                      
         MTW,0    BINFLAG           'BIN'                                       
         BNEZ     CPYXBIN                                                       
         MTW,0    CCFLAG            'CC'   ?                                    
         BNEZ     CPYXCC                                                        
         MTW,0    FBCDFLAG          'FBCD' ?                                    
         BNEZ     CPYXFBCD                                                      
         MTW,0    VFCFLAG           'VFC'  ?                                    
         BNEZ     CPYXVFC                                                       
         MTW,0    ORGIFLAG          'ORGI'                                      
         BNEZ     CPYXORGI                                                      
*                                                                               
         CAL1,1   VFCSO0            INSURE 'VFC' OFF IN OUTPUT DCB              
         MTW,+1   BINFLAG           AND INSURE 'BIN' ON FOR OUTPUT              
         LI,R2    F:SO              POINT AT OUTPUT DCB                         
         BAL,RLNK COPYMODE          SET REQUIRED MODE BITS, SIZES               
         BAL,RLNK CPYPOSIT          PROCESS 'ADD' & 'UPD' OPTIONS               
         BAL,LINK RDWRTE            COPY FIRST RECORD OF ROM                    
*                                                                               
COPY68   RES      0                                                             
         CI,R13   1                 LAST CARD OF ROM                            
         BE       COPY69            YES                                         
         BAL,LINK RDWRTE1           NO                                          
         B        COPY68                                                        
COPY69   RES      0                                                             
         CAL1,1   WEOFSO              WEOF ON OUTPUT FILE                       
         CAL1,1   CLOSESI                                                       
         CAL1,1   CLOSESO                                                       
         B        EXEC1             EXIT                                        
         PAGE                                                                   
*************************                                                       
*                       *                                                       
*  DEVICE COPY ROUTINE  *                                                       
*                       *                                                       
*************************                                                       
*                                                                               
*  ROUTINE READS AND WRITES A RECORD AT A TIME UNTIL AN EOD.                    
*    DOES BCD TO EBCDIC CONVERSION IF REQUESTED.                                
*     ON OUTPUT TO A TAPE/FILE WITH 'BLKO' GIVEN, THE INPUT BUFFER IS           
*    BLANK FILLED UP TO THE OUTPUT RECORD LENGTH TO SPACE FILL SHORT            
*    INPUT RECORDS. THIS IS DONE FOR FILE TO FILE COPIES TOO IF THE             
*    OUTPUT RECORDS ARE LARGER THAN THE INPUT.                                  
*                                                                               
COPY70    RES     0                                                             
         LW,R1    BLKOFLAG          IS OUTPUT BLOCKED ?                         
         BEZ      COPY70A             NO, DON'T SPACE FILL BUFFER               
*                                                                               
         LD,R8    BLNK              GET SPACES                                  
         STD,R8   *SIBUFF           CLEAR INDEX ZERO                            
         STD,R8   *SIBUFF,R1        AND THE REST OF THE BUFFER                  
         BDR,R1   %-1               COUNT CONVERTED TO DOUBLE WORDS             
*                                                                               
COPY70A  RES      0         READ THE NEXT RECORD                                
         CAL1,1   READSI            READ INTO BUFF3 WITH WAIT                   
COPY72   RES      0                                                             
         LI,R1    0                                                             
         STW,R1   EODFLAG           FLAG MEANS THIS RECORD NOT EOD              
         MTW,0    ASCIFL            IS THE INPUT ASCII                          
         BEZ      COPY71            NO, BRANCH                                  
         BAL,R8   ASCITOEB          CHANGE BUFFER TO EBCDIC                     
         B        COPY71A                                                       
COPY71   RES      0                                                             
         MTW,0    FBCDFLAG          IS BCD-EBCDIC CONV. SPEC.                   
         BEZ      COPY71A           NO, BRANCH                                  
         BAL,LINK BCDTOEBC          YES                                         
COPY71A  RES      0                                                             
         LW,R1    SICOMPL           GET COMPLETION STATUS WORD                  
         AND,R1   M17               R1= ACTUAL RECORD SIZE                      
         MTW,+00  BLKOFLAG          IS OUTPUT RECORD SIZE FORCED ?              
         BNEZ     %+2                 YES, DON'T SET                            
         STW,R1   SOBCNT                                                        
         MTW,0    OUTFLAG           IF OUTPUT TO NON RAD DEVICE SET             
         BEZ      COPY72B           MODE BEFORE OUTPUTTING RECORD               
         MTW,0    BBCDFLAG          IS IT NON STANDARD BINARY                   
         BNEZ     COPY72B           YES. DONT SET MODE                          
         MTW,0    PNCHFLAG          IF OUTPUT TO PUNCH, SET MODE                
         BEZ      COPY72B           B IF NOT PUNCH OUTPUT                       
         LW,R1    SIBUFF            FOR MIXED MODE                              
         BAL,R15  COPY75                                                        
COPY72B  RES      0                                                             
         MTW,0    BBCDFLAG          IS THIS A NON STANDARD BINARY COPY          
         BEZ      COPY72C           NO                                          
         LW,R1    SIBUFF                                                        
         BAL,R15  COPY80            YES. CHECH IF !EOD                          
         B        COPY72A                                                       
COPY72C  RES      0                                                             
         MTW,0    CCFLAG            IS THIS A CONTROL COMMAND COPY              
         BEZ      COPY72D           NO                                          
         LW,R1    *SIBUFF           YES                                         
         CW,R1    :EOD              TERMINATE COPY IF :EOD READ                 
         BE       ABN5AEOF                                                      
COPY72D  RES      0                                                             
         MTW,0    ASCOFL            IS OUTPUT TO BE CONVERTED TO ASCII          
         BEZ      COPY72A           NO                                          
         BAL,R8   EBTOASCI          YES, CONVERT BUFFER TO ASCII                
COPY72A  CAL1,1   WRITESO           WRITE OUT BUFF3                             
         B        COPY70                                                        
         PAGE                                                                   
*                                                                               
*  SUBROUTINE SETS OUTPUT MODE TO BCD IF THE                                    
*   FIRST BYTE IN THE INPUT  BUFFER DOES NOT MATCH ANY OF THE ENTRIES           
*   IN THE 'BINFORM' TABLE                                                      
*  CONDITIONS FOR ENTRY ARE:  OUTFLAG=1                                         
*                            BBCDFLAG=0 (BIN WAS NOT SPECIFIED)                 
*                            PNCHFLAG=1 (OUTPUT IS TO CP OR PP)                 
*                                                                               
*                                                                               
COPY75   RES      0                                                             
         LB,R3    BINFORM           GET NO. ENTRIES IN BINFORM TABLE            
COPY76   RES      0                                                             
         LB,R0    BINFORM,R3                                                    
         CB,R0    *R1                                                           
         BE       COPY77                                                        
         BDR,R3   COPY76                                                        
         CAL1,1   MODESO0            SET OUTPUT MODE TO BCD                     
         B        *R15                                                          
COPY77   RES      0                                                             
         CAL1,1   MODESO1           SET OUTPUT MODE TO BINARY                   
         B        *R15                                                          
*                                                                               
*  SUBROUTINE CHECKS FOR !EOD IN NON STANDARD BINARY COPY                       
*                                                                               
COPY80   RES      0                                                             
         LI,R4    1                                                             
         LW,R2    *R1                                                           
         LW,R3    *R1,R4                                                        
         AND,R3   ML16                                                          
         CD,R2    BINEOD            IS IT AN !EOD                               
         BE       ABN5AEOF            YES, WRITE EOF, CHECK NFIL COUNT          
         B        *R15              NO                                          
         PAGE                                                                   
****************************************                                        
*                                      *                                        
*  DCB AND FPT INITIALIZATION ROUTINE  *                                        
*                                      *                                        
****************************************                                        
*                                                                               
*  ROUTINE CALLED WHEN IN OR OUT FIELD IS (FILE,AA,NNNNNNNN)                    
*  CHECKS VALIDITY OF PARAMETERS AND INITIALIZES THE DCB                        
*    AND FPT FOR A RAD FILE READ/WRITE                                          
*  IF COPYFLAG = 0,  PROCESS 'IN' DCB/FPT                                       
*  IF COPYFLAG = 1,  PROCESS 'OUT' DCB/FPT                                      
*                                                                               
COPY85   RES      0                                                             
         CI,R6    0                 DOES ANOTHER SUBFIELD FOLLOW ?              
         BNE      ERROR02             NO, GIVE 'ERROR ITEM XX'                  
         PUSH     LINK              SAVE RETURN                                 
         BAL,LINK GETFID            GET FILE ID                                 
         CI,R6    -1                ANY ERRORS FOUND ?                          
         BLE      ERROR02             YES, REPORT IT                            
         LW,R8    AREANAME          CONVERT AREA NAME TO SCAN'S FORMAT          
         SLS,R8   16                FOR GETAX ROUTINE TESTS                     
         BAL,XLNK COPY95            CHECK VALIDITY OF AREA NAME                 
*                                                                               
         LI,R2    F:SI              ASSUME PROCESSING INPUT FILE                
         LI,R3    SIBCNT            AND SETTING UP ITS DCB AND FPTS             
         MTW,+0   COPYFLAG          ARE WE PROCESSING THE INPUT NAME ?          
         BGZ      COPY85A             NO, SET UP FOR OUTPUT                     
*                                                                               
         CI,R6    1                 WAS END OF INPUT NAME FOUND ?               
         BNE      ERROR02             NO, GIVE AN ERROR                         
         B        COPY86            GO ASSIGN FILE, GET REC SIZE                
*                                                                               
COPY85A  RES      0         PROCESS OUTPUT FILE DEFINITION                      
         CI,R6    1                 WAS END OF FIELD OR COMMAND FOUND ?         
         BL       ERROR02             NO, ERROR IN OUTPUT SPEC                  
*                                                                               
         LI,R2    F:SO              SET UP TO USE OUTPUT DCB, FPTS              
         LI,R3    SOBCNT                                                        
*                                                                               
*                                                                               
COPY86   RES      0         CHECK FILE NAME AND AREA FOR BT FILES               
         CI,R1    BTINDEX           IS THE 'BT' AREA SPECIFIED ?                
         BNE      COPY87              NO, DON'T TEST FOR BT FILES               
*                                                                               
         LD,R8    FILENAME          GET FILENAME SPECIFIED                      
         LW,R1    ILLTOTL           INSURE FILENAME IS A LEGAL                  
         CW,R8    ILLNMES-1,R1      BT AREA NAME                                
         BE       COPY87              IT IS; RETURN OK                          
*                                                                               
         BDR,R1   %-2               NOT LEGAL YET. TEST ANOTHER NAME            
         B        ERROR02           NOT LEGAL AT ALL; ERROR ITEM XX             
*                                                                               
COPY87   RES      0         ASSIGN DCB, GET AND SET RSIZE FOR READ/WRITE        
         LI,R0    0                 RESET 'MOD', 'OPEN', 'PACK', 'BIN',         
         LW,R1    MASKDCB           'BUSY', 'BTD', ETC IN DCB                   
         LS,R0    *R2                                                           
         STW,R0   *R2                                                           
         LW,R0    GIOCT             GET PRESENCE BITS FOR FILE.ACNT             
         LW,R1    GIOFA             SET ACNT IF GIVEN, ELSE DEFAULT IT          
         STS,R0   ASNFILE+1                                                     
         CAL1,1   ASNFILE           ASSIGN FILE TO F:SI OR F:SO                 
         CAL1,1   OPENANY           OPEN IT TO SET RSIZE IN MONITOR             
         CAL1,1   GETRSIZE          GET RSIZE IN R0                             
         STW,R0   *R3               AND SET IN APPROPRIATE FPT                  
         CAL1,1   CLOSEANY          INSURE DCB CLOSED IN CASE OF ERRORS         
         PULL     LINK                                                          
         B        *LINK             RETURN                                      
         PAGE                                                                   
*************************************                                           
*                                   *                                           
*  INITIALIZE ASN, AREA PARAMETERS  *                                           
*                                   *                                           
*************************************                                           
*                                                                               
*  ROUTINE SETS THE ASN AND AREA PARAMETERS IN THE PROPER DCB FOR               
*    A RAD FILE                                                                 
*                                                                               
COPY92   RES      0                                                             
         LI,R1    6                 PUT AREA IN PROPER DCB                      
         LW,R2    AREA                                                          
         MTW,0    COPYFLAG                                                      
         BGZ      COPY93                                                        
         STB,R2   F:SI,R1                                                       
*                                                                               
         LI,R2    1                 SET ASN=1 IN F:SI DCB                       
         LW,R3    M4                                                            
         STS,R2   F:SI                                                          
         B        *R15                                                          
COPY93   RES      0                                                             
         STB,R2   F:SO,R1                                                       
*                                                                               
         LI,R2    1                 SET ASN=1 IN F:SO DCB                       
         LW,R3    M4                                                            
         STS,R2   F:SO                                                          
         B        *R15                                                          
         PAGE                                                                   
*************************                                                       
*                       *                                                       
*  AREA VALIDITY CHECK  *                                                       
*                       *                                                       
*************************                                                       
*                                                                               
*  ROUTINE CHECKS THE VALIDITY OF THE AREA WHEN THE IN OR OUT                   
*    FIELD IS (FILE,AA,NNNNNNNN)                                                
*                                                                               
COPY95   RES      0                                                             
         BAL,RLNK GETAX             VALIDATE AREA, GET ITS INDEX                
         B        ERROR02           ERROR ITEM XX; BAD AREA INDEX               
*                                                                               
*                                                                               
         CLM,R1   CKXA              VERIFY AREA IS MAINTAINED BY EDITOR         
         BCS,6    COPY98                                                        
         MTW,0    COPYFLAG          (FILE,CK) OR (FILE,XA) ALLOWED ONLY         
         BNEZ     COPY150                               AS INPUT FILES.         
*                                                                               
COPY98   RES      0                                                             
         BAL,R14  UNPKMASD          CHECK AREA, GET AREA INFO                   
         B        ERROR04             NOT ALLOCATED; GIVE ERROR                 
         B        *R15              RETURN                                      
         PAGE                                                                   
*************************************                                           
*                                   *                                           
*  INITIALIZE DEVF, ASN PARAMETERS  *                                           
*                                   *                                           
*************************************                                           
*                                                                               
*  ROUTINE INITIALIZES DEVF,ASN PARAMETERS FOR 'IN' OR 'OUT' FIELDS             
*    WHEN COPYING TO OR FROM A DEVICE OR OP LABEL                               
*  SETS PNCHFLAG = 1 IF COPYING TO CARD PUNCH OR PAPER TAPE                     
*                                                                               
COPY100  RES      0                                                             
         PUSH     LINK              SAVE RETURN                                 
         LI,R2    F:SI              POINT AT INPUT DCB                          
         MTW,+00  COPYFLAG          ARE WE PROCESSING THE INPUT ?               
         BEZ      COPY101             YES, KEEP DCB ADDRESS AS IS               
*                                                                               
         LI,R2    F:SO              NO, POINT AT OUTPUT DCB                     
*                                                                               
COPY101  RES      0         PROCESS ASSIGNMENT OF IN OR OUT DCB                 
         CI,R6    1                 DOES A SUBFIELD (DEVICE/OPLB) FOLLOW        
         BGE      COPY109             NO, USE PREVIOUS ASSIGNMENT AS IS         
*                                                                               
         LI,R0    0                 RESET 'MOD', 'OPEN', 'PACK', 'BIN',         
         LW,R1    MASKDCB           'BUSY', 'BTD', ETC IN DCB                   
         LS,R0    *R2                                                           
         STW,R0   *R2                                                           
         BAL,LINK SCAN                                                          
         CI,R6    0                                                             
         BLE      COPY150                                                       
*                                                                               
         CI,R10   2                 MORE THAN 2 CHARS. INFERS DEVICE            
         BG       COPY104                                     TYPE              
*                                                                               
*   OPERATIONAL LABEL SPECIFIED                                                 
*                                                                               
         LH,R8    R8                                                            
         STW,R8   OPLBASGN          SET NAME FOR ASSIGN IF OK OPLB              
         LH,R1    *K:OPLBS1         GET NUM OF OPLBS AND TEST IF LEGAL          
*                                                                               
COPY102  RES      0         LOOK THROUGH OPLB LIST FOR ONE GIVEN                
         CH,R8    *K:OPLBS1,R1      IS THIS A LEGAL LABEL ?                     
         BE       COPY103             YES, ASSIGN DCB TO IT                     
         BDR,R1   COPY102           NOT FOUND YET; LOOK MORE                    
         B        ERROR02           ILLEGAL NAME; 'ERROR ITEM XX'               
*                                                                               
COPY103  RES      0         LEGAL OPLABEL FOUND; DO ASSIGNMENT                  
         CAL1,1   ASNOPLB           DCB TO ASSIGN TO IN R2                      
         B        COPY110           GO TEST FOR 'C' DEVICE, ETC.                
*                                                                               
*   DEVICE SPECIFIED                                                            
*                                                                               
COPY104  RES      0                                                             
         CI,R10   5                 DEVICE TYPE SPECIFIED. GET DCT INDEX        
         BNE      COPY150           AND MERGE INTO DEV/OPLB/RFILE               
*                                                                               
         LCI      2                                                             
         STM,R8   DEVASGN           SAVE NAME FOR ASSIGNMENT                    
*                                                                               
*   FIX UP DEVICE NAME IN DCT16 FORMAT AND TRY TO FIND A MATCH                  
         SLD,R8   -24                                                           
         OR,R8    DCTDATA                                                       
         LH,R1    *K:DCT1           GET NUMBER OF DEVICES TO CHECK              
*                                                                               
COPY107  RES      0         LOOK THROUGH DEVICE LIST FOR ONE GIVEN              
         CD,R8    *K:DCT16,R1       IS IT A LEGAL DEVICE NAME ?                 
         BE       COPY108             YES, ASSIGN DCB TO IT                     
         BDR,R1   COPY107           NOT YET, LOOK MORE                          
         B        ERROR02           ILLEGAL NAME; 'ERROR ITEM XX'               
*                                                                               
COPY108  RES      0         LEGAL DEVICE NAME FOUND; DO ASSIGNMENT              
         CAL1,1   ASNDEV            DCB TO ASSIGN TO IN R2                      
         B        COPY110           AND TEST IF 'C' DEVICE; PUNCH, ETC          
*                                                                               
*                                                                               
*   DEFAULT ASSIGNMENT: USE PREVIOUS ASSIGNMENT                                 
*                                                                               
COPY109  RES      0         USE PREVIOUS ASSIGNMENT OF DCB; GET IT              
         CAL1,1   GETAINFO          GET DEVICE ADDR + OTHER STUFF               
         LD,R8    MASDDEVA          AND MOVE IT TO DEVICE ASSIGNMENT            
         STD,R8   DEVASGN           AS IF IT WAS INPUT                          
COPY109Z CAL1,1   GETFILNM          GET FILENAME.AA.ACNT IF A FILE.             
*                                   IT IS UNCHANGED IF NOT TO A FILE            
         CD,R8    DEVASGN           WAS THE DEVICE NAME CHANGED ?               
         BNE      COPY114A            YES, FILE INVOLVED; EXIT DONE             
*                                                                               
************************************                                            
*                                                                               
*        PROCESS RESULTANT ASSIGNMENTS FOR SPECIAL CASES:                       
*                 IN FROM 'C' DEVICE; OUT TO PUNCH.                             
*                                                                               
COPY110  RES      0         DECODE ASSIGNMENT OF THE DCB                        
         CAL1,1   GETAINFO                                                      
         LW,R3    MASDDCTI          GET DCT INDEX                               
*                                                                               
COPY112  RES      0                                                             
         CW,R3    CDEVICE           IS R3 THE C DEVICE INDEX                    
         BNE      COPY112A          NO, BRANCH                                  
         MTW,0    COPYFLAG          YES, TEST FOR 'OUT'                         
         BGZ      COPY112A          B IF C IS THE 'OUT' DEVICE                  
         MTW,1    CREAD             SET INPUT IS THRU C DEVICE                  
COPY112A RES      0                                                             
         CI,R3    X'80'                                                         
         BANZ     COPY114A          R3=RFT INDEX; RETURN                        
         LD,R2    *K:DCT16,R3       GET DEVICE NAME IN R3                       
         SLD,R2   -24                                                           
         AND,R3   M16                                                           
         MTW,0    OUTFLAG           IS 'OUT' FLAG SET                           
         BEZ      COPY114           B IF NOT                                    
         STW,R3   SODEVICE          SAVE OUTPUT DEVICE NAME                     
         CI,R3     'CP'             CARD PUNCH                                  
         BE       %+3                                                           
         CI,R3    'PP'                                                          
         BNE      COPY114A            NOT PAPER TAPE; RETURN                    
         MTW,1    PNCHFLAG          YES                                         
         B        COPY114A            FLAG SET; RETURN                          
COPY114  MTW,0    INFLAG            IS 'IN' FLAG SET                            
         BEZ      COPY114A            NO, EXIT                                  
         STW,R3   SIDEVICE          YES, STORE NAME OF INPUT DEVICE             
*                                                                               
COPY114A RES      0         EXIT                                                
         PULL     LINK                                                          
         B        *LINK                                                         
         PAGE                                                                   
*********************                                                           
*                   *                                                           
*  PROCESS OPTIONS  *                                                           
*                   *                                                           
*********************                                                           
*                                                                               
*  ROUTINE SCANS COPY COMMAND FOR OPTIONS AND SETS APPROPRIATE FLAGS            
*                                                                               
COPYOPTS EQU      %         PROCESS OPTIONS FOR 'COPY' COMMAND                  
         PUSH     LINK              SAVE RETURN ADDRESS                         
*                                                                               
CPYOPT1  EQU      %         PROCESS NEXT OPTION IF PRESENT                      
         LI,R0    1                 INSURE SCAN SCANS FOR EBCDIC ONLY           
         STW,R0   SPARAMF1                                                      
         CI,R6    2                 IS THERE ANOTHER ?                          
         BE       CPYOPT8             NO, RETURN TO START COPY                  
*                                                                               
         BAL,LINK SCAN              GET NEXT PARAMETER                          
         CI,R6    -1                ANY ERRORS FOUND ?                          
         BLE      CPYOPT9             YES, RETURN 'ERROR ITEM XX'               
*                                                                               
         LI,R9    X'FFF00'          SET MASK TO TEST 1ST 3 CHARS ONLY           
         CS,R8    KWNFIL            IS IT THE 'NFIL' OPTION ?                   
         BNE      CPYOPT4             NO, TEST OTHER KEYWORDS                   
*                                                                               
         CI,R6    0                 DOES ANOTHER FIELD FOLLOW ?                 
         BNE      CPYOPT9X            NO, BUT THERE SHOULD; GIVE ERROR          
*                                                                               
         LI,R1    5                 SET UP TO SCAN THE 'N' FIELD IN             
         STW,R1   SPARAMF1          DECIMAL OR CHARACTER MODE                   
         BAL,R8   SCAN              GET THE PARAMETER                           
         CI,R6    0                 WERE THERE ANY ERRORS ?                     
         BLE      CPYOPT9             YES, REPORT THEM                          
         PAGE                                                                   
         SPACE    2                                                             
         CI,R9    0                 IS THE PARAM A DECIMAL NUMBER ?             
         BNE      CPYOPT3             NO, TRY 'ALL' KEYWORD                     
*                                                                               
         STW,R8   NFIL                YES, SET NUMBER OF FILES TO COPY          
         B        CPYOPT1           AND SEE IF MORE PARAMETERS                  
*                                                                               
CPYOPT3  EQU      %         TEST FOR 'ALL' PARAMETER ON 'NFIL' OPTION           
         CW,R8    KWALL             IS IT 'ALL' ?                               
         BNE      CPYOPT9X            NO, SAY ILLEGAL PARAMETER                 
*                                                                               
         LI,R1    -1                  YES, SET NFIL COUNT = ALL                 
         STW,R1   NFIL                                                          
         B        CPYOPT1           AND GET NEXT OPTION IF ANY                  
         PAGE                                                                   
         SPACE    1                                                             
CPYOPT4  EQU      %         TEST IF PARAM A LEGAL OPTION KEYWORD                
         LI,R1    #KEYWRDS          SET NUMBER OF LEGAL OPTION WORDS            
*                                                                               
CPYOPT5  EQU      %         SEARCH FOR THE WORD                                 
         CW,R8    KEYWORDS,R1                                                   
         BE       CPYOPT6             FOUND                                     
         BDR,R1   CPYOPT5           LOOK FURTHER                                
*                                                                               
         B        CPYOPT9X          NOT LEGAL OPTION; GIVE ERROR                
*                                                                               
CPYOPT6  EQU      %         KEYWORD FOUND; SET FLAG INDICATING SAME             
         CI,R1    #KEYWWP           DOES THE OPTION ALLOW A PARAM ?             
         BG       CPYOPT10            YES, PROCESS IT                           
*                                                                               
         CI,R6    0                 NO, DO WE HAVE A PARAM ON IT ?              
         BE       CPYOPT9X            YES, TELL USER OF HIS ERROR               
*                                                                               
         LI,R0    1                                                             
         STW,R0   COPYFLAG,R1       SET FLAG                                    
         B        CPYOPT1           GET NEXT OPTION IF ANY                      
*                                                                               
*                                                                               
CPYOPT8  EQU      %         NORMAL, NO ERROR EXIT                               
         PULL     LINK              RECOVER RETURN ADDRESS                      
         B        *LINK             RETURN                                      
*                                                                               
*                                                                               
CPYOPT9  EQU      %         ERROR IN SCAN                                       
         PULL     LINK              CLEAR STACK                                 
         B        SEG3X02           AND REPORT ERROR 02                         
*                                                                               
CPYOPT9X EQU      %         ERROR IN PARAMETER OR ILLEGAL OPTION KEYWORD        
         LW,R2    R8                COPY KEYWORD                                
         PULL     LINK              CLEAR STACK                                 
         B        SEG3X18           GO OUTPUT MESSAGE                           
*                                                                               
*                                                                               
CPYOPT10 RES      0         PROCESS OPTIONS WITH PARAMS                         
         CI,R1    #KEYWOP           DOES IT ALLOW OPTIONAL PARAMS ?             
         BG       CPYOPT15            NO, REQUIRES PARAMS: SCAN IT              
*                                                                               
         MTW,-1   COPYFLAG,R1       SET 'BLKX' OPTION GIVEN                     
         CI,R6    0                 DOES AN PARAM FOLLOW ?                      
         BNE      CPYOPT1             NO, GET NEXT OPTION, IF ANY               
*                                                                               
         LI,R0    4                 YES, SCAN VALUE IN DECIMAL                  
         STW,R0   SPARAMF1                                                      
         BAL,LINK SCAN              GET THE NUMBER                              
         CI,R8    32768             IS RSIZE TOO BIG ?                          
         BG       CPYOPT9             YES, GIVE 'ERROR ITEM XX'                 
*                                                                               
         STW,R8   COPYFLAG,R1       SET RECORD SIZE FOR BLOCKED TAPE            
         CI,R6    0                 WERE ERRORS OR MORE PARAMS FOUND ?          
         BL       CPYOPT9           ERRORS: REPORT THEM                         
         BG       CPYOPT1           NO MORE PARAMS; TEST IF ANOTHER             
*                                                                               
         BAL,LINK SCAN              GET MAX BUFFER SIZE                         
         CI,R6    0                 IS THIS IN ERROR OR NOT END ?               
         BLE      CPYOPT9             YES, REPORT                               
*                                                                               
         CI,R8    512*4             IS MAX BLOCK SIZE TOO BIG ?                 
         BG       CPYOPT9             YES, REPORT IT AS AN ERROR                
*                                                                               
         LW,R0    COPYFLAG,R1       INSERT SIZE IN WITH RECORD SIZE             
         CW,R8    R0                IS 'BLKSIZE' > 'RSIZE' ?                    
         BL       ERROR02             NO, GIVE 'ERROR ITEM XX'                  
*                                                                               
         STH,R8   R0                                                            
         STW,R0   COPYFLAG,R1                                                   
         B        CPYOPT1           AND GO GET NEXT OPTION, IF ANY              
*                                                                               
*                                                                               
CPYOPT15 RES      0         PROCESS OPTIONS WITH EBCDIC PARAMS (ORGX)           
         CI,R6    0                 DOES A PARAM FOLLOW ?                       
         BNE      CPYOPT9X            NO, GIVE 'ERROR ITEM XX'                  
*                                                                               
         BAL,LINK SCAN              GET PARAM                                   
         CI,R6    0                 IS IT END OF THE OPTION ?                   
         BLE      CPYOPT9             NO, 'ERROR ITEM XX'                       
*                                                                               
         LI,R2    #ORGS             SCAN LIST OF LEGAL ORG CODES                
*                                                                               
CPYOPT17 RES      0         TEST IF GIVEN PARAM A LEGAL ORG CODE                
         CW,R8    KWORGS,R2                                                     
         BE       CPYOPT18            YES, SET ORG                              
         BDR,R2   CPYOPT17          NOT YET                                     
         B        CPYOPT9           NOT AT ALL; 'ERROR ITEM XX'                 
*                                                                               
CPYOPT18 RES      0         LEGAL ORG FOUND; SAVE FOR SET MODE                  
         STW,R2   COPYFLAG,R1       SET ORG CODE                                
         B        CPYOPT1           AND GET ANY OTHER OPTIONS                   
         PAGE                       'BLOCKED' I/O DOCUMENTATION                 
         SPACE    2                 ---------------------------                 
*        BLKI     ARE USED TO CONTROL INPUT FROM AND OUTPUT TO BLOCKED          
*        BLKO     TAPES (AND FILES); THEY WILL CONTAIN ONE OF:                  
*                        0  OPTION NOT USED;                                    
*                       -1  OPTION USED, BUT NO OPTIONAL PARAMS;                
*                 0000RRRR  RECL GIVEN, READ/WRITE 'RRRR' BYTES;                
*                 GGGGRRRR  RECL & GSIZE GIVEN: SET GSIZE = 'GGGG',             
*                           RSIZE AND RSZ IN DCB = 'RRRR'.                      
*                                                                               
*        ORGI     ARE USED TO SET TYPE OF BLOCKING ON INPUT/OUTPUT              
*        ORGO     TAPES (AND FILES); 1=UNBLK; 2=BLK; 3=COMPRESSED.              
*                 (VALUES ARE DECREMENTED BY 1 WHEN SET IN THE FPT              
*                  FOR SET MODE CAL. THEY ARE 1 GREATER THAN THEIR              
*                  USUAL VALUES SO 0 CAN BE USED FOR NO OPTION GIVEN.)          
         PAGE                                                                   
         SPACE    2                                                             
*        CALL:    BAL,RLNK    CPYPOSIT                                          
*                                                                               
*                 POISTIONS OUTPUT FILE (ONLY) ACCORDING TO THE                 
*                 'ADD' OR 'UPD' OPTION GIVEN.                                  
*                 ERRORS GO DIRECTLY TO THE APPROPRIATE ERROR ROUTINE.          
*                                                                               
*                                                                               
CPYPOSIT EQU      %         PROCESS POSITION FOR 'ADD' AND 'UPD' OPTIONS        
         MTW,0    ADDFLAG           'ADD' REQUESTED ?                           
         BEZ      CPYPOSA             NO, TEST FOR 'UPD'                        
*                                                                               
         MTW,0    UPDFLAG           YES, 'UPD' REQUESTED TOO ?                  
         BNEZ     CPYXADD             YES, ERROR (GIVE ADD MSG)                 
*                                                                               
         CAL1,1   SKIPFSO           NO, SKIP TO END FOR 'ADD'                   
         B        *RLNK             AND RETURN                                  
*                                                                               
CPYPOSA  EQU      %         'ADD' NOT GIVEN, TEST FOR 'UPD'                     
         MTW,+00  OUTFLAG           IS OUTPUT TO A FILE ?                       
         BNEZ     *RLNK               NO, IGNORE 'UPD' OR NO OPTION             
*                                                                               
         MTW,0    UPDFLAG           IS 'UPD' REQUESTED ?                        
         BEZ      CPYPOSB             NO, REWIND TO START AT BEGINNING          
*                                                                               
         CAL1,1   WEOFSO            ELSE START WHEREEVER WE ARE NOW             
         B        *RLNK             THEN RETURN                                 
*                                                                               
CPYPOSB  EQU      %         'ADD' AND 'UPD' NOT GIVEN; REWIND OUTPUT            
         CAL1,1   REWINDSO          REWIND TO START AT BEGINNING                
         B        *RLNK             RETURN                                      
         PAGE                                                                   
*                                                                               
*        CALL     BAL,RLNK    COPYMODE                                          
*                                                                               
*        R2       ADDRESS OF DCB TO PROCESS                                     
*                                                                               
*                 PROCESSES THE VARIOUS POSSIBLE MODES A DCB MAY HAVE.          
*                 THIS INCLUDES 'BIN', D800', 'D1600'.                          
*                 FOR DCBS FOR WHICH 'BLKX' AND/OR 'ORGX' HAVE BEEN             
*                 SPECIFIED, SETS THE RSIZE, GSIZE, AND ORG ACCORDING           
*                 TO THE PARAMETERS ON THE CORRESPONDING OPTIONS.               
*                 ONE SET MODE CAL IS ISSUED FOR EACH DCB (F:SI, F:SO)          
*                 AND THE BYTE COUNT IN SXBCNT FOR THE DCB SET FROM             
*                 THE GIVEN RSIZE.                                              
*                 IF 'BLKO' IS GIVEN, THE NUMBER OF DOUBLE WORDS IN             
*                 THE BUFFER IS COMPUTED FOR BLANKING OUT THE BUFFER            
*                 BEFORE EACH READ TO SPACE FILL SHORT INPUT RECORDS.           
*                                                                               
COPYMODE RES      0         SET MODE BITS IN DCB IN (R2)                        
         LW,R15   F1B               SET DEFAULT = 800 BPI, PACKED               
         MTW,+00  BINFLAG           WAS 'BIN' (BINARY) REQUESTED ?              
         BEZ      CPYMOD1             NO, NO NEED TO SET ITS BIT                
*                                                                               
         OR,R15   F3B               YES, SET 'BIN' BIT (NOT 'BCD')              
*                                                                               
CPYMOD1  RES      0         FIND OUT WHICH DCB PROCESSING                       
         LI,R1    0                 ASSUME DOING F:SI, THE INPUT DCB            
         LI,R3    SIBCNT            AND POINT AT ITS PARAMS & INFO              
         CI,R2    F:SI              IS IT THE INPUT DCB ?                       
         BE       CPYMOD3             YES, CONTINUE; SKIP DENSITY TESTS         
*                                                                               
         LI,R1    1                 POINT AT OUTPUT PARAMS                      
         LI,R3    SOBCNT            AND BYTE COUNTS                             
         MTW,+00  D8HFLAG           IS 800 BPI REQUESTED ?                      
         BEZ      CPYMOD3             NO, DON'T SET REQUEST BIT                 
*                                                                               
         OR,R15   F1BF3B            SET 800 BPI AND UNPACKED                    
*                                                                               
CPYMOD3  RES      0         PROCESS 1600 BPI REQUEST                            
         MTW,+00  D16HFLAG          IS DOUBLE DENSITY REQUESTED ?               
         BEZ      CPYMOD5             NO, SKIP ON                               
*                                                                               
         AND,R15  NF1B              YES, RESET 800 BPI FLAG                     
         OR,R15   F3B               AND SET 'BIN' TO GET IT                     
*                                                                               
CPYMOD5  RES      0         PROCESS 'BLKX' OPTIONS                              
         MTW,+00  BLKIFLAG,R1       IS BLOCKED ORG SPECIFIED ?                  
         BEZ      CPYMOD7             NO, DO NOT SET                            
*                                                                               
         OR,R15   F4B               YES, SET BLOCKED FLAG                       
*                                                                               
CPYMOD7  RES      0         PROCESS OTHER MODE BIT FLAGS FOR FPT                
*                                                                               
CPYMOD10 RES      0         PROCESS PARAMS TO FPT                               
         STW,R15  SETDCBAT+1        SET F-BITS IN FPT                           
         LI,R15   0                 INITIALIZE P-BIT OPTION FLAGS               
         LI,R4    2                 SET NEXT FREE WORD INDEX IN FPT             
         LW,R0    BLKIFLAG,R1       IS 'BLKX' SPECIFIED AT ALL ?                
         BEZ      CPYMOD15            NO, NO 'RSIZE' PARAM TO CAL               
*                                                                               
         CI,R0    -1                WAS A RECORD SIZE FORCED ?                  
         BE       CPYMOD15            NO, USE SIZE FROM FILE OR DEFAULT         
*                                                                               
         AND,R0   M16               EXTRACT OUT GIVEN SIZE                      
         STW,R0   *R3               AND SET AS BYTE COUNT TO READ/WRITE         
         STW,R0   SETDCBAT,R4       AND IN NEXT FPT ENTRY                       
         AI,R4    1                 STEP TO NEXT FREE ENTRY IN FPT              
         OR,R15   P1B               AND SET OPTION PRESENT IN FPT               
*                                                                               
CPYMOD15 RES      0         PROCESS 'ORG' OPTIONS                               
         LW,R0    ORGIFLAG,R1       IS 'ORG' OPTION PRESENT ?                   
         BEZ      CPYMOD20            NO, SKIP SETTING IN FPT                   
*                                                                               
         AI,R0    -1                ADJUST TO TRUE VALUE (0,1,2 = U,B,C)        
         STW,R0   SETDCBAT,R4       AND PUT IN FPT'S NEXT FREE WORD             
         AI,R4    1                 STEP TO NEW NEXT FREE WORD                  
         OR,R15   P2B               AND SET FPT WORD PRESENT                    
*                                                                               
CPYMOD20 RES      0         PROCESS 'BSIZE' ('GSIZE') OPTION                    
         LW,R0    BLKIFLAG,R1       IS ANY PARAM GIVEN ?                        
         BEZ      CPYMOD30            NO, END OF PARAMS                         
*                                                                               
         CI,R0    -1                WAS PARAM JUST 'BLKX' ?                     
         BE       CPYMOD25            YES, NO 'BSIZE' PARAM                     
*                                                                               
         LH,R0    R0                GET 'GSIZE' IF IT IS PRESENT                
         BEZ      CPYMOD25          IT IS ABSENT; SKIP OUT                      
*                                                                               
         STW,R0   SETDCBAT,R4       PRESENT: SET 'GSIZE' / 'BSIZE'              
         OR,R15   P3B               AND SET FPT PARAM PRESENT                   
*                                                                               
CPYMOD25 RES      0         SET SIZE OF BUFFER TO CLEAR IN DBL WORDS            
         LW,R0    *R3               GET READ/WRITE COUNT                        
         AI,R0    7                 ROUND UP                                    
         SLS,R0   -3                AND DIVIDE BY 8                             
         STW,R0   BLKIFLAG,R1       AND SET FOR COPY LOOP CLEAR                 
*                                                                               
CPYMOD30 RES      0         END OF OPTION PROCESSING; ISSUE CAL                 
         STB,R15  SETDCBAT+1        SET P-BITS                                  
         CAL1,1   CLOSEANY          CLOSE DCB SO CHANGES TAKE EFFECT            
         CAL1,1   SETDCBAT          AND SET CAL                                 
         B        *RLNK             AND RETURN ALL DONE                         
         PAGE                       ERROR PROCESSING AND MESSAGES               
         SPACE    1                 -----------------------------               
SEG3X02  EQU      ERROR02           USE COMMON ERROR ROUTINE IN ROOT1           
COPY150  EQU      ERROR02           DEFINE OLD ERROR 02 ROUTINE NAME            
*                                                                               
*                                                                               
SEG3X33  EQU      %         ERROR MESSAGE 33: ILLEGAL USE OF COPY               
COPY150A EQU      SEG3X33                                  (OLD NAME)           
         LI,R15   MESS33            SET MESSAGE, AND                            
         B        SEG3ERR           GO TO COMMON ERROR PROCESSING               
*                                                                               
*                                                                               
SEG3X18  EQU      %         ERROR MESSAGE 18: ILLEGAL OPTION YYY                
COPY151  EQU      SEG3X18                                  (OLD NAME)           
         STW,R2   MESS18+4          STORE OPTION KEYWORD IN MESSAGE             
         LI,R15   MESS18            POINT AT THE MESSAGE                        
         B        SEG3ERR           DO COMMON PROCESSING                        
*                                                                               
*                                                                               
SEG3X19  RES      0         ERROR MESSAGE 19: NOT ENUF BCKG SPACE               
         LI,R15   MESS19            SET MESSAGE ADDRESS                         
         B        SEG3ERR           DO COMMON PROCESSING                        
*                                                                               
*                                                                               
SEG3ERR  EQU      %         COMMON ERROR PROCESSOR FOR SEGMENT 3                
         CAL1,1   CLOSESI                                                       
         CAL1,1   CLOSESO                                                       
         B        ERROROUT          GO TO COMMON ERROR OUT IN ROOT1             
         PAGE                                                                   
         SPACE    2                                                             
CPYXNFIL EQU      %         'NFIL' IN ERROR                                     
         LW,R2    KWNFIL            GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
*                                                                               
*                                                                               
CPYXADD  EQU      %         'ADD'  IN ERROR                                     
         LW,R2    KWADD             GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
*                                                                               
CPYXASCI EQU      %         'ASCI' IN ERROR                                     
         LW,R2    KWASCI            GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
*                                                                               
CPYXASCO EQU      %         'ASCO' IN ERROR                                     
         LW,R2    KWASCO            GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
*                                                                               
CPYXBIN  EQU      %         'BIN' IN ERROR                                      
         LW,R2    KWBIN             GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
*                                                                               
CPYXCC   EQU      %         'CC'   IN ERROR                                     
         LW,R2    KWCC              GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
*                                                                               
CPYXD800 EQU      %         'D800'  OR 'D1600' IN ERROR                         
         LW,R2    KWD800            GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
CPYXFBCD EQU      %         'FBCD' IN ERROR                                     
         LW,R2    KWFBCD            GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
CPYXUPD  EQU      %         'UPD'  IN ERROR                                     
         LW,R2    KWUPD             GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
CPYXVFC  EQU      %         'VFC' IN ERROR                                      
         LW,R2    KWVFC             GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
CPYXBLKI RES      0         'BLKI' IN ERROR                                     
         LW,R2    KWBLKI            GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
CPYXBLKO RES      0         'BLKO' IN ERROR                                     
         LW,R2    KWBLKO            GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
CPYXORGI RES      0         'ORGI'  IN ERROR                                    
         LW,R2    KWORGI            GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
*                                                                               
CPYXORGO RES      0         'ORGO' IN ERROR                                     
         LW,R2    KWORGO            GET NAME OF OPTION IN ERROR                 
         B        SEG3X18           AND GO GIVE OPTION ERROR MESSAGE            
         PAGE              ERROR PROCESSING ROUTINES FOR COPY, SQUEEZE          
         SPACE    3                                                             
COPYERF  ERRP     X'03',ABN3        NONEXIST FILE: TEST IF IN SQUEEZE           
         ERRP     X'05',ABN5        !EOD:  FIGURE OUT WHERE AND WHY             
         ERRP     X'06',ABN6        EOF: TEST FOR LIB CLEAN-UP                  
         ERRP     X'07',ABN7        BUFFER LEN < DATA LEN:                      
         ERRP     X'0A',0           CLOSE A CLOSED DCB: IGNORE                  
         ERRP     X'1C',ABN10       EOT:                                        
         ERRP     X'2E',OPENERR     OPEN AN OPENED DCB: CLOSE, TRY AGAIN        
         ERRP     X'30',DEVINOP     DEVICE MANUAL: PERIODIC RETRY               
         ERRP     X'42',WPERR       WRITE PROTECT: TEST FOR OPER'S 'SY'         
         ERRP     X'00',ABNALL      ALL OTHERS: INSURE DCB'S CLOSED             
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
ABN3     RES      0         X'03' - FILE DOES NOT EXIST                         
         CI,R8    SQUEZ103+1        IS CAL FROM SQUEEZE ?                       
         BE       EXEC1               YES, IGNORE                               
*                                   NO-                                         
         CI,R8    COPY109Z+1        FROM GET FILENAME FOR 'IN', 'OUT' ?         
         BNE      ERROR06             NO, GO SAY 'FILE DOES NOT EXIST'          
*                                                                               
         LW,R2    KWIN              SET TO SAY ILLEGAL OPTION IN                
         MTW,+00  COPYFLAG          PROCESSING INPUT SPEC ?                     
         BLEZ     SEG3X18             YES, GO OUT MESSAGE                       
*                                                                               
         LW,R2    KWOUT             SET 'ILLEGAL OPTION OUT'                    
         B        SEG3X18           AND GO GIVE THE MESSAGE                     
*                                                                               
*                                                                               
ABN6     RES      0         X'06' - E-O-F OR BANG CARD FROM C DEVICE            
         B        ABN5AEOF                                                      
         PAGE                                                                   
         SPACE    2                                                             
ABN5     RES      0         X'05' - E-O-D, A !EOD HAS BEEN READ                 
         CI,R8    COPY72            IS IT IN COPY LOOP ?                        
         BNE      ABNALLX             NO, GIVE FATAL ERROR                      
*                                                                               
ABN5A    RES      0                                                             
         MTW,0    CCFLAG            IF !EOD ENCOUNTERED WHILE DOING A           
         BGZ      *R8                                   CC COPY, IGNORE.        
*                                                                               
ABN5AEOF RES      0         WRITE END-FILE; TEST NFIL COUNT FOR DONE            
         CAL1,1   WEOFSO            WRITE END OF FILE                           
         MTW,0    NFIL              ARE WE COPYING TO DOUBL                     
         BLZ      ABN5C             YES, BRANCH                                 
         MTW,-1   NFIL              NO, DECREMENT # OF FILE                     
         BGZ      COPY70            NOT DONE, RETURN TO COP                     
*                                                                               
ABN5B    RES      0         END OF COPY: RETURN TO COPY LOOP EXIT               
         B        *R14                                                          
*                                                                               
*                                                                               
*                                                                               
*   HERE WE ARE COPYING TO A DOUBLE EOF                                         
ABN5C    RES      0                                                             
         MTW,0    EODFLAG           WAS LAST RECORD = EOD                       
         BGZ      ABN5B             YES, WE ARE DONE                            
         MTW,1    EODFLAG           NO, SET 'EOD READ' FLAG                     
         B        COPY70            RETURN TO COPY ROUTINE                      
*                                                                               
*                                                                               
ABNALL   RES      0         ALL OTHER ERRORS: CLOSE ALL DCBS                    
         PUSH     16,R0             SAVE ALL REGS FOR ABNABORT                  
         LB,R0    R10               COPY & SAVE ERROR CODE                      
         LI,R2    F:SI              CLOSE ANY DCB'S WE HAVE                     
         CAL1,1   CLOSEANY                                                      
         LI,R2    F:SO                                                          
         CAL1,1   CLOSEANY                                                      
         LI,R2    F:BI                                                          
         CAL1,1   CLOSEANY                                                      
         PRNT                       SPACE A LINE BEFORE ERROR MSG               
         CI,R0    X'72'             WAS ERROR = DISC OVERFLOW ?                 
         BE       ERROR01             YES, GIVE THAT MSG EXPLICITLY.            
         PULL     16,R0             RESTORE REGS FOR CALL TO ABNABORT           
*                                                                               
*                                                                               
ABNALLX  RES      0                                                             
         PUSH     16,R0             SAVE REGS AS ABNABORT EXPECTS               
         B        ABNABORT                                                      
         PAGE                                                                   
         SPACE    2                                                             
ABN7     RES      0         X'07' - BUFFER SMALLER THAN DATA READ               
         MTW,+00  BLKIFLAG          IS INPUT BLOCKED ('BLKI') ?                 
         BNEZ     *R8                 YES, ALLOW THIS AS OK                     
*                                                                               
         CAL1,1   CLOSESI           CLOSE F:SI DCB                              
         CAL1,1   CLOSESO           CLOSE F:SO DCB                              
         B        ERROR28           GO OUT ERROR 'BUFFER SMALLER THAN DATA'     
*                                                                               
*                                                                               
ABN10    RES      0         X'1C' - E-O-T, END OF TAPE OR DISC FILE             
         CI,R8    COPY72A+1         WAS EOT ENCOUNTERED IN COPY ?               
         BE       ABN10A              YES, CLEAN UP DCBS                        
         CI,R8    COPY72            WAS EOT ON INPUT FILE ?                     
         BE       ABN5A               YES, PROCESS AS AN EOD                    
*                                                                               
         B        ABN10B            ELSE JUST GIVE ERROR                        
*                                                                               
*                                                                               
ABN10A   RES      0                                                             
         PUSH     R10               SAVE R10 IN CASE ERRORS IN CLOSES           
         CAL1,1   CLOSESI           YES. CLOSE F:SI DCB                         
         CAL1,1   CLOSESO                CLOSE F:SO DCB                         
         PULL     R10               RECOVER R10 FOR ERROR MESSAGE               
ABN10B   RES      0                                                             
         B        ERROR35           GO OUT 'EOT ON XXXXXXXX' ERROR              
         PAGE                                                                   
****************                                                                
*   EBTOASCI   *                                                                
****************                                                                
*   ASCITOEB   *                                                                
****************                                                                
*                                                                               
*                                                                               
*   EBTOASCI ---  CONVERTS THE SPCECIFIED BYTE STRING FROM EBCDIC               
*                 TO ASCII.                                                     
*                                                                               
*   ASCITOEB ---  CONVERTS THE SPECIFIED BYTE STRING FROM ASCII                 
*                 TO EBCDIC.                                                    
*                                                                               
*   THE BYTE STRING TO BE CONVERTED IS IN SIBUFF.                               
*   THE NUMBER OF BYTES TO CONVERT IS IN SIBCNT.                                
*                                                                               
*   AT ENTRY:   R8   LINK                                                       
*   REGISTERS USED:   R0,R8                                                     
*                                                                               
*                                                                               
EBTOASCI RES      0                 CONVERT EBCDIC TO ASCII                     
         LI,R0    T:ASCII           ADDRESS OF CONVERSION TABLE                 
         B        CONV1                                                         
ASCITOEB RES      0                 CONVERT ASCII TO EBCDIC                     
         LI,R0    T:EBCDIC          ADDRESS OF CONVERSION TABLE                 
CONV1    RES      0                                                             
         PUSH     3,R1              SAVE WORKING REGS                           
         LW,R1    SICOMPL           GET COMPL STATUS WORD                       
         AND,R1   M17               R1= ACTUAL RECORD SIZE (BYTES)              
         LW,R2    SIBUFF            BUFFER ADDRESS                              
         SLS,R2   2                 BYTE ADDR OF BUFFER                         
CONV2    RES      0                                                             
         LB,R3    0,R2              GET CHARACTER FROM BUFFER                   
         LB,R3    *R0,R3            GET CONVERTED CHARACTER FROM TABLE          
         STB,R3   0,R2              STORE CONVERTED CHARACTER                   
         AI,R2    1                 INCR. BUFFER POINTER                        
         BDR,R1   CONV2                                                         
         PULL     3,R1              RECOVER WORK REGS                           
         B        *R8               RETURN                                      
         PAGE                                                                   
*                                                                               
*   EBCDIC TO ASCII CONVERSION TABLE                                            
*                                                                               
*   AN ASCII CHARACTER IS OBTAINED BY ACCESSING THE TABLE WITH                  
*    AN EBCDIC CHARACTER FROM 0 TO FF AS AN INDEX.                              
*                                                                               
T:ASCII  RES      0                                                             
         DATA,1   X'00',X'01',X'02',X'03',X'9C',X'09',X'86'                     
         DATA,1   X'7F',X'97',X'8D',X'8E',X'0B',X'0C',X'0D'                     
         DATA,1   X'0E',X'0F',X'10',X'11',X'12',X'13',X'9D'                     
         DATA,1   X'85',X'08',X'87',X'18',X'19',X'92',X'8F'                     
         DATA,1   X'1C',X'1D',X'1E',X'1F',X'80',X'81'                           
         DATA,1   X'82',X'83',X'84',X'0A',X'17',X'1B',X'88'                     
         DATA,1   X'89',X'8A',X'8B',X'8C',X'05',X'06',X'07'                     
         DATA,1   X'90',X'91',X'16',X'93',X'94',X'95',X'96'                     
         DATA,1   X'04',X'98',X'99',X'9A',X'9B',X'14',X'15'                     
         DATA,1   X'9E',X'1A',X'20',X'A0',X'A1',X'A2',X'A3'                     
         DATA,1   X'A4',X'A5',X'A6',X'A7',X'A8',X'5B',X'2E',X'3C'               
         DATA,1   X'28',X'2B',X'21',X'26',X'A9',X'AA',X'AB',X'AC'               
         DATA,1   X'AD',X'AE',X'AF',X'B0',X'B1',X'5D',X'24',X'2A'               
         DATA,1   X'29',X'3B',X'5E',X'2D',X'2F',X'B2',X'B3'                     
         DATA,1   X'B4',X'B5',X'B6',X'B7',X'B8',X'B9',X'7C'                     
         DATA,1   X'2C',X'25',X'5F',X'3E',X'3F',X'BA',X'BB'                     
         DATA,1   X'BC',X'BD',X'BE',X'BF',X'C0',X'C1'                           
         DATA,1   X'C2',X'60',X'3A',X'23',X'40',X'27',X'3D'                     
         DATA,1   X'22',X'C3',X'61',X'62',X'63',X'64',X'65'                     
         DATA,1   X'66',X'67',X'68',X'69',X'C4',X'C5',X'C6'                     
         DATA,1   X'C7',X'C8',X'C9',X'CA',X'6A',X'6B'                           
         DATA,1   X'6C',X'6D',X'6E',X'6F',X'70',X'71',X'72'                     
         DATA,1   X'CB',X'CC',X'CD',X'CE',X'CF',X'D0',X'D1'                     
         DATA,1   X'7E',X'73',X'74',X'75',X'76',X'77',X'78',X'79'               
         DATA,1   X'7A',X'D2',X'D3',X'D4',X'D5',X'D6',X'D7'                     
         DATA,1   X'D8',X'D9',X'DA',X'DB',X'DC',X'DD',X'DE',X'DF'               
         DATA,1   X'E0',X'E1',X'E2',X'E3',X'E4',X'E5',X'E6'                     
         DATA,1   X'E7',X'7B',X'41',X'42',X'43',X'44',X'45'                     
         DATA,1   X'46',X'47',X'48',X'49',X'E8',X'E9',X'EA'                     
         DATA,1   X'EB',X'EC',X'ED',X'7D',X'4A',X'4B',X'4C'                     
         DATA,1   X'4D',X'4E',X'4F',X'50',X'51',X'52',X'EE'                     
         DATA,1   X'EF',X'F0',X'F1',X'F2',X'F3',X'5C',X'9F'                     
         DATA,1   X'53',X'54',X'55',X'56',X'57',X'58',X'59'                     
         DATA,1   X'5A',X'F4',X'F5',X'F6',X'F7',X'F8',X'F9'                     
         DATA,1   X'30',X'31',X'32',X'33',X'34',X'35',X'36',X'37'               
         DATA,1   X'38',X'39',X'FA',X'FB',X'FC',X'FD',X'FE',X'FF'               
         BOUND    4                                                             
         PAGE                                                                   
*                                                                               
*   ASCII TO EBCDIC CONVERSION TABLE                                            
*                                                                               
*   AN EBCDIC CHARACTER IS OBTAINED BY ACCESSING THE TABLE WITH                 
*     AN ASCII CHARACTER FROM 0 TO FF AS AN INDEX.                              
*                                                                               
T:EBCDIC RES      0                                                             
         DATA,1   X'00',X'01',X'02',X'03',X'37',X'2D',X'2E'                     
         DATA,1   X'2F',X'16',X'05',X'25',X'0B',X'0C',X'0D'                     
         DATA,1   X'0E',X'0F',X'10',X'11',X'12',X'13'                           
         DATA,1   X'3C',X'3D',X'32',X'26',X'18',X'19',X'3F'                     
         DATA,1   X'27',X'1C',X'1D',X'1E',X'1F',X'40',X'4F'                     
         DATA,1   X'7F',X'7B',X'5B',X'6C',X'50',X'7D',X'4D'                     
         DATA,1   X'5D',X'5C',X'4E',X'6B',X'60',X'4B',X'61'                     
         DATA,1   X'F0',X'F1',X'F2',X'F3',X'F4',X'F5',X'F6'                     
         DATA,1   X'F7',X'F8',X'F9',X'7A',X'5E',X'4C',X'7E'                     
         DATA,1   X'6E',X'6F',X'7C',X'C1',X'C2',X'C3',X'C4'                     
         DATA,1   X'C5',X'C6',X'C7',X'C8',X'C9',X'D1',X'D2'                     
         DATA,1   X'D3',X'D4',X'D5',X'D6',X'D7',X'D8',X'D9'                     
         DATA,1   X'E2',X'E3',X'E4',X'E5',X'E6',X'E7',X'E8'                     
         DATA,1   X'E9',X'4A',X'E0',X'5A',X'5F',X'6D',X'79'                     
         DATA,1   X'81',X'82',X'83',X'84',X'85',X'86',X'87'                     
         DATA,1   X'88',X'89',X'91',X'92',X'93',X'94',X'95'                     
         DATA,1   X'96',X'97',X'98',X'99',X'A2',X'A3',X'A4'                     
         DATA,1   X'A5',X'A6',X'A7',X'A8',X'A9',X'C0',X'6A'                     
         DATA,1   X'D0',X'A1',X'07',X'20',X'21',X'22',X'23'                     
         DATA,1   X'24',X'15',X'06',X'17',X'28',X'29',X'2A'                     
         DATA,1   X'2B',X'2C',X'09',X'0A',X'1B',X'30',X'31'                     
         DATA,1   X'1A',X'33',X'34',X'35',X'36',X'08',X'38'                     
         DATA,1   X'39',X'3A',X'3B',X'04',X'14',X'3E',X'E1'                     
         DATA,1   X'41',X'42',X'43',X'44',X'45',X'46',X'47'                     
         DATA,1   X'48',X'49',X'51',X'52',X'53',X'54',X'55'                     
         DATA,1   X'56',X'57',X'58',X'59',X'62',X'63',X'64'                     
         DATA,1   X'65',X'66',X'67',X'68',X'69',X'70',X'71',X'72'               
         DATA,1   X'73',X'74',X'75',X'76',X'77',X'78',X'80'                     
         DATA,1   X'8A',X'8B',X'8C',X'8D',X'8E',X'8F',X'90'                     
         DATA,1   X'9A',X'9B',X'9C',X'9D',X'9E',X'9F',X'A0'                     
         DATA,1   X'AA',X'AB',X'AC',X'AD',X'AE',X'AF',X'B0'                     
         DATA,1   X'B1',X'B2',X'B3',X'B4',X'B5',X'B6',X'B7'                     
         DATA,1   X'B8',X'B9',X'BA',X'BB',X'BC',X'BD',X'BE'                     
         DATA,1   X'BF',X'CA',X'CB',X'CC',X'CD',X'CE',X'CF'                     
         DATA,1   X'DA',X'DB',X'DC',X'DD',X'DE',X'DF'                           
         DATA,1   X'EA',X'EB',X'EC',X'ED',X'EE',X'EF',X'FA'                     
         DATA,1   X'FB',X'FC',X'FD',X'FE',X'FF'                                 
         PAGE                                                                   
******** CNVRT ********                                                         
*                                                                               
*        INPUT    BYTES TO BE CONVERTED IN INPUT BUFFER (SIBUFF)                
*                 BYTE COUNT FROM FPT (SIBCNT)                                  
*                                                                               
*        OUTPUT   BCD OR EBCDIC IN INPUT BUFFER                                 
*                                                                               
*        FUNCTION CONVERTS BCD-EBCDIC OR EBCDIC TO BCD                          
*                                                                               
*        CALL     BAL,LINK  BCDTOEBC                                            
*                 BAL,LINK  EBCTOBCD                                            
*                                                                               
*                                                                               
BCDTOEBC RES      0                 BCD TO EBCDIC                               
         PUSH     8,R0              SAVE R0-R7                                  
         LI,R3    BCDTABLE          CONVERT BCD TO EBCDIC                       
         LI,R4    EBCTABLE                                                      
CNV      LW,R1    SIBUFF            GET BUFFER ADDR. (BA)                       
         SLS,R1   2                                                             
         LW,R2    SICOMPL           GET COMPLETION STATUS W                     
         AND,R2   M17               R2= ACTUAL RECORD SIZE                      
         INT,R6   LIMITS                                                        
CNVLOOP  RES      0                                                             
         LB,R0    0,R1                                                          
         CLR,R6   R0                                                            
         BCS,6    NOCNV                                                         
         LI,R5    11                SET NUM OF DIFFERENT CHARS TO TEST          
*                                                                               
CNVLOOP1 RES      0         TEST IF CHAR IN R0 IS A BCD (EBCDIC)                
         CB,R0    *R3,R5            IS IT A BCD (EBCDIC) CHARACTER ?            
         BE       CNVLOOP2            YES, CONVERT IT                           
         BDR,R5   CNVLOOP1           NO, TEST ALL POSSIBILITIES                 
         B        NOCNV             NOT BCD (EBCDIC) - DO NOT CONVERT           
*                                                                               
CNVLOOP2 RES      0         CONVERT BCD (EBCDIC) CHARACTER TO EBCDIC (BCD)      
         LB,R0    *R4,R5            GET CONVERTED CHARACTER                     
         STB,R0   0,R1              PUT AWAY IN CONVERTED IMAGE                 
NOCNV    AI,R1    1                                                             
         BDR,R2   CNVLOOP                                                       
         PULL     8,R0              RESTORE R0-R7                               
         B        *LINK                                                         
*                                                                               
*                                                                               
*####    THIS ROUTINE IS NOT CURRENTLY REFERENCED     #####************         
EBCTOBCD RES      0                 EBCDIC TO BCD                               
         PUSH     0,R0              SAVE R0-R7                                  
         LI,R3    EBCTABLE          CONVERT EBCDIC TO BCD                       
         LI,R4    BCDTABLE                                                      
         B        CNV                                                           
*                                                                               
*                                                                               
BCDTABLE DATA,1   0,X'4A',X'4C',X'4E',X'50',X'6C',X'7B',X'7C',X'7D'             
         DATA,1   X'7E',X'C0',X'D0'                                             
         BOUND    4                                                             
EBCTABLE DATA,1   0,X'6F',X'5D',X'4C',X'4E',X'4D',X'7E',X'7D',X'7A'             
         DATA,1   X'6E',X'6F',X'5A'                                             
         BOUND    4                                                             
LIMITS   DATA,2   X'4A',X'D0'                                                   
         PAGE                                                                   
******** SUBROUTINE  SCNMOD  ********                                           
*                                                                               
*        INPUT    EBDICSZE= EBCDIC FILE SIZE (BYTES)                            
*                 DREFSZE=  DEFREF FILE SIZE (BYTES)                            
*                 MODIRSZE= MODIR  FILE SIZE (BYTES)                            
*                 BCKSZE=   SIZE OF BCKGRND BUFFER (BYTES)                      
*                 EBCDIC,DEFREF FILES IN BCKGRND BUFFER                         
*                 F:BI SETUP                                                    
*                                                                               
*        OUTPUT   ROM TO MODULE FILE                                            
*                 DEFS AND REFS TO EBCDIC FILE                                  
*                 ENTRIES  TO DEFREF FILE FOR ROM                               
*                 MFENTRY= MODULE FILE ENTRY                                    
*                 EBDBYTES= NO. OF EBCDIC BYTES ADDED FOR ROM                   
*                 MODBYTES= NO. OF MODIR BYTES ADDED FOR ROM                    
*                 DRFHWDS=  NO. OF DEFREF FILE HWDS ADDED FOR ROM               
*                                                                               
*        FUNCTION READS ROMS SEARCHING FOR REFS AND DEFS, ADDS ANY NEW          
*                 REFS TO EBCDIC FILE (ALL DEFS), BUILDS DEFREF FILE            
*                 ENTRY, MODULE FILE ENTRY FOR ROM.                             
*        CALL     BAL,LINK  SCNMOD                                              
*                                                                               
*        SUBROUTINES USED  RDWRTE,BINDEC,SCNMOD20,FNDREF,BLDDRF,BLDEBD          
*                                                                               
*        REGISTERS USED                                                         
*                                                                               
SCNMOD   RES      0                                                             
         STW,LINK LINKSAVE                                                      
         LW,R2    MODULSZE          SET START RECORD FOR NEW ROM                
         SLS,R2   16                                                            
         STW,R2   MFENTRY                                                       
*                                                                               
         LW,R1    BLNK              SET FIRST DEF NAME TO BLANKS                
         STW,R1   MFENTRY+1                                                     
         STW,R1   MFENTRY+2                                                     
*                                                                               
         LW,R1    EBDBA             SET STARTING BYTE ADDRESS OF 1ST            
         SW,R1    EBDICSZE          ENTRY OF NEXT ROM                           
         STW,R1   CRNTEBD                                                       
         STW,R1   FBAEBC            STARTING BYTE ADDR FOR THIS ROM             
*                                                                               
         LI,R1    0                                                             
         STW,R1   EBDBYTES                                                      
         STW,R1   MODBYTES                                                      
         STW,R1   DRFHWDS                                                       
         STW,R1   SKIPCKS             RESET CKSUM AND SEQ. CHECKING FLAG        
         STW,R1   NMENOS                                                        
         STW,R1   NDEFS                                                         
         STW,R1   DUPDEF                                                        
*                                                                               
         BAL,LINK RDWRTE            READ ROM RECORD                             
         LI,R1    3                                                             
         LB,R2    *R12,R1           GET INDEX OF LAST BYTE                      
         AI,R2    -1                                                            
         AI,R1    1                                                             
*                                                                               
SCNMOD2  RES      0                                                             
         LB,R3    *R12,R1           GET CONTROL BYTE                            
         CI,R3    X'13'             IS IT EQUAL TO TABLE1 LOAD ITEM             
         BLE      TABLE1,R3                                                     
*                                                                               
         CI,R3    X'20'                                                         
         BL       SCNMOD17          LOAD ITEM ERROR                             
         CI,R3    X'3B'             IS IT EQUAL TO TABLE2 LOAD ITEM             
         BG       SCNMOD5                                                       
         SLS,R3   -2                RIGHT-ALIGN INDEX                           
         AND,R3   M3                GET INDEX                                   
         B        TABLE2,R3                                                     
*                                                                               
SCNMOD5  RES      0                                                             
         CI,R3    X'40'                                                         
         BL       SCNMOD17          LOAD ITEM ERROR                             
         CI,R3    X'4F'                                                         
         BG       SCNMOD15                                                      
         LW,R4    M4                LOAD ABSOLUTE                               
         AND,R4   R3                MASK OFF BYTES TO SKIP                      
         BNEZ     SCNMOD10                                                      
         LI,R4    16                16 BYTES IMPLIED IF ZERO                    
SCNMOD10 RES      0                                                             
         AI,R4    1                                                             
         B        SCNX                                                          
*                                                                               
SCNMOD15 RES      0                                                             
         CI,R3    X'80'             LOAD RELOC. SHORT                           
         BANZ     SCN5              YES                                         
*                                                                               
         CI,R3    X'60'             LOAD RELOC. LONG                            
         BGE      SCNMOD17                                                      
         LI,R4    6                                                             
         CI,R3    X'8'                                                          
         BANZ     SCNX                                                          
*                                                                               
         LI,R4    7                                                             
         B        SCNX                                                          
*                                                                               
SCNMOD17 RES      0                                                             
*                                                                               
         LW,R15   R3                ILLEGAL LOAD ITEM                           
         STRNG    MESS37            OUT 'ILLEGAL LOAD ITEM '                    
         INTGR    DEC,ZERO,2        AND WHAT THAT ITEM IS                       
         B        SCNMOD75          THEN OUT ROM NAME, SKIP TO ROM END          
         PAGE                                                                   
* CHECK IF DESIRED NO. BYTES AVAILABLE. READ NEXT ROM RECORD IF NOT.            
*        CALL    BAL,XLNK   SCNMOD20                                            
*        USES R2,R7,R13                                                         
SCNMOD20 RES      0                                                             
         LW,R7    R1                SUFF. NO. IN CURRENT BUFFER                 
         AW,R7    R4                                                            
         CW,R7    R2                                                            
         BLE      *XLNK             YES.                                        
         SW,R7    R2                NO. GET NEXT RECORD                         
         AI,R7    -1                                                            
         CI,R7    0                                                             
         BNE      SCNMOD27                                                      
         CI,R13   1                 LAST RECORD FLAG SET                        
         BNE      SCNMOD27                                                      
         LI,R13   -1                SET LAST BYTE OF MODULE FLAG.               
         B        *XLNK                                                         
SCNMOD27 RES      0                                                             
         AI,R7    1                                                             
         STW,XLNK  TEMPSAVE                                                     
         BAL,LINK RDWRTE1           GET NEXT RECORD.                            
         LI,R2    3                                                             
         LB,R2    *R12,R2                                                       
         AI,R2    -1                                                            
         AI,R7    3                 SET PNTR TO 1ST BYTE NEXT ITEM.             
         CI,R2    4                 IS THERE 1 BYTE ON CARD                     
         BNE      *TEMPSAVE         NO                                          
         CI,R13   1                 IS IT LAST CARD                             
         BNE      *TEMPSAVE         NO,EXIT                                     
         LI,R13   -1                SET LAST BYTE OF MODULE FLAG                
         B        *TEMPSAVE                                                     
         PAGE                                                                   
*BRANCH TABLES                                                                  
*                                                                               
TABLE1   B        SCN1              PADDING                                     
         B        SCN5              ADD CONSTANT                                
         B        SCN1              EXPRESSION END                              
         B        SCNDEF            DECLARE EXTERNAL DEFINITION NAME            
         B        SCN1              ORIGIN                                      
         B        SCNPREF           DECLARE PRIMARY REFERENCE NAME              
         B        SCNDSREF          DECLARE SECONDARY REFERENCE NAME            
         B        SCN3                DEFINE FIELD                              
         B        SCN3              DEFINE FORWARD REFERENCE                    
         B        SCN5OR6           DECLARE DUMMY SECTION                       
         B        SCN2OR3           DEFINE EXTERNAL DEFINITION                  
         B        SCN4              DECLARE STANTARD CONTROL SECTION            
         B        SCN4              DECLARE NON-STANDARD CONTROL SECTION        
         B        SCN1              DEFINE START                                
         B        SCN2              MODULE END                                  
         B        SCN3              REPEAT LOAD                                 
         B        SCN3              DEFINE FORWARD REF AND HOLD                 
         B        SCN2OR3           DEBUG TYPE                                  
         B        SCNDINT           DEBUG INTEGER                               
         B        SCNDSYM           DEBUG SYMBOL                                
*                                                                               
TABLE2   B        SCN2OR3           ADD VALUE OF DECLARATION                    
         B        SCN3              ADD VALUE OF FORWARD REFERENCE              
*                                                                               
         B        SCN2OR3           SUBTRACT VALUE OF DECLARATION               
         B        SCN3              SUBTRACT VALUE OF FORWARD REFERENCE         
         B        SCN1              CHANGE EXPRESSION VALUE                     
         B        SCN1              ADD ABSOLUTE SECTION                        
         B        SCN1              SUBTRACT ABSOLUTE SECTION                   
         PAGE                                                                   
SCN1     LI,R4    1                                                             
         B        SCNX                                                          
*                                                                               
SCN2     LI,R4    2                                                             
         B        SCNX                                                          
SCN3     LI,R4    3                                                             
         B        SCNX                                                          
*                                                                               
SCN4     LI,R4    4                                                             
         CI,R3    12                CHECK IF NON-STANDARD                       
*                                    CONTROL SECTION                            
         BNE      SCNX                                                          
*                                                                               
         LI,R8    -1                                                            
         BAL,XLNK  BLDDRF           BUILD ZERO ENTRY                            
         MTW,1    NMENOS            INCR. NAME NO. COUNT                        
         B        SCNX                                                          
*                                                                               
SCN5     LI,R4    5                                                             
         B        SCNX                                                          
*                                                                               
SCN2OR3  LI,R4    1                                                             
         BAL,XLNK  SCNMOD20                                                     
         LW,R1    R7                                                            
         LW,R3    NMENOS            SKIP 3 IF NAME NOS. => 256                  
         CI,R3    256                                                           
         BL       %+2                                                           
         LI,R4    2                                                             
         B        SCNX                                                          
*                                                                               
SCN5OR6  LI,R4    1                                                             
         BAL,XLNK  SCNMOD20                                                     
         LW,R1    R7                                                            
         LI,R4    4                 SKIP 6 IF NAME NO. =>256                    
         LW,R3    NMENOS                                                        
         LB,R15   *R12,R1           GET 1ST BYTE OF NAME NO.                    
         CI,R3    256               IS NAME NO. 2 BYTES LONG                    
         BL       SCN5OR6A          NO                                          
         LI,R4    5                 YES                                         
         SLS,R15   8                GET 2ND BYTE                                
         AI,R1    1                                                             
         LB,R3    *R12,R1                                                       
         OR,R15   R3                R15=NAME NO. OF DEF TO BE CHANGED           
*   CHANGE DEF ENTRY TO A DSECT ENTRY                                           
*                                                                               
SCN5OR6A LW,R3    DREFSZE           R3=SIZE OF DEFREF IN BYTES                  
         SLS,R3   -1                CHANGE TO HALFWORDS                         
         AW,R3    R15                                                           
         AI,R3    1                 ENTRY TO CHANGE                             
         LH,R1    *BPEND,R3         R1=DEFREF IN BYTES                          
         CI,R1    X'4000'           MAKE SURE IT IS A DEF                       
         BANZ     %+2                                                           
         CAL1,9   3                 ABORT, SHOULDNT GET HERE                    
         OR,R1    LIBREFF            CONVERT TO A DSECT                         
         STH,R1   *BPEND,R3                                                     
         LW,R1    R7                RESTORE R1                                  
         LI,R8    -1                                                            
         BAL,XLNK  BLDDRF           BUILD ZERO ENTRY                            
         MTW,1    NMENOS            INCR. NAME NO. COUNT                        
         B        SCNX                                                          
*                                                                               
SCNDINT  LI,R4    2                                                             
         BAL,XLNK  SCNMOD20                                                     
         LW,R1    R7                                                            
         LB,R4    *R12,R1                                                       
         AI,R4    1                                                             
         B        SCNX                                                          
*                                                                               
SCNDSYM  LI,R4    1                                                             
         BAL,XLNK  SCNMOD20                                                     
         LW,R1    R7                                                            
         LB,R4    *R12,R1                                                       
         AI,R4    3                                                             
         B        SCNX                                                          
*                                                                               
SCNDSREF RES      0                                                             
         LI,R8    -1                                                            
         BAL,XLNK  BLDDRF           BUILD ZERO ENTRY                            
         MTW,1    NMENOS            INCR. NAME NO. COUNT                        
         LI,R4    1                                                             
         BAL,XLNK  SCNMOD20         SREF SKIP K BYTES                           
         LW,R1    R7                                                            
         LB,R4    *R12,R1                                                       
         AI,R4    1                                                             
SCNX     BAL,XLNK  SCNMOD20                                                     
         B        SCNMOD45                                                      
*                                                                               
SCNDEF   RES      0                                                             
         MTW,1    NMENOS            INCR NAME NO. COUNT                         
         MTW,1    NDEFS             INCR. NUMBER OF DEFS                        
         BAL,XLNK  BLDEBD           BUILD EBCDIC FILE                           
         CI,R11   -1                ERROR. SKIP TO END OF ROM                   
         BE       SCNMOD75                                                      
*                                                                               
         BAL,XLNK  FNDREF           CHECK FOR DUPLICATE DEFS                    
         CI,R11   0                                                             
         BE       SCNDEF5           NAME DOES NOT EXIST                         
         LB,R5    R11                                                           
         CI,R5    X'C0'             IS THE DUPLICATE A DSECT                    
         BNE      %+3               NO                                          
         MTW,1    DUPDEF            YES,SET FLAG AND DO NOT ABORT SINCE         
*                                    PRESENT ENTRY MAY BE A DSECT ALSO          
         B        SCNDEF5                                                       
         CI,R5    X'80'             IS THE DUPLICATE A DEF                      
         BE       SCNMOD60          YES                                         
         B        SCNDEF6           NO, MUST BE A REF                           
*                                                                               
SCNDEF5  RES      0                                                             
         LW,R11   CRNTEBD                                                       
         LW,R4    CRNTEBD           UPDATE EBCDIC FILE BYTE COUNT FOR           
         LB,R5    0,R4                                 THIS ROM.                
         AWM,R5   EBDBYTES          UPDATE BYTES IN THIS PART                   
         LCW,R5   R5                                                            
         AWM,R5   CRNTEBD           UPDATE POINTER TO NEXT ENTRY                
*                                                                               
SCNDEF6  LW,R5    MFENTRY+1         DEF NAME TO MODIR FILE IF 1ST               
         CW,R5    BLNK                                     FOR MODULE.          
         BNE      SCNDEF9                                                       
         LW,R4    R11                                                           
         LB,R5    0,R4                                                          
         AI,R5    -1                                                            
         CI,R5    8                                                             
         BLE      %+2                                                           
         LI,R5    8                                                             
         LI,R6    0                                                             
SCNDEF7  RES      0                                                             
         AI,R4    -1                                                            
         LB,R10   0,R4                                                          
         STB,R10  MFENTRY+1,R6                                                  
         AI,R6    1                                                             
         BDR,R5   SCNDEF7                                                       
SCNDEF9  RES      0                                                             
         LI,R5    12                UPDATE MODIR FILE BYTE COUNT FOR            
         STW,R5   MODBYTES                            THIS MODULE.              
*                                                                               
         LI,R8    0                                                             
         AND,R11  M19               MASK OUT BA OF EBCDIC ENTRY                 
         BAL,XLNK  BLDDRF           BUILD DEFREF FILE ENTRY                     
         CI,R11   -1                                                            
         BE       SCNMOD75                                                      
         B        SCNMOD46                                                      
*                                                                               
SCNPREF  RES      0                                                             
         MTW,1    NMENOS            INCR. NAME NO. COUNT                        
         BAL,XLNK  BLDEBD           BUILD EBCDIC FILE                           
         CI,R11   -1                                                            
         BE       SCNMOD75          ERROR. SKIP TO END OF MODULE.               
*                                                                               
         BAL,XLNK  FNDREF           CHECK IF REF PREVIOUSLY ENTERED IN          
         CI,R11   0                                       EBCDIC FILE.          
         BNE      SCNPREF2          NAME ALREADY EXISTS                         
         LW,R11   CRNTEBD                                                       
         LW,R4    CRNTEBD           IT ISNT. UPDATE EBCDIC FILE BYTE FOR        
         LB,R5    0,R4                                         THIS ROM.        
         AWM,R5   EBDBYTES          UPDATE BYTE COUNT                           
         LCW,R5   R5                                                            
         AWM,R5   CRNTEBD           STEP ENTRY POINTER                          
SCNPREF2 RES      0                                                             
         LI,R8    1                 BUILD DEFREF FILE ENTRY.                    
         AND,R11  M19               MASK OUT BA OF EBCDIC ENTRY                 
         BAL,XLNK  BLDDRF                                                       
         CI,R11   -1                                                            
         BE       SCNMOD75                                                      
         B        SCNMOD46                                                      
         PAGE                                                                   
SCNMOD40 RES      0                                                             
         LW,R15   BPEND             WORD ADDR OF DEFREF                         
         SLS,R15   1                HW ADDR OF DEFREF                           
         LW,R2    DREFSZE           SIZE OF CURRENT DEFREF                      
         SLS,R2   -1                CONVERT TO HWDS                             
         AW,R2    R15                                                           
*        R2 POINTS TO ENTRY 0 OF DEFREF FILE FOR THIS ROM                       
         LW,R1    R2                                                            
         AI,R2    2                 FIRST TRUE ENTRY                            
         LW,R6    DRFHWDS                                                       
         AI,R6    -2                # OF ENTRIES ADDED                          
SCNMOD41 RES      0                                                             
         LH,R11   0,R2              GET NEXT ENTRY                              
         BNEZ     SCNMOD44                                                      
*                                                                               
*        HAVE AN ENTRY TO REMOVE                                                
*        SCRUNCH THE FILE AND DECREMENT # OF ENTRIES ADDED                      
         LW,R5    R6                                                            
         AI,R5    -1                NO. OF ENTRIES TO MOVE                      
         BEZ      SCNMOD43          B IF NONE TO MOVE                           
         LW,R3    R2                                                            
         LW,R4    R2                                                            
         AI,R4    1                                                             
SCNMOD42 LH,R11   0,R4              MOVE THE ENTRY                              
         STH,R11  0,R3                                                          
         AI,R3    1                                                             
         AI,R4    1                                                             
         BDR,R5   SCNMOD42                                                      
SCNMOD43 MTH,-1   0,R1              DECR # OF ENTRIES                           
         MTW,-1   DRFHWDS                                                       
         B        %+2                                                           
*                                                                               
SCNMOD44 AI,R2    1                                                             
         BDR,R6   SCNMOD41                                                      
         B        SCNMOD47                                                      
*                                                                               
SCNMOD45 RES      0                                                             
         LW,R1    R7                                                            
SCNMOD46 RES      0                                                             
         CI,R13   -1                IS IT END OF ROM                            
         BNE      SCNMOD2           NO                                          
*                                                                               
         LW,R2    BLNK              YES. CHECK IF AT LEAST ONE DEF IN           
         CW,R2    MFENTRY+1                                      ROM.           
         BNE      SCNMOD40                                                      
         STRNG    MESS38            ENTER ERROR MESSAGE                         
         B        SCNMOD80                                                      
*                                   RE-ARRANGE DEFREF ENTRIES FOR THIS          
SCNMOD47 RES      0                    ROM SO THAT ALL DEFS/DSECTS WILL         
         LW,R6    DREFSZE              PRECEDE THE REFS.                        
         SLS,R6   -1                                                            
         AI,R6    2                 R6=INDEX TO 1ST ENTRY IN DEFREF             
         LW,R2    DRFHWDS              FOR THIS ROM.                            
         AI,R2    -2                                                            
         LW,R5    R2                R5= # DEFREF ENTRIES FOR THIS ROM           
         AW,R2    R6                                                            
         AI,R2    -1                                                            
         STW,R2   TEMP1             TEMP1=INDEX TO LAST ENTRY IN DEFREF         
         LW,R2    NDEFS             NO. DEFS AND DSECTS IN THIS ROM             
SCNMD47A LH,R7    *BPEND,R6         R7= 1ST/NEXT ENTRY IN DEFREF                
         CI,R7    X'4000'           IS IT A DEF OR DSECT                        
         BAZ      SCNMD47C          B IF ENTRY IS A REF                         
         AI,R6    1                 YES, DON'T MOVE ANY ENTRIES                 
         AI,R5    -1                                                            
         BDR,R2   SCNMD47A                                                      
         B        SCNMD47E          DONE WITH THIS ROM                          
*                                   ARRANGE DEFREF SO THAT DEFS AND             
SCNMD47C STW,R5   TEMP1A               DSECTS ARE FIRST                         
         LW,R4    TEMP1             R4 POINTS TO LAST ENTRY IN DEFREF           
SCNMD47D LH,R11   *BPEND,R4                                                     
         STH,R7   *BPEND,R4                                                     
         AI,R4    -1                                                            
         LW,R7    R11                                                           
         BDR,R5   SCNMD47D                                                      
         LW,R5    TEMP1A                                                        
         B        SCNMD47A                                                      
*                                                                               
SCNMD47E RES      0                                                             
         MTW,0    DUPDEF            WERE DUPL. DEFS FOUND                       
         BEZ      SCNMOD51          NO                                          
*                                   YES,CHECK TO SEE IF THEY WERE               
*                                    CHANGED TO DSECTS(DUPL DSECT IS OK)        
         LW,R11   CRNTEBD           R11=NEXT AVAILABLE BYTE ADDRESS             
         STW,R11  LBAEBC                FOR AN EBCDIC FILE ENTRY                
         LW,R11   FBAEBC            R11=BYTE ADDRESS OF FIRST ENTRY             
         STW,R11  CRNTEBD               IN EBCDIC FILE FOR THIS ROM             
*                                  CHECK ALL NEW ENTRIES IN EBCDIC              
*                                     FILE TO SEE IF A DUPLICATE                
*                                     DEF HAS BEEN ADDED TO THE LIBR.           
SCNMOD48 BAL,XLNK  FNDREF                                                       
         CI,R11   0                 BYTE 0 OF R11=X'80', FOUND A DEF            
         BL       SCNMOD50                       =X'C0', FOUND A DSECT          
SCNMOD49 RES      0                              =X'0' , FOUND A REF            
         LW,R3    CRNTEBD           FOUND NO DUPL DEF OR DSECT                  
         LB,R4    0,R3                  TRY NEXT ENTRY                          
         SW,R3    R4                                                            
         STW,R3   CRNTEBD                                                       
         CW,R3    LBAEBC            HAVE WE CHECKED ALL ENTRIES                 
         BLE      SCNMOD51          YES,NO DUPL DEFS                            
         B        SCNMOD48          NO, CONTINUE                                
*                                                                               
SCNMOD50 RES      0                                                             
         LB,R3    R11               FOUND DUPL DEF OR DSECT                     
         CI,R3    X'80'             IS IT A DEF                                 
         BE       SCNMOD60          YES, LOG ERROR MESSAGE                      
*                                   NO, MUST BE A DSECT                         
         LW,R7    CRNTEBD           CHECK CURRENT ENTRY AT LOC=CRNTEBD          
         BAL,XLNK  SCHDREF              TO SEE IF IT IS ALSO A DSECT            
         LB,R3    R11                                                           
         CI,R3    X'80'             IS IT A DEF                                 
         BE       SCNMOD60          YES,CANT ADD A DSECT IF ALREADY             
*                                       A DEF WITH SAME LABEL                   
         CI,R3    X'C0'             NO, IS IT A DSECT                           
         BE       SCNMOD49              YES, DUPL DSECT ALLOWED                 
         B        ABORT             SHOULDN'T GET HERE, ABORT                   
*                                                                               
SCNMOD51 RES      0                                                             
         B        *LINKSAVE         RETURN TO CALLING PROGRAM.                  
         PAGE                                                                   
         SPACE    2                                                             
*                          ERROR PROCESSING ROUTINES FOR LIBRARY BUILD          
*                                                                               
*                                                                               
SCNMOD60 RES      0                                                             
         AND,R11  M19               MASK OUT BYTE ADDRESS                       
         STRNG    MESS36            OUT 'DUPLICATE DEF ' PART OF MSG            
         LW,R4    R11               COPY BYTE ADDR OF START OF NAME             
         LW,R1    0,R4              AND GET LENGTH OF NAME                      
         CI,R1    8                 LIMIT NAME LENGTH TO 8 CHARS                
         BLE      SCNMOD61            LESS THAN 8; USE LENGTH                   
*                                                                               
         LI,R1    8                 ELSE TRUNCATE NAME AT 8 CHARS               
*                                                                               
SCNMOD61 RES      0         OUT DUPLICATE NAME                                  
         AI,R4    -1                STEP TO NEXT CHAR IN EBCDIC TABLE           
         LB,R15   0,R4              FETCH IT                                    
         CHAR                       ENTER IT                                    
         BDR,R1   SCNMOD61          LOOP TO GET ALL                             
*                                                                               
         CI,R13   -1                ARE WE AT END OF ROM ?                      
         BLE      SCNMOD79            YES, OUT MESSAGE                          
*                                                                               
SCNMOD75 RES      0         SKIP TO END OF CURRENT (ERROR) ROM                  
         MTW,1    SKIPCKS             SET NO CKSUM SEQ. CHECK FLAG              
SCNMOD77 RES      0                                                             
         CI,R13   1                                                             
         BE       SCNMOD79            AT END; FINISH AND OUT MESSAGE            
         BAL,LINK RDWRTE1           SKIP OUT TO END OF MODULE                   
         B        SCNMOD77                                                      
*                                                                               
SCNMOD79 RES      0         INSERT NAME OF ROM IN ERROR                         
         STRNG    MESINROM          INSERT ' IN ROM '                           
         CHARS    8,MFENTRY+1       OUT THE ROM'S NAME                          
*                                                                               
SCNMOD80 RES      0                                                             
         CAL1,1   REWINDSO          WEOF AFTER PREVIOUS ROM ON MODULE           
         LW,R2    MODULSZE          GET SIZE AFTER LAST GOOD ROM                
         STW,R2   SKIPNSO                                                       
         CAL1,1   SKIPRSO                                                       
         CAL1,1   WEOFSO                                                        
         BAL,RLNK OUT%MSG           OUT MESSAGE                                 
         BIFFGD   ABORT             ABORT IF FOREGROUND                         
*                                                                               
         M:WAIT                     GET NEXT ROM IF 'C' TYPED                   
         B        SCNMOD+1                                                      
         PAGE                                                                   
******** SUBROUTINE BINDEC ********                                             
*                                                                               
*        INPUT    NUMBER TO BE CONVERTED IN R15                                 
*                                                                               
*        OUTPUT   CONVERTED NUMBER IN R10,R11 RIGHT JUSTIFIED                   
*                                                                               
*        FUNCTION CONVERTS A BINARY NUMBER TO DECIMAL EBCDIC                    
*                                                                               
*        CALL IS    BAL,LINK  BINDEC                                            
*                                                                               
BINDEC   RES      0                                                             
         PUSH     3,R14             SAVE R0,R14,R15                             
         LI,R0    8                 8 DIGIT MAXIMUM                             
BDCNVT1  RES      0                                                             
         LI,R14   0                                                             
         DW,R14   DEC10                                                         
         AI,R14   X'F0'                                                         
         SLD,R10  -8                                                            
         STB,R14  R10               STORE NEXT BYTE                             
         BDR,R0   BDCNVT1                                                       
         PULL     3,R14             RESTORE R0,R14,R15                          
         B        *LINK                                                         
*                                                                               
DEC10    DATA     10                                                            
         PAGE                                                                   
*                                                                               
*  FOLLOWING ARE IN CONTEXT SEGMENT                                             
*CRNTEBD DATA     0                 BYTE ADDR. OF NXT. AVAIL EBCDIC LOC.        
*EBDBYTES DATA    0                 NO. BYTES ADDED FOR ROM (EBCDIC FLE)        
*MODBYTES DATA    0                 NO. BYTES ADDED FOR ROM (MODIR FLE)         
*DRFHWDS DATA     0                 NO. HWDS. ADDED FOR ROM (DEFREF FLE)        
*SKIPCKS DATA     0                   READ MODULE W/OUT SEQ. CHK AND CHKSUM     
*NMENOS  DATA     0                 COUNT OF NAME NUMBERS FOR ROM               
*EBDBA   DATA     0                 BYTE ADDR. OF LAST BYTE IN BUFFER           
*LINKSAVE DATA    0                 TEMPORARY SAVE                              
*TEMP1   DATA     0                 TEMPORARY SAVE                              
*TEMPSAVE DATA    0                 TEMPORARY SAVE                              
*TEMP1A  DATA     0                 TEMPORARY SAVE                              
*NDEFS   DATA     0                 NO. DEFS AND DSECTS FOR THIS ROM            
*LBAEBC  DATA     0                 TEMPORARY SAVE FOR CRNTEBD                  
*FBAEBC  DATA     0                 1ST BYTE ADDR OF EBCDIC FOR                 
**                                      CURRENT ROM.                            
*DUPDEF  DATA     0                                                             
*SEQNO   DATA     0                 ROM SEQUENCE NUMBER                         
         PAGE                                                                   
******** RDWRTE ********                                                        
*                                                                               
*        INPUT    BINARY CARDS                                                  
*                                                                               
*        OUTPUT   CARD IMAGES TO SPECIFIED FILE                                 
*                 R12= BUFFER THAT LAST CARD WAS READ INTO                      
*                 R13= 1 IF LAST CARD ENCOUNTERED                               
*                 R14= RETAINS ROM SEQUENCE NO.                                 
*        FUNCTION READS BINARY INTO EITHER BUFF3 OR BUFF4, CHECKSUMS,           
*                 SEQUENCE CHECKS, PERFORMS LEGALITY CHECK, AND WRITES          
*                 TO SPECIFIED FILE. IS USED BY ROUTINES SCANNING FOR           
*                                     DEFS AND REFS. IF SKIPCKS FLAG=1,         
*                                     SEQUENCE CHECKING AND CHECK SUMMING       
*                                     WILL NOT BE PERFORMED                     
*                                                                               
*        CALL     BAL,LINK  RDWRTE  IF NEW MODULE                               
*        CALL     BAL,LINK  RDWRTE1  IF READING CARD OF SAME MODULE             
*                                                                               
*        REGISTERS USED  R12,R13,R14                                            
*                                                                               
RDWRTE   RES      0                                                             
*                                                                               
         LI,R12   BUFF3                                                         
         LI,R13   0                 RESET LAST CARD FLAG                        
         LI,R14   -1                                                            
         STB,R14  SEQNO             SAVE SEQ. NO.                               
RDWRTE1  RES      0                                                             
         PUSH     12,R0             SAVE R0-R11                                 
*  ALSO HERE FOR REREAD AFTER ERROR                                             
RDWRTE1B MTW,0    SQUEZ95           IS THIS A SQUEEZE RUN                       
         BEZ      RDWRTE2           NO                                          
RDWRTE1A CAL1,1   READX1            YES,TAKE INPUT FROM X1                      
         B        %+2                                                           
RDWRTE2  RES      0                                                             
         CAL1,1   READSI            READ INTO BUFF3 W/WAIT                      
RDWRTE3  RES      0                                                             
         LI,R12   BUFF3                                                         
         BAL,XLNK  RDWRTE15         CHECKSUM, SEQ. CHECK CARD.                  
RDWRTE11 RES      0                                                             
         CAL1,1   WRITESO           WRITE OUT BUFF3                             
         MTW,+1   MFENTRY           STEP COUNT OF RECORDS IN ROM                
         PULL     12,R0             RESTORE R0-R11                              
         LB,R14   SEQNO             SET OUT PARAM                               
         B        *LINK                                                         
*                                                                               
*                                                                               
RDWRTE15 RES      0                                                             
         MTB,1    SEQNO             INCR. SEQ. NO.                              
         BNOV     %+3               OK                                          
         LI,R14   0                 START ALL OVER                              
         STB,R14  SEQNO             WITH ZERO                                   
*                                   TS2426                                      
         LI,R6    0                                                             
         LB,R9    *R12,R6           GET BYTE 0 '1C' OR '3C'                     
         CI,R9    X'1C'             LAST RECORD?                                
         BE       RDWRTE18          YES                                         
RDWRTE17 RES      0                                                             
         CI,R9    X'3C'             LEGAL BINARY CARD                           
         BE       RDWRTE19                                                      
         LI,R15   MESS30            NO.                                         
         B        RDWRTE50                                                      
RDWRTE18 RES      0                                                             
         LI,R13   1                 SET LAST CARD FLAG                          
RDWRTE19 RES      0                                                             
         MTW,0    SKIPCKS             SKIP CHKSUM. AND SEQ. CHKING              
         BGZ      RDWRTE24                                                      
         AI,R6    1                                                             
         LB,R9    *R12,R6           GET BYTE 1  (SEQ. NO.)                      
         CB,R9    SEQNO             IS CARD IN SEQUENCE                         
         BE       RDWRTE21          YES                                         
         LI,R15   MESS31                                                        
         B        RDWRTE50          SEQUENCE ERROR                              
*                                                                               
RDWRTE21 RES      0                                                             
         AI,R6    1                                                             
         LB,R9    *R12,R6           GET BYTE 2  (CHECKSUM)                      
         LI,R3    0                                                             
         STB,R3   *R12,R6                                                       
*                                                                               
         AI,R6    1                 VERIFY CHECKSUM                             
         LB,R4    *R12,R6                                                       
         AI,R4    -1                                                            
RDWRTE23 RES      0                                                             
         LB,R5    *R12,R4                                                       
         AW,R3    R5                                                            
         BDR,R4   RDWRTE23                                                      
         LB,R5    *R12,R4                                                       
         AW,R3    R5                                                            
         AND,R3   M8                                                            
         CW,R3    R9                                                            
         BNE      RDWRTE25                                                      
         LI,R6    2                                                             
         STB,R9   *R12,R6           RESTORE CHECKSUM                            
RDWRTE24 RES      0                                                             
         B        *XLNK             EXIT                                        
*                                                                               
RDWRTE25 RES      0                                                             
         LI,R15   MESS32            CHECKSUM ERROR                              
RDWRTE50 RES      0                                                             
         BAL,LINK TYPRNT            IF 'C' IS TYPED, READ NEXT RECORD           
         BIFFGD   EXEC1             KILL IF FROM TEL; HE RESTARTS COPY          
*                                                                               
         M:WAIT                     BACKGROUND                                  
         AI,R14   -1                CORRECT SEQ. NO. FOR REREAD                 
         B        RDWRTE1B          REREAD CARD                                 
         PAGE                                                                   
******** SUBROUTINE  BLDEBD  ********                                           
*                                                                               
*        INPUT    R12= CURRENT INPUT BUFFER                                     
*                 R2 = INDEX OF LAST BYTE ON CARD                               
*                 R7 = INDEX OF FIRST BYTE OF DEF/REF NAME                      
*                 CRNTEBD= 1ST AVAIL. BYTE LOCATION TO STORE INTO               
*                                                                               
*        OUTPUT   DEFS AND REFS TO EBCDIC FILE                                  
*                 R11= -1IF ERROR                                               
*        FUNCTION GETS DEF/REF NAMES AND ADDS TO EBCDIC FILE, CHKS FOR          
*                                                                F4:COM         
*        CALL     BAL,XLNK  BLDEBD                                              
*                                                                               
*        REGISTERS USED  R1,R4,R7,R10,R11,R15,R3                                
BLDEBD   RES      0                                                             
         STW,XLNK  TEMP1                                                        
         LI,R4    1                                                             
         BAL,XLNK  SCNMOD20         GET NXT BYTE WITH NAME LENGTH               
         LW,R1    R7                                                            
         LB,R4    *R12,R1                                                       
         AI,R4    1                                                             
         STB,R4   *R12,R1                                                       
         LW,R10   R4                WILL NAME FIT IN BCKGRND. BUFFER IF         
         AW,R10   EBDBYTES                                       ADDED.         
         AW,R10   EBDICSZE                                                      
         AW,R10   DREFSZE                                                       
         LW,R15   DRFHWDS                                                       
         SLS,R15  1                                                             
         AW,R10   R15                                                           
         CW,R10   BCKSZE                                                        
         BL       BLDEBD2           YES                                         
         LI,R15   MESS19            NOT ENUF BCKGRND                            
         LI,R11   -1                SET ERROR FLAG                              
         B        *TEMP1                                                        
*                                                                               
BLDEBD2  RES      0                                                             
         LW,R3    CRNTEBD           POINTER TO NEXT STORAGE LOCATION            
         LW,R10   R2                PUT DEF/REF IN EBCDIC FILE                  
         SW,R10   R1                NO. OF BYTES TO TRANSFER FROM               
         AI,R10   1                                 CURRENT CARD.               
         CW,R4    R10                                                           
         BGE      BLDEBD4                                                       
         LW,R10   R4                                                            
         LI,R4    -1                SET FLAG THAT DON'T NEED NEXT CARD          
         B        BLDEBD6                                                       
BLDEBD4  RES      0                                                             
         SW,R4    R10               NO. OF BYTES TO TRANSEER FROM NEXT          
BLDEBD6  RES      0                                               CARD          
         LB,R7    *R12,R1                                                       
         STB,R7   0,R3                                                          
         AI,R1    1                                                             
         AI,R3    -1                                                            
         BDR,R10  BLDEBD6                                                       
         CI,R4    0                 ARE ALL BYTES TRANSFERRED TO FILE           
         BL       BLDEBD8           YES                                         
         LW,R10   R4                NO                                          
         LI,R4    0                                                             
         BAL,XLNK  SCNMOD20         GET NEXT CARD                               
         LW,R1    R7                                                            
         CI,R10   0                 DID LOAD ITEM END ON CARD                   
         BE       BLDEBD8           YES                                         
         B        BLDEBD6                                                       
BLDEBD8  RES      0                                                             
         LW,R7    CRNTEBD           CHECK IF DEF/REF IS F4:COM                  
         LB,R11   0,R7                                                          
         AI,R11   -1                                                            
         CI,R11   6                 IF NAME LENGH=6, CHECK IF F4:COM            
         BNE      *TEMP1                                                        
         LW,R11   BLNK                                                          
         LI,R4    0                                                             
BLDEBD9  RES      0                                                             
         AI,R7    -1                                                            
         LB,R15   0,R7                                                          
         STB,R15  R10,R4                                                        
         AI,R4    1                                                             
         CI,R4    6                                                             
         BL       BLDEBD9                                                       
         CD,R10   F4:COM                                                        
         BNE      *TEMP1                                                        
         LI,R15   MESS29            POINT AT MESSAGE 'F4:COM NOT OK ...'        
         LI,R11   -1                SET ERROR FLAG                              
         B        *TEMP1                                                        
*                                                                               
         BOUND    8                                                             
F4:COM   TEXT     'F4:COM'                                                      
         PAGE                                                                   
******** SUBROUTINE  FNDREF  ********                                           
*                                                                               
*        INPUT    EBDBA= BYTE ADDRESS OF EBCDIC BUFFER                          
*                 CRNTEBD= BYTE ADDRESS OF REF/DEF                              
*        OUTPUT   R11=0 IF NO DUPLICATE                                         
*                 R11  BIT 0=0, REF FOUND                                       
*                            1, DEF FOUND                                       
*                      BITS 13-31=POINTER TO DUPLICATE FOUND                    
*                                                                               
*        FUNCTION SEARCHES THE EBCDIC FILE FOR DUPLICATE DEF OR REF             
*                 AND RETURNS BYTE ADDRESS IF FOUND                             
*                                                                               
*                                                                               
*        CALL     BAL,XLNK  FNDREF                                              
*                                                                               
*        REGISTERS USED  R3,R4,R5,R6,R7,R8,R9,R14,R15                           
FNDREF   RES      0                                                             
         STW,XLNK  TEMP1                                                        
         LI,R11   0                 PRESET TO NOTHING FOUND                     
         LW,R6    EBDBA                                                         
FNDREF1  LW,R5    CRNTEBD           GET ADDRESS OF NAME SEARCHING FOR           
         CW,R6    R5                ARE WE DONE                                 
         BLE      *TEMP1            YES,DIDN'T FIND DUPLICATE                   
         LB,R9    0,R6              R9=NO. BYTES IN NAME                        
         LW,R7    R6                SAVE START ADDRESS IN R7                    
FNDREF2  LB,R8    0,R6                                                          
         CB,R8    0,R5              IS THIS BYTE THE SAME                       
         BNE      FNDREF9           NO,CAN'T BE DUPLIC. HERE                    
         AI,R6    -1                YES,TRY NEXT BYTE                           
         AI,R5    -1                                                            
         BDR,R9   FNDREF2                                                       
         BAL,XLNK  SCHDREF          FOUND A DUPLICATE                           
*                                   R7= BYTE ADDRESS OF DUPLICATE               
         B        *TEMP1                                                        
*                                                                               
FNDREF9  AI,R6    -1                BYPASS REMAINDER OF NAME                    
         BDR,R9   %-1                                                           
         B        FNDREF1                                                       
*                                                                               
*                                                                               
*                                                                               
SCHDREF  RES      0                 R7= BYTE ADDR. OF DUPLICATE                 
         STW,XLNK  TEMP1A           SAVE RETURN                                 
         LW,R11   R7                                                            
         LW,R15   EBDBA                                                         
         SW,R15   R11                                                           
         LW,R7    DREFSZE                                                       
         SLS,R7   -1                                                            
         AW,R7    DRFHWDS           R7=TOTAL # OF DEFREF HALFWORDS              
         LI,R3    0                                                             
SCHDREF1 RES      0                                                             
         LH,R4    *BIBUFF,R3        GET ENTRY SIZE                              
         AI,R4    -2                                                            
         AI,R3    1                                                             
         LH,R6    *BIBUFF,R3        IS THIS A DELETED ENTRY                     
         BGEZ     SCHDREF2-1        NO,CONTINUE                                 
         AW,R3    R4                YES,DONT CHECK FOR DUPL.                    
         LI,R4    0                                                             
         B        SCHDREF3                                                      
         AI,R3    1                                                             
SCHDREF2 RES      0                                                             
         LH,R6    *BIBUFF,R3        GET NEXT DEF/REF/DSECT                      
         CI,R6    X'4000'           IS IT A REF                                 
         BAZ      SCHDREF3          YES                                         
         AND,R6   M14               NO,DEF OR DSECT                             
         CW,R6    R15               IS IT THE ENTRY WE'RE LOOKING FOR           
         BNE      SCHDREF3          NO                                          
         LH,R6    *BIBUFF,R3        YES, IS IT A DEF                            
         BGZ      SCHDREF4          B IF DEF                                    
         LI,R3    X'C0'             SET BYTE 0 OF R11 TO INDICATE               
         B        SCHDREF4+1          DUPL. ENTRY IS A DSECT                    
*                                                                               
SCHDREF3 AI,R3    1                 GET NEXT ENTRY                              
         BDR,R4   SCHDREF2                                                      
         CW,R3    R7                HAVE WE SEARCHED WHOLE TABLE                
         BL       SCHDREF1          NO                                          
         B        *TEMP1A           YES,EXIT                                    
*                                                                               
SCHDREF4 LI,R3    X'80'             SET BYTE 0 OF R11 TO INDICATE               
         STB,R3   R11                 DUPL. ENTRY IS A DEF                      
         B        *TEMP1A           EXIT                                        
         PAGE                                                                   
******** SUBROUTINE  BLDDRF                                                     
*                                                                               
*        INPUT    R8=0 MAKE DEF ENTRY                                           
*                 R8=1 MAKE REF ENTRY                                           
*                 R8= -1 TO MAKE PSEUDO ENTRY (0)                               
*                 R11= POINTER (BYTE ADDRESS) TO EBCDIC FILE ENTRY              
*                                                                               
*                                                                               
*        OUTPUT   EBCDIC BYTE INDEX TO DEFREF FILE                              
*                 UPDATED ENTRY SIZE                                            
*                 DRFHWDS= UPDATED DEFREF FILE HALFWORD COUNT                   
*                 R11= -1 IF ERROR (INSUFF. BUFFER SPACE)                       
*                                                                               
*        FUNCTION MAKES AN ENTRY (DEF OR REF) TO THE DEFREF FILE IF             
*                 SUFF. BUFFER SPACE, AND UPDATE THE HALFWORD COUNT.            
*                 ALSO BUILDS THE I.D. ENTRY FOR THE MODULE.                    
*                                                                               
*        CALL     BAL,XLNK  BLDDRF                                              
*                                                                               
*        REGISTERS USED  R9,R10,R11,R15                                         
*                 SAVES R4 IN STACK                                             
*                                                                               
BLDDRF   RES      0                                                             
         STW,R15  TEMP1                                                         
         PUSH     R4                SAVE R4                                     
         LW,R10   DRFHWDS             WILL ENTRY FIT IB BCKGRND. BUFFER         
         BGZ      %+2                                                           
         AI,R10   2                                                             
         AI,R10   1                                                             
         SLS,R10  1                                      THIS MODULE.           
         AW,R10   DREFSZE                                                       
         AW,R10   EBDICSZE                                                      
         AW,R10   EBDBYTES                                                      
         CW,R10   BCKSZE                                                        
         BL       BLDDRF5           YES. MAKE ENTRY                             
         LI,R15   MESS19                                                        
         LI,R11   -1                                                            
         B        BLDDRF90          RETURN                                      
*                                                                               
BLDDRF5  RES      0                                                             
         LW,R4    DREFSZE           UPDATE DEFREF FILE ENTRY SIZE               
         SLS,R4   -1                                                            
         MTW,0    DRFHWDS           IS THIS THE FIRST ENTRY FOR MODULE          
         BEZ      BLDDRF10          YES                                         
         LH,R10   *BPEND,R4                                                     
         AI,R10   1                                                             
         STH,R10  *BPEND,R4                                                     
         AI,R4    2                                                             
         MTW,1    DRFHWDS                                                       
         B        BLDDRF12                                                      
*                                                                               
BLDDRF10 RES      0                                                             
         LI,R10   3                 BUILD I.D. ENTRY FOR MODULE                 
         STW,R10  DRFHWDS                                                       
         STH,R10  *BPEND,R4         ENTRY SIZE                                  
*                                                                               
         AI,R4    1                                                             
         LW,R9    MODIRSZE          MODIR FILE INDEX                            
         SLS,R9   -1                                                            
         STH,R9   *BPEND,R4                                                     
*                                                                               
         AI,R4    1                                                             
BLDDRF12 RES      0                                                             
         LW,R9    EBDBA             EBCDIC FILE BYTE INDEX                      
         SW,R9    R11                                                           
         MTW,0    R8                                                            
         BGZ      BLDDRF15                                                      
         BLZ      BLDDRF17                                                      
         OR,R9    LIBDEFF           MAKE A DEF ENTRY                            
         B        BLDDRF16                                                      
*                                                                               
BLDDRF15 RES      0                                                             
         OR,R9    LIBREFF           MAKE A REF ENTRY                            
*                                                                               
BLDDRF16 RES      0                                                             
         AW,R4    R10                                                           
         AI,R4    -3                                                            
         STH,R9   *BPEND,R4         INSERT NEW ENTRY AS LAST WORD IN            
*                                      DEFREF FILE.                             
         LI,R11   0                                                             
         B        BLDDRF90          RETURN                                      
*                                                                               
BLDDRF17 RES      0                                                             
         LI,R9    0                                                             
         B        BLDDRF16                                                      
*                                                                               
BLDDRF90 PULL     R4                RESTORE R4                                  
         B        *TEMP1            RETURN                                      
         PAGE                       *****  SQUEEZE  *****                       
         SPACE    2                 ---------------------                       
         LIST     1                                                             
*        INPUT    DIRECTIVE PARAMETERS                                          
*                                                                               
*        OUTPUT   COMPRESSED RAD FILES WITHIN AN AREA                           
*                                                                               
*        FUNCTION RECLAIM SPACE WITHIN AREAS LOST VIA DELETES AND TRUN-         
*                 CATES BY COMPRESSING ENTRIES AND FILES TOWARDS THE            
*                 FRONT OF DIRECTORY SECTORS AND THE AREA, RESPECTIVELY         
*                 THE NEW SQUEEZE ALSO TRIES TO ORDER AND JUXTAPOSE             
*                 THE EXTENTS OF AN EXTENDED FILE, AND THEN COMBINE             
*                 DIRECTORY ENTRIES IF THE 'FIX' FLAG IS NOT SET.               
*                                                                               
*           NOTE: PACK- AND UNPK- DIRE ARE ALWAYS USED TO ALTER OR GET          
*                 ANY DIRE ITEM TO ELIMINATE DIRE FORMAT DEPENDENCIES.          
*                                                                               
*        CALLS:   B     SQUEEZE     FOR NEW SQUEEZE                             
*                 B     SQUEZ       FOR OLD SQUEEZE                             
*                                                                               
*        SUBROUTINES CALLED:        GAN,SCAN,UNPKMASD,GETAX                     
*                                   GET1SFIL,GETNXFIL,UNPKDIRE,PACKDIRE         
*                                   AND SEVERAL INTERNAL SUBROUTINES;           
*                                   OR  COPY TO REBUILD THE LIBRARY             
         PAGE                          COMMON ENTRY FOR SQUEEZE, SKWEZ          
         SPACE    2                    -------------------------------          
SQUEEZE  RES      0         'SQUEEZE' AREAS OR LIBRARIES                        
         LI,R0    0                 SET DOING NEW FORMAT SQUEEZE                
         B        SQSK              GO TO COMMON PART OF CODE                   
*                                                                               
SKWEZ    RES      0         'SKWEZ' AREA IN OLD WAY: NO EXTENT COMBINE          
         LI,R0    1                 SET IN OLD FORMAT SQUEEZE                   
         B        SQSK              GO TO COMMON PART OF CODE                   
*                                                                               
SQSK     RES      0         COMMON PROCESS PARAMS AND READ DIRE                 
         STW,R0   MAPSW             SAVE HOW WE ARE DOING SQUEEZES              
         LI,R0    COPYERF           SET ERROR FUNCTION TABLE ADDRESS            
         STW,R0   ERRFCN            SAME AS FOR COPY                            
         LI,RLNK+1  1               SET CK, BT, IS, OS ALLOWED                  
         BAL,RLNK GAN               IN AREA NAME SCAN                           
         B        SQUEZ100          ERROR OF SOME SORT; TEST FOR 'LIB'          
*                                                                               
         LI,R0    0                 INSURE ILLEGAL AREA NAMES WERE              
         LI,R1    BTINDEX           NOT SPECIFIED                               
         STB,R0   AREASWS,R1                                                    
         LI,R1    CKINDEX                                                       
         STB,R0   AREASWS,R1                                                    
         LI,R1    XAINDEX                                                       
         STB,R0   AREASWS,R1                                                    
         PAGE                          FIND AN AREA; PREP FOR DIRE READ         
         SPACE    2                    --------------------------------         
         LI,R6    SPINDEX           START SQUEEZE SCAN WITH 'SP' AREA           
*                                                                               
SQUEZ0   RES      0         FIND NEXT AREA TO BE 'SQUEEZE'D                     
         LB,R0    AREASWS,R6        IS AREA SPECIFIED ?                         
         BEZ      SQUEZ24             NO, STEP TO NEXT                          
*                                                                               
         STW,R6   AREA              SET AREA INDEX TO PROCESS NEXT              
         BAL,R14  UNPKMASD          GET AREA AND DEVICE INFO                    
         B        ERROR04           CAN'T HAPPEN, BUT IF IT DOES...             
*                                                                               
         SPACE    2                                                             
*        IF WE ARE GOING TO PRE-H00 TO H00 DIRECTORY                            
*        SEE IF FILES IN THE AREA WERE EXTENDED                                 
*        ISSUE WARNING (ABORT) MESSAGE IF SO                                    
*                                                                               
         LI,R0    0                 RESET CON2H00 FLAG                          
         STW,R0   CON2H00                                                       
         BAL,RLNK GET1SFIL          GET 1ST FILE DIRECTORY                      
         B        SQUEZ28           ERROR                                       
         B        SQUEZ22           EMPTY                                       
         MTW,+0   MASDFRMT          ARE WE CONVERTING TO H00 DIR FORMAT         
         BEZ      SQUEZ0C           NO                                          
         MTW,+2   CON2H00           YES, SET FLAG FOR PASS NUMBER               
*QUEZ0A  BAL,RLNK UNPKDIRE                                                      
*        MTW,+0   DIREXTNT          HAS THIS FILE BEEN EXTENDED                 
*        BEZ      SQUEZ0B           NO                                          
*        LI,R15   MESS39            PRE-H00 MUST HAVE COMBINED EXTENTS          
*        BAL,LINK TYPRNT                                                        
*        B        SQUEZ0C           PROCEED AFTER WARNING                       
*        B        PROCKYIN          PROCEED OR ABORT                            
*QUEZ0B  BAL,RLNK GETNXFIL          GET NEXT FILE ENTRY                         
*        B        SQUEZ28           ERROR                                       
*        B        SQUEZ0C           DONE                                        
*        B        SQUEZ0A           OK,                                         
SQUEZ0C  EQU      %                                                             
         SPACE    2                                                             
         LW,R6    BPEND             POINT WHERE TO BUILD LINKED DIRE            
         STW,R6   DIRCHAIN          AND SET LOC OF INITIAL 1ST ENTRY            
         LI,R8    BUFF4             SET DUMMY  INITIAL ENTRY ADDRESS            
         LI,R9    0                 SET FWD LINK = 0; BACK = DUMMY              
         LD,R10   ZEROS             SET NO EXTENT LINKS EITHER                  
*                                                                               
         BAL,RLNK GET1SFIL          GET FIRST FILE FROM DIRECTORY               
         B        SQUEZ28           ERROR IN DIRE: REPORT & SKIP AREA           
         B        SQUEZ22           EMPTY: LEAVE THE AREA AS IS                 
*        B        SQUEZ1            ENTRY FOUND: PACK IT UP                     
         PAGE                          BUILD DIRE CHAIN IN CORE                 
         SPACE    2                    ------------------------                 
SQUEZ1   RES      0         PROCESS NEXT ENTRY: STORE IN BCKG BUFFER            
         BAL,RLNK UNPKDIRE          GET INFO ABOUT THE ENTRY                    
         LW,R0    DIRESTAT          IS IT A VALID ENTRY;                        
         CI,R0    FILDELTD          THAT IS, IS IT NOT DELETED ?                
         BE       SQUEZ10             NO; DELETED; SKIP IT                      
         SPACE                                                                  
         MTW,+0   MASDFRMT          ARE WE MOVING FROM PRE-H00 TO H00           
         BEZ      SQUEZ1A           NO                                          
         LW,RLNK  SQUZDATE          YES, DATE = SQUEEZE DATE                    
         STW,RLNK DIREDATE                                                      
SQUEZ1A  RES      0                                                             
*                                                                               
         BAL,RLNK PACKDIRE          PACK IT BACK UP IN BCKG SPACE               
         LW,R1    R8                SET FWD LINK IN PREVIOUS ENTRY              
         STW,R6   FWDLINK,R1                                                    
         LCI      4                 AND SET BACK LINK, ETC IN THE ENTRY         
         STM,R8   BACLINK,R6                                                    
         LW,R8    R6                SET BACK LINK FOR NEXT ENTRY                
         MTW,+00  DIREESIZ          CAN THE FILE BE EXTENDED ?                  
         BEZ      SQUEZ9              NO, A SIMPLE FILE                         
*                                                                               
         MTW,+0   MASDFRMT          IF MOVING FROM PRE-H00 TO H00               
         BNEZ     SQUEZ9            LEAVE EXTENTS WHERE THEY ARE                
*                                   SINCE POINTER R5 TO DIR POS                 
*                                   WILL GET MESSED UP SINCE WE                 
*                                   ARE DEALING WITH 2 DIRELEN                  
*                                   IF WE UNPACK INSIDE THE EXTENT              
*                                   LOOP                                        
         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                   
*                                                                               
SQUEZ2   RES      0         TEST NEXT ENTRY FOR SAME FILE                       
         CW,R5    R6                AT END OF FILE CHAIN ?                      
         BGE      SQUEZ8              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      SQUEZ7              NO, BADTRACK: SKIP IT                     
*                                                                               
         CD,R2    DIRENAME          PART OF SAME FILE ?                         
         BNE      SQUEZ7              NO, TRY FOR A NEXT                        
*                                                                               
         CD,R12   DIREACNT          YES, IN SAME ACCOUNT ?                      
         BNE      SQUEZ7            NO, SOME OTHER FILE                         
*                                                                               
SQUEZ3   RES      0         SAME FILE: FIND ORDERED PLACE FOR XTNT              
         CW,R15   DIREXTNT          WHICH WAY IN XTNT CHAIN TO SCAN ?           
         BLE      SQUEZ5              BACK UP; NEW XTNT # < THIS ONE            
*                                                                               
         LW,R4    XFWDLINK,R5       FWD: IS CURRENT ONE THE LAST ONE ?          
         BEZ      SQUEZ4              YES, PUT AT THE END                       
*                                                                               
         LW,R5    R4                NO, LINK TO NEXT IN CHAIN                   
         BAL,RLNK UNPKDIRE          GET ITS EXTENT NUMBER                       
         B        SQUEZ3            AND TEST AGAIN                              
*                                                                               
SQUEZ4   RES      0         NEW EXTENT HIGHEST NUMBERED: PUT AT END             
         STW,R6   XFWDLINK,R5                                                   
         STW,R5   XBACLINK,R6                                                   
         B        SQUEZ8            CLEAN UP AND DO NEXT FILE                   
*                                                                               
SQUEZ5   RES      0         BACK UP LINKS TO FIND PLACE FOR NEW XTNT            
         LW,R4    XBACLINK,R5       ARE WE AT BEGINNING NOW ?                   
         BEZ      SQUEZ6              YES, PUT NEW ONE AT BEGINNING             
*                                                                               
         LW,R5    R4                NO, POINT AT PREVIOUS ENTRY AND             
         BAL,RLNK UNPKDIRE          GET ITS NUMBER                              
         CW,R15   DIREXTNT          HAVE WE GONE FAR ENOUGH ?                   
         BL       SQUEZ5              NO, BACK UP ANOTHER                       
*                                                                               
         LW,R4    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    R4                SET OLD NEXT AT CURRENT &                   
*                                                                               
SQUEZ6   RES      0         LINK UP CURRENT AND NEXT ENTRIES                    
         STW,R5   XFWDLINK,R6                                                   
         STW,R6   XBACLINK,R5                                                   
         B        SQUEZ8            GO CLEAN UP AND GET NEXT NEW FILE           
*                                                                               
SQUEZ7   RES      0         LOOK DOWN BCKG FILES FOR NEXT IN CHAIN              
         LW,R5    FWDLINK,R5        GET LINK TO NEXT FILE                       
         B        SQUEZ2            AND TEST IF AT END YET                      
*                                                                               
SQUEZ8   RES      0         DONE WITH EXTENT LINK-UP; RECOVER DIRE PTR          
         PULL     R5                GET POINTER TO UNPACK DIRE SECTORS          
*                                                                               
*                                                                               
SQUEZ9   RES      0         STEP POINTERS TO INCLUDE FILE IN CHAIN              
         AI,R6    SIZEDIR           STEP POINTER TO NEXT ENTRY LOCATION         
         LW,R0    R6                SEE IF THERE IS ENOUGH ROOM FOR IT          
         AI,R0    SIZEDIR                                                       
         CW,R0    BCKEND            IF IT FILLS ALL MEMORY, THERE'S NOT         
         BGE      ERROR19             NO, ERROR; ABORT OPERATION                
*                                                                               
SQUEZ10  RES      0         FIND NEXT FILE IN DIRECTORY SECTOR                  
         BAL,RLNK GETNXFIL          GET THE NEXT FILE IN DIRE                   
         B        SQUEZ11           ERROR: SQUEZE WHAT WE HAVE NOW              
         B        SQUEZ12           DONE:  RECOVER SPACE, ETC                   
         B        SQUEZ1            NEXT:  PROCESS IT                           
         PAGE                          CHAINS BUILT; PREP FOR SQUEEZE           
         SPACE    2                    ------------------------------           
SQUEZ11  RES      0         ERROR IN DIRE: REPORT, THEN SQUEZE                  
         PUSH     R8                SAVE ADDRESS OF THE LAST ENTRY              
         LI,R15   MESS41            POINT AT MESSAGE TO OUTPUT                  
         BAL,RLNK SQUEZ29           FORM & OUTPUT MESSAGE                       
         PULL     R8                RECOVER LAST ENTRY POINTER                  
         LW,R0    DIREEOT           SET TO CLEAR NOTHING SINCE USER             
         STW,R0   MASDFREE          MAY BE ABLE TO RECOVER SOMETHING            
*                                                                               
*                                                                               
SQUEZ12  RES      0         DIRE SECTORS UNPACKED: TEST WHAT IS LEFT            
         LW,R5    DIRCHAIN          POINT AT START OF CHAIN IN BCKG             
         STW,R11  BACLINK,R5        CLEAR BAC LINK TO DUMMY 1ST ENTRY           
         STW,R6   FREECELL          SAVE LAST ENTRY IN BCKG CHAIN               
         STW,R8   ENDCHAIN           AND ADDR OF TAIL OF CHAIN                  
         CW,R5    R6                WAS ANYTHING ENTERED ?                      
         BE       SQUEZ20             NO, JUST CLEAR ENTIRE AREA                
*                                                                               
         LW,R0    R6                ROUND END OF ENTRIES UP TO NEXT PAGE        
         AI,R0    256               BOUNDARY FOR START OF COPY BUFFER           
         AND,R0   ML24              LEAVING SOME ROOM FOR POSSIBLE              
         STW,R0   BIBUFF            NEW ENTRIES: SET COPY BUFF ADDRESS          
         LW,R15   BCKEND            COMPUTE SIZE OF BUFFER AVAIL                
         SW,R15   R0                                                            
         AI,R15   1                 ADJUST FOR INCLUSIVE LAST ADDR              
         CI,R15   X'4000'           LIMIT SPACE TO 16K WORDS, DECIMAL           
         BLE      %+2                                                           
         LI,R15   X'4000'                                                       
         DW,R15   MASDWPS           GET NUMBER OF SECTORS IN SPACE              
         CI,R15   2                 IS THERE AT LEAST 2 SECTORS ?               
         BL       ERROR19             NO, GIVE NOT ENUF ROOM                    
*                                                                               
         LW,R9    R15               SET & SAVE SIZE OF COPY BUFFER              
         LI,R0    0                 INSURE NEW SQUEEZED DIRECTORY IS            
         XW,R0    MASDFRMT          IN NEW FORMAT: IF INPUT DIRE WAS            
         AWM,R0   MASDNFIL          OLD FORMAT, SET DIRE CHANGED                
*                                                                               
*        FOR SAFETY REASONS, MAYBE ONE SHOULD WRITE THE DIRECTORY               
*        BACK OUT AT THIS POINT.                                                
         LI,R11   1                 SET 1ST SECTOR FOR 1ST FILE                 
         CI,R0    0                 DID WE HAVE PRE-H00 DIR                     
         BNE      SKWEZ0            YES, DON'T COMBINE EXTENTS                  
         MTW,+0   MAPSW             WHAT TYPE OF SQUEEZE ARE WE DOING ?         
         BNEZ     SKWEZ0            OLD FORMAT: DO NOT COMBINE EXTENTS          
      SNPSQCHN                 <==== SHOW UNALTERED CHAIN                       
         B        SQUEZ30           NEW FORMAT: COMBINE EXTENTS                 
         PAGE                          WRITE NEW UPDATED DIRECTORY              
         SPACE    2                    ---------------------------              
SQUEZ15  RES      0         FILE SPACE COMPACTED: REWRITE NEW DIRE              
         LW,R9    R11               SET 1ST EXTRA DIRE SECTOR ADDRESS           
         MTW,+00  MASDNFIL          WERE ANY FILES MOVED ?                      
         BNEZ     SQUEZ16             YES, REWRITE DIRE                         
         CW,R11   MASDFREE          WERE ANY SECTORS RECOVERED ?                
         BE       SQUEZ22             NO, AREA UNCHANGED; DO NEXT AREA          
*                                                                               
*        THIS COULD BE MADE A SUBROUTINE AND USED TO REWRITE THE                
*        DIRECTORY WHENEVER WANTED OR NEEDED (SAY AFTER A FILE MOVE).           
SQUEZ16  RES      0         DIRECTORY (AND MAYBE AREA) ALTERED: UPDATE.         
         LI,R7    BUFF1             SET BUFFER TO BUILD DIRE SECTORS IN         
         STW,R7   BIBUFF            SET BUFFER WHERE DIRE IS FORMED             
         LW,R5    DIRCHAIN          POINT AT START OF THE CHAIN                 
         LI,R0    0                 SET TO WRITE 1ST DIRE SECTOR AT             
         STW,R0   WRDISC5           SECTOR ZERO                                 
         LW,R0    MASDWPS           SET TO WRITE ONLY 1 SECTOR                  
         SLS,R0   2                                                             
         STW,R0   WRDISC4                                                       
*                                                                               
SQUEZ17  RES      0         INITIALIZE THE SECTOR                               
         LW,R1    MASDWPS           CLEAR THE SECTOR                            
         AI,R1    -1                                                            
         LI,R15   0                                                             
         STW,R15  *R7,R1                                                        
         BDR,R1   %-1                                                           
*                                                                               
         LW,R6    R7                FORM THE HEADER INFO                        
         LI,R10   DIRLHDR           LENGTH OF INFO IN SECTOR                    
****     LI,R11   MASDFREE          NEXT FREE SECTOR                            
         LD,R12   DCW1              CONTROL WORDS                               
         LCI      4                 STORE IT AWAY                               
         STM,R10  DIRINFO,R7                                                    
         AW,R6    DIRINFO,R7        POINT AT 1ST FREE WORD IN SECTOR            
*                                                                               
SQUEZ18  RES      0         PROCESS NEXT DIRE ENTRY                             
         BAL,RLNK UNPKDIRE          GET ITS LENGTH                              
         AW,R10   DIRELEN           WILL ENTRY FIT IN CURRENT SECTOR ?          
         CW,R10   MASDWPS                                                       
         BG       SQUEZ19             NO, NEED NEW DIRE SECTOR                  
*                                                                               
         BAL,RLNK PACKDIRE          STORE ENTRY IN SECTOR                       
         STW,R10  DIRINFO,R7        AND SET NEW INFO LENGTH                     
         AW,R6    DIRELEN           POINT AT NEXT SPACE IN SECTOR               
         LW,R5    FWDLINK,R5        GET NEXT ENTRY IN BCKG BUFFER               
         BGZ      SQUEZ18           ANOTHER TO GO; PROCESS IT                   
*                                                                               
         CAL1,1   WRDISC            WRITE LAST SECTOR OF DIRE                   
         B        SQUEZ21           AND CLEAR RECOVERED SECTORS                 
*                                                                               
SQUEZ19  RES      0         NEED ANOTHER DIRE SECTOR                            
         LW,R0    DIRINFO,R7        GET LINK FLAG WORD                          
         OR,R0    Y8                SET LINKED TO ANOTHER SECTOR                
         STW,R0   DIRINFO,R7                                                    
         STW,R9   DIRNEXT,R7        SET LINK TO NEXT DIRE SECTOR                
         CAL1,1   WRDISC            WRITE CURRENT SECTOR                        
         STW,R9   WRDISC5           SET ADDRESS OF NEXT DIRE SECTOR             
         AI,R9    1                 THEN STEP TO NEXT TO USE                    
         CW,R9    R11               ARE WE USING A DELETED ENTRY ?              
         BL       SQUEZ17             YES, DON'T ALTER LAST USED SECTOR         
*                                                                               
         AI,R11   1                 NO, UPDATE NEXT FREE SECTOR ADDR            
         B        SQUEZ17           AND FORM A NEW DIRE SECTOR                  
         PAGE                          CLEAR RECOVERED SECTORS OF AREA          
         SPACE    2                    -------------------------------          
SQUEZ20  RES      0         AREA EMPTY NOW; CLEAR TO OLD LAST USED SECTOR       
         LI,R11   0                 SET NEW FIRST FREE SECTOR                   
*                                                                               
SQUEZ21  RES      0         CLEAR RECOVERED SECTORS                             
         LW,R0    R11               SET NEW 1ST FREE SECTOR                     
         LW,R15   MASDFREE          GET OLD 1ST FREE SECTOR                     
         CW,R15   MASDSIZE          CLEARING BEYOND END OF AREA ?               
         BLE      %+2                 NO, CLEAR WHAT WE MUST                    
*                                                                               
         LW,R15   MASDSIZE          YES, CLEAR ONLY TO THE END                  
*                                                                               
         SW,R15   R0                AND COMPUTE NUMBER TO CLEAR                 
         BLEZ     SQUEZ22           IF IT IS NOT > 1 SECTOR FREED               
*                                                                               
         BAL,RLNK CLRAREA           CLEAR THEM                                  
*                                                                               
SQUEZ22  RES      0         AREA PROCESSED; CLOSE AREA FILE, GET INDEX          
         CAL1,1   CLFLEIN           INSURE DCB FOR AREA IS CLOSED               
         LW,R0    CON2H00           ARE WE IN H00 CONVERSION                    
         BEZ      SQUEZ22A          NO                                          
         MTW,-1   CON2H00           CHECK PASS FLAG -PRE-H00 2 H00              
         BGZ      SQUEZ0C           RESQUEEZE TO COMBINE EXTENTS                
         BLZ      %                 CANT HAPPEN...ERROR                         
         BAL,RLNK SETUSEC           YES, SET USEC FOR ALL FILES                 
SQUEZ22A EQU      %                                                             
         LW,R6    AREA              RESET INDEX OF AREA JUST PROCESSED          
*                                                                               
*                                                                               
SQUEZ24  RES      0         TEMP 'CLEAR AREA' & STEP TO NEXT                    
         AI,R6    1                 STEP AREA INDEX                             
         CW,R6    K:NUMDA           AFTER LAST LEGAL INDEX ?                    
         BLE      SQUEZ0              NO, DO THE NEXT AREA                      
         B        EXEC1             ALL DONE: GET A NEW COMMAND                 
         PAGE                                                                   
*        SUBROUTINE TO 'TRUNCATE' ALL THE FILES IN THE                          
*        AREA WHICH WAS JUST CONVERTED TO H00 FORMAT                            
*        ..TRUNCATE CAL HAS BEEN MODIFIED TO ONLY SET                           
*        USEC = WOULD BE TRUNCATED SIZE AND RUTURN IF                           
*        IT DETECTS A FILE WITH USEC = 0, OR DATE=0?                            
*        BECAUSE IT ASSUMES WE ARE CALLING FROM RADEDIT SQUEEZXE.               
         SPACE                                                                  
*PROBLEM: WHEN FILE IS ALLOCATED IT IS ALSO HAS USIZE = 0 BUT                   
* FSIZE ALSO...                                                                 
         SPACE                                                                  
         SPACE                                                                  
SETUSEC  RES      0                                                             
         PUSH     RLNK                                                          
         LW,R0    MASDNAME          ADD AREA NAME TO FPT                        
         STW,R0   DELTRUNC                                                      
         LI,R0    X'5C80'           TRUNCATE ODER                               
         STH,R0   DELTRUNC                                                      
         BAL,RLNK GET1SFIL          GET 1ST ENTRY IN THE DIRE                   
         B        TRUNC30           DIRE ERROR ALREADY REPORTED..               
         B        TRUNC21           DIRE EMPTY; DONE                            
*        B        TRUNC15           FOUND FIRST; PROCESS                        
*                                                                               
         MTW,+0   MASDFRMT          IS DIRECTORY NOW H00                        
         BNEZ     %                 ERROR ...HANG                               
*                                                                               
TRUNC15  RES      0         PROCESS FILE ENTRY AT (R5)                          
         BAL,RLNK UNPKDIRE          UNPACK THE DIRECTORY ENTRY                  
         LW,R0    DIRESTAT          IS IT AN ACTIVE FILE ?                      
         CI,R0    FILGOODF          I.E., NOT DELETED OR BADTRACK ?             
         BNE      TRUNC18             NO, SKIP IT                               
*                                                                               
         LW,R0    DIREFSIZ          DOES IT HAVE ANY RECORDS IN IT ?            
         BEZ      TRUNC18             NO, SKIP IT                               
*                                                                               
         LCI      2                                                             
         LM,R0    DIRENAME          MOVE NAME TO FPT                            
         STM,R0   DELTRUNC+3                                                    
         LM,R0    DIREACNT                                                      
         STM,R0   ACNTNAME          PUT ACNT NAME IN PLACE                      
         CAL1,7   DELTRUNC          TRUNCATE THE FILE                           
*                                                                               
******* TRUNCATE CAL WILL FIND DIREUSEC = -1 AND KNOW THAT WE                   
*        ARE IN THE PROCESS OF CONVERTING FROM PRE-H00 TO H00                   
*        AND THEREFORE WILL NOT TRUNCATE REALLY, BUT WILL ONLY                  
*        SET USEC PROPERLY.... WE APPOLIZIGE FOR THIS                           
*        POOR SOLUTION... BUT IT IS ONLY RUN ONCE IN A LIFETIME...              
**                THE MANAGMENT                                                 
         SPACE                                                                  
*                                                                               
TRUNC18  RES      0         DONE WITH CURRENT FILE; FIND NEXT                   
         BAL,RLNK GETNXFIL          GET NEXT ENTRY                              
         B        ERROR41           ERROR; REPORT                               
         B        TRUNC30           DONE WITH DIRE; TEST MORE TO DO             
         B        TRUNC15           GOT NEXT; PROCESS IT                        
*                                                                               
*                                                                               
*                                                                               
TRUNC21  RES      0         AREA EMPTY                                          
*                                                                               
*                                                                               
TRUNC30  RES      0         DONE WITH AN AREA; TEST WHAT TO DO NEXT             
         CAL1,1   CLFLEIN           INSURE DCB FOR AREA IS CLOSED               
         PULL     RLNK                                                          
         B        *RLNK                                                         
         PAGE                          ERROR AND MESSAGE ROUTINES               
         SPACE    2                    --------------------------               
SQUEZ26  RES      0         'AREA XX CONTAINS NO FILES' MESSAGE                 
         LI,R15   MESS14            POINT AT MESSAGE TO OUTPUT                  
         BAL,RLNK SQUEZ29           INSERT AREA NAME AND OUTPUT                 
         B        SQUEZ24           THEN GO DO NEXT AREA                        
*                                                                               
*                                                                               
*                                                                               
SQUEZ28  RES      0         ERROR IN DIRE: REPORT AND THEN SKIP AREA            
         LI,R15   MESS41            POINT AT MESSAGE TO PRINT                   
         BAL,RLNK SQUEZ29           INSERT AREA NAME & OUTPUT IT                
         B        SQUEZ22           THEN STEP TO NEXT AREA                      
*                                                                               
*                                                                               
*                                                                               
SQUEZ29  RES      0         INSERT AREA 'MASDNAME' IN MESSAGE AT (R15)          
         PUSH     LINK              SAVE LINK REG FOR TYPRNT CALL               
         LI,R1    3                 SET HW INDEX INTO MESSAGE                   
         LW,LINK  MASDNAME          INSERT AREA NAME INTO THE MESSAGE           
         STH,LINK *R15,R1                                                       
         BAL,LINK TYPRNT            OUT MESSAGE ON LL, OC IF ATTENDED           
         PULL     LINK              RECOVER LAST ENTRY ADDRESS                  
         B        *RLNK             RETURN TO CALLER                            
         PAGE                          NEW SQUEEZE: COMBINE EXTENTS             
         SPACE    1                    ----------------------------             
********   SQUEEZE AREA VIA NEW PROCESS: JUXTAPOSE AND COMBINE EXTENTS          
*                                                                               
*        R5       NEXT ENTRY ON DIRE CHAIN TO PROCESS                           
*        R8       LAST ENTRY ON DIRE CHAIN (POINTS TO LAST USED SECTOR)         
*        R9       # SECTORS IN COPY BUFFER                                      
*        R11      NEXT SECTOR TO USE FOR A SQUEEZED FILE'S BOT                  
*                                                                               
SQUEZ30  RES      0         PROCESS 1ST (NEXT) ENTRY IN CHAIN                   
         BAL,RLNK UNPKDIRE          GET INFO ABOUT THE ENTRY                    
         LW,R0    DIRESTAT          IS IT A MOVEABLE FILE ?                     
         CI,R0    FILBDTRK          (THAT IS, NOT A BADSECTOR ENTRY?)           
         BE       SQUEZ71             NOT MOVEABLE; TRY TO FILL HOLE            
*                                                                               
         MTW,+0   DIREXTNT          IS IT 1ST EXTENT OF A FILE ?                
         BEZ      SQUEZ32             YES, PROCESS IT NOW                       
*                                                                               
         LW,R0    XBACLINK,R5       IS IT 1ST EXTENT IN BROKEN CHAIN ?          
         BEZ      SQUEZ32             YES, TREAT LIKE AN EXTENT 0               
*                                                                               
         CW,R0    BACLINK,R5        IS IT NEXT EXTENT OF SAME FILE ?            
         BNE      SQUEZ42             NO, FIND AND SQUEEZE NEXT EXTENT          
*                                                                               
SQUEZ32  RES      0         NEXT ENTRY NEXT TO SQUEEZE                          
         CW,R11   DIREBOT           IS IT ALREADY IN PLACE ?                    
         BE       SQUEZ35             YES, NO NEED TO MOVE IT                   
*                                                                               
SQUEZ34  RES      0         MOVE A FILE TO RECOVER SPACE                        
         BAL,RLNK SQMOVFIL          MOVE FILE TO ITS PLACE                      
*                                                                               
SQUEZ35  RES      0         UPDATE NEXT SECTOR TO USE, COMBINE EXTENTS          
         AW,R11   DIRENSEC          SET NEW NEXT FREE SECTOR                    
         MTW,+0   DIREESIZ          IS FILE EXTENDABLE ?                        
         BEZ      SQUEZ37             NO, NOTHING TO COMBINE EVER               
*                                                                               
         MTW,+0   DIREFIX           IS IT TO REMAIN UNCOMBINED ?                
         BNEZ     SQUEZ36             YES, DON'T LOOK TO COMBINE IT             
*                                                                               
         MTW,+0   DIREXTNT          IS THIS 1ST XTNT OF THE FILE ?              
         BEZ      SQUEZ36             YES, NOTHING PREVIOUS TO IT               
*                                                                               
         LW,R2    BACLINK,R5        IS PREVIOUS FILE ALSO PREV EXTENT ?         
         CW,R2    XBACLINK,R5       OF SAME FILE ?                              
         BNE      SQUEZ36             NO, THE EXTENTS DON'T COMBINE             
*                                                                               
*                           CONSECUTIVE EXTENTS: COMBINE INTO 1 EXTENT          
         XW,R2    R5                SET PREVIOUS EXTENT = NEW CURRENT           
         BAL,RLNK SQUNLNKX          UNLINK OLD CURRENT EXTENT FROM              
         BAL,RLNK SQUNLNK           EXTENT AND ENTRY CHAINS                     
         LW,R0    DIREEOT           SAVE ITS SIZE AND EOT                       
         LW,R15   DIREFSIZ          FOR ADDING TO PREVIOUS XTNT                 
         LW,R6    DIREUSEC          AND USEC                                    
         BAL,RLNK UNPKDIRE          GET INFO FOR PREVIOUS EXTENT                
         STW,R0   DIREEOT           SET NEW COMBINED EOT                        
         AWM,R15  DIREFSIZ          AND SIZE OF FILE                            
         AWM,R6   DIREUSEC          AND SIZE OF USEC                            
         LW,R6    R5                                                            
         BAL,RLNK PACKDIRE          STORE NEW INFO BACK IN DIRE                 
         MTW,+1   MASDNFIL          SET DIRECTORY ALTERED                       
      SNPSQCHN                 <==== SHOW CHAIN WITH EXTENT OFF IT              
*                                                                               
SQUEZ36  RES      0         LOOK FOR ADDITIONAL EXTENTS IN FILE                 
         LW,R7    XFWDLINK,R5       DOES ANOTHER EXTENT EXIST ?                 
         BNEZ     SQUEZ40             YES, MOVE IT TO NEXT SPACE                
*                                                                               
SQUEZ37  RES      0         FILE & EXTENTS PROCESSED; MORE TO DO ?              
         LW,R5    FWDLINK,R5        IS THERE ANOTHER FILE TO DO ?               
         BNEZ     SQUEZ30             YES, PROCESS IT                           
*                                                                               
         LW,R15   MASDNDS           SEE IF ROOM FOR XTRA DIRE SECTORS           
      SNPSQCHN                 <==== SHOW FINAL CHAIN                           
         AW,R15   R11               AT END OF THE AREA AFTER LAST               
         CW,R15   MASDEOA           ENTRY:  IS THERE ROOM ?                     
         BL       SQUEZ15             YES, GO WRITE DIRE IF ALTERED             
*                                                                               
         LW,R15   MASDNDS           SET NUMBER OF XTRA DIRE SECTORS             
         LW,R5    ENDCHAIN          NEEDED AND LAST ENTRY IN CHAIN              
         LI,R0    FILDELTD          LOOK FOR A DELETED ENTRY                    
*                                                                               
SQUEZ38  RES      0         LOOK BACK UP CHAIN FOR A DELETED ENTRY              
         BAL,RLNK UNPKDIRE          GET INFO FOR THE ENTRY                      
         CW,R0    DIRESTAT          IS THIS A DELETED ENTRY ?                   
         BE       SQUEZ39             YES, SEE IF WE CAN USE IT                 
*                                                                               
         LW,R5    BACLINK,R5        NOT DELETED; GET PREVIOUS ENTRY             
         B        SQUEZ38           & TRY IT                                    
*                                                                               
SQUEZ39  RES      0         DELETED ENTRY FOUND: TEST BIG ENOUGH                
         CW,R15   DIRENSEC          IS IT AS BIG AS WE NEED ?                   
         BG       SQUEZ38             NO, KEEP LOOKING                          
*                                                                               
         LW,R9    DIREBOT           YES, USE BEGINNING FOR DIRE                 
         AW,R15   R9                COMPUTE NEW BOT                             
         STW,R15  DIREBOT           AND SET                                     
         LW,R6    R5                UPDATE ENTRY IN CHAIN                       
         BAL,RLNK PACKDIRE                                                      
         CW,R15   DIREEOT           WAS ENTIRE ENTRY USED ?                     
         BLE      SQUEZ16             NO, GO WRITE NEW DIRE                     
*                                                                               
         LW,R2    R5                YES, DELETE THE ENTRY                       
         BAL,RLNK SQUNLNK           BY UNLINKING IT FROM THE CHAIN              
         B        SQUEZ16           AND GO WRITE THE NEW DIRECTORY              
         PAGE                          FIND NEXT EXTENT OF CURRENT FILE         
         SPACE    1                    --------------------------------         
SQUEZ40  RES      0         LOOK FOR NEXT XTNT AFTER CURRENT ONE                
         LW,R10   DIREXTNT          SAVE XTNT NUMBER PROCESSED LAST             
         LW,R5    FWDLINK,R5        GET NEXT ENTRY IN CHAIN                     
*                                                                               
SQUEZ41  RES      0         TEST IF NEXT ENTRY IS ALSO NEXT EXTENT              
      SNPSQMRK                 <==== SAY WE ARE HERE                            
         CW,R5    R7                ARE THEY THE SAME ENTRY ?                   
         BNE      SQUEZ49             NO, TRY TO SQUEEZE NEXT EXTENT            
*                                                                               
         BAL,RLNK UNPKDIRE          YES, GET INFO FOR MOVE                      
         B        SQUEZ32           AND GO SQUEEZE IT TO PLACE                  
*********                                                                       
*                                                                               
*        FIRST OCCURANCE OF A FILE IN THE ENTRY CHAIN IS NOT THE                
*        FIRST EXTENT OF A FILE CHAIN (OR BROKEN CHAIN).                        
*                                                                               
*                                                                               
SQUEZ42  RES      0         AT XTNT N, N > 0; DO THIS ONE NEXT OR NOT ?         
         LW,R7    R5                SAVE CURRENT ENTRY POINTER                  
*                                                                               
SQUEZ43  RES      0         FIND 1ST XTNT OF FILE WHOSE XTNT N IS NEXT          
         LW,R0    XBACLINK,R5       IS THIS THE 1ST EXTENT ?                    
         BEZ      SQUEZ45             YES, NOW FIND 1ST UNSQUEEZED XTNT         
*                                                                               
         LW,R5    R0                NO, BACK UP XTNT CHAIN 1 ENTRY              
         B        SQUEZ43           AND TRY AGAIN                               
*                                                                               
SQUEZ45  RES      0         FIND 1ST XTNT NOT YET SQUEEZED                      
         BAL,RLNK UNPKDIRE          GET INFO ON THE FILE                        
         CW,R11   DIREEOT           HAS IT BEEN SQUEEZED YET ?                  
         BL       SQUEZ47             NO, USE AS NEXT TO SQUEEZE                
*                                                                               
         LW,R5    XFWDLINK,R5       YES, STEP TO NEXT EXTENT                    
         B        SQUEZ45           AND TEST IT                                 
*                                                                               
SQUEZ47  RES      0         1ST UNSQUEEZED XTNT FOUND                           
         CW,R5    R7                IS SAME XTNT WE STARTED WITH ?              
         BE       SQUEZ32             YES, DO IT NEXT                           
*                                                                               
         XW,R5    R7                NO, SAVE NEXT XTNT TO DO, GET NEXT          
*                                                                               
SQUEZ49  RES      0         TEST FOR ROOM FOR (R7) BETWEEN R11 & (R5)           
      SNPSQMRK                 <==== SAY WE ARE HERE                            
         BAL,RLNK UNPKDIRE          GET BOT OF NEXT ENTRY AFTER R11             
         LW,R15   DIREBOT           TO GET SIZE OF HOLE AFTER LAST              
         SW,R15   R11               SQUEEZED FILE                               
         LW,R6    R5                SAVE PTR TO NEXT ENTRY                      
         LW,R5    R7                GET INFO ON NEXT XTNT TO SQUEEZE            
         BAL,RLNK UNPKDIRE                                                      
         CW,R15   DIRENSEC          WILL XTNT FIT IN HOLE ?                     
         BL       SQUEZ50             NO, MUST ENLARGE HOLE FIRST               
*                                                                               
*                       ROOM FOR NEXT XTNT IN HOLE AFTER PREVIOUS XTNT          
*                       MOVE ENTRY AT (R7), THE NEXT XTNT TO SQUEEZE            
*                       TO BEFORE ENTRY AT (R6), THE CURRENT NEXT               
*                       UNPROCESSED ENTRY.                                      
         LW,R2    R7                REMOVE XTNT ENTRY FROM CHAIN                
         BAL,RLNK SQUNLNK                                                       
         LW,R5    R6                SET WHERE IT IS TO BE REINSERTED            
         BAL,RLNK SQLNKAHD          INSERT AS NEW NEXT ENTRY TO SQUEEZ          
         LW,R5    R2                SET AS CURRENT ENTRY                        
         BAL,RLNK UNPKDIRE          GET ITS INFO                                
      SNPSQCHN                 <====                                            
         B        SQUEZ32           AND PROCESS AS USUAL                        
         PAGE                                                                   
*                       THERE IS NOT ENOUGH ROOM FOR THE NEXT EXTENT            
*                       IN THE HOLE AFTER THE LAST SQUEEZED ENTRY.              
*                       IF THE NEXT ENTRY IN CHAIN IS MOVEABLE, TRY TO          
*                       MOVE IT TO THE END OF THE AREA TO MAKE A                
*                       LARGER HOLE, THEN TRY TO MOVE THE EXTENT AGAIN.         
*                                                                               
SQUEZ50  RES      0                                                             
      SNPSQMRK                 <==== SAY WE ARE HERE                            
         LW,R5    R6                POINT AT NEXT ENTRY AGAIN                   
         BAL,RLNK UNPKDIRE          GET ITS STATUS                              
         LI,R0    FILBDTRK                                                      
         CW,R0    DIRESTAT          IS IT A FILE'S ENTRY ?                      
         BE       SQUEZ70             NO, BADSECTOR; FIND A FILLER FILE         
*                                                                               
         LW,R15   MASDSIZE          IS THERE ROOM FOR THE FILE AT THE           
         SW,R15   MASDFREE          END OF THE AREA (SAVE ROOM FOR OLD          
         SW,R15   MASDNDS           # DIRE SECTORS) ?                           
         CW,R15   DIRENSEC          WILL IT FIT AT END OF AREA ?                
         BL       SQUEZ52             NO, FIND HOLE ANOTHER WAY                 
*                                                                               
         XW,R11   MASDFREE          SAVE SQUEZ PTR, SET WHERE TO MOVE           
         BAL,RLNK SQMOVFIL          MOVE FILE TO ITS NEW LOCATION               
         AW,R11   DIRENSEC          SET NEW LAST USED SECTOR AND                
         XW,R11   MASDFREE          UPDATE FREE SPACE POINTER; RECOVER          
*                                   WHERE LAST SQUEEZED FILE WAS                
         LW,R2    R5                POINT AT ENTRY WE MOVED                     
         BAL,RLNK SQUNLNK           REMOVE FROM THE CHAIN                       
         LW,R6    R3                SET NEXT IN CHAIN AS NEW CURRENT            
         LW,R5    ENDCHAIN          SET LAST ENTRY IN CHAIN AS CURRENT          
         BAL,RLNK SQLNKBHD          PUT MOVED FILE AS NEW LAST ENTRY            
      SNPSQCHN                 <====                                            
         LW,R5    R6                GET PTR TO NEXT FILE NOT SQUEEZED           
         B        SQUEZ41           SEE IF NEXT XTNT FITS YET                   
         PAGE                                                                   
*                                                                               
*                       NO ROOM AT END OF THE AREA: LOOK FOR AN UNUSED          
*                       HOLE (DELETED OR LOST SECTORS) BIG ENOUGH FOR           
*                       THE NEXT ENTRY. MOVE ENTRY TO HOLE IF FOUND.            
*                                                                               
SQUEZ52  RES      0         SCAN FOR LOST SPACE                                 
      SNPSQMRK                 <==== SAY WE ARE HERE                            
         LW,R12   DIRENSEC          GET SIZE OF SPACE WE WILL NEED              
         LW,R5    FWDLINK,R5        DON'T FIND SPACE AFTER FIRST ENTRY          
         BAL,RLNK UNPKDIRE          AS LINKS WILL BECOME CONFUSED               
*                                                                               
SQUEZ53  RES      0         LOOK BETWEEN LAST AND NEXT ENTRIES                  
         LW,R13   DIREEOT           GET POSSIBLE BEGIN OF SPACE                 
         AI,R13   +1                                                            
         LW,R5    FWDLINK,R5        POINT AT NEXT ENTRY                         
         BEZ      SQUEZ54             NO NEXT: NO SPACE; DO BAD THINGS          
*                                                                               
         BAL,RLNK UNPKDIRE          GET INFO ON NEXT FILE ENTRY                 
         LW,R15   DIREBOT           CALCULATE SPACE BETWEEN THE TWO             
         SW,R15   R13               (BOT OF NEXT)-(EOT+1 OF PREV)               
         CW,R15   R12               IS IT BIG ENOUGH FOR MOVE ?                 
         BL       SQUEZ53             NO, LOOK ON                               
*                                                                               
         PUSH     R5                YES, SAVE WHERE HOLE IS                     
         LW,R5    R6                POINT BACK AT ENTRY TO MOVE                 
         BAL,RLNK UNPKDIRE                                                      
         XW,R11   R13               SAVE SQUEEZE PTR; SET COPY ADDR             
         BAL,RLNK SQMOVFIL          MOVE DATA, UPDATE ENTRY                     
         XW,R11   R13               RESET NEXT SECTOR TO SQUEEZE TO             
         LW,R2    R5                UNLINK THE MOVED ENTRY FROM                 
         BAL,RLNK SQUNLNK           WHERE IT WAS                                
         LW,R6    R3                SAVE POINTER TO NEW NEXT ENTRY              
         PULL     R5                RECOVER WHERE IT WAS MOVED TO               
         BAL,RLNK SQLNKAHD          AND INSERT BEFORE THAT ENTRY                
      SNPSQCHN                 <====                                            
         LW,R5    R6                POINT AT NEW NEXT ENTRY TO BE               
         B        SQUEZ41           PROCESSED; TEST FOR ROOM NOW                
*                                                                               
*                                                                               
*                                                                               
***********************************************************************         
*                                                                               
*       THE NEXT ENTRY IN THE CHAIN CANNOT BE MOVED OUT OF THE WAY              
*        TO A FREE OR UNUSED SPACE.   THE FOLLOWING ALGORITHM IS A              
*        LAST RESORT.      IF THERE ARE NO 'BADSECTOR' ENTRIES BETWEEN          
*        (NEXT ENTRY (AT R5)) THROUGH (NEXT EXTENT (AT R7)), THEY WILL          
*        BE ROTATED SO (R7) WILL BE BEFORE (R5), AND THE ENTRY BEFORE           
*        (R7) MOVED UP OVER EXTENT (R7)'S OLD SPACE.   ANY LOST OR              
*        DELETED SPACE IN THE RANGE IS RECOVERED IN THE PROCESS TO              
*        MAKE AS LARGE A HOLE FOR THE NEXT EXTENT AS POSSIBLE.                  
*       IF THERE ARE ANY 'BADSECTOR' ENTRIES IN THE RANGE, THE EXTENT           
*        CHAIN IS BROKEN AT THE NEXT EXTENT (IN R7), MAKING THE                 
*        ENTRY THE FIRST ENTRY IN A SEPARATE CHAIN.  THE NEXT ENTRY             
*        WHICH HAS BEEN KEPT IN R6 IS MADE CURRENT AGAIN AND SQUEEZED           
*        AFTER BREAKING ITS BACKWARD EXTENT LINK.                               
*                                                                               
*                                                                               
*        R0       STATUS CODE FOR A 'BADSECTOR' ENTRY ('FILBDTRK')              
*        R6       NEXT UNPROCESSED ENTRY ON CHAIN                               
*        R7       NEXT EXTENT TO BE SQUEEZED IF IT CAN BE MOVED TO              
*                 THE SPACE AFTER LAST SQUEEZED ENTRY. IT IS EITHER A           
*                 PREVIOUS EXTENT OF THE ENTRY IN R5, OR THE NEXT               
*                 EXTENT AFTER THE ONE JUST SQUEEZED INTO PLACE.                
*        R10      XTNT NUMBER OF LAST EXTENT SQUEEZED                           
*                                                                               
SQUEZ54  RES      0         TEST FOR 'BADSECTOR' ENTRIES IN WAY OF ROTATE       
      SNPSQMRK                 <==== SAY WE ARE HERE                            
         LW,R5    R6                POINT BACK AT NEXT ENTRY AND GET            
         BAL,RLNK UNPKDIRE          LOWER LIMIT OF SECTORS THAT WILL            
         LCW,R12  DIREBOT           ROTATED UPWARDS                             
*                                                                               
SQUEZ55  RES      0         LOOP TO SEARCH FOR 'BADSECTOR' ENTRIES              
         LW,R5    FWDLINK,R5        GET NEXT ENTRY                              
         BAL,RLNK UNPKDIRE                                                      
         CW,R5    R7                ARE WE DONE WITH SEARCH ?                   
         BE       SQUEZ57             YES, NO 'BADSECTOR'S FOUND                
*                                                                               
         CW,R0    DIRESTAT          IS THE ENTRY A VALID FILE ?                 
         BNE      SQUEZ55             YES, LOOP TO TEST NEXT                    
*                                                                               
SQUEZ56  RES      0         CAN'T DO NEXT EXTENT; BREAK XTNT CHAIN              
*                                                                               
*        R6       NEXT EXTENT, THE EXTENT THAT CAN'T BE MOVED                   
*        R7       NEXT ENTRY IN CHAIN NOT YET PROCESSED                         
*                                                                               
         LW,R5    R7                POINT AT NEXT UNSQUEEZED EXTENT             
         BAL,RLNK UNPKDIRE          EXPAND FOR ALTERING IT                      
         XW,R5    R6                R5 <= NEXT ENTRY; R6 <= NEXT XTNT           
         AI,R10   1                 SET NEXT XTNT'S NUMBER = LAST + 1           
         STW,R10  DIREXTNT          TO KEEP CONTITUOUS NUMBERS                  
         BAL,RLNK PACKDIRE                                                      
         LI,R0    0                                                             
         LW,R1    XBACLINK,R7       CLEAR LINKS FROM LAST, TO NEXT              
         STW,R0   XBACLINK,R7       EXTENT TO MAKE TWO SEPARATE FILES           
         STW,R0   XFWDLINK,R1                                                   
         BAL,RLNK UNPKDIRE          GET INFO ON NEXT ENTRY TO DO                
      SNPSQCHN                 <====                                            
         B        SQUEZ32           AND GO MOVE TO SQUOOZED PLACE               
         PAGE                                                                   
*                                                                               
************************************                                            
*                                                                               
*        NO BADSECTOR ENTRIES IN WAY. MOVE NEXT EXTENT OF FILE TO               
*        NEXT SECTOR OF SQUEEZED SPACE.                                         
*                                                                               
*        REGISTERS ARE:                                                         
*        R5       NEXT EXTENT OF THE FILE BEING PROCESSED.                      
*        R6       NEXT ENTRY IN CHAIN NOT YET PROCESSED.                        
*        R7       NEXT EXTENT OF FILE WHOSE PREVIOUS EXTENT WAS JUST            
*                 PROCESSED.                                                    
*        R12      - (BOT OF NEXT ENTRY, = LAST ENTRY TO MOVE UP)                
*                                                                               
*                                                                               
SQUEZ57  RES      0         MOVE ENTRY (R7) TO BEFORE ENTRY (R6)                
      SNPSQCHN                 <====                                            
         LW,R15   BCKEND            COMPUTE SIZE OF BKG SPACE AVAILABLE         
         LW,R0    BIBUFF            AFTER DIRECTORY CHAIN FOR COPY              
         AND,R0   M17               BUFFERS                                     
         SW,R15   R0                END MEMORY - BUFFER BEGIN                   
         AI,R15   1                 ADJUST FOR INCLUSIVE END ADDRESS            
         SLS,R15  -1                DIVIDE IN 2 FOR TEMP BUFFER FOR             
         CI,R15   X'4000'           FILE SPACE; LIMIT TRANSFERS TO              
         BLE      %+2               65K MAX                                     
         LI,R15   X'4000'                                                       
         DW,R15   MASDWPS           GET NUMBER IN SECTORS                       
         BEZ      SQUEZ56           NOTHING!!? IMPOSSIBLE, SO SKIP COPY         
*                                                                               
         XW,R6    R7                SWITCH POINTERS TO FREE R6                  
*                                                                               
*        R5       NEXT EXTENT                                                   
*        R6       NEXT EXTENT                                                   
*        R7       NEXT ENTRY (EXTENT R6 WILL BE MOVED TO BEFORE HERE)           
*                                                                               
         PUSH     R9                SAVE SIZE OF NORMAL COPY BUFFER             
         LW,R9    R15               AND USE NEW HALFSIZED BUFFERS               
         AW,R12   DIREBOT           GET # SECTORS TO ROTATE                     
         CI,R12   1000              IF MORE THAN 1000 ARE INVOLVED              
         BLE      SQUEZ58             NOT 1000, SO JUST DO IT                   
*                                                                               
         SLS,R12  2                 ADJUST BY *4 TO SEE IF                      
         CW,R12   MASDSIZE          MORE THAN 1/4 OF AREA INVOLVED ?            
         BL       SQUEZ58             NO, JUST DO IT ANYHOW                     
*                                                                               
         PUSH     LINK              SAVE LINK REGISTER                          
         LI,R15   SKWEZMSG          POINT AT MESSAGE                            
         BAL,LINK TYPRNT            OUT WARNING MESSAGE                         
         PULL     LINK                                                          
*                                                                               
SQUEZ58  RES      0         READY TO ROTATE FILE TO PLACE                       
         MTW,+1   MASDNFIL          SET DIRE & AREA ALTERED                     
         LW,R10   DIRENSEC          SAVE SIZE OF FILE TO BE MOVED               
         LW,R13   DIREBOT           SAVE WHERE IT STARTS                        
         LW,R2    R5                MOVE THE ENTRY; UNLINK FROM ITS             
         BAL,RLNK SQUNLNK           CURRENT ENTRY POSITION                      
         LW,R3    R1                SAVE LOCATION OF LAST ENTRY TO BE           
*                                   RELOCATED UP OVER ENTRY (R5)                
         LW,R5    R7                INSERT IT AS NEXT UNPROCESSED ENTRY         
         BAL,RLNK SQLNKAHD          & AFTER PREVIOUS EXTENT                     
         LW,R7    R2                SAVE POINTER TO IT                          
*                                                                               
*        R3       LAST ENTRY OF FILES TO BE MOVED UP OVER NEXT EXTENT           
*        R7       NEXT EXTENT, DIRE CHAIN ENTRY NOW IN PROPER ORDER.            
*                                                                               
*        ENTRIES (R7 + 1) THRU (R3) WILL BE MOVED UP                            
*                                                                               
         LW,R2    R9                SET MAX SECTORS TO ROTATE PER LOOP          
         LW,R1    R9                COMPUTE OFFSET TO SECOND HALF OF            
         MW,R1    MASDWPS           BUFFER IN WORDS                             
         LW,R14   R11               SET WHERE (R7) FILE WILL BE MOVED           
*                                                                               
*        REGISTERS NOW CONTAIN:  (+ ==> SET ELSEWHERE, USED EVERYWHERE)         
*                                                                               
*        R1       NUMBER OF WORDS IN BKG BUFFERS (& OFFSET TO BUFFER 2)         
*        R2       SIZE OF TEMP BUFFER IN BKG SPACE                              
*        R3       PTR TO LAST ENTRY TO MOVE UP                                  
*        R7       PTR TO NEXT EXTENT, FILE TO MOVE VIA BKG                      
*        R8  +    LAST ENTRY ON CHAIN                                           
*        R9       NUMBER OF SECTORS IN BKG BUFFER                               
*        R10      SIZE OF FILE BEING MOVED (SIZE OF FILE AT R7)                 
*        R11 +    NEXT SECTOR FOR A SQUEEZED FILE                               
*        R13      NEXT SECTOR OF FILE (R7) TO MOVE TO BKG                       
*        R14      SECTOR TO WRITE BKG TO WHEN MOVED BACK TO AREA                
*                                                                               
SQUEZ60  RES      0         MOVE NEXT SIZE OF BKG SECTORS OF FILE (R7)          
         PUSH     R14               SAVE WHERE FILE WILL END UP                 
         CW,R2    R10               IS BKG BIGGER THAN FILE TO MOVE ?           
         BLE      %+2                 NO, MOVE BKG SIZED PIECE                  
*                                                                               
         LW,R2    R10               YES, MOVE ONLY FILE LENGTH                  
*                                                                               
         STW,R13  RDDISC5           SET NEXT SECTOR OF (R7) TO COPY             
         AWM,R1   BIBUFF            POINT TO 2ND BUFFER IN BKG                  
         LW,R15   R2                SET SIZE TO READ FROM FILE                  
         MW,R15   MASDWPS                                                       
         SLS,R15  2                                                             
         STW,R15  RDDISC4                                                       
         STW,R15  R0                SAVE AS LENGTH TO READ BACK                 
         CAL1,1   RDDISC            FILL BUFFER 2 WITH (R7) DATA                
         LCW,R15  R1                READJUST POINTER TO BUFFER 1                
         AWM,R15  BIBUFF                                                        
         STW,R13  WRDISC5           SET NEW EOT+1 OF 1ST (NEXT) FILE            
         AWM,R2   WRDISC5           TO BE MOVED UP                              
      SNPSQREG                 <==== SAY WE ARE HERE WITH WHAT REGS             
         LW,R5    R3                POINT AT FIRST FILE TO MOVE UP              
*                                                                               
SQUEZ62  RES      0         MOVE A FILE UP                                      
         BAL,RLNK UNPKDIRE          GET INFO ON THE FILE                        
         CW,R5    R7                HAVE WE DONE ALL THE FILES YET ?            
         BE       SQUEZ66             YES, MOVE DATA IN BKG BACK                
*                                                                               
         LW,R15   DIREEOT           SET END+1 OF NEXT GROUP OF SECTORS          
         AI,R15   1                 TO MOVE UP                                  
         STW,R15  RDDISC5                                                       
         LW,R15   WRDISC5           UPDATE BOT, EOT FOR FILE TO SHOW            
         STW,R15  DIREEOT           WHAT IT WILL HAVE AFTER IT IS               
         SW,R15   DIRENSEC          MOVED                                       
         STW,R15  DIREBOT                                                       
         MTW,-1   DIREEOT                                                       
         LW,R12   DIRENSEC          SET NUMBER OF SECTORS TO COPY               
      SNPSQREG                 <====                                            
*                                                                               
SQUEZ64  RES      0         MOVE (R12) SECTORS UP                               
         LW,R15   R12               ASSUME ALL WILL GO THIS PASS                
         SW,R12   R9                ADJUST REMAINDER BY LOOP COUNT              
         BLEZ     %+2                LAST PASS, DOING JUST REMAINDER            
         LW,R15   R9                TOO MANY, LIMIT TO BUFFER SIZE              
         LCW,R14  R15               ADJUST EOT'S DOWN BY SIZE OF                
         AWM,R14  RDDISC5           BLOCK BEING MOVED                           
         AWM,R14  WRDISC5                                                       
         MW,R15   MASDWPS           COMPUTE BLOCK SIZE IN                       
         SLS,R15  2                 BYTES AND SET IN COUNT FIELDS               
         STW,R15  RDDISC4           FOR READ                                    
         STW,R15  WRDISC4           WRITE                                       
         CAL1,1   RDDISC            MOVE THE BLOCK UP ON DISK                   
         CAL1,1   WRDISC            (TO HIGHER ADDRESSES)                       
         CI,R12   0                 ARE WE DONE YET ?                           
         BGZ      SQUEZ64             NO, LOOP FOR MORE OF FILE                 
*                                                                               
         LW,R6    R5                STORE UPDATED BOT, EOT                      
         BAL,RLNK PACKDIRE                                                      
         LW,R5    BACLINK,R5        POINT AT ENTRY BEFORE THIS ONE              
         B        SQUEZ62           AND GO MOVE IT                              
*                                                                               
*                                                                               
SQUEZ66  RES      0         FILES MOVED UP: GET FILE BACK FROM BKG              
         PULL     R14               GET WHERE TO WRITE BKG FILE TO              
         LW,R15   WRDISC5           GET BOT OF NEXT FILE AFTER CURR             
         STW,R14  WRDISC5           SET COPY IN DISC ADDRESS                    
         AW,R14   R2                STEP NEXT WRITE ADDR TO END THIS 1          
*        R14      NEXT SECTOR FOR DATA FROM FILE AT (R7), OR EOT+1              
*                                   IF FILE IS NOW COMPLETELY MOVED.            
*        R15      NEW BOT OF NEXT FILE IN CHAIN (LAST FILE MOVED UP).           
*                                                                               
         PUSH     2,R14             AND SAVE POINTERS OVER COPY                 
         AWM,R1   BIBUFF            POINT BACK UP AT BUFFER 2                   
         STW,R0   WRDISC4           SET LENGTH TO WRITE                         
         CAL1,1   WRDISC            AND WRITE DATA BACK TO REAL FILE            
         LCW,R15  R1                FIX UP BUFFER ADDRESS AGAIN                 
         AWM,R15  BIBUFF                                                        
         PULL     2,R14             RECOVER UPDATED POINTERS                    
         AW,R13   R2                STEP START SECTOR TO MOVE TO BKG            
         SW,R10   R2                AND DEC COUNT YET TO COPY                   
         BLEZ     SQUEZ68             COUNT = 0 ==> FILE MOVED                  
*                                                                               
         SW,R15   R14               IS THERE ROOM FOR REST OF FILE NOW          
         CW,R15   R10               IN HOLE AFTER PARTIALLY MOVED FILE          
         BL       SQUEZ60             NO, MOVE IN ANOTHER PIECE                 
*                                                                               
         STW,R13  RDDISC5           YES, COPY IT DOWN IMMEDIATELY               
         STW,R14  WRDISC5           FROM WHERE IT IS TO NEW SPOT                
         LW,R12   R10               SET LENGTH REMAINING                        
         LI,R1    RDDISC            SET FPT'S TO USE                            
         LI,R2    WRDISC                                                        
         AW,R10   R14               COMPUTE EOT+1 OF FILE AFTER COPY            
      SNPSQREG                 <==== SNAP REGISTERS                             
         BAL,RLNK SQMOVDTA          MOVE IT                                     
         LW,R14   R10               SET EOT+1 OF MOVED EXTENT                   
*                                                                               
SQUEZ68  RES      0         FILE (EXTENT) MOVED AFTER PREVIOUS                  
         STW,R11  DIREBOT           SET NEW BOT                                 
         LW,R15   R11                                                           
         AW,R15   DIRENSEC          COMPUTE EOT                                 
         STW,R15  DIREEOT           (AND HOPE IT IS STILL SAME SIZE)            
         MTW,-1   DIREEOT           ADJUST FOR INCLUSIVE EOT ADDR               
         CW,R14   R15               ARE THEY STILL THE SAME SIZE ?              
         BNE      %                 LOOP FOREVER IF NOT                         
         LW,R6    R5                STORE UPDATED INFO IN THE DIRE              
         BAL,RLNK PACKDIRE                                                      
         PULL     R9                RECOVER NORMAL SIZE OF COPY BUFFER          
      SNPSQENT                 <====                                            
         B        SQUEZ35           GO UPDATE NEXT SECTOR POINTER, ETC          
         PAGE                          PROCESS A BADSECTOR ENTRY                
         SPACE    2                    -------------------------                
*        R6       NEXT ENTRY IN CHAIN TO BE PROCESSED (= 'BADSECTOR')           
*        R7       NEXT EXTENT OF FILE THAT CAN'T BE MOVED AFTER PREV            
*        R10      NUMBER OF PREVIOUS, LAST SQUEEZED, EXTENT                     
*                                                                               
SQUEZ70  RES      0         BREAK XTNT CHAIN; NEXT XTNT NOT PROCESSABLE         
         LI,R1    0                 SET NO LINK VALUE                           
         XW,R1    XBACLINK,R7       GET, CLEAR NEXT EXTENT'S BACK LINK          
         BEZ      SQUEZ71           NO PREVIOUS ?, HOW?, SKIP ON                
*                                                                               
      SNPSQREG                 <====                                            
         LI,R0    0                 CLEAR PREVIOUS EXTENT'S FWD LINK            
         STW,R0   XFWDLINK,R1                                                   
         LW,R5    R7                SET XTNT NUMBER OF NEXT EXTENT =            
         BAL,RLNK UNPKDIRE          ONE GREATER THAN PREVIOUS IN CASE           
         AI,R10   1                 ANY WERE COMBINED ARE THERE ARE             
         STW,R10  DIREXTNT          GAPS IN THE SEQUENCE NOW.                   
         XW,R5    R6                R5 <= NEXT ENTRY (= 'BADSECTORS')           
*                                   R6 <= NEXT EXTENT = ONE TO UPDATE           
         BAL,RLNK PACKDIRE          STORE NEW EXTENT NUMBER IN ENTRY            
*                                                                               
SQUEZ71  RES      0         PROCESS A 'BADSECTOR' ENTRY                         
      SNPSQCHN                 <====                                            
         LW,R10   DIREBOT           COMPUTE SPACE TO BE FILLED                  
         SW,R10   R11               BETWEEN LAST FILE AND BADSECTOR             
         BEZ      SQUEZ35             NONE: UPDATE NEXT SECTOR TO USE           
*                                                                               
         LI,R1    0                 SET PASS 1: FIND BEST FIT                   
         LD,R2    ZEROS             SET NO FIT FOUND YET                        
*                                                                               
SQUEZ72  RES      0         LOOP TO FIND A FIT                                  
         PUSH     R5                SAVE WHERE WE ARE IN SQUEEZE                
*                                                                               
SQUEZ73  RES      0         TEST NEXT ENTRY IN CHAIN FOR A FIT IN HOLE          
         LW,R5    FWDLINK,R5        STEP TO NEXT TO TRY FOR A FIT               
         BEZ      SQUEZ81             NO MORE; SEE IF ONE FOUND                 
*                                                                               
         BAL,RLNK UNPKDIRE          GET ITS STATUS, SIZE                        
         LW,R0    DIRESTAT          IS ENTRY A VALID FILE ?                     
         CI,R0    FILGOODF           THAT IS MOVEABLE ?                         
         BNE      SQUEZ73             NO, SKIP ON TO NEXT ENTRY                 
*                                                                               
         CI,R1    0                 ARE WE LOOKING FOR BEST FIT ?               
         BNE      SQUEZ74             NO, TEST ALL EXTENT ZEROS                 
*                                                                               
         MTW,+0   DIREESIZ          IS FILE EXTENSIBLE ?                        
         BNEZ     SQUEZ73             YES, DON'T ACCEPT THIS PASS               
*                                                                               
SQUEZ74  RES      0         TEST ONLY EXTENT 0 FOR MOVING TO HOLE               
         MTW,+0   DIREXTNT          IS THIS AN EXTENT 0 ?                       
         BNEZ     SQUEZ73             NO, DO NOT TRY TO MOVE IT                 
*                                                                               
         CW,R10   DIRENSEC          WILL FILE FIT IN THE HOLE ?                 
         BL       SQUEZ73             NO, SKIP ON TO NEXT ENTRY                 
         BE       SQUEZ80           EXACT FIT: USE IT AND STOP SEARCH           
*                                                                               
         CW,R3    DIRENSEC          WAS PREVIOUS FIT A BETTER ONE ?             
         B        %+1,R1            TEST ACCORDING TO PASS IN R1                
*                                                                               
         BGE      SQUEZ73           SMALLER, KEEP PREVIOUS                      
         B        SQUEZ76           BIGGER,  KEEP THIS ONE                      
*                                                                               
         BLE      SQUEZ73           BIGGER,  KEEP PREVIOUS                      
*                                                                               
SQUEZ76  RES      0         BETTER FIT FOR HOLE FOUND; MARK WHERE               
         LW,R3    DIRENSEC          SAVE SIZE OF THE BEST FIT AND               
         LW,R2    R5                WHERE WE FOUND IT                           
         B        SQUEZ73           GO TEST FOR ANOTHER                         
         PAGE                                                                   
         SPACE    2                                                             
SQUEZ80  RES      0         EXACT FIT FOUND: USE IT                             
         LW,R2    R5                SET WHERE IT IS                             
*                                                                               
SQUEZ81  RES      0         END OF SEARCH: WAS A FILE FOUND                     
         PULL     R5                GET POINTER TO NEXT (BAD) ENTRY             
         CI,R2    0                 WAS A FILE TO MOVE TO HOLE FOUND ?          
         BEZ      SQUEZ85             NO, TEST IF ANOTHER PASS TO GO            
*                                                                               
         BAL,RLNK SQUNLNK           UNLINK ENTRY FROM CURRENT SPOT              
         BAL,RLNK SQLNKAHD          INSERT BEFORE BADSECTOR ENTRY               
         LW,R5    R2                SET NEW ENTRY AS CURRENT                    
         BAL,RLNK UNPKDIRE          GET INFO ON NEXT FILE TO MOVE               
      SNPSQCHN                 <====                                            
         B        SQUEZ34           MOVE TO SQUEEZED PLACE                      
*                                                                               
*                                                                               
SQUEZ85  RES      0         NO FIT FOUND FOR HOLE; TEST FOR 2ND PASS            
         LW,R3    R10               PREPARE FOR PASS 2: LOOK FOR THE            
         AI,R1    2                 SMALLEST EXTENT 0 THAT FITS                 
         CI,R1    2                 HAVE WE DONE PASS 2 YET ?                   
         BLE      SQUEZ72             NO, GO DO IT                              
*                                                                               
         BAL,RLNK SQDELFIL          YES, CREATE A DELETED ENTRY TO FILL         
      SNPSQCHN                 <====                                            
         B        SQUEZ35           GO STEP POINTERS, DO NEXT ENTRY             
*                                                                               
*                                                                               
*                                                                               
SKWEZMSG TXTC     'EXTENDED SQUEEZE -- DO NOT ABORT'                            
         PAGE                          SUBROUTINES FOR SQUEEZE, SKWEZ           
         SPACE    2                    ------------------------------           
*********                                                                       
*                                                                               
SQUNLNK  RES      0         UNLINK ENTRY AT R2 FROM CHAIN                       
*        RETURNS: R1:  BAC LINK ENTRY                                           
*                 R2:  THE UNLINKED ENTRY                                       
*                 R3:  FWD LINK ENTRY                                           
*                 UPDATES DIRCHAIN OR ENDCHAIN IF ENTRY WAS 1ST OR LAST         
         LW,R1    BACLINK,R2        SET POINTER TO PREVIOUS ENTRY               
         LW,R3    FWDLINK,R2        AND POINTER TO NEXT ENTRY                   
         BEZ      SQUNLNK1            NO NEXT; THIS WAS LAST ENTRY              
*                                                                               
         STW,R1   BACLINK,R3        WAS A NEXT; POINT IT TO PREVIOUS            
         B        SQUNLNK2          AND PROCESS BACLINKS                        
*                                                                               
SQUNLNK1 RES      0         UPDATE LAST ENTRY ON CHAIN POINTER                  
         STW,R1   ENDCHAIN          SET PREVIOUS AS NEW LAST                    
*                                                                               
SQUNLNK2 RES      0         FIX FWD LINKS OF PREVIOUS ENTRY                     
         CI,R1    0                 IS THERE A PREVIOUS ENTRY ?                 
         BEZ      SQUNLNK3            NO, THIS WAS THE FIRST                    
*                                                                               
         STW,R3   FWDLINK,R1        WAS A PREV; POINT IT TO NEW NEXT            
         B        *RLNK             AND RETURN                                  
*                                                                               
SQUNLNK3 RES      0         UPDATE FIRST ENTRY ON CHAIN POINTER                 
         STW,R3   DIRCHAIN          SET NEW NEXT AS NEW FIRST                   
*                                                                               
SQUNLNK4 RES      0         ALL DONE; RETURN TO CALLER                          
         B        *RLNK             RETURN                                      
         PAGE                          SUBROUTINES FOR SQUEEZE, SKWEZ           
         SPACE    2                    ------------------------------           
*********                                                                       
*                                                                               
SQUNLNKX RES      0         UNLINK ENTRY AT R2 FROM EXTENT CHAIN                
*        RETURNS: R1: BAC LINK EXTENT ENTRY                                     
*                 R2: THE UNLINKED ENTRY                                        
*                 R3: FWD LINK EXTENT ENTRY                                     
*                                                                               
         LW,R1    XBACLINK,R2       GET POINTER TO PREVIOUS EXTENT              
         LW,R3    XFWDLINK,R2       GET, TEST POINTER TO NEXT EXTENT            
         BEZ      SQUNLNKA            NO NEXT; NO BAC LINK TO FIX               
*                                                                               
         STW,R1   XBACLINK,R3       POINT NEXT EXTENT AT PREVIOUS               
*                                                                               
SQUNLNKA RES      0         FIX UP FWD EXTENT LINK OF PREV EXTENT               
         CI,R1    0                 IS THERE A PREVIOUS EXTENT ?                
         BEZ      SQUNLNKB            NO, SKIP FIX                              
*                                                                               
         STW,R3   XFWDLINK,R1       SET NEW NEXT                                
*                                                                               
SQUNLNKB RES      0                                                             
         B        *RLNK             RETURN TO CALLER                            
         PAGE                          SUBROUTINES FOR SQUEEZE, SKWEZ           
         SPACE    2                    ------------------------------           
*********                                                                       
*                                                                               
SQLNKAHD RES      0         LINK ENTRY AT R2 IN AHEAD OF ENTRY AT R5            
*        RETURNS: R1: POINTER TO OLD PREVIOUS ENTRY                             
*                 R2: THE INSERTED ENTRY                                        
*                 R5: THE ENTRY INSERTED BEFORE                                 
*                 UPDATES DIRCHAIN IF ENTRY IS NEW FISRT ENTRY                  
*                                                                               
         LW,R1    BACLINK,R5        GET POINTER TO PREV; IS THERE ONE ?         
         BEZ      SQLNKA1             NO, WILL BE NEW FIRST ENTRY               
*                                                                               
         STW,R2   FWDLINK,R1        INTERIOR ENTRY; SET LINK TO IT              
         B        SQLNKA2           AND GO UPDATE BAC LINKS                     
*                                                                               
SQLNKA1  RES      0         NEW FIRST ENTRY ON CHAIN: SET DIRCHAIN              
         STW,R2   DIRCHAIN                                                      
*                                                                               
SQLNKA2  RES      0         SET BAC LINK FROM R5, ETC                           
         STW,R1   BACLINK,R2        POINT INSERT BAC AT OLD PREVIOUS            
         STW,R2   BACLINK,R5        POINT CURRENT BACK AT INSERT                
         STW,R5   FWDLINK,R2        POINT INSERT FWD TO CURRENT                 
         B        *RLNK             DONE, SO EXIT                               
         PAGE                          SUBROUTINES FOR SQUEEZE, SKWEZ           
         SPACE    2                    ------------------------------           
*********                                                                       
*                                                                               
SQLNKBHD RES      0         LINK ENTRY AT R2 IN BEHIND ENTRY AT R5              
*        RETURNS: R2: THE INSERTED ENTRY                                        
*                 R3: POINTER TO OLD NEXT ENTRY                                 
*                 R5: THE ENTRY INSERTED BEHIND                                 
*                 UPDATES ENDCHAIN IF ENTRY IS NEW LAST ON CHAIN                
*                                                                               
         LW,R3    FWDLINK,R5        GET PTR TO NEXT; IS THERE A NEXT ?          
         BEZ      SQLNKB1             NO NEXT; NEW LAST ENTRY                   
*                                                                               
         STW,R2   BACLINK,R3        POINT OLD NEXT BAC AT INSERT                
         B        SQLNKB2           AND SET NEW FWD LINKS                       
*                                                                               
SQLNKB1  RES      0         NEW LAST ENTRY: SET NEW ENDCHAIN                    
         STW,R2   ENDCHAIN          SET NEW ADDR OF TAIL OF CHAIN               
*                                                                               
SQLNKB2  RES      0         FIX UP REST OF LINKS                                
         STW,R3   FWDLINK,R2        POINT INSERT AT OLD NEXT                    
         STW,R2   FWDLINK,R5        POINT CURRENT FWD TO INSERT                 
         STW,R5   BACLINK,R2        POINT INSERT BAC AT CURRENT                 
         B        *RLNK             AND EXIT ALL DONE                           
         PAGE                          SUBROUTINES FOR SQUEEZE, SKWEZ           
         SPACE    2                    ------------------------------           
*********                                                                       
*                                                                               
SQMOVFIL RES      0         MOVE FILE TO (R11), UPDATE DIRE ENTRY               
         PUSH     RLNK              SAVE RETURN ADDRESS                         
         LW,R0    DIREBOT           SET READ FROM ADDRESS                       
         STW,R0   RDDISC5           = OLD BOT                                   
         STW,R11  WRDISC5           WRITE ADDRESS = NEW BOT                     
         STW,R11  DIREBOT           AND SET NEW BOT TOO                         
         LW,R0    R11               COMPUTE NEW EOT                             
         AW,R0    DIRENSEC                                                      
         AI,R0    -1                                                            
         STW,R0   DIREEOT                                                       
         LW,R12   DIRENSEC          SET SECTOR COUNT TO MOVE                    
         LI,R1    RDDISC            SET FPT TO READ WITH                        
         LI,R2    WRDISC            AND FPT TO WRITE WITH                       
         BAL,RLNK SQMOVDTA          MOVE THE DATA                               
         PULL     RLNK              RECOVER LINK ADDRESS                        
         LW,R6    R5                SET PACK POINTER                            
         B        PACKDIRE          UPDATE DIRE ENTRY;                          
*                                   PACKDIRE RETURNS TO OUR CALLER              
         PAGE                          SUBROUTINES FOR SQUEEZE, SKWEZ           
         SPACE    2                    ------------------------------           
SQMOVDTA RES      0         MOVE DATA FROM PLACE TO PLACE                       
*        INPUT:   R1 :   FPT TO USE TO READ THE DATA                            
*                 R2 :   FPT TO USE TO WRITE THE DATA BACK                      
*                 R9 :   NUMBER OF SECTORS IN BUFFER TO MOVE PER LOOP           
*                 R12:   NUMBER OF SECTORS TO COPY                              
*                 START SECTORS ARE ALREADY SET IN READ & WRITE FPTS            
*                 READ/WRITE FPTS MUST HAVE BYTE COUNTS IN WORD 4 AND           
*                 SECTOR (GRANULE) ADDRESS IN WORD 5                            
*                                                                               
         PUSH     RLNK              SAVE RETURN                                 
         MTW,+1   MASDNFIL          SET DIRE/AREA ALTERED: REWRITE DIRE         
*                                                                               
SQMOVDAT RES      0         LOOP TO MOVE DATA IN FILE                           
         LW,R15   R12               SET TO MOVE ALL THAT IS LEFT                
         SW,R12   R9                & DEC COUNT BY MAX SECTORS PER LOOP         
         BLEZ     %+2               MOVING MORE THAN MAX PER LOOP ?             
         LW,R15   R9                  YES, SET TO MOVE ONLY THAT MUCH           
         MW,R15   MASDWPS           CONVERT # SECTORS TO WORDS, THEN            
         SLS,R15  2                 BYTES                                       
         STW,R15  4,R1              AND SET READ AND WRITE BYTE COUNTS          
         STW,R15  4,R2                                                          
         CAL1,1   *R1               MOVE A BUFFER'S WORTH OF FILE               
         CAL1,1   *R2                                                           
         AWM,R9   5,R1              STEP SECTOR ADDRESSES BY NUMBER             
         AWM,R9   5,R2              MOVED                                       
         CI,R12   0                 ARE ALL MOVED YET ?                         
         BGZ      SQMOVDAT            NO, MOVE SOME MORE                        
*                                                                               
         PULL     RLNK              RECOVER RETURN LINK: WE ARE                 
         B        *RLNK             DONE, RETURN TO CALLER                      
         PAGE                          SUBROUTINES FOR SQUEEZE, SKWEZ           
         SPACE    2                    ------------------------------           
*********                                                                       
*                                                                               
SQDELFIL RES      0         NO FILE FITS HOLE; CREATE A DELETED FILE            
*        R5       'BADSECTOR' ENTRY A FILE WILL NOT FIT IN FRONT OF             
*        R10      NUMBER OF SECTORS IN UNUSED HOLE                              
*        R14=RLNK LINK TO THIS ROUTINE                                          
*                 IF AN ENTRY CAN BE CREATED, SQLNKAHD IS CALLED AND            
*                 IT RETURNS TO THE CALLER OF THIS ROUTINE;                     
*                 IF ANY ENTRY CANNOT BE CREATED, WE RETURN TO THE              
*                 CALLER TO IGNORE AND LOSE THE SPACE.                          
*                                                                               
         MTW,+1   MASDNFIL          SET DIRECTORY/AREA ALTERED                  
         LI,R1    -(DIREEND-DIRENAME)                                           
         LI,R0    0                 SET INFO = DELETED                          
         STW,R0   DIREEND,R1        STATUS = 0 ==> DELETED FILE                 
         BIR,R1   %-1                                                           
*                                                                               
         STW,R11  DIREBOT           SET BOT = NEXT AVAIL SECTOR                 
         STW,R10  DIRENSEC          AND SIZE OF THE ENTRY                       
         AW,R10   R11               AND SET EOT = BOT OF BADTRACK - 1           
         AI,R10   -1                                                            
         STW,R10  DIREEOT                                                       
         LI,R0    DIRSIZE+(2*#DFACNT)                                           
         STW,R0   DIRELEN           SET SIZE NEEDED FOR A GOOD FILE             
         LI,R0    SIZEDIR           GET SPACE NEEDED IN CHAIN FOR IT            
         AW,R0    FREECELL          + CURRENT END                               
         LI,R15   X'1FFFF'          GET ADDR OF COPY BUFFER TO SEE IF           
         AND,R15  BIBUFF            ENTRY OVERLAPS START.                       
         CW,R0    R15               DOES THE ENTRY OVERLAP BUFFER ?             
         BLE      SQDELF5             NO, OK TO USE ENTRY AT CHAIN END          
*                                                                               
         CI,R9    2                 AT LEAST 2 PAGES OF COPY BUFFER ?           
         BLE      *RLNK               NO, LOSE THE SPACE                        
*                                                                               
         LI,R1    256               YES, ADJUST BUFFER ADDRESS, SIZE            
         AWM,R1   BIBUFF                                                        
         DW,R1    MASDWPS           COMPUTE NUMBER OF SECTORS IT HAS            
         SW,R9    R1                SHRUNK BY TOO                               
*                                                                               
SQDELF5  RES      0         LINK NEW DELETED ENTRY INTO CHAIN                   
         PUSH     RLNK              SAVE RETURN ADDRESS                         
         LW,R6    FREECELL          GET CURRENT END = ADDR OF NEW ENTRY         
         STW,R0   FREECELL          SET NEW CURRENT END                         
         LW,R2    R6                POINT AT THE NEW ENTRY                      
         BAL,RLNK SQLNKAHD          INSERT AHEAD OF BADSECTOR ENTRY             
         LW,R5    R6                MAKE THE DELETED ENTRY CURRENT              
         BAL,RLNK PACKDIRE          STORE DATA FOR ENTRY IN CHAIN               
         LI,R0    0                 CLEAR XTNT LINKS JUST TO BE SURE            
         STW,R0   XBACLINK,R6                                                   
         STW,R0   XFWDLINK,R6                                                   
         PULL     RLNK              RECOVER RETURN LINK                         
         B        *RLNK             AND EXIT HERE DONE                          
         PAGE                       OLD STYLE SQUEEZE: RECLAIM SPACE            
         SPACE    2                                                             
*********                                                                       
*          SQUEEZE AREA VIA OLD PROCESS: JUST RECOVER LOST SPACE                
*                                                                               
*                                                                               
*        R9       # SECTORS IN COPY BUFFER                                      
*        R11      NEXT SECTOR TO USE FOR A SQUEEZED FILE'S BOT                  
*                                                                               
SKWEZ0   RES      0         PROCESS NEXT ENTRY TO COMPACT FILES                 
         BAL,RLNK UNPKDIRE          UNPACK TO GET BOT, EOT                      
         CW,R11   DIREBOT           IS FILE ALREADY IN PLACE ?                  
         BE       SKWEZ4              YES, LEAVE IN PLACE; GET NEXT             
*                                                                               
         LW,R0    DIRESTAT          IS THE ENTRY MOVEABLE ?                     
         CI,R0    FILBDTRK          (THAT IS, NOT A BAD TRACK ?)                
         BE       SKWEZ10             NO, TRY TO FILL HOLE                      
*                                                                               
SKWEZ2   RES      0         MOVE A FILE TO COMPACT SPACE; UPDATE DIRE           
         BAL,RLNK SQMOVFIL          MOVE FILE TO ITS NEW POSITION               
*                                                                               
SKWEZ4   RES      0         UPDATE NEXT SECTOR ADDRESS: STEP TO NEXT            
         AW,R11   DIRENSEC          POINT AT NEXT SECTOR TO USE                 
         LW,R5    FWDLINK,R5        STEP TO NEXT ENTRY: IS THERE ONE ?          
         BNEZ     SKWEZ0              YES, PROCESS IT                           
*                                                                               
         LW,R5    ENDCHAIN          DONE: POINT AT LAST ENTRY AGAIN             
         B        SQUEZ37           HOP INTO NEW SQUEZ TO TEST IF               
*                                   ROOM FOR DIRE SECTORS AT END                
         PAGE                                                                   
         SPACE    2                                                             
SKWEZ10  RES      0         PROCESS A 'BADTRACK' ENTRY                          
         LW,R10   DIREBOT           COMPUTE SPACE BETWEEN LAST FILE             
         SW,R10   R11               AND THE BADTRACK START                      
         PUSH     R5                SAVE CURRENT ENTRY POINTER                  
         LD,R2    ZEROS             SET NO BEST FIT FOUND                       
*                                                                               
SKWEZ11  RES      0         FIND A FILE TO MOVE INTO HOLE BEFORE BDTRCK         
         LW,R5    FWDLINK,R5        STEP TO NEXT TO TRY FOR A FIT               
         BEZ      SKWEZ13             NO MORE; SEE IF ONE FOUND                 
*                                                                               
         BAL,RLNK UNPKDIRE          GET ITS STATUS, SIZE                        
         LW,R0    DIRESTAT          IS ENTRY A VALID FILE ?                     
         CI,R0    FILGOODF           THAT IS MOVEABLE ?                         
         BNE      SKWEZ11             NO, SKIP ON TO NEXT ENTRY                 
*                                                                               
         CW,R10   DIRENSEC          WILL IT FIT IN THE HOLE ?                   
         BL       SKWEZ11             NO, SKIP IT                               
         BE       SKWEZ12           EXACT FIT:  USE IT                          
*                                                                               
         CW,R3    R10               WAS PREVIOUS FIT A BETTER ONE ?             
         BGE      SKWEZ11             YES, KEEP PREVIOUS FILE                   
*                                                                               
         LW,R3    DIRENSEC          NO, THIS IS BETTER; SAVE SIZE AND           
         LW,R2    R5                WHERE IT IS                                 
         B        SKWEZ11           AND TEST THE REST FOR A BETTER FIT          
*                                                                               
SKWEZ12  RES      0         EXACT FIT FOUND: SET WHERE FOR MOVE                 
         LW,R2    R5                MAKE PREVIOUS BEST FIT THE EXACT FIT        
*                                                                               
SKWEZ13  RES      0         END OF SEARCH: WAS A FILE TO MOVE FOUND             
         PULL     R5                RECOVER CURRENT PLACE IN COMPACTING         
         CI,R2    0                 WAS A FILE TO BE MOVED FOUND ?              
         BEZ      SKWEZ17             NO, FORM A DELETED ENTRY                  
*                                                                               
         BAL,RLNK SQUNLNK           UNLINK THE ENTRY FROM PRES PLACE            
         BAL,RLNK SQLNKAHD          AND INSERT BEFORE 'BADSECTORS'              
*                                                                               
*                           MAKE INSERTED ENTRY CURRENT;                        
         LW,R5    R2                SET READY TO PROCESS THE NEW ENTRY          
         BAL,RLNK UNPKDIRE          GET ITS INFO AGAIN                          
         B        SKWEZ2            AND PROCESS NORMALLY                        
*                                                                               
*                                                                               
SKWEZ17  RES      0         NO FILE FITS HOLE; CREATE A DELETED FILE            
         BAL,RLNK SQDELFIL          CREATE A DELETED FILE ENTRY                 
         B        SKWEZ4            AND PROCESS NORMALLY                        
         PAGE                         DEBUG ROUTINES FOR SQUEEZE                
         SPACE    1                   --------------------------                
         LIST     DBGSKWEZ          DONT LIST DEBUG CODE IF NOT USED            
       DO       DBGSKWEZ                                                        
         SPACE    2                                                             
OUTCHAIN RES      0         DISPLAY DIRE CHAIN IN MEMORY                        
         LCI      0                 SAVE REGS IN TEMP SPACE                     
         STM,R0   BUFF4             IN ORDER, 0, 1, ..., R15                    
         BAL,RLNK SNAPTEST          TEST IF TRACING YET                         
         PRTUP    2                 SPACE AWAY FROM PREVIOUS OUTPUT             
         BAL,RLNK OUTMARKA          OUT LOCATION OF CALL                        
         BAL,RLNK OUTREGSA          OUT THE REGISTERS                           
         BAL,RLNK OUTPTRSA          OUT VARIOUS POINTERS                        
         LI,R3    1                 SET DIRE ENTRY COUNT                        
         LW,R4    DIRCHAIN          SET POINTER TO FIRST ENTRY                  
         PRTTXT   OC1               PRINT COLUMN TITLE LINE                     
*                                                                               
OUTCHN1  RES      0         OUT A CHAIN ENTRY                                   
         BAL,RLNK OUTENTA           DISPLAY THE ENTRY                           
         AI,R3    1                 STEP ENTRY COUNT                            
         LW,R4    FWDLINK,R4        STEP TO, TEST IF A NEXT                     
         BNEZ     OUTCHN1             THERE IS, DO IT                           
         PAGE                                                                   
         SPACE    2                                                             
*                                                                               
SNPRETRN RES      0         COMMON RETURN FROM SQUEEZE SNP ROUTINES             
         PRNT                       SPACE ANOTHER LINE TO CLEAR UPSPAC          
*                                                                               
SNPQRTRN RES      0         RETURN IF DYNAMIC TRACE IS OFF                      
         LCI      0                 RECOVER REGS                                
         LM,R0    BUFF4                                                         
         B        *RLNK             AND RETURN                                  
         PAGE                                                                   
         SPACE    2                                                             
OUTMARK  RES      0         SNAP SHOT: SAY WHERE CALLED FROM                    
         LCI      0                                                             
         STM,R0   BUFF4                                                         
         BAL,RLNK SNAPTEST          TEST IF TRACING YET                         
         BAL,RLNK OUTMARKA                                                      
         B        SNPRETRN          RETURN TO OUR CALLER                        
*                                                                               
OUTMARKA RES      0         PRINT CALLING ADDRESS INFO                          
         PUSH     RLNK              SAVE OUR RETURN                             
         PRNT                       SPACE AWAY FROM PREVIOUS OUTPUT             
         STRNG    OC2                                                           
         LW,R15   BUFF4+14          GET LINK                                    
         AI,R15   -(RADSEG3+1)      CONVERT TO MODULE RELATIVE                  
         INTGR    HEX,ZERO,5                                                    
*                                                                               
SNPEXIT  RES      0         COMMON EXIT FROM INTERNAL SNP ROUTINES              
         PRNT                       INSURE LINE PRINTED AND CLEARED             
         PULL     RLNK              GET RETURN                                  
         B        *RLNK             AND RETURN                                  
         PAGE                                                                   
         SPACE    1                                                             
OUTPTRS  RES      0         OUT POINTERS TO DIRE CHAIN                          
         LCI      0                 SAVE REGS                                   
         STM,R0   BUFF4                                                         
         BAL,RLNK SNAPTEST          TEST IF TRACING YET                         
         BAL,RLNK OUTMARKA          OUT WHERE CALLED FROM                       
         BAL,RLNK OUTPTRSA          ANF THE POINTERS                            
         B        SNPRETRN          AND RETURN TO SQUEEZE                       
*                                                                               
*                                                                               
OUTPTRSA RES      0         PRINT POINTER INFO                                  
         PUSH     RLNK                                                          
         PRTTXT   OC3               OUT HEADER LINE                             
         INTGR    HEX,SPAC,9,DIRCHAIN     START OF CHAIN                        
         INTGR    ,,,ENDCHAIN             END OF CHAIN                          
         INTGR    ,,,FREECELL             NEXT WORD FREE FOR AN ENTRY           
         INTGR    DEC,,,MASDFREE          NEXT FREE SECTOR IN AREA              
         INTGR    ,,,MASDNFIL             DIRECTORY ALTERED SWITCH              
         INTGR    ,,,R11                  NEXT SECTOR TO SQUEEZE INTO           
         PRNT                       PRINT THE LINE                              
         B        SNPEXIT           AND RETURN TO CALLER                        
         PAGE                                                                   
         SPACE    2                                                             
OUTREGS  RES      0         PRINT CONTENTS OF REGISTERS                         
         LCI      0                                                             
         STM,R0   BUFF4                                                         
         BAL,RLNK SNAPTEST          TEST IF TRACING YET                         
         BAL,RLNK OUTMARKA          SAY WHERE CALLED FROM                       
         BAL,RLNK OUTREGSA                                                      
         B        SNPRETRN          AND GO BACK TO CALLER                       
*                                                                               
*                                                                               
OUTREGSA RES      0                                                             
         PUSH     RLNK              SAVE RETURN                                 
         STRNG    OC4               OUT PART 1 OF TITLE                         
         LI,R3    -8                SET INDEX ACCESS POINTER                    
         LI,R0    X'10'                                                         
         LI,R1    C'0'                                                          
         LI,R2    8                 SET TO OUT 8 HEX DIGITS                     
*                                                                               
OUTREGS1 RES      0                                                             
         STEPCP   2                                                             
         LW,R15   BUFF4+8,R3        GET A REGISTER                              
         INTGR                                                                  
         BIR,R3   OUTREGS1                                                      
*                                                                               
         SETCP    99                                                            
         CHAR     C'*'                                                          
         CHARS    32,BUFF4          OUT EBCDIC FOR REG                          
         CHAR     C'*'                                                          
         PRNT                                                                   
         STRNG    OC5                                                           
         LI,R3    -8                                                            
         LI,R2    8                 SET NUMBER OF DIGITS AGAIN                  
         LI,R1    C'0'              SET LEADING ZEROS AGAIN                     
         LI,R0    X'10'             AND HEX                                     
*                                                                               
OUTREGS2 RES      0                                                             
         STEPCP   2                                                             
         LW,R15   BUFF4+16,R3                                                   
         INTGR                                                                  
         BIR,R3   OUTREGS2                                                      
*                                                                               
         SETCP    99                                                            
         CHAR     C'*'                                                          
         CHARS    32,BUFF4+8        OUT EBCDIC FOR REG                          
         CHAR     C'*'                                                          
         PRNT                                                                   
         B        SNPEXIT                                                       
         PAGE                                                                   
         SPACE    2                                                             
OUTENTRY RES      0         OUT THE CURRENT CHAIN ENTRY                         
         LCI      0                 SAVE ALL THE REGISTERS                      
         STM,R0   BUFF4                                                         
         BAL,RLNK SNAPTEST          TEST IF TRACING YET                         
         BAL,RLNK OUTMARKA          SAY WHERE CALLED FROM                       
         PRTTXT   OC1               OUT ITEM HEADER                             
         LI,R3    0                 SET NOT LOOPING THROUGH ENTRIES             
         LW,R4    R5                SET WHICH ENTRY TO DO                       
         BAL,RLNK OUTENTA           OUT THE ENTRY                               
         B        SNPRETRN          AND RETURN                                  
*                                                                               
OUTENTA  RES      0         DISPLAY ENTRY (R4)                                  
         PUSH     RLNK              SAVE OUR RETURN                             
         CI,R3    0                 ARE WE DOING ONLY ONE ENTRY                 
         BE       OUTENT1             YES, NO COUNT ID                          
*                                                                               
         INTGR    DEC,SPAC,3,R3     OUT COUNT INDEX                             
         CW,R4    R5                DOING THE CURRENT ENTRY ?                   
         BNE      OUTENT1             NO, CONTINUE                              
*                                                                               
         CHAR     C'*'              YES, MARK AS ALSO CURRENT                   
*                                                                               
OUTENT1  RES      0         OUT REST OF ENTRY INFO                              
         SETCP    6                                                             
         INTGR    HEX,SPAC,5,R4     OUT LOC OF ENTRY                            
         STEPCP   3                                                             
         LW,R15   BACLINK,R4        OUT BAC LINK                                
         INTGR                                                                  
         STEPCP   3                                                             
         LW,R15   FWDLINK,R4        OUT FWD LINK                                
         INTGR                                                                  
         STEPCP   5                                                             
         LW,R15   XBACLINK,R4       OUT EXTENT BAC LINK                         
         INTGR                                                                  
         STEPCP   4                                                             
         LW,R15   XFWDLINK,R4       OUT EXTENT FWD LINK                         
         INTGR                                                                  
         STEPCP   3                 STEP CP AND SAVE ITS POSITION               
         LI,R2    OC6               ASSUME A DELETED ENTRY                      
         LW,R0    0,R4              GET NAME TO DECIDE STATUS                   
         BEZ      OUTENT2             DELETED: OUT THAT INFO                    
         CI,R0    -1                BADSECTOR ENTRY ?                           
         BNE      OUTENT3             NO, GOOD ENTRY: OUT NAME.ACNT             
         LI,R2    OC7               POINT AT 'BADSECTOR' NAME                   
*                                                                               
OUTENT2  RES      0         OUT NAME FOR DELETED, BADSECTOR ENTRIES             
         STRNG                                                                  
         AI,R15   17                INSURE WE USED ENOUGH COLUMNS               
         SETCP                                                                  
         B        OUTENT4           AND CONTINUE                                
*                                                                               
OUTENT3  RES      0         OUT NAME.ACCOUNT FOR A GOOD FILE                    
         LW,R2    R4                OUT:                                        
         CHARS    8                      FILENAME                               
         CHAR     C'.'                           .                              
         CHARS    8,,36                           ACCOUNT                       
*                                                                               
OUTENT4  RES      0                                                             
         LW,R15   7,R4              OUT EXTENT NUMBER                           
         INTGR    DEC,SPAC,4                                                    
         STEPCP   1                                                             
         LW,R15   5,R4              OUT BOT                                     
         INTGR    ,,6                                                           
         LW,R15   6,R4              EOT                                         
         INTGR                                                                  
         SW,R15   5,R4              COMPUTR NEMBER OF SECTORS                   
         AI,R15   1                                                             
         INTGR                                                                  
         B        SNPEXIT           EXIT DISPLAY ROUTINE                        
         PAGE                                                                   
         SPACE    2                                                             
SNAPTEST RES      0         TEST IF DEBUG SNAPS TURNED ON DYNAMICALLY           
         MTW,+00  DEBUGSW           IS TRACE TURNED ON ?                        
         BNEZ     SNPQRTRN            NO, RETURN IMMEDIATELY TO PROG            
         B        *RLNK             YES, DO TRACE/DEBUG OUTPUT                  
*                                                                               
*                                                                               
*                                                                               
OUTCOUNT RES      0         COUNT PASSES/ENTRIES IF DOING DELAYED SNAP          
         LCI      0                 SAVE REGS JUST IN CASE                      
         STM,R0   BUFF4                                                         
         MTW,+00  DEBUGSW           TRACE INHIBITED OR ENABLED ?                
         BLEZ     SNPQRTRN            YES, LEAVE SWITCH AS IS                   
         MTW,-1   DEBUGSW           NO, DECREMENT DELAY COUNT                   
         B        SNPQRTRN          AND EXIT                                    
*                                                                               
*                           SETTINGS AND ACTIONS OF DEBUG SWITCH                
*                                                                               
*        > 0      COUNT OF NUMBER OF ENTRIES BEFORE STARTING OUTPUT             
*        = 0      TRACE/DEBUG OUTPUT ENABLED; DO ALL 'SNP' ROUTINES             
*        < 0      TRACE/DEBUG OUTPUT INHIBITED; DO NOTHING                      
         PAGE                                                                   
         SPACE    2                                                             
OC1      TXTC     '  #  ENTRY  BACLINK FWDLINK  XBACLINK XFWDLINK  ',;          
                  'FILENAME.ACCOUNT XTNT    BOT   EOT  NSEC'                    
OC2      TXTC     'CALL FROM '                                                  
OC3      TXTC     '  DIRCHAIN ENDCHAIN FREECELL MASDFREE MASDNFIL ',;           
                  'NXT BOT'                                                     
OC4      TXTC     ' R0 - R7  '                                                  
OC5      TXTC     ' R8 - R15 '                                                  
OC6      TXTC     '** DELETED FILE *'                                           
OC7      TXTC     '## BAD SECTORS ##'                                           
*                                                                               
*                                                                               
       FIN      DBGSKWEZ                                                        
*                                                                               
         LIST     1                 INSURE WE PRINT THE REST                    
         PAGE                       SQUEEZE LIBRARY FILES                       
         SPACE    2                                                             
*                          DO SQUEEZE ON LIBRARY FILES                          
SQUEZ100 RES      0         ERROR FROM 'GAN' ON AREA NAMES: TEST FOR LIB        
         CW,R8    KWLIB             IS IT 'LIB' KEYWORD ?                       
         BNE      ERROROUT            NO, GIVE ERROR SET BY GAN                 
*                                                                               
         CI,R6    -1                ANY OTHER TYPE OF ERROR FOUND ?             
         BLE      ERROR02             YES, ALSO ERROR IN ITEM                   
         CI,R6    2                 DOES ANOTHER PARAM FOLLOW ?                 
         BGE      ERROR02             NO, MUST: ERROR ALSO                      
*                                                                               
SQUEZ101 RES      0         SCAN A LIB AREA NAME                                
         BAL,LINK SCAN              GET AREA NAME WITH LIB TO SQUEEZE           
         CI,R6    -1                AND ERRORS ?                                
         BNE      SQUEZ102            NO, PROCESS THE NAME                      
*                                                                               
         CI,R10   C'.'              WAS ERROR THE AREA'S DOT PREFIX ?           
         BE       SQUEZ101            YES, RESCAN THE NAME                      
         B        ERROR02             NO, REPORT AN ERROR                       
*                                                                               
SQUEZ102 RES      0         VALIDATE AN AREA NAME                               
         BAL,RLNK GETAX             VALIDATE AREA NAME                          
         B        ERROR04           ILLEGAL: GIVE 'AREA NOT ALLOCATED'          
         CI,R1    FPINDEX           IS IT 'SP' OR 'FP' AREA ?                   
         BG       ERROR02             NO, GIVE 'ERROR ITEM XX'                  
         BAL,R14  UNPKMASD          GET AREA AND DEVICE INFO                    
         B        ERROR04           SHOULDN'T HAPPEN NOW, BUT...                
         LW,R0    MASDWPS           SET UP READ AND WRITE FPT'S                 
         SLS,R0   2                 TO READ A SECTOR'S WORTH OF BYTES           
         STW,R0   RDDISC4                                                       
         STW,R0   WRDISC4                                                       
         LD,R2    MODIR             READ IN MODIR TO SEE IF THERE ARE           
         STD,R2   BIFNAME           ANY ENTRIES DELETED OR THERE                
         LW,R0    BPEND1                                                        
         STW,R0   BIBUFF                                                        
         LW,R3    ML15                                                          
         STS,R3   F:BI+3            SET NO. BYTES TO MAX.                       
SQUEZ103 CAL1,1   RDDISCS           GO READ IN MODIR                            
         CAL1,1   CLFLEIN           CLOSE OUT FILE                              
         LW,R5    F:BI+4                                                        
         SLS,R5   -19                                                           
         AND,R5   M13               R5=NO. WORDS IN MODIR                       
         LI,R2    0                 MAKE INITIAL PASS THRU MODIR AND            
SQUEZ104 LW,R0    *BPEND1,R2        SEE IF DELETED ENTRIES                      
         BEZ      SQUEZ105          YES, MUST DO SQUEEZE                        
         AI,R2    3                                                             
         CW,R2    R5                                                            
         BL       SQUEZ104                                                      
         B        EXEC1             NO SQUEEZE NEEDED: GET NEXT COMMAND         
*                                                                               
SQUEZ105 LD,R2    MODULE                                                        
         STD,R2   BIFNAME           SET UP DCB TO COPY AND COMPRESS             
         LI,R2    BUFF3                MODULE ONTO X1                           
         STW,R2   M:X1+2                                                        
         STW,R2   BIBUFF                                                        
         LI,R2    120                                                           
         SLS,R2   17                                                            
         LW,R3    ML15                                                          
         STS,R2   F:BI+3                                                        
         CAL1,1   SETX1             GO SET RSIZE AND BLOCKED IN DCB             
         LI,R1    0                 SET INDEX TO SCAN FROM 1ST ENTRY            
         LI,R2    F:BI              POINT AT MODULE INPUT DCB                   
*                                                                               
SQUEZ106 RES      0         SCAN MODIR FOR ACTIVE ROMS & MOVE TO X1             
         LW,R0    *BPEND1,R1        GET NEXT MODIR ENTRY                        
         BEZ      SQUEZ108          THIS ENTRY DELETED, SKIP IT                 
*                                                                               
*                           POSITION TO MODULE IN FILE AND COPY                 
         SLS,R0   -16                                                           
         STW,R0   SKIPRCD1          SET NO. RECORDS TO SKIP                     
         LW,R3    *BPEND1,R1                                                    
         AND,R3   M16               R3=NO. RECORDS TO COPY                      
         CAL1,1   REWINFBI          GO REWIND INPUT FILE                        
         CAL1,1   SKIPRCD           SKIP TO PROPER RECORD                       
*                                                                               
SQUEZ107 RES      0         MOVE ROM TO X1                                      
         CAL1,1   RDDISCS                                                       
         CAL1,1   WRITEX1           COPY OBJ. MOD. TO X1                        
         BDR,R3   SQUEZ107                                                      
*                                                                               
SQUEZ108 RES      0         STEP TO NEXT ENTRY IN MODIR & TEST IF DONE          
         AI,R1    3                 STEP MODIR INDEX TO NEXT ENTRY              
         CW,R1    R5                ARE AFTER LAST ENTRY ?                      
         BL       SQUEZ106          NO, GET NEXT ENTRY                          
*                                                                               
         CAL1,1   CLFLEIN           YES, CLOSE FILES                            
         CAL1,1   CLOSEX1                                                       
*                                                                               
*                                                                               
*                                   NOW RECREATE EBCDIC,DEFREF, MODIR,          
*                                     MODULE FILES FROM X1                      
SQUEZ109 RES      0         SET INPUT TO LIB BUILD = X1                         
         LI,R0    1                 SET FOR F:SO DCB                            
         STW,R0   COPYFLAG                                                      
         BAL,R15  COPY92            GO TO SET UP F:SO DCB                       
         LI,R0    0                 SET NOT IN 'ADD' MODE                       
         STW,R0   ADDFLAG           SO AS TO CLEAR LIB                          
         MTW,1    SQUEZ95           SET SQUEEZE FLAG FOR COPY                   
         B        COPYSQUZ          GO TO COPY TO REGENERATE FILES              
*                                                                               
SQUEZ110 RES      0         RETURN FROM 'EOF' IN COPYSQUZ                       
         LI,R0    0                                                             
         STW,R0   SQUEZ95           CLEAR SQUEEZE FLAG                          
         CAL1,1   CLOSEX1           CLOSE X1                                    
         B        EXEC1             GO GET A NEW COMMAND                        
         PAGE                       *****  CLEAR  *****                         
         SPACE    2                 -------------------                         
*        INPUT    DIRECTIVE PARAMETERS                                          
*                                                                               
*        OUTPUT   CLEARED AREAS                                                 
*                                                                               
*        FUNCTION CLEAR THE SPECIFIED AREAS TO ALL ZEROS                        
*                                                                               
*        CALL     B  CLEAR          (FROM RS1000)                               
*                                                                               
*        SUBROUTINES CALLED         GAN,UNPKMASD,CLRAREA                        
*                                                                               
*                                                                               
CLEAR    RES      0         CLEAR AREAS TO ALL ZEROS                            
         LI,RLNK+1 1                SET BT, CK, IS & OS LEGAL NAMES             
         BAL,RLNK GAN               GET AREA NAMES                              
         B        ERROROUT          REPORT ANY ERRORS FOUND IN LIST             
         LB,R0    AREASWS           WAS 'SP' SPECIFIED ?                        
         BEZ      CLEAR2              NO, OK TO CONTINUE                        
*                                                                               
         CI,R0    X'0F'             WAS IT SPECIFIED BY AN 'ALL' ?              
         BE       CLEAR2              YES, OK.  IGNORE IT                       
*                                                                               
         LI,R8    C'SP'             FORM A ' SP ' FOR THE ERROR MSG             
         OR,R8    BLNK                                                          
         SCS,R8   8                                                             
         B        ERROR05           AND REPORT 'ERROR IN OPTION  SP'            
*                                                                               
CLEAR2   RES      0         START SCAN OF AREAS TO BE CLEARED                   
         LI,R4    SPINDEX           START WITH 'SP', BUT SKIP IT                
*                                                                               
CLEAR5   RES      0         PROCESS NEXT AREA                                   
         AI,R4    1                 STEP TO NEXT                                
         CW,R4    K:NUMDA           HAVE WE PROCESSED THE LAST ONE ?            
         BG       EXEC1               YES, GET NEXT COMMAND                     
*                                                                               
         LB,R0    AREASWS,R4        IS THE AREA TO BE CLEARED ?                 
         BEZ      CLEAR5              NO, STEP TO NEXT                          
*                                                                               
         STW,R4   AREA              SAVE INDEX TO CURRENT AREA                  
         BAL,RLNK UNPKMASD          GET AREA INFO                               
         B        ERROR04           SHOULDN'T HAPPEN, BUT IF IT DOES...         
         LW,R15   MASDSIZE          GET NUMBER OF SECTORS IN AREA, AND          
         LI,R0    0                 CLEAR THAT MANY FROM SECTOR 0               
         BAL,RLNK CLRAREA           CLEAR THE SECTORS                           
         CAL1,1   CLFLEIN           INSURE THE AREA'S DCB IS CLOSED             
         LW,R4    AREA              RECOVER INDEX TO THE AREA                   
         B        CLEAR5            AND LOOP FOR THE NEXT                       
         PAGE                                                                   
         SPACE    2                                                             
*  CLRAREA        CLEAR THE SPECIFIED SECTORS OF AN AREA TO ZEROS               
*                                                                               
*        INPUT:   R0 :  START SECTOR TO ZERO                                    
*                 R15:  NUMBER OF SECTORS TO CLEAR                              
*                 R14:  LINK                                                    
*                                                                               
*                                                                               
CLRAREA  RES      0         CLEAR THE SPECIFIED SECTORS                         
         PUSH     16,RLNK           SAVE RETURN LINK                            
         STW,R0   WRDISC5           SET START SECTOR                            
         LW,R9    BACKSZE           GET SIZE OF BUFFER TO USE                   
         CI,R9    X'4000'           LIMIT IT TO 16K WORDS, 65K BYTES            
         BLE      %+2                                                           
         LI,R9    X'4000'                                                       
         LW,R1    R9                COPY BUFFER SIZE IN WORDS                   
         DW,R9    MASDWPS           GET NUMBER OF SECTORS IN BUFFER             
         BEZ      CLRAREA5          LESS THAN 1 FULL SECTOR: FUDGE              
*                                                                               
CLRAREA1 RES      0         DO INITIALIZATION: CLEAR BUFFER, SET BYTE CNT       
         SLS,R1   2                 CONVERT WORD COUNT TO BYTES AND SET         
         STW,R1   WRDISC4                                                       
         SLS,R1   -2                                                            
         AI,R1    -1                ADJUST FOR THE BUFFER CLEAR LOOP            
         LI,R0    0                 CLEAR BUFFER                                
         STW,R0   *BPEND,R1                                                     
         BDR,R1   %-1                                                           
         STW,R0   *BPEND                                                        
         LW,R0    BPEND                                                         
         STW,R0   BIBUFF            SET BUFFER ADDRESS                          
*                                                                               
CLRAREA2 RES      0         LOOP TO CLEAR THE SECTORS (R9) AT A TIME            
         LW,R1    R15               SET TO CLEAR ALL THAT'S LEFT                
         SW,R15   R9                & DEC COUNT BY MAX SECTORS PER LOOP         
         BGEZ     CLRAREA3          MORE THAN MAX PER LOOP LEFT: DO MAX         
         MW,R1    MASDWPS           LESS THAN MAX TO CLEAR; SET BYTE            
         SLS,R1   2                 FOR REMAINING SECTORS TO CLEAR              
         STW,R1   WRDISC4           THE EXACT NUMBER ON LAST PASS               
*                                                                               
CLRAREA3 RES      0         CLEAR A BUFFER'S WORTH OF SECTORS                   
         CAL1,1   WRDISC                                                        
         AWM,R9   WRDISC5           STEP SECTOR ADDRESS TO NEXT PIECE           
         CI,R15   0                 IS THE CLEAR COMPLETE ?                     
         BGZ      CLRAREA2            NO, DO ANOTHER BUFFER'S WORTH             
*                                                                               
         PULL     16,RLNK           RECOVER THE REGISTERS                       
         B        *RLNK             AND RETURN                                  
*                                                                               
CLRAREA5 RES      0         LESS THAN 1 SECTOR IN BUFFER AREA                   
         LI,R9    1                 SET TO CLEAR 1 SECTOR PER LOOP              
         LI,R1    1                 CLEAR SECTOR VIA DISC'S ZERO FILL           
         B        CLRAREA1          GO DO IT THE HARD WAY                       
         PAGE                                                                   
         SPACE    2                                                             
SEG3END  EQU      ((%-RADSEG3)+511)/512  # PAGES REQUIRED FOR SEGMENT           
         END                                                                    
