         TITLE    '               R A D E D I T   S E G M E N T   4'            
         SPACE    2                                                             
         SYSTEM   SIG7FDP                                                       
         SYSTEM   OPTIONS                                                       
*                                                                               
*                                                                               
*  DEFINITIONS                                                                  
         DEF      RADSEG4,SEG4END   BEGIN, END OF THIS SEGMENT                  
*                                                                               
*  COMMAND PROCESSORS IN THIS SEGMENT                                           
         DEF      SAVE                                                          
         DEF      RESTORE                                                       
         TITLE    '               R A D E D I T   S E G M E N T   4'            
*                                                                               
*  UNIVERSAL REFERENCE TO PUSH/PULL STACK SUPPLIED BY OLOAD                     
         REF      U:PCB                                                         
*                                                                               
*                                                                               
*  DCB'S IN CONTEXT SEGMENT                                                     
         REF      M:C,M:LL,M:OC,M:LO                                            
         REF      M:BI,M:BO,M:X1                                                
         REF      F:SI,F:SI2,SIFNAME                                            
         REF      F:SO,F:SO2,SOFNAME                                            
         REF      F:BI,BIBUFF,BIFNAME                                           
         REF      F:LI                                                          
*                                                                               
*  FPT'S IN CONTEXT SEGMENT                                                     
         REF      READSI,SIBUFF,SIBCNT,SICOMPL                                  
         REF      WRITESO,SOBUFF,SOBCNT,SOCOMPL                                 
         REF      RDDISC,RDDISC4,RDDISC5,RDDISC6                                
         REF      WRDISC,WRDISC4,WRDISC5                                        
         REF      READBI,WRITEBO                                                
         REF      ASNFILE                                                       
         REF      TYPE,TYPE1,TYPE2,TYPRERR                                      
         REF      PRINT,PRINT1,PRINT2                                           
         REF      WRITELO,BYTCNT                                                
         REF      SKIPRSI,SKIPNSI,SKIPRSO,SKIPNSO                               
         REF      SKIPRCD,SKIPRCD1,NUMRECS                                      
         REF      SETRSIZE,SETRSIZ2,SETDCBAT                                    
         REF      STIMER,WAITTIME                                               
*                                                                               
* FPT'S DEFINED IN ROOT1                                                        
         REF      OPENC,OPENLL,OPENOC,OPENANY                                   
         REF      OPENSI,OPENSO,OPENSL,OPFLEIN                                  
         REF      CLOSESO,CLOSESI,CLOSEANY                                      
         REF      CLFLEIN,CLOSEBI,CLOSEBO,CLOSEOC                               
         REF      CLOSELL,CLOSELI,CLOSEX1,CLOSESL                               
         REF      READBIH,READLI,READX1,RDDISCS                                 
         REF      WRITEBOH,WRITEX1,WRDISCS                                      
         REF      REWINDBI,REWINDBO,REWINFBI,REWINDSO                           
         REF      UNLOADBO,SKIPFSO,FSKIPLI,SKIPFILE,SETX1                       
         REF      REWIND,WEOF,UNLOAD                                            
         REF      VFCSO0,VFCSO1,WEOFSO,WEOFBO                                   
         REF      MODESI0,MODESO0,MODESI1,MODESO1                               
         REF      MODESODD,MODESOND                                             
         REF      ASNAREA,ASNDEV,ASNOPLB                                        
         REF      GETAINFO,GETFILNM,GETRSIZE                                    
*                                                                               
*  ERROR MESSAGES IN CONTEXT SEGMENT                                            
         REF      MESS0,MESS2,MESS4,MESS5,MESS9                                 
         REF      MESS14,MESS18,MESS20,MESS21,MESS22,MESS23                     
         REF      MESS40,MESS41                                                 
*                                                                               
*  ERROR MESSAGES IN ROOT1 (RS1000)                                             
         REF      MESS1,MESS7,MESS8,MESS10                                      
         REF      MESS11,MESS16,MESS19,MESS28                                   
         REF      MESS30,MESS31,MESS32,MESS35                                   
*                                                                               
*  MISC VARIABLES IN CONTEXT SEGMENT                                            
         REF      BCKEND,BPEND,BPEND1,BACKSZE,BCKSZE                            
         REF      SPARAM,SPARAMF1,SPARAMF2                                      
         REF      BUFF1,BUFF2,BUFF3,BUFF4                                       
         REF      LIBFLAG,LINEIMAG,COLPTR                                       
         REF      AREANAME,FILENAME,AREA,ACNTNAME                               
         REF      AREAASGN,DEVASGN,OPLBASGN                                     
         REF      GIOCT                                                         
         REF      MAPSW,MAXMASD                                                 
         REF      ERRFCN,ERRORSW,CONESW                                         
         REF      FREECELL,DIRCHAIN,ENDCHAIN                                    
*                                                                               
* DATA DEFINED IN ROOT1                                                         
         REF      ZEROS,BLNK,DCW1,DCW2,DCTDATA,DCBOPENF                         
         REF      FPSP,CKXA,CKXABT                                              
         REF      ILLNMES,ILLTOTL                                               
         REF      M1,M2,M3,M4,M5,M6,M7,M8,M9                                    
         REF      M14,M15,M16,M17,M19,M24,M31                                   
         REF      ML8,ML15,ML16,ML24                                            
         REF      X200000,Y8                                                    
         REF      KWFILE,KWLIB,KWALL                                            
         REF      STATFLAG                                                      
         REF      GIOBITS,GIOOBIT,GIODBIT,GIOFBIT,GIOABIT,GIOFA                 
*                                                                               
*  TABLES IN CONTEXT SEGMENT                                                    
         REF      AREASWS,AREASWSX                                              
         REF      MASTDICT,MASDNAME,MASDBOA,MASDEOA                             
         REF      MASDSIZE,MASDTPC,MASDSPT,MASDWPS                              
         REF      MASDWP,MASDDEVA,MASDDCTI,MASDMODL                             
         REF      MASDZERO,MASDLEOF,MASDFREE,MASDUSED                           
         REF      MASDLOST,MASDNDS,MASDNFIL,MASDFRMT,MASDEND                    
         REF      DIRENAME,DIREBOT,DIREEOT,DIRENSEC                             
         REF      DIREFSIZ,DIRERSIZ,DIREGSIZ,DIRERF                             
         REF      DIREORG,DIRESD,DIRESTAT,DIREXTNT,DIRELEN                      
         REF      DIREESIZ,DIREACNT,DIREFIX,DIREPRIO,DIREEND                    
*                                                                               
* CONSTANTS USED THROUGH OUT THE SYSTEM                                         
*             AREA INDICIES                                                     
         REF      SPINDEX,FPINDEX,BPINDEX,BTINDEX                               
         REF      XAINDEX,CKINDEX,ISINDEX,OSINDEX                               
*            FILE DIRECTORY FORMAT INDEX DEFINITIONS                            
         REF      DIRSIZE,DIRLHDR,LNDIRHDR                                      
         REF      DIRINFO,DIRNEXT,DIRIDW1,DIRIDW2                               
         REF      DIRNAM1,DIRNAM2,DIRFLGS,DIRLEN,DIRGRSZ,DIRFSIZ                
         REF      DIRBOT,DIREOT,DIRXTNT,DIRESIZ,DIRACT1,DIRACT2                 
         REF      DIRUNB,DIRBLK,DIRCOMP,DIRSEQN,DIRDIRC                         
*            VALUES SET AND USED BY 'UNPKDIRE'                                  
         REF      ORGUNB,ORGBLK,ORGCOMP                                         
         REF      FILDELTD,FILBDTRK,FILGOODF,FILENTRY,LDIREHDR                  
*             VALUES USED TO BUILD LINKED CORE DIRECTORIES                      
         REF      BACLINK,FWDLINK,XBACLINK,XFWDLINK,SIZEDIR                     
*                                                                               
*  ROUTINES IN ROOT1                                                            
         REF      EXEC,EXEC1                                                    
         REF      SCAN,PROCSCN,TYPRNT,PROCKYIN                                  
         REF      GETIOID,GETFID,GETDEV,GETOPLB,GETANY                          
         REF      ABORT,END,ABNERR,ABNADDR,ERADDR                               
         REF      ABNCONT,ABNRETRY,ABNABORT,WPERR,OPENERR                       
         REF      ERROROUT,ERRORINA,ERROR%PL,OUTFILNM,OUT%MSG                   
         REF      ERROR01,ERROR02,ERROR04,ERROR05,ERROR06                       
         REF      ERROR10,ERROR11,ERROR19,ERROR28,ERROR35,ERROR41               
         REF      GETFSTSD,GETNXTSD,GET1SFIL,GETNXFIL                           
         REF      GETAX,UNPKMASD,UNPKDIRE,GAN,PACKDIRE                          
         REF      FNDROM                                                        
*                                                                               
*  GENERAL PRINT-LINE / PRINT ROUTINES                                          
         REF      %PL               PRINT LINE BUFFER                           
         REF      %CP               CURRENT CHARACTER POSITION IN %PL           
         REF      %TITLINE          TITLE LINE FOR PAGE HEADERS                 
         REF      %19@3             LINES REMAINING ON PAGE                     
         REF      %19@4             SWITCH: TITLE LINE TO BE OUTPUT             
         REF      %1        CLEAR THE PRINT LINE                                
         REF      %2        SET CP                                              
         REF      %3        STEP CP                                             
         REF      %4        STORE CHARACTER                                     
         REF      %5        STORE TEXT STRING                                   
         REF      %6        STORE TEXTC STRING                                  
         REF      %7        STORE TIME                                          
         REF      %8        CONVERT AND STORE INTEGER                           
         REF      %9        ENTER DATE                                          
         REF      %11       PRINT PRINT LINE                                    
         REF      %12       PRINT PRINT LINE, UPSPACE CONTROL                   
         REF      %13       PAGE PRINTER AND OUT ANY TITLE LINE                 
         REF      %14       PAGE PRINTER AND PRINT THE PRINT-LINE               
         REF      %15       PRINT A TEXT STRING                                 
         REF      %16       PRINT A TEXTC STRING                                
*                                                                               
*                                                                               
*                                                                               
*  REFERENCES PECULIAR TO SEGMENT 4                                             
         REF      SAVE90,SAVE91,SAVE92,SAVE93                                   
         REF      REST90,REST91,REST92,REST93                                   
         REF      NFIL              SWITCH FOR EOTSW                            
         PAGE                                                                   
         SPACE    2                                                             
PUSH     CNAME    1                 PUSH REGISTERS INTO STACK                   
PULL     CNAME    0                 PULL REGISTERS FROM STACK                   
         PROC                                                                   
        DO       NUM(AF)=1          SAVE ONLY ONE REGISTER ?                    
LF(1)    GEN,8,4,20        X'8'+NAME,AF(1),U:PCB                                
        ELSE     NUM(AF)=0          SAVE MULTIPLE REGISTERS                     
LF(1)    LCI      AF(1)&X'F'                                                    
         GEN,8,4,20        X'A'+NAME,AF(2),U:PCB                                
        FIN                                                                     
         PEND                                                                   
*                                                                               
*        USES REGISTER R3 FOR COMPUTING SCRATCH MEMORY ADDRESS ********         
STTW     CNAME    1                                                             
STTH     CNAME    2                                                             
STTB     CNAME    3                                                             
         PROC                                                                   
LF       EQU      %                                                             
         LI,R3    (AF(1)-SBOOT)**(NAME-1)     AF(1) BECOMES                     
*                                               INDEX DISPLACEMENT              
         DO1      NUM(AF)=2                                                     
         AW,R3    AF(2)             ADD IN R FIELD, IF NECESSARY                
*  FOLLOWING GENERATES   STW,CF(2)  *BPEND,R3                                   
*                   OR   STH,CF(2)  *BPEND,R3                                   
*                   OR   STB,CF(2)  *BPEND,R3                                   
         GEN,1,2,5,4,3,17  1,NAME,X'15',CF(2),R3,BPEND                          
         PEND                                                                   
*                                                                               
*                                                                               
ERRP     CNAME                                                                  
         PROC                                                                   
         DO       NUM(AF)>0                                                     
LF        GEN,8,24 AF(1),AF(2)                                                  
         ELSE                                                                   
LF        GEN,32   0                                                            
         FIN                                                                    
         PEND                                                                   
*                                                                               
         LIST     0                 DO NOT LIST % ROUTINE'S PROCS               
         PAGE                                                                   
         SPACE    2                                                             
         OPEN     ARG,ARGA                                                      
         SPACE    2                                                             
*                                                                               
*                                                                               
*                 LOAD REGISTER WITH ARGUMENT FOR A % ROUTINE.                  
*        CALL:                                                                  
*              LF ARG,REG  AF(I)                                                
*                 WHERE LF IS THE LABEL FIELD FROM THE %ROUTINE CALL,           
*                       REG IS THE REGISTER TO BE LOADED IF THERE IS            
*                       AN ARGUMENT PRESENT, AND                                
*                       AF(I) IS THE I-TH ARGUMENT TO THE %ROUTINE.             
*                 IF AF(I) IS NULL,  LF  IS DEFINED BY A RES 0                  
*                                                                               
ARG      CNAME                                                                  
         PROC                                                                   
         DO       NUM(AF)>0         AN ARGUMENT GIVEN ?                         
          DO       TCOR(AF,S:INT,S:C)>0    IS IT A CONSTANT ?                   
           DO       SCOR(AF,R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,;   IS IT A           
                            R10,R11,R12,R13,R14,R15)>0        REGISTER ?        
LF          LW,CF(2)  AF                LOAD VALUE FROM WORD (REG)              
           ELSE                     SCOR = 0  ==> CONSTANT                      
LF          LI,CF(2)  AF                LOAD CONSTANT                           
           FIN                                                                  
          ELSE                      TCOR = 0 ==> NOT A CONSTANT                 
LF         LW,CF(2)  AF                 IT IS A SYMBOL; LOAD FROM IT            
          FIN                                                                   
         ELSE                                                                   
          DO       NUM(LF)>0        IS THERE A LABEL ?                          
LF         RES      0               DEFINE IT                                   
          FIN                                                                   
         FIN                                                                    
         PEND                                                                   
***********************************************************************         
         SPACE    3                                                             
***********************************************************************         
*                                                                               
*                                                                               
*        LOAD PARAMETER REGISTER WITH ARGUMENT ADDRESS FOR A % ROUTINE          
*        CALL:                                                                  
*              LF ARGA,REG   AF(I)                                              
*                 WHERE  LF  IS THE LABEL FIELD FROM THE %ROUTINE CALL,         
*                        REG IS THE REGISTER TO BE LOADED, IF THERE             
*                          IS AN ARGUMENT PRESENT, AND                          
*                        AF(I)  IS THE I-TH ARGUMENT TO THE %ROUTINE            
*                 IF AF(I) IS NULL, LF IS DEFINED BY A  RES  0                  
*                                                                               
ARGA     CNAME                                                                  
         PROC                                                                   
         DO       NUM(AF)>0         AND PARAMETERS ?                            
          DO       ((NUM(AF)=1)&(AFA(1)=0))                                     
LF         LI,CF(2)   AF                                                        
          ELSE                                                                  
LF         LW,CF(2)   AF                                                        
          FIN                                                                   
         ELSE                                                                   
          DO       NUM(LF)>0                                                    
LF         RES      0                                                           
          FIN                                                                   
         FIN                                                                    
         PEND                                                                   
***********************************************************************         
         SPACE    3                                                             
CLRPL    CNAME                                                                  
*                          CLEAR CURRENT PRINT LINE                             
         PROC                                                                   
LF       BAL,R14  %1                CLEAR THE PRINT LINE                        
         PEND                                                                   
         SPACE    3                                                             
SETCP    CNAME                                                                  
*                          SET CHARACTER POINTER (CP)                           
*                 R15 <= NEW VALUE OF CP                                        
         PROC                                                                   
LF       ARG,R15  AF                GET NEW CP VALUE                            
         BAL,R14  %2                SET IT                                      
         PEND                                                                   
         SPACE    3                                                             
STEPCP   CNAME                                                                  
*                           STEP CP LEFT OR RIGHT                               
*                 R15 <= CP STEP VALUE                                          
*                                   R15 > 0 ==>  RIGHT                          
*                                   R15 = 0 ==>  NO CHANGE                      
*                                   R15 < 0 ==>  LEFT                           
*                 R15 IS RETURNED WITH NEW VALUE OF CP                          
         PROC                                                                   
LF       ARG,R15  AF                GET STEP VALUE                              
         BAL,R14  %3                SET IT                                      
         PEND                                                                   
         SPACE    3                                                             
CHAR     CNAME                                                                  
*                          STORE CHARACTER IN PL                                
*                 R15 <= CHARACTER TO STORE, IN RIGHTMOST BYTE                  
         PROC                                                                   
LF       ARG,R15  AF                GET CHARACTER IF GIVEN                      
         BAL,R14  %4                STORE AWAY                                  
         PEND                                                                   
         SPACE    3                                                             
CHARS    CNAME    %5                                                            
PRTCHR   CNAME    %15                                                           
*                           STORE CHARACTER (TEXT) STRING  (,AND PRINT)         
*                 R2  <= WORD ADDRESS OF START OF 'TEXT' STRING                 
*                 R1  <= NUMBER OF CHARACTERS TO STORE                          
*                 R0  <= BYTE INDEX RELATIVE TO R2 OF 1ST CHARACTER             
         PROC                                                                   
LF       ARG,R1   AF(1)             GET STRING LENGTH                           
         ARGA,R2  AF(2)             GET START ADDRESS                           
         DO       NUM(AF(3))>0      OFFSET GIVEN ?                              
          ARG,R0   AF(3)            GET OFFSET                                  
         ELSE                                                                   
          DO1      NUM(AF)>0        SET DEFAULT ONLY IF PARAMS GIVEN            
          LI,R0    0                ELSE START AT 1ST CHARACTER                 
         FIN                                                                    
         BAL,R14  NAME              CALL REQUESTED ROUTINE                      
         PEND                                                                   
         SPACE    3                                                             
STRNG    CNAME    %6                                                            
PRTTXT   CNAME    %16                                                           
*                           STORE TEXTC STRING (, AND PRINT)                    
*                 R2  <= ADDRESS OF START OF TEXTC STRING                       
         PROC                                                                   
LF       ARGA,R2  AF                LOAD ADDRESS OF TEXTC STRING                
         BAL,R14  NAME                                                          
         PEND                                                                   
         SPACE    3                                                             
TIME     CNAME                                                                  
*                           CONVERT AND STORE INTEGER AS TIME                   
*                 R15 <= TIME, IN SECONDS, TO BE CONVERTED                      
         PROC                                                                   
LF       ARG,R15  AF                GET TIME                                    
         BAL,R14  %7                CONVERT AND STORE                           
         PEND                                                                   
         SPACE    3                                                             
INTGR    CNAME                                                                  
*                           CONVERT AND STORE INTEGER                           
*                 R0  <= BASE OF CONVERSION (10 = DEC, 16 = HEX, 2 = BIN)       
*                 R1  <= FILL CHARACTER FOR LEADING UNUSED POSITIONS            
*                 R2  <= WIDTH OF FIELD (NUMBER OF DIGITS TO OUTPUT)            
*                 R15 <= INTEGER TO CONVERT (AS A 32 POSITIVE INTEGER)          
         PROC                                                                   
         DO       NUM(LF)>0                                                     
LF        RES      0                                                            
         FIN                                                                    
         OPEN     I                                                             
         DO       NUM(AF(1))>0                                                  
I         SET      SCOR(AF(1),DEC,HEX,BIN)                                      
           DO       I>0                                                         
            DO1      I=1                                                        
            LI,0     10             SET DECIMAL                                 
            DO1      I=2                                                        
            LI,0     16             SET HEX                                     
            DO1      I=3                                                        
            LI,0     2              SET BINARY                                  
           ELSE                                                                 
            ARG,R0   AF(1)          SET BASE                                    
           FIN                                                                  
         FIN                                                                    
*                                                                               
         DO       NUM(AF(2))>0                                                  
I         SET      SCOR(AF(2),SPAC,ZERO)                                        
           DO       I>0                                                         
            DO1      I=1                                                        
            LI,1     C' '           SET LEADING SPACES                          
            DO1      I=2                                                        
            LI,1     C'0'           SET LEADING ZEROES                          
           ELSE                                                                 
            ARG,R1   AF(2)          GET LEADING/FILL CHARACTER                  
           FIN                                                                  
         FIN                                                                    
*                                                                               
         ARG,R2   AF(3)             SET NUMBER OF DIGIT PLACES                  
         ARG,R15  AF(4)             SET VALUE TO CONVERT                        
         CLOSE    I                                                             
         BAL,R14  %8                CONVERT AND ENTER                           
         PEND                                                                   
         SPACE    3                                                             
DATE     CNAME                                                                  
         PROC                                                                   
LF       BAL,R14  %9                GET AND ENTER DATE                          
         PEND                                                                   
         SPACE    3                                                             
PRNT     CNAME    1                                                             
PRTUP    CNAME    0                                                             
*                 FOR PRTUP:                                                    
*                 R15 <= UPSPACE COUNT IN NUMBER OF LINES; |N| < 8              
*                                   R15 > 0 ==> UPSPACE AFTER PRINT             
*                                   R15 = 0 ==> DO NOT UPSPACE                  
*                                   R15 < 0 ==> UPSPACE BEFORE PRINT            
         PROC                                                                   
         DO       NAME                                                          
LF        BAL,R14  %11              SIMPLY PRINT THE LINE                       
         ELSE                                                                   
LF        ARG,R15  AF               GET UPSPACE COUNT,                          
          BAL,R14  %12              THEN PRINT WITH UPSPACE                     
         FIN                                                                    
         PEND                                                                   
         SPACE    3                                                             
PRTPAG   CNAME                                                                  
         PROC                                                                   
LF       BAL,R14  %14               PAGE THE PRINTER, PRINT PL                  
         PEND                                                                   
         SPACE    3                                                             
         CLOSE    ARG,ARGA                                                      
         LIST     1                                                             
         OPEN     Q,I                                                           
TXT      CNAME    0                                                             
TXTC     CNAME    1                                                             
         PROC                                                                   
Q        SET      S:UT(AF)                                                      
I        SET      S:NUMC(Q)                                                     
Q(I+1)   SET      ' '                                                           
Q(I+2)   SET      ' '                                                           
Q(I+3)   SET      ' '                                                           
         DO       NAME=0                                                        
LF       TEXT     S:PT(Q(1),Q(2),Q(3),Q(4))                                     
         LIST     0                                                             
         ORG      %-1                                                           
         TEXT     AF                                                            
         ELSE                                                                   
LF       DATA     (((I)**8+Q(1))**8+Q(2))**8+Q(3)                               
         LIST     0                                                             
         ORG      %-1                                                           
         TEXTC    AF                                                            
         FIN                                                                    
         LIST     1                                                             
         PEND                                                                   
         CLOSE    Q,I                                                           
         PAGE                                                                   
         SPACE    2                                                             
RADSEG4  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                                                             
LINK     EQU      8                                                             
R8       EQU      8                                                             
R9       EQU      9                                                             
R10      EQU      10                                                            
R11      EQU      11                                                            
R12      EQU      12                                                            
R13      EQU      13                                                            
R14      EQU      14                                                            
RLNK     EQU      R14               NEW ROUTINES' STANDARD LINK REGISTER        
R15      EQU      15                                                            
*                                                                               
*                          DEFINITIONS OF EQUATED DATA IN ROOT FOR SAVE         
*                                                                               
T1       EQU      MASDLOST          1ST SECTOR UNABLE TO READ                   
T2       EQU      MASDUSED          LAST SECTOR UNABLE TO READ                  
LOSTCNT  EQU      SAVE90            SW: > 0 IF DATA LOST ON A SAVE              
EOTSW    EQU      NFIL              E-O-T FOUND WHILE WRITING SAVE TAPE         
         PAGE                                                                   
         SPACE    2                                                             
K:UNAVBG EQU      X'149'            START ADDR OF UNAVAILABLE MEMORY            
K:RDBOOT EQU      X'175'            FWA AND DEV. NO. OF RAD BOOT                
K:DCT1   EQU      X'176'            NUMBER OF DEVICE ENTRIES                    
K:DCT16  EQU      X'177'            DEVICE TYPE INDEX ADDRESS                   
K:MDNAME EQU      X'212'            ADDRESS OF MDNAME TABLE                     
K:DCT1X  EQU      X'213'            ADDR OF REAL DCT1 TABLE                     
*                                                                               
*                                                                               
*                 FLAG BITS IN SAVE TAPE HEADER BLOCKS                          
*                                                                               
*   NAME          VALUE    USE:     COMMENTS                                    
LRAFLGB  EQU      X'80'    BYTE     LAST RECORD OF AN AREA                      
LRTFLGB  EQU      X'40'    BYTE     LAST RECORD OF A  SAVE TAPE(S)              
MRTFLGB  EQU      X'20'    BYTE     MULTI-REEL SAVE: ANOTHER REEL FOLLOWS       
DPAFLGB  EQU      X'10'    BYTE     AREA RESIDES ON A DISK PACK                 
*                                                                               
*                                                                               
*                          WORD OR HALFWORD VALUES OF ABOVE FLAGS               
LRAFLAG  EQU      LRAFLGB*X'100'                                                
LRTFLAG  EQU      LRTFLGB*X'100'                                                
MRTFLAG  EQU      MRTFLGB*X'100'                                                
DPAFLAG  EQU      DPAFLGB*X'100'                                                
*                                                                               
*                                                                               
LSAVEHDR EQU      6                 LENGTH OF A SAVETAPE HEADER                 
LSAVHDRD EQU      LSAVEHDR-1        LENGTH OF DATA IN A HEADER                  
         PAGE                                                                   
         SPACE    1                                                             
*%*MESS20 TEXTC   'AREA XX NOT FOUND ON SAVE TAPE'                              
*%*MESS21 TEXTC   'AREA XX INCOMPATIBLITY'                                      
*%*MESS22 TEXTC   'AREA XX CKSM ERROR'                                          
*%*MESS23 TEXTC   'AREA XX TRUNCATED'                                           
*                                                                               
MESS24   TXTC     'ABOVE AREAS NOT RESTORED'                                    
MESS25   TXTC     'SAVE TAPE OK'                                                
MESS26   TXTC     'CKSM ERR ON SAVE TAPE'                                       
MESS27   TXTC     'SAVE NOT DONE: ERROR IN TABLES'                              
MESS34   TXTC     'WARNING: ERRORS WRITING SAVETAPE. CHECK LISTING.'            
*                                                                               
MESS45   TXTC     'MOUNT NEXT SAVE VOLUME, NUMBER '                             
MESS46   TXTC     'WRONG SAVE VOLUME: HAS SEQ NUMBER = '                        
MESS47   TXTC     'WARNING: AREA INDEX FOR AREA '                               
MESS47A  TXTC     ' HAS CHANGED FROM '                                          
MESS47B  TXTC     ' TO '                                                        
MESS48   TXTC     'STDLB BO TO NEXT VOLUME, KEYIN ''C'' WHEN READY'             
MESS49   TXTC     'STDLB BI TO NEXT VOLUME, KEYIN ''C'' WHEN READY'             
*                                                                               
*                                                                               
Y1       DATA     X'10000000'       PARAM PRESENCE BIT P4                       
         TITLE    '     SEGMENT 4 ERROR ROUTINES'                               
         SPACE    2                                                             
SEG4X21  EQU      %         ERROR 21: AREA XX INCOMPATABILITY                   
         LI,R15   MESS21            SET ERROR MESSAGE ADDRESS                   
         B        SEG4XXX           GO PUT IN AREA NAME                         
*                                                                               
SEG4X22  EQU      %         ERROR 22: AREA XX CHECKSUM ERROR                    
         LI,R15   MESS22            SET ERROR MESSAGE                           
         B        SEG4XXX           INSERT AREA NAME                            
*                                                                               
SEG4X24  EQU      %         ERROR 24: RESTORE NOT COMPLETED SUCCESSFULLY        
         LI,R15   MESS24            SET ERROR MESSAGE ADDRESS                   
         B        SEG4ERR           OUT MESSAGE                                 
*                                                                               
ERROR26  RES      0         CHECK SUM ERROR ON SAVE TAPE                        
         CAL1,1   CLOSEBO           CLOSE M:BO OUTPUT TAPE DCB                  
         LI,R15   MESS26            POINT AT MESSAGE TO OUTPUT                  
         B        ERROROUT          GO TO COMMON MESSAGE OUT ROUTINE            
*                                                                               
SEG4X27  EQU      %         ERROR 27: NO NAMES FOUND IN AREASWS                 
         LI,R15   MESS27            SET ERROR MESSAGE                           
         B        SEG4ERR           AND OUTPUT IT                               
*                                                                               
SEG4X2   EQU      ERROR02           'ERROR ITEM XX' ERROR ROUTINE               
SEG4X19  EQU      ERROR19           'NOT ENUF BCKG SPACE' ERROR                 
SEG4XXX  EQU      ERRORINA          INSERT AREA NAME IN MESS AT R15             
SEG4ERR  EQU      ERROROUT          OUT MESSAGE, CONTINUE IF OK                 
         TITLE    '     SAVE ROUTINE'                                           
         SPACE    2                                                             
******** ROUTINE SAVE ********                                                  
*                                                                               
*        INPUT    DIRECTIVE PARAMETERS                                          
*                                                                               
*        OUTPUT   RAD SAVED ON BO DEVICE                                        
*                                                                               
*        FUNCTION SAVES THE CONTENTS OF ANY OR ALL RAD AREAS ON                 
*                 MAGNETIC TAPE USING THE M:BO DCB. THE AREAS ARE               
*                 PRECEDED BY A SELF LOADING BOOTSTRAP.                         
*===>    NOTE:    THE SAVE CAN ONLY BE DONE TO MAGNETIC TAPE.  PAPER            
*                 TAPE IS NOT ALLOWED.                                          
*        NOTE:    MULTIPLE VOLUMES MAY BE REQUIRED TO CONTAIN ALL THE           
*                 AREAS REQUESTED. AS EACH VOLUME IS COMPLETED, IT WILL         
*                 BE REWOUND AND VERIFIED, THEN UNLOADED. A MOUNT               
*                 MESSAGE FOR THE NEXT VOLUME, WITH ITS SERIAL NUMBER,          
*                 IS ISSUED AND THE SAVE CONTINUED ON THE NEW VOLUME.           
*        NOTE:    IF MULTIPLE VOLUMES ARE REQUIRED, THE JOB                     
*                 ==>  MUST  <== BE RUN ATTENDED, OR ELSE IT WILL               
*                 ABORT AFTER THE FIRST VOLUME.                                 
*                                                                               
*        CALL     B  SAVE                                                       
*                                                                               
*        SUBROUTINES USED    SCAN                                               
*                                                                               
SAVE     EQU      %         BUILD A SAVE TAPE                                   
         LI,R1    LBOOTX            MOVE SBOOT                                  
         LW,R2    SBOOT,R1           THRU LBOOT99                               
         STW,R2   *BPEND,R1          INTO *BPEND                                
         BDR,R1   %-2                SCRATCH BUFFER                             
*                                                                               
         LW,R2    SBOOT              INCLUDING 1ST                              
         STW,R2   *BPEND             WORD                                       
*                                                                               
         LI,R1    LBOOT61D-SBOOT    PLACE TIME AND                              
         AW,R1    BPEND              DATE IN SCRATCH                            
         OR,R1    Y1                 BUFFER                                     
         CAL1,8   R1                 VIA TIME CAL                               
*                                                                               
         LI,RLNK+1  0               SET CK, BT, IS, OS NOT ALLOWED              
         BAL,RLNK GAN               PROCESS AREA NAMES, BUILD TABLE             
         B        SEG4ERR             ERROR; REPORT IT                          
*                                                                               
         CI,R6    2                 WAS END OF CARD FOUND ?                     
         BE       SAVE2               YES, NO ID MESSAGE; DELETE IT             
*                                                                               
         CI,R10   C''''             IS ERROR CHARACTER A QUOTE ?                
         BNE      SEG4X2              NO, ERROR MSG 2 'ERROR ITEM XX'           
*                                                                               
         LI,R2    0                 SET LENGTH OF MESSAGE STORED                
         LW,R1    COLPTR            GET ADDR OF START QUOTE OF MSG              
         LW,R15   *R7               GET ADDRESS OF CARD IMAGE INPUT             
         PAGE                                                                   
         SPACE    2                                                             
SAVE1A   EQU      %         STEP OVER START QUOTE CHARACTER                     
         AI,R1    1                 STEP TO NEXT CHARACTER                      
         CI,R1    80                AT END OF CARD ?                            
         BGE      SAVE1G              YES, ASSUME END OF MESSAGE                
*                                                                               
         LB,R0    *R15,R1           GET THE NEXT CHARACTER                      
         CI,R0    C''''             IS IT A QUOTE ?                             
         BNE      SAVE1E              NO, TEST IF OK TO STORE IT                
*                                                                               
         AI,R1    1                 YES, TEST NEXT CHARACTER                    
         CI,R1    80                END OF CARD => END OF MESSAGE               
         BGE      SAVE1G            END OF CARD, ASSUME END OF MESSAGE          
*                                                                               
         LB,R0    *R15,R1           GET THE NEXT CHARACTER                      
         CI,R0    C''''             IS IT 2ND OF PAIR OF QUOTES ?               
         BE       SAVE1E              YES, STORE AS SINGLE QUOTE                
*                                                                               
         CI,R0    C' '              NO, IS IT BLANK AT END DATA ?               
         BE       SAVE1G              YES, FORCE END OF MESSAGE                 
*                                                                               
         CI,R0    C';'              IS IT CONTINUATION CHARACTER ?              
         BNE      SEG4X2              NO, ERROR IN ITEM XX MESSAGE              
*                                                                               
         LW,R14   4,R7              GET ADDR. OF READ CONT'D CARD SUBR          
         BAL,R14  *R14              AND READ THE CONTINUATION LINE              
         LI,R1    0                 SCAN OFF ':' AND LEADING BLANKS             
         LB,R0    *R15,R1           GET CHAR IN COL 1                           
         CI,R0    C':'              IS IT THE NECESSARY ':' ?                   
         BNE      SEG4X2              NO, GIVE ERROR                            
         PAGE                                                                   
         SPACE    1                                                             
SAVE1C   EQU      %         SCAN OFF LEADING BLANKS                             
         AI,R1    1                 STEP TO NEXT COLUMN                         
         CI,R1    80                END OF CARD ?                               
         BGE      SEG4X2              YES, GIVE ERROR                           
*                                                                               
         LB,R0    *R15,R1           GET THE CHAR                                
         CI,R0    C' '              A SPACE ?                                   
         BE       SAVE1C              YES, SKIP IT                              
*                                                                               
         CI,R0    C''''             THE NECESSARY QUOTE ?                       
         BE       SAVE1A              YES, SKIP IT AND CONTINUE                 
         B        SEG4X2              NO, GIVE ERROR                            
*                                                                               
SAVE1E   EQU      %         STORE CHARACTER INTO ID MESSAGE                     
         CI,R2    40                STORED LAST CHARACTER YET ?                 
         BGE      SAVE1A              YES, SKIP IT                              
*                                                                               
         STTB,R0  LBOOT62M,R2       STORE CHARACTER IN MESSAGE                  
         AI,R2    1                 STEP CHARACTER COUNT                        
         B        SAVE1A            AND GET NEXT CHARACTER                      
*                                                                               
SAVE1G   EQU      %         END OF ID MESSAGE FOUND; OR NO MESSAGE              
         AI,R2    (LBOOT62M-LBOOT62L)**2-1  SET LENGTH OF STD MSG HEADER        
         STTB,R2  LBOOT62L          SET NUMBER OF BYTES TO TYPE                 
         B        SAVE3             GO BUILD SAVE TAPE                          
*                                                                               
SAVE2    EQU      %         NO ID MESSAGE GIVEN; SET NO MESSAGE TO TYPE         
         LI,R0    0                 SET MESSAGE LENGTH TO ZERO                  
         STTB,R0  LBOOT62L          TO INDICATE NO MESSAGE TO TYPE              
         B        SAVE3             GO BUILD SAVE TAPE                          
         PAGE                                                                   
         SPACE    2                                                             
*  VERIFY CHECKSUMS ON TAPE                                                     
*                                                                               
SAVE2C   RES      0                                                             
         LW,R0    M:BO              TEST IF THE M:BO DCB WAS OPENED             
         CW,R0    DCBOPENF          IS THE OPEN FLAG SET ?                      
         BAZ      EXEC1             NO                                          
*                                                                               
         CAL1,1   WEOFBO            MARK END OF FILE WITH DOUBLE                
         CAL1,1   WEOFBO            TAPE MARKS                                  
         CAL1,1   REWINDBO                                                      
         MTW,+00  LOSTCNT           WERE THERE ANY ERRORS READING DATA          
         BEZ      SAVE2B              NO, OK                                    
*                                                                               
         LI,R15   MESS34              YES, OUT WARNING MESSAGE                  
         BAL,LINK TYPRNT                                                        
*                                                                               
SAVE2B   RES      0         START VERIFY                                        
         LI,R3    WRITEBO           SET ADDRS OF MAG TAPE FPT, ETC              
         LI,R4    WRITEBO+4                                                     
         LI,R0    X'10'             CHANGE TO READ ORDER                        
         STB,R0   WRITEBO                                                       
         LW,R2    BPEND             SET ADDRESS OF BUFFER TO READ THE           
         STW,R2   M:BO+2            DATA INTO FOR VERIFY                        
         CI,R13   0                 IS THIS A CONTINUATION VOLUME ?             
         BNE      SAVE2E              YES, GO VERIFY DATA; SKIP BOOT INF        
*                                                                               
         LI,R1    88                                                            
         STW,R1   *R4               SET FOR BOOTSTRAP                           
         CAL1,1   *R3               GO READ BOOTSTRAP                           
         BAL,LINK CHKCKSM           CHECK THE CKSM                              
         B        SAVE2X              ERROR: REPORT IT                          
         LI,R1    (LBOOT99-LBOOT1)*4                                            
         STW,R1   *R4               STOTE BYTE COUNT OF LBOOT                   
         CAL1,1   *R3               GO READ LBOOT                               
         BAL,LINK CHKCKSM           VERIFY CHECKSUM                             
         B        SAVE2X              ERROR: REPORT                             
         LI,R1    4*LSAVEHDR        SET BYTE LENGTH OF HEADER RECORD            
         STW,R1   *R4               HEADER BHTE COUNT                           
         CAL1,1   *R3               GO READ HEADER FOR RADBOOT                  
         BAL,LINK CHKCKSM           VERIFY CHECKSUM                             
         B        SAVE2X              ERROR: REPORT                             
         LI,R1    92                                                            
         STW,R1   *R4               BYTE COUNT FOR RAD BOOT                     
         CAL1,1   *R3               GO READ RADBOOT                             
         BAL,LINK CHKCKSM           VERIFY CHECKSUM                             
         B        SAVE2X              ERROR: REPORT                             
*                                                                               
SAVE2E   RES      0         LOOP TO CHECK VARIABLE PART OF TAPE                 
         LI,R1    4*LSAVEHDR        SET HEADER SIZE IN BYTES                    
         STW,R1   *R4               SET FOR NEXT HEADER                         
         CAL1,1   *R3               GO READ NEXT HEADER                         
         BAL,LINK CHKCKSM           VERIFY CHECKSUM                             
         B        SAVE2X              ERROR: REPORT IT                          
         LW,R5    *BPEND            GET, SAVE HEADER RECORD'S FLAGS             
         LI,R1    2                 GET SECTORS OF DATA IN NEXT RECORD          
         LH,R1    *BPEND,R1         FROM HEADER RECORD                          
         BEZ      SAVE2G            NO DATA FOLLOWS                             
         MH,R1    *BPEND            CHANGE TO WORDS                             
         AI,R1    1                 ADD 1 FOR CKSM                              
         SLS,R1   2                                                             
         STW,R1   *R4               STORE BYTE COUNT OF DATA REC.               
         CAL1,1   *R3               READ NEXT DATA REC.                         
         BAL,LINK CHKCKSM           VERIFY CHECKSUM                             
         B        SAVE2X              ERROR: REPORT                             
*                                                                               
SAVE2G   RES      0         TEST FOR END OF THE TAPE                            
         CI,R5    LRTFLAG           IS THIS THE END OF THE TAPE ?               
         BAZ      SAVE2E            NO,GET MORE                                 
*                                                                               
         LI,R15   MESS25                                                        
         BAL,LINK TYPRNT            GO OUTPUT 'SAVE TAPR OK'                    
         CAL1,1   UNLOADBO          REWIND/UNLOAD THE SAVE TAPE                 
         CAL1,1   CLOSEBO           YES,CLOSE IT OUT                            
         LI,R0    X'11'             CHANGE BACK TO A WRITE ORDER                
         STB,R0   WRITEBO                                                       
         LI,R0    0                 RESET LOST DATA AND END-OF-TAPE             
         STW,R0   LOSTCNT           FLAGS, AND TEST IF WE ARE TO                
         XW,R0    EOTSW             CONTINUE ON ANOTHER VOLUME ?                
         BEZ      EXEC1               NO, ALL DONE: GET NEXT COMMAND            
*                                                                               
SAVEGNV  RES      0         GET NEXT VOLUME FOR THE SAVE                        
         AI,R13   1                 STEP VOLUME SEQUENCE NUMBER                 
         AND,R13  M4                COUNTING MODULO 16                          
         STRNG    MESS45            FORM THE MOUNT MESSAGE                      
         INTGR    DEC,SPAC,2,R13    OUT 'MOUNT NEXT VOL' MESSAGE                
         BAL,RLNK OUT%MSG                                                       
         STRNG    MESS48            FORM THE STDLB MESSAGE                      
         BAL,RLNK OUT%MSG           PRESENT IT                                  
         LI,R0    SAVERF            RESET TO STANDARD ERROR FUNCTIONS           
         STW,R0   ERRFCN                                                        
         CAL1,9   9                 FOR HIM AND THE NEXT VOLUME                 
         PULL     3,R4              RECOVER SAVE INDICIES, RETURN POINT         
         B        *R5               CONTINUE WHERE WE LEFT OFF                  
*                                                                               
*                                                                               
SAVE2X   RES      0         CKSM ERROR; RESTORE WRITEBO FPT                     
         LI,R15   X'11'             RESET WRITEBO FPT TO DO                     
         STB,R15  WRITEBO           WRITES RATHER THAN VERIFY READS             
         B        ERROR26           THEN GIVE 'CKSM ERROR'                      
         PAGE                                                                   
         SPACE    2                                                             
*                                                                               
*  WRITE SMALL BOOT                                                             
*                                                                               
SAVE3    EQU      %         CREATE A SAVE TAPE                                  
         CAL1,1   REWINDBO          REWIND THE TAPE TO START AT BOT             
         LW,R1    BPEND                                                         
         STW,R1   M:BO+2            SET UP TO WRITE OUT SMALL BOOT              
         LI,R0    88                ALWAYS 88 BYTES                             
         STW,R0   WRITEBO+4                                                     
         LI,R2    21                GO CKSM 21 WORDS FOR SBOOT                  
         BAL,LINK GENCKSM           FORM CHECKSUM FOR THE BLOCK                 
         CAL1,1   WRITEBO           GO WRITE OUT SMALL BOOT                     
*                                                                               
*   WRITE LARGE BOOT                                                            
*                                                                               
         LI,R2    M:BO              GET THE 1ST TWO CHARACTERS OF THE           
         CAL1,1   GETAINFO          OUTPUT DEVICE, WHICH IS DEVICE TYPE         
         LH,R0    MASDDEVA                                                      
         STTH,R0  READ98A           SAVE NAME FOR LBOOT                         
         AND,R0   M16               MASK OUT NAME                               
         CI,R0    'PP'              IS IT A PAPER PUNCH                         
         BNE      %+3               NO                                          
         LI,R0    X'82'             YES, USE READ ORDER OF READ BLNKS           
         B        %+2                                                           
         LI,R0    2                 READ ORDER FOR MAG TAPE                     
         STTB,R0  READ90A                                                       
         LW,R1    K:UNAVBG                                 /SIG7-4419/*C5734    
         AI,R1    -LBOOT99                                 /SIG7-4419/*C5734    
         CI,R1    X'4000'                                  /SIG7-4419/*C5734    
         BLE      %+2                                      /SIG7-4419/*C5734    
         LI,R1    X'4000'                                  /SIG7-4419/*C5734    
         STTW,R1  LBOOT19A                                                      
         LI,R1    LBOOT-SBOOT                                                   
         AW,R1    BPEND                                                         
         STW,R1   M:BO+2                                                        
         LI,R2    (LBOOT99-LBOOT1)*4                                            
         STW,R2   WRITEBO+4         STORE FWA AND BYTE COUNT OF LBOOT           
         SLS,R2   -2                CHANGE TO WORDS                             
         AI,R2    -1                REDUCE FOR CKSM                             
         BAL,LINK GENCKSM           FORM CHECKSUM FOR THE BLOCK                 
         CAL1,1   WRITEBO           GO WRITE OUT LBOOT                          
*                                                                               
*   WRITE HEADER FOR RADBOOT                                                    
*                                                                               
         LW,R0    K:RDBOOT                                                      
         STW,R0   SAVE91+1          SAVE DEVICE # OF RADBOOT IN HEADER          
         LI,R0    0                 SET TO WRITE IT TO SECTOR ZERO              
         STW,R0   SAVE91+2          OF THE SYSTEM DISC                          
         STW,R0   SAVE91+4          AND NO SECTORS OF ZEROS TO WRITE            
         LI,R0    SPINDEX           SET AREA INDEX VALUE FOR SP AREA            
         STW,R0   AREA              SO WE CAN GET AREA INFO ABOUT SP            
         BAL,R14  UNPKMASD          FOR THE BOOTSTRAP PROGRAM                   
         B        ERROR04           SHOULDN'T HAPPEN, BUT IF IT DOES...         
         LW,R0    MASDTPC           GET TRACKS PER CYLINDER FOR DEVICE          
         STB,R0   SAVE91+2          STORE IN HEADER                             
         LW,R0    MASDWPS           GET, SET WORDS PER SECTOR, AND MAKE         
         SLS,R0   16                AREA INDEX, DP, ETC, IN HEADER = 0          
         STW,R0   SAVE91                                                        
         LI,R0    C'SP'             SET AREA NAME IN EBCDIC INTO THE            
         STW,R0   SAVE91+3          HEADER RECORD                               
         STW,R0   AREANAME          AND ASSIGN BLOCK                            
         LW,R0    MASDSPT           SET SECTORS PER TRACK IN HEADER             
         STH,R0   SAVE91+3                                                      
         LH,R0    MASDDEVA          CHECK DEVICE FOR A DISC AND SET THE         
         AND,R0   M16               DISC FLAG IN THE HEADER IF 'SP' IS          
         CI,R0    C'DP'             ON A DISC                                   
         BNE      SAVE3R              NOT A DISC; DO NOT SET FLAG               
*                                                                               
         LI,R15   DPAFLAG           SET 'DISC' FLAG IN BYTE 2, WORD 0           
         STS,R15  SAVE91            OF THE RADBOOT BLOCK HEADER                 
*                                                                               
SAVE3R   RES      0                                                             
         LI,R1    SAVE91                                                        
         LI,R2    LSAVHDRD          SET LENGTH OF THE RECORD                    
         BAL,LINK GENCKSM           FORM CHECKSUM FOR THE BLOCK                 
         CAL1,1   WRITEBOH          GO WRITE HEADER FOR RAD BOOT                
*                                                                               
*   WRITE RADBOOT                                                               
*                                                                               
         LD,R0    SAVE94            POINT AT FILE 'SP.RADBOOT' AND READ         
         STD,R0   FILENAME          IT IN                                       
         LW,R0    GIOFBIT           SET FILENAME ONLY IN ASSIGNMENT TO          
         LW,R1    GIOFA             DEFAULT SYSTEM ACCOUNT NAME                 
         STS,R0   ASNFILE+1                                                     
         LI,R2    F:BI                                                          
         CAL1,1   ASNFILE           ASSIGN FILE TO F:BI DCB                     
         LI,R0    88                SET TO READ THE 88 BYTES (22 WORDS)         
         STW,R0   RDDISC4           OF SECTOR (GRANULE)                         
         LI,R0    0                 ZERO, THE ONLY GRANULE IN THE FILE          
         STW,R0   RDDISC5           INTO THE BACKGROUND BUFFER                  
         LW,R0    BPEND                                                         
         STW,R0   BIBUFF                                                        
         CAL1,1   RDDISC            GO READ RAD BOOT                            
         CAL1,1   CLFLEIN           CLOSE DCB                                   
         LW,R1    BPEND                                                         
         STW,R1   M:BO+2                                                        
         LI,R2    22                                                            
         BAL,LINK GENCKSM           FORM CHECKSUM FOR THE BLOCK                 
         LI,R0    92                SET TO WRITE 23 WORDS                       
         STW,R0   WRITEBO+4                                                     
         CAL1,1   WRITEBO           WRITE OUT RAD BOOT                          
         PAGE                                                                   
         SPACE    2                                                             
*   THE FOLLOWING RECORDS HAVE BEEN WRITTEN:                                    
*     1.  SBOOT                                                                 
*     2.  LBOOT                                                                 
*     3.  RADBOOT HEADER                                                        
*     4.  RADBOOT                                                               
*                                                                               
*   THE SPECIFIED AREAS WILL NOW BE WRITTEN WITH EACH DATA RECORD               
*   PRECEEDED BY A 6 WORD HEADER RECORD (5 DATA WORDS, 1 CKSM WORD).            
*                                                                               
         LD,R0    ZEROS             CLEAR FILE NAME SO WE CAN READ THE          
         STD,R0   BIFNAME           WHOLE AREA, AND                             
         STW,R0   SAVE91+3          SET NO SECTORS OF ZERO YET                  
         STW,R0   LOSTCNT           SET NOTHING LOST ON SAVE TAPE               
         STW,R0   EOTSW             SET END-OF-TAPE NOT FOUND YET               
         LI,R13   0                 SET INITIAL VOLUME'S ID = 0                 
         LI,R0    SAVERF            SET ERR FUNCTION FOR SAVE                   
         STW,R0   ERRFCN            TO SKIP OVER BAD SECTORS                    
*                                                                               
*                          FIND INDEX TO FIRST AREA TO SAVE                     
         LI,R6    0                 START SEARCH AT SP AREA                     
*                                   GAN VERIFIED AT LEAST 1 AREA MARKED         
*                                                                               
SAVE4    EQU      %         TEST IF AREA INDEX R6 MARKED FOR SAVE               
         LW,R4    R6                UPDATE INDEX TO 1ST TO SAVE                 
         LB,R0    AREASWS,R6        IS REQUEST BYTE SET ?                       
         BNEZ     SAVE6               YES, NOW TEST IF ANY MORE                 
*                                                                               
         AI,R6    1                 STEP TO NEXT AREA                           
         CB,R6    K:MDNAME          TESTED LAST AREA YET ?                      
         BL       SAVE4               NO, TRY ANOTHER                           
*                                                                               
         B        SEG4X27           BAD ERROR: SAY NOTHING SAVED                
*                                                                               
SAVE6    EQU      %         FIND NEXT AREA IF ANY (TEST IF R4 IS LAST)          
         AI,R6    1                 STEP INDEX                                  
         CB,R6    K:MDNAME          AT LAST ALLOCATED AREA ?                    
         BGE      SAVE7               YES, SET (R4) IS LAST AREA                
*                                                                               
         LB,R0    AREASWS,R6        IS THE NEXT ARA REQUESTED ?                 
         BEZ      SAVE6               NO, STEP TO ANOTHER                       
*                                                                               
         B        SAVE11              YES, DO SAVE OF AREA (R4)                 
*                                                                               
*                                                                               
SAVE7    EQU      %         READY TO SAVE LAST AREA REQUESTED; FLAG IT          
         LI,R6    0                 SET NO MORE TO DO; ON LAST AREA             
         PAGE                                                                   
         SPACE    2                                                             
SAVE11   EQU      %         START WRITING OUT THE AREA GIVEN BY (R4)            
         STW,R4   AREA              SET AREA INDEX AND THEN GET AREA &          
         BAL,RLNK UNPKMASD          DEVICE INFO; ASSIGN AREA TO F:BI            
         B        ERROR04           SHOULDN'T HAPPEN, BUT IF IT DOES ...        
*                                                                               
*                           INITIALIZE THE HEADER RECORD BUFFER                 
         LW,R0    MASDWPS           GET WORDS PER SECTOR                        
         STH,R0   SAVE91            AND SAVE IN HW 0 OF HEADER BLOCK            
         LI,R1    3                 SAVE AREA INDEX IN BYTE 3 OF HEADER         
         STB,R1   AREASWS,R4        MARK THIS AREA'S SAVE IN PROGRESS           
         STB,R4   SAVE91,R1                                                     
         LW,R0    MASDNAME          SET AREA'S NAME IN EBCDIC INTO              
         STW,R0   SAVE91+3                                                      
         LW,R2    MASDDCTI          GET DCT INDEX FOR AREA'S DEVICE             
         LH,R0    *K:DCT1X,R2       GET RAD DEVICE NUMBER                       
         STW,R0   SAVE91+1          SAVE IN HEADER                              
         LW,R0    MASDSIZE          SET TOTAL SIZE OF AREA AS NUMBER            
         STW,R0   SAVE92            OF SECTORS TO WRITE ON SAVE TAPE            
         LW,R0    MASDBOA           SET START SECTOR IN HEADER AS               
         STW,R0   SAVE91+2          ADDR OF FIRST SECTOR                        
         LW,R0    MASDTPC           GET TRACKS PER CYLINDER FOR DEVICE          
         STB,R0   SAVE91+2          STORE IN HEADER                             
         LW,R0    MASDSPT           GET SECTORS PER TRACK IN LEFT HALF          
         STH,R0   SAVE91+3          OF WORD                                     
         LI,R0    0                                                             
         STW,R0   RDDISC5           SET GRANULE NO. IN FPT=0                    
         STW,R0   MASDFREE          SET NOT SAVING A DISC DEVICE                
         STW,R0   SAVE91+4          AND NO SECTORS OF ZERO TO WRITE             
         LH,R0    MASDDEVA          THEN CHECK DEVICE NAME TO SEE IF            
         AND,R0   M16               IT HAS 'DP' AS ITS 1ST TWO LETTERS          
         CI,R0    C'DP'             IS IT A DISC DEVICE ?                       
         BNE      SAVE13              NO                                        
*                                                                               
         LI,R0    DPAFLGB           YES, SET 'DP' FLAG FOR HEADER               
         STW,R0   MASDFREE          FLAG BYTE                                   
*                                                                               
SAVE13   RES      0         CHECK SIZE OF BUFFER SPACE FOR MAX                  
         LW,R0    BACKSZE           GET SIZE OF BUFFER AREA - 1 WORD,           
         AI,R0    -1                WHICH IS NEEDED FOR THE CHECKSUM            
         CI,R0    X'3FFF'                                                       
         BLE      %+2                                                           
         LI,R0    X'3FFF'                                                       
         CH,R0    SAVE91            IS THERE ENUF ROOM TO LOAD 1 SECT.          
         BL       SEG4X19             NO, GIVE 'NOT ENUF ROOM' ERROR            
*                                                                               
         DH,R0    SAVE91            GET NUMBER OF SECTORS IN LOAD AREA          
         STW,R0   SAVE93            SAVE IT                                     
         LW,R0    BPEND                                                         
         STW,R0   BIBUFF            STORE FWA FOR RAD READ                      
*                                                                               
*                                                                               
SAVE16   RES      0         FORM AND WRITE NEXT SAVE RECORD                     
         LI,R12   0                 SET NO SECTORS OF ZERO AFTER DATA           
         LW,R10   SAVE92            GET NUMBER OF SECTORS LEFT TO DO            
         LW,R8    R10               SET AS NUMBER TO READ NEXT                  
         SW,R10   SAVE93            DROP NUM LEFT BY A BUFFER'S WORTH           
         BLEZ     %+2                LESS THAN A BUFFER; DO WHAT'S LEFT         
         LW,R8    SAVE93             TOO MANY: DO A BUFFER'S WORTH              
*                                                                               
         STW,R10  SAVE92            SAVE NUMBER YET TO PROCESS                  
         MH,R8    SAVE91            CHANGE NO. SECT. TO WORDS                   
         SLS,R9   2                 CHANGE TO BYTES                             
         STW,R9   RDDISC4           STORE BYTE COUNT TO READ                    
         CAL1,1   RDDISC            GO READ NEXT SECTORS                        
         AWM,R8   RDDISC5           SET TO NEXT GRANULE NO.                     
*                                                                               
SAVE18   RES      0         PROCESS DATA TO FIND SECTORS OF ALL ZEROS           
         SLS,R9   -2                CONVERT BYTE COUNT BACK TO WORDS            
         LI,R1    0                 SET INDEX=0                                 
         LW,R2    R9                R2=TOTAL NO. WORDS LOADED                   
         LW,R0    *BPEND,R1         FIND FIRST NONZERO WORD IN BUFFER           
         BNEZ     SAVE21            FOUND IT                                    
         AI,R1    1                                                             
         BDR,R2   %-3               IF FALL THRU, WHOLE BUFFER=0                
*                                                                               
         AWM,R8   SAVE91+4          STEP NUMBER OF SECTORS OF ZEROS             
         LW,R0    SAVE92            IS THIS LAST TIME                           
         BGZ      SAVE16            NO, GO READ MORE                            
         STH,R2   SAVE91+1          ZERO OUT NO. SECT IN REC.                   
         B        SAVE24                                                        
*                                                                               
SAVE21   RES      0         ADJUST HEADER FOR LEADING ZERO SECTORS              
         DH,R1    SAVE91            COMPUTE NUM SECTS OF ZERO AT FRONT          
         AWM,R1   SAVE91+4          AND STEP ACCUMULATED COUNT                  
         MH,R1    SAVE91            CHANGE R1 BACK TO NO. WORDS OF ZERO         
         SW,R9    R1                R9=NO. WORDS LEFT IN BUFFER                 
         AW,R1    BPEND                                                         
         STW,R1   M:BO+2            STORE FWA OF OUTPUT BUFFER                  
         AI,R1    -1                                                            
         LW,R2    R9                                                            
         LW,R0    *R1,R2            KNOCK OFF ZEROES FROM BACK END              
         BNEZ     %+2               DONE                                        
         BDR,R2   %-2                                                           
         LW,R1    R9                                                            
         SW,R1    R2                R1=NO. ZEROES ON BACK END                   
         DH,R1    SAVE91            CHANGE R1 TO NO. SECT.                      
         STW,R1   R12               SAVE NUM OF ZERO SECTORS AT END             
         MH,R1    SAVE91            R1 NOW=NO. WORDS OF ZERO                    
         SW,R9    R1                R9=NO. WORDS IN OUTPUT RECORD               
         SLS,R9   2                 CHANGE TO BYTES                             
         STW,R9   WRITEBO+4         STORE BYTE COUNT IN FPT                     
         MTW,4    WRITEBO+4         ADD IN FOR CKSM                             
         SLS,R9   -2                CHANGE BACK TO WORDS                        
         LW,R1    R9                                                            
         DH,R1    SAVE91            R1=NO. SECT. IN OUTPUT REC.                 
         STH,R1   SAVE91+1          STORE NO. SECT.                             
*                                                                               
SAVE24   EQU      %         TEST IF LAST RECORD FOR THE AREA                    
         LW,R0    MASDFREE          GET 'DP' FLAG WORD, OR ZERO IF NOT          
         LW,R1    SAVE92            ANY SECTORS LEFT IN AREA TO WRITE ?         
         BGZ      SAVE26              YES, MORE TO WRITE                        
*                                                                               
         MTW,+00  R12               NO, WILL A HEADER FOR ZEROS FOLLOW ?        
         BNEZ     SAVE26              YES, DON'T SET 'LRA' FLAG YET             
*                                                                               
SAVE25   RES      0         SET 'LRA' FLAG                                      
         AI,R0    LRAFLGB           SET LAST RECORD IN AREA FLAG                
         CI,R6    0                 ARE THERE MORE AREAS TO GO ?                
         BGZ      SAVE26              YES, NOT END OF TAPE                      
*                                                                               
         AI,R0    LRTFLGB           SET 'LAST RECORD ON TAPE' FLAG              
*                                                                               
SAVE26   EQU      %         STORE FLAGS LAST RECORD OF -AREA, -TAPE             
         OR,R0    R13               INSERT VOLUME ID (SEQ NUMBER)               
         LI,R1    2                 SET INDEX FOR HEADER FLAG BYTE              
         STB,R0   SAVE91,R1         STORE FLAGS                                 
*                                                                               
         LI,R1    SAVE91            POINT AT BLOCK TO CHECKSUM                  
         LI,R2    LSAVHDRD          SET LENGTH TO USE                           
         BAL,LINK GENCKSM           GENERATE AND STORE CHECKSUM                 
         CAL1,1   WRITEBOH          WRITE OUT HEADER                            
         LH,R0    SAVE91+1          IS THERE A RECORD TO FOLLOW HEADER          
         BEZ      SAVE30            NO, GO BACK FOR NEXT AREA                   
         LW,R1    M:BO+2                                                        
         LW,R2    R9                                                            
         BAL,LINK GENCKSM           COMPUTE, STORE DATA RECORD CHECKSUM         
         CAL1,1   WRITEBO           GO WRITE DATA RECORD                        
         STW,R12  SAVE91+4          SET NUM ZERO SECTORS AT BACK END AS         
*                                     START OF NEXT RECORD HEADER               
         LW,R0    SAVE92            ARE WE DONE WITH AREA                       
         BGZ      SAVE32              NO, CHECK END OF TAPE                     
*                                                                               
         LW,R0    R12               ARE THERE ZEROS AT END ?                    
         BEZ      SAVE30              NO, DONE WITH AREA; TEST ANOTHER          
*                                                                               
         LI,R12   0                 SET NO SECTORS OF ZERO AT END               
         STH,R12  SAVE91+1          AND NO DATA IN THIS RECORD                  
         LW,R0    MASDFREE          GET 'DP' FLAG IF IT IS SET                  
         B        SAVE25            GO WRITE LAST HEADER                        
*                                                                               
SAVE30   RES      0         DONE WITH AN AREA; DECIDE WHAT NEXT                 
         CAL1,1   CLFLEIN           CLOSE DCB FOR THE AREA                      
         XW,R12   EOTSW             CLEAR E-O-T SW INCASE FINISHED              
         LW,R4    R6                SET NEXT AREA; IS THERE A NEXT ?            
         BEZ      SAVE2C              NO, VERIFY THIS TAPE AND STOP             
*                                                                               
         MTW,+00  R12               YES, AT END OF THIS TAPE ?                  
         BEZ      SAVE6               NO, SAVE THE NEXT AREA                    
*                                                                               
         LI,R5    SAVE6             YES, SET WHERE TO CONTINUE                  
         B        SAVE34            GO TO COMMON 'GET NEXT VOULME'              
*                                                                               
*                                                                               
SAVE32   RES      0         MORE DATA IN AREA: CHECK 'END-OF-TAPE'              
         MTW,+00  EOTSW             ARE WE AT END OF THIS VOLUME ?              
         BEZ      SAVE16              NO, GET NEXT DATA RECORD                  
*                                                                               
         LI,R5    SAVE16            YES, SET WHERE TO CONTINUE                  
*                                                                               
SAVE34   RES      0         SET UP TO GET THE NEXT VOLUME                       
         PUSH     3,R4              SAVE AREA INDICIES, RETURN ADDRESS          
         STW,R5   EOTSW             INSURE EOT SW IS SET TO CONTINUE            
         LI,R0    MRTFLGB+LRTFLGB   FORM THE 'END-OF-VOLUME' HEADER             
         LI,R1    2                                                             
         STB,R0   SAVE91,R1                                                     
         LI,R0    0                 SET NO DATA, NO ZERO SECTORS                
         STW,R0   SAVE91+4          FOR THIS HEADER RECORD                      
         STH,R0   SAVE91+1                                                      
         LI,R1    SAVE91                                                        
         LI,R2    LSAVHDRD                                                      
         BAL,LINK GENCKSM                                                       
         CAL1,1   WRITEBOH          WRITE THE HEADER                            
         LI,R0    SAVERFV           SET SPECIAL ERRFCN TO GET PAST THE          
         STW,R0   ERRFCN            EOT MARKER ON THE WEOFS                     
         B        SAVE2C            GO TERMINATE AND VERIFY TAPE                
         PAGE                                                                   
         SPACE    2                                                             
SAVE40   RES      0         ERROR READING AN AREA; SKIP OVER BAD DATA           
         LW,R1    RDDISC4           GET NUMBER OF BYTES WE WERE TO READ         
         SLS,R1   -3                CONVERT TO DOUBLE WORDS                     
         AI,R1    -1                AND ADJUST FOR STARTING AT ZERO             
         LD,R14   LOSTDATA          GET CONSTANT TO REPLACE LOST DATA           
         STD,R14  *BPEND            WITH ON THE SAVE TAPE                       
*                                                                               
SAVE41   RES      0         FILL MEMORY WITH 'DATALOST'                         
         STD,R14  *BPEND,R1                                                     
         BDR,R1   SAVE41                                                        
*                                                                               
         STW,R1   T1                RESET 1ST, LAST SECTOR NUMBER THAT          
         STW,R1   T2                WAS LOST                                    
         MTW,-1   ERRFCN            SET TO GOTO SAVE48 ON READ ERRORS           
         LW,R0    MASDWPS           GET BYTES PER SECTOR                        
         SLS,R0   2                                                             
         LW,R1    MASDWPS           GET WORDS PER SECTOR                        
         LW,R2    RDDISC4           GET BYTES WE WERE TRYING TO READ            
         STW,R0   RDDISC4           SET TO READ ONLY 1 SECTOR                   
*                                                                               
SAVE42   RES      0         READ 1 SECTOR OF DATA AT A TIME                     
         CAL1,1   RDDISC            UNTIL WE FIND THE BAD SECTOR (S)            
*                                                                               
SAVE43   RES      0         DATA FRO THE SECTOR READ OR SKIPPED HERE            
         AWM,R1   BIBUFF            STEP READ ADDRESS BY 1 SECTOR               
         MTW,+1   RDDISC5           STEP SECTOR NUMBER                          
         SW,R2    R0                DECREMENT COUNT OF BYTES TO READ.           
         BGZ      SAVE42              MORE TO GO, READ ANOTHER SECTOR           
*                                                                               
         MTW,+1   ERRFCN            RESET NORMAL ERRFCN START                   
         LW,R0    BPEND             RESET BUFFER ADDR IN DCB                    
         STW,R0   BIBUFF            TO START AT BEGIN OF SPACE                  
         LW,R8    R9                SET NUMBER OF WORDS READ/SKIPPED            
         SLS,R8   -2                AND ARE IN THE BUFFER                       
         DH,R8    SAVE91            AND CONVERT BACK TO SECTORS                 
         LW,R15   T1                WAS A BAD SECTOR FOUND ?                    
         BEZ      SAVE18              NO, FORGET ALL THIS                       
*                                                                               
         STRNG    LOSTDTA1          YES, OUT START OF MESSAGE                   
         INTGR    DEC,SPAC,5        OUT START ADDRESS                           
         CW,R15   T2                ONLY 1 BAD SECTOR ?                         
         BE       SAVE44              YES, DON'T OUT RANGE                      
*                                                                               
         STRNG    LOSTDTA2          NO, OUT RANGE INFO                          
         INTGR    ,,5,T2            OUT END SECTOR NUMBER                       
*                                                                               
SAVE44   RES      0         OUT END OF LOST DATA MESSAGE                        
         STRNG    LOSTDTA3          OUT 'MAY BE LOST ... '                      
         CHARS    3,MASDNAME,1      OUT AREA NAME                               
         PRNT                       PRINT THE LINE                              
         MTW,+1   LOSTCNT           SET SOME DATA LOST                          
         B        SAVE18            GO WRITE WHAT WE HAVE ON SAVE TAPE          
         PAGE                                                                   
         SPACE    2                                                             
SAVE48   RES      0         ERROR READING SECTORS 1 AT A TIME: MARK IT          
         LW,R8    RDDISC5           GET SECTOR NUMBER                           
         XW,R8    T2                SET AS RANGE END; 1ST ERROR ?               
         BNEZ     SAVE43              NO, CONTINUE                              
*                                                                               
         LW,R8    RDDISC5           YES, GET SECTOR ADDRESS AGAIN               
         STW,R8   T1                AND SET AS START OF RANGE                   
         B        SAVE43            CONTINUE READING                            
*                                                                               
*                                                                               
SAVE49   RES      0         END-OF-TAPE FOUND; MARK ANOTHER VOL NEEDED          
         MTW,+1   EOTSW             SET E-O-T FOUND                             
         B        *R8               AND CONTINUE AS USUAL                       
         PAGE                                                                   
         SPACE    2                                                             
LOSTDTA1 TXTC     'DATA IN SECTOR '     XXXXX  LOST                             
LOSTDTA2 TXTC     ' TO '     XXXXX                 DATA                         
LOSTDTA3 TXTC     ' MAY BE LOST IN AREA'     AA        MESSAGES                 
*                                                                               
*                                                                               
SAVERFV  ERRP     X'05',0           EOF: IGNORE AND CONTINUE                    
*                                                                               
         ERRP     X'41',SAVE48      READ ERROR: SKIP THE SECTOR                 
SAVERF   ERRP     X'41',SAVE40      READ ERROR: DO READ BY SECTOR RETRY         
         ERRP     X'1C',SAVE49      E-O-T:  MARK ANOTHER VOLUME NEEDED          
         ERRP     X'FF',0           ALL OTHERS: DO AS PER ROOT                  
*                                                                               
         BOUND    8                                                             
LOSTDATA TXT      'LOSTDATA'        FILLER FOR ANY DATA LOST                    
SAVE94   TXT      'RADBOOT '        NAME OF BOOT FILE IN SP AREA                
         TITLE    '     UTILITY ROUTINES FOR SAVE AND RESTORE'                  
*                                                                               
*                                   CKSM ROUTINE                                
*                                   CALL IS BAL,LINK GENCKSM                    
*                                     WHERE  R1=FWA TO START CKSM               
*                                            R2=NO. WORDS TO CKSM               
*                                   STORES CKSM IN LAST CELL                    
*                                   COMPUTES 2'S COMPLEMENT CKSM WITH           
*                                     CARRY                                     
*                                   USES  R0-R3                                 
GENCKSM  EQU      %         GENERATE A CHECKSUM                                 
         LI,R3    0                                                             
         LI,R0    0                                                             
SAVE81   AW,R0    *R1,R3                                                        
         BCR,8    %+2               NO CARRY                                    
         AI,R0    1                 ADD 1 IF CARRY                              
         AI,R3    1                 STEP INDEX                                  
         BDR,R2   SAVE81                                                        
         LCW,R0   R0                                                            
         STW,R0   *R1,R3            STORE CKSM AS 2'S COMPL.                    
         B        *LINK             RETURN                                      
         PAGE                                                                   
*                                                                               
*                                                                               
*                                   SBR TO CHECK CKSM                           
*                                   CALL IS BAL,LINK CHKCKSM                    
*                                      WHERE  R1=NO. BYTES TO CKSM              
*                                             R2 = DATA START                   
*                                   IF ERROR TAKES SPECIAL EXIT                 
CHKCKSM  EQU      %         CHECK A CHECKSUM                                    
         LI,R0    0                 CLEAR ACCUMULATOR                           
         SLS,R1   -2                CHANGE TO WORDS                             
         AI,R1    -1                                                            
SAVE86   AW,R0    *R2,R1            COMPUTE                                     
         BCR,8    %+2                                                           
         AI,R0    1                 ADD 1 IF CARRY                              
         BDR,R1   SAVE86                                                        
         CI,R1    0                                                             
         BE       SAVE86            LOOP BACK FOR LAST CELL                     
         CI,R0    1                 IS CKSM RIGHT                               
         BNE      *LINK               NO, RETURN AT ERROR EXIT                  
*                                                                               
         AI,LINK  1                 YES, RETURN AT THE OK EXIT                  
         B        *LINK                                                         
         TITLE    '     RESTORE ROUTINE'                                        
         SPACE    2                                                             
******** ROUTINE RESTORE ********                                               
*                                                                               
*        INPUT    DIRECTIVE PARAMETERS                                          
*                                                                               
*        OUTPUT   RAD AREAS RESTORED                                            
*                                                                               
*        FUNCTION RESTORE SELECTED AREA OR AREAS FROM A SAVE VOLUME.            
*                 THE VOLUME IS SEARCHED JUST ONCE AND EACH AREA                
*                 REQUESTED IS RESTORED AS FOUND.                               
*        NOTE:    THE RESTORE CAN ONLY BE DONE FROM MAGNETIC TAPE.              
*                 PAPER TAPE IS NOT ALLOWED.                                    
*        NOTE:    MULTIPLE VOLUME SAVES ARE ALSO SEARCHED JUST ONCE             
*                 AND IN THE ORDER CREATED. EACH VOLUME MUST BE MOUNTED         
*                 IN ORDER AS REQUESTED. ALL BUT THE LAST VOLUME IS             
*                 REWOUND OFFLINE (UNLOADED) AFTER IT HAS BEEN PROCESSED        
*        NOTE:    IF MULTIPLE VOLUME SAVES ARE BEING RESTORED, THE JOB          
*                 ==>  MUST  <== BE RUN IN ATTENDED MODE, OR ELSE IT            
*                 WILL ABORT AFTER THE FIRST VOLUME.                            
*        NOTE:    THE CURRENT INDEX OF THE AREA BEING RESTORED IS               
*                 COMPARED WITH IT'S INDEX WHEN SAVED; IF THEY DIFFER,          
*                 A WARNING MESSAGE IS GIVEN.  IF THE SAVE TAPE WAS             
*                 CREATED BY A PRIOR VERSION (AND THUS HAS A 5 WORD             
*                 HEADER AND NO AREA NAME), THIS CHECK IS BYPASSED AND          
*                 NO WARNING GIVEN IF THEY ARE DIFFERENT AREAS.                 
*        CALL     B  REST                                                       
*                                                                               
*        SUBROUTINES USED:     GAN TO GET ALL AREA NAMES TO RESTORE             
*                                   UNPKMASD, GETAX, TYPRNT   IN SEG0           
*                                   CHKHDR, CHKCKSM, RESTGNV  IN SEG4           
*                                                                               
RESTORE  RES      0         RESTORE SELECTED AREAS FROM A SAVE TAPE             
         LI,RLNK+1  0               SET CK, BT, IS, OS NOT ALLOWED              
         BAL,RLNK GAN               PROCESS AREA NAMES, BUILD TABLE             
         B        SEG4ERR             ERROR, REPORT IT                          
*                                                                               
         LD,R0    ZEROS             CLEAR FILE NAME IN F:BI DCB SO              
         STD,R0   BIFNAME           WE CAN WRITE ON ENTIRE AREA                 
         LI,R1    8                 SET CHECK-WRITE BIT IN WRITE FPT            
         STS,R1   WRDISC+1          TO FORCE CHECK AFTER WRITE OPER'TN          
         LW,R0    BPEND             SET END OF RADEDIT AS START OF THE          
         STW,R0   BIBUFF            TAPE INPUT (READ) BUFFER, AND               
         STW,R0   M:BI+2            DISC OUTPUT (WRITE) BUFFER                  
         LW,R0    BACKSZE           GET SIZE OF BUFFER AREA IN WORDS            
         CI,R0    X'4000'           LIMIT SIZE TO MAXIMUM NUMBER                
         BLE      %+2               OF BYTES WRITABLE IN ONE WRITE              
         LI,R0    X'4000'                                                       
         STW,R0   REST90                                                        
         LI,R0    RESTERF                                                       
         STW,R0   ERRFCN            SET ERROR PROCESSOR CONTROLS                
         PAGE                                                                   
*                                                                               
*                                                                               
REST2    RES      0         POSITION SAVE TAPE                                  
         LI,R13   -1                INITIAL VOLUME ID -1                        
         BAL,RLNK RESTGNV           GET NEXT VOLUME                             
*                                                                               
*                           SKIP OVER SMALL BOOT                                
         LI,R0    88                BYTE COUNT FOR SMALL BOOT                   
         STW,R0   READBI+4                                                      
         CAL1,1   READBI            GO READ IN SMALL BOOT                       
*                                                                               
*                           COMPUTE SIZE OF LARGE BOOT, THEN SKIP IT            
         LW,R1    BPEND                                                         
         LW,R0    SBOOT8-SBOOT,R1   GET BYTE COUNT OF BIG BOOT                  
         AND,R0   M19               MASK OUT                                    
         STW,R0   READBI+4                                                      
         CAL1,1   READBI            SKIP OVER BIG BOOT                          
*                                                                               
*                           SKIP RADBOOT HEADER                                 
         CAL1,1   READBIH           SKIP OVER RADBOOT HEADER                    
*                                                                               
*                           SKIP OVER RADBOOT                                   
         LI,R0    92                                                            
         STW,R0   READBI+4          STORE BYTE COUNT FOR RADBOOT                
         CAL1,1   READBI            SKIP OVER RADBOOT                           
         PAGE                                                                   
         SPACE    2                                                             
REST10   EQU      %         TEST IF ANY MORE AREAS TO BE RESTORED               
         LB,R1    K:MDNAME          GET COUNT OF AREAS TO TEST                  
         AI,R1    -1                ADJUST TO ZERO RELATIVE INDEX               
*                                                                               
REST11   EQU      %         TEST EACH AREA'S FLAG BYTE FOR 'YES', REST          
         LB,R0    AREASWS,R1        IS THE AREA REQUESTED ?                     
         BNEZ     REST12              YES, KEEP SEARCHING THE TAPE              
*                                                                               
         BDR,R1   REST11              NO, TEST MORE AREAS ?                     
*                                                                               
         LB,R0    AREASWS,R1        TEST THE SP AREA TOO                        
         BEZ      REST50              NO MORE TO RESTORE; TEST IF OK            
*                                                                               
REST12   EQU      %         READ HEADER OF NEXT AREA ON TAPE                    
         CAL1,1   READBIH           READ THE HEADER                             
         BAL,RLNK CHKHDR            CHK CKSM AND FIX OLD STYLE HEADERS          
         LW,R4    REST91            CHECK FOR END-OF-VOLUME                     
         CI,R4    MRTFLAG           IS IT THE END OF THE VOLUME ?               
         BANZ     REST18              YES, GET NEXT VOLUME                      
*                                                                               
         AND,R4   M8                GET THE AREA'S INDEX                        
         LW,R8    REST91+3          GET THE AREA NAME                           
         SLS,R8   16                                                            
         BAL,RLNK GETAX             GET THE AREAS INDEX                         
         LW,R1    R4                USE INDEX AS GIVEN                          
*                                                                               
         LW,R4    R1                SET AREA'S INDEX FOR RESTORING              
         BLZ      REST13            IF INVALID OR PUBLIC INDEX, SKIP IT         
*                                                                               
         CB,R4    K:MDNAME          IS INDEX WITHIN LEGAL RANGE ?               
         BGE      REST13              NO, SKIP AND TEST IF MORE ON TAPE         
*                                                                               
         LB,R0    AREASWS,R4        IS THIS AREA TO BE RESTORED ?               
         BNEZ     REST20              YES, RESTORE IT                           
*                                                                               
REST13   RES      0         TEST IF AT END OF SAVE TAPE                         
         LW,R0    REST91            TEST IF THIS LAST AREA ON TAPE              
         CI,R0    LRTFLAG           IS 'LAST RECORD ON TAPE' FLAG SET ?         
         BANZ     REST50              YES, TEST IF ALL AREAS RESTORED           
*                                                                               
REST14   RES      0         SKIP THE AREA; READ OVER AND IGNORE THEM            
         LH,R0    REST91+1          GET NUMBER OF SECTORS IN NEXT REC           
         BEZ      REST10              NONE, GET NEXT HEADER                     
*                                                                               
         MH,R0    REST91            CHANGE TO NO. WORDS                         
         AI,R1    1                 ADD ONE FOR CKSM                            
         CW,R1    REST90            IS THERE ENUF ROOM TO READ REC,             
         BG       SEG4X19             NO, GIVE ERROR; TOO LITTLE SPACE          
*                                                                               
         SLS,R1   2                 CONVERT WORDS TO BYTES, AND                 
         STW,R1   READBI+4          STORE BYTE COUNT TO READ                    
         CAL1,1   READBI            GO SKIP OVER DATA RECORD                    
         B        REST10                                                        
*                                                                               
*                                                                               
*                                                                               
REST18   RES      0         END-OF-VOLUME: GET THE NEXT                         
         BAL,RLNK RESTGNV           STEP SEQ ID NUM; GET THE VOLUME             
         B        REST12            CONTINUE SEARCH                             
         PAGE                                                                   
         SPACE    2                                                             
REST20   EQU      %         AREA TO SAVE FOUND; COPY IT TO DISC                 
         STW,R4   AREA              SET AREA INDEX NOW IN USE                   
         BAL,RLNK UNPKMASD          UNPACK AREA INFO                            
         B        ERROR04           SHOULDN'T HAPPEN, BUT IF IT DOES ...        
         LI,R0    0                 RESET DCB, FPT FOR A NEW AREA               
         STW,R0   WRDISC5           SET TO START AT GRANUAL 0                   
         STB,R0   AREASWS,R4        SET AREA RESTORE AS ATTEMPTED               
         LW,R0    MASDWPS           GET THE AREA'S WORDS PER SECTOR;            
         CH,R0    REST91            IS RAD WE'RE RESTORING SAME AS SAVED        
         BNE      SEG4X21             NO, INCOMPATABILITY ERROR                 
*                                                                               
*                                                                               
         LW,R15   REST91            GET INDEX OF AREA WHEN SAVED                
         AND,R15  M8                IS IT THE SAME AS NOW ?                     
         CW,R15   R4                THAT IS, HAS THE AREA MOVED ?               
         BE       REST22              SAME INDEX: ALL IS OK                     
*                                                                               
         STRNG    MESS47            OUT 'WARNING: AREA INDEX FOR AREA '         
         CHARS    2,MASDNAME,2        AA                                        
         STRNG    MESS47A           ' HAS CHANGED FROM '                        
         INTGR    DEC,SPAC,2          XX                                        
         STRNG    MESS47B           ' TO '                                      
         INTGR    ,,2,AREA            YY                                        
         BAL,RLNK OUT%MSG           OUT MSG TO LO, LL, OC, ETC                  
*                                                                               
REST22   RES      0         BEGIN ACTUAL RESTORATION SETUP                      
         LW,R0    MASDSIZE          GET AREA SIZE IN SECTORS AND SAVE           
         STW,R0   REST92            AS MAX NUMBER TO COPY FROM TAPE             
         LW,R0    REST90                                                        
         AI,R0    -1                SUB 1 FOR CKSM WORD                         
         DH,R0    REST91                                                        
         STW,R0   REST93            STORE MAX. NO. SECT. CAN LOAD               
*                                                                               
REST25   RES      0         PROCESS NEXT HEADER & DATA RECORDS                  
         LW,R8    REST91+4          GET NUM SECTORS OF ZERO TO WRITE            
         BEZ      REST34              NONE; GO WRITE DATA                       
*                                                                               
         CW,R8    REST92            IS THERE ROOM IN AREA FOR ALL SECT.         
         BLE      REST30            YES                                         
         LH,R0    REST91+1          NO, ARE THERE NON ZERO SECT. LEFT           
         BNEZ     SEG4X21             YES, GIVE INCOMPATABILITY MESSAGE         
*                                                                               
*                           ONLY ZERO SECTORS LEFT; TELL WORLD AREA             
*                                   WAS TRUNCATED                               
         MTW,+00  REST92            WERE WE HERE BEFORE? (REMAINING             
         BEZ      REST38            SPACE = NONE ? ); YES, SKIP MSG             
*                                                                               
         LH,R0    *K:MDNAME,R4      GET AREA NAME                               
         LI,R15   MESS23            SET ADDRESS OF ERROR MESSAGE                
         LI,R1    3                 SET INDEX OF NAME'S SPOT IN MESSAGE         
         STH,R0   *R15,R1           AND STORE THE NAME AWAY                     
         BAL,LINK TYPRNT            OUTPUT THE MESSAGE                          
         LW,R8    REST92            FILL AREA EXACTLY WITH ZEROS                
*                                                                               
REST30   LCW,R0   R8                                                            
         AWM,R0   REST92            REDUCE NO. SECT. IN AREA                    
         LW,R1    REST93                                                        
         MH,R1    REST91                                                        
         LI,R0    0                                                             
         STW,R0   *BPEND,R1         ZERO OUT LOAD AREA                          
         BDR,R1   %-1                                                           
         STW,R0   *BPEND                                                        
REST31   SW,R8    REST93            R8=NO. SECT. LEFT TO ZERO                   
         BLZ      %+3               LAST TIME                                   
         LW,R1    REST93            USE FULL LOAD AREA AS BUFFER                
         B        %+3                                                           
         LW,R1    R8                                                            
         AW,R1    REST93                                                        
         STW,R1   R2                SAVE NO. SECT. ZEROED                       
         MH,R1    REST91                                                        
         SLS,R1   2                 CHANGE TO BYTES                             
         STW,R1   WRDISC4           STORE BYTE COUNT                            
         STW,R8   R9                SAVE R8 SINCE IT GETS CHANGED IF ERROR      
         CAL1,1   WRDISC            GO WRITE SECT. OF ZERO                      
         AWM,R2   WRDISC5           STEP GRANULE NO.                            
         LW,R8    R9                ARE WE DONE WITH ZERO SECTORS               
         BGZ      REST31            NO                                          
REST34   LH,R8    REST91+1          GET NO. SECT. IN DATA RECORD                
         BEZ      REST38            NONE                                        
         CW,R8    REST92            IS THERE ROOM IN AREA                       
         BG       SEG4X21             NO, ABORT; INCOMPATABILITY ERROR          
*                                                                               
         CW,R8    REST93            BACKGROUND BIG ENOUGH FOR RECORD ?          
         BG       SEG4X19             NO, NOT ENOUGH ROOM ERROR                 
*                                                                               
         LCW,R0   R8                                                            
         AWM,R0   REST92            REDUCE NO. SECT. IN AREA                    
         LW,R1    R8                                                            
         MH,R1    REST91                                                        
         SLS,R1   2                 GET NO. BYTES IN DATA RECORD                
         STW,R1   WRDISC4           STORE IT FOR RAD WRITE                      
         AI,R1    4                 ADD 4 BYTES FOR CKSM                        
         STW,R1   READBI+4                                                      
         LW,R9    R8                SAVE NUMBER OF SECTORS IN BLOCK             
         CAL1,1   READBI            GO READ DATA RECORD                         
         LW,R2    BPEND             SET ADDRESS OF BUFFER                       
         BAL,LINK CHKCKSM           AND CHECK THE CKSM                          
         B        SEG4X22             ERROR, GIVE 'CKSM ERROR'                  
*                                                                               
         CAL1,1   WRDISC            WRITE DATA ON RAD                           
         AWM,R9   WRDISC5           STEP GRANULE NO. FOR NEXT WRITE             
*                                                                               
REST38   RES      0         TEST FOR END OF THE AREA                            
         LW,R0    REST91            GET FLAGS FROM THE HEADER                   
         CI,R0    LRAFLAG           IS IT AREA END ?                            
         BANZ     REST40              YES, GO ON TO TEST OTHER AREAS            
*                                                                               
REST39   RES      0         GET NEXT HEADER: TEST END-OF-VOLUME                 
         CAL1,1   READBIH           READ THE HEADER                             
         BAL,RLNK CHKHDR            VALIDATE CKSM & FIX IF OLD FORMAT           
         LW,R0    REST91            IS THE 'END-OF-VOLUME' FLAG SET             
         CI,R0    MRTFLAG            ?                                          
         BAZ      REST25            NOT END: PROCESS DATA & ZEROS               
*                                                                               
         BAL,RLNK RESTGNV           END-OF-VOLUME: GET NEXT                     
         B        REST39            AND CONTINUE                                
*                                                                               
*                                                                               
*                                                                               
REST40   EQU      %         END OF AN AREA; MARK SAVED; CLOSE DISC DCB          
         CAL1,1   CLFLEIN           CLOSE DISC FILE TO FREE DCB,                
         CI,R0    LRTFLAG           WAS 'LAST RECORD ON TAPE' FLAG SET ?        
         BAZ      REST10              NO, READ AND TEST NEXT HEADER             
*                           ELSE VERIFY REQUESTED AREAS RESTORED OK             
         PAGE                                                                   
         SPACE    1                                                             
REST50   EQU      %         END OF TAPE; VERIFY REQUESTED AREAS SAVED           
*                                                                               
*                 EXPLICITLY REQUESTED AREAS MARKED BY X'FF'                    
*                 AREAS REQUESTED BY 'ALL' MARKED   BY X'0F'                    
*                                                                               
*                 THIS CODE VERIFIES THAT NO ENTRIES IN THE AREASWS             
*                 TABLE HAS X'F0' BITS SET.  IF ALL ARE RESET, ALL              
*                 EXPLICITLY REQUESTED AND ANY OTHER AREAS FOUND                
*                 ON THE TAPE WERE RESTORED SUCCESSFULLY.                       
*                                                                               
*                 IF THE X'F0' BITS ARE SET IN ANY OF THE ENTRIES               
*                 THOSE AREAS WERE NOT RESTORED AND THERE IS AN ERROR.          
*                                                                               
         LI,R15   MESS20            SET ERROR TO REPORT                         
         LI,R1    3                 MOVE NAME INTO MESSAGE                      
         LI,R0    0                 SET NO ERROR FOUND, REPORTED                
         LI,R2    X'F0'             SET MASK TO TEST AGAINST                    
         LI,R6    SPINDEX           START SCAN WITH THE SP AREA                 
*                                                                               
REST51   EQU      %         SCAN AREASWS TABLE FOR X'F0' IN ENTRIES             
         CB,R2    AREASWS,R6        AREA RESTORED OK ?                          
         BAZ      REST53              YES, STEP TO NEXT                         
*                                                                               
         LH,R0    *K:MDNAME,R6      GET NAME                                    
         STH,R0   *R15,R1           STORE IN THE MESSAGE                        
         BAL,LINK TYPRNT            OUTPUT IT EVERYWHERE                        
*                                                                               
REST53   EQU      %         STEP TO NEXT AREA                                   
         AI,R6    1                 STEP TO NEXT AREA                           
         CB,R6    K:MDNAME          HAVE WE LOOKED AT ALL ALLOCATED AREA        
         BL       REST51              NO, LOOK AT THE NEXT                      
         PAGE                                                                   
         SPACE    2                                                             
         CB,R2    AREASWS,R6      CHECK SP AREA TOO                             
         BAZ      REST55              IT IS OK TOO; TEST FOR ANY ERRORS         
*                                                                               
         LH,R0    *K:MDNAME,R6      GET AND MOVE NAME                           
         STH,R0   *R15,R1           IT INTO THE ERROR MESSAGE                   
         BAL,LINK TYPRNT            OUT ERROR MESSAGE                           
*                                                                               
REST55   EQU      %         END OF RESTORE; CLEAN UP AND EXIT                   
         LW,R8    M:BI              WAS THE TAPE DCB EVER OPENED ?              
         CW,R8    DCBOPENF          IF SO, IS IT STILL ?                        
         BAZ      REST60               NO, TEST FOR ERRORS                      
*                                                                               
         CAL1,1   REWINDBI            YES, REWIND SAVE TAPE                     
         CAL1,1   CLOSEBI           AND THEN CLOSE IT                           
*                                                                               
REST60   EQU      %         TEST IF ANY ERRORS FOUND                            
         LW,R0    R0                WAS THE ERROR OUTPUTTER CALLED ?            
         BNEZ     SEG4X24             YES, REPORT ERROR IN RESTORE              
         B        EXEC1              NO, SO EXIT                                
         PAGE                                                                   
         SPACE    2                                                             
RESTGNV  RES      0         GET AND VERIFY NEXT VOLUME                          
         PUSH     RLNK              SAVE RETURN LOCATION                        
         AI,R13   1                 STEP VOLUME SEQ ID                          
         AND,R13  M4                MODULO 16 TO KEEP IT IN 4 BITS              
         BEZ      RESTGFV           B IF FIRST VOL, SKIP MSGS                   
*                                                                               
RESTGNV1 RES      0         LOOP TO INSURE THE CORRECT TAPE IS GOTTEN           
         LI,R2    M:BI                                                          
         CAL1,1   UNLOAD            UNLOAD PRESENT VOL; MAKE MANULE             
         STRNG    MESS45            FORM MESSAGE TO ASK FOR NEXT                
         INTGR    DEC,SPAC,2,R13    OUT SEQ NUM OF WHAT WE WANT                 
         BAL,RLNK OUT%MSG           TYPE AND/OR PRINT IT                        
         STRNG    MESS49            STDLB TO NEX VOLUME MSG                     
         BAL,RLNK OUT%MSG           PRESENT IT                                  
         CAL1,9   9                 WAIT FOR A 'C' TO CONTINUE                  
*                                                                               
RESTGFV  RES      0                                                             
         LI,R2    M:BI              POINT AT OUR DCB                            
         CAL1,1   REWIND            INSURE WE ARE AT BOT                        
         LI,R0    RESTERFH          HEADER ERROR CONTROLS                       
         STW,R0   ERRFCN                                                        
         CAL1,1   READBIH           READ NEXT HEADER                            
         LI,R0    RESTERF           NORMAL ERROR CONTROLS                       
         STW,R0   ERRFCN                                                        
         LW,R15   REST91            GET SEQ ID NUMBER OF TAPE                   
         SLS,R15  -8                FROM HEADER TO INSURE IT IS THE             
         AND,R15  M4                THE TAPE WE MUST HAVE                       
         CW,R15   R13               IS IT THE CORRECT VOLUME ?                  
         BE       RESTGNV2            YES, REWIND IT AND CONTINUE               
*                                                                               
         STRNG    MESS46            TELL THE OPERATOR HE HAS THE WRONG          
         INTGR    DEC,SPAC,2        VOLUME                                      
         BAL,RLNK OUT%MSG                                                       
         B        RESTGNV1          LOOP TO UNLOAD AND TRY AGAIN                
*                                                                               
RESTGNV2 RES      0         NEXT VOLUME MOUNTED OK                              
         CAL1,1   REWIND            REWIND IT TO REREAD THE 1ST HEADER          
         PULL     RLNK              RECOVER WHERE WE CAME FROM                  
         B        *RLNK             AND GOTHERE                                 
*                                                                               
RESTERFH ERRP     X'07',0           IGNORE BUFFER TOO SMALL                     
RESTERF  ERRP     X'FF',0           USE STANDARD PROCESSING                     
         PAGE                                                                   
         SPACE    2                                                             
CHKHDR   RES      0         CHECK HEADER RECORD CKSM; REFORMAT OLD HDRS         
         PUSH     6,RLNK            SAVE WORK REGISTERS                         
         LW,R1    M:BI+4            GET SIZE OF THE RECORD WE JUST READ         
         SLS,R1   -17                                                           
         CI,R1    4*LSAVEHDR        IS IT A NEW FORMAT HEADER ?                 
         BGE      CHKHDR2             YES, CHK THE CKSM                         
*                                                                               
         LI,R2    REST91            NO, ASSUME OLD FORMAT HEADER                
         BAL,LINK CHKCKSM           CHECK ITS CKSM                              
         B        ERROR26             ERROR: REPORT IT                          
         LW,R0    REST91+3          REFORMAT IT: MOVE NUMBER OF SECTORS         
         AND,R0   M16               OF ZERO TO WRITE TO ITS NEW WORD            
         STW,R0   REST91+4                                                      
         LW,R1    REST91            GET THE AREA'S INDEX                        
         AND,R1   M8                                                            
         LI,R0    X'FFFF'           SET AN ILLEGAL NAME AS DEFAULT              
         CB,R1    K:MDNAME          IS IT A LEGAL INDEX FOR THIS                
         BGE      %+2               SYSTEM ?  --  NO, USE DEFAULT               
         LH,R0    *K:MDNAME,R1        YES, GET ITS NAME                         
*                                                                               
         LI,R1    X'FFFF'                                                       
         STS,R0   REST91+3          INSERT EBCDIC NAME IN HEADER                
         LI,R2    LSAVHDRD          REGENERATE THE NEW CKSM JUST IN             
         LI,R1    REST91            WE EVER CHECK IT                            
         BAL,LINK GENCKSM                                                       
         B        CHKHDR4           AND THEN CONTINUE AS BEFORE                 
         PAGE                                                                   
         SPACE    2                                                             
CHKHDR2  RES      0         CHK RECORD'S CKSM                                   
         LI,R1    4*LSAVEHDR        SET LENGTH AND                              
         LI,R2    REST91            LOC OF HEADER                               
         BAL,LINK CHKCKSM           TO CHECK                                    
         B        ERROR26             ERROR: REPORT                             
*                                                                               
CHKHDR4  RES      0         HEADER OK; CONTINUE                                 
         PULL     6,RLNK                                                        
         B        *RLNK                                                         
         TITLE    '**** SMALL BOOT FOR RAD RESTORE ****'                        
*                                                                               
*                                                                               
*                                   BOOTED IN FROM CONSOLE                      
*                                   LOADS LARGE BOOT AND CKSM'S IT              
*                                   HALTS IF I/O OR CKSM ERROR                  
SBOOT    EQU      %%                                                            
ABS      ASECT                      MAKE ABSOLUTE SECTION                       
         ORG      SBOOT             SET BOTH COUNTERS TO LOAD LOC.              
         LOC      ABS+X'2A'         RESET EXEC. COUNTER TO X'2A'                
         LAW,R0   0                 MAKE FIRST BYTE STAND. BINARY CODE          
         LI,R0    DA(SBOOT7)                                                    
         SIO,0    *X'25'            READ IN LARGE BOOT                          
         TIO,0    *X'25'                                                        
         BCS,12   %-1               LOOP TILL READ IS DONE                      
         LW,R1    SBOOT7+1                                                      
         SLS,R1   -2                                                            
         AND,R1   SBOOT6            R1= NO. WORDS IN LBOOT                      
         LI,R0    0                                                             
         AW,R0    LBOOT1-1,R1       CKSM LBOOT                                  
         BCR,8    %+2                                                           
         AI,R0    1                                                             
         BDR,R1   %-3                                                           
         CI,R0    1                 IS CKSM OK                                  
         BE       LBOOT1            YES, EXIT TO LBOOT                          
         WAIT                       NO, HALT ON CKSM ERROR                      
         B        %-1                                                           
SBOOT6   DATA     X'FFFF'                                                       
         BOUND    8                                                             
SBOOT7   GEN,8,24 2,X'500'          READ ORDER, LOAD ADD.# X'140'               
SBOOT8   EQU      %%                                                            
         GEN,8,24 8,(LBOOT99-LBOOT1)*4   HTE,BYTE  COUNT IS STORED IN           
         DATA     0                 UNUSED                                      
         DATA     0                 CKSM STORED HERE                            
         TITLE    '**** LARGE BOOT FOR RAD RESTORE ****'                        
*                                                                               
*                                                                               
*                                   RESTORES RAD FROM MAG OR PAPER TAPE         
*                                     WHEN BOOTED FROM CONSOLE. RAD MUST        
*                                     BE SAME RAD AS WRITTEN OUT.               
*                                     RAD AREAS WHICH WERE WRITTEN, GET         
*                                     RESTORED IDENTICALLY.                     
*                                   WHEN DONE, READS IN RAD BOOT AND            
*                                     EXITS TO IT.                              
*                                                                               
         LOC      ABS+X'140'                                                    
LBOOT    EQU      %%                                                            
LBOOT1   EQU      %         START OF LARGE BOOT PROCESSING                      
         LI,R7    LBOOT60           OUT SHORT MESSAGE OF 3 NEW LINES            
         LI,R9    0                 TO RETURN CARRIAGE AND SPACE AWAY           
         BAL,R8   TYPEMSG           PREVIOUS TYPEOUTS                           
         LB,R7    LBOOT62B          IS THERE AN ID MESSAGE STORED ?             
         BEZ      LBOOT2              NO, SKIP ITS OUTPUT                       
*                                                                               
         LI,R7    LBOOT62                                                       
         LI,R9    0                                                             
         BAL,R8   TYPEMSG           OUTPUT THE ID MESSAGE                       
*                                                                               
LBOOT2   EQU      %                                                             
         LI,R7    LBOOT61           OUT SAVE TAPE CREATION DATE                 
         LI,R9    0                                                             
         BAL,R8   TYPEMSG           TO IDENTIFY THE TAPE                        
         LI,R7    LSAVEHDR          SET EXPECTED SIZE OF RECORD                 
         BAL,R8   READ              GO READ RAD BOOT HEADER                     
         LI,R7    23                RADBOOT# 22 WORDS&CKSM                      
         BAL,R8   READ              GO READ RAD BOOT                            
         LW,R0    LBOOT91+2         GET TRUE SECTOR # OF RADBOOT                
         AND,R0   MASK24            AND                                         
         STW,R0   LBOOT92+1         SET RAD SECT. NO. OF BOOT                   
         BAL,R8   WRITE             GO WRITE RAD BOOT                           
         LI,R1    22                                                            
         LW,R0    LBOOT99-1,R1      MOVE RAD BOOTSTAP TO ITS EXC. LOC.          
         STW,R0   X'2A'-1,R1                                                    
         BDR,R1   %-2                                                           
         LI,R7    LBOOT63           TYPE AREA NAMES RESTORED HEADER.            
         LI,R9    0                                                             
         BAL,R8   TYPEMSG                                                       
*                                                                               
LBOOT5   RES      0         PROCESS NEXT AREA ON TAPE                           
         LI,R7    LSAVEHDR          SET HEADER LENGTH                           
         BAL,R8   READ              GO READ FIRST HEADER FOR DATA               
         LW,R0    LBOOT19           MAX WORDS IN 1 WRITE   /SIG7-4419/*C5734    
         DH,R0    LBOOT91           R0# MAX. NO. SECT. IN LOAD AREA             
         STW,R0   LBOOT90           SAVE IT                                     
         LW,R0    LBOOT91+2         GET TRUE AREA BOT                           
         AND,R0   MASK24            AND                                         
         STW,R0   LBOOT92+1         STORE IT IN WRITE PARAM                     
*                                                                               
LBOOT7   RES      0         PROCESS A HEADER RECORD                             
         LW,R0    LBOOT91           DO FLAGS SAY TAPE IS CONTINUED ?            
         CI,R0    MRTFLAG           TO ANOTHER VOLUME ?                         
         BANZ     LBOOT22             YES, GET THE NEXT VOLUME                  
*                                                                               
         SLS,R0   -8                RIGHT JUSTIFY AND EXTRACT OUT THE           
         AND,R0   MASK4             VOLUME'S SEQ NUMBER                         
         CW,R0    VOLSEQNO          IS IT THE CORRECT VOLUME ?                  
         BNE      LBOOT26             NO, ASK FOR THE CORRECT ONE               
*                                                                               
         LW,R4    LBOOT91+4         GET THE NUMBER OF SECTORS OF ZERO           
         BEZ      LBOOT9            BRANCH IF NO ZERO SECTORS                   
         STW,R4   LBOOT92           STORE NO OF ZERO SECTORS                    
         MTW,1    WRITE86           SET FLAG FOR SKIP-WRITE OPERATION           
         BAL,R8   WRITE             GO WRITE OUT ZEROES                         
         MTW,-1   WRITE86           RESET SKIP-WRITE FLAG                       
LBOOT9   LH,R7    LBOOT91+1         GET NO. SECT. IN DATA REC.                  
         STW,R7   LBOOT92           SET NO. SECT. TO WRITE                      
         BEZ      LBOOT11                                                       
         MH,R7    LBOOT91           CHANGE TO WORDS                             
         AI,R7    1                 ADD ONE FOR CKSM                            
         BAL,R8   READ              GO READ DATA RECORD                         
         BAL,R8   WRITE             GO WRITE DATA RECORD                        
*                                                                               
LBOOT11  RES      0         DATA PROCESSED: TEST WHAT IS NEXT                   
         LW,R0    LBOOT91           GET HEADER FLAGS                            
         CI,R0    LRAFLAG           IS IT THE END OF THE AREA ?                 
         BANZ     LBOOT12             YES, SAY AREA RESTORED                    
*                                                                               
         LI,R7    LSAVEHDR          NO, READ NEXT DATA RECORD HEADER            
         BAL,R8   READ                                                          
         B        LBOOT7            AND PROCESS IT                              
*                                                                               
LBOOT12  RES      0         END OF AN AREA: SAY IT IS RESTORED                  
         LW,R0    LBOOT91+3         GET THE AREA'S NAME                         
         LI,R1    X'FFFF'                                                       
         STS,R0   LBOOT64E          AND INSERT IN MESSAGE                       
         LI,R7    LBOOT64                                                       
         LI,R9    0                 AND TYPE THE MESSAGE                        
         BAL,R8   TYPEMSG                                                       
         LW,R0    LBOOT91           REFETCH FLAGS                               
         CI,R0    LRTFLAG           WAS THIS THE END OF THE LAST TAPE ?         
         BAZ      LBOOT5              NO, READ 1ST HDR FOR NEXT AREA            
*                                                                               
LBOOT14  RES      0         END OF RESTORE: CLEAN UP                            
         LI,R7    LBOOT80           POINT AT 'RAD RESTORED' MSG                 
         LI,R9    0                                                             
         BAL,R8   TYPEMSG           GO TYPE 'RAD RESTORED OK'                   
         LI,R0    X'FD7D9'          PR IN BCD                                   
         CH,R0    READ98            IS INPUT DEV. PAPER TAPE                    
         BE       X'2A'             YES,EXIT TO RAD BOOT                        
         LI,R0    DA(LBOOT20)       REWIND MAG TAPE                             
         SIO,R11  *X'25'                                                        
         B        X'2A'             EXIT TO RAD BOOT                            
*                                                                               
*                                                                               
LBOOT19A EQU      %%                                       /SIG7-4419/*C5734    
LBOOT19  DATA     0                 SIZE OF BUFFER         /SIG7-4419/*C5734    
         BOUND    8                                                             
LBOOT20  GEN,8,24 X'33',0           REWIND ORDER                                
         DATA     0                                                             
*                                                                               
LBOOT21  GEN,8,24 X'23',0           REWIND/UNLOAD ORDER                         
         DATA     0                                                             
*                                                                               
*                                                                               
LBOOT22  RES      0         GET A NEW VOLUME                                    
         LW,R10   VOLSEQNO          GET NUMBER OF VOL JUST PROCESSED            
         AI,R10   1                 STEP                                        
         AND,R10  MASK4             MODULO 16                                   
         STW,R10  VOLSEQNO          AND SAVE NEW VOL NUMBER                     
         LI,R5    -4                CONVERT 2 DIGITS                            
         BAL,R8   HXBCD               TO EBCDIC                                 
         STH,R0   LBOOT65E          ASK FOR NEXT VOL                            
*                                                                               
LBOOT24  RES      0         GET THE CORRECT NEXT VOLUME                         
         LI,R0    DA(LBOOT21)       REWIND/UNLOAD THE CURRENT VOL               
         SIO,R11  *X'25'                                                        
         BCR,4    %+2               SIO ACCEPTED: ASK FOR NEXT VOL              
         B        %-2               SIO REJECTED: TRY AGAIN                     
         LI,R7    LBOOT65           SAY WHAT VOLUME IS WANTED                   
         LI,R9    0                                                             
         BAL,R8   TYPEMSG                                                       
*                                                                               
*                                                                               
LBOOT25  RES      0                 IS DEVICE RECOGNIZABLE?                     
         TIO,R11  *X'25'            ***TIO DEVICE***                            
         BCR,12   %+3               I/O ADDRESS RECOGNIZED                      
         SCD,R0   64                DELAY IN TIO LOOP....                       
         B        LBOOT25           LOOP ON TIO                                 
         SLS,R11  -16               DEVICE STATUS BITS                          
         CI,R11   X'1000'           DEVICE MANUAL/AUTOMATIC?                    
         BAZ      LBOOT25           0=MANUAL,1=AUTOMATIC                        
         CI,R11   X'6600'           IS DEVICE READY?                            
         BANZ     LBOOT25           2=NOT OPER,4=UNAVAIL,6=BUSY                 
         LI,R0    DA(LBOOT20)       REWIND VOL TO INSURE AT BOT                 
         SIO,R11  *X'25'            ***SIO DEVICE***                            
         BCR,4    %+2               SIO ACCEPTED                                
         B        LBOOT25           SIO REJECTED                                
         LI,R7    LSAVEHDR          SET HEADER LENGTH                           
         BAL,R8   READ              READ HEADER                                 
         B        LBOOT7            CHECK VOLUME                                
*                                                                               
*                                                                               
LBOOT26  RES      0         WRONG VOLUME                                        
         LW,R10   R0                COPY VOL NUM ON WRONG TAPE                  
         LI,R5    -4                                                            
         BAL,R8   HXBCD             CONVERT                                     
         STH,R0   LBOOT66E                                                      
         LI,R7    LBOOT66           OUT MESSAGE SAYING:                         
         LI,R9    0                 'WRONG VOLUME: ID= XX'                      
         BAL,R8   TYPEMSG                                                       
         B        LBOOT24           UNLOAD IT AND TRY FOR RIGHT ONE             
         PAGE                                                                   
         SPACE    2                                                             
LBOOT60  DATA     0                                                             
         DATA     X'03151515'       LENGTH, NL, NL, NL  SEPARATOR               
*                                                                               
*                                                                               
LBOOT61A EQU      %%         MODULE RELATIVE ADDRESS OF LBOOT61                 
LBOOT61  DATA     0                                                             
         TEXTC    'SAVE TAPE CREATED: ',;                                       
                  'HH:MM MON DD,"YY'                                            
LBOOT61D EQU      %%-4              ADDRESS OF DATE/TIME                        
*                                                                               
*                                                                               
LBOOT62A EQU      %%                                                            
LBOOT62  DATA     0                                                             
*                                                                               
LBOOT62L EQU      %%         ADDRESS OF LENGTH OF MESSAGE                       
LBOOT62B TEXTC    'SAVE TAPE ID:  '                                             
*                                                                               
LBOOT62M EQU      %%         ADDRESS OF ID MESSAGE                              
         RES      10                40 CHARACTERS OF ID MESSAGE                 
         PAGE                                                                   
         SPACE    2                                                             
LBOOT63  DATA     0                                                             
         TEXTC    'AREA RESTORED:'                                              
*                                                                               
LBOOT64  DATA     0                                                             
LBOOT64E TEXTC    ' XX'             AREA NAME                                   
*                                                                               
LBOOT65  DATA     0                                                             
         TEXTC    ' MOUNT SAVE VOLUME XX'                                       
LBOOT65E EQU      %-1                                                           
*                                                                               
LBOOT66  DATA     0                                                             
         TEXTC    ' WRONG VOLUME: ID= XX'                                       
LBOOT66E EQU      %-1                                                           
*                                                                               
*                                                                               
VOLSEQNO DATA     0                 SEQ NUMBER (ID) OF CURRENT VOLUME           
         PAGE                                                                   
*                                                                               
*                                   READS ONE RECORD FROM MAG OR PAPER          
*                                     TAPE. AND CKSM'S IT                       
*                                   CALL IS   BAL,R8  READ                      
*                                     WHERE  R7=NO. WORDS TO READ               
*                                   USES R0,R5-R11                              
*                                                                               
READ     STW,R8   READ99            SAVE RETURN                                 
         LI,R0    4                                                             
         STW,R0   READ97            SET TO RETRY 3 TIMES                        
         SLS,R7   2                 CHANGE TO BYTES                             
         STW,R7   READ90+1          STORE BYTE COUNT                            
         LI,R0    BA(LBOOT99)       ASSUME READING A DATA RECORD                
         CI,R7    4*LSAVEHDR        IS IT A HEADER READ ?                       
         BNE      READ1               NO, DO THE DATA READ                      
*                                                                               
         LI,R0    BA(LBOOT91)       YES, POINT AT HEADER BUFFER                 
*                                                                               
READ1    RES      0         FORM THE COMMAND DOUBLEWORD LIST                    
         LI,R5    1                                                             
         STH,R0   READ90,R5         STORE BA IN COMM. LIST                      
         LI,R0    DA(READ90)                                                    
READ3    SIO,R11  *X'25'                                                        
         BCR,4    %+2                                                           
         B        %-2               LOOP TILL SIO TAKES                         
READ4    TIO,R11  *X'25'                                                        
         SLS,R11  -16                                                           
         CI,R11   X'600'            IS CONTROLLER STILL BUSY                    
         BAZ      READ4C            NO,I/O DONE                                 
         LI,R5    600               LOOP FOR 1 MIL TO CUTDOWN I/O BW            
         BDR,R5   %                                                             
         B        READ4             GO TRY TIO AGAIN                            
READ4C   CI,R11   X'7E'             WAS THERE A PARITY TYPE ERROR               
         BAZ      READ10            NO                                          
READ5    LI,R0    X'FD7D7'          YES,GET PR IN BCD                           
         CH,R0    READ98            IS IT PAPER TAPE                            
         BE       READ6             YES                                         
         MTW,-1   READ97            NO(MAG TAPE), HAVE WE TRIED MAX NO.         
         BEZ      READ6             YES                                         
         LI,R0    DA(READ91)        NO, TRY READ AGAIN                          
         B        READ3                                                         
READ6    LI,R7    READ92            GO TYPE 'ERROR' ALARM                       
READ7    LI,R9    -1                                                            
         LW,R10   READ98                                                        
         AW,R10   X'25'             SET R10 TO DEVICE NAME AND NO.              
         BAL,R8   TYPEMSG           GO TYPE ALARM                               
         WAIT                                                                   
         B        %-1               NO RECOVERY                                 
READ10   CI,R11   X'80'             WAS THERE INC. LENGTH                       
         BAZ      READ12            NO                                          
         LI,R0    X'FF7E3'           YES, IS IT 7 TRACK MT                      
         CH,R0    READ98                                                        
         BNE      READ5             NO, ERROR                                   
READ12   CI,R11   X'800'            YES, IGNORE                                 
         BAZ      READ14            NO UNUSUAL END                              
         TDV,R11  *X'25'            DO TDV FOR UNUSUAL END                      
         SLS,R11  -16                                                           
         LI,R7    READ93            SET TO TYPE 'UNUS. END'                     
         B        READ7                                                         
READ14   LI,R7    1                                                             
         LH,R8    READ90,R7         GET WORD ADDRESS FOR CKSM                   
         SLS,R8   -2                                                            
         AI,R8    -1                                                            
         LW,R7    READ90+1                                                      
         SLS,R7   -2                GET NO. WORDS TO CKSM                       
         LI,R0    0                                                             
         AW,R0    *R8,R7                                                        
         BCR,8    %+2               CKSM RECORD                                 
         AI,R0    1                 ADD 1 IF CARRY                              
         BDR,R7   %-3                                                           
         CI,R0    1                                                             
         BE       *READ99           EXIT IF CKSM OK                             
         LI,R7    READ94                                                        
         LI,R9    0                                                             
         BAL,R8   TYPEMSG           GO TYPE 'CKSM ERROR'                        
         WAIT                                                                   
         B        *READ99           TAKE RECORD WITH BAD CKSM IF CONT.          
         BOUND    8                                                             
READ90A  EQU      %%                                                            
READ90   DATA     0                 ORDER(STORED BY SAVE), BYTE ADD.            
         DATA     0                 FLAGS=0, BYTE COUNT IS STORED               
READ91   GEN,8,24 X'4B',0           BACKSPACE ON RECORD                         
         GEN,8,24 X'20',0           COM. CHAIN                                  
         GEN,8,24 8,DA(READ90)      TRANSFER IN CHANNEL                         
         DATA     0                                                             
READ92   DATA     1                                                             
         TEXTC    'ERROR,'                                                      
READ93   DATA     3                                                             
         TEXTC    'UNUS. END,'                                                  
READ94   DATA     0                                                             
         TEXTC    'CKSM ERROR'                                                  
READ97   DATA     0                 RETRY COUNT                                 
READ98A  EQU      %%                                                            
READ98   DATA     0                 BCD NAME OF INPUT DEVICE IN LHW             
READ99   DATA     0                 RETURN ADDRESS                              
*                                                                               
*                                   WRITES DATA TO RAD AND DOES CHECK           
*                                     WRITE                                     
*                                   CALL  IS  BAL,R8  WRITE                     
*                                     WHERE  LBOOT92+0=NO. SECT TO WRITE        
*                                            LBOOT92+1=STARTING SECT.           
*                                   USES R0,R5-R11                              
*                                                                               
WRITE    STW,R8   WRITE99           SAVE RETURN                                 
         LD,R0    WRITE90A          INITIALIZE                                  
         STW,R0   WRITE90+2          BUFFER                                     
         STW,R1   WRITE90+6           ADDRESSES                                 
WRITEC   LI,R0    3                                                             
         STW,R0   WRITE92           SET RETRY COUNT                             
         LI,R0    X'20'             COMMAND CHAIN AND                           
         AW,R0    WRITE86            POSSIBLE SKIP-WRITE FOR                    
         STB,R0   WRITE90+3           WRITE                                     
         LI,R0    8                 HTE AND                                     
         AW,R0    WRITE86            POSSIBLE SKIP-WRITE FOR                    
         STB,R0   WRITE90+7           CHECK-WRITE                               
         LI,R0    -1                                                            
         STW,R0   WRITE92A                                                      
         LW,R9    LBOOT92           GET NO. SECT. TO WRITE                      
WRITE0   STW,R9   WRITE85           SAVE NO. SECT TO WRITE                      
         CW,R9    LBOOT90           CHECK FOR MAX. SECTORS IN 64K BYTES         
         BLE      WRITE01             BRANCH IF OK                              
         LW,R9    LBOOT90           GET MAXIMUM                                 
         B        WRITE0             SECTORS                                    
WRITE01  MH,R9    LBOOT91           CHANGE TO WORDS                             
         SLS,R9   2                 MAKE BYTES                                  
         LW,R8    R9                                                            
         LI,R9    X'7FFFF'                                                      
         STS,R8   WRITE90+3         STORE BYTE COUNT                            
         STS,R8   WRITE90+7                                                     
         LH,R11   LBOOT91+3         R11= SECT/TRK                               
         LI,R8    0                                                             
         LW,R9    LBOOT92+1         R9 = SECTOR ADDRESS                         
         STW,R8   WRITE91           ZERO SEEK ADDRESS                           
         LW,R0    LBOOT91           CHECK FOR                                   
         CI,R0    DPAFLAG            DISC PACK ?                                
         BAZ      WRITE1              BRANCH IF NOT                             
         CW,R11   WRITE85           CHECK FOR MORE THAN 1 TRACK                 
         BGE      WRITE02            BRANCH IF NOT                              
         LW,R9    R11               SET MAXIMUM                                 
         STW,R9   LBOOT90            SECTORS AND                                
         B        WRITE0              TRY AGAIN                                 
WRITE02  DW,R8    R11               R8 = SECTOR, R9 = CYL/TRACK                 
         LW,R11   WRITE85           GET # SECTORS TO WRITE                      
         AW,R11   R8                CHECK FOR TRANSFER                          
         CH,R11   LBOOT91+3          OVER TRACK BOUNDARY                        
         BLE      WRITE03             BRANCH IF NOT                             
         LH,R9    LBOOT91+3         GET                                         
         SW,R9    R8                 AMOUNT TO NEXT TRACK                       
         B        WRITE0                                                        
WRITE03  XW,R8    WRITE91           R8 = 0, WRITE91 = SECTOR                    
         LB,R7    LBOOT91+2         R7= # OF TRACKS PER CYL.                    
         DW,R8    R7                R8= TRACK, R9= CYLINDER                     
         SLD,R8   8                 SHIFT TRACK TO POSITION                     
         SLS,R9   8                 SHIFT CYL TO POSITION                       
         AW,R9    R8                ADD TRACK                                   
         AWM,R9   WRITE91           ADD TO SECTOR                               
         LI,R7    1                 INDEX FOR HALFWORD 1                        
         LI,R8    4                 4 BYTES FOR SEEK                            
         LI,R9    1                                                             
         LI,R10   'DP'              DEVICE TYPE FOR ERROR MESSAGES              
         B        WRITE2                                                        
WRITE1   LW,R0    R11                                                           
         AI,R0    -1                                                            
         LI,R5    0                 GET SHIFT FACTOR TO CHANGE SECT. NO.        
         AI,R5    -1                  INTO RAD ADDRESS FORMAT                   
         SLS,R0   1                                                             
         BNOV     %-2                                                           
         AI,R5    32                R5=SHIFT FACTOR                             
         STW,R5   WRITE26                                                       
         DW,R8    R11               DIVIDE BY SECT/TRK                          
         SLS,R9   0,R5                                                          
         AW,R8    R9                R8=RAD ADD. IN PROPER FORMAT                
         STH,R8   WRITE91           STORE INTO SEEK                             
         LI,R7    1                                                             
         LI,R8    2                 BYTE COUNT FOR SEEK                         
         LI,R9    0                                                             
         LI,R10   'DC'                                                          
WRITE2   SLS,R10  16                                                            
         AH,R10   LBOOT91+1,R7      R10=DC IN BCD, RAD DEV. NO.                 
         STH,R8   WRITE90+1,R7      BYTE COUNT FOR                              
         STH,R8   WRITE90+5,R7       SEEK COMMANDS                              
         STH,R8   WRITE93+1,R7        AND SENSE COMMAND                         
         STW,R9   WRITE92B          0 = RAD, 1 = DISK PACK                      
*                                                                               
WRITE3   LI,R0    4                                                             
WRITE3C  TIO,R11  *R10              DO TIO TO SEE IF RAD OK                     
         BCR,12   WRITE5            RAD CAN TAKE AN SIO                         
         AI,R0    -1                HAVE WE TRIED TIO 3 TIMES                   
         BEZ      %+4               YES                                         
         LI,R5    15000             NO,LOOP FOR 21 MIL TO CUT DOWN BW           
         BDR,R5   %                                                             
         B        WRITE3C           GO TRY TIO AGAIN                            
         LI,R7    WRITE98                                                       
         LI,R9    -1                PROBLEM WITH RAD                            
         SLS,R11  -16                                                           
         BAL,R8   TYPEMSG           GO TYPE  'UNREC' ALARM                      
         WAIT                                                                   
         B        WRITE3            TRY AGAIN                                   
WRITE5   LI,R0    DA(WRITE90)                                                   
WRITE6   LI,R5    100                                                           
         SIO,R11  *R10              DO SIO                                      
         BCR,4    WRITE7             BRANCH IF OK                               
         BDR,R5   WRITE6+1          TRY SIO AGAIN                               
         B        WRITE15            GIVE UP AFTER 100 TRIES                    
WRITE7   LI,R5    15000                                                         
         BDR,R5   %                                                             
         TIO,R11  *R10              CHECK FOR I/O COMPLETE                      
         BCS,12   WRITE7            NO                                          
         SLS,R11  -16               I/O COMPLETE, CHECK STATUS                  
WRITE9   CI,R11   X'7E'             ANY TRANSMISSION ERRORS                     
         BAZ      WRITE14           NO                                          
         MTW,-1   WRITE92           YES, MAX. NO. RETRIES                       
         BNEZ     WRITE3            NO, TRY AGAIN                               
         LI,R7    READ92                                                        
         LI,R9    -1                                                            
         BAL,R8   TYPEMSG           GO TYPE  'ERROR' ALARM                      
         LW,R8    WRITE92B          CHECK FOR DISK PACK                         
         BEZ      WRITE10            BRANCH IF NOT                              
         LW,R10   LBOOT92+1         GET SECTOR ADDRESS                          
         DH,R10   LBOOT91+3          CONVERT TO TRACK NUMBER                    
         B        WRITE11                                                       
WRITE10  LI,R0    DA(WRITE93)                                                   
         SIO,R11  *R10              DO SENSE TO GET BAD TRACK                   
         BCS,4    %+2                                                           
         B        %-2               LOOP TILL SIO TAKES                         
         TIO,R11  *R10                                                          
         BCR,12   %+2                                                           
         B        %-2               LOOP TILL SENSE DONE                        
         LI,R0    0                                                             
         LH,R10   WRITE94           GET TRACK-SECTOR                            
         AND,R10  WRITE89            STRIP WRITE PROTECT BIT                    
         LCW,R5   WRITE26           GET SHIFT FACTOR                            
         SLS,R10  0,R5              SHIFT TO TRACK ADDRESS                      
WRITE11  LI,R5    -12               SET FOR 4 CHARACTERS                        
         BAL,R8   HXBCD              CHANGE TO EBCDIC                           
         STW,R0   WRITE96+3         STORE TRK NO. IN IMAGE                      
         LI,R7    WRITE96                                                       
         LI,R9    0                                                             
         BAL,R8   TYPEMSG           GO TYPE 'TRK=XXXX'                          
         LW,R0    WRITE86           CHECK FOR SKIP WRITE                        
         BNEZ     WRITE11Z          B IF IT IS                                  
         LI,R6    0                                                             
         LI,R7    X'7FFFF'                                                      
         LS,R6    WRITE90+3         GET BYTE COUNT                              
         SLS,R6   -2                CHANGE TO WORDS                             
         LI,R0    0                                                             
         CW,R0    LBOOT99-1,R6      SEE IF WHOLE BUFFER=ZEROES                  
         BNE      WRITE12                                                       
         BDR,R6   %-2                                                           
WRITE11Z LI,R7    WRITE95                                                       
         LI,R9    0                                                             
         BAL,R8   TYPEMSG           GO TYPE 'DATA=ALL ZEROES'                   
WRITE12  WAIT                                                                   
         B        *WRITE99          EXIT IF CONT. AFTER BAD WRITE               
WRITE13  LW,R0    WRITE85           UPDATE                                      
         AWM,R0   LBOOT92+1          NO OF SECTORS                              
         MTW,0    WRITE86           IS IT SKIP WRITE       /SIG7-4419/*C5734    
         BNEZ     WRITE13A          YES                    /SIG7-4419/*C5734    
         MH,R0    LBOOT91           AND                                         
         SLS,R1   2                                                             
         AWM,R1   WRITE90+2           POINTERS                                  
         AWM,R1   WRITE90+6                                                     
WRITE13A RES      0                                        /SIG7-4419/*C5734    
         LCW,R0   WRITE85           UPDATE                                      
         AWM,R0   LBOOT92            NO OF SECTORS TO WRITE                     
         BEZ      *WRITE99            BRANCH IF DONE                            
         B        WRITEC            CONTINUE                                    
WRITE14  CI,R11   X'800'            WAS THERE AN UNUSUAL END                    
         BANZ     WRITE15           BRANCH IF UE                                
         CI,R0    DA(WRITE27)       CHECK FOR HEADER READ (DISK PACK)           
         BNE      WRITE13            BRANCH IF NOT                              
         LW,R0    WRITE29           GET ALT CYL                                 
         LB,R1    LBOOT91+2         GET TRACKS/CYLINDER                         
         CI,R1    2                 2 MEANS 3242/3 CARTRAGE DISC                
         BE       WRITE14A          R0 IS ALREADY SEEK IN THAT CASE             
*                                   OTHERWISE                                   
         AND,R0   WRITE87            AND TRACK                                  
         CI,R0    X'8000'           IS HI ORDER CYL BIT SET                     
         BAZ      %+3               YES                                         
         EOR,R0   XBIT16            RESET IT                                    
         OR,R0    XBIT7             AND SET REAL HI ORDER BIT                   
         LB,R1    WRITE29             ADD SECTOR                                
         AW,R0    R1                                                            
WRITE14A RES      0                                                             
         STW,R0   WRITE91                                                       
         LI,R0    3                 START SEEK                                  
         STW,R0   WRITE92            ON ALTERNATE                               
         B        WRITE3                                                        
WRITE15  TDV,R11  *R10              DO TDV TO FIND REASON                       
         SLS,R11  -16                                                           
         CI,R11   X'1000'           IS RAD WRITE PROTECTED                      
         BAZ      WRITE16           NO                                          
         MTW,1    WRITE92A          WAS ALARM ALREADY TYPED                     
         BNEZ     WRITE3            YES, GO TRY AGAIN                           
         LI,R7    WRITE97           NO                                          
         LI,R9    -1                                                            
         BAL,R8   TYPEMSG           GO TYPE 'RAD WT PROT'                       
         B        WRITE3            GO TRY AGAIN                                
WRITE16  CI,R11   X'2000'           IS IT SECTOR UNAV.                          
         BANZ     WRITE30           YES - OUTPUT ERROR MESSAGE                  
         LW,R9    LBOOT91           CHECK FOR                                   
         CI,R9    DPAFLAG            DISK PACK                                  
         BAZ      WRITE30             BRANCH IF NOT                             
         CI,R11   X'4000'           CHECK FOR FLAWED TRACK                      
         BAZ      WRITE17            BRANCH IF NOT                              
         LI,R0    10                RESET RETRY COUNT                           
         STW,R0   WRITE92            FOR READING HEADER                         
         LI,R0    DA(WRITE27)       READ HEADER                                 
         B        WRITE6                                                        
WRITE17  CI,R11   X'200'            CHECK FOR SEEK TIMEOUT                      
         BAZ      WRITE30            BRANCH IF NOT                              
         LI,R0    10                                                            
         STW,R0   WRITE92           RESET RETRY                                 
         LI,R0    DA(WRITE25)                                                   
         SIO,R11  *R10              RESTORE CARRIAGE                            
         BCS,4    WRITE3                                                        
         B        %-2               LOOP TILL SIO TAKES                         
WRITE26  DATA     0                 SHIFT FACTOR FOR TRACK/SECTOR               
         BOUND    8                                                             
WRITE25  GEN,8,24 X'33',0                                                       
         GEN,8,24 8,0               HTE                                         
WRITE27  GEN,8,24 3,BA(WRITE91)                                                 
         GEN,8,24 X'20',4                                                       
         GEN,8,24 X'A',BA(WRITE28)                                              
         GEN,8,24 8,8               HTE, 8 BYTES                                
WRITE28  DATA     0                 FLAW BYTE, 0, CYL, TRACK                    
WRITE29  DATA     0                 SECTOR, ALT CYL, ALT TRACK, 0               
WRITE30  LI,R9    -1                                                            
         LI,R7    READ93            GO TYPE 'UNUS. END'                         
         BAL,R8   TYPEMSG                                                       
         WAIT                       HALT AFTER UNUS. END                        
         B        WRITE3            GO TRY AGAIN                                
WRITE85  DATA     0                 NUMBER OF SECTORS TO WRITE                  
WRITE86  DATA     0                 FLAG FOR SKIP-WRITE (WRITE ZEROS)           
WRITE87  DATA     X'FFFF00'         MASK FOR ALT CYL & TRACK                    
WRITE88  DATA     20                TRACKS/CYLINDER FOR 7240 DISK PACK          
WRITE89  DATA     X'7FFF'                                                       
         BOUND    8                                                             
WRITE90  GEN,8,24 3,BA(WRITE91)     SEEK ORDER, ADD. OF SEEK                    
         GEN,8,24 X'28',0           COMMAND CHAIN, HTE, BYTE COUNT              
         GEN,8,24 1,BA(LBOOT99)     WRITE ORDER, BA OF OUTPUT BUFFER            
         GEN,8,24 X'28',0           COMMAND CHAIN, HTE, BYTE COUNT              
         GEN,8,24 3,BA(WRITE91)     SEEK ORDER FOR CHK WRITE                    
         GEN,8,24 X'28',0           COMMAND CHAIN, HTE, BYTE COUNT              
         GEN,8,24 5,BA(LBOOT99)     CHECK WRITE, BA OF BUFF.                    
         GEN,8,24 8,0               HTE, BYTE COUNT STORED IN                   
WRITE90A GEN,8,24 1,BA(LBOOT99)     WRITE ORDER AND BUFFER ADDRESS              
         GEN,8,24 5,BA(LBOOT99)     CHECK-WRITE ORDER AND BUFFER ADDRES         
WRITE91  DATA     0                 SEEK ORDER STORED HERE                      
WRITE92  DATA     0                 RETRY COUNT                                 
WRITE92A DATA     0                 FLAG THAT WRIT PROT ALARM TYPED             
WRITE92B DATA     0                 FLAG FOR DISK PACK ( 1 = DP                 
         BOUND    8                                                             
WRITE93  GEN,8,24 4,BA(WRITE94)     SENSE ORDER                                 
         GEN,8,24 2,2               SUPPRESS I.L., 2 BYTES                      
WRITE94  DATA     0                 SENSE ORDER INPUT                           
WRITE95  DATA     0                                                             
         TEXTC    'DATA=ALL ZEROS'                                              
WRITE96  DATA     0                                                             
         TEXTC    '   TRK=XXXX'                                                 
WRITE97  DATA     0                                                             
         TEXTC    'WRT PROT'                                                    
WRITE98  DATA     1                                                             
         TEXTC    'UNRECOG,'                                                    
WRITE99  DATA     0                 RETURN ADDRESS                              
*****                                                                           
XBIT16   DATA     X'8000'                                                       
XBIT7    DATA     X'01000000'                                                   
MASK24   DATA     X'00FFFFFF'                                                   
MASK16   DATA     X'0000FFFF'                                                   
MASK4    DATA     X'0000000F'                                                   
         PAGE                                                                   
*                                   TYPES ALARMS AND MSGS. ON TYA01             
*                                   DOES OWN I/O                                
*                                   IF TYA01 NOT READY, ROUTINE WAITS           
*                                     IF OPERATOR RUNS TRIES AGAIN              
*                                   INPUT PARAMETERS:                           
*                                    CALL IS    BAL,R8    TYPE                  
*                                    R7=ADDRESS OF MSG. TO BE TYPED             
*                                    R9=-1,TYPE YYNDD FIRST                     
*                                      =1, TYPE IOP X FIRST                     
*                                      =0, TYPE NOTHING FIRST                   
*                                    R10=YYNDD (E.G. CRA03), IF ANY             
*                                         YY IS EBCDIC, NOD IS BIN.             
*                                    R11=STATUS BYTES TO BE TYPED,              
*                                          IF ANY, RIGHT HALF WORD              
*                                   USES  R0,R5-R11                             
*                                      R10 IS UNCHANGED ON EXIT                 
*                                                                               
*                                                                               
TYPEMSG  STW,R8   TYPE87            SAVE RETURN                                 
         STW,R10  TYPE87A           SAVE R10                                    
         LI,R0    TYPE95            HOUSEKEEP                                   
         STW,R0   TYPE94A                                                       
         LI,R0    0                                                             
         STW,R0   TYPE86                                                        
         STW,R11  TYPE89                                                        
         LW,R9    R9                                                            
         BEZ      TYPE9             NOTHING TO TYPE FIRST                       
         BGZ      TYPE7             TYPE IOP X FIRST                            
         LH,R0    R10                                                           
         AND,R0   TYPE83                                                        
         AW,R0    TYPE82                                                        
         STW,R0   TYPE91            STORE !!YY                                  
         LI,R6    2                                                             
         LB,R0    R10,R6            GET IOP NO.                                 
         DO       #550                                                          
*   HERE FOR TAURUS                                                             
         LI,R5    BA(TYPE71)-BA(TYPE72)                                         
         CB,R0    TYPE72+TYPE73,R5  LOOK FOR MATCH OF IOP LETTER                
         BE       TYPE6             FOUND IT                                    
         BIR,R5   %-2                                                           
         LI,R0    '?'                                                           
         B        %+2                                                           
TYPE6    LB,R0    TYPE71+TYPE73,R5  GET HEX FOR IOP BYTE                        
         ELSE     #550=0                                                        
*  HERE FOR SIGMA                                                               
         AI,R0    'A'               CHANGE TO IOP LETTER                        
         FIN      #550=0                                                        
         LI,R5    -4                                                            
         BAL,R8   HXBCD             GO TOCHANGE DD OF YYNDD TO BCD              
         SLS,R0   8                 R0=NDD                                      
         AI,R0    X'40'             ADD IN BLANK                                
         B        TYPE8                                                         
TYPE7    LW,R0    TYPE92            GET !!IO                                    
         STW,R0   TYPE91                                                        
         LI,R6    2                                                             
         LB,R0    R10,R6            GET IOP NO.                                 
         DO       #550                                                          
*   HERE FOR TAURUS                                                             
         LI,R5    BA(TYPE71)-BA(TYPE72)                                         
         CB,R0    TYPE72+TYPE73,R5  LOOK FOR MATCH OF IOP LETTER                
         BE       TYPE7A            FOUND IT                                    
         BIR,R5   %-2                                                           
         LI,R0    '?'                                                           
         B        %+2                                                           
TYPE7A   LB,R0    TYPE71+TYPE73,R5  GET HEX FOR IOP BYTE                        
         ELSE     #550=0                                                        
*  HERE FOR SIGMA                                                               
         AI,R0    'A'               CHANGE TO IOP LETTER                        
         FIN      #550=0                                                        
         SLS,R0   8                                                             
         AW,R0    TYPE93            FOR IOP X PART OF ALARM                     
TYPE8    STW,R0   TYPE91+1                                                      
         LW,R0    TYPE94A                                                       
         STW,R0   TYPE86            SAVE FWA OF COMMAND LIST                    
TYPE9    MTW,2    TYPE94A           STEP COM. LIST POINTER                      
         LW,R0    *R7                                                           
         BGZ      TYPE13            MUST TYPE STATUS TOO                        
         MTW,2    TYPE94A                                                       
         LW,R0    TYPE86                                                        
         BEZ      TYPE12                                                        
         LW,R0    TYPE85            STORE TRANSFER IN CHANNEL COMMAND           
         STW,R0   TYPE96              SINCE MUST SKIP ONE COM. LIST             
         B        TYPE13                                                        
TYPE12   LW,R0    TYPE94A                                                       
         STW,R0   TYPE86                                                        
TYPE13   LW,R10   R7                GET FWA OF MSG.                             
         AI,R10   1                                                             
         LB,R11   *R10              GET BYTE COUNT                              
         AW,R11   TYPE94            ADD IN FLAGS                                
         SLS,R10  2                 CHANGE TO BYTE ADD.                         
         AW,R10   TYPE88            ADD IN WRITE ORDER AND 1 MORE BYTE          
         STD,R10  *TYPE94A          STORE COMM. PAIR                            
         LW,R0    *R7                                                           
         BEZ      TYPE18            NO STATUS TO TYPE                           
         MTW,2    TYPE94A           STEP TO NEXT COMM. PAIR                     
         LW,R10   TYPE89            GET STATUS                                  
         LI,R5    -12               SET FOR 4 CHARS.                            
         LI,R0    0                                                             
         BAL,R8   HXBCD             CONVERT STATUS TO BCD                       
         LW,R6    *R7                                                           
         STW,R0   MSG1,R6           STORE INTO IMAGE                            
         LW,R7    TYPE95+1                                                      
         AW,R6    TYPE84            ADD IN ADDRESS                              
         SLS,R6   2                 CHANGE TO BYTE ADD.                         
         STD,R6   *TYPE94A          STORE IN COM LIST                           
TYPE18   LW,R0    TYPE86                                                        
         SLS,R0   -1                CHANGE TO DA                                
         SIO,R5   1                 *** DO SIO ***                              
         BCR,4    %+2                                                           
         B        %-2                                                           
         LW,R10   TYPE87A           RESTORE R10 BEFORE EXIT                     
         TIO,R5   1                                                             
         BCR,4    *TYPE87                                                       
         B        %-2               LOOP TILL TYPE OUT DONE                     
*                                                                               
         DO       #550                                                          
* IOP TABLE FOR TAURUS                                                          
TYPE71   TEXT     'AABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ž%#@:   '               
TYPE72   DATA     X'00000809',X'0A0B0C0D',X'10111213',X'14151819'               
         DATA     X'1A1B1C1D',X'20212223',X'24252829',X'2A2B2C2D'               
         DATA     X'30313233',X'34350102',X'03040000',0                         
TYPE73   EQU      TYPE72-TYPE71                                                 
         FIN      #550                                                          
*                                                                               
TYPE82   DATA     X'40400000'                                                   
TYPE83   DATA     X'FFFF'                                                       
TYPE84   GEN,10,5,17  5,0,MSG1-1                                                
TYPE85   GEN,8,24     8,DA(TYPE97)  TRANSFER IN CHANNEL COMM.                   
TYPE86   DATA     0                 FWA OF COM. LIST                            
TYPE87   DATA     0                 EXIT                                        
TYPE87A  DATA     0                 SAVE R10 HERE                               
TYPE88   DATA,1   5,0,0,1           CONSTAMT                                    
TYPE89   DATA     0                 STATUS BYTES                                
TYPE91   DATA,8   0                 STORAGE FOR ALARM                           
TYPE92   TEXT     '  IO'                                                        
TYPE93   DATA,1   'P',' ',0,' '                                                 
TYPE94   DATA     X'82000000'                                                   
TYPE94A  DATA     0                                                             
         BOUND    8                                                             
TYPE95   GEN,8,5,19  5,0,BA(TYPE91) COMMAND LIST                                
         DATA,2   X'8200',8         DATA CHAIN, SUPP. IL, 8 BYTES               
TYPE96   DATA,1   5,0,0,0                                                       
         DATA,1   X'82',0,0,0                                                   
TYPE97   DATA,1   5,0,0,0                                                       
         DATA,1   X'82',0,0,0                                                   
TYPE98   GEN,8,5,19  5,0,BA(TYPE99)  END OF COMMAND LIST                        
         DATA,2   X'0200',1                                                     
TYPE99   DATA,1   X'15',0,0,0       NEW LINE CODE                               
MSG1     TEXT     ' SB='                                                        
MSG1A    DATA     0                                                             
MSG2     TEXT     'TDV='                                                        
MSG2A    DATA     0                                                             
*                                   CHANGES HEX CHARS. TO EBCDIC                
*                                   UP TO 4 CHARS. OUTPUT IN R0                 
*                                   INPUT PARAMETERS                            
*                                    R0=0 OR OTHER CHARS.                       
*                                    R5=0,DO 1 CHAR.                            
*                                      -4,DO 2 CHAR.                            
*                                      -8,DO 3 CHAR.                            
*                                      -12,DO 4 CHAR.                           
*                                    R10=CHARS. TO BE CHANGED,                  
*                                         RIGHT JUSTIFIED                       
*                                   OUTPUT                                      
*                                    R0-CONTAINS CHARS. IN EBCDIC,              
*                                         RIGHT JUSTIFIED                       
*                                   USES                                        
*                                    R11,R9                                     
*                                   CALL                                        
*                                    BAL,R8   HEXBCD                            
*                                                                               
*                                                                               
*                                                                               
HXBCD    LI,R11   X'F'              MASK                                        
HXBCD1   SLS,R0   8                                                             
         LW,R9    R10               GET HEX CHAR.                               
         SLS,R9   0,R5              RIGHT JUSTIFY                               
         AND,R9   R11               MASK OFF                                    
         AI,R9    X'F0'             CHANGE TO EBCDIC                            
         CI,R9    X'FA'                                                         
         BL       %+2               NOT A-F                                     
         AI,R9    -X'39'                                                        
         AW,R0    R9                ADD INTO ACC. VALVE                         
         AI,R5    4                                                             
         BLEZ     HXBCD1            NOT DONE                                    
         B        *R8               EXIT                                        
LBOOT80  DATA     0                                                             
         TEXTC    'DISK RESTORED OK'                                            
LBOOT90  DATA     1                 MAX SECT TO WRITE (1 FOR RAD BOOT)          
*                                                                               
LBOOT91  RES      0         BUFFER FOR A HEADER RECORD                          
         DATA     0                 WPS; FLAGS & SEQ NO; AREA INDEX             
         DATA     0                 SECTRS IN RECORD; DEVICE ADDR               
         DATA     0                 TPC; FWA OF AREA                            
         DATA     0                 SPT; AREA NAME                              
         DATA     0                 NUMBER OF SECTORS OF ZERO                   
         DATA     0                 CKSM                                        
*                                                                               
LBOOT92  DATA     1                 NO SECT TO WRITE (1 FOR RAD BOOT)           
         DATA     0                 SECT. NO. TO WRITE INTO                     
LBOOT98  DATA     0                 CKSM FOR LBOOT                              
LBOOT99  EQU      %                 FWA OF LOAD AREA                            
         ORG      %%                RESET LOAD LOC. COUNTER                     
LBOOTX   EQU      %-SBOOT           SIZE TO MOVE TO *BPEND                      
SEG4END  EQU      ((%-RADSEG4)+511)/512  # PAGES REQUIRED FOR SEGMENT           
         END                                                                    
