         SYSTEM   OPTIONS                                                       
         SYSTEM   SIG5P                                                         
         DEF      LOAD                                                          
         REF      DCT4                                                          
         REF      DCT7                                                          
         REF      DCT16                                                         
         REF      MDNAME,MDDISCI,MDDCTI                                         
         REF      DISCNWPS                                                      
         REF      OPLB1,OPLB2,OPLB3                                             
         REF      RFT1,RFT2,RFT3,RFT4,RFT5,RFT6,RFT7                            
         REF      RFT8,RFT9,RFT10,RFT11,RFT12,RFT13,RFT14                       
         REF      RFT15                                                         
         DO       #MAP                                                          
         REF      STILMID,LMIRFT                                                
         FIN                        #MAP                                        
*                                                                               
OPLBS1   EQU      OPLB1                                                         
OPLBS2   EQU      OPLB2                                                         
OPLBS3   EQU      OPLB3                                                         
PCBPOINT EQU      X'4E'                                                         
TCBPOINT EQU      X'4F'                                                         
BTINDEX  EQU      3                 AREA INDEX FOR THE BT AREA                  
*                                                                               
R0       EQU      0                 REGISTER EQUATES                            
R1       EQU      1                                                             
R2       EQU      2                                                             
R3       EQU      3                                                             
R4       EQU      4                                                             
R5       EQU      5                                                             
R6       EQU      6                                                             
R7       EQU      7                                                             
R8       EQU      8                                                             
R9       EQU      9                                                             
R10      EQU      10                                                            
R11      EQU      11                                                            
R12      EQU      12                                                            
R13      EQU      13                                                            
R14      EQU      14                                                            
R15      EQU      15                                                            
*                                                                               
*                                   EQUATES FOR SYSTEM FLAGS                    
*                                                                               
K:BACKBG EQU      X'140'            BEGINNING ADDRESS OF BACKGROUND             
K:BCKEND EQU      X'141'            ENDING ADDRESS OF BACKGROUND                
K:CCBUF  EQU      X'144'            ADDRESS OF CONTROL CARD BUFFER              
K:UNAVBG EQU      X'149'            START ADD. OF UNAVAILABLE MEMORY            
K:MASTD  EQU      X'14A'            START ADD. OF MASTER DICTIONARY             
K:NUMDA  EQU      X'14B'            HIGHEST VALID DW INDEX FOR MASTD            
K:JCP1   EQU      X'150'            FLAGS FOR JCP AND CONTROL TASK              
*                                   BITS HAVE FOLLOWING MEANING:                
*        BIT  0=1, JCP IS EXECUTING                                             
*        BIT  1=1, BACKGROUND IS ACTIVE                                         
*        BIT  2=1, BCKG. IS CHECKPOINTED ON RAD                                 
*        BIT  3=1, BCKG. IS BEING USED BY FGD. BUT WAS NOT CKPOINTED            
*        BIT  4=1, WAITING FOR KEYIN RESPONSE                                   
*        BIT  5=1, SKIP TO NEXT JOB CARD                                        
*        BIT  6=1, ATTEND COMMAND NOT ALLOWED                                   
*        BIT  7=1, PAUSE COMMAND NOT ALLOWED                                    
*       BITS 8-15, PREVIOUS ASSIGN. OF C DEVICE(FOR TY KEY-IN)                  
*        BITS 16-21 UNUSED                                                      
*        BIT 22=1,  SYSTEM PROCESSOR CONTROL COMMAND ENCOUNTERED                
*        BIT  23=1, EXECUTE BACKGROUND DEBUG                                    
*      BITS 24-25, 0 MEANS NO PMD REQUESTED                                     
*                , 1 MEANS CONDITIONAL PMD                                      
*                , 2 MEANS UNCOND. PMD                                          
*        BIT 26    FLAG FOR CKPT THAT ALARM TYPED                               
*        BIT 27=1, RBM INITIALIZE ROUTINE IS RUNNING                            
*        BIT 28=1, FG KEY-IN  ACTIVE                                            
*        BIT 29=1, TY KEY-IN  ACTIVE                                            
*        BIT 30=1, ATTEND COMMAND WAS INPUT                                     
*        BIT 31=1, JOB COMMAND WAS INPUT                                        
*                                                                               
K:DCT1   EQU      X'176'            ADDRESSES OF TABLES                         
K:DCT16  EQU      X'177'                                                        
K:OPLBS1 EQU      X'178'                                                        
K:MDNAME EQU      X'212'            FILE AREA NAME TABLE POINTER                
*                                                                               
         TITLE    '***** PUSH/PULL PROCEDURES *****'                            
*                                                                               
*                                                                               
*                                                                               
*                                                                               
PULL     CNAME    0                                                             
PUSH     CNAME    1                                                             
         PROC                                                                   
LF       RES      0                                                             
         DO       NUM(AF)=1                                                     
         GEN,1,7,4,3,17  0,8+NAME,AF(1),0,LOAD                                  
         ELSE                                                                   
         GEN,8,4,12,4,4  2,3,0,AF(1),0                                          
         GEN,1,7,4,3,17  0,X'A'+NAME,AF(2),0,LOAD                               
         FIN                                                                    
         PEND                                                                   
         TITLE    '***** LOAD LOAD MODULE HEADER *****'                         
*                                                                               
*        LOAD MODULE HEADER                                                     
         GEN,8,24 X'44',LOAD        FLAGS, FWA                                  
         GEN,8,24 X'FF',OVLOAD      MAX SECBS, LWA                              
         GEN,8,24 X'FF',S01         MAX RECBS, ENTRY                            
         GEN,8,24 X'FF',BA(OVLOAD+1)-BA(LOAD)  MAX ENQS, ROOT VMBL              
         GEN,8,24 2,LOAD            NR SEGS (MAPPED ONLY), ROOT VMWO            
         DATA     BA(OVLOAD+1)-BA(LOAD)  ROOT LMBL                              
         DATA     0,0,0,0,0,0       NO ROOT PART 2                              
         GEN,32,16,16 RTS,RTS1-RTS,0 RBM TEMP STACK SCD PROTOTYPE               
         DATA     0                 NO PUBLIBS                                  
         ORG      0                 CUE SYSGEN FOR END-OF-SECTOR                
*                                   PROGRAM CONTROL BLOCK (PCB)                 
LOAD     RES      0                                                             
         DATA     TSTACK-1          LOADED AT START OF BKG                      
         DATA,2   TSTACK1-TSTACK,0                                              
         DATA     0                 NOT USED BY JCP                             
         DATA     0                 NOT USED BY JCP                             
         DATA     0                 TRAP HANDLING-NONE                          
         DATA     0                 M:SL OCB FOR JCP OVERLAYS                   
         DATA     S01,0,0,0         ENTRY, ETC                                  
         DATA     DCBTAB1,0,0                                                   
TSTACK   RES      50                USER TEMP STACK                             
TSTACK1  RES      0                                                             
RTS      RES      150+#SYMB*100                                                 
RTS1     RES      0                                                             
DCBTAB1  DATA     (DCBTAB2-DCBTAB1+1)/3                                         
         TEXT     'F:BI    '        DCB TABLE FOR JCP                           
         DATA     F:BI                                                          
         TEXT     'F:C     '                                                    
         DATA     F:C                                                           
         TEXT     'F:OV    '                                                    
         DATA     F:OV                                                          
         TEXT     'F:X1    '                                                    
         DATA     F:X1                                                          
         TEXT     'F:LL    '                                                    
         DATA     F:LL                                                          
         TEXT     'F:LO    '                                                    
         DATA     F:LO                                                          
         TEXT     'F:OC    '                                                    
         DATA     F:OC                                                          
         TEXT     'F:UR    '                                                    
         DATA     F:UR                                                          
DCBTAB2  RES      0                                                             
*                                   FPT'S                                       
         TITLE    '***** FPTS *****'                                            
*                                                                               
*                                                                               
*                                                                               
ASGNFPT  GEN,1,7,1,23  1,X'08',1,R1   ASSIGN DCB ADDRESSED BY R1                
ASGNBITS DATA     X'80000000'       P1                                          
         DATA     ASGNERR           ERROR RETURN ADDRESS                        
ASGNPTR  DATA     GIOCT+1           I/O STREAM ID POINTER                       
         DATA     GIOCT+4           FILE ACCOUNT POINTER (IF NEEDED)            
*                                                                               
CLOSE    GEN,8,24 X'15',0           ADDRESS OF DCB IS STORED IN                 
         GEN,2,30 3,0                                                           
         DATA     ERRCLO                                                        
         DATA     ERRCLO                                                        
OPEN2    GEN,8,24  X'14',F:OV                                                   
         DATA      0                                                            
PRINT    GEN,8,24 1,0               FPT FOR PRINT CAL                           
         GEN,1,31 1,X'10'           MSG PRESENT, WAIT                           
         DATA     0                 STORED INTO                                 
READBI   GEN,8,24 X'10',F:BI                                                    
         GEN,2,30 3,X'10'                                                       
         DATA     ERRBI                                                         
         DATA     ERRBI                                                         
READC    GEN,8,24 X'10',F:C         FPT FOR READ FROM C DEVICE                  
         DATA     X'C0000010'       READ WITH WAIT                              
         PZE      ERRC              ERROR RETURN                                
         PZE      ERRC              ABNORMAL RETURN                             
READX1   GEN,8,24 X'10',F:X1                                                    
         GEN,2,30 3,X'10'                                                       
         DATA     ERRX1                                                         
         DATA     ERRX1                                                         
REWINDX1 GEN,8,24 1,F:X1                                                        
REWINDBI GEN,8,24 1,F:BI                                                        
TYPE     GEN,8,24 2,0               FPT FOR TYPE CAL                            
         GEN,1,31 1,X'10'           MSG PRESENT, WAIT                           
         DATA     0                                                             
WRITELL  GEN,8,24 X'11',F:LL        FPT TO WRITE LL                             
         GEN,2,30 3,X'10'                                                       
         DATA     ERRLL                                                         
         DATA     ERRLL                                                         
WRITELO  GEN,8,24    X'11',F:LO     FPT FOR WRITE LO                            
         GEN,4,28 X'F',X'10'                                                    
         DATA     ERRLO                                                         
         DATA     ERRLO                                                         
         DATA        0              BUFFER ADDRESS                              
         DATA        0              BYTE COUNT                                  
WRITEDO  EQU      WRITELO                                                       
WRITEOC  GEN,8,24 X'11',F:OC                                                    
         DATA     X'D0000010'                                                   
         DATA     ERROC                                                         
         DATA     ERROC                                                         
WROCBCT  DATA     80                BYTE COUNT TO LOG CMND TO OC                
WRITEOV  GEN,8,24 X'11',F:OV                                                    
         GEN,8,24 X'D1',X'10'                                                   
         DATA     ERROV                                                         
         DATA     ERROV                                                         
         DATA     0                 BYTE COUNT                                  
         DATA     0                 KEY ADDRESS                                 
WRITEUR  GEN,8,24 X'11',F:UR                                                    
         GEN,2,30 3,X'10'                                                       
         DATA     ERRLO                                                         
         DATA     ERRLO                                                         
WRITEX1  GEN,8,24 X'11',F:X1                                                    
         GEN,2,30 3,X'10'                                                       
         DATA     ERRX1                                                         
         DATA     ERRX1                                                         
SETX1    GEN,8,24 X'22',F:X1        SET FILE MODE FOR F:X1                      
         DATA     X'C0000000'       P1 + P2                                     
         DATA     120               RSIZE IN BYTES                              
         DATA     1                 BLOCKED FORMAT                              
         TITLE    '***** DCBS *****'                                            
*                                                                               
*                                                                               
*                                                                               
         BOUND    8                                                             
         DATA     0                 FORCE ON ODD BOUNDARY                       
F:BI     GEN,8,24 11,3                                                          
         GEN,8,7,17  3,1,BI                                                     
         DATA        INBUF1                                                     
         GEN,15,17   120,ERRBI                                                  
         DATA        ERRBI                                                      
         DATA     0,0,0,0,0,0                                                   
F:C      GEN,8,16,8 5,1,3                                                       
         GEN,15,17 1,C                                                          
         DATA      0                                                            
         GEN,15,17 120,ERRC                                                     
         DATA      ERRC                                                         
F:LL     GEN,8,16,8 5,1,X'33'       VFC, START IN BYTE 3                        
         GEN,15,17 2,LL                                                         
         DATA      0                BUFFER ADD. SET TO K:CCBUF                  
         GEN,15,17 81,ERRLL                                                     
         DATA      ERRLL                                                        
F:LO     GEN,8,16,8  5,1,3          DCB FOR LO                                  
         GEN,15,17   2,LO                                                       
         DATA        0                                                          
         GEN,15,17   133,ERRLO                                                  
         DATA        ERRLO                                                      
F:OC     GEN,8,16,8  5,0,X'33'                                                  
         GEN,15,17   2,OC                                                       
         DATA        0                                                          
         GEN,15,17   81,ERROC                                                   
         DATA        ERROC                                                      
         BOUND    8                                                             
         DATA     0                 FORCE ON ODD BOUNDARY                       
F:OV     GEN,8,24 11,1                                                          
         GEN,8,7,9,8 3,2,3,1                                                    
         DATA        0                                                          
         GEN,15,17   X'7FFF',ERROV                                              
         DATA        ERROV                                                      
         DATA     0,0,0,0,0,0                                                   
F:UR     GEN,8,24  5,3                                                          
         GEN,15,17 2,0                                                          
         DATA     MSG24A                                                        
         GEN,15,17 28,ERRLO                                                     
         DATA      ERRLO                                                        
F:X1     GEN,8,24   7,1                                                         
         GEN,8,7,9,8 3,3,3,3                                                    
         DATA        INBUF1                                                     
         GEN,15,17   120,ERRX1                                                  
         DATA        ERRX1                                                      
         TEXT     'X1      '                                                    
*                                                                               
*                                                                               
*                                   PARAMETERS, CONSTANTS, AND FLAGS            
*                                                                               
KSIGN    DATA     X'80000000'                                                   
KM8      DATA     -8                                                            
KM2      DATA     -2                                                            
K1       DATA     1                                                             
K2       DATA     2                                                             
K3       DATA     3                                                             
K4       DATA     4                                                             
K10      DATA     10                                                            
KXF      DATA     X'F'                                                          
KX1F     DATA     X'1F'                                                         
KX3F     DATA     X'3F'                                                         
KX7F     DATA     X'7F'                                                         
KXFF     DATA     X'FF'                                                         
KX7FC    DATA     X'7FC'                                                        
KXFFFF   DATA     X'FFFF'                                                       
KX1FFFF  DATA     X'1FFFF'                                                      
KX800000 DATA     X'800000'                                                     
KXFFFFFF DATA     X'FFFFFF'                                                     
BLBLBL   DATA     X'00404040'       RT JUST 3 BLANKS LEADING ZEROES             
NLBB     DATA     X'155A5A00'       NEW LINE, BANG, BANG                        
         BOUND    8                                                             
KBLANKS  DATA,8   '        '        8 BLANKS                                    
KZEROS   DATA     0,0                                                           
KOV      DATA,8   'OV      '                                                    
         BOUND    4                                                             
*                                                                               
GIOCT    DATA     0                 GETIOID CONTROL TABLE: P-BITS               
         DATA     0,0,0             DEVICE, OPLABEL, OR AREA/FILE NAME          
         DATA     0,0               FILE ACCOUNT NAME                           
*                                                                               
SCANPM   DATA     0                 CALL FOR SCAN ROUTINE-BUFFER ADD.           
SCANPMA  DATA     1                 SCAN CONVERSION TYPE: EBCDIC                
SCANPMB  DATA     0                 FIRST TIME FLAG                             
         DATA     CONTCRD           ADDRESS OF ROUTINE TO HANDLE                
*                                     CONT. CARD                                
INBUF1   RES      30                BUFFER FOR LOADING OBJECT MODULES CARDS     
*                                                                               
*                                   CONSTANTS                                   
C        EQU      1                                                             
OC       EQU      2                 OP LABEL EQU'S                              
LO       EQU      3                                                             
LL       EQU      4                                                             
CI       EQU      8                                                             
SI       EQU      9                                                             
BI       EQU      10                                                            
EXIT     EQU      1                                                             
WAIT     EQU      9                 CALL FOR WAIT                               
         TITLE    '*****   EXIT SEQUENCES  *****'                               
A08      LI,R9    MSG2              ERROR ENTRU                                 
         BAL,R8   LOGALM            GO OUTPUT 'CC ERROR IN FIELD XX'            
A08A     LW,R0    K:JCP1                                                        
         AND,R0   K2                ARE WE IN ATTEND MODE                       
         BEZ      A09B              B IF NOT ATTENDED                           
A09      RES      0                                                             
         DO       #MAP                                                          
         LI,R1    1                                                             
         CW,R1    *R9                                                           
         BANZ     A09A              B IF MSG LOGGED ON OC ALREADY               
         AI,R9    1                                                             
         STW,R9   F:OC+2            BUFFER=LAST ERR MSG                         
         LI,R1    X'30'                                                         
         STS,R1   F:OC              SKIP BANG,BANG (BTD=3)                      
         LB,R1    *R9               GET BYTE COUNT                              
         AI,R1    -2                LESS THE 'BANG, BANG'                       
         STW,R1   WROCBCT           SET BYTE COUNT IN FPT                       
         CAL1,1   WRITEOC           ERR MSG TO OC                               
A09A     RES      0                                                             
         LI,R0    0                                                             
         LI,R1    X'30'                                                         
         STS,R0   F:OC              BTD=0                                       
         LW,R0    K:CCBUF                                                       
         STW,R0   F:OC+2            BUFFER=CCBUF                                
         LI,R0    80                BYTE CT FOR CMND                            
         STW,R0   WROCBCT           SET BYTE CT IN FPT                          
         CAL1,1   WRITEOC           LOG BUM CMND ON OC                          
         FIN                        #MAP                                        
A09B     RES      0                                                             
         CAL1,9   WAIT              WAIT IF ATTENDED, ABORT IF NOT              
A03      RES      0                                                             
         CAL1,9   EXIT                                                          
         TITLE    '**** PROCESS LOAD COMMAND ****'                              
*                                                                               
*                                   JCP RELOCATING LOADER                       
*                                   LOADS A SUBSET OF SIGMA OBJECT LANG.        
*                                                                               
*                                   FIRST PROCESS LOAD CONTROL COMM.            
S01      LW,R0    K:BACKBG                                                      
         LW,R1    KX1FFFF                                                       
         STS,R0   FHRVMWO                                                       
         STW,R0   EXLOC             SET UP DEFAULTS AND INITIALIZE CELLS        
         STW,R0   EXLOC1                                                        
         STW,R0   EXLOC2                                                        
         STW,R0   S93                                                           
         LI,R0    0                                                             
         STW,R0   PASS                                                          
         STW,R0   MAP                                                           
         STW,R0   S80                                                           
         STW,R0   S81                                                           
         STW,R0   S88               CLEAR SIZE OF LARGEST OLAY                  
         STW,R0   S94                                                           
         STW,R0   OVLOAD                                                        
         STW,R0   OLDADD                                                        
         STW,R0   MSLDCB+2                                                      
         STW,R0   DCBADD                                                        
         LI,R1    11                                                            
         STB,R0   S92,R1            "LEAR TABLE OF COUNT OF OBJ. MODULES        
         BDR,R1   %-1                                                           
         STB,R0   S92                                                           
         MTB,1    S92               SET TO POINT TO FIRST ENTRY                 
         STW,R0   S92A                                                          
         LI,R0    1                                                             
         STW,R0   S97                                                           
         DO       #MAP=0                                                        
         LI,R0    X'04'             BKG, SEC                                    
         ELSE                                                                   
         LI,R0    X'44'             BKG, SEC, SMM                               
         FIN                                                                    
         STB,R0   FILEHD            SET DEFAULT TO BCKG PROG.                   
         LI,R1    3                 INIT. DCB'S                                 
         STB,R1   F:BI,R1                                                       
         LI,R0    BI                                                            
         LI,R1    1                                                             
         STH,R0   F:BI+1,R1                                                     
         LI,R0    X'0301'                                                       
         STH,R0   F:OV+1,R1                                                     
         LD,R0    KOV                                                           
         STD,R0   F:OV+5                                                        
         LW,R0    K:CCBUF                                                       
         STW,R0   SCANPM            SET CC BUFFER ADDR                          
         LI,R7    SCANPM            LOAD TABLE POINTER                          
         BAL,R8   SCAN              SKIP OVER !LOAD                             
         CI,R6    1                                                             
         BL       A08               B IF SYNTAX ERROR                           
         MTW,1    SCANPMB           FLAG: NOT AT START OF COMMAND               
S02      CI,R6    2                                                             
         BE       S06                                                           
         LI,R0    1                                                             
         STW,R0   SCANPMA           SET FOR BCD CONV.                           
         BAL,R8   SCAN              GO GET NEXT FIELD                           
         LW,R1    S04                                                           
         LI,R9    X'FFF00'                                                      
         CS,R8    S04,R1            SEARCH TABLE FOR KEYWORD                    
         BE       %+3               FOUND IT                                    
         BDR,R1   %-2                                                           
         B        A08               ERROR, BAD KEYWORD                          
         LW,R0    S05,R1                                                        
         B        *R0               GO TO PROPER PROCESSING ROUTINE             
*                                                                               
*                                   TABLE OF KEYWORDS                           
S03      DATA     0                 TEMP STORAGE                                
S04      DATA     S05-S04-1                                                     
         TEXT     'IN  '                                                        
         TEXT     'OUT '                                                        
         TEXT     'EXL '                                                        
         TEXT     'SEG '                                                        
         TEXT     'FOR '                                                        
         TEXT     'MAP '                                                        
S05      DATA     0,S05A,S05B,S05C                                              
         DATA     S05D,S05E,S05G                                                
*                                                                               
*                                                                               
S05A     RES      0                 PROCESS IN KEYWORD                          
         LI,R1    F:BI              DCB TO ASSIGN                               
         LW,R9    GIOBITS           FLAGS FOR ACCEPTABLE ASSIGNMENTS            
         B        S05AB                                                         
*                                                                               
*                                                                               
S05B     RES      0                 PROCESS OUT KEYWORD                         
         LI,R1    F:OV              DCB TO ASSIGN                               
         LW,R9    GIOFA             FLAGS FOR ACCEPTABLE ASSIGNMENTS            
*                                                                               
S05AB    RES      0                                                             
         BAL,R8   ASGNDCB                                                       
         B        S02                                                           
*                                                                               
*                                                                               
S05C     CI,R6    0                 PROCESS EXLOC KEYWORD                       
         BNE      A08               ERROR IF NOT END OF SUBFIELD                
         MTW,1    SCANPMA           SET FOR HEX                                 
         BAL,R8   SCAN              GET 'EXLOC'                                 
         CI,R6    1                                                             
         BL       A08               ERROR IF NOT END OF FIELD OR CARD           
         CW,R8    K:BACKBG                                                      
         BL       A08               ERROR, EXLOC IN RBM                         
         DO       #MAP=0                                                        
         CW,R8    K:UNAVBG                                                      
         ELSE                                                                   
         CI,R8    X'18000'                                                      
         FIN                                                                    
         BGE      A08               ERROR, 'EXLOC OUTSIDE OF CORE'              
         AND,R8   KM2               PUT ON DW BOUND.                            
         LI,R9    X'1FFFF'                                                      
         STS,R8   EXLOC                                                         
         STS,R8   FHRVMWO                                                       
         STW,R8   EXLOC1            SAVE 'EXLOC'                                
         STW,R8   EXLOC2                                                        
         STW,R8   S93                                                           
         B        S02                                                           
*                                                                               
*                                                                               
S05D     CI,R6    0                 PROCESS 'SEG' KEYWORD                       
         BNE      A08               ERROR                                       
         MTW,3    SCANPMA           SET FOR DECIMAL                             
         BAL,R8   SCAN              GET NO. OLAYS                               
         CI,R6    1                                                             
         BL       A08               ERROR                                       
         CI,R8    10                                                            
         BG       A08               ERROR IF MORE THAN 10 OVERLAYS              
         STW,R8   OVLOAD            SAVE NO. OLAYS                              
         B        S02                                                           
*                                                                               
*                                                                               
S05E     RES      0                 'FOR' KEYWORD                               
         CI,R6    1                                                             
         BL       A08               B IF NOT END OF SUBFIELD                    
         LW,R1    KSIGN                                                         
         STS,R1   FILEHD            SET FOREGROUND BIT IN HEADER                
         B        S02                                                           
S05G     CI,R6    1                 PROCESS 'MAP' KEYWORD                       
         BL       A08               ERROR                                       
         MTW,1    MAP               SET FLAG FOR MAP                            
         B        S02                                                           
*                                                                               
*                                                                               
S06      LW,R1    OVLOAD            GET NO. OF OLAYS                            
         MI,R1    11                R1=NO. WORDS NEEDED FOR OVLOAD              
         AI,R1    OVLOAD+3                                                      
         AND,R1   KM2               PUT ON DW BOUNDARY                          
         STW,R1   SYMT1             SET FWA OF SYMT1                            
         LW,R0    K:BCKEND                                                      
         STW,R0   SYMT2             SET FWA OF SYMT2                            
         LW,R1    SYMT2                                                         
         SW,R1    SYMT1                                                         
         DW,R1    K4                                                            
         STW,R1   S96               SET MAX. NO. OF SYMT ENTRIES                
         LW,R1    SYMT2                                                         
         AI,R1    -OVLOAD                                                       
         LI,R0    0                                                             
         STW,R0   OVLOAD,R1         CLEAR OVLOAD AND SYMT                       
         BDR,R1   %-1                                                           
         LI,R1    1                                                             
         LD,R8    P:END             STORE P:END AS FIRST DEF                    
         STD,R8   *SYMT1,R1                                                     
         MTW,1    *SYMT2            SET TO ONE ENTRY                            
         LI,R0    OVLOAD+1                                                      
         STW,R0   OVLOAD1           SET CURRENT OVLOAD POINTER                  
         LI,R6    BTINDEX           GET BT AREA INDEX TO GET                    
         LB,R6    MDDISCI,R6        DISC TABLE INDEX TO GET                     
         LH,R6    DISCNWPS,R6       WORDS PER SECTOR FOR THE DISC               
         SLS,R6   2                 CONVERT TO BYTES PER SECTOR                 
         LI,R1    3                                                             
         LW,R0    MAP                WAS A MAP REQUESTED                        
         BEZ      %+3               NO,LOG UNSAT. REF. ALARMS ON LL             
         LI,R0    LO                NO,LOG UNSAT. REF. ALARMS ON LO             
         B        %+2                                                           
         LI,R0    LL                                                            
         STB,R0   F:UR+1,R1         STORE OPLBS INDEX FOR UNSAT. REF. A         
         LB,R0    F:BI,R1           GET ASN                                     
         CI,R0    1                 IS BI A RAD FILE                            
         BNE      %+3               NO                                          
         MTW,1    S81               SET FLAG THAT BI IS A RAD FILE              
         B        S06B                                                          
         CAL1,1   SETX1             SET X1 RSIZE AND FORMAT                     
S06B     LD,R0    F:OV+5            GET FILE NAME FOR OUTPUT                    
         CD,R0     KOV              IS IT OV                                    
         BE        S06C             YES                                         
         CAL1,1    OPEN2            GO OPEN FILE TO GET GRANULE SIZE            
         LI,R1     3                                                            
         LB,R1     F:OV+1,R1        GET RFT INDEX                               
         LH,R6     RFT4,R1          GET GRANULE SIZE                            
         AND,R6   KXFFFF                                                        
S06C     SLS,R6    -2               CHANGE TO WORDS                             
         STW,R6   S83               SAVE IT                                     
S06F     BAL,R8   S70               GO DO HOUSEKEEPING                          
S07      BAL,R8   S55               GO READ NEXT CARD                           
S08      RES      0                                                             
S08A     AI,R1    1                 STEP INDEX                                  
S08B     CW,R1    S91               DONE WITH THIS CARD                         
         BE       S07                                                           
         LB,R2    INBUF1,R1         GET CONTROL BYTE                            
         CI,R2    X'F'                                                          
         BG       S10                                                           
         LW,R0    S99,R2                                                        
         B        *R0               ENTER PROPER REGION                         
S10      CI,R2    X'80'                                                         
         BGE      S35               LOAD RELOC. SHORT FORM                      
         CI,R2    X'13'            IS IT A 13                                   
         BE       S39              YES,GO TO SKIP OVER IT                       
         CI,R2    X'40'                                                         
         BL       S20               ERROR, ILL. CONTROL BYTE                    
         CI,R2    X'50'                                                         
         BL       S37               LOAD ABS.                                   
         BGE      S36               LOAD RELOC., LONG FORM                      
*                                                                               
*                                   GO OUTPUT 'ERR, CONTROL BYTE'               
S20      LW,R11   R2                                                            
         BAL,R7   HEXBCD                                                        
         LI,R1    1                                                             
         STH,R11  MSG22A+5,R1       STORE CONTROL BYTE IN IMAGE                 
         LI,R9    MSG22                                                         
S20A     BAL,R8   LOGALM            GO OUTPUT ALARM                             
         B        A08A                                                          
*                                                                               
S22      BAL,R8   S56               DECLARE EXT. DEF. NAME                      
         LB,R3    INBUF1,R1         GET LENGTH                                  
         BAL,R8   S75               GO PACK NAME INTO R10,R11                   
         LW,R2    *SYMT2                                                        
         BEZ      S22B              NO SYMT ENTRIES YET                         
         CD,R10   *SYMT1,R2         SEARCH SYMBOL TABLE FOR DEF                 
         BE       S22D              FOUND IT                                    
         BDR,R2   %-2                                                           
S22B     LW,R0    PASS                                                          
         BEZ      S22BB             B IF PASS1                                  
         CAL1,9   3                 ABORT (NOT FOUND IN PASS 2)                 
S22BB    MTW,1    *SYMT2             STEP NO. ENTRIES                           
         LW,R2    *SYMT2                                                        
         CW,R2    S96               HAVE WE EXCEEDED MAX. ENTRIES               
         BLE      S22C              NO                                          
S22BC    LI,R9     MSG25            YES, GO OUTPUT 'NOY ENUF BCKG. SPACE'       
         B        S20A                                                          
S22C     STD,R10  *SYMT1,R2         STORE NAME OF DEF                           
         B        S22E                                                          
S22D     LW,R0    PASS                                                          
         BNEZ     S22E              PASS 2                                      
         LW,R5    KX800000          PASS 1                                      
         LI,R4    -1                SET DUP DEF BIT                             
         LCW,R2   R2                                                            
         AW,R2    R2                DW INDEX TO WORD INDEX                      
         STS,R4   *SYMT2,R2                                                     
         B        S22BB                                                         
S22E     LI,R5    X'FFFF'           GET MASK FOR DECL NR                        
         LW,R4    S89               GET DECL. NO.                               
S22F     LCW,R2   R2                                                            
         AW,R2    R2                DW INDEX TO WORD INDEX                      
         STS,R4   *SYMT2,R2         STORE DECL. NO.                             
S22H     MTW,1    S89               STEP TO NEXT DECL. NO.                      
         B        S08                                                           
*                                                                               
S23      BAL,R8   S56               PROCESS DEC. PRIMARY REF                    
         LB,R3    INBUF1,R1         GET NAME LENGTH                             
         BAL,R8   S75               GO PACK NAME INTO R10,R11                   
         LW,R0    PASS                                                          
         BEZ      S22H              PASS 1 SO IGNORE                            
         LW,R2    *SYMT2                                                        
         CD,R10   *SYMT1,R2         SEARCH SYMT FOR DEF                         
         BE       S22E              FOUND IT                                    
         BDR,R2   %-2                                                           
         STD,R10  MSG24A+5          CAN'T FIND REF IN SYMT                      
         CAL1,1   WRITEUR           GO LOG UNSATISFIED REF ALARM                
         MTW,1    S80               SET FLAG THAT UN. REF. DURING LOAD          
         B        S22H                                                          
*                                                                               
*                                   PROCESS ORG                                 
S24      BAL,R8   S60               EVALUATE EXP.                               
         LW,R0    PASS                                                          
         BEZ      S08               IF PASS 1, IGNORE ORG ITEM                  
         LW,R0    S93A                                                          
         LW,R14   R15                                                           
         AND,R14  K3                SAVE OLD BYTE POSITION                      
         STW,R14  S93A                                                          
         SW,R14   R0                R14=DIFF. BETWEEN OLD BYTE AND NEW          
         SLS,R15  -2                CHANGE TO WORD RESOL.                       
         LW,R0    R15                                                           
         SW,R0    EXLOC2            R0= NO. WORDS SKIPPED BY ORG ITEM           
         BGEZ     %+3                                                           
         LI,R9    MSG29             GO OUTPUT 'NEG. ORG ' ALARM                 
         B        S20A                                                          
         STW,R15  EXLOC2            UPDATE CURRENT EXLOC                        
         AWM,R0   LDLOC2              AND LDLOC                                 
         SLS,R0   2                 CHANGE TO BYTES                             
        AW,R0    R14               ADD OT SUB BYTE DIFFERENCE                   
         LCW,R0   R0                                                            
         AWM,R0   S98A              UPDATE BYTES REMAINING COUNT                
         BGZ      S08               EXIT, IF DON'T HAVE TO WRITE BUFFER         
         BAL,R8   S59               GO WRITE OUT BUFFER                         
         B        S08               EXIT ORG ITEM                               
*                                                                               
S26      BAL,R8   S56               PROCESS DEFINE FIELD                        
         LB,R4    INBUF1,R1         R4=K                                        
         BAL,R8   S56                                                           
         LB,R5    INBUF1,R1         R5=L,LENGTH                                 
         CI,R5    32                                                            
         BLE      %+3                                                           
         LI,R9    MSG30             CAN'T PROCESS LENGTH>32 BITS                
         B        S20A                                                          
         BAL,R8   S60               EVALUATE EXP.                               
         LW,R0    PASS                                                          
         BEZ      S08               IGNORE ANY FURTHER IF PASS 1                
         LCW,R2   R14                                                           
         SLS,R15  0,R2              SET TO PROPER RESOLUTION                    
         LI,R0    -255                                                          
         AW,R4    R0                                                            
         LCW,R4   R4                R4=POS. AMOUNT OF SHIFT FROM BIT 31         
         LW,R9    LDLOC2            ADD. TO LOAD                                
         LW,R0    R4                                                            
         SLS,R0   -5                R0= NO. FULL WORDS TO BACK UP               
         SW,R9    R0                BACK UP TO PROPER WORD                      
         AND,R4   KX1F              MASK OFF BIT COUNT WITHIN WORD              
         LW,R2    S93A              GET BYTE WITHIN WORD                        
         SLS,R2   3                 CHANGE TO BIT NO.                           
         SW,R2    R4                R2=TRAILING BIT NO.                         
         BGZ      %+3               IN SAME WORD                                
         AI,R9    -1                BYTE 0, BACK UP ONE MORE WORD               
         AI,R2    32                CHANGE TO POS. BIT NO.                      
         SW,R2    R5                SUBTRACT OFF LENGTH                         
         BGEZ     %+3               NOT SPLIT BETWEEN WORDS                     
         LI,R9    MSG30             CAN'T HANDLE FIELD SPLIT BETWEEN WDS        
         B        S20A                                                          
         AW,R2    R5                GET BACK TRAILING BIT POSITION              
         AI,R2    -32               CHANGE TO NO. TO SHIFT                      
         LCW,R4   R2                R4=NO. TO SHIFT FROM BIT 31                 
         LW,R3    KSIGN                                                         
         LCW,R6   R5                                                            
         SAS,R3   1,R6              FORM MASK FOR LENGTH OF FIELD               
         SLS,R3   -32,R5            RT. JUSTIFY MASK                            
         AND,R15  R3                MASK OUT VALUE                              
         SLS,R15  0,R4              SHIFT VALUE PROPER AMOUNT                   
         SLS,R3   0,R4              SHIFT MASK TOO                              
         LW,R2    *R9               GET CELL TO CHANGE                          
         AW,R2    R15               ADD IN VALUE                                
         STS,R2   *R9               STORE NEW VALUE ONLY                        
         B        S08                                                           
*                                                                               
S27      BAL,R8   S56               PROCESS EXT. DEF.                           
         LB,R5    INBUF1,R1         GET FIRST BYTE OF DECL NR                   
         STW,R5   R4                                                            
         LW,R2    S89                                                           
         CI,R2    256                                                           
         BLE      S27A              BRANCH IF ONLY ONE BYTE                     
         BAL,R8   S56                                                           
         LB,R5    INBUF1,R1         GET NEXT BYTE OF DECL NR                    
         STB,R5   R4                                                            
         SCS,R4   8                 RT JUSTIFY  DECL NR IN R4                   
S27A     BAL,R8   S60               EVALUATE EXPRESSION                         
         LW,R0    PASS                                                          
         BNEZ     S08               EXIT IF PASS 2, VALUE OBTAINED IN           
         LI,R5    X'FFFF'           PASS 1                                      
         LCW,R2   *SYMT2                                                        
         AW,R2    R2                DW INDEX TO WORD INDEX                      
         CS,R4    *SYMT2,R2         SEARCH FOR DECL. NO.                        
         BE       S27B              FOUND IT                                    
         AI,R2    1                                                             
         BIR,R2   %-3                                                           
         LI,R9    MSG19                                                         
         BAL,R8   LOGALM            ILLEGAL OBJECT LANGUAGE                     
         B        A08A              QUIT                                        
S27B     AI,R2    1                                                             
         STW,R15  *SYMT2,R2         STORE VALUE OF DEF                          
         B        S08                                                           
*                                                                               
S28      LW,R0    S94A              PROCESS STND. CONTROL SECT.                 
         BEZ      S28A                                                          
         LI,R9    MSG31             OUTPUT MORE THAN 1 CONTROL SECT ALM         
         B        S20A                                                          
S28A     MTW,1    S94A              SET FLAG THAT CONT. SECT. PROCESSED         
         BAL,R8   S56                                                           
         LB,R0    INBUF1,R1         GET SIZE OF MODULE                          
         AND,R0   KXF                                                           
         STW,R0   R2                                                            
         LI,R3    2                 SET FOR NEXT 2 BYTES OF SIZE                
S28B     BAL,R8   S56                                                           
         LB,R0    INBUF1,R1                                                     
         SLS,R2   8                                                             
         AW,R2    R0                GET NEXT 2 BYTES OF SIZE                    
         BDR,R3   S28B                                                          
         AI,R2    7                 ROUND SIZE UP TO NEXT DW BOUNDARY           
         AND,R2   KM8                                                           
         AWM,R2   S94               ADD TO ACCUM. BYTE COUNT                    
         B        S08                                                           
*                                                                               
S29      LW,R0    S94A              PROCESS NON STND. CNTRL SECT.               
         BEZ      %+3                                                           
         LI,R9    MSG31             OUTPUT MORE THAN 1 CONTROL SECT ALM         
         B        S20A                                                          
         LW,R0    S89                                                           
         STW,R0   S95               SET DECL. NO. FOR NON STND. CTRL            
         MTW,1    S89               STEP DECL. NO.                              
         B        S28A                                                          
*                                                                               
S30      BAL,R8   S60               PROCESS START ITEM                          
         LW,R0    PASS                                                          
         BNEZ     S08               DON'T SAVE IF PASS 2                        
         SLS,R15  -2                CHANGE TO WA                                
         LW,R0    *OVLOAD1          IS THIS THE ROOT                            
         BNEZ     %+5               BRANCH IF NOT                               
         LW,R14   R15                                                           
         LW,R15   KX1FFFF                                                       
         STS,R14  FHENTRY           SET ENTRY ADDR IN  HEADER                   
         B        S08                                                           
         LI,R2    10                                                            
         STW,R14  *OVLOAD1,R2       SAVE ENTRY ADDRESS IN OVLOAD                
         B        S08                                                           
*                                                                               
S31      BAL,R8   S56               PROCESS REPEAT LOAD                         
*        MUST BE REPEAT OF LOAD ABSOLUTE 1-BYTE ZERO                            
         LB,R2    INBUF1,R1                                                     
         BAL,R8   S56                                                           
         LB,R0    INBUF1,R1                                                     
         SLS,R2   8                 R2=REPEAT COUNT                             
         AW,R2    R0                                                            
         BAL,R8   S56               GET NEXT BYTE                               
         LB,R3    INBUF1,R1                                                     
         CI,R3    X'41'                                                         
         BNE      S33               B IF NOT LOAD ABS 1 BYTE                    
         BAL,R8   S56               GET NEXT BYTE                               
         LB,R4    INBUF1,R1                                                     
         BNEZ     S33               B IF BYTE TO LOAD IS NOT ZERO               
         MTW,0    PASS                                                          
         BEZ      S08               B IF PASS 1. DONT LOAD NOW                  
S31B     LW,R5    S93A              GET BYTE IN WORD TO LOAD NEXT               
S31D     STB,R4   *LDLOC2,R5                                                    
         MTW,-1   S98A              DECR BYTES REMAINING IN BUF                 
         BEZ      S31F              B IF NO MORE SPACE                          
         AI,R5    1                                                             
         BDR,R2   S31D              B TO LOAD NEXT BYTE                         
S31F     DW,R4    K4                CONVERT BYTES TO WORDS AND                  
*        EXCESS BYTES                                                           
         AWM,R5   EXLOC2            UPDATE EXECUTION LOC                        
         AWM,R5   LDLOC2            UPDATE LOAD LOC (IN BUF)                    
         STW,R4   S93A              UPDATE BYTE IN WORD TO LOAD                 
         MTW,0    S98A                                                          
         BGZ      S08               B IF NO NEED TO WRITE BUF                   
         BAL,R8   S59               WRITE BUFFER TO LM FILE                     
         BDR,R2   S31B              B IF NOT DONE WITH REPEAT                   
         B        S08                                                           
S33      LI,R2    X'0F'             REPEAT LOAD CONTROL BYTE                    
         B        S20               MESSAGE: ILLEGAL CONTROL BYTE               
*                                                                               
*                                   PROCESS LOAD RELOC. SHORT FORM              
S35      CI,R2    X'C0'                                                         
         BGE      S35L              IF REL. TO FWD REF,BYPASS                   
         AND,R2   KX3F              GET DECL. NO.                               
S35A     LI,R4    -2                SET TO WORD RESOLUTION                      
S35B     LW,R0    PASS                                                          
         BNEZ     S35C              PASS 2, SO DO ACTUAL LOAD                   
         LI,R2    4                                                             
         BAL,R8   S56               PASS 1, IGNORE LOAD ITEM                    
         BDR,R2   %-1                                                           
         B        S08                                                           
S35C     CI,R2    0                                                             
         BE       S35J              STND. CTRL SECT                             
         CW,R2    S95                                                           
         BE       S35J              NON STND CTRL SECT                          
         LI,R3    X'FFFF'                                                       
         LCW,R5   *SYMT2                                                        
         AW,R5    R5                DW   INDEX TO WORD INDEX                    
         CS,R2    *SYMT2,R5         SEARCH FOR DECL. NO.                        
         BE       S35CC             FOUND IT                                    
         AI,R5    1                                                             
         BIR,R5   %-3                                                           
         LI,R9    0                 IF CAN'T FIND DECL. USE ZERO                
         B        S35D                                                          
S35CC    AI,R5    1                                                             
         LW,R9    *SYMT2,R5         GET VALUE OF DECL.                          
S35D     SLS,R9   0,R4              CHANGE TO PROPER RESOL.                     
         LI,R3    0                                                             
S35F     BAL,R8   S56                                                           
         LB,R0    INBUF1,R1                                                     
         STB,R0   R10,R3            GET WORD TO LOAD                            
         AI,R3    1                                                             
         CI,R3    4                                                             
         BL       S35F              PACK 4 BYTES                                
         LW,R2    R10                YES, CHECK FOR FIELD OVERFLOW              
         AW,R2    R9                                                            
         LI,R3    X'7FFFF'          GET MASK                                    
         SLS,R3   0,R4              LINE UP MASK RIGHT                          
         STS,R2   R10                                                           
         LCW,R3   S93A              ARE WE ON BYTE 0                            
         BEZ      S35H              YES                                         
         LI,R0    0                 NO                                          
         STW,R0   S93A              RESET TO BYTE 0                             
         MTW,1    EXLOC2            STEP CURRENT LOAD, EXEC. LOC.               
         MTW,1    LDLOC2               COUNTERS                                 
         CI,R3    -2                                                            
         BE       %+2                                                           
         EOR,R3   K2                CHANGE TO BYTES SKIPPED                     
         AWM,R3   S98A              REDUCE BYTE COUNT REMAINING                 
S35H     STW,R10  *LDLOC2           STORE WORD                                  
         MTW,1    EXLOC2            STEP EXEC. AND LOAD LOC. COUNTERS           
         MTW,1    LDLOC2                                                        
         MTW,-4   S98A              REDUCE BYTE COUNT REMAINING                 
         BGZ      S08               NOT FILLED BUFFER YET                       
         BAL,R8   S59               GO WRITE OUT BUFFER                         
         B        S08                                                           
S35J     LW,R9    S93               GET RELOCATION BIAS                         
         SLS,R9   2                 CHANGE TO BYTE ADD.                         
         B        S35D                                                          
S35L     LI,R2    0                 SET SO DO STANDARD RELOC.                   
         B        S35A                                                          
*                                                                               
*                                   PROCESS LOAD RELOC. LONG FORM               
S36      AND,R2   KXF                                                           
         CI,R2    4                                                             
         BANZ     S36C              BYPASS IF REL TO FWD REF                    
         BAL,R8   S56                                                           
         LB,R4    INBUF1,R1         GET FIRST BYTE OF DECL NR                   
         STW,R4   R5                                                            
         CI,R2    8                                                             
         BANZ     S36B              BRANCH IF ONLY ONE BYTE                     
         BAL,R8   S56                                                           
         LB,R4    INBUF1,R1         GET NEXT BYTE OF DECL NR                    
         STB,R4   R5                                                            
         SCS,R5   8                 RT JUSTIFY  DECL NR IN R5                   
S36B     AND,R2   K3                                                            
         LCW,R4   R2                SAVE RESOL. IN R4 AS A SHIFT FACTOR         
         LW,R2    R5                DECL NR INTO R2                             
         B        S35B                                                          
S36C     BAL,R8   S56               PASS OVER DECL.                             
         CI,R2    8                                                             
         BANZ     S35L              BRANCH IF ONE BYTE DECL NR                  
         BAL,R8   S56                                                           
         B        S35L                                                          
*                                                                               
S37      AND,R2   KXF               PROCESS LOAD ABSOLUTE                       
         BNEZ     %+2               GET NO. BYTES                               
         AI,R2    16                                                            
         LW,R9    R2                                                            
         LW,R3    S93A              GET NEXT BYTE WITHIN WORD TO STORE          
         AW,R9    R3                                                            
S37B     BAL,R8   S56                                                           
         LB,R0    INBUF1,R1                                                     
         MTW,0    PASS                                                          
         BEZ      %+2               IF PASS 1, DON'T STORE                      
         STB,R0   *LDLOC2,R3        STORE BYTES                                 
         AI,R3    1                                                             
         MTW,-1   S98A              REDUCE NO. BYTES LEFT BY ONE                
         BDR,R2   S37B                                                          
         LW,R0    PASS                                                          
         BEZ      S08               EXIT IF PASS 1                              
         AND,R3   K3                MASK OFF NEXT BYTE TO STORE                 
         STW,R3   S93A              STORE NEXT BYTE TO STORE                    
         SLS,R9   -2                                                            
         AWM,R9   EXLOC2                                                        
         AWM,R9   LDLOC2            UP EXEC., LOAD LOC. COUNTERS                
         LW,R0    S98A              IS BUFFER FILLED                            
         BGZ      S08               NO                                          
         BAL,R8   S59               YES, GO WRITE IT OUT                        
         B        S08               EXIT LOAD ABS.                              
*                                   PROCESS END ITEM                            
S38      BAL,R8   S56               PASS OVER SEVERITY LEVEL                    
         LW,R0    S94               GET NO. BYTES IN SEGMENT                    
         SLS,R0   -2                                                            
         AW,R0    EXLOC1            SEE IF ANY RES AT END                       
         STW,R0   S93               SET NEXT RELOCATION BIAS                    
         LB,R1    S92               SET R1 TO S92 ENGRY                         
         MTW,0    PASS                                                          
         BNEZ     %+3               PASS 2                                      
         MTB,1    S92,R1            STEP COUNT OF OBJ. MODULES                  
         B        S06F              GO READ NEXT OBJ. MODULE                    
         SW,R0    EXLOC2            R0= AMOUNT OF RES, IF ANY                   
         AWM,R0   LDLOC2            UP LDLOC BY RES AMOUNT                      
         AWM,R0   EXLOC2                                                        
         SLS,R0   2                                                             
         LCW,R0   R0                                                            
         AWM,R0   S98A              REDUCE BYTES REMAINING                      
         BGZ      %+2                                                           
         BAL,R8   S59               GO WRITE OUT WHAT WE HAVE                   
         MTW,1    S92A              STEP COUNT OF OBJ. MOD. FOR THIS SEG        
         LW,R0    S92A                                                          
         CB,R0    S92,R1            IS THIS LAST OBJ. MODULE                    
         BNE      S06F              NO                                          
         B        S40               YES, GO TO EOD PROCESSING                   
*                                  SKIP OVER TYPE 13                            
S39      BAL,R8   S56              GET LENGTH OF NAME                           
         LB,R3    INBUF1,R1        GET LENGTH                                   
         BAL,R8   S56              SKIP OVER NAME                               
         BDR,R3   %-1                                                           
         BAL,R8   S56              SKIP OVER FWD. REF. DECL NO.                 
         BAL,R8   S56                                                           
         B        S08                                                           
*                                                                               
*                                   PROCESS EOD CARD                            
S40      MTB,1    S92               STEP POINTER TO NEXT ENTRY                  
         LW,R0    PASS                                                          
         BNEZ     S45               PASS 2                                      
         LW,R0    *OVLOAD1          IS THIS THE ROOT, PASS 1                    
         BNEZ     S42               NO                                          
         STW,R0   DCBTAB            YES, HOUSEKEEP DCBTAB                       
         LI,R2    DCBTAB                                                        
         LW,R8    S94               YES, R8= BYTE SIZE OF ROOT                  
         LW,R9    S94                                                           
         SLS,R9   -2                R9= WORD SIZE OF ROOT                       
         LW,R0    EXLOC                                                         
         AND,R0   KX1FFFF           GET EXEC. FWA                               
         AW,R9    R0                R9= ADD. OF M:SL DCB                        
         LW,R0    OVLOAD            ARE THERE OVERLAYS                          
         BEZ      S41               NO                                          
         STW,R9   MSLDCB+2          SAVE ADD. OF M:SL DCB                       
         AI,R8    44                ADD M:SL  TO ROOT BYTE LGTH                 
         AI,R9    11                ADD M:SL TO NEXT LOAD ADDR                  
         MTW,1    DCBTAB            SET FOR AT LEAST M:SL DCB ENTRY             
         LD,R4    MSLDCB                                                        
         STW,R4   1,R2              MOVE M:SL DCB AS FIRST ENTRY IN             
         STW,R5   2,R2                DCBTAB                                    
         LW,R0    MSLDCB+2                                                      
         STW,R0   3,R2                                                          
         AI,R2    3                 STEP TO NEXT ENTRY                          
*                                                                               
*                                   BUILD DCBTAB                                
S41      LW,R3    *SYMT2                                                        
         BEZ      S41D              NO DCB'S, EXCEPT MAYBE M:SL                 
S41A     LD,R4    *SYMT1,R3         GET DEF NAME                                
         LH,R0    R4                                                            
         CI,R0    X'FD47A'          IS IT M:                                    
         BE       S41M              YES                                         
         CI,R0    X'FC67A'          NO, IS IT F:                                
         BE       S41M              YES                                         
S41C     BDR,R3   S41A              NO, GET NEXT ENTRY                          
S41D     STW,R3   1,R2              ZERO OUT FIRST PUB LIB ENTRY                
         STW,R3   2,R2                                                          
         LW,R3    DCBTAB            DONE, GET NO. DCB'S                         
         BEZ      S41F              NONE                                        
         MI,R3    3                                                             
         AI,R3    1                 R3=NO. WORDS NEEDED FOR DCBTAB              
         STW,R9   DCBADD            STORE FWA OF DCBTAB                         
         AW,R9    R3                R9=NEXT FWA                                 
         SLS,R3   2                                                             
         AW,R8    R3                UP BYTE COUNT OF ROOT BY SIZE OF DCB        
S41F     LW,R3    OVLOAD            ARE THERE OVERLAYS                          
         BEZ      S41H              NO                                          
         STW,R9   OLDADD            YES, SAVE FWA OF OVLOAD TABLE               
         MI,R3    11                                                            
         AI,R3    1                                                             
         AW,R9    R3                GET END OF ROOT                             
         SLS,R3   2                                                             
         AW,R8    R3                UP BYTE SIZE OF ROOT                        
S41H     STW,R9   FHRTSCD           RBM TEMP STACK FWA                          
         MTW,-1   FHRTSCD           FWA-1                                       
         LH,R3    FHRTSCD+1         RTS SIZE                                    
         AW,R9    R3                ADD RTS SIZE INT ROOT LWA                   
         SLS,R3   2                 WL TO BL                                    
         AW,R8    R3                ADD RTS BL INTO ROOT BL                     
         AI,R8    7                 EXTEND TO DW                                
         AI,R9    1                                                             
         AND,R8   KM8                                                           
         AND,R9   KM2                                                           
         STW,R9   EXLOC1                                                        
         STW,R9   EXLOC2            STORE FWA OF OLAYS                          
         STW,R9   S93               SET FOR NEXT RELOCATION BIAS                
         LW,R9    KXFFFFFF                                                      
         STS,R8   FHRLMBL           ROOT LM BL INTO HEADER                      
S41K     LW,R3    R8                                                            
         SLS,R3   -2                R3=WORD SIZE OF MODULE                      
         LI,R2    0                                                             
         DW,R2    S83               GET NO. GRANULES FOR MODULE                 
         CI,R2    0                                                             
         BE       %+2                                                           
         AI,R3    1                                                             
         AWM,R3   S97               STORE NEXT GRANULE TO USE                   
         LW,R0    *OVLOAD1          GET SEG ID                                  
         AND,R0   KXFFFF                                                        
         AI,R0    1                 STEP TO NEXT SEGMENT                        
         CW,R0    OVLOAD            ARE WE DONE WITH PASS 1                     
         BG       S43               YES                                         
         CI,R0    1                 IS THIS END OF ROOT                         
         BE       %+3               YES                                         
         LI,R1    11                                                            
         AWM,R1   OVLOAD1           SET TO NEXT OVLOAD ENTRY                    
         STW,R0   *OVLOAD1          SET SEG. ID                                 
         LI,R0    0                                                             
         STW,R0   S94               CLEAR SIZE OF SEGMENT                       
         B        S07               GO READ NEXT MODULE                         
S41M     MTW,1    DCBTAB            STEP NO. DCB'S                              
         LW,R0    DCBTAB                                                        
         CI,R0    25                HAVE WE REACHED THE MAX                     
         BL       S41P              NO                                          
         LI,R9    MSG26             YES                                         
         BAL,R8   LOGALM            GO OUPUT ALARM                              
         MTW,-1   DCBTAB            SET BACK TO WHERE IT WAD                    
         LI,R3    0                                                             
         B        S41D                                                          
S41P     STW,R4   1,R2                                                          
         STW,R5   2,R2              STORE DCB NAME                              
         LCW,R3   R3                                                            
         SAS,R3   1                 DW INDEX TO WORD INDEX                      
         AI,R3    1                 POINT TO VALUE FIELD                        
         LW,R0    *SYMT2,R3         GET ADD. OF DCB                             
         AI,R3    -1                                                            
         SAS,R3   -1                RESTORE R3                                  
         LCW,R3   R3                                                            
         AND,R0   KX1FFFF                                                       
         SLS,R0   -2                CHANGE TO WA                                
         STW,R0   3,R2              STORE ADD. OF DCB                           
         AI,R2    3                                                             
         B        S41C                                                          
*                                                                               
*                                   SET UP OVLOAD                               
S42      LW,R1    OVLOAD1                                                       
         LW,R0    MSLDCB+2          GET ADD. OF M:SL DCB                        
         AW,R0    S84                                                           
         STW,R0   1,1                                                           
         LW,R0    EXLOC1                                                        
         STW,R0   5,R1              STORE BUFFER ADD.                           
         STW,R0   S93               SET RELOCATION BIAS                         
         LW,R8    S94                                                           
         LW,R9    R8                                                            
         AI,R8    X'7FF'            EXTEND TO PAGE END                          
         SLS,R8   -11               BL TO PL                                    
         STH,R8   *R1               STORE INTO OVLOAD                           
         LI,R8    0                 NO SEGMENT FLAGS SET                        
         STB,R8   *R1               IN OVLOAD ENTRY                             
         LW,R8    R9                RESTORE BL OF SEGMENT                       
         STW,R8   6,R1              STORE BYTE COUNT                            
         CW,R8    S88               SAVE SIZE OF LARGEST OLAY                   
         BLE      %+2                                                           
         STW,R8   S88                                                           
         LW,R0    S97                                                           
         STW,R0   7,R1              SET KEY ADDRESS                             
         B        S41K                                                          
*                                                                               
*                                   FINISH UP PASS 1                            
S43      MTW,1    PASS              SET TO PASS 2                               
         LI,R0    1                                                             
         STB,R0   S92               RESET POINTER FOR PASS 2                    
         LW,R1    KXFFFFFF                                                      
         LW,R0    FHRLMBL           ROOT BL                                     
         AW,R0    S88               LONGEST SEG BL                              
         DO       #MAP~=0                                                       
*        MEMORY MANAGEMENT WILL BE BASED ON TWO SEGMENTS:                       
*                 1)  THE ROOT, HERE EXTENDED TO CONTAIN THE                    
*                 LONGEST PATH OF THE PROGRAM.   USER-DEFINED                   
*                 SEGMENTS MAY BE SEGLOADED WITHIN THIS.                        
*                                                                               
*                 2)  THE REST OF BACKGROUND MEMORY, WHICH IS                   
*                 SUPPLIED AS A SEGMENT BY TASK INITIATION                      
*                 FOR USE AS SCRATCH SPACE.                                     
         FIN                                                                    
         STS,R0   FHRVMBL           SET ROOT MEM SIZE TO LONGEST PATH BL        
         LW,R2    FHFWA             ROOT ORIGIN                                 
         AND,R2   R1                                                            
         SLS,R2   2                 WA TO BA                                    
         AW,R0    R2                (R0)=END OF PATH BA + 1                     
         LI,R2    -1                                                            
         STW,R0   *SYMT2,R2         P:END VALUE                                 
         AI,R0    -1                                                            
         SLS,R0   -2                BA TO WA                                    
         STS,R0   FHLWA             STORE LWA IN HEADER                         
         LW,R0    EXLOC                                                         
         AND,R0   KX1FFFF                                                       
         STW,R0   EXLOC1            RESET EXLOC'S                               
         STW,R0   EXLOC2                                                        
         STW,R0   S93               RESET RELOCATION BIAS                       
         LI,R0    FILEHD            SET UP TO WRITE FILE HEADER                 
         STW,R0   F:OV+2            STORE BUF. ADD.                             
         LI,R0    100                                                           
         STW,R0   WRITEOV+4         MAXIMUM HEADER SIZE IN BYTES                
         LI,R1    0                                                             
         STW,R1   WRITEOV+5         SET TO GRANULE ZERO                         
         CAL1,1   WRITEOV           GO WRITE FILE HEADER                        
         LW,R0    *SYMT2                                                        
         AI,R0    1                                                             
         SLS,R0   1                 GET LWA OF SYMBOL TABLE                     
         AW,R0    SYMT1                                                         
         STW,R0   LDLOC1            SET LOAD LOC. COUNTERS                      
         STW,R0   LDLOC2                                                        
         STW,R0   F:OV+2            STORE FWA OF OUTPUT BUFFER                  
         LCW,R1   *SYMT2            GET LWA OF LOAD AREA                        
         AW,R1    R1                DW INDEX TO WORD INDEX                      
         AI,R1    -13               LEAVE 12 EXTRA WORDS                        
         AW,R1    SYMT2                                                         
         SW,R1    LDLOC1                                                        
         DW,R1    S83               GET MAX. NO. GRANULES                       
         BEZ       S22BC            NOT ENUF ROOM FOR 1 GRANULE EVEN            
         STW,R1   S98B              SAVE NO. GRANULES TO WRITE EACH TIME        
         MW,R1    S83                                                           
         AI,R1    8                 LOAD 8 EXTRA WORDS EACH TIME                
         SLS,R1   2                                                             
         STW,R1   S98               STORE NO. BYTES TO LOAD BEFORE              
         STW,R1   S98A                 WRITING RAD                              
         LI,R0    OVLOAD+1                                                      
         STW,R0   OVLOAD1           RESET TO FIRST ENTRY                        
         MTW,1    WRITEOV+5         SET TO GRANULE ONE                          
         LW,R0    S81               IS BI A RAD FILE                            
         BEZ      %+3               NO                                          
         CAL1,1   REWINDBI          YES, DON'T USE X1                           
         B        %+2                                                           
         CAL1,1   REWINDX1          REWIND X1                                   
         LI,R0    0                                                             
         STW,R0   S94               CLEAR SIZE OF SEGMENT                       
         B        S07               GO READ NEXT MODULE                         
*                                                                               
*                                                                               
S45      LI,R0    0                                                             
         STW,R0   S92A              CLEAR NO. OBJ. MODULES READ                 
         LW,R0    EXLOC                                                         
         AND,R0   KX1FFFF           MASK OUT                                    
         CW,R0    EXLOC1            DID WE JUST LOAD THE ROOT                   
         BNE      S46               NO, AN OVERLAY                              
         LW,R0    MSLDCB+2          YES, IS THERE AN M:SL DCB                   
         BEZ      S45D              NO                                          
         LI,R0    11                DCB SIZE IN WORDS                           
         STB,R0   *LDLOC2           SET IN DCB                                  
         AWM,R0   LDLOC2            ADJUST LOAD LOCATION                        
         LI,R0    -44                                                           
         AWM,R0   S98A              REDUCE NO. BYTES REMAINING                  
         BGZ      S45D                                                          
         BAL,R8   S59               GO WRITE OUT LOAD AREA                      
S45D     LW,R1    DCBTAB            IS THERE A DCBTAB                           
         BEZ      S45J              NO                                          
         LI,R2    DCBTAB+1          SET TO MOVE DCBTAB                          
         STW,R1   *LDLOC2           YES, MOVE IT TO ROOT                        
S45E     MTW,1    LDLOC2            MOVE FIRST WORD                             
         MTW,-4   S98A                                                          
S45F     LI,R3    3                                                             
S45G     LW,R0    0,R2                                                          
         STW,R0   *LDLOC2           MOVE EITHER DCBTAB OR OVLOAD                
         AI,R2    1                                                             
         MTW,1    LDLOC2                                                        
         BDR,R3   S45G              MOVE 3 WORDS AT A TIME                      
         LI,R0    -12               REDUCE REMAINING BYTES                      
         AWM,R0   S98A                                                          
         BGZ      %+2               NOT TIME TO OUTPUT                          
         BAL,R8   S59               OUTPUT LOAD AREA TO RAD                     
         BDR,R1   S45F              GO MOVE NEXT GROUP                          
         CI,R2    OVLOAD            DID WE MOVE OVLOAD                          
         BGE      S46               YES, DONE                                   
S45J     LW,R1    OVLOAD            NO, IS THERE AN OVLOAD                      
         BEZ      S46               NO, DONE                                    
         STW,R1   *LDLOC2           YES, STORE WORD 1                           
         MI,R1    11                                                            
         DW,R1    K3                GET NO. OF 3 WORD ENTRIES IN OVLOAD         
         AI,R1    1                 ROUND UP                                    
         LI,R2    OVLOAD+1          SET TO MOVE OVLOAD                          
         B        S45E              GO MOVE OVLOAD                              
*                                                                               
*                                   DO CLEANUP FOR ROOT AND OVERLAYS            
S46      BAL,R8   S59               GO WRITE REST OF ROOT OR OVERLAY            
         LW,R0    OVLOAD            ARE THERE OVERLAYS                          
         BEZ      S49               NO, GO DO MAP                               
         LW,R0    EXLOC                                                         
         AND,R0   KX1FFFF                                                       
         CW,R0    EXLOC1            DID WE JUST LOAD THE ROOT                   
         BE       S46B              YES                                         
         LW,R1    OVLOAD1           NO                                          
         AI,R1    -11               BACK UP 1 OVLOAD ENTRY                      
         LW,R0    0,R1                                                          
         AND,R0   KXFFFF                                                        
         CW,R0    OVLOAD            ARE WE DONE                                 
         BGE      S49               YES, GO DO MAP                              
S46B     LW,R1    OVLOAD1           NO                                          
         LW,R0    5,R1              GET EXLOC ADDRESS                           
         STW,R0   EXLOC1            STORE NEW EXLOC                             
         STW,R0   EXLOC2                                                        
         STW,R0   S93               SET NEW RELOCATION BIAS                     
         LW,R0    7,R1                                                          
         STW,R0   WRITEOV+5         STORE KEY ADDRESS                           
         AI,R1    11                                                            
         STW,R1   OVLOAD1           STEP TO NEXT OVLOAD ENTRY                   
         BAL,R8   S70               GO DO HOUSEKEEPING                          
         LI,R0    0                                                             
         STW,R0   S94               CLEAR SIZE OF SEGMENT                       
         B        S07               GO GET NEXT OBJ. MODULE                     
*                                                                               
*                                   OUTPUT MAP AND CLOSE FILES                  
S49      LI,R1    X'1FFFF'                                                      
         LI,R0     F:OV             CLOSE OUT FILES                             
         STS,R0   CLOSE                                                         
         CAL1,1    CLOSE            GO CLOSE OV                                 
         LI,R0     F:BI                                                         
         STS,R0   CLOSE                                                         
         CAL1,1    CLOSE            GO CLOSE BI                                 
S49C     LW,R0    S80               WAS THERE UNSAT. REF'S DURING LOAD          
         BEZ      %+3               NO                                          
         LI,R9    MSG28                                                         
         BAL,R8   LOGALM            GO OUTPUT ON OC 'UNSAT. RAF. ALARM          
         LW,R0    MAP               WAS A MAP REQUESTED                         
         BNEZ     S79               YES, GO OUTPUT MAP                          
         B        A03               NO, EXIT THIS FUNCTION                      
*                                                                               
*                                                                               
*                                   SBR TO READ NEXT CARD                       
S55      STW,R8   S55L                                                          
S55A     LW,R0    PASS                                                          
         BNEZ     S55AC             PASS 2                                      
         CAL1,1   READBI            PASS 1, READ FROM BI                        
         LW,R0    F:BI+4            GET ACTUAL REC. SIZE                        
         SLS,R0   -17                                                           
         CI,R0    120               WAS 120 BYTES READ                          
         BE       S55AB             READ OK                                     
         LW,R0    INBUF1            GET FIRST WORD READ                         
         CW,R0    S82               IS IT AN EOD                                
         BE       S40               YES,GO TO PROCESS                           
         LI,R9    MSG27             NO,GO OUTPUT ILL. BINARY CARD               
         B        S55C                                                          
S55AB    LW,R0    S81               IS BI A RAD FILE                            
         BNEZ     S55AE             YES, DON'T WRITE X1                         
         CAL1,1   WRITEX1           COPY CARD ON X1                             
         B        S55AE                                                         
S55AC    LW,R0    S81               IS BI A RAD FILE                            
         BEZ      %+3               NO                                          
         CAL1,1   READBI            YES, TAKE PASS 2 FROM BI                    
         B        S55AE                                                         
         CAL1,1   READX1            TAKE PASS 2 FROM X1                         
S55AE    LW,R2    INBUF1                                                        
         AND,R2   KXFF                                                          
         BEZ      S55BE                                                         
         STW,R2   S91               SAVE RECORD SIZE                            
         AI,R2    -1                SET FOR CKSM                                
         LI,R3    0                                                             
S55B     LB,R0    INBUF1,R2                                                     
         AW,R3    R0                COMPUTE CKSM                                
         BDR,R2   S55B                                                          
         CI,R2    -1                                                            
         BNE      S55B               GO BACK FOR LAST BYTE                      
         LI,R1    2                                                             
         LB,R0    INBUF1,R1         GET CKSM FROM CARD                          
         SLS,R0   1                 MULT. BY 2                                  
         LI,R1    X'FF'                                                         
         CS,R0    R3                IS CKSM OK                                  
         BE       S55E              YES                                         
S55BE    LI,R9    MSG20             TYPE 'BI CKSM ERR'                          
S55C     BAL,R8   LOGALM            GO OUTPUT ALARM                             
         CAL1,9   WAIT              GO WAIT FOR RESPONSE                        
         B        S55A                                                          
S55E     LI,R1    1                                                             
         LB,R0    INBUF1,R1         IS SEQ. NO OK                               
         LI,R1    X'FF'                                                         
         CS,R0    S90                                                           
         BE       S55G              YES                                         
         LI,R9    MSG21             NO, TYPE 'BI SEQ ERR'                       
         B        S55C                                                          
S55G     MTW,1    S90               STEP SEQ. NO.                               
         LI,R1    3                 SET INDEX TO PROCESS CARD                   
         B        *%+1              EXIT                                        
S55L     DATA     0                                                             
*                                                                               
*                                                                               
S56      AI,R1    1                 SBR TO GET NEXT BYTE                        
         CW,R1    S91               IS THIS LAST BYTE                           
         BNE      *R8               NO                                          
         LCFI     14                SET TO SAVE 14 REGS                         
         STM,R2   S56C              SAVE REGS                                   
         BAL,R8   S55               READ NEXT CARD                              
         LCFI     14                                                            
         LM,R2    S56C                                                          
         B        S56                                                           
S56C     RES      14                                                            
*                                                                               
*                                                                               
*                                   SBR TO WRITE RAD                            
S59      STW,R8   S59Z              SAVE EXIT                                   
         LI,R0    0                 HOUSEKEEP TO ZERO                           
         STW,R0   S59Y                                                          
         LW,R0    WRITEOV+5                                                     
         CI,R0    1                 IS THIS THE FIRST GRANULE OF ROOT           
         BNE      S59B              NO                                          
         LW,R7    LDLOC1            YES                                         
         LW,R0    OLDADD                                                        
         STW,R0   2,R7              STORE OVLOAD, MSLADD, AND DCBADD            
         LW,R0    MSLDCB+2            IN PCB                                    
         STW,R0   5,R7                                                          
         LW,R0    FHENTRY                                                       
         AND,R0   KX1FFFF                                                       
         STW,R0   6,R7              PUT TASK ENTRY ADDR IN PCB                  
         LW,R0    DCBADD                                                        
         STW,R0   10,R7                                                         
S59B     LCW,R7   S98A              GET NO. BYTES LEFT TO LOAD                  
         BGEZ     S59C              IS IT LESS THAN A FULL BUFFER, NO           
         AW,R7    S98               YES, GET NO. BYTES ACTUALLY LOADED          
         BEZ      *S59Z             EXIT IF ZERO BYTE COUNT                     
         B        S59D                                                          
S59C     LW,R7    S98B              GET NO. GRANULES TO WRITE                   
         MW,R7    S83               CHANGE TO NO. WORDS                         
         STW,R7   S59Y              SAVE NO WORDS IN GRANULE BUFFER             
         SLS,R7   2                 CHANGE TO BYTES                             
S59D     STW,R7   WRITEOV+4         STORE BYTE COUNT                            
S59E     CAL1,1   WRITEOV           GO WRITE OV                                 
         LW,R0    S98B                                                          
         AWM,R0   WRITEOV+5         UPDATE GRANULE NO.                          
         LW,R8    LDLOC1                                                        
         AW,R8    S59Y              R8=END OF GRANULE BUFFER                    
         LI,R7    11                                                            
         LW,R0    *R8,R7            MOVE 12 WORDS FROM PAST END OF              
         STW,R0   *LDLOC1,R7          BUFFER TO TOP OF BUFFER                   
         BDR,R7   %-2                                                           
         LW,R0    *R8                                                           
         STW,R0   *LDLOC1                                                       
         LW,R8    S59Y                                                          
         SLS,R8   2                                                             
         CW,R8    WRITEOV+4         IS THIS LAST TIME CASE                      
         BNE      S59H              YES, EXIT                                   
         AWM,R8   S98A              NO, UPDATE NO. BYTES REMAINING              
         BLZ      S59E              STILL NEG., MUST BE A BIG RES               
         LW,R8    S98               DONE WITH THIS WRITE                        
         SW,R8    S98A              GET NEW LDLOC2                              
         LW,R0    R8                                                            
         AND,R0   K3                GET NEXT BYTE WITHIN WORD TO LOAD           
         STW,R0   S93A              SAVE IT                                     
         SLS,R8   -2                CHANGE TO WA                                
         AW,R8    LDLOC1                                                        
         STW,R8   LDLOC2            SET CURRENT LOAD LOC.                       
         B        *S59Z             EXIT                                        
S59H     LW,R0    LDLOC1                                                        
         STW,R0   LDLOC2            SET LDLOC2 BACK TO START                    
         LW,R0    S98                                                           
         STW,R0   S98A              SET BYTES REMAINING TO MAX.                 
         B        *S59Z                                                         
*                                                                               
S59Y     DATA     0                 NO. WORDS IN GRANULE BUFFER                 
S59Z     DATA     0                 EXIT                                        
*                                                                               
*                                                                               
*                                   EVALUATE EXPRESSION SBR                     
*                                   CALL BAL,R8  S60                            
*                                                                               
*                                   RETURNS                                     
*                                     R14=RESOLUTION                            
*                                     R15=VALUE                                 
*                                   USES R0-R3,R8-R10,R13-R15                   
*                                                                               
*                                                                               
S60      STW,R8   S68               SAVE RETURN                                 
         LI,R14   -1                                                            
         LI,R15   0                                                             
S60A     BAL,R8   S56                                                           
         LB,R2    INBUF1,R1         GET CONTROL BYTE                            
         LW,R3    R2                                                            
         BEZ      S20               ERROR IF ZERO                               
         CI,R3    2                                                             
         BL       S61               ADD CONSTANT                                
         BE       S66               END EXPRESSION                              
         SLS,R3   -2                                                            
         AND,R3   KXF                                                           
         AI,R3    -8                                                            
         BLZ      S20               ERROR, ILL. CONTROL BYTE                    
         LW,R9    R2                                                            
         AND,R9   K3                SAVE RESOLUTION                             
         LW,R0    S69,R3                                                        
         B        *R0               GO TO PROPER SECTION                        
*                                                                               
S61      LI,R2    0                 PROCESS ADD CONSTANT                        
S61A     BAL,R8   S56                                                           
         LB,R0    INBUF1,R1                                                     
         STB,R0   R10,R2            STORE CONSTANT IN R10                       
         AI,R2    1                                                             
         CI,R2    4                                                             
         BL       S61A                                                          
         AW,R15   R10               ADD CONSTANT TO ACC. VALUE                  
         B        S60A              EXIT                                        
*                                                                               
S62      LI,R13   0                 PROCESS ADD VALUE OF DECL.                  
S62A     BAL,R8   S56                                                           
         LB,R0    INBUF1,R1         GET FIRST BYTE OF DECL NR                   
         STW,R0   R3                                                            
         LW,R0    S89                                                           
         CI,R0    256                                                           
         BLE      S62AA             BRANCH IF ONLY ONE BYTE                     
         BAL,R8   S56                                                           
         LB,R0    INBUF1,R1         GET NEXT BYTE OF DECL NR                    
         STB,R0   R3                                                            
         SCS,R3   8                 RT JUSTIFY DECL NR IN R3                    
S62AA    LW,R0    R3                                                            
         BEZ      S62G              STND. CNTROL SECT.                          
         CW,R0    S95                                                           
         BE       S62G              NON STND. CNTRL SECT                        
         LCW,R3   *SYMT2            BET NO. ENTRIES                             
         SLS,R3   2                 DW INDEX TO HW INDEX                        
         AI,R3    1                                                             
         CH,R0    *SYMT2,R3         SEARCH SYMT FOR DECL NR                     
         BE       S62B              FOUND IT                                    
         AI,R3    4                 STEP TO NEXT ENTRY                          
         BLZ      %-3                                                           
         LI,R14   0                 IF CAN'T FIND DECL. USE ZERO                
         B        S60A                                                          
S62B     SLS,R3   -1                HW INDEX TO WORD INDEX                      
         AI,R3    1                                                             
         LW,R10   *SYMT2,R3         GET VALUE OF DEF                            
S62C     LW,R0    R13                                                           
         BEZ      %+2               ADD DECL.                                   
         LCW,R10  R10               SUB DECL.                                   
S62D     LW,R0    R14                                                           
         BLZ      S62E              RES. NOT ESTABLISHED YET                    
         CW,R9    R14                                                           
         BE       S62E                                                          
         LI,R9    MSG32             CAN'T HANDLE MIXED MODE EXPRESSIONS         
         B        S20A                                                          
S62E     STW,R9   R14               STORE RESOL.                                
         LCW,R2   R14                                                           
         SAS,R10  0,R2              SET VALUE TO PROPER RES.                    
         AW,R15   R10               ADD TO ACC. SUM                             
         B        S60A                                                          
S62G     LW,R10   S93               GET RELOCATION VALUE FOR CONT. SECT.        
         SLS,R10  2                                                             
         B        S62C                                                          
*                                                                               
S63      LI,R13   1                 PROCESS SUB VALUE OF DECL.                  
         B        S62A                                                          
*                                                                               
S64      LW,R2    R14               PROCESS CHANGE EXP RESOL.                   
         BLZ      %+3               B IF RESOLUTION NOT ESTABLISHED             
         SW,R2    R9                                                            
         SAS,R15  0,R2              CHANGE RESOLUTION                           
         STW,R9   R14               SAVE NEW RESOLUTION                         
         B        S60A                                                          
*                                                                               
S65      LI,R14   0                 PROCESS ADD/SUB VALUE OF FWD. REF.          
         BAL,R8   S56               JUST SKIP THIS LOAD ITEM                    
         BAL,R8   S56                                                           
         B        S60A              EXIT AND GET NEXT CONTROL BYTE              
*                                                                               
S66      LW,R2    R14                                                           
         BLZ      %+3                                                           
         SLS,R15  0,R2              MAKE BYTE RESOL.                            
         B        *S68              EXIT EVAL. EXP.                             
         LI,R9    MSG19                                                         
         BAL,R8   LOGALM            ILLEGAL OBJECT LANGUAGE                     
         B        A08A              QUIT                                        
*                                                                               
S67      LI,R10   0                 ADD/SUBTR ORIGINOF ASECT                    
         B        S62D                                                          
S68      DATA     0                 RETURN ADDRESS                              
*                                                                               
S69      DATA     S62,S65,S63,S65                                               
         DATA     S64,S67,S67,S20                                               
*                                                                               
*                                                                               
*                                                                               
*                                   DO HOUSEKEEPING SBR                         
*                                   RUNS AFTER AN END ITEM OR A                 
*                                     DECK HAS BEEN SKIPPED                     
*                                   CALL  BAL,R8  S70                           
*                                                                               
S70      LI,R0    0                                                             
         STW,R0   S90                                                           
         STW,R0   S93A                                                          
         STW,R0   S94A                                                          
         STW,R0   S95                                                           
         LCW,R1   *SYMT2            CLEAR DECL NO. OUT OF SYMT                  
         AW,R1    R1                DW INDEX TO WORD INDEX                      
         BEZ      S70B              NO ENTRIES YET                              
         LI,R2    0                                                             
         LI,R3    X'FFFF'                                                       
         STS,R2   *SYMT2,R1                                                     
         AI,R1    1                                                             
         BIR,R1   %-2                                                           
S70B     LI,R0    1                                                             
         STW,R0   S89                                                           
         B        *R8               EXIT                                        
*                                                                               
*                                                                               
*                                   SRR TO STORE NAME IN R10,R11                
*                                   CALL IS BAL,R8  S75                         
*                                                                               
*                                      R3= NO. BYTES IN NAME                    
*                                                                               
*                                                                               
S75      STW,R8   S75C              SAVE EXIT                                   
         LW,R10   KBLANKS                                                       
         LW,R11   KBLANKS                                                       
         LI,R2    0                                                             
S75A     BAL,R8   S56               STEP TO NEXT BYTE                           
         LB,R0    INBUF1,R1                                                     
         STB,R0   R10,R2            STORE BYTE                                  
         AI,R2    1                                                             
         BDR,R3   S75A                                                          
         B        *%+1              EXIT                                        
S75C     DATA     0                                                             
*                                                                               
*                                                                               
*                                   ROUTINE TO OUTPUT MAP                       
*                                                                               
*                                   NOTE THAT MAP GOES ON 'LO' SINCE            
*                                   WRITEDO=WRITELO                             
*                                                                               
S79      LI,R6    BA(F:OV+5)                                                    
         LI,R7    BA(S79Z)+13                                                   
         LI,R9    8                                                             
         BAL,R8   MOVBYTE           GO MOVE FILE NAME INTO IMAGE                
         LI,R0    S79Z                                                          
         STW,R0   WRITEDO+4                                                     
         LI,R0    21                                                            
         STW,R0   WRITEDO+5                                                     
         CAL1,1   WRITEDO           GO PRINT 'MAP OF FILE XXXX'                 
         LI,R0    S79Y                                                          
         STW,R0   WRITEDO+4                                                     
         LI,R0    38                                                            
         STW,R0   WRITEDO+5                                                     
         CAL1,1   WRITEDO           GO PRINT HEADER LINE                        
         LW,R11   EXLOC             SET UP ROOT LINE                            
         AND,R11  KXFFFFFF                                                      
         BAL,R7   HEXBCD                                                        
         LI,R6    (R10*4)+3                                                     
         LI,R7    BA(S79X)+12                                                   
         LI,R9    5                                                             
         BAL,R8   MOVBYTE           STORE ROOT FWA IN IMAGE                     
         LW,R11   FHRVMBL                                                       
         AND,R11  KXFFFFFF                                                      
         SLS,R11  -2                GET WORD SIZE OF ROOT                       
         BAL,R7   HEXBCD                                                        
         LI,R6    R11*4                                                         
         LI,R7    BA(S79X)+20                                                   
         LI,R9    4                                                             
         BAL,R8   MOVBYTE           STORE ROOT SIZE IN IMAGE                    
         LI,R6    BA(S79R)                                                      
         LI,R7    BA(S79X)+27                                                   
         LI,R9    3                                                             
         BAL,R8   MOVBYTE           STORE ROOT GRANULE NO. IN IMAGE             
         LW,R11   FHENTRY                                                       
         AND,R11  KXFFFFFF                                                      
         BAL,R7   HEXBCD                                                        
         LI,R6    (R10*4)+3                                                     
         LI,R7    BA(S79X)+33                                                   
         LI,R9    5                                                             
         BAL,R8   MOVBYTE           STORE ENTRY ADD. IN IMAGE                   
         LI,R0    S79X                                                          
         STW,R0   WRITEDO+4                                                     
         CAL1,1   WRITEDO           GO PRINT ROOT LINE                          
         LW,R1    OVLOAD            GET NO. OF OVERLAYS                         
         BEZ      S79E              NONE                                        
         LI,R2    OVLOAD+1          R2=INDEX FOR OVLOAD TABLE                   
S79C     LW,R11   0,R2                                                          
         AND,R11  KXFFFF                                                        
         BAL,R8   BINBCD                                                        
         LI,R6    (R10*4)+2                                                     
         LI,R7    BA(S79W)+7                                                    
         LI,R9    2                                                             
         BAL,R8   MOVBYTE           STORE SEG IDENT IN IMAGE                    
         LW,R11   5,R2                                                          
         BAL,R7   HEXBCD                                                        
         LI,R6    (R10*4)+3                                                     
         LI,R7    BA(S79W)+12                                                   
         LI,R9    5                                                             
         BAL,R8   MOVBYTE           STORE SEG FWA IN IMAGE                      
         LW,R11   6,R2                                                          
         SLS,R11  -2                                                            
         BAL,R7   HEXBCD                                                        
         LI,R6    R11*4                                                         
         LI,R7    BA(S79W)+20                                                   
         LI,R9    4                                                             
         BAL,R8   MOVBYTE           STORE SEG SIZE IN IMAGE                     
         LW,R11   7,R2                                                          
         BAL,R8   BINBCD                                                        
         LI,R6    (R10*4)+1                                                     
         LI,R7    BA(S79W)+27                                                   
         LI,R9    3                                                             
         BAL,R8   MOVBYTE           STORE SEG GRANULE NO. INIMAGE               
         LW,R11   10,R2                                                         
         BAL,R7   HEXBCD                                                        
         LI,R6    (R10*4)+3                                                     
         LI,R7    BA(S79W)+33                                                   
         LI,R9    5                                                             
         BAL,R8   MOVBYTE           STORE SEG ENTRY ADDRESS IN IMAGE            
         LI,R0    S79W                                                          
         STW,R0   WRITEDO+4                                                     
         CAL1,1   WRITEDO           GO PRINT SEG LINE                           
         AI,R2    11                                                            
         BDR,R1   S79C                                                          
S79E     LW,R1    DCBTAB            ANY DCB'S                                   
         BEZ      S79H              NO                                          
         LI,R0    S79V                                                          
         STW,R0   WRITEDO+4                                                     
         LI,R0    10                                                            
         STW,R0   WRITEDO+5                                                     
         CAL1,1   WRITEDO           GO PRINT 'DCB TABLE'                        
         LI,R2    DCBTAB+1          R2=INDEX FOR DCB TABLE                      
S79F     LI,R3    21                                                            
         LW,R0    KBLANKS                                                       
         STW,R0   S79S-1,R3         BLANK OUT IMAGE FOR DCB TABLE               
         BDR,R3   %-1                                                           
         LI,R0    X'C0'             SKIP NO LINES                               
         STB,R0   S79S                                                          
         LI,R3    5                 SET FOR 5 DCB'S PER LINE                    
         LI,R7    BA(S79S)+3                                                    
S79G     LW,R10   0,R2                                                          
         LW,R11   1,R2                                                          
         BAL,R8   MOVBYTE1          STORE DCB NAME IN IMAGE                     
         LI,R6    BA(S79P)                                                      
         LI,R9    1                                                             
         BAL,R8   MOVBYTE           STORE = INIMAGE                             
         LW,R5    R7                SAVE R7 HERE                                
         LW,R11   2,R2                                                          
         BAL,R7   HEXBCD                                                        
         STW,R5   R7                RESTORE R7                                  
         LI,R6    (R10*4)+3                                                     
         LI,R9    5                                                             
         BAL,R8   MOVBYTE           STORE VALUE OF DCB IN IMAGE                 
         AI,R7    2                 STEP BA IN IMAGE                            
         AI,R2    3                 STEP DCBTAB INDEX                           
         AI,R1    -1                ARE WE DONE                                 
         BEZ      %+2               YES                                         
         BDR,R3   S79G              NO, IF BRANCH LINE NOT FULL                 
         LI,R0    S79S                                                          
         STW,R0   WRITEDO+4                                                     
          LI,R0    81                                                           
         STW,R0   WRITEDO+5                                                     
         CAL1,1   WRITEDO           GO PRINT LINE OF DCB TABLE                  
         CI,R1    0                 ARE WE DONE                                 
         BNE      S79F              NO                                          
S79H     LI,R4    0                 FLAG FOR DON'T PRINT DUP. DEF'S             
         LW,R1    *SYMT2            ANY DEF'S                                   
         BEZ      S79L              NO                                          
         LI,R0    S79U                                                          
         STW,R0   WRITEDO+4                                                     
         LI,R0    6                                                             
S79HA    STW,R0   WRITEDO+5                                                     
         CAL1,1   WRITEDO           GO PRINT 'DEF'S' HEADER                     
S79I     LI,R2    21                                                            
         LW,R0    KBLANKS                                                       
         STW,R0   S79S-1,R2         BLANK OUT IMAGE                             
         BDR,R2   %-1                                                           
         LI,R0    X'C0'                                                         
         STB,R0   S79S              SET FOR SINGLE SPACING                      
         LI,R6    BA(S79O)                                                      
         LI,R7    BA(S79S)+3                                                    
         LI,R9    4                                                             
         BAL,R8   MOVBYTE           STORE 'NONE' IN IMAGE                       
         LI,R2    5                 SET FOR 5 DEF'S PER LINE                    
         LI,R7    BA(S79S)+3                                                    
S79J     LCW,R1   R1                                                            
         SAS,R1   1                 DW INDEX TO WORD INDEX                      
         LW,R0    *SYMT2,R1         GET DUP. DEF BIT                            
         SAS,R1   -1                WORD  INDEX TO DW INDEX                     
         LCW,R1   R1                                                            
         AND,R0   KX800000                                                      
         CW,R0    R4                SHOULD WE PRINT DEF NOW                     
         BNE      S79K              NO                                          
         LD,R10   *SYMT1,R1         YES                                         
         BAL,R8   MOVBYTE1          STORE DEF NAME IN IMAGE                     
         LI,R6    BA(S79P)                                                      
         LI,R9    1                                                             
         BAL,R8   MOVBYTE           STORE= IN IMAGE                             
         LCW,R1   R1                                                            
         SAS,R1   1                 DW INDEX TO WORD INDEX                      
         AI,R1    1                 POINT TO VALUE                              
         LW,R11   *SYMT2,R1                                                     
         AI,R1    -1                POINT TO BASE OF ENTRY                      
         SAS,R1   -1                WORD INDEX TO DW INDEX                      
         LCW,R1   R1                                                            
         SLS,R11  -2                CHANGE TO WORD ADDRESS                      
         LW,R5    R7                SAVE R7 HERE                                
         BAL,R7   HEXBCD                                                        
         STW,R5   R7                RESTORE R7                                  
         LI,R6    (R10*4)+3                                                     
         LI,R9    5                                                             
         BAL,R8   MOVBYTE           STORE VALUE OF DEF IN IMAGE                 
         AI,R7    2                 STEP BA IN IMAGE                            
         AI,R2    -1                STEP COUNT OF DEF'S IN IMAGE                
S79K     AI,R1    -1                ARE WE DONE                                 
         BEZ      %+3               YES                                         
         CI,R2    0                 IS LINE FULL                                
         BG       S79J              NO,GO BACK FOR MORE                         
         LI,R0    S79S                                                          
         STW,R0   WRITEDO+4                                                     
          LI,R0    81                                                           
         STW,R0   WRITEDO+5                                                     
         CAL1,1   WRITEDO           GO PRINT DEF LINE                           
         CI,R1    0                 ARE WE DONE                                 
         BNE      S79I              NO                                          
         CI,R4    0                 HAVE WE MADE DUP DEF PASS                   
         BNE      S79L              YES                                         
         LW,R4    KX800000          NO, SET R4 FOR DUP DEF PRINT                
         LW,R1    *SYMT2                                                        
         LI,R0    S79T                                                          
         STW,R0   WRITEDO+4         SET TO PRINT 'DUPLICATE DEF' LINE           
         LI,R0    16                                                            
         B        S79HA                                                         
S79L     LI,R0    S79Q                                                          
         STW,R0   WRITEDO+4                                                     
         LI,R0    8                                                             
         STW,R0   WRITEDO+5                                                     
         CAL1,1   WRITEDO           GO PRINT 'END MAP'                          
         LI,R0    S79N              TOP OF FORM                                 
         STW,R0   WRITEDO+4         SET MESSAGE BUFFER ADDR                     
         LI,R0    1                                                             
         STW,R0   WRITEDO+5         SET MESSAGE BYTE COUNT                      
         CAL1,1   WRITEDO           SKIP TO TOP OF FORM                         
         B        A03               EXIT                                        
S79N     TEXT     '1'               TOP OF FORM                                 
S79O     TEXT     'NONE'                                                        
S79P     TEXT     '=   '                                                        
S79Q     TEXT     'AEND MAP'                                                    
S79R     TEXT     '001'                                                         
S79S     RES      21                                                            
S79T     TEXT     'ADUPLICATE DEF''S'                                           
S79U     TEXT     'ADEF''S'                                                     
S79V     TEXT     'ADCB TABLE'                                                  
S79W     DATA,1   X'C0',' ',' ','S'                                             
         TEXT     'EG XX                             '                          
S79X     DATA,1   X'C0',' ',' ','R'                                             
         TEXT     'OOT                               '                          
S79Y     TEXT     'A  IDENT     FWA    SIZE   GRAN  ENTRY'                      
S79Z     TEXT     'BMAP OF FILE XXXXXXXX'                                       
*                                   FLAGS AND CONSTANTS FOR S REGION            
S80      DATA     0                  FLAG THAT UNSAT. REF'S DURING LOAD         
S81      DATA     0                 FLAG THAT BI IS A RAD FILE                  
S82      TEXT     '!EOD'                                                        
S83      DATA     0                 NO. WORDS/GRANULE FOR OV                    
S84      DATA     X'10000000'       A CONSTANT                                  
S88      DATA     0                 BYTE SIZE OF LARGEST OVERLAY                
S89      DATA     1                 NEXT DECL. NO. TO USE                       
S90      DATA     0                 SEQ NO.                                     
S91      DATA     0                 LAST BYTE+1 TO PROCESS ON CARD              
S92      DATA,1   0,0,0,0,0,0,0,0,0 TABLE CONTAINING NO. OBJ. MODULES           
         DATA,1   0,0,0              FOR EACH SEGMENT. WORD 0 IS A              
*                                     POINTER TO CURRENT ENTRY TO USE.          
         BOUND    4                                                             
S92A     DATA     0                 NO. OBJ. MOD. READ/SEG. IN PASS 2           
S93      DATA     0                 RELOCATION BIAS FOR OBJ. MOD.               
S93A     DATA     0                 NEXT BYTE WITHIN WORD TO LOAD               
S94      DATA     0                 SIZE OF LOAD MODULE IN BYTES                
S94A     DATA     0                 NO. OF CONTROL SECT. IN OBJ. MOD.           
S95      DATA     0                 DECL. NO. OF NON STND. CNTRL SECT.          
S96      DATA     0                 MAX. NO. OF ENTRIES IN SYMT                 
S97      DATA     1                 NEXT GRANULE NO. TO USE-FOR PASS 1          
S98      DATA     0                 NO. BYTES TO LOAD                           
S98A     DATA     0                 NO. BYTES LEFT TO  LOAD                     
S98B     DATA     0                 NO. GTANULES WRITTEN EACH TIME              
*                                     BEING LOADED                              
S99      DATA     S08,S20,S20,S22                                               
         DATA     S24,S23,S20,S26                                               
         DATA     S20,S20,S27,S28                                               
         DATA     S29,S30,S38,S31                                               
*                                                                               
*                                                                               
         BOUND    4                                                             
FILEHD   RES      0                                                             
EXLOC    RES      0                                                             
FHFLAGS  DATA,1   0                                                             
FHFWA    DATA,3   0                                                             
FHMSECB  DATA,1   X'FF'                                                         
FHLWA    DATA,3   0                                                             
FHMRECB  DATA,1   X'FF'                                                         
FHENTRY  DATA,3   0                                                             
FHMENQ   DATA,1   X'FF'                                                         
FHRVMBL  DATA,3   0                                                             
         DO       #MAP=0                                                        
FHNSEGS  DATA,1   1                                                             
         ELSE                                                                   
FHNSEGS  DATA,1   2                                                             
         FIN                                                                    
FHRVMWO  DATA,3   0                                                             
FHRLMBL  DATA     0                                                             
         DATA     0,0,0,0,0,0                                                   
FHRTSCD  GEN,32,16,16  0,150+#SYMB*75,0                                         
         DATA     0                 NO PUBLIBS                                  
*                                                                               
*                                                                               
DCBTAB   RES      76                SPACE FOR BUILDING DCBTAB                   
*                                                                               
*                                                                               
EXLOC1   DATA     0                 EXEC. FWA FOR ENTIRE SEGMENT                
EXLOC2   DATA     0                 CURRENT EXEC. FWA FOR ENTIRE SEG.           
LDLOC1   DATA     0                 LOAD FWA                                    
LDLOC2   DATA     0                 NEXT ADDRESS TO LOAD INTO                   
SYMT1    DATA     0                 ADDRESS OF SYMT1                            
SYMT2    DATA     0                 ADDRESS OF SYMT2                            
OVLOAD1  DATA     0                 ADDRESS OF CURRENT OVLOAD ENTRY             
PASS     DATA     0                 PASS FLAG. 0=PASS 1, 1=PASS 2               
MAP      DATA     0                 FLAG TO OUTPUT MAP                          
OLDADD   DATA     0                 ADD. OF OVLOAD TABLE AFTER ROOT             
DCBADD   DATA     0                 ADD. OF DCBTAB AFTER ROOT                   
         BOUND    8                                                             
P:END    TEXT     'P:END   '        DEF FOR END OF PROG. LOAD AREA              
MSLDCB   TEXT     'M:SL   '                                                     
         DATA     0                 ADD. OF M:SL DCB AFTER ROOT                 
         TITLE    '***** ASSIGN A DCB ACCORDING TO COMMAND *****'               
*                                                                               
*        NAME:    ASGNDCB                                                       
*                                                                               
*        CALL:    BAL,R8  ASGNDCB                                               
*                                                                               
*        INPUT:   R1 = DCB ADDRESS                                              
*                 R7 = SCAN CONTROL BLOCK IN USE                                
*                 R9 = M:ASSIGN PBITS FOR THE ALLOWED ASSIGNMENTS...            
*                      P2 SET IF OPLABEL ASSIGNMENT PERMITTED                   
*                      P3 SET IF DEVICE ASSIGNMENT PERMITTED                    
*                      P4 SET IF FILE OR AREA ASSIGNMENT PERMITTED              
*                                                                               
*        OUTPUT:  DCB ASSIGNED TO SPECIFIED DEV/OPLB/FILE                       
*                 R6, R10, R11 AS RETURNED FROM LAST SCAN CALL                  
*                 R0-R4, R7, R12-R15 PRESERVED                                  
*                 RETURNS TO A08 IF ANY ERROR FOUND                             
*                                                                               
*        USES:    GETIOID ROUTINE                                               
*                 R5-R12                                                        
*                                                                               
ASGNDCB  RES      0                                                             
         CW,R9    GIOFBIT                                                       
         BAZ      %+2               B IF FILE NAME NOT ALLOWED                  
         OR,R9    GIOABIT           ALLOW ACCOUNT NAME                          
         STW,R9   GIOCT             SET PBITS IN GETIOID CONTROL TBL            
         LI,R9    GIOCT                                                         
         PUSH     R8                                                            
         BAL,R8   GETIOID           GET IO STREAM ID FROM CMND                  
         PULL     R8                                                            
         CI,R6    0                                                             
         BL       A08               B IF ILLEGAL ID                             
         LW,R10   GIOCT                                                         
         LI,R11   GIOCT+1           ADDRESS OF STREAM NAME                      
         CW,R10   GIOOBIT                                                       
         BAZ      %+2               B IF NOT OPLABEL                            
         OR,R11   KSIGN             ADDRESS IS INDIRECT FOR OPLABLE             
         STW,R11  ASGNPTR           SET IO STREAM NAME POINTER                  
         LW,R11   GIOBITS                                                       
         STS,R10  ASGNBITS          SET PBITS FOR ASSIGNMENT                    
         CAL1,1   ASGNFPT           DO ASSIGNMENT                               
         B        *R8               RETURN                                      
*****                                                                           
         PAGE                                                                   
*                                                                               
*        ENVIRONMENT FOR GETIOID                                                
*                                                                               
GIOSCAN  CNAME                                                                  
         PROC                                                                   
         LI,R0    1                                                             
         STW,R0   SCAN97            SCAN POSSIBLE FILE ID                       
         STW,R0   1,R7              SCAN EBCDIC                                 
         BAL,R8   SCAN              GET NEXT SUBFIELD                           
         CI,R6    0                                                             
         BL       GIOEXIT           B IF SCAN ERROR                             
         PEND                                                                   
*                                                                               
GIOBITS  DATA     1**(31-1)+1**(31-2)+1**(31-3)+1**(31-13)  P2+P3+P4+P14        
GIOOBIT  DATA     1**(31-1)         P2 (OPLABEL)                                
GIODBIT  DATA     1**(31-2)         P3 (DEVICE)                                 
GIOFBIT  DATA     1**(31-3)         P4 (FILE ID)                                
GIOABIT  DATA     1**(31-13)        P14 (ACCOUNT NAME)                          
GIODEV0  DATA     '0   '            NULL DEVICE NAME                            
GIOFA    DATA     1**(31-3)+1**(31-13)   P4 AND P14                             
NULLDEV  EQU      KZEROS                                                        
*                                                                               
         TITLE    '***** GETIOID *****'                                         
*                                                                               
*        NAME:    GETIOID                                                       
*                                                                               
*        PURPOSE: SCAN A DEVICE, OPLABEL, OR FILE IDENTIFIER                    
*                 FROM A COMMAND                                                
*                                                                               
*        CALL:    BAL,R8  GETIOID                                               
*                                                                               
*        INPUT:   R9 = ADDRESS OF A MEMORY AREA, THE FIRST                      
*                      WORD OF WHICH INDICATES PERMISSIBLE FORMS AS             
*                      FOLLOWS:                                                 
*                      BIT 1 SET IF AN OPLABEL NAME IS PERMITTED                
*                      BIT 2 SET IF A DEVICE NAME IS PERMITTED                  
*                      BIT 3 SET IF A FILE AND AREA IS PERMITTED                
*                      BIT 13 SET IF AN ACCOUNT NAME IS PERMITTED               
*                      NOTE THAT THESE ARE THE CORRESPONDING                    
*                      P-BITS FOR AN ASSIGN CAL.                                
*                      FOLLOWING THE FIRST WORD MUST BE ENOUGH                  
*                      SPACE FOR THE RETURN AS INDICATED BELOW                  
*                      (SPACE NEED NOT BE ALLOWED FOR NON-                      
*                      PERMISSIBLE NAME TYPES)                                  
*                 R7 = R7 VALUE FOR SCAN                                        
*                                                                               
*        RETURN:  R6 = -1 IF A NON-ALLOWED OR UNRECOGNIZED FORM                 
*                      IS FOUND.  OTHERWISE, AS RETURNED FROM                   
*                      THE LAST SCAN CALL.                                      
*                 R10,R11 AS RETURNED FROM LAST SCAN CALL                       
*                 OTHER REGISTERS UNCHANGED                                     
*                 AREA POINTED BY R9:                                           
*                   FIRST WORD BITS 1, 2, 3, AND 13 SET TO INDICATE             
*                   THE FORM FOUND. OTHER BITS UNCHANGED.                       
*                   FOLLOWING WORDS AS INDICATED BELOW:                         
*                      OPLABEL:  RIGHT-ALIGNED IN ONE WORD                      
*                      DEVICE:  LEFT-ALIGNED WITH TRAILING BLANKS               
*                      IN TWO WORDS                                             
*                      FILE AND AREA:  AREA NAME IN ONE WORD, RIGHT             
*                      ALIGNED, AND FILE NAME IN FOLLOWING TWO                  
*                      WORDS, LEFT-ALIGNED WITH TRAILING BLANKS                 
*                      ACCOUNT NAME: IN TWO WORDS FOLLOWING THE                 
*                      SPACE FOR FILE AND AREA NAMES (WORDS 4                   
*                      AND 5 FOLLOWING THE P-BIT WORD), LEFT-ALIGNED            
*                      WITH TRAILING BLANKS                                     
*                      THIS FORMAT MAY BE USED IN AN ASSIGN CAL FPT.            
*                                                                               
GETIOID  RES      0                                                             
         PUSH     R8                                                            
         PUSH     4,R0                                                          
*                                                                               
         LW,R1    R9                SAFER AND MORE USABLE PLACE                 
         GIOSCAN                    GET NEXT SUBFIELD                           
*                                                                               
*        CHECK TO SEE IF A DEVICE NAME COULD BE IN R8, R9                       
         LW,R0    GIODBIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIO10             B IF NOT PERMITTED                          
         CI,R6    2                                                             
         BG       GIO10             B IF NEW-FORMAT FILE ID                     
         CW,R8    GIODEV0                                                       
         BNE      GIO01             B IF NOT NULL DEVICE                        
         LD,R8    NULLDEV           GET NULL DEVICE ID                          
         B        GIO05                                                         
*****                                                                           
GIO01    RES      0                                                             
         CI,R10   5                                                             
         BNE      GIO10             B IF WRONG LENGTH                           
         SLD,R8   -24               ADJUST TO DCT16 FORMAT                      
         OR,R8    NLBB                                                          
         LH,R2    *K:DCT1           GET DCT NR OF ENTRIES                       
GIO02    RES      0                 SEARCH FOR NAME IN DCT                      
         CD,R8    *K:DCT16,R2                                                   
         BE       GIO03             B IF FOUND                                  
         BDR,R2   GIO02                                                         
         SLD,R8   24                NOT FOUND.  RESTORE NAME                    
         OR,R9    BLBLBL                                                        
         B        GIO10                                                         
*****                                                                           
GIO03    RES      0                                                             
         SLD,R8   24                NAME FOUND. RESTORE TO INPUT FORMAT         
         OR,R9    BLBLBL                                                        
GIO05    RES      0                                                             
*                                                                               
*        DEVICE ID SCANNED. PACK IT AWAY.                                       
         STW,R8   1,R1                                                          
         STW,R9   2,R1                                                          
         LW,R3    GIODBIT                                                       
         B        GIOOKEX           SPLIT                                       
*****                                                                           
GIO10    RES      0                                                             
*                                                                               
*        CHECK TO SEE IF AN OPLABEL NAME COULD BE IN R8                         
         LW,R0    GIOOBIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIO20             B IF NOT PERMITTED                          
         CI,R6    2                                                             
         BG       GIO20             B IF NEW-FORMAT FILE ID                     
         CI,R10   2                                                             
         BG       GIO20             B IF NAME IS TOO LONG                       
         LH,R2    *K:OPLBS1         GET OPLBS1 NR OF ENTRIES                    
         LH,R0    R8                                                            
GIO15    RES      0                 SEARCH FOR NAME IN OPLB                     
         CH,R0    *K:OPLBS1,R2                                                  
         BE       GIO17             B IF FOUND                                  
         BDR,R2   GIO15                                                         
         B        GIO20             B IF NOT FOUND                              
*****                                                                           
GIO17    RES      0                                                             
*                                                                               
*        OPLABEL NAME SCANNED. PACK IT AWAY.                                    
         SLS,R8   -16                                                           
         STW,R8   1,R1                                                          
         LW,R3    GIOOBIT                                                       
         B        GIOOKEX                                                       
*****                                                                           
GIO20    RES      0                                                             
*                                                                               
*        CHECK TO SEE IF AN OLD-FORMAT AREA NAME COULD BE IN R8, R9             
         LW,R0    GIOFBIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIO30             B IF NOT PERMITTED                          
         CI,R6    0                                                             
         BG       GIO30             B IF NEW-FORMAT FILE ID                     
         CI,R10   2                                                             
         BNE      GIO30             B IF WRONG LENGTH                           
*                                                                               
*        OLD FORMAT AREA NAME FOUND. PACK IT AWAY.                              
*                                                                               
         SLS,R8   -16                                                           
         STW,R8   1,R1                                                          
         LW,R3    GIOFBIT           FLAG FOR FILE ID FOUND                      
*                                                                               
*        FILE NAME FOLLOWS AREA NAME                                            
         GIOSCAN                    GET NEXT SUBFIELD                           
         CI,R6    2                                                             
         BG       GIOEREX           B IF A NEW-FORMAT TERMINATOR                
*                                                                               
*        FILE NAME FOUND. PACK IT AWAY.                                         
         STW,R8   2,R1                                                          
         STW,R9   3,R1                                                          
*                                                                               
         LW,R0    GIOABIT                                                       
         CW,R0    *R1               IS AN ACCOUNT NAME REQUESTED                
         BAZ      GIOOKEX           NO, SKIP THIS                               
*                                   YES                                         
         LI,R0    0                                                             
         STW,R0   4,R1                                                          
         STW,R0   5,R1              ZERO IS THE DEFAULT ACCOUNT NAME            
         B        GIOOKEX           DONE.                                       
*****                                                                           
*        ASSUME SCANNED FIELD IS A NEW-FORMAT FILE NAME                         
GIO30    RES      0                                                             
         LW,R3    GIOFBIT                                                       
         CW,R3    *R1                                                           
         BAZ      GIOEREX           B IF FILE ID NOT PERMITTED                  
         STW,R8   2,R1                                                          
         STW,R9   3,R1              SET FILE NAME                               
         LI,R0    0                                                             
         STW,R0   1,R1              SET AREA NAME UNSPECIFIED FOR NOW.          
*                                                                               
         LW,R0    GIOABIT                                                       
         CW,R0    *R1               IS AN ACCOUNT NAME REQUESTED                
         BAZ      GIO31             NO, SKIP THIS                               
*                                   YES                                         
         LI,R0    0                                                             
         STW,R0   4,R1                                                          
         STW,R0   5,R1              ZERO IS THE DEFAULT ACCOUNT NAME            
*                                                                               
GIO31    RES      0                                                             
         CI,R6    3                                                             
         BNE      GIOOKEX           B IF NO MORE FILE ID FIELDS                 
         GIOSCAN                    GET NEXT SUBFIELD                           
*                                                                               
*        CHECK TO SEE IF A NEW-FORMAT AREA NAME COULD BE IN R8, R9              
         CI,R10   0                                                             
         BE       GIO34             B IF NULL (DEFAULT) AREA                    
         CI,R10   2                                                             
         BNE      GIO35             B IF WRONG LENGTH                           
         LB,R2    K:MDNAME          NR OF AREA NAMES                            
GIO33    RES      0                                                             
         AI,R2    -1                                                            
         BLZ      GIO35             B IF NOT AN AREA NAME                       
         LH,R0    *K:MDNAME,R2      GET NEXT NAME FROM TABLE                    
         CH,R0    R8                                                            
         BNE      GIO33             B IF NOT MATCHED                            
*                                                                               
*        AREA NAME FOUND. SET IT.                                               
         SLS,R8   -16                                                           
         STW,R8   1,R1                                                          
*                                                                               
GIO34    RES      0                                                             
         CI,R6    3                                                             
         BNE      GIOOKEX           B IF NO MORE FILE ID FIELDS                 
         GIOSCAN                    GET NEXT SUBFIELD                           
*                                                                               
GIO35    RES      0                                                             
*                                                                               
*        CHECK TO SEE IF AN ACCOUNT NAME COULD BE IN R8, R9                     
         LW,R0    GIOABIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIOEREX           B IF NOT PERMITTED                          
*                                                                               
*        ACCOUNT NAME FOUND. SET IT                                             
         STW,R8   4,R1                                                          
         STW,R9   5,R1                                                          
         OR,R3    GIOABIT           SET ACCOUNT NAME BIT.                       
         CI,R6    3                                                             
         BNE      GIOOKEX           B IF END OF FILE ID                         
*        OTHERWISE, TOO MANY FILE ID FIELDS                                     
*                                                                               
*        NON-SCAN ERROR ENCOUNTERED. SET R6 AND EXIT.                           
GIOEREX  RES      0                                                             
         LI,R6    -1                                                            
         B        GIOEXIT                                                       
*****                                                                           
*        NORMAL EXIT                                                            
*        R1 IS PARAM TABLE POINTER                                              
*        R2 IS P-BITS FOR TYPE OF I/O STREAM NAME FOUND                         
GIOOKEX  RES      0                                                             
         LW,R9    R1                RESTORE R9                                  
         LW,R0    R3                GET NEW P-BIT SETTING                       
         LW,R1    GIOBITS                                                       
         STS,R0   *R9               SET EM                                      
*                                                                               
*        ALL EXIT PATHS MEET HERE                                               
GIOEXIT  RES      0                                                             
         PULL     4,R0              RESTORE OTHER STUFF                         
         PULL     R8                RESTORE LINK                                
GIOEX    B        *R8               RETURN                                      
*****                                                                           
*****                                                                           
         TITLE    '**** SBR TO MOVE BYTE STRING ****'                           
*                                                                               
*                                   CALL IS BAL,R8  MOVBYTE                     
*                                     WHERE                                     
*                                      R6=BA TO MOVE FROM                       
*                                      R7=BA TO STORE INTO                      
*                                      R9=NO. BYTES TO MOVE                     
*                                   USES R0, R6-R9                              
*                                                                               
MOVBYTE  LB,R0    0,R6                                                          
         STB,R0   0,R7              MOVE BYTES                                  
         AI,R6    1                                                             
         AI,R7    1                                                             
         BDR,R9   MOVBYTE                                                       
         B        *R8                                                           
*                                                                               
*                                                                               
MOVBYTE1 STW,R8   MOVBYT9                                                       
         LW,R0    R11               SHIFT SO NO TRAILING BLANKS                 
         AND,R0   KXFF              GET LAST BYTE                               
         CI,R0    X'40'             IS IT A BLANK                               
         BNE      %+3               NO                                          
         SCD,R10  -8                                                            
         B        MOVBYTE1+1                                                    
         LI,R9    8                                                             
         LI,R6    R10*4                                                         
         BAL,R8   MOVBYTE           MOVE INTO PRINT IMAGE                       
         B        *%+1              EXIT                                        
MOVBYT9  DATA     0                                                             
         TITLE    '**** CONVERT BINARY TO BCD ****'                             
*                                                                               
*                                   CALL IS  BAL,R8  BINBCD                     
*                                    WHERE                                      
*                                     R11= VALUE TO BE CONVERTED                
*                                   EXITS                                       
*                                     R10=VALUE IN BCD, RT. JUST.,              
*                                          WITH LEADING ZEROS                   
*                                   USES R0,R10,R11                             
*                                                                               
BINBCD   STW,R8   BINBCD9           SAVE RETURN                                 
         LI,R0    0                                                             
         LI,R8    -4                SET FOR 4 CHARS.                            
BINBCD1  LI,R10   0                                                             
         SLS,R0   -8                                                            
         DW,R10   K10               CHANGE TO BCD                               
         AI,R10   X'F0'                                                         
         STB,R10  R0                                                            
         AI,R8    1                 DONE?                                       
         BNEZ     BINBCD1           NOT YET                                     
         LW,R10   R0                                                            
         B        *%+1              EXIT                                        
BINBCD9  DATA     0                                                             
         TITLE    '**** CONVERT HEX TO BCD ****'                                
*                                                                               
*                                   CALL IS  BAL,R7 HEXBCD                      
*                                   WHERE R11=VALUE TO CONVERT                  
*                                   EXITS R10,R11=BCD                           
*                                   USES R6-R11                                 
*                                                                               
HEXBCD   RES      0                                                             
         PSW,R6   LOAD                                                          
         LW,R9    R11               VALUE TO CONVERT                            
         LI,R6    -8                CHARACTER COUNT                             
*                                                                               
HEXBCD1  LI,R8    X'F'              PREPARE FOR HEX CHAR IN R9                  
         SLD,R8   4                 FOR EBCDIC TEST IN R8                       
         CI,R8    C'9'              NUMERIC                                     
         BLE      %+2               B IF YES                                    
         AI,R8    'A'-'0'-10        MAKE IT ALPHA                               
         STB,R8   R10+2,R6          INSERT INTO R10-R11                         
         BIR,R6   HEXBCD1           LOOP TIL DONE                               
         PLW,R6   LOAD                                                          
         B        0,R7              RETURN                                      
         TITLE    '**** CONT. CARD PROCESSING ****'                             
*                                                                               
*                                   ENTERED BY SCAN AFTER READING A ;           
*                                   READS AND LOGS NEXT CARD                    
CONTCRD  RES      0                                                             
         LW,R0    K:CCBUF                                                       
         STW,R0   F:C+2             SET UP READ C BUFFER ADDR                   
         AI,R0    -1                POINT TO VFC WORD                           
         STW,R0   F:LL+2            SET UP WRITE LL BUFFER ADDR                 
         LI,R0    ' '               VFC:  NO EXTRA SPACING                      
         STW,R0   *F:LL+2           SET VFC                                     
         CAL1,1   READC             READ CONTINUATION CARD                      
         CAL1,1   WRITELL           LOG IT                                      
         B        *R8               RETURN                                      
         TITLE    '**** I/O ERROR PROCESSING ROUTINES ****'                     
*                                                                               
*                                                                               
ERRBI    LB,R0    R10               GET ERROR CODE                              
         CI,R0    5                 IS IT AN EOD                                
         BE       S40               YES                                         
         CI,R0    3                 IS IT FILE NONEXIST.                        
         BNE      ERRW              NO.  MSG35                                  
         LD,R8    F:BI+5            GET FILE NAME                               
ERRPOS2  STW,R8   MSG7+3            STORE FILE NAME IN MSG /SIG7-7472/*C5732  03
         STW,R9   MSG7+4                                   /SIG7-7472/*C5732  03
         LI,R9    MSG7                                                          
         BAL,R8   LOGALM            GO OUTPUT ALARM                             
         B        A08A                                                          
ERROV    LB,R0    R10               GET ERROR CODE                              
         CI,R0    X'42'             IS IT RAD WRT PROT PROBLEM                  
         BE       ERROV5            YES                                         
         CI,R0    X'1C'             NO,IS IT END OF TAPE                        
         BE       ERROV1            YES                                         
         CI,R0    3                 IS IT FILE NONEXIST.                        
         BNE      ERRW              NO.  MSG35                                  
         LD,R8    F:OV+5            GET FILE NAME                               
         B        ERRPOS2                                                       
ERROV1   LD,R0    F:OV+5            GET NAME OF FILE                            
ERROV2   STW,R0   MSG13+5           STORE FILE NAME IN ALARM                    
         STW,R1   MSG13+6                                                       
         LI,R9    MSG13                                                         
         BAL,R8   LOGALM                                                        
         B        A08A                                                          
ERROV5   LI,R7    6                                                             
         LB,R7    *R10,R7           GET AREA CODE FROM DCB                      
         STW,R8   R10               SAVE R8                                     
         LB,R7    MDDCTI,R7         GET DEVICE INDEX WHERE AREA IS              
         LD,R8    DCT16,R7          GET NAME OF DISC                            
         LI,R0    17                GET SIZE OF ALARM                           
         STB,R0   R8                STORE AS FIRST BYTE                         
         STW,R8   MSG12+1           STORE NAME IN ALARM                         
         STW,R9   MSG12+2                                                       
         LI,R0    2                 LOG TO LL FLAG AND ATTENDED FLAG            
         CW,R0    K:JCP1                                                        
         BAZ      %+2               B IF NOT ATTENDED                           
         LI,R0    3                 LOG TO LL AND OC FLAGS                      
         STW,R0   MSG12             SET LOGGING FLAGS                           
         LI,R9    MSG12                                                         
         BAL,R8   LOGALM            GO OUTPUT 'WRT PROT' ALARM                  
         CAL1,9   WAIT              GO TO WAIT                                  
         AI,R10   -1                GET ADDRESS OF CAL                          
         B        *R10              GO TRY WRITE AGAIN                          
ERRX1    LB,R0    R10                                                           
         CI,R0    X'1C'             IS IT END OF TAPE                           
         BNE      ERRW              NO.  MSG35                                  
         LW,R0    F:X1+5            GET X1 IN BCD                               
         LW,R1    F:X1+6                                                        
         B        ERROV2            GO TO OUTPUT ALARM                          
ASGNERR  RES      0                                                             
         LI,R9    MSG45                                                         
         BAL,R8   LOGALM                                                        
         B        A08A                                                          
ERRW     RES      0                                                             
         LB,R11   R10               SAVE ERROR CODE                             
         LW,R13   R8                                                            
         AI,R13   -1                SAVE CAL ADDRESS                            
         LW,R14   *R13              FPT ADDRESS                                 
         LW,R14   *R14              DCB ADDRESS                                 
         BAL,R7   HEXBCD            INSERT ERROR CODE IN MSG                    
         LW,R10   KBLANKS                                                       
         SCD,R10  16                                                            
         STW,R11  MSG38W                                                        
         LW,R11   R13               INSERT ERROR LOC IN MSG                     
         BAL,R7   HEXBCD                                                        
         SLD,R10  24                                                            
         OR,R11   BLBLBL                                                        
         LCI      2                                                             
         STM,R10  MSG38Z                                                        
         LI,R10   X'F'              INSERT DEV/FILE NAME IN MSG                 
         AND,R10  *R14                                                          
         CI,R10   1                                                             
         BE       ERRWFIL           B IF DCB ASSIGNED TO FIL                    
         CI,R10   3                                                             
         BNE      ERRWLOG           B IF NOT DEV/OPLB                           
         AI,R14   1                                                             
         LI,R1    X'80FF'                                                       
         AND,R1   *R14              GET DEV FLAG AND DCT INDEX                  
         CI,R1    X'8000'                                                       
         BANZ     ERRWDEV           B IF ASSIGNED TO DEVICE                     
         AND,R1   KX7F              GET OPLB ASSIGNMENT                         
         LB,R1    OPLBS3,R1                                                     
         CI,R1    X'80'                                                         
         BAZ      ERRWDEV           B IF ASSIGNED TO DEVICE                     
         AND,R1   KX7F              TRIM TO RFT INDEX                           
         LD,R10   RFT1,R1           LOAD FILE NAME                              
         B        ERRWDFN           B TO INSERT NAME                            
ERRWDEV  RES      0                 GET DEVICE NAME                             
         LW,R10   MSG38X1                                                       
         STW,R10  MSG38X                                                        
         AND,R1   KX7F                                                          
         LD,R10   DCT16,R1                                                      
         SLD,R10  24                                                            
         OR,R11   BLBLBL                                                        
         B        ERRWDFN           B TO INSERT NAME                            
ERRWFIL  RES      0                 GET FILE NAME                               
         LW,R10   MSG38X2                                                       
         STW,R10  MSG38X                                                        
         LB,R1    *R14              GET DCB LENGTH                              
         CI,R1    5                                                             
         BLE      ERRWLOG           B IF NO FILE NAME IN DCB                    
         LI,R1    5                                                             
         LCI      2                                                             
         LM,R10   *R14,R1           GET FILE NAME FROM DCB                      
ERRWDFN  RES      0                 INSERT DEV/FILE NAME                        
         LCI      2                                                             
         STM,R10  MSG38Y                                                        
ERRWLOG  RES      0                                                             
         LI,R9    MSG38                                                         
         BAL,R8   LOGALM                                                        
         B        A08A                                                          
*                                                                               
ERRPOS   EQU      ERRW                                                          
ERRLO    EQU      ERRW                                                          
ERRC     EQU      ERRW                                                          
ERRLL    EQU      ERRW                                                          
ERROC    EQU      A03                                                           
ERRCLO   EQU      ERRW                                                          
         TITLE    '**** SBR TO LOG ALARMS AND MSGS. ON OC,LL ****'              
*                                                                               
*                                   CALL   BAL,R8  LOGALM                       
*                                     WHERE  R9= ADD. OF MSG. TO LOG            
*                                           R10= FIELD NO. FOR ERROR            
*                                                  FIELD MSG.                   
*                                   USES R0,R7                                  
*                                                                               
LOGALM   CI,R9    MSG2              IS IT ERROR FIELD ALARM                     
         BNE      %+2               NO                                          
         STW,R11  MSG2A+5           YES, STORE FIELD NO.                        
         LW,R0    R9                                                            
         AI,R0    1                                                             
         STW,R0   TYPE+2            STORE ADDRESS OF MSG. IN FPT                
         STW,R0   PRINT+2                                                       
         LW,R0    *R9                                                           
         AND,R0   K1                DOES MSG. GO TO OC                          
         BEZ      %+2               NO                                          
         CAL1,2   TYPE              YES, OUTPUT TO OC                           
         LW,R0    *R9                                                           
         CI,R0    2                 DOES MSG. GO ON LL                          
         BL       *R8               NO, EXIT                                    
         LI,R7    OC                                                            
         LB,R0    OPLBS3,R7         SEE IF OC, LL SAME DEVICE                   
         LI,R7    LL                                                            
         CB,R0    OPLBS3,R7                                                     
         BNE      LOGALM5           NO, NOT SAME                                
         LW,R0    *R9               YES, SAME DEVICE                            
         AND,R0   K1                WAS MSG. ALREADY OUTPUT ON OC               
         BNEZ     *R8               YES, EXIT                                   
LOGALM5  CAL1,2   PRINT             PRINT MSG.                                  
         B        *R8               EXIT                                        
         TITLE    '**** ALARMS AND MESSAGES ****'                               
*                                                                               
*                                   WORD 1 IS FLAG WORD                         
*                                     BIT 31=1, OUTPUT TO OC                    
*                                     BIT 30=1, OUTPUT TO LL                    
*                                                                               
LOGFLAG  EQU      2+(#MAP=0)        LL, AND OC IF UNMAPPED                      
MSG2     DATA     LOGFLAG                                                       
MSG2A    TEXTC    '!!CC ERROR IN ITEM  XX'                                      
MSG7     DATA     LOGFLAG                                                       
         TEXTC    '!!FILE XXXXXXXX NONEXIST.'                                   
MSG12    DATA     LOGFLAG                                                       
         DATA     0,0               STORED IN                                   
         TEXT     ' WRT RESTR'                                                  
MSG13    DATA     LOGFLAG                                                       
         TEXTC    '!!EOT ON FILE  XXXXXXXX'                                     
MSG19    DATA     LOGFLAG                                                       
         TEXTC    '!!ILLEGAL OBJECT LANGUAGE'                                   
MSG20    DATA     LOGFLAG                                                       
         TEXTC    '!!BI CKSM ERR'                                               
MSG21    DATA     LOGFLAG                                                       
         TEXTC    '!!BI SEQ ERR'                                                
MSG22    DATA     LOGFLAG                                                       
MSG22A   TEXTC    '!!ERR, CONTROL BYTE= XX'                                     
         BOUND    8                                                             
MSG24    DATA     LOGFLAG                                                       
MSG24A   TEXT     ' !!UNSATISFIED REF  XXXXXXXX'                                
MSG25    DATA     LOGFLAG                                                       
         TEXTC    '!!NOT ENUF SPACE FOR LOAD'                                   
MSG26    DATA     LOGFLAG                                                       
         TEXTC    '!!TOO MANY DCB''S'                                           
MSG27    DATA     LOGFLAG                                                       
         TEXTC    '!!ILLEGAL BINARY CARD'                                       
MSG28    DATA     LOGFLAG                                                       
         TEXTC    '!!UNSATISFIED REF''S DURING LOAD'                            
MSG29    DATA     LOGFLAG                                                       
         TEXTC    '!!ILL. NEG. ORG ITEM'                                        
MSG30    DATA     LOGFLAG                                                       
         TEXTC    '!!ILL. DEFINE FIELD ITEM'                                    
MSG31    DATA     LOGFLAG                                                       
         TEXTC    '!!TOO MANY CONTROL SECT.'                                    
MSG32    DATA     LOGFLAG                                                       
         TEXTC    '!!ILL. EXPRESSION'                                           
MSG38    DATA     3                                                             
         GEN,8,24 BA(MSG38E)-BA(MSG38)-5,'!!I'                                  
         TEXT     '/O    ERROR CODE '                                           
MSG38W   TEXT     'XX'                                                          
MSG38X   TEXT     'DEV'                                                         
MSG38Y   TEXT     'UNKNOWN '                                                    
         TEXT     ' AT '                                                        
MSG38Z   TEXT     'XXXXX'                                                       
MSG38E   RES      0                                                             
MSG38X1  TEXT     'DEV'                                                         
MSG38X2  TEXT     'FIL'                                                         
MSG45    DATA     LOGFLAG                                                       
         TEXTC    '!!CC ERR: FILE/DEV/OPLB NAME'                                
         TITLE    '**** SCAN ROUTINE ****'                                      
*                                                                               
*                                                                               
*                                   SCANS ONE SUBFIELD AT A TIME                
*                                                                               
*                                   CALL IS   BAL,R8   SCAN                     
*                                     WHERE  R7=ADD. OF INPUT PARAM.            
*                                     WHICH ARE                                 
*                                                                               
*                                       WORD 1= ADD. OF INPUT BUFFER            
*                                               (MUST START ON WORD BND)        
*                                       WORD 2=1, LEAVE FIELD IN EBCDIC         
*                                             =2, CONVERT TO HEX                
*                                             =4, CONVERT TO DECIMAL            
*                                             =3, CONVERT TO HEX OR BCD         
*                                             =5, CONVERT TO DEC OR BCD         
*                                                                               
*                                       WORD 3=0, FIRST TIME FOR CARD           
*                                             =1, CONTINUE ON CARD              
*                                                                               
*                                       WORD 4=ADD. OF ROUTINE TO               
*                                              PROCESS  ;                       
*                                                                               
*                                   EXITS WITH FOLLOWING:                       
*                                                                               
*                                     R7- UNCHANGED                             
*                                     R8,R9- CONTAIN VALUE                      
*                                       IF R9=0, R8 CONTAINS DEC OR HEX         
*                                            =NONZERO, R8 AND R9 CONTAIN        
*                                               EBCDIC(UNUSED CHAR. HAVE        
*                                               BLANKS)                         
*                                                                               
*                                     R6=0, END OF SUBFIELD                     
*                                       =1, END OF FIELD                        
*                                       =2, END OF CARD                         
*                                       =3, END OF FILE ID FIELD                
*                                       =-1,ERROR IN SUBFIELD OR FIELD          
*                                         ERRORS ARE:                           
*                                           ILLEGAL CHAR.                       
*                                           MORE THAN 8 CHARS.                  
*                                           COL. 80 SCANNED                     
*                                           ILLEGAL PARENTHSES                  
*                                           NO : IN COL. ONE                    
*                                     R10= NO. CHARS. IN FIELD OR SUBF.         
*                                     R11= SUBFIELD NO. IN EBCDIC FOR           
*                                          ERROR FIELD XX ALARM; CHARS.         
*                                          ARE IN BITS 8-23, OTHER CHARS        
*                                          ARE BLANKS                           
*                                                                               
*                                   REGISTERS USED:  R0, R5-R11                 
*                                                    R7 IS UNCHANGED            
*                                   AFTER AN ERROR RETURN, WORD 3 OF            
*                                     INPUT PARAM. MUST BE ZERO                 
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
SCAN     STW,R8   SCAN99            SAVE RETURN ADDRESS                         
         LW,R0    *R7                                                           
         STW,R0   SCAN96            SAVE ADD. OF BUFFER                         
         LW,R0    SCAN92            IS IT A CONT. CARD                          
         BNEZ     SCAN0             NO                                          
         STW,R7   SCAN88            YES, SAVE R7                                
         LW,R0    3,R7              GET ADDR OF CONTINUATION SUBR               
         BAL,R8   *R0               ENTER ROUTINE TO READ NEXT CARD             
         LW,R7    SCAN88            RESTORE R7                                  
SCAN0    LW,R8    SCAN89A           HOUSEKEEP R8,R9 TO ALL BLANKS               
         STW,R8   R9                                                            
         LI,R0    -9                                                            
         STW,R0   SCAN93            HOUSEKEEP CHAR. COUNT                       
         LI,R0    0                                                             
         STW,R0   SCAN95            CLEAR COUNT OF HEX CHARS.                   
         LW,R0    2,R7              IS THIS A CONTINUATION                      
         BNEZ     SCAN4             YES                                         
         STW,R0   SCAN90            HOUSEKEEP FIELD FLAG AND                    
         LI,R0    -1                  PARENTHESES FLAG                          
         STW,R0   SCAN91                                                        
SCAN1    LI,R0    X'F0F0'                                                       
         STW,R0   SCAN94            HOUSEKEEP FIELD COUNT                       
         LI,R0    '!'                                                           
         MTW,0    SCAN92                                                        
         BNEZ     %+2               B IF NOT CONTINUATION                       
         LI,R0    ':'                                                           
         CB,R0    *SCAN96           CHECK FOR CORRECT 1ST CHAR                  
         BNE      SCAN8             NO, ERROR                                   
         LI,R6    1                 SET TO COL. 2                               
         LI,R0    X'40'                                                         
SCAN2    CB,R0    *SCAN96,R6        SCAN OFF LEADING BLANKS                     
         BNE      SCAN6             NOT BLANK                                   
         AI,R6    1                 STEP INDEX                                  
         CI,R6    80                                                            
         BL       SCAN2             NOT COL. 80 YET                             
         LI,R10   0                 BLANK CARD, SET NO. CHARS=0                 
         LI,R6    2                 SET TO END OF CARD                          
         B        SCAN33            EXIT                                        
*                                                                               
SCAN4    LW,R0    SCAN92            IS THIS A CONT. CARD                        
         BEZ      SCAN1             YES                                         
         LW,R6    SCAN98            GET COL. INDEX                              
         AI,R6    1                 STEP TO NEXT COL.                           
SCAN6    LW,R11   1,R7              GET INPUT CONVERSION TYPE IN R11            
         LI,R0    0                                                             
         STW,R0   SCAN98            HOUSEKEEP                                   
         MTW,1    SCAN94            STEP FIELD COUNTER IN EBCDIC                
         LI,R5    3                 CHECK FOR OVERFLOW AND RESET IF             
         LI,R0    X'FA'             OVERFLOW                                    
         CB,R0    SCAN94,R5                                                     
         BG       SCAN7             NO OVERFLOW                                 
         LI,R0    X'F0'             RESET FOR OVERFLOW                          
         STB,R0   SCAN94,R5                                                     
         LI,R5    2                                                             
         MTB,1    SCAN94,R5                                                     
SCAN7    LB,R10   *SCAN96,R6        GET NEXT BYTE                               
         CI,R10   X'C1'                                                         
         BL       SCAN25            SPECIAL CHAR.                               
         MTW,1    SCAN93            STEP CHAR. COUNT                            
         BNEZ     SCAN9             NOT TOO MANY CHARS.                         
SCAN8    RES      0                                                             
         STW,R6   SCAN98                                                        
         LI,R6    -1                NO, SET TO ERROR EXIT  /SIG7-4191/*C015732  
         B        SCAN33            GO TO EXIT             /SIG7-4191/*C015732  
SCAN9    CI,R10   X'C7'                                                         
         BL       SCAN19            HEX CHAR.                                   
         CI,R10   X'F0'                                                         
         BL       SCAN14            EBCDIC CHAR.                                
         CI,R10   X'FA'                                                         
         BGE      SCAN8             ERROR, ILLEGAL CHAR.                        
         CI,R11   4                 IS FIELD DECIMAL                            
         BL       SCAN19            NO DECIMAL CONVERSION                       
         LI,R11   4                 SET FLAG SO ONLY DECIMAL CONVERSION         
         CW,R8    SCAN89A           IS THIS FIRST CHAR.                         
         BNE      %+2               NO                                          
         LI,R8    0                 YES, CLEAR R8                               
         LW,R9    R8                                                            
         MI,R9    10                CHANGE TO DECIMAL                           
         AI,R10   -X'F0'                                                        
         AW,R9    R10               ADD INTO ACC. SUM                           
         LW,R8    R9                MOVE VALUD TO R8                            
SCAN10   LI,R9    0                 SET EXIT VALUE TO DEC OR HEX                
SCAN11   LW,R0    SCAN91            WAS ) PREVIOUS CHAR.                        
         BEZ      SCAN8             YES, ERROR IN FIELD                         
SCAN12   AI,R6    1                 STEP COL. COUNT                             
         CI,R6    80                COL. 80                                     
         BL       SCAN7             NO                                          
         B        SCAN8             YES, ERROR                                  
SCAN14   LW,R0    R10               CHECK FOR LEGAL EBCDIC CHAR.                
         AND,R0   KXF                                                           
         BEZ      SCAN8             ILLEGAL CHAR.                               
         CI,R0    'A'                                                           
         BGE      SCAN8             ILLEGAL CHAR.                               
         CI,R10   X'E1'                                                         
         BE       SCAN8             ILLEGAL CHAR.                               
SCAN14A  LI,R0    1                                                             
         AND,R11  R0                EBCDIC CONV. REQUESTED                      
         BEZ      SCAN8             NO, ERROR                                   
         LW,R5    SCAN93            GET CHAR. COUNT                             
         AI,R5    8                 GET PROPER BYTE FOR CHAR.                   
         STB,R10  R8,R5             STORE CHAR. IN PROPER BYTE                  
         B        SCAN11                                                        
SCAN19   RES      0                                                             
SCAN20   LI,R0    2                                                             
         AND,R0   R11                                                           
         BEZ      SCAN14A           NOT HEX CONV.                               
         LI,R11   2                 SET TO HEX ONLY                             
         CW,R8    SCAN89A           IS THIS FIRST CHAR.                         
         BNE      SCAN22            NO                                          
         LI,R8    0                 YES, CLEAR R8                               
SCAN22   SLS,R8   4                                                             
         CI,R10   X'F0'                                                         
         BGE      %+2                                                           
         AI,R10   X'39'             CHANGE TO HEX                               
         AI,R10   -X'F0'                                                        
         AW,R8    R10                                                           
         MTW,1    SCAN95            STEP COUNT OF HEX                           
         B        SCAN10            GET NEXT CHAR.                              
SCAN25   CI,R10   X'6B'             COMMA                                       
         BNE      SCAN35            NO                                          
         LW,R0    SCAN91            YES,GET PARENTHESES FLAG                    
         BGZ      SCAN29            NOT END OF FIELD                            
         LI,R0    -1                                                            
         STW,R0   SCAN91            RESET PARENTHESES FLAG                      
SCAN28   MTW,1    SCAN98            SET EXIT PARAM. FOR END OF FIELD            
SCAN29   MTW,1    SCAN90            STEP FIELD FLAG                             
         LW,R10   SCAN93            GET CHAR. COUNT ON EXIT                     
         AI,R10   9                 CHANGE TO POSITIVE                          
         STW,R6   2,R7              RETURN NEXT CHAR PTR                        
SCAN32   XW,R6    SCAN98            SAVE CHAR COUNT AND SET EXIT PM.            
SCAN33   MTW,1    SCAN92            STEP CONT. CARD FLAG                        
         LW,R11   SCAN94            SET R11 TO FIELD NO.                        
         SLS,R11  8                 POSITION TO PROPER BITS                     
         AW,R11   SCAN89            ADD IN BLANKS                               
         LI,R0    0                                                             
         STW,R0   SCAN97            RESET FILE ID SCAN FLAG                     
         B        *SCAN99           EXIT                                        
SCAN35   CI,R10   X'5D'             RIGHT PARENTH.                              
         BNE      SCAN36            NO                                          
         LW,R0    SCAN91            YES, CHECK LEGALITY                         
         BLEZ     SCAN8             ERROR, RT.PARENTH., BUT NO LEFT             
         MTW,-1   SCAN91            SET PARENTH. FLAG TO RT. PARENTH.           
         B        SCAN12            GET NEXT CHAR.                              
SCAN36   CI,R10   X'4D'             LEFT PARENTHSES                             
         BNE      SCAN37            NO                                          
         MTW,0    SCAN91            YES                                         
         BGZ      SCAN8             ERROR, 2 LFT. PARENTH. IN A ROW             
         LI,R0    1                                                             
         STW,R0   SCAN91            SET TO LEFT PARENTH.                        
         B        SCAN12            GET NEXT CHAR.                              
SCAN37   CI,R10   X'40'             BLANK                                       
         BNE      SCAN38            NO                                          
SCAN37B  RES      0                                                             
         LW,R0    SCAN91            GET PARENTH. FLAG                           
         BGZ      SCAN8             ERROR, LFT. BUT NO RIGHT                    
         LW,R0    SCAN90            YES, CHECK FIELD                            
         BNEZ     SCAN37C           SPEC. FIELD, SO EXIT                        
         CI,R10   '.'                                                           
         BE       SCAN37C           B IF END OF CARD                            
         LI,R0    '.'               R0=PERIOD IN BCD                            
SCAN37A  AI,R6    1                                                             
         CI,R6    80                STRIP OFF BLANKS AFTER MNE. FIELD           
         BE       SCAN37C           END OF CARD, NO SPEC. FIELD                 
         CB,R10   *SCAN96,R6                                                    
         BE       SCAN37A           A BLANK                                     
         CB,R0    *SCAN96,R6        IS IT A PERIOD                              
         BE       SCAN37C           YES,NO SPECIFICATION FIELD                  
         AI,R6    -1                RESET TO LAST BLANK                         
         B        SCAN28            GO TO EXIT WITH END OF FIELD                
SCAN37C  MTW,2    SCAN98                                                        
         B        SCAN29                                                        
SCAN38   CI,R10   X'5E'             ;                                           
         BNE      SCAN39            NO                                          
         LW,R0    SCAN90                                                        
         BEZ      SCAN8             NOT ALLOWED IN MNEMONIC FIELD               
         LW,R0    SCAN91                                                        
         BGZ      SCAN8             ERROR, LFT. PARENTH., BUT NO RIGHT          
         LI,R0    -1                                                            
         STW,R0   SCAN92            SET CONT. CARD FLAG                         
         B        SCAN28                                                        
SCAN39   RES      0                                                             
         CI,R10   '.'                                                           
         BNE      SCAN40            B IF NOT PERIOD                             
         MTW,0    SCAN97                                                        
         BEZ      SCAN37B           B IF NOT SCANNING FILE ID FIELD             
         MTW,3    SCAN98            END OF FILE ID FIELD FLAG                   
         B        SCAN29                                                        
*****                                                                           
SCAN40   RES      0                                                             
         CI,R10   '%'               CHECK FOR LEGAL EBCDIC CHAR                 
         BE       SCAN41            OK                                          
         CI,R10   ':'                                                           
         BL       SCAN8             ILLEGAL CHAR.                               
         CI,R10   X'7C'                                                         
         BG       SCAN8             ILLEGAL CHAR.                               
SCAN41   MTW,1    SCAN93            OK, STEP CHAR. COUNT                        
         BNEZ     SCAN14A                                                       
         B        SCAN8             ERROR,TOO MANY CHARS.                       
*                                                                               
SCAN88   DATA     0                 SAVE R7 HERE                                
SCAN89   DATA     X'40000040'       BLANKS                                      
SCAN89A  DATA     X'40404040'       EBCDIC BLANKS                               
SCAN90   DATA     0                 FIELD FLAG                                  
SCAN91   DATA     0                 PARENTHESES FLAG                            
SCAN92   DATA     1                 CONT. CARD FLAG                             
SCAN93   DATA     0                 CHAR. COUNT                                 
SCAN94   DATA     0                 FIELD COUNT                                 
SCAN95   DATA     0                 COUNT OF HEX CHARS.                         
SCAN96   DATA     0                 ADD. OF CARD BUFFER                         
SCAN97   DATA     0                 =0 IF PERIOD MEANS END OF CMND              
*                                   =1 IF END OF FILE ID FIELD                  
SCAN98   DATA     0                 COL. INDEX AND EXIT PM. R6                  
SCAN99   DATA     0                 RETURN ADDRESS                              
OVLOAD   DATA     0                 START OF OVLOAD TABLE (FOR LOAD)            
         END                                                                    
