         SYSTEM SIG9P                                                           
         SYSTEM   OPTIONS                                                       
         DEF      FGL3                                                          
         DEF      FGLMEMCK                                                      
         DEF      FGLMCX                                                        
         DEF      FGL3X                                                         
*                                                                               
OLAYFLAG EQU      'FGL3'                                                        
         SYSTEM   CPRMON                                                        
*                                                                               
HEADSIZ1 EQU      25                LM HDR SIZE                                 
HEADSIZ2 EQU      10                PUB LIB HEADER SIZE                         
FIDSPACE EQU      HEADSIZ1+HEADSIZ2                                             
         TITLE    '**** ROOT LOADER - FGL3 ****'                                
*                                                                               
*        FGL3 READS IN THE ROOT PARTS 1 AND 2, AND                              
*        ACQUIRES ANY PUBLIBS NEEDED, READING THEM IN IF NECESSARY              
*                                                                               
*        AT ENTRY,                                                              
*                 R2=LMI INDEX                                                  
*                 FGLCSP POINTS AT LOAD DCB/FPT FROM INIT/RUN                   
*                                                                               
FGL3     RES      0                                                             
         LW,R7    FGLBSP            GET BUFFER SPACE POINTER                    
         BNEZ     FGL3100           B IF DEFINED                                
         LI,R7    64                                                            
         BAL,R8   GETTEMP           GET BUFFER SPACE                            
         B        B45               ERROR: NOT ENUF TSPACE                      
         STW,R7   FGLBSP            SAVE POINTER                                
         ENABLE                                                                 
         PAGE                                                                   
*                                                                               
*        READ HEADER AND VALIDATE LOAD MODULE FOR REQUESTED LOAD                
*                                                                               
FGL3100  RES      0                                                             
         LW,R9    FGLCSP                                                        
         AI,R9    TISFPT            POINT AT LOAD FPT                           
         LW,R10   FGLBSP            POINT AT HEADER BUFFER                      
         LI,R11   0                 POINT AT HEADER GRANULE                     
         LI,R12   4*HEADSIZ1        NR BYTES TO READ                            
         BAL,R8   FGLREAD           READ HEADER                                 
         B        READERR           ERROR DURING READ                           
         BAL,R8   FGLHDRCK          CHECK HEADER VALIDITY                       
         B        B44               B IF NOT A VALID HEADER                     
         CI,R0    LML                                                           
         BANZ     B42               B IF THIS IS A PUBLIB                       
         DO       #MAP                                                          
         CI,R0    LMPRI                                                         
         BAZ      B47               B IF NOT A PRIMARY LM                       
         ELSE                       #MAP                                        
         LH,R1    LMISTAT,R2        LMI FLAGS FOR COMPARISON                    
         CI,R1    LMIBKG                                                        
         BANZ     B03B              B IF BKG LM EXPECTED                        
         CI,R0    LMF                                                           
         BAZ      B48               B IF LM NOT FGD:  ERROR                     
         DO       #UST                                                          
         CI,R1    LMISEC            IS REQ FOR SEC FGD                          
         BANZ     B03A              YES, BRANCH                                 
         CI,R0    LMPRI             IS THE LM PRIMARY                           
         B        %+2                                                           
B03A     CI,R0    LMSEC             IS THE LM SECONDARY FGD                     
         BAZ      B48               NO, ERROR                                   
         ELSE     #UST                                                          
         CI,R0    LMPRI                                                         
         BAZ      B47               B IF LM IS NOT PRIMARY: ERROR               
         FIN      #UST                                                          
         B        B03C              PASSED HEADER CONSISTENCY CHECK             
B03B     CI,R0    LMF                                                           
         BANZ     B48               B IF LM NOT BKG:  ERROR                     
         CI,R0    LMSEC                                                         
         BAZ      B47               B IF LM IS NOT SECONDARY:  ERROR            
B03C     RES      0                 SEE IF SPACE TO LOAD LM                     
         FIN                        #MAP                                        
         PAGE                                                                   
*                                                                               
*        SEE IF REQUIRED MEMORY IS UNUSED                                       
*                                                                               
         LW,R6    R10               LM HEADER BUFFER ADDRESS                    
         LW,R8    0,R6                                                          
         AND,R8   M24               LOAD MODULE FIRST WORD ADDRESS              
         LW,R9    1,R6                                                          
         AND,R9   M24               LOAD MODULE LAST WORD ADDRESS               
         BAL,R5   FGLMEMCK          CHECK AVAILABILITY OF MEMORY                
         B        B25               REAL MEMORY NOT FREE                        
*                                   YES,SPACE OK,R8=FWA OR EXLOC                
         DO       #MAP=0                                                        
         LH,R0    LMISTAT,R2        SEE IF BKG LOAD                             
         CI,R0    LMIBKG            TEST BKG BIT                                
         BAZ      B03D              B IF FGD                                    
         CW,R9    K:BCKEND                                                      
         BGE      B25               B IF BKG LM OVERLAPS FGD AREA               
         B        B08               BKG PGM HAS NO MEM CONFLICTS                
B03D     RES      0                                                       93.010
         LI,R0    0                                                             
         LW,R1    KL20                                                          
         STS,R0   K:CTST            INSURE CKPT NOT SCHEDULED                   
         CW,R8    K:FGDBG1                                                97.010
         BGE      B08               B IF FGD PGM HAS NO MEM CONFLICTS     97.020
         LB,R0    K:JCP1            NO                                          
         CI,R0    X'30'             IS BCKG. BEING USED BY FGD NOW              
         BANZ     B08               YES                                         
         LW,R1    KL80              NO                                          
         STS,R1   K:CTST            SET BIT TO RUN CKPT.                        
         LCI      2                                                             
         LM,R10   FCLOSE                                                        
         LW,R7    FGLCSP                                                        
         AI,R7    1                 POINT AT DCB TO CLOSE                       
         CAL1,1   R10               CLOSE LOAD MODULE DCB                       
         LI,R1    LMIRUNQ                                                       
         DISABLE                                                                
         LH,R0    LMISTAT,R2                                                    
         OR,R0    R1                SET QUEUED FLAG (SAVES LM FOR A RETRY)      
         STH,R0   LMISTAT,R2                                                    
         MTH,1    RUN99                                                         
         ENABLE                                                                 
         LI,R3    0                 RUN COMPLETION CODE (NOT USED)              
         LI,R8    FGLBADLM          WHERE TO GO NEXT                            
         B        FGL3X                                                         
         FIN                        #MAP=0                                      
         PAGE                                                                   
*                                                                               
*        LOAD PROGRAM ROOTS                                                     
*                                                                               
B08      RES      0                                                             
         LW,R9    FGLCSP                                                        
         AI,R9    TISFPT            POINT TO LOAD FPT                           
         LW,R10   LMRP1WO,R6                                                    
         AND,R10  M24               POINT TO ROOT1 WORD ORIGIN IN MEMORY        
         LI,R11   RP1GO             ROOT1 GRANULE ADDRESS                       
         LW,R12   LMRP1LMB,R6       ROOT1 LM BYTE LENGTH                        
         BAL,R8   FGLREAD           READ ROOT PART 1                            
         B        READERR           ERROR DURING READ                           
         LW,R10   LMRP2WO,R6        ROOT PART TWO WORD ORIGIN                   
         BEZ      B10               B IF NO ROOT PART 2                         
         LW,R11   LMRP2GO,R6        ROOT 2 GRANULE ADDRESS                      
         LW,R12   LMRP2LMB,R6       ROOT 2 LM BYTE LENGTH                       
         BAL,R8   FGLREAD           READ ROOT PART 2                            
         B        READERR           ERROR DURING READ                           
         PAGE                                                                   
*                                                                               
*        ASSIGN USER M:SL TO LM FILE                                            
*                                                                               
B10      RES      0                                                             
         LW,R1    LMFWA,R6          PCB ADDRESS                                 
         LW,R1    PCBM:SL,R1        M:SL ADDRESS                                
         BEZ      B20               B IF THERE IS NO M:SL                       
         LW,R7    FGLCSP                                                        
         AI,R7    1                 LOAD DCB IS TARGET OF GETASN                
         LCI      FGLGASN%-FGLGASN                                              
         LM,R8    FGLGASN           GET GETASN FPT IN REGISTERS                 
         AWM,R6   R8+FGLGASN1-FGLGASN   BIAS FOR FILE NAME POINTER              
         AWM,R6   R8+FGLGASN2-FGLGASN  BIAS FOR ACCOUNT NAME POINTER            
         CAL1,1   R8                GET LOAD DCB ASSIGNMENT                     
         LW,R8    FGLASN            CHANGE TO AN ASSIGN FPT                     
         LW,R7    R1                M:SL IS TARGET OF ASSIGN                    
         CAL1,1   R8                ASSIGN M:SL TO LOAD DCB MEDIUM              
         PAGE                                                                   
*                                                                               
*        CLOSE THE DCB USED TO READ THE LOAD MODULE                             
*                                                                               
B20      RES      0                                                             
         LW,R7    FGLCSP                                                        
         AI,R7    1                 LOAD DCB IS TARGET OF CLOSE                 
         LCI      2                                                             
         LM,R10   FCLOSE                                                        
         CAL1,1   R10               CLOSE LOAD DCB                              
*                                                                               
*        CHECK FOR PUBLIBS NEEDED                                               
*                                                                               
         LW,R0    LMPUBLIB,R6                                                   
         BNEZ     FGL3PL            B IF PUBLIBS ARE NEEDED                     
*                                                                               
FGL3OKEX RES      0                 SUCCESSFUL LOADS EXIT HERE                  
         LI,R8    FGLOKLM           WHERE TO GO NEXT                            
*                                                                               
FGL3X    B        *R8               ALL EXITS GO THRU HERE                      
         PAGE                                                                   
*                                                                               
*        SUBROUTINE TO SEE IF MEMORY AREA REQUIRED TO LOAD                      
*        A PROGRAM OR PUBLIB IS AVAILABLE                                       
*                                                                               
*        CONFLICTS WITH BACKGROUND ARE IGNORED SINCE THEY                       
*        ARE RESOLVED BY CHECKPOINTING, NOT BY WAITING OR                       
*        ABORTING                                                               
*                                                                               
*        CALL IS   BAL,R5  FGLMEMCK                                             
*                 R2=LM INDEX                                                   
*                 R8=LM FWA                                                     
*                 R9=LM LWA                                                     
*                                                                               
*                                   EXITS: TO CALL+1 IF NO SPACE                
*                                             CALL+2 IF FREE SPACE              
*                                       R8=FWA OF LM                            
*                                       R9=LWA OF LM                            
*        USES:    R0, R7-R9, R13                                                
*                                                                               
*        IF A CONFLICT IS OF A NATURE THAT IT WILL NOT BE RESOLVED BY           
*        OTHER TASKS TERMINATING, THE MODULE BEING LOADED IS                    
*        DEQUEUED, SO ITS LOAD WILL NOT BE RETRIED.                             
*                                                                               
FGLMEMCK RES      0                                                             
         PUSH     R1                                                            
         DO       #MAP=0                                                        
         CW,R9    K:FGDEND                                                      
         BG       B89               B IF PAST MEMORY END                        
         CW,R8    K:BACKBG                                                      
         BL       B89               B IF BEFORE CPR END                         
         ELSE                                                                   
         LW,R14   R8                FWA                                         
         BAL,R13  BPTEST            GET PARTITION INDEX                         
         LW,R1    R7                SAVE PPT INDEX                              
         LW,R14   R9                LWA                                         
         BAL,R13  BPTEST            GET PARTITION INDEX                         
         CW,R7    R1                SEE IF FWA/LWA IN SAME PARTITION            
         BNE      B89               B IF NOT                                    
         LW,R1    PPT,R7            SEE IF PARTITION IS A PRIVATE               
         LB,R1    R1                      PARTITION                             
         AND,R1   XPPTTYPE          MASK FOR PPT TYPE                           
         CI,R1    PPTTYPE1          TYPE 1 IS PRIVATE                           
         BE       B815              B IF PRIVATE PARTITION                      
         CI,R1    PPTTYPE4          COMPARE WITH PREFERRED                      
         BNE      B89               B IF NOT PREFERRED PARTITION                
         FIN      #MAP                                                          
B815     RES      0                                                             
         LB,R1    LMI#              NR OF LMI ENTRIES TO CHECK                  
B82      RES      0                                                             
         CW,R1    R2                ON OWN ENTRY                                
         BE       B85               IF SO, SKIP LIMITS COMPARISON               
B821     RES      0                                                             
         LH,R7    LMISTAT,R1        CYCLE THROUGH LMI LOOKING FOR SPACE         
         CI,R7    LMIRUN                                                        
         BAZ      B85               THIS PROG. IS NOT LOADED                    
         DO       #MAP                                                          
         CI,R7    LMIMAP                                                        
         BANZ     B85               B IF MAPPED                                 
         ELSE     #MAP                                                          
         CI,R7    LMIBKG            CONFLICT WITH BKG TASK WILL                 
         BANZ     B85               BE RSOLVED BY CKPTING. B IF BKG.            
         FIN      #MAP                                                          
         LW,R7    LMIFWA,R1         GET FWA TO COMPARE                          
         AND,R7   M24                                                           
         CLR,R8   R7                DO COMPARE ON FWA                           
         BCS,4    B85               NO OVERLAP IF FWA EXCEEDS LWA               
         BCS,2    B84               FWA LESS THAN FWA, TEST LWA                 
         BCR,3    FGL3B81E                                                      
         BCR,12   FGL3B81E          OVERLAP IF FWA OR LWA ARE =                 
         BCS,9    FGL3B81E          OVERLAP IF FWA BETWEEN FWA,LWA              
B84      LW,R7    LMILWA,R1         GET LWA                                     
         AND,R7   M24                                                           
         CLR,R8   R7                DO COMPARE ON LWA                           
         BCS,2    B85               NO OVERLAP IF LWA LESS THAN FWA             
         B        FGL3B81E          OVERLAP,EXIT TO CALL+1;NO SPACE             
B85      BDR,R1   B82               NO OVERLAP SO FAR, GET NEXT ENTRY           
         MTW,1    R5                SPACE IS FREE,EXIT TO CALL+2                
FGL3B81E RES      0                                                             
         PULL     R1                                                            
FGLMCX   B        *R5                                                           
*                                                                               
B89      RES      0                 PERMANENT MEMORY CONFLICT                   
         PUSH     R8                                                            
         BAL,R8   FGL3DQ            REMOVE THE LM FROM THE LOAD QUEUE           
         PULL     R8                                                            
         B        FGL3B81E          B TO EXIT                                   
*                                                                               
         DO       #MAP                                                          
*        FIND PARTITION FOR ADDRESS IN R14                                      
BPTEST   RES      0                                                             
         PUSH     R8                                                            
         BAL,R8   MMFMP             FIND PARTITION NR                           
         LI,R7    1                 NOT FOUND: CLAIM CPR PARTITION              
         PULL     R8                                                            
         B        *R13                                                          
         FIN                        #MAP                                        
         PAGE                                                                   
*                                                                               
*                                   PROCESS ERROR, ABNORMAL RETURNS             
*                                                                               
FGL3ERR1 RES      0                                                             
         LB,R15   R10               GET ERROR CODE IN R15                       
READERR  RES      0                                                             
         LI,R5    XMSG7             NONEXIST. LM                                
         CI,R15   X'03'                                                         
         BE       READERR1          B IF FILE DID NOT EXIST                     
         LI,R5    XMSG9             NO TSPACE                                   
         CI,R15   X'66'                                                         
         BE       READERR1          B IF THERE WAS NOT ENUF TSPACE              
         LI,R5    XMSG61            I/O ERROR                                   
READERR1 RES      0                                                             
         LI,R3    2                 RUN COMPLETION STATUS                       
*                                                                               
FGL3BXDQ RES      0                 BAD EXIT, DEQUEUE THE LM                    
*        R3=RUN COMPLETION CODE                                                 
*        R5=MESSAGE INDEX                                                       
*        R15=TYC                                                                
         BAL,R8   FGL3DQ            DEQUEUE THE LM                              
*                                                                               
FGL3BADX RES      0                 BAD EXIT                                    
*        R3=RUN COMPLETION CODE                                                 
*        R5=MESSAGE INDEX                                                       
*        R15=TYC                                                                
         BAL,R8   FGLMSG            OUTPUT MESSAGE                              
         LI,R8    FGLBADLM          WHERE TO GO NEXT                            
         B        FGL3X             GO THERE                                    
         PAGE                                                                   
*                                                                               
*        LOAD PRIMARY PUBLIBS                                                   
*                                                                               
FGL3PL   RES      0                 SAVE BAL REGISTER                           
         LW,R6    FGLBSP            FGL BUFFER SPACE (LM HEADER)                
         LI,R3    LMPUBLIB          INDEX TO NEXT PUBLIB NAME IN HDR            
*                                                                               
*        LOOP THRU HERE TO ACQUIRE EACH PUBLIB REQUIRED                         
*                                                                               
FGLPL100 RES      0                                                             
         LCI      2                                                             
         LM,R10   *R3,R6            NEXT PUBLIB NAME                            
         AI,R3    2                 UPDATE NAME POINTER                         
         CI,R10   0                                                             
         BE       FGL3OKEX          B IF NO MORE PUBLIBS NEEDED                 
*                                                                               
*        SEARCH LMI FOR PUBLIB ALREADY LOADED                                   
*                                                                               
         LB,R1    LMI#              NR OF LMI ENTRIES                           
FGLPL110 RES      0                                                             
         DISABLE                                                                
         CD,R10   LMINAME,R1                                                    
         BNE      FGLPL120          B IF NOT SAME NAME                          
         LH,R0    LMISTAT,R1                                                    
         CI,R0    LMIRUN                                                        
         BAZ      FGLPL120          B IF NOT RUNNING                            
         CI,R0    LMIPPL+LMISPL                                                 
         BAZ      FGLPL120          B IF NOT A PUBLIB                           
         DO       #MAP                                                          
         CI,R0    LMIPPL                                                        
         BAZ      B46               B IF WRONG KIND OF PUBLIB                   
         FIN                        #MAP                                        
         BAL,R8   FGLPL910          ACQUIRE THE PUBLIB                          
         ENABLE                                                                 
         B        FGLPL100          CHECK FOR MORE PUBLIBS                      
*                                                                               
FGLPL120 RES      0                                                             
         ENABLE                                                                 
         BDR,R1   FGLPL120          CHECK NEXT LMI ENTRY                        
*                                                                               
*        PUBLIB IS NOT YET LOADED                                               
*        RESERVE LMI ENTRY FOR IT                                               
*                                                                               
FGLPL200 RES      0                                                             
         LI,R0    0                 FOR USE IN INITIALIZING LMI                 
         LB,R1    LMI#              NR OF LMI ENTRIES TO CHECK                  
         LI,R8    LMIPPL            FOR USE IN INITIALIZING LMI                 
FGLPL210 RES      0                                                             
         DISABLE                                                                
         LH,R5    LMISTAT,R1                                                    
         BEZ      FGLPL220          B IF AN UNUSED ENTRY FOUND                  
         ENABLE                                                                 
         BDR,R1   FGLPL210          CHECK NEXT ENTRY                            
         B        B49               NO FREE ENTRY IN LMI FOR PUBLIB             
*                                                                               
FGLPL220 RES      0                 INITIALIZE LMI ENTRY FOR PUBLIB             
         STH,R8   LMISTAT,R1                                                    
         STD,R10  LMINAME,R1                                                    
         STW,R0   LMIFWA,R1                                                     
         STW,R0   LMILWA,R1                                                     
         STB,R0   LMIUSERS,R1                                                   
         MTW,1    RUN99                                                         
         BAL,R8   FGLPL910          ACQUIRE THE PUBLIB                          
         ENABLE                                                                 
*                                                                               
*        SEE IF PUBLIB CAN BE LOADED                                            
*        R1=PUBLIB LMI INDEX                                                    
*                                                                               
FGLPL300 RES      0                                                             
         LI,R9    'FP'              PUBLIB LM AREA NAME                         
         LD,R12   ZEROS             DEFAULT ACCOUNT NAME                        
         LCI      5                                                             
         STM,R9   FIDSPACE,R6       PUT FILE ID INTO BUFFER SPACE               
         LCI      FGLGASN%-FGLGASN                                              
         LM,R8    FGLGASN           LOAD GETASN FPT INTO REGS                   
         LW,R8    FGLASN            CHANGE TO ASSIGN                            
         AWM,R6   R8+FGLGASN1-FGLGASN  BIAS FILE NAME POINTER                   
         AWM,R6   R8+FGLGASN2-FGLGASN  BIAS ACCOUNT NAME POINTER                
         LW,R7    FGLCSP                                                        
         AI,R7    1                 POINT TO LOAD DCB                           
         CAL1,1   R8                ASSIGN LOAD DCB TO PUBLIB LM                
         LW,R9    FGLCSP                                                        
         AI,R9    TISFPT            POINT TO LOAD DCB                           
         LW,R10   FGLBSP                                                        
         AI,R10   HEADSIZ1          POINT TO PUBLIB HEADER BUFFER               
         LI,R11   0                 HEADER GRAN NR                              
         LI,R12   4*HEADSIZ2        HEADER BYTE LENGTH                          
         BAL,R8   FGLREAD           READ PUBLIB HEADER                          
         B        READERR           ERROR DURING READ                           
*                                                                               
*        CHECK VALIDITY OF HEADER                                               
*                                                                               
         BAL,R8   FGLHDRCK          CHECK HEADER VALIDITY                       
         B        B43               B IF NOT A VALID HEADER                     
         LI,R1    LMF+LML           FOREGROUND, PUBLIB                          
         CS,R1    R0                                                            
         BNE      B43               B IF NOT A PUBLIB                           
         DO       #MAP                                                          
         CI,R0    LMPRI                                                         
         BAZ      B46               B IF SECONDARY PUBLIB                       
         FIN                        #MAP                                        
         LW,R7    R10               GET PUBLIB HEADER POINTER IN R7             
         LW,R8    LMFWA,R7                                                      
         AND,R8   M24               PUBLIB FWA                                  
         LW,R9    LMLWA,R7                                                      
         AND,R9   M24               PUBLIB ROOT LWA                             
         LW,R0    LMRP2WO,R7        CONTEXT ORIGIN                              
         BEZ      FGLPL310          B IF NO CONTEXT SEG                         
         LW,R9    LMRP2MBL,R7       CONTEXT MEMORY BYTE LENGTH                  
         AI,R9    3                                                             
         SLS,R9   -2                CONTEXT WORD LENGTH                         
         AW,R9    R0                                                            
         AI,R9    -1                CONTEXT LWA                                 
FGLPL310 RES      0                                                             
         STW,R8   LMIFWA,R1                                                     
         STW,R9   LMILWA,R1                                                     
         CW,R8    K:FGDBG1                                                      
         BL       B25               B IF PUBLIB IS NOT IN FGD MEMORY            
         XW,R2    R1                GET PUBLIB LMID IN R2                       
         BAL,R5   FGLMEMCK          SEE IF REQUIRED MEMORY IS FREE              
         B        B24               NOT FREE                                    
         XW,R2    R1                RESTORE REGS                                
*                                                                               
*        PUBLIB HAS NO MEMORY CONFLICTS                                         
*        READ IT                                                                
*        R1=PUBLIB LMI INDEX                                                    
*                                                                               
FGLPL400 RES      0                                                             
         LW,R7    FGLBSP                                                        
         AI,R7    HEADSIZ1          POINTER TO PUBLIB HEADER BUFFER             
         LW,R9    FGLCSP                                                        
         AI,R9    TISFPT            POINT TO LOAD FPT                           
         LW,R10   LMRP1WO,R7        ROOT PART 1 ORIGIN                          
         LI,R11   RP1GO             GRANULE NR                                  
         LW,R12   LMRP1LMB,R7       BYTE LENGTH                                 
         BAL,R8   FGLREAD           READ PUBLIB ROOT                            
         B        READERR           ERROR DURING READ                           
         LW,R10   LMRP2WO,R7        CONTEXT ORIGIN                              
         BEZ      FGLPL410          B IF NO CONTEXT SEG                         
         LW,R11   LMRP2GO,R7        CONTEXT GRANULE NR                          
         LW,R12   LMRP2LMB,R7       BYTE LENGTH                                 
         BEZ      FGLPL410          B IF NO LM IMAGE OF CONTEXT                 
         BAL,R8   FGLREAD           READ PUBLIB CONTEXT SEG                     
         B        READERR           ERROR ENCOUNTERED DURING READ               
FGLPL410 RES      0                                                             
         LW,R7    FGLCSP                                                        
         AI,R7    1                 POINT TO LOAD DCB                           
         LCI      2                                                             
         LM,R10   FCLOSE                                                        
         CAL1,1   R10               CLOSE LOAD DCB                              
*                                                                               
*        PUBLIB IS LOADED                                                       
*                                                                               
         DISABLE                                                                
         LH,R0    LMISTAT,R1                                                    
         OR,R0    XLMIRUN           SET PUBLIB 'RUNNING'                        
         STH,R0   LMISTAT,R1                                                    
         MTW,1    RUN99                                                         
         ENABLE                                                                 
         B        FGLPL100          LOOK FOR MORE PUBLIBS                       
         PAGE                                                                   
*                                                                               
*        ATTACH PUBLIB TO TASK BEING LOADED                                     
*        BAL,R8   FGLPL910                                                      
*        R1=PUBLIB LMID                                                         
*        R0       DESTROYED                                                     
*                                                                               
*        EXECUTE DISABLED                                                       
*                                                                               
FGLPL910 RES      0                                                             
         MTB,1    LMIUSERS,R1       INCREMENT PUBLIB USE COUNT                  
         LW,R0    FGLPUBL                                                       
         SLS,R0   8                                                             
         OR,R0    R1                ADD PUBLIB TO THOSE LOADED FOR              
*                                   CURRENT TASK                                
         STW,R0   FGLPUBL                                                       
         B        *R8                                                           
         PAGE                                                                   
*                                                                               
*        FGLREAD  READ  SUB-ROUTINE  READS HEADERS AND ROOTS                    
*                       ALL READS ARE WITH WAIT                                 
*                 AT ENTRY:                                                     
*                             R8= LINK                                          
*                             R9= FPT ADDRESS                                   
*                             R10=BUFFER ADDRESS                                
*                             R11=START GRANULE #  (KEY)                        
*                             R12=BYTE COUNT                                    
*                                                                               
*                 AT EXIT!                                                      
*                             R0= DESTROYED                                     
*                                   R10 BYTE ZERO DESTROYED                     
*                             R12=DESTROYED                                     
*                             RETURN IS TO LINK IF ANY ERRORS  R15 WILL         
*                                   HAVE AN ABNORMAL T4C  CODE                  
*                                                                               
*                             RETURN IS TO LINK+1 IF NO ERRORS                  
*                                                                               
FGLREAD  EQU      %                                                             
         PUSH     5,R4              SAVE REGS                                   
         LW,R6    *R9               GET DCB ADDRESS                             
         LW,R0    XBIT10                                                        
         CW,R0    0,R6                                                          
         BANZ     FGLR00            B IF DCB IS OPEN                            
         LI,R0    0                                                             
         STB,R0   R10               INSURE R10 BYTE ZERO IS ZERO                
         LCI      2                                                             
         LM,R4    FGLOPEN           GET OPEN FPT                                
         CAL1,1   R4                OPEN THE DCB IF NECESSARY                   
         LB,R0    R10                                                           
         BNEZ     FGLR04            B IF ANY ERRORS                             
FGLR00   RES      0                                                             
         LI,R7    6                 GET AREA INDEX BYTE DISPLACEMENT            
         LB,R6    *R6,R7            GET AREA INDEX                              
         LB,R5    MDDISCI,R6        THEN DISC TABLE INDEX, AND FINALLY          
         LH,R5    DISCNWPS,R5       NUMBER OF WORDS PER SECTOR                  
         AND,R5   X1FF              MASK                                        
         LI,R7    8191              MAX WORDS IN ONE READ                       
         DW,R7    R5                R7=MAX # SECTORS IN ONE READ                
         MW,R5    R7                R5=MAX # WORDS   IN ONE READ                
         LI,R6    4                 OFFSET TO KEY PARAMETER IN FPT              
         STW,R11  *R9,R6            PLACE START GRANULE # IN FPT                
         LI,R6    2                 OFFSET TO BUFFER ADDRESS IN FPT             
         STW,R10  *R9,6             SET BUFFER ADDRESS IN FPT                   
FGLR01   RES      0                                                             
         SLS,R5   2                 CHANGE WORDS TO BYTES                       
         LW,R6    R12               SAVE REMAINING BYTE COUNT                   
         SW,R12   R5                SUBTRACT MAX BYTE COUNT                     
         BLZ      FGLR02            B IF REMAINING .LT. MAX (READ REM)          
         LW,R6    R5                READ MAX BYTE COUNT                         
FGLR02   EQU      %                                                             
         LI,R4    3                 OFFSET TO BYTE COUNT                        
         STW,R6   *R9,R4            STORE IN FPT                                
         LI,R4    20                OFFSET TO COMPLETION STATUS WORD            
         CAL1,1   *R9               PERFORM READ                                
         LB,R6    *R9,R4            GET COMPLETION STATUS FROM FPT              
         CI,R6    TYCNORM           CHECK FOR NORMAL COMPLETION                 
         BNE      FGLR04            B IF ERRORS                                 
         CI,R12   0                 CHECK TO SEE IF WE ARE DONE                 
         BLE      FGLR03            B IF  DONE                                  
         LI,R4    4                 OFFSET TO GRANULE  # IN FPT                 
         AWM,R7   *R9,R4            SET UP GRANULE # FOR NEXT  READ             
         LI,R4    2                 OFFSET TO BUFFER ADDRESS                    
         SLS,R5  -2                 CHANGE TO WORDS                             
         AWM,R5   *R9,R4            ADD WORDS READ TO BUFFER ADDR               
         B        FGLR01            B TO CONTINUE READING                       
FGLR03   EQU      %                                                             
         PULL     5,R4              RESTORE  REGS                               
         AI,R8    1                 NORMAL EXIT                                 
         B        *R8                                                           
*                                                                               
FGLR04   EQU      %                                                             
         LB,R15   R10               ERRORCODE                                   
         BNEZ     %+2               B IF OTHER THAN ZERO CODE                   
         LI,R15   TYCB6             IO ERROR CODE ZERO                          
         PULL     5,R4              RESTORE REGS                                
         B        *R8                                                           
*                                                                               
FGLOPEN  GEN,1,7,24  1,X'14',R6     OPEN DCB ADDRESSED BY R6                    
         DATA     F7                IGNORE ERRORS                               
         PAGE                                                                   
*                                                                               
*        FGL3DQ   RESET THE RUN-QUEUED FLAG FOR A                               
*                 LOAD MODULE WHEN AN UNCORRECTABLE LOAD                        
*                 PROBLEM HAS BEEN ENCOUNTERED                                  
*        AT ENTRY R2=LMID                                                       
*                 R8=LINK                                                       
*                                                                               
*        AT EXIT  R0, R1 DESTROYED                                              
*                                                                               
*        RETURN   IS TO LINK, ENABLED                                           
*                                                                               
FGL3DQ   RES      0                                                             
         LI,R1    X'FFFD'                                                       
         DISABLE                                                                
         LH,R0    LMISTAT,R2                                                    
         AND,R0   R1                RESET RUNQ FLAG                             
         STH,R0   LMISTAT,R2                                                    
         MTW,1    RUN99             INCREMENT REENTRANCE COUNT FOR LMI          
         ENABLE                                                                 
         B        *R8                                                           
         PAGE                                                                   
*                                                                               
*        SUBROUTINE TO VALIDATE A FILE AS A LOAD MODULE                         
*                                                                               
*        ENTRY:   R10=MEMORY ADDRESS OF FILE GRANULE 0                          
*                 BAL,R8  FGLHDRCK                                              
*                                                                               
*        EXIT:    CALL+1 IF NOT VALID                                           
*                 CALL+2 IF VALID                                               
*                 HEADER FLAG BYTE IN R0 IF VALID                               
*                 R1 DESTROYED                                                  
*                                                                               
FGLHDRCK RES      0                                                             
         LI,R1    1                                                             
*        CHECK THAT THE FIRST THREE WORDS OF THE HEADER HAVE                    
*        A VALID ADDRESS IN THE LAST THREE BYTES OF EACH WORD                   
FGLHC10  RES      0                                                             
         LW,R0    *R10,R1           NEXT WORD                                   
         AND,R0   M24               TRIMMED                                     
         CI,R0    RBMEND                                                        
         BLE      FGLHCX            B IF TOO SMALL                              
         CI,R0    X'1FFFF'                                                      
         BG       FGLHCX            B IF TOO BIG                                
         AI,R1    -1                                                            
         BGEZ     FGLHC10           B IF MORE TO CHECK                          
*                                                                               
         LB,R0    *R10              GET FLAG BYTE FROM HEADER                   
         CI,R0    LMPRI+LMSEC                                                   
         BAZ      FGLHCX            B IF NOT PRIMARY OR SECONDARY               
         CI,R0    3                                                             
         BANZ     FGLHCX            B IF UNUSED FLAGS SET                       
         AI,R8    1                 SKIP RETURN                                 
FGLHCX   B        *R8                                                           
         PAGE                                                                   
*                                                                               
*        ERROR EXITS                                                            
*                                                                               
B24      RES      0                                                             
         XW,R1    R2                RESTORE LMIDS                               
B25      LI,R5    FMSG5             CORE USED                                   
         LI,R15   X'A4'             TYC: REAL MEM NOT AVAILABLE                 
         LI,R3    1                 STATUS                                      
         B        FGL3BADX                                                      
B42      LI,R3    6                 STATUS TO POST                              
         LI,R15   X'B0'             TYC: CAN'T DIRECTLY REQUEST PUBLIB          
         LI,R5    XMSG8             PUBLIB ALARM                                
         B        FGL3BXDQ                                                      
B43      LI,R3    6                 RUN STATUS CODE: BAD PUBLIB                 
         LI,R15   X'B4'             TYC: REQUESTED PUBLIB IS NOT PUBLIB         
         LI,R5    FMSG10            MSG: BAD PUBLIB                             
         B        FGL3BXDQ                                                      
B44      LI,R3    2                 RUN STATUS CODE: NONEXIST PGM               
         LI,R15   X'77'             TYC:  ILLEGAL FILE FORMAT                   
         LI,R5    XMSG11            MSG: BAD HEADER                             
         B        FGL3BXDQ                                                      
B45      LI,R3    7                 R3=STATUS TO POST                           
         LI,R15   X'66'             TYC: NO TSPACE                              
         LI,R5    XMSG9             NO TSPACE ALARM                             
         B        FGL3BADX                                                      
B46      RES      0                                                             
         ENABLE                                                                 
         LI,R3    6                 RUN COMPLETION CODE                         
         LI,R15   X'B5'             TYC: LM IS PRI/SEC, PUBLIB OPPOSITE         
         LI,R5    FMSG10            PUB LIB USE ERROR                           
         B        FGL3BADX                                                      
B47      LI,R3    2                 RUN STATUS CODE: LM IS NOT PRIMARY          
         LI,R15   X'B1'             TYC: LM IS NOT PRIMARY                      
         LI,R5    XMSG11            FGL2 CANT LOAD SECONDARY TASK               
         B        FGL3BXDQ                                                      
B48      LI,R3    2                                                             
         LI,R15   X'B7'             TYC: INIT FOR FGD/BKG, LM OPPOSITE          
         LI,R5    XMSG11            MSG: BAD HEADER                             
         B        FGL3BXDQ                                                      
B49      RES      0                                                             
         LI,R3    1                 RUN COMPLETION CODE                         
         LI,R5    FMSG4             LMI FULL MESSAGE INDEX                      
         LI,R15   TYC66             NO TABLE SPACE TYC                          
         B        FGL3BADX                                                      
*                                                                               
XMSG5    EQU      1                 CORE USED ALARM                             
XMSG61   EQU      2                 I/O ERROR ALARM INDEX                       
XMSG7    EQU      3                 NONEXISTENT PROG AL. INDEX                  
XMSG8    EQU      4                 PUBLIB ALARM                                
XMSG9    EQU      5                 NO TSPACE ALARM INDEX                       
XMSG11   EQU      6                 BAD HEADER                                  
FMSG4    EQU      0                 LMI FULL ALARM MESSAGE                      
FMSG5    EQU      1                 CORE USED ALARM                             
FMSG7    EQU      3                 NONEXIST LM ALARM                           
FMSG10   EQU      7                 BAD PUBLIB ALARM                            
         PAGE                                                                   
*                                                                               
*        FPT PROTOTYPES                                                         
*                                                                               
FCLOSE   GEN,1,7,24  1,X'15',R7     CLOSE DCB ADDRESSED BY R7                   
         DATA     F7                IGNORE ERRORS                               
*                                                                               
FGLGASN  GEN,1,7,1,23  1,X'09',1,R7 GET ASGNMT OF DCB ADDRESSED BY R7           
         DATA     P1+P4+P14         ERROR ADDR, FILE NAME, ACNT NAME            
         PZE      FGL3ERR1          ERROR ADDRESS                               
FGLGASN1 PZE      FIDSPACE          FILE NAME DISPL INTO TSPACE                 
FGLGASN2 PZE      FIDSPACE+3        ACNT NAME DISPL INTO TSPACE                 
FGLGASN% RES      0                                                             
*                                                                               
FGLASN   GEN,1,7,1,23  1,X'08',1,R7  ASSIGN DCB ADDRESSED BY R7                 
*        REST OF FPT IS FROM FGLGASN                                            
*                                                                               
*        CONSTANTS                                                              
*                                                                               
KX7F     EQU      M7                                                            
KX1FF    EQU      M9                                                            
KL20     EQU      Y2                                                            
KL80     EQU      Y8                                                            
         OLAYEND                                                                
         END                                                                    
