**********************************************************************          
*                                                                    *          
*                                                                    *          
*  R B M - 2   J O B  C O N T R O L  P R O C E S S O R               *          
*                                                                    *          
*                                                                    *          
**********************************************************************          
         PAGE                                                                   
         SYSTEM   SIG5P                                                         
         SYSTEM   OPTIONS                                                       
         DEF      JCP                                                           
*                                                                               
         REF      S:SPAI                                                        
         REF      MMGJRP,MMRJRP                                                 
         REF      JMTERM                                                        
         REF      SEARCHAI                                                      
         REF      TMFINDJ                                                       
         REF      DCT4                                                          
         REF      DCT7                                                          
         REF      DCT16                                                         
         REF      MDNAME,MDFLAG,MDDCTI,MDBOA,MDEOA,MDDISCI                      
         REF      DISCNWPS                                                      
         REF      OPLB1,OPLB2,OPLB3                                             
         REF      RFT1,RFT2,RFT3,RFT4,RFT5,RFT6,RFT7                            
         REF      RFT8,RFT9,RFT10,RFT11,RFT12,RFT13,RFT14                       
         REF      RFTACNT,RFTE#,RFTESZ                                          
         REF      CIT1,CIT2,CIT3                                                
         REF      IOQ1,IOQ2,IOQ3                                                
         REF      Y04                                                           
         REF      RFT15,STILMID                                                 
         REF      LMIRFT                                                        
         REF      JCBBKG                                                        
         REF      GENCHARS                                                      
         REF      SITE                                                          
         REF      JOB#                                                          
         DO       #SYMB                                                   39.010
         REF      JOBPRI                                                        
         REF      SYMB                                                          
         FIN                        #SYMB                                 42.010
         REF      RBMEND                                                        
         REF      M7                                                            
         REF      Y0004                                                         
         REF      JCPSETP,JCPCATW                                               
IOSTUF   CNAME                                                                  
         PROC                                                                   
         LOCAL    DCBAD                                                         
DCBAD    RES      0                                                             
         GEN,8,24 7,1                                                           
         GEN,8,16,8  3,CF(2),0                                                  
         DATA,4   0,0,0,AF(3),AF(4)                                             
LF       RES      0                                                             
         GEN,8,24 X'15',DCBAD                                                   
         DATA,4   0                                                             
         GEN,8,24 X'10'+AF(1),DCBAD                                             
         GEN,4,6,22  15,1,X'10'                                                 
         DATA,4   AF(2),AF(2),AF(5),80,0                                        
         PEND                                                                   
*                                                                               
         TITLE    '***** ASSEMBLY CONSTANTS *****'                              
*                                                                               
*                                                                               
OPLBS1   EQU      OPLB1                                                         
OPLBS2   EQU      OPLB2                                                         
OPLBS3   EQU      OPLB3                                                         
BKGJID   EQU      2                                                             
BT#      EQU      RFT15                                                         
BTINDEX  EQU      3                 INDEX FOR BT AREA                           
ALLOC    EQU      X'80'             ALLOCATED FLAG BIT IN MDFLAG                
*                                                                               
PCBPOINT EQU      X'4E'                                                         
TCBPOINT EQU      X'4F'                                                         
DCT#     EQU      DCT7                                                          
DCT4:TY  EQU      1                 TY                                          
JCBACCNT EQU      X'12'             ACCOUNT/USER NAME BLOCK                     
JCBNXLM  EQU      17                NEXT LOAD MODULE ID BLOCK PTR               
JCBDBUG  EQU      X'C'                                                          
JCBTIME  EQU      X'17'                                                         
JCBSY    EQU      X'40000'          SYSTEM PRIVILEGE FLAG                       
*                                                                               
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:FGDBG1 EQU      X'142'            CURRENT BEGINNING ADDRESS OF FGD.           
K:FGDEND EQU      X'143'            ENDING ADDRESS OF FGD.                      
K:CCBUF  EQU      X'144'            ADDRESS OF CONTROL CARD BUFFER              
K:BPOOL  EQU      X'145'            START ADD. OF BCKG BLK BUFFER POOL          
K:FGDBG2 EQU      X'146'            BEG. ADD. OF FGD. SET AT SYSGEN             
K:FMBOX  EQU      X'147'            START ADD. OF FGD. MAILBOXES                
K:FPOOL  EQU      X'148'            START ADD. OF FGD. BLK BUFFER POOL          
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:VRSION EQU      X'14C'            RBM VERSION                                 
K:ACCNT  EQU      X'14D'            JOB ACCOUNTING FLAG                         
K:OV     EQU      X'14E'            PERM. AND CURRENT SIZES OF OV               
K:KEYST  EQU      X'14F'            POST STATUS OF KEYIN HERE                   
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:CTST   EQU      X'151'            FLAGS TO EXECUTE CONTROL TASK SUBTSK        
*                                   BITS HAVE FOLLOWING MEANING:                
*        BIT  0=1, EXECUTE CHECKPOINT                                           
*        BIT  1=1, EXECUTE FGD. LOADER/RELEASER                                 
*        BIT  2=1, EXECUTE RESTART                                              
*        BIT  3=1, SERVICE ALL DEVICES                                          
*        BIT  4=1, EXECUTE ABORT/EXIT                                           
*        BIT  5=1, EXECUTE KEYIN                                                
*        BIT  6=1, EXECUTE PMD                                                  
*        BIT  7=1, EXECUTE IDLE                                                 
*        BIT  8=1, EXECUTE BCKG. LOAD                                           
*        BIT  9=1, LOAD JCP                                                     
*        BIT 10=1,  LOAD BCKG. PROG,NOT JCP                                     
*        BIT 11=1, KEYIN REQUIRED BY A HIGHER PRIORITY SUBTASK                  
*        BIT 12=1, RECYCLE FGL1/2 TO FGL1 FOR POSSIBLE RLS /SIG7-2005/*C5732 C01
*        BIT 26=1, KEY2 DOING STDLB RAD FILE OPEN/CLOSE    /SIG7-2619/*C015732  
*        BIT 27=1, FGL1 CALLED FROM FGL2                                        
*        BIT 28=1, CTASK IS RUNNING                        1SIG7-1553/*C5732    
*        BIT 29=0, EXECUTE ABORT PART OF ABORT/EXIT                             
*        BIT 29=1, EXECUTE EXIT  PART OF ABORT/EXIT                             
*        BIT 30=1, PMD FROM KEY-IN REQUEST                                      
*        BIT 31=1, PMD FROM PMD COMMAND                                         
*                                                                               
K:SY     EQU      X'152'            NON ZERO IF SY KEY-IN ACTIVE                
K:BPEND  EQU       X'153'           END OF LOAD AREA FOR BCKG. PROG.            
K:CTWD   EQU      X'154'            WD CODE FOR CONTROL TASK                    
*                                   BYTE 0=NONZERO MEANS CT WAS TRIGG.          
K:CTGL   EQU      X'155'            GROUP LEVEL FOR CONTROL TASK                
K:BLOAD  EQU      X'156'            NAME IN BCD OF BCK PROG. TO LOAD            
*                                     TWO WORDS                                 
K:BAREA  EQU      X'158'            AREA TO LOAD BCK. PROGRAM FROM              
K:ASSIGN EQU      X'159'            ADDRESS OF ASSIGN TABLE                     
K:RUNF   EQU      X'15A'            POST RUN STATUS HERE FOR FGD LOAD           
K:HIINT  EQU      X'15B'            HW0 = CTRL TASK INT LEVEL                   
*                                   HW1 = HIGHEST ADDRESS USED FOR INT          
K:FGDBG3 EQU      X'15C'            BEGIN ADDRESS OF FGD. FROM FMEM KEYN        
K:PMD    EQU      X'15D'            CELLS TO DUMP FOR PMD AS DW ADDRSS.         
*                                      5 WORDS                                  
K:DCB    EQU      X'162'            DCB FOR CONTROL TASK TO LOAD IN             
*                                    OLAYS- 7 WORDS- ALWAYS ASSIGNED TO         
*                                    RBM FILE                                   
K:KEYIN  EQU      X'169'            KEYIN RESPONSE BUFFER- 6 WORDS              
K:FGDBG4 EQU      X'16F'            BYTE 0=FWA OF FGD PRIOR TO CKPT-PAGE        
*                                   BITS 15-31=K:BCKEND PRIOR TO CKPT           
K:DELTA  EQU      X'170'            ENTRY POINT FOR DELTA                       
K:QUEUE  EQU      X'171'            ADDRESS OF QUEUE ROUTINE                    
*                                   BYTE 0=NONZERO,STOP I/O ON BCKG.            
K:BTFILE EQU      X'172'            STATUS OF BT FILES                          
*                                     BITS 0-8, 1 BIT FOR EACH XI FILE          
*                                               1 MEANS SAVE FILE               
*                                     BITS 16-31, LWA TO USE FOR NON            
*                                                 SAVE FILES                    
K:GO     EQU      X'173'            PERM. AND CURRENT SIZES OF GO               
K:PAGE   EQU      X'174'            BYTE 0=NO. LINES PER PAGE                   
K:RDBOOT EQU      X'175'            FWA AND DEVICE NO. OF RADBOOT               
K:DCT1   EQU      X'176'            ADDRESSES OF TABLES                         
K:DCT16  EQU      X'177'                                                        
K:OPLBS1 EQU      X'178'                                                        
K:OPLBS3 EQU      X'179'                                                        
K:RFT4   EQU      X'17A'                                                        
K:RFT5   EQU      X'17B'                                                        
K:SERDEV EQU      X'17C'            ADDRESS OF SERDEV                           
K:REQCOM EQU      X'17D'            ADDRESS OF REQCOM                           
K:INITX  EQU      X'17E'            ADD. TO RETURN TO AFTER INIT. RUNS          
K:FGLD   EQU      X'17F'            BYTE 0=NONZERO, XEQ FGD LOAD/RLS            
K:PMD1   EQU      X'180'            FORMAT FLAG,FWA,NO. CELLS                   
K:RUNBPL EQU      X'185'            CELLS TO POST STATUS IN FOR BCKG.           
*                                     PUB LIB LOAD- 3 CELLS                     
*                                                                               
*                                   THE CLOCK CELLS MUST START ON A DW          
K:CLK1   EQU      X'188'            COUNTERS FOR 4 CLOCKS- 2 WORDS/CLOCK        
K:CLK2   EQU      X'18A'            WORD 2 GETS STORED INTO WORD 1 WHEN         
K:CLK3   EQU      X'18C'              COUNTER=0                                 
K:ABTLOC EQU      X'18E'            LOC. AT WHICH BCKG WAS ABORTED              
K:MSG1   EQU      X'190'            KEY-IN                                      
K:MSG2   EQU      X'193'            KEY ERR                                     
K:MSG3   EQU      X'196'            RLS NAME NA                                 
K:MSG4   EQU      X'19A'            FILE NAME ERR                               
K:MSG5   EQU      X'19E'            FGD AREA ACTIVE                             
K:MSG6   EQU      X'1A3'            NOT ENUF BCKG SPACE                         
K:MSG7   EQU      X'1A9'            UNABLE TO DO ASSIGN                         
K:MSG8   EQU      X'1AF'            BCKG CKPT                                   
K:MSG9   EQU      X'1B2'            BKG IN USE BY FGD                           
K:MSG10  EQU      X'1B7'            BCKG RESTART                                
K:MSG11  EQU      X'1BB'            CK AREA TOO SMALL                           
K:MSG12  EQU      X'1C0'            I/O ERR ON CKPT                             
K:MSG13  EQU      X'1C5'            JOB ABORTED AT XXXXX                        
K:MSG14  EQU      X'1CB'            LOADED PROG            /SIG7-3785/*C5732 C01
K:MSG15  EQU      X'1CF'            UNABLE LOAD BKG PUB LIB/SIG7-3785/*C5732 C01
K:MSG16  EQU      X'1D7'            CKPT WAITING FOR BKG   /SIG7-3785/*C5732 C01
*                                            I/O RUNDOWN   /SIG7-3785/*C5732 C01
*                                                                               
K:FPSIM  EQU      X'1E6'            ADDRESS OF SIMULATION ROUTINES              
K:DECSIM EQU      X'1E7'                                                        
K:BYTSIM EQU      X'1E8'                                                        
K:CVSIM  EQU      X'1E9'                                                        
*                 CELLS FOR JOB ACCOUNTING                                      
K:MONTH  EQU      X'1EA'            TABLE OF DAYS/MONTH AND BCD NAMES           
K:DATE1  EQU      X'1F6'            MAX. NO. DAYS IN YEAR, YEAR-1960            
K:DATE2  EQU      X'1F7'            DAY OF YEAR                                 
K:TIME   EQU      X'1F8'            TIME OF DAY IN SECONDS                      
K:BPGLIM EQU      X'1F9'            BKG PAGE OUTPUT LIMIT CONTROL               
K:LIMIT  EQU      X'1FA'            MAX. EXEC. TIME FOR BCKG                    
K:ACCNAM EQU      X'1FB'            ACCOUNT ENTRY FOR AL FILE - 8 WORDS         
K:ELTIM2 EQU      X'202'             LAST WD OF ENTRY- ELPASED TIME             
K:MDNAME EQU      X'212'            FILE AREA NAME TABLE POINTER                
K:RUNJ   EQU      X'215'            STATUS FOR RUN CAL FROM JCP                 
CFPTSZ   EQU      2                                                             
*                                                                               
         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,JCP                                   
         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,JCP                                
         FIN                                                                    
         PEND                                                                   
         TITLE    '***** JCP LOAD MODULE HEADER *****'                          
*                                                                               
*        LOAD MODULE HEADER                                                     
         GEN,8,24 X'04',JCP                                                     
         GEN,8,24 X'FF',ENDJCP-1    MAX SECBS, LWA                              
         GEN,8,24 X'FF',A01         MAX RECBS, ENTRY                            
         GEN,8,24 X'FF',BA(ENDJCP)-BA(JCP)  MAX ENQS, ROOT VMBL                 
         GEN,8,24 1,JCP             NR SEGS,ROOT WA                             
         DATA     BA(ENDJCP)-BA(JCP)  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)                 
JCP      RES      0                                                             
A:JCP    EQU      JCP                                                           
         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                   
ENTRY    DATA     A01,0,0,0         ENTRY ADDRESS FOR JCP                       
         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:C     '                                                    
         DATA     F:C                                                           
         TEXT     'F:DC    '                                                    
         DATA     F:DC                                                          
         TEXT     'F:POS   '                                                    
         DATA     F:POS                                                         
         TEXT     'F:AL    '                                                    
         DATA     F:AL                                                          
         TEXT     'F:LL    '                                                    
         DATA     F:LL                                                          
         TEXT     'B:LL    '                                                    
         DATA     B:LL                                                          
         TEXT     'F:LO    '                                                    
         DATA     F:LO                                                          
         TEXT     'B:LO    '                                                    
         DATA     B:LO                                                          
         TEXT     'F:OC    '                                                    
         DATA     F:OC                                                          
         TEXT     'F:OPEN  '                                                    
         DATA     F:OPEN                                                        
DCBTAB2  RES      0                                                             
*                                   FPT'S                                       
         BOUND    8                                                             
LPSD     DATA     LPSDAD+1**(31-9),0   NEXT WORD, MAPPED, WK=0                  
         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)            
*                                                                               
CHKC     GEN,8,24 X'29',F:C                                                     
         GEN,16,16  X'C000',0       CHECK WITH WAIT                             
         PZE      ERRC              ERROR RETURN                                
         PZE      ERRC              ABNORMAL RETURN                             
*                                                                               
CHECKC   GEN,8,24 X'29',F:C         FPT FOR CHECK C DEVICE READ                 
         GEN,3,29 7,0                                                           
         DATA     ERRC                                                          
         DATA     ERRC                                                          
         DATA     A30               BUSY ADDRESS TO GO TO                       
*                                                                               
CLOSE    GEN,8,24 X'15',0           ADDRESS OF DCB IS STORED IN                 
         GEN,2,30 3,0                                                           
         DATA     ERRCLO                                                        
         DATA     ERRCLO                                                        
*                                                                               
CLOSE2   GEN,1,7,24 1,X'15',R14     CLOSE OFFENDING DCB IN IO ERR EXIT          
         DATA     1                 ABORT OVERRIDE                              
*                                                                               
DELFPTC  GEN,8,1,23  X'47',1,F:C    DELETE READ C REQUEST                       
         DATA     1                 DCB REQUEST, IGNORE ERRORS                  
*                                                                               
DELFPTS  GEN,8,1,23  X'47',1,STIMFPT  DELETE STIMER REQUEST                     
         DATA     X'00400001'       FPT REQUEST, IGNORE ERRORS                  
*                                                                               
DFMAL    GEN,8,24 X'22',F:AL        DEV. MODE FPT FOR AL FILE                   
         GEN,2,30 3,0                                                           
         DATA     32                                                            
         DATA     1                                                             
*                                                                               
MASTER   GEN,8,1,23  8,0,0          MASTER MODE REQUEST                         
*                                                                               
OPEN     GEN,8,24 X'14',F:OPEN                                                  
         GEN,2,30 3,0                                                           
         DATA     ERROPEN                                                       
         DATA     ERROPEN                                                       
*                                                                               
OPENB    GEN,1,7,24  1,X'14',BFPT   OPEN BFPT DCB                               
         DATA     1                 IGNORE ERRORS                               
*                                                                               
OPENAL   GEN,8,24 X'14',F:AL                                                    
         GEN,2,30 3,0                                                           
         DATA     ERRAL                                                         
         DATA     ERRAL                                                         
*                                                                               
POSAL    GEN,8,24 X'1C',F:AL                                                    
         DATA     0                                                             
*                                                                               
POSFILE  GEN,8,24 X'1C',F:POS       FPT FOR POSITION FILE                       
         DATA     0                                                             
*                                                                               
POSREC   GEN,8,24 X'1D',F:POS       FPT FOR POSITION RECORD                     
         GEN,2,30 3,0                                                           
         DATA     0                                                             
         DATA     ERRPOS                                                        
*                                                                               
PROMTFPT GEN,8,1,23  X'2C',0,'#'    SET PROMPT FOR KEYBOARD INPUT               
*                                                                               
PRINT    GEN,8,24 1,0               FPT FOR PRINT CAL                           
         GEN,1,31 1,X'10'           MSG PRESENT, WAIT                           
         DATA     0                 STORED INTO                                 
*                                                                               
READAL   GEN,8,24 X'10',F:AL                                                    
         GEN,2,30 3,X'10'                                                       
         DATA     ERRAL                                                         
         DATA     ERRAL                                                         
*                                                                               
READC    GEN,8,24 X'10',F:C         FPT FOR READ FROM C DEVICE                  
         GEN,16,16  X'C000',0       READ WITHOUT WAIT                           
         PZE      ERRC              ERROR RETURN                                
         PZE      ERRC              ABNORMAL RETURN                             
*                                                                               
READFH   GEN,8,24 X'10',F:DC                                                    
         GEN,8,24 X'C1',X'10'                                                   
         DATA     ERRDC                                                         
         DATA     ERRDC                                                         
         DATA     0                                                             
*                                                                               
REWIND   GEN,8,24 1,F:POS           FPT FOR REWIND                              
*                                                                               
REWINDAL GEN,8,24 1,F:AL                                                        
*                                                                               
         BOUND    8                                                             
RUN      GEN,8,24 X'0C',N92                                                     
         DATA     0,0,0                                                         
STDLBFPT GEN,8,1,23  X'62',1,0      STDLB FPT                                   
STDLBBTS DATA     X'80000010'                                                   
         DATA     STDLBERR                                                      
STDLBPTR DATA     GIOCT+1           I/O STREAM ID POINTER                       
         DATA     GIOCT+4           FILE ACCOUNT POINTER (IF NEEDED)            
*                                                                               
STIMFPT  GEN,8,1,23  X'44',1,0      STIMER FPT                                  
         DATA     X'00080000'                                                   
         DATA     2                 2-SECOND INTERVAL                           
*                                                                               
TYPE     GEN,8,24 2,0               FPT FOR TYPE CAL                            
         GEN,1,31 1,X'10'           MSG PRESENT, WAIT                           
         DATA     0                                                             
*                                                                               
         DO       #SYMB                                                         
TYPE2    GEN,8,24 2,0               TYPE INTRODUCTION TO OC                     
         DATA     X'80000000'       NO WAIT                                     
         DATA     MSG43+1           MSG ADDRESS                                 
         FIN      #SYMB                                                         
*                                                                               
WALLFPT  GEN,8,1,23  X'40',0,0      WAITALL (USED AT JOB CLEANUP)               
*                                                                               
WANYFPT  GEN,8,1,23  X'41',1,0      WAITANY FOR READ C OR STIMER                
         DATA     X'C0000000'       P1, P2                                      
         DATA     ERRC              ERROR ADDRESS                               
         DATA     ERRC              ABNORMAL ADDRESS                            
*                                                                               
WRITEAL  GEN,8,24 X'11',F:AL                                                    
         GEN,2,30 3,X'10'                                                       
         DATA     ERRAL                                                         
         DATA     ERRAL                                                         
*                                                                               
WRITELL  GEN,8,24 X'11',F:LL        FPT TO WRITE LL                             
         GEN,2,30 3,X'10'                                                       
         DATA     ERRLL                                                         
         DATA     ERRLL                                                         
*                                                                               
BFPT     GEN,8,24 X'11',B:LL                               /SIG7-4920/*C5732 C01
         DATA     X'F4000010'                                                   
         PZE      ERRLL                                                         
         PZE      ERRLL                                                         
         PZE      *R11              BUFFER ADR             /SIG7-4920/*C5732 C01
         PZE      *R0               BYTE COUNT             /SIG7-4920/*C5732 C01
         DATA     0                 BTD                                         
*                                                                               
BFPT1    GEN,8,24  X'11',B:LL       WRITE LL                                    
*                                                                               
BFPT2    GEN,8,24  X'11',B:LO       WRITE LO                                    
*                                                                               
BR0COR   GEN,1,7,24  1,X'2B',BFPT   BFPT DCB CORRES DCB IN R0                   
         PZE      *R0                                                           
*                                                                               
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                
*                                                                               
WEOF     GEN,8,24 2,F:POS           FPT FOR WRITE EOF                           
*                                                                               
WEOFAL   GEN,8,24 2,F:AL                                                        
*                                                                               
UNLOAD   GEN,8,24 3,F:POS                                                       
         TITLE    '***** DCBS *****'                                            
*                                                                               
*                                                                               
*                                                                               
         BOUND    8                                                             
         DATA     0                                                             
F:AL     GEN,8,16,1,7  9,0,1,1                                                  
         GEN,8,24 3,0                                                           
         DATA     INBUF1                                                        
         GEN,15,17 32,ERRAL                                                     
         DATA     ERRAL                                                         
         TEXT     'AL      '                                                    
         DATA     1**31             P-BIT FOR AREA NAME                         
         DATA     #ALAREA                                                       
         BOUND    8                                                             
         DATA     0                 FORCE ON ODD BOUNDARY                       
F:C      GEN,8,16,8 5,1,3                                                       
         GEN,8,16,8  3,0,C                                                      
         DATA      0                                                            
         GEN,15,17 120,ERRC                                                     
         DATA      ERRC                                                         
F:CLOSE  GEN,8,3,21  5,1,1                                                      
         DATA     0                                                             
         DATA     0                                                             
         DATA     ERRCLO                                                        
         DATA     ERRCLO                                                        
         BOUND    8                                                             
         DATA     0                 FORCE ON ODD BOUNDARY                       
F:DC     GEN,8,24 11,1              DCB TO READ LD MODULE HEADERS               
         GEN,8,16,8  3,0,0                                                      
         DATA        BUFF1                                                      
         GEN,15,17  100,ERRDC                                                   
         DATA        ERRDC                                                      
         DATA     0,0,0,0,0,0                                                   
F:LL     GEN,8,16,8 5,1,X'33'       VFC, START IN BYTE 3                        
         GEN,8,16,8  3,0,LL                                                     
         DATA      0                BUFFER ADD. SET TO K:CCBUF                  
         GEN,15,17 81,ERRLL                                                     
         DATA      ERRLL                                                        
B:LL     GEN,8,16,8 5,1,3           VFC                    /SIG7-4920/*C5732 C01
         GEN,8,16,8  3,0,LL                                                     
         DATA     0                                        /SIG7-4920/*C5732 C01
         DATA     ERRLL                                    /SIG7-4920/*C5732 C01
         DATA     ERRLL                                    /SIG7-4920/*C5732 C01
F:LO     GEN,8,16,8  5,1,3          DCB FOR LO                                  
         GEN,8,16,8  3,0,LO                                                     
         DATA        0                                                          
         GEN,15,17   133,ERRLO                                                  
         DATA        ERRLO                                                      
B:LO     GEN,8,16,8 5,1,3                                                       
         GEN,8,16,8  3,0,LO                                                     
         DATA     0                                                             
         DATA     ERRLL             TREAT AS LL ERROR (STOP BKG)                
         DATA     ERRLL                                                         
F:OC     GEN,8,16,8  5,0,X'33'                                                  
         GEN,8,16,8  3,0,OC                                                     
         DATA        0                                                          
         GEN,15,17   81,ERROC                                                   
         DATA        ERROC                                                      
         BOUND    8                                                             
         DATA     0                 FORCE TO ODD BOUNDARY                       
F:OPEN   GEN,8,24 11,1              DCB TO VALIDATE ASSIGN CMNDS                
         GEN,8,16,8  3,0,0                                                      
         DATA     0                                                             
         DATA     ERROPEN                                                       
         DATA     ERROPEN                                                       
         DATA     0,0,0,0,0,0                                                   
         BOUND    8                                                             
         DATA     0                 FORCE ON ODD BOUNDARY                       
F:POS    GEN,8,24 11,0              DCB FOR UTILITY COMMANDS                    
         GEN,8,16,8  3,0,0                                                      
         DATA     0                                                             
         DATA     ERRPOS                                                        
         DATA     ERRPOS                                                        
         DATA     0,0,0,0,0,0                                                   
         BOUND    8                                                             
         DATA,4   0                 FORCE ON ODD BOUNDARY                       
CATDCB   RES      0                 DCB TO CLOSE SP,CATALOG                     
         GEN,8,3,21    7,1,1                                                    
         DATA,4   0,0,RSETCAT,RSETCAT                                           
CATNAME  RES      0                                                             
         TEXT     'CATALOG '                                                    
FAKECLOS DATA,4   0,X'20'                                                       
CSPCAT   RES      0                                                             
         GEN,8,24 X'15',CATDCB                                                  
         DATA,4   0                                                             
*                                                                               
*                                                                               
*                                   PARAMETERS, CONSTANTS, AND FLAGS            
BTFILE   DATA,2   11,'OV','GO'      BCD NAMES OF BT FILES                       
         DATA,2   'X1','X2','X3'                                                
         DATA,2   'X4','X5','X6'                                                
         DATA,2   'X7','X8','X9'                                                
         BOUND    4                                                             
*                                   TABLES TO STORE DATA FROM ALLOBT            
GSIZE    DATA,2   0,0,0,0,0,0,0,0,0,0,0,0                                       
         BOUND    4                                                             
FSIZE    DATA,4   0,0,0,0,0,0,0,0,0,0,0,0                                       
         BOUND    4                                                             
FORM     DATA,1   0,0,0,0,0,0,0,0,0,0,0,0                                       
         BOUND    4                                                             
SAVE     DATA,1   0,0,0,0,0,0,0,0,0,0,0,0      1=SAVE, 0=DONT'T SAVE            
         BOUND    4                                                             
RSIZE    DATA,2   -1,-1,-1,-1,-1,-1,-1,-1     -1=NOT INPUT ON ALLOBT            
         DATA,2   -1,-1,-1,-1                                                   
         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     0                 CONVERSION TYPE FLAG                        
SCANPMB  DATA     0                 FIRST TIME FLAG                             
         DATA     CONTCRD           ADDRESS OF ROUTINE TO HANDLE                
*                                     CONT. CARD                                
         BOUND    8                                                             
BUFF1    RES      64                BUFFER FOR ALMOST ANYTHING                  
INBUF1   RES      8                 BUFFER FOR ACCOUNTING LOG RECORDS           
*                                                                               
*                                   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                               
DISABLE  EQU      X'37'             CODE FOR DISABLE INTERRUPTS                 
ENABLE   EQU      X'27'             CODE TO ENABLE INTERRUPTS                   
DEBUGBIT EQU      X'100'            K:JCP1 FLAG: RUN BKG UNDER DEBUG            
X8       EQU      8                                                             
X18      EQU      X'18'                                                         
X20      EQU      X'20'                                                         
X100     EQU      X'100'                                                        
K1       DATA     1                                                             
K2       DATA     2                                                             
K10      DATA     10                                                            
K60      DATA     60                                                            
K1000    DATA     1000                                                          
K3600    DATA     3600                                                          
KXF      DATA     X'F'                                                          
KX3F     DATA     X'3F'                                                         
KX7F     DATA     X'7F'                                                         
KXFF     DATA     X'FF'                                                         
KX1FF    DATA     X'1FF'                                                        
KXFFFF   DATA     X'FFFF'                                                       
KX1FFFF  DATA     X'1FFFF'                                                      
KX7FFFFF DATA     X'007FFFFF'                                                   
KL7      DATA     X'FE000000'                                                   
KL8      DATA     X'FF000000'                                                   
KL9      DATA     X'FF800000'                                                   
KL15     DATA     X'FFFE0000'                                                   
KL2      DATA     X'20000000'                                                   
KL01     DATA     X'01000000'                                                   
KL02     DATA     X'02000000'                                                   
KL0FF    DATA     X'0FF00000'                                                   
KL002    DATA     X'200000'                                                     
KL000F   DATA     X'000F0000'                                                   
KL21     DATA     X'FFFFF800'                                                   
KL23     DATA     X'FFFFFE00'                                                   
KL24     DATA     X'FFFFFF00'                                                   
KM1      DATA     -1                                                            
KM2      DATA     -2                                                            
KM8      DATA     -8                                                            
KSIGN    DATA     X'80000000'                                                   
F0404040 DATA      X'F0404040'                             /SIG7-1671/*B5732    
BANGCAT  DATA     ' CAT'                                                        
BLBLBL   DATA     '   '                                                         
         BOUND    8                                                             
KOV      TEXT     'OV      '                                                    
DFLTACNT DATA,S:NUMC(#NOACNT) #NOACNT                                           
         DO       8-S:NUMC(#NOACNT)                                             
         DATA,1   ' '                                                           
         FIN                        8-S:NUMC(#NOACNT)                           
KBLANKS  TEXT     '        '        8 BLANKS                                    
KMACROSY TEXT     'MACRSYM'                                                     
KAP      TEXT     'AP      '                                                    
KMCI     TEXT     'M:CI    '                                                    
KMSI     TEXT     'M:SI    '                                                    
SYSACNT  TEXT     #SYSACNT          DEFAULT SYSTEM ACCOUNT NAME                 
KZEROS   DATA     0,0                                                           
KBKG     TEXT     'BKG'                                                         
KCOC     TEXT     'COC '                                                        
KCI      TEXT     'CI  '                                                        
KSI      TEXT     'SI  '                                                        
KCPR     TEXT     ' CPR'                                                        
DEBUG    TEXT     'DEB'                                                         
KACC     TEXT     'ACC '                                                        
IDLE     EQU      KL01                                                          
BKLD     DATA     X'00A00000'                                                   
NLBB     DATA     X'155A5A00'       NL, BANG, BANG, 0                           
         TITLE    '**** JCP CONTROL SECTION ****'                               
*                                                                               
*                                   JCP RUNS IN MASTER MODE, AND HAS            
*                                     SKELETON KEY                              
*                                   CONTROL SECTION READS CONTROL               
*                                     COMMANDS AND TRANSFERS CONTROL TO         
*                                     APPROPRIATE ROUTINE                       
*                                                                               
*                                   ENTRY POINT                                 
A01      CAL1,5   MASTER            CHANGE TO MASTER MODE                       
         LPSD,0   LPSD              GET SKELETON WRITE KEY,                     
LPSDAD   RES      0                 AND UNPROTECTED MEMORY MODE                 
         CAL1,1   PROMTFPT          SET BACKGROUND PROMPT                       
         BAL,R8   B20               CLEAR PMD REQUESTS                          
         LW,R0    K:CCBUF                                                       
         BNEZ     A01A              BRANCH IF ASSIGN/CC PAGE                    
*                                   ALREADY ACQUIRED                            
         LI,R0    0                 ACCESS PROTECTION READ/WRITE                
         BAL,R8   MMGJRP            GET A JOB-RESERVED PAGE                     
         B        %                 SHOULD NOT HAPPEN                           
         SLS,R14  9                 VPN TO WA                                   
         AI,R14   1                                                             
         STW,R14  K:CCBUF                                                       
         STW,R14  R0                                                            
         AI,R14   510                                                           
         STW,R14  K:ASSIGN                                                      
A01A     STW,R0   F:C+2             STORE ADD. OF CONTROL CARD BUFFER           
         STW,R0   SCANPM              INTO DCB'S                                
         AI,R0    -1                BACK UP 1 FOR FORMAT BYTE                   
         STW,R0   F:LL+2                                                        
         LI,R1    3                                                             
         LI,R4    0                                                             
         LI,R5    0                                                             
         LW,R3    K:BTFILE          PURGE ALL XI FILES NOT SAVED                
A02      RES      0                                                             
         CB,R1    BT#               DONE WITH BT FILES                          
         BG       A02E              YES                                         
         SLS,R3   1                 NO, WAS THIS FILE SAVED                     
         BCS,8    %+2               YES, DON'T PURGE                            
         STD,R4   RFT1,R1           NO, PURGE BY CLEARING OUT NAME              
         AI,R1    1                 STEP TO NEXT FILE                           
         B        A02                                                           
A02E     LB,R0    K:JCP1                                                        
         CI,R0    4                 WAS SKIP FLAG SET BY ABORT                  
         BANZ     A08C              YES, SKIP TO A JOB CARD                     
A03      LI,R1    C                                                             
         LB,R0    OPLBS3,R1         GET CURRENT ASSIGN. OF C                    
         BEZ      %-1                LOOP IF C DEVICE ASSIGN. TO 0              
         STW,R0   A94               SAVE IT                                     
         CAL1,1   READC             GO READ NEXT CONTROL CMD                    
A03B     RES      0                                                             
         CAL1,1   CHECKC            CHECK COMMAND READ (NO WAIT)                
A03C     RES      0                                                             
         LI,R0    1                                                             
         STW,R0   SCANPMA                                                       
         LI,R0    0                                                             
         STW,R0   SCANPMB           SET UP CALL FOR SCAN                        
         LI,R7    SCANPM                                                        
         BAL,R8   SCAN              GO GET FIRST FIELD                          
         STD,R8   PNCX              STORE FIELD            /SIG7-4947/*C015732  
         LI,R1    3                                                             
         LI,R0    C                 SWITCH INPUT DEV. TO C, IF NOT              
         STB,R0   F:C+1,R1             ALREADY                                  
         LI,R0    X'C0'             SET TO SINGLE SPACE                         
         STW,R0   *F:LL+2                                                       
         CI,R6    0                                                             
         BG       A10               BRANCH IF FIRST FIELD                       
A05      RES      0                                                             
         LW,R0    BRANCHF                                                       
         BNEZ     %+5               BRANCH SKIP  BRANCH                         
         LW,R0    CSKIPF            ARE WE IN SELECTIVE SKIP                    
         BNEZ     %+3               YES  BRANCH                                 
         LW,R0    A92               ARE WE IN SKIP MODE                         
         BEZ      A07               NO                                          
         LB,R0    *K:CCBUF          YES                                         
         CI,R0    X'5A'             IS IT A CONTROL CARD                        
         BNE      A03               NO, DON'T LOG                               
A06      LI,R0    X'6E'             YES, REPLACE EXCLAM. WITH >                 
         STB,R0   *K:CCBUF                                                      
         CAL1,1   WRITELL           GO LOG CONTROL CARD SKIPPED                 
         B        A03                                                           
A07      CAL1,1   WRITELL           GO LOG COMMAND                              
A08      LI,R9    MSG2              ERROR ENTRU                                 
A08B     RES      0                                                             
         BAL,R8   LOGALM            OUTPUT ERROR MESSAGE                        
A08A     LW,R0    K:JCP1                                                        
         AND,R0   K2                ARE WE IN ATTEND MODE                       
         BNEZ     A09               YES                                         
A08C     MTW,1    A92               NO SET SKIP MODE FLAG                       
         LI,R9    MSG3                                                          
         BAL,R8   LOGALM            GO OUTPUT 'SEARCHING FOR JOB CARD' ALARM    
         LI,R1    1                                                             
         BAL,R7   CIFCAT                                                        
         B        A03                                                           
A09      RES      0                                                             
         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                          
         CAL1,9   WAIT              WAIT FOR OPERATOR RESPONSE                  
         LI,R9    X'FFF00'                                                      
         LW,R8    K:KEYIN+2                                                     
         CW,R8    KCOC              SHOULD WE SWITCH INPUT TO OC DEV.           
         BNE      A03               NO                                          
         LI,R1    3                 YES                                         
         LI,R0    OC                SWITCH DEV. TO OC                           
         STB,R0   F:C+1,R1                                                      
         B        A03                                                           
A10      LI,R9    X'FFF00'          IS IT A JOB CARD                            
         LI,R0    0                                                             
         CS,R8    A90+1                                                         
         BE       B01               B IF JOB CMND                               
         CS,R8    A90+2             IS IT A FIN CARD                            
         BE       C01               B IF FIN CMND                               
         LI,R0    1                                                             
         CS,R8    USTD              IS IT UNCONDITIONAL STANDARD LABEL          
         BE       A15               YES ALLOW IT                                
         CS,R8    A90C              IS IT A 'CC' CMD                            
         BE       A15               B IF CC CMND                                
         LW,R0    K:JCP1            NO, DO WE NEED A JOB CARD                   
         AND,R0   K1                                                            
         BEZ      A05               YES,ERROR                                   
A14      RES      0                                                             
         LW,R0    CSKIPF            ARE WE IN SELECTIVE SKIP                    
         BEZ      A14XA             NO BRANCH                                   
         CS,R8    T0SS             IS THIS A SKIP COMMAND?                      
         BE       A15XA                                                         
         CS,R8    T0SNS             IS IT A SKIP NOT SET COMMAND                
         BE       A15XA                                                         
         CS,R8    T0XS                                                          
         BE       A15XA                                                         
         CS,R8    T0XNS                                                         
         BE       A15XA                                                         
         CS,R8    T0ADS             IS IT ADSET COMMAND                         
         BE       A15XA                                                         
         CS,R8    T0SET             IS IT A SET COMMAND                         
         BE       A15XA                                                         
         BNE      A05                                                           
A14XA    RES      0                                                             
         LW,R0    A92               ARE WE IN SKIP MODE                         
         BNEZ     A06               YES                                         
         LW,R0    STEPFLAG          ARE WE IN STEP SKIP                         
         BEZ      %+4               NO  BRANCH                                  
         CS,R8    TSTEP             IS IT A STEP COMMAND                        
         BE       A15               YES  PROCESS IT                             
         B        A06                                                           
A15XA    RES      0                                                             
         LW,R0    BRANCHF           AREE WE IN BRANCH SKIP                      
         BEZ      %+3               NO  BRANCH                                  
         CS,R8    TCON              IS IT A CONTINEU                            
         BNE      A06               NO GO ON TO NEZT COMMAND                    
A15      LW,R1    A90                                      /SIG7-4947/*CO15732  
         LI,R9    X'FFF00'                                                      
         CS,R8    A90,R1            SEARCH FOR CONTROL COMMAND                  
         BE       A18               FOUND IT                                    
         BDR,R1   %-2                                                           
         B        N01               SEE IF AN EXLAM. NAME COMMAND               
A18      CAL1,1   WRITELL           GO LOG CARD            /SIG7-4947/*CO15732  
         MTW,1    SCANPMB           SET SO NOT FIRST TIME  /SIG7-4947/*CO15732  
         CI,R0    0                                                             
         BNE      %+5                                                           
         LI,R8    0                                                             
         LW,R9    Y04                                                           
         STS,R8   K:JCP1            CLEAR SKIP FLAG IN K:JCP1                   
         STW,R8   A92               CLEAR LOCAL SKIP INDIACATOR                 
         LW,R0    A91,R1                                                        
         CI,R1    A91A              UTILITY COMMAND                             
         BGE      U00               YES..COMMON ENTRY                           
         B        *R0               GO TO PROPER PROCESSING REGION              
*                                                                               
A30      RES      0                                                             
         DO       #ECB                                                          
         CAL1,7   STIMFPT           COMMAND READ NOT COMPLETE.                  
         CAL1,7   WANYFPT           WAIT FOR IT OR 2-SEC STIMER                 
         LI,R1    X'1FFFF'                                                      
         AND,R1   WANYFPT                                                       
         CI,R1    STIMFPT                                                       
         BE       A31               B IF TIMER FINISHED FIRST                   
         CAL1,7   DELFPTS           DELETE STIMER SERVICE                       
         B        A03C              B TO PROCESS COMMAND JUST READ              
         FIN      #ECB                                                          
A31      RES      0                                                             
         LI,R1    C                 TIMER RAN OUT. NO COMMAND YET.              
         LB,R0    OPLBS3,R1         GET CURRENT ASSIGN. OF C                    
         CW,R0    A94               DID C ASSIGN CHANGE                         
         BE       A03B              NO, GO TRY CHECK AGAIN                      
         CAL1,7   DELFPTC           DELETE CURRENT COMMAND INPUT REQUEST        
         B        A03               GO READ FROM NEW DEVICE                     
*                                                                               
A40      LI,R9    MSG34             ERROR:  COMMAND NOT ALLOWED                 
         BAL,R8   LOGALM            IN MAPPED/UNMAPPED SYSTEM                   
         B        A08A              SKIP TO NEXT JOB/FIN                        
*                                                                               
A41      LI,R9    MSG35             WARNING:  COMMAND IGNORED                   
         BAL,R8   LOGALM            IN MAPPED/UNMAPPED SYSTEM                   
         B        A03               GET NEXT COMMAND                            
*                                                                               
A90      DATA     A91-A90-1         TABLE OF VALID CONTROL COMMANDS             
         TEXT     'JOB '                                                        
         TEXT     'FIN '                                                        
         TEXT     'ASS '                                                        
         TEXT     'DAL '                                                        
         TEXT     'ATT '                                                        
         TEXT     'MES '                                                        
         TEXT     'PAU '                                                        
A90C     TEXT     'CC  '                                                        
         TEXT     'LIM '                                                        
         TEXT     'STD '                                                        
         TEXT     'RUN '                                                        
         TEXT     'ROV '                                                        
         TEXT     'INI '                                                        
         TEXT     'SJO '                                                        
         DO1      #SYMB                                                         
         TEXT     'BAT '                                                        
         TEXT     'POO '                                                        
         TEXT     'ALL '                                                        
         TEXT     'PMD '                                                        
T0SET    TEXT     'SET '                                                        
T0ADS    TEXT     'ADS '                                                        
         TEXT     'SSL '                                                        
         TEXT     'RSL '                                                        
T0XS     TEXT     'SEX '                                                        
T0XNS    TEXT     'NSE '                                                        
T0SS     TEXT     'SKI '                                                        
T0SNS    TEXT     'NSK '                                                        
         TEXT     'BEQ '                                                        
         TEXT     'BNE '                                                        
         TEXT     'BAZ '                                                        
         TEXT     'BAN '                                                        
         TEXT     'BGT '                                                        
         TEXT     'BLT '                                                        
         TEXT     'BGE '                                                        
         TEXT     'BLE '                                                        
TCON     TEXT     'CON '                                                        
USTD     TEXT     'USD '                                                        
TSTEP    TEXT     'STE '                                                        
         TEXT     'REP '                                                        
         TEXT     'CAT '                                                        
         TEXT     'RET '                                                        
         TEXT     'PAG '                                                        
         TEXT     'LIS '            LIST COMMAND (LL DEVICE)                    
         TEXT     'EOD '            IGNORE EOD COMMANDS                         
         TEXT     'SYC '                                                        
         TEXT     'RSY '                                                        
         TEXT     'PFI '                                                        
         TEXT     'PRE '                                                        
         TEXT     'SFI '                                                        
         TEXT     'REW '                                                        
         TEXT     'UNL '                                                        
         TEXT     'WEO '                                                        
A91      DATA     0                 TABLE OF ENTRY ADDRS                        
*                                   ALSO USED AS TEMP CELL                      
         DATA     B01                                                           
         DATA     C01                                                           
         DATA     D01                                                           
         DATA     E01                                                           
         DATA     F01                                                           
         DATA     G01                                                           
         DATA     H01                                                           
         DATA     J01                                                           
         DATA     L01                                                           
         DATA     M01                                                           
         DATA     P01                                                           
         DATA     P10                                                           
         DATA     P101                                                          
         DATA     P201                                                          
         DO1      #SYMB                                                         
         DATA     P301              BATCH                                       
         DATA     A41                                                           
         DATA     R01                                                           
         DATA     T01                                                           
         DATA     SETSF                                                         
         DATA     ADSETSF                                                       
         DATA     SSLSF                                                         
         DATA     RSLSF                                                         
         DATA     TSXEC                                                         
         DATA     TNSXEC                                                        
         DATA     TSKIPS                                                        
         DATA     TSKIPNS                                                       
         DATA     BEQ                                                           
         DATA     BNE                                                           
         DATA     BAZ                                                           
         DATA     BANZ                                                          
         DATA     BGT                                                           
         DATA     BLT                                                           
         DATA     BGE                                                           
         DATA     BLE                                                           
         DATA     CONTINUE                                                      
         DATA     M01                                                           
         DATA     STEP                                                          
         DATA     REPEAT                                                        
         DATA     CATALOG                                                       
         DATA     RETFCAT                                                       
         DATA     NEWPAGE                                                       
         DATA     A03               LIST                                        
         DATA     A03               EOD                                         
         DATA     K01                                                           
         DATA     K02                                                           
A91A     EQU      %-A91                                                         
         DATA     U01                                                           
         DATA     V01                                                           
         DATA     W01                                                           
         DATA     X01                                                           
         DATA     Y01                                                           
         DATA     Z01                                                           
CSKIPF   DATA     0                 SELECTIVE SKIP FLAG                         
A92      DATA     0                 SKIP MODE FLAG                              
A94      DATA     0                 CURRENT ASSIGN. OF C DEV.                   
A95      DATA     X'05000103'                                                   
         BOUND    8                                                             
         TITLE    '****PROCESS CATALOG PROCEDURES****'                          
CATALOG  RES      0                                                             
         LW,R1    JCPCATW                                                       
         BNEZ     A08                                                           
         MTW,0    REPFLAG                                                       
         BEZ      %+2                                                           
         MTW,1    REPFLAG                                                       
         MTW,1    CATDEP                                                        
         BGZ      NOTFIRST                                                      
         BAL,R8   CATI                                                          
NOTFIRST RES      0                                                             
         LW,R1    CATDEP                                                        
         LW,R8    CATSKIP-1,R1                                                  
         STW,R8   CATSKIP,R1                                                    
         BAL,R8   SCAN              GET FILE NAME FOR SKELETON READ             
         CI,R6    -1                                                            
         BE       ERROR                                                         
         LW,R3    CALR,R1           GET FPT ADDRESS                             
         LW,R3    0,R3              GET DCB ADDRESS                             
         STW,R8   5,R3              PUT FILE NAME IN DCB                        
         STW,R9   6,R3                                                          
         LW,R12   TABLOC,R1                                                     
         LI,R2    0                                                             
         CI,R6    2                 IF NO PARAMETERS                            
         BE       EPARSCN           DONT SCAN FOR ANY                           
BPARSCN  BAL,R8   SCAN                                                          
         CI,R6    -1                                                            
         BNE      %+3                                                           
         CI,R10   0                                                             
         BNE      ERROR                                                         
         STD,R8   *R12,R2                                                       
         AI,R2    1                                                             
         CI,R6    2                                                             
         BE       EPARSCN                                                       
         LW,R6    SCAN98                                                        
         CI,R6    79                                                            
         BL       BPARSCN                                                       
EPARSCN  RES      0                 NOW R2 HAS DW INDEX TO NEXT AVAILA          
         LW,R13   TABLOC,R1         SAVE # OF PARAMETER ENTRIES                 
         STB,R2   R13               FOR POSSIBLE NESTING                        
         STW,R13  TABLOC,R1                                                     
         SLS,R2   1                 MAKE WORD INDEX                             
         AW,R2    R12               MAKE ABSOLUTE ADDRESS                       
         STW,R2   TABLOC+1,R1       SAVE FOR POSSIBLE NESTING                   
RSKEL    RES      0                                                             
         LW,R1    CATDEP                                                        
         LW,R12   TABLOC,R1                                                     
         EXU      CALR,R1           READ SKELETON CARD                          
ERSKC    LW,R3    CALR,R1           GET FPT ADDRES                              
         LW,R3    6,R3                                                          
         LB,R3    R3                                                            
         CI,R3    6                                                             
         BE       ESKEL             END OF DATA                                 
         CI,R3    7                                                             
         BE       ESKEL             END OF FILE                                 
         CI,R3    1                 WAS IT OTHERWISE NORMANL                    
         BNE      ERROR             NO BRANCH                                   
         LI,3     0                 R3 CONTAINS INDEX INTO SKELETON CARD        
         LI,4     0                 R4 CONTAINS INDEX INTO TARGET CARD          
BBLD1    RES      0                                                             
         LB,R7    SKELBUF,R3                                                    
         CI,R7    '@'                                                           
         BNE      %+3                                                           
         LI,R7    '%'                                                           
         B        %+3                                                           
         CI,R7    '%'                                                           
         BE       FILL                                                          
         STB,R7   OUTBUF,R4                                                     
         AI,R4    1                                                             
         CI,R4    80                                                            
         BE       EBLD1                                                         
FILX     RES      0                                                             
         AI,R3    1                                                             
         CI,R3    80                                                            
         BL       BBLD1                                                         
EBLD1    RES      0                                                             
         BAL,R8   BLANK                                                         
         LW,R7    OUTBUF                                                        
         CW,R7    BCON              IS IT A CONTINUE COMMAND                    
         BE       %+3                                                           
         MTW,0    CATBRNCH                                                      
         BNEZ     RSKEL                                                         
         LI,R2    NUMSPEC                                                       
         CW,R7    SPECCOM,R2                                                    
         BE       ANALYZIT                                                      
         BDR,R2   %-2                                                           
         MTW,0    CATSKIPF                                                      
         BNEZ     RSKEL                                                         
         CW,R7    BANGREP                                                       
         BNE      %+3                                                           
         BAL,R15  SCANI                                                         
         B        REPEAT                                                        
         CW,R7    C:ERR                                                         
         BE       ERR01                                                         
         CW,R7    SPECCOM                                                       
         BNE      NOTSPEC                                                       
         BAL,R15  SCANI                                                         
         B        CATALOG                                                       
NOTSPEC  RES      0                                                             
         MTW,0    CATSKIPF                                                      
         BNEZ     RSKEL                                                         
         CAL1,1   WCAT+2                                                        
         B        RSKEL                                                         
FILL     RES      0                                                             
         AI,R3    1                                                             
         LB,R7    SKELBUF,R3                                                    
         CI,R7    '('               IS IT A FUNCTION CALL                       
         BE       EVFUNCT           YES                                         
         AND,R7   KXF                                                           
         CB,R7    R12                                                           
         BG       FILX              PARAMETER REQUESTED AND NOT THERE           
         AI,R7    -1                                                            
         LD,R14   *R12,R7                                                       
         LI,R5    8                                                             
         LI,R6    0                                                             
MOVE     RES      0                                                             
         LB,R7    R14,R6                                                        
         CI,R7    ' '                                                           
         BE       FILX                                                          
         STB,R7   OUTBUF,R4                                                     
         AI,R4    1                                                             
         CI,R4    80                                                            
         BE       EBLD1                                                         
         AI,R6    1                                                             
         BDR,R5   MOVE                                                          
         B        FILX                                                          
EVFUNCT  RES      0                                                             
         LI,R7    3                                                             
         LI,R9    X'40'                                                         
         AI,R3    1                                                             
         LB,R8    SKELBUF,R3                                                    
         STB,R8    R9                                                           
         SCS,R9   8                                                             
         BDR,R7   %-4                                                           
         LI,R5    NUMSFN                                                        
         CW,R9    FUNNAM-1,R5                                                   
         BE       FUNADR-1,R5                                                   
         BDR,R5   %-2                                                           
         B        ERROR                                                         
FUNNAM   RES      0                                                             
         TEXT     ' VAL'                                                        
         TEXT     ' DEC'                                                        
         TEXT     ' DAT'                                                        
          TEXT      ' VER'                                                      
         TEXT     ' DEV'                                                        
NUMSFN   EQU      %-FUNNAM                                                      
FUNADR   RES      0                                                             
         B        FVALUE                                                        
         B        FVALUE                                                        
         B        FDATIM                                                        
          B         FVERSION                                                    
         B        FDEVICE                                                       
FDEVICE  RES      0                                                             
         LI,R7    1                                                             
         LB,R7    OPLBS3,R7         GET CURRENT C ASSIGNMENT                    
         CI,R7    X'80'             IS IT A RAD FILE                            
         BANZ     ITSAFL            YES  BRANCH                                 
         CI,R4    75                DO WE HAVE SPACE LEFT TO PUT 5 CH           
         BGE      FUNOUT            NO  IGNORE FUNCTION                         
         LD,R8    DCT16,R7          GET DEVICE NAME                             
         SLD,R8   24                SHIFT OFF !!NEW LINE                        
         LI,R7    5                                                             
         B        SINOB                                                         
ITSAFL   RES      0                                                             
         CI,R4    72                IS THERE ROOM FOR 8 CH                      
         BGE      FUNOUT            NO  IGNORE FUNCTION                         
         AND,R7   KX7F                                                          
         LB,R6    RFT8,R7           GET AREA INDEX                              
         LH,R8    *K:MDNAME,R6                                                  
         SCS,R8   -8                                                            
         STB,R8   OUTBUF,R4                                                     
         AI,R4    1                                                             
         LB,R8    R8                                                            
         STB,R8   OUTBUF,R4                                                     
         AI,R4    1                                                             
         LI,R8    ','                                                           
         STB,R8   OUTBUF,R4                                                     
         AI,R4    1                                                             
         LD,R8    RFT1,R7           GET FILE NAME                               
         LI,R7    8                                                             
SINOB    RES      0                                                             
         LB,R10   R8                                                            
         CI,R10   ' '               IGNORE TRAILING BLANKS                      
         BE       FUNOUT            IGNORE TRAILING BLANKS                      
         SCD,R8   8                                                             
         STB,R9   OUTBUF,R4                                                     
         AI,R4    1                                                             
         BDR,R7   SINOB                                                         
         B        FUNOUT                                                        
FVERSION  RES     0                                                             
          LI,R7     4                                                           
          LI,R5     0                                                           
          LB,R8     K:VRSION,R5                                                 
          STB,R8    OUTBUF,R4                                                   
          AI,R5     1                                                           
          AI,R4     1                                                           
          CI,R4     80                                                          
          BE        EBLD1                                                       
          BDR,R7    %-6                                                         
         B        FUNOUT                                                        
FDATIM   RES      0                                                             
         CAL1,8   DTFPT                                                         
         AI,R4    16                                                            
         CI,R4    80                                                            
         BL       %+3                                                           
         AI,R4    -16                                                           
         B        FUNOUT                                                        
         LI,R9    16                                                            
         LI,R6    BA(DTBUF)                                                     
         LI,R7    BA(OUTBUF)-16                                                 
         AW,R7    R4                                                            
         BAL,R8   MOVBYTE                                                       
FUNOUT   RES      0                                                             
         AI,R3    1                                                             
         B        FILX                                                          
DTFPT    GEN,8,24 16,DTBUF                                                      
DTBUF    TEXT     'TIME NOT ENTERED'                                            
FVALUE   RES      0                                                             
         AI,R3    1                                                             
         LI,R6    0                                                             
FVLOOP   RES      0                                                             
         AI,R3    1                                                             
         LB,R8    SKELBUF,R3                                                    
         CI,R8    ')'                                                           
         BE       FVALO                                                         
         CI,R8    X'F0'                                                         
         BGE      %+2                                                           
         AI,R8    X'39'                                                         
         AI,R8    -X'F0'                                                        
         SLS,R6   4                                                             
         AW,R6    R8                                                            
         B        FVLOOP                                                        
FVALO    RES      0                                                             
         CW,R6    K:UNAVBG                                                      
         BGE      ERROR                                                         
         LW,R11   0,R6                                                          
         EXU      VALINS-1,R5                                                   
         LB,R8    FNTODO,R5                                                     
         LI,R7    3                                                             
         LB,R9    R10                                                           
         CI,R9    X'F0'                                                         
         BE       %+1,R7                                                        
         LI,R7    1                                                             
         STB,R9   OUTBUF,R4                                                     
         AI,R4    1                                                             
         SLD,R10  8                                                             
         BDR,R8   %-7                                                           
         B        FILX                                                          
VALINS   RES      0                                                             
         BAL,R7   HEXBCD                                                        
         BAL,R8   BINBCD                                                        
FNTODO   DATA,1   0,8,4                                                         
         BOUND    4                                                             
ESKEL    RES      0                                                             
         EXU      CALC,R1           CLOSE SKELETON FILE                         
NESTCHEK RES      0                                                             
         MTW,0    REPFLAG                                                       
         BEZ      %+2                                                           
         MTW,-1   REPFLAG                                                       
         MTW,-1   CATDEP            ARE WE NESTED                               
         BGEZ     RSKEL                                                         
         MTW,0    REPFLAG                                                       
         BNEZ     GETNPAR                                                       
SETC     RES      0                                                             
         LI,R7    1                                                             
         LB,R7    OPLBS3,R7         GET CURRENT C ASSIGNMENT                    
         LW,R14   K:JCP1                                                        
         CI,R14   X'04'             IS TYC ACTIVE                               
         BAZ      %+2               NO  BRANCH                                  
         AI,7     X'8000'           SET TYC ACTIVE BIT                          
         STH,7    JCPCATW                                                       
         LD,R14   BANGRET           GET RETURN COMMAND                          
         STD,R14  OUTBUF            PUT IT IN BUFFER                            
         LI,R4    8                                                             
         BAL,R8   BLANK                                                         
         CAL1,1   WCAT+2            WRITE USDLB IN CATALOG FILE                 
         CAL1,1   WCAT              CLOSE CATALOG FILE                          
         LW,R4    SYSAVE                                                        
         STW,R4   K:SY                                                          
         LW,R0    SYSAVN            GET OLD JCB WORD 1                          
         STW,R0    JCBBKG            RESTORE IN BKG JCB                         
         LI,R3    2                                                             
         LI,R2    0                                                             
         STB,R2   F:OPEN+1,R3       STORE SP INDEX IN OPEN DCB                  
         LD,R4    CATNAME           STORE FILE NAME  'CATALOG'                  
         STD,R4   F:OPEN+5          IN OPEN DCB                                 
         LI,R2    X'700'                                                        
         STH,R2   F:OPEN            RESET OPEN BIT                              
         CAL1,1   OPEN                                                          
         LI,R3    3                                                             
         LB,R2    F:OPEN+1,R3       GET RFT INDEX                               
         AI,R2    X'80'             ADD RFT FLAG BIT                            
         LI,R3    1                                                             
         STB,R2   OPLBS3,R3         STORE IN C OP POSITION                      
         STH,R2   JCPCATW,R3        SAVE RFT INDEX OF SP,CATALOG                
         CAL1,1   CLF:CL            CLOSE DCB (NOT RAD FILE)                    
         B        A03               READ NEXT CONTROL CARD                      
CATI     RES      0                                                             
         LW,R1    JCPSETP                                                       
         STW,R1   CATSKIP-1                                                     
         LI,R1    0                                                             
         STW,R1   CATSKIPF                                                      
         STW,R1   CATBRNCH                                                      
         LW,R0    JCBBKG            GET JCB WORD 1                              
         STW,R0   SYSAVN           SAVE IT                                      
         OR,R0    Y0004            SET SY BIT                                   
         STW,R0   JCBBKG           RESTORE TO JCB                               
         LW,R1    SKELKEY                                                       
         XW,R1    K:SY                                                          
         STW,R1   SYSAVE                                                        
         B        *R8                                                           
BLANK    RES      0                                                             
         LI,R7    ' '                                                           
         CI,R4    80                                                            
         BE       *R8                                                           
         STB,R7   OUTBUF,R4                                                     
         AI,R4    1                                                             
         B        %-4                                                           
SCANI    RES      0                                                             
         LI,R7    19                                                            
         LW,R0    OUTBUF,R7                                                     
         STW,R0   *K:CCBUF,R7                                                   
         BDR,R7   %-2                                                           
         LW,R0    OUTBUF                                                        
         LI,R7    X'5A'                                                         
         STB,R7   R0                                                            
         STW,R0   *K:CCBUF                                                      
SCANII   RES      0                                                             
         LI,R0    1                                                             
         STW,R0   SCANPMA                                                       
         LI,R0    0                                                             
         STW,R0   SCANPMB                                                       
         LI,R7    SCANPM                                                        
         BAL,R8   SCAN                                                          
         MTW,1    SCANPMB                                                       
         B        *R15                                                          
ANALYZIT RES      0                                                             
         BAL,R15  SCANI                                                         
         CI,R6    1                                                             
         BG       RSKEL             END OF CARD  NO OPERALTON                   
         BNE      ERROR             ERROR IF NOT END OF FIELD                   
         MTW,1    SCANPMA           SET FOR HEX CONVERSION                      
         BAL,R8   SCAN                                                          
         CI,R6    -2                                                            
         BLE      %+3                                                           
         CI,R6    1                                                             
         BL       ERROR             ERROR IF NOT END OF CARD OR FIELD           
         EXU      INS1,R2                                                       
         EXU      INS2,R2                                                       
         EXU      INS3,R2                                                       
         CI,R6    2                                                             
         BNE      ERROR             ERROR IF NOT END OF CARD                    
         LI,R12   -1                                                            
         LW,R13   R8                                                            
         CS,R12   R14                                                           
         BE       %+3                                                           
         SLS,R1   -16                                                           
         B        %+2                                                           
         AND,R1   KXFFFF                                                        
         STW,R1   CATSKIPF                                                      
         B        RSKEL                                                         
SETBRNCH RES      0                                                             
         MTW,0    CATSKIPF                                                      
         BNEZ     RSKEL             IF IN SKIP MODE SKIP                        
         CI,R6    -1                DID WE GET EBCDIC FOR HEX                   
         BGE      %+2               NO  BRANCH                                  
         AI,R6    4                 YES  ADJUST                                 
         CI,R6    1                                                             
         BG       RSKEL             END OF CARD NO OPERATIOON                   
         BNE      ERROR             ERROR IF NOT END OF FIELD                   
         BAL,R8   SCAN                                                          
         CI,R6    2                                                             
         BNE      ERROR             ERROR IF NOT END OF CARD                    
         STW,R8   CATBRNCH                                                      
         B        RSKEL                                                         
SYTST    RES      0                                                             
         CI,R14   JCBSY             IS SY FLAG SET                              
         BANZ     SYMET              IF SO BRANCH                               
NOTMET   RES      0                                                             
         B        (%+1-BISX),R2                                                 
         B        RSKEL             BIS                                         
         B        SETBRNCH                                                      
SYMET    RES      0                                                             
         B        (%+1-BISX),R2                                                 
         B        SETBRNCH          BIS                                         
         B        RSKEL             BNS                                         
CONSAT   RES      0                                                             
         LI,R8    0                                                             
         STW,R8   CATBRNCH                                                      
         B        RSKEL                                                         
         PAGE                                                                   
TESTPAR  RES      0                                                             
         LB,R0    R12               GET # PARAMETERS ON CAT CARD                
         CW,R8    R0                IS PARAM SPEC OK                            
         BG       *R15              NO  CONSIDER THIS THE COMPARISON            
         LW,R3    R8                SAVE PARAMETER SPECIFICATION                
         AI,R3    -1                ADJUST                                      
         MTW,-1   SCANPMA           SET FOR EBCDIC CONVERSION                   
         BAL,R8   SCAN                                                          
         AI,R2    SOB-SOPT          RESET TO EQUIVALENT BRANCH COMMAND          
         MTW,1    SCANPMA           RESET CONVERSION TYPE                       
         CD,R8    *R12,R3           MAKE COMPARISON WITH PARAMETER              
         B        *R15                                                          
TESTNPAR RES      0                                                             
         LB,R0    R12                                                           
         AI,R2    SOB-SONT                                                      
         CW,R8    R0                                                            
         B        *R15                                                          
         PAGE     PROCESS HST                                                   
HARDSET  RES      0                                                             
         LW,R3    CATDEP                                                        
         AI,R3    1                                                             
         STW,R8   CATSKIP-1,R3                                                  
         BDR,R3   %-1                                                           
         B        RSKEL                                                         
         PAGE                       PROCESS :ERR                                
ERR01    RES      0                                                             
         LI,R4    0                                                             
         LI,R9    19                                                            
         LI,R3    -1                                                            
         AI,R3    1                                                             
         LW,R10   OUTBUF+1,R3                                                   
         CW,R10   SCAN89A                                                       
         EXU      INSX,R4                                                       
         LI,R4    1                                                             
         AI,R3    1                                                             
ERR02    RES      0                                                             
         BDR,R9   %-5                                                           
ERR03    RES      0                                                             
         SLS,R3   2                                                             
         AI,R3    -1                                                            
         STB,R3   OUTBUF+1                                                      
         LI,R3    3                                                             
         STW,R3   OUTBUF                                                        
         LI,R9    OUTBUF                                                        
         B        ERROR1                                                        
         PAGE                                                                   
RETFCAT  RES      0                 PROCESS RETURN FROM CATALOG CALL            
         LI,R1    1                                                             
         LB,R0    JCPCATW,R1        GET C BEFORE CAT CALL                       
         BEZ      A08               RETURN ONLY ALLOWED WHEN CAT PROC           
*                                          IS ACTIVE                            
         MTW,0    JCPCATW           WAS TY ACTIVE WHEN CAT WAS MADE             
         BLZ      %+4               YES  OK  BRANCH                             
         LW,R4    K:JCP1            NO                                          
         CI,R4    4                 IS TY ACTIVE NOW                            
         BANZ     A08               YES  ERROR  BRANCH                          
         STB,R0   OPLBS3,R1         MAKE IT THE NEW ONE                         
         LI,R0    0                                                             
         XW,R0    JCPCATW           RESET K:CAT                                 
         BAL,R4   CLOSCOD0          CLOSE SP,CATALOG                            
         B        A01                                                           
         PAGE                                                                   
REPEAT   RES      0                                                             
         MTW,0    REPFLAG                                                       
         BNEZ     A08               DONT ALLOW IF IN CAT PROC                   
         MTW,1    REPFLAG           SET FLAG                                    
         BAL,R8   CATI                                                          
         BAL,R8   SCAN                                                          
         STB,R9   REPCAT+3                                                      
         SLD,R8   -8                                                            
         OR,R8    REPCON1                                                       
         STW,R8   REPCAT+1                                                      
         STW,R9   REPCAT+2                                                      
         LW,R1    R10                                                           
         AI,R1    5                                                             
         LI,R8    ','                                                           
         STB,R8   REPCAT,R1                                                     
         AI,R1    1                                                             
         STW,R1   REPHOL1                                                       
         BAL,R8   SCAN                                                          
         SAS,R8   -16                                                           
         LB,R2    *K:MDNAME                                                     
         CH,R8    *K:MDNAME,R2                                                  
         BE       FNDAREA                                                       
         BDR,R2   %-2                                                           
         B        A08                                                           
FNDAREA  RES      0                 R2 HAS AREA INDEX                           
         LI,R3    6                                                             
         STB,R2   PARDCB,R3                                                     
         BAL,R8   SCAN                                                          
         STW,R8   PARDCB+5                                                      
         STW,R9   PARDCB+6                                                      
GETNPAR  RES      0                                                             
         LI,R2    3                                                             
         LW,R8    REPCAT,R2                                                     
         STW,R8   *K:CCBUF,R2                                                   
         BDR,R2   %-2                                                           
         CI,R2    0                                                             
         BE       %-4                                                           
         CAL1,1   READPAR+CFPTSZ                                                
ERREP    RES      0                                                             
         LB,R3    READPAR+CFPTSZ+6                                              
         CI,R3    6                                                             
         BE       ENDREP            END OF DATA                                 
         CI,R3    7                                                             
         BE       ENDREP            END OF FILE                                 
         CI,R3    1                 WAS IT OTHERWISE NORMAL                     
         BNE      ERROR             NO BRANCH                                   
         LI,R8    80                                                            
         SW,R8    REPHOL1                                                       
         LW,R1    REPHOL1                                                       
         LI,R2    0                                                             
         LB,R9    OUTBUF,R2                                                     
         STB,R9   *K:CCBUF,R1                                                   
         AI,R2    1                                                             
         AI,R1    1                                                             
         BDR,R8   %-4                                                           
         BAL,R15  SCANII                                                        
         LW,R8    TABLOC                                                        
         STW,R8   TABLOC+1                                                      
         B        CATALOG                                                       
ENDREP   RES      0                                                             
         CAL1,1   READPAR           CLOSE PARAMETER FILE                        
         MTW,1    CATDEP                                                        
         B        NESTCHEK                                                      
BANGREP  TEXT     '!REP'                                                        
C:ERR    TEXT     ':ERR'                                                        
SPECCOM  RES      0                                                             
         TEXT     '!CAT'                                                        
SOPT     TEXT     ':PEQ'                                                        
         TEXT     ':PNE'                                                        
         TEXT     ':HST'            HST                                         
         DATA,4   0                 RFU                                         
         TEXT     ':PGT'                                                        
         TEXT     ':PLT'                                                        
         TEXT     ':PGE'                                                        
         TEXT     ':PLE'                                                        
SONT     TEXT     ':NEQ'                                                        
         TEXT     ':NNE'                                                        
         DATA,4   0,0               RFU  ALLOED ONLY 1 EXU                      
         TEXT     ':NGT'                                                        
         TEXT     ':NLT'                                                        
         TEXT     ':NGE'                                                        
         TEXT     ':NLE'                                                        
         TEXT     ':SET'                                                        
         TEXT     ':ADS'                                                        
         TEXT     ':REW'                                                        
         TEXT     ':SKI'                                                        
         TEXT     ':NSK'                                                        
         TEXT     ':SEX'                                                        
         TEXT     ':NSE'                                                        
SOB      RES      0                                                             
         TEXT     ':BEQ'                                                        
         TEXT     ':BNE'                                                        
         TEXT     ':BAZ'                                                        
         TEXT     ':BAN'                                                        
         TEXT     ':BGT'                                                        
         TEXT     ':BLT'                                                        
         TEXT     ':BGE'                                                        
         TEXT     ':BLE'                                                        
BCON     TEXT     ':CON'                                                        
         TEXT     ':BIS'                                                        
         TEXT     ':BNS'                                                        
NUMSPEC  EQU      %-SPECCOM                                                     
INS1     EQU      %-1                                                           
         BAL,R15  TESTPAR           PEQ                                         
         BAL,R15  TESTPAR           PNE                                         
         B        HARDSET           HST                                         
         B        ERROR             RFU                                         
         BAL,R15  TESTPAR           PGT                                         
         BAL,R15  TESTPAR           PLT                                         
         BAL,R15  TESTPAR           PGE                                         
         BAL,R15  TESTPAR           PLE                                         
         BAL,R15  TESTNPAR          NEQ                                         
         BAL,R15  TESTNPAR          NNE                                         
         B        ERROR             RFU                                         
         B        ERROR             RFU                                         
         BAL,R15  TESTNPAR          NGT                                         
         BAL,R15  TESTNPAR          NLT                                         
         BAL,R15  TESTNPAR          NGE                                         
         BAL,R15  TESTNPAR          NLE                                         
         STW,R8   CATSKIP,R1                                                    
         AWM,R8   CATSKIP,R1        ADS                                         
         EXU      CALC,R1                                                       
         LW,R14   CATSKIP,R1                                                    
         LCW,R14  CATSKIP,R1                                                    
         LW,R14   CATSKIP,R1                                                    
         LCW,R14  CATSKIP,R1                                                    
         CW,R8    CATSKIP,R1        BEQ                                         
         CW,R8    CATSKIP,R1        BNE                                         
         CW,R8    CATSKIP,R1        BAZ                                         
         CW,R8    CATSKIP,R1        BANZ                                        
         CW,R8    CATSKIP,R1        GBT                                         
         CW,R8    CATSKIP,R1        BLT                                         
         CW,R8    CATSKIP,R1        BGE                                         
         CW,R8    CATSKIP,R1        BLE                                         
         CW,R8    CATBRNCH          CON                                         
BISX     EQU      %-INS1                                                        
         LW,R14   SYSAVE            BIS                                         
         LW,R14   SYSAVE            BNS                                         
INS2     EQU      %-17                                                          
         B        RSKEL                                                         
         B        RSKEL                                                         
         B        RSKEL                                                         
         LCI      0                                                             
         AI,R14   -1                                                            
         LCI      0                                                             
         AI,R14   -1                                                            
         BNE      RSKEL             BEQ                                         
         BE       RSKEL             BNE                                         
         BANZ     RSKEL             BAZ                                         
         BAZ      RSKEL             BANZ                                        
         BLE      RSKEL             BGT                                         
         BGE      RSKEL             BLT                                         
         BL       RSKEL             BGE                                         
         BG       RSKEL             BLE                                         
         BNE      RSKEL             CON                                         
         BEZ      RSKEL             BIS                                         
         BEZ      SETBRNCH                                                      
INS3     EQU      %-20                                                          
         LI,R1    1                                                             
         LI,R1    1                                                             
         LI,R1    X'10000'                                                      
         LI,R1    X'10000'                                                      
         B        SETBRNCH          BEQ                                         
         B        SETBRNCH          BNE                                         
         B        SETBRNCH          BAZ                                         
         B        SETBRNCH          BANZ                                        
         B        SETBRNCH                                                      
         B        SETBRNCH                                                      
         B        SETBRNCH                                                      
         B        SETBRNCH                                                      
         B        CONSAT            CON                                         
         B        SYTST                                                         
         B        SYTST                                                         
INSA     RES      0                                                             
         BNE      A06               BEQ                                         
         BE       A06               BNE                                         
         BANZ     A06               BAZ                                         
         BAZ      A06               BANZ                                        
         BLE      A06               BGT                                         
         BGE      A06               BLT                                         
         BL       A06               BGE                                         
         BG       A06               BLE                                         
INSB     RES      0                                                             
         STW,R8   JCPSETP           SET                                         
         AWM,R8   JCPSETP           ADS                                         
         B        SSLSFA            SSL/RSL                                     
INSX     RES      0                                                             
         BE       ERR02                                                         
         BE       ERR03                                                         
CATSKIP  EQU      %+1                                                           
         DATA,4   0,0,0,0,0                                                     
CATSKIPF DATA,4   0                                                             
CATBRNCH DATA,4   0                                                             
BRANCHF  DATA,4   0                                                             
SYSAVN   DATA,4   0                                                             
SKELKEY  GEN,16,16 X'5A',0                                                      
ERROR    RES      0                                                             
         BAL,R9   ERROR1                                                        
MSGSKEL  DATA,4   3                                                             
         TEXTC    'ERROR IN PROCESSING CATALOGED PROCEDURE'                     
ERROR1   RES      0                                                             
         LI,R3    CALC                                                          
         LW,R4    *CATDEP,R3                                                    
         LW,R4    0,R4                                                          
         LW,R4    0,R4                                                          
         CW,R4    KL002                                                         
         BAZ      %+2               NO  DONT TRY TO CLOSE IT                    
         EXU      *CATDEP,R3        CLOSE SKELETON FILE                         
         MTW,-1   CATDEP                                                        
         BGEZ     ERROR1+1                                                      
         LW,R4    *WCAT                                                         
         CW,R4    KL002                                                         
         BAZ      %+2               NO DONT CLOSE IT                            
         CAL1,1   WCAT              CLOSE CATALOG FILE                          
         LW,R8    SYSAVE                                                        
         STW,R8   K:SY                                                          
         MTW,0    REPFLAG                                                       
         BEZ      A08+1                                                         
         CAL1,1   READPAR           CLOSE PARAMETER FILE                        
         LI,R8    0                                                             
         STW,R8   REPFLAG                                                       
         B        A08+1                                                         
CALR     RES      0                                                             
         CAL1,1   FPTR1+CFPTSZ                                                  
         CAL1,1   FPTR2+CFPTSZ                                                  
         CAL1,1   FPTR3+CFPTSZ                                                  
CALC     RES      0                                                             
         CAL1,1   FPTR1                                                         
         CAL1,1   FPTR2                                                         
         CAL1,1   FPTR3                                                         
CATDEP   DATA,4   -1                                                            
SYSAVE   DATA,4   0                                                             
FPTR1    IOSTUF,6 0,ERSKC,0,0,SKELBUF                                           
FPTR2    IOSTUF,6 0,ERSKC,0,0,SKELBUF                                           
FPTR3    IOSTUF,6 0,ERSKC,0,0,SKELBUF                                           
WCAT     IOSTUF,0 1,ERROR,'CATA','LOG ',OUTBUF                                  
READPAR  IOSTUF,0 0,ERREP,0,0,OUTBUF                                            
CLF:CL   GEN,8,24 X'15',F:OPEN                                                  
         DATA     0                                                             
PARDCB   EQU      READPAR-7                                                     
REPCAT   TEXT     '!CAT'                                                        
         RES      3                                                             
REPCON1  DATA,4   X'40000000'                                                   
REPCON2  DATA,1   0,',',0,0                                                     
REPHOL1  DATA,4   0                                                             
REPFLAG  DATA,4   0                                                             
         BOUND    8                                                             
OUTBUF   RES      20                                                            
SKELBUF  RES      20                                                            
BANGRET  TEXT     '!RETURN '                                                    
TABLOC   DATA,4   TABAREA,0,0,0                                                 
         BOUND    8                                                             
TABAREA  RES      80                                                            
         TITLE    '****PROCESS CONDITIONAL JCL COMMANDS***'                     
ADSETSF  RES      0                                                             
         LI,R2    1                                                             
         B        %+2                                                           
SETSF    RES      0                 SET SELECTIVE SKIP FLAGS                    
         LI,R2    0                                                             
         CI,R6    1                                                             
         BG       A06               END OF CARD NO OPERATION                    
         BNE      A08               ERROR IF NOT END OF FILED                   
         MTW,1    SCANPMA SET FOR HEX CONVERSION                                
         BAL,R8   SCAN                                                          
         CI,R6    2                                                             
         BNE      A08               ERROR IF NOT END OF CARD                    
         EXU      INSB,R2                                                       
         B        A03               EXIT                                        
SSLSF    RES      0                                                             
         LI,R3    -1                                                            
         LI,R2    2                                                             
         B        SETSF+1                                                       
RSLSF    RES      0                                                             
         LI,R3    0                                                             
         LI,R2    2                                                             
         B        SETSF+1                                                       
SSLSFA   RES      0                                                             
         LW,R9    R8                                                            
         LW,R8    R3                                                            
         STS,R8   JCPSETP                                                       
         B        A03                                                           
TSXEC    RES      0                                                             
         LI,1     X'10000'                                                      
         LW,R14   JCPSETP                                                       
         B        TSKIPNS+3                                                     
TNSXEC   RES      0                                                             
         LI,1     X'10000'                                                      
         LCW,R14  JCPSETP                                                       
         B        TSKIPNS+2                                                     
TSKIPS   RES      0                                                             
         LI,1     1                                                             
         LW,R14   JCPSETP                                                       
         B        TSKIPNS+3                                                     
TSKIPNS  RES      0                                                             
         LI,1     1                                                             
         LCW,R14  JCPSETP                                                       
         AI,R14   -1                                                            
         CI,R6    1                                                             
         BG       A06               END OF CARD NO OPERATION                    
         BNE      A08               ERROR IF NOT END OF FIELD                   
         MTW,1    SCANPMA           SET FOR HEX CONVERSION                      
         BAL,R8   SCAN                                                          
         CI,R6    2                                                             
         BNE      A08               ERROR IF NOT END OF CARD                    
         LI,R12   -1                                                            
         LW,R13   R8                                                            
         CS,R12   R14               SHOULD WE SWT SKIP                          
         BE       %+3               SATISFIED  SET SKIP                         
         SLS,R1   -16                                                           
         B        %+2                                                           
         AND,R1   KXFFFF                                                        
         STW,R1   CSKIPF                                                        
         B        A03                                                           
BEQ      RES      0                                                             
         LI,R2    0                                                             
         B        BCOM                                                          
BNE      RES      0                                                             
         LI,R2    1                                                             
         B        BCOM                                                          
BAZ      RES      0                                                             
         LI,R2    2                                                             
         B        BCOM                                                          
BANZ     RES      0                                                             
         LI,R2    3                                                             
         B        BCOM                                                          
BGT      RES      0                                                             
         LI,R2    4                                                             
         B        BCOM                                                          
BLT      RES      0                                                             
         LI,R2    5                                                             
         B        BCOM                                                          
BGE      RES      0                                                             
         LI,R2    6                                                             
         B        BCOM                                                          
BLE      RES      0                                                             
         LI,R2    7                                                             
BCOM     RES      0                                                             
         CI,R6    1                                                             
         BG       A06               END OF CARD  NO OPERATION                   
         BNE      A08               ERROR IF NOT END OF FIELD                   
         MTW,1    SCANPMA           SET FOR HEX CONVERSION                      
         BAL,R8   SCAN                                                          
         CI,R6    1                                                             
         BG       A06               END OF CARD  NO OPERATION                   
         BL       A08               ERROR IF NOT END OF FIELD                   
         CW,R8    JCPSETP                                                       
         EXU      INSA,R2                                                       
         BAL,R8   SCAN              GET LABEL FIELD                             
         CI,R6    2                                                             
         BNE      A08               ERROR IF NOT END OF CARD                    
         STW,R8   BRANCHF           SAVE LABEL                                  
         B        A03                                                           
CONTINUE RES      0                                                             
         CI,R6    1                                                             
         BG       A06               END OF CARD NO  OPERATION                   
         BNE      A08               ERROR IF NOT END OF FIELD                   
         MTW,1    SCANPMA           SET FOR HEX CONVERSION                      
         BAL,R8   SCAN                                                          
         CI,R6    2                                                             
         BNE      A08               ERROR IF NOT END OF CARD                    
         CW,R8    BRANCHF           IS IT THE TARGET LABEL                      
         BNE      A03                                                           
         LI,R8    0                 YES  RESET TO 0                             
         STW,R8   BRANCHF                                                       
         B        A03                                                           
         PAGE                                                                   
STEP     RES      0                                                             
         LI,R8    0                                                             
         STW,R8   STEPFLAG                                                      
         CI,R6    1                                                             
         BG       A06               END OF CARD NO OPERATION                    
         BNE      A08               ERROR IF NOT END OF FIELD                   
         BAL,R8   SCAN                                                          
         CI,R10   2                                                             
         BNE      A08                                                           
         LH,R8    R8                                                            
         LI,R2    NUMOP                                                         
         CH,R8    OPS,R2                                                        
         BE       GOODOP                                                        
         BDR,R2   %-2                                                           
         B        A08               ERROR INVALID OP                            
GOODOP   RES      0                                                             
*           R2 HAS THE OP CODE INDEX                                            
         MTW,1    SCANPMA           SET FOR HEX CONVERSION                      
         BAL,R8   SCAN                                                          
         CW,R8    JCPSETP                                                       
         EXU      STEPINS,R2                                                    
*                 IF FALL THROUGH THE CONDITION IS NOT SATISFIED                
*                 HENCE WE ARE TO SKIP OR BRANCH                                
*                 IGNORE 3RD PARAMETER                                          
*                 BRANCH IF 4TH PARAMETER PRESENT--OTHERWISE SKIP               
         CI,R6    2                                                             
         BE       STEPSKIP          END OF CARD                                 
         BAL,R8   SCAN                                                          
         CI,R6    2                                                             
         BNE      STEPBRAN          NOT END OF CARD  GET BRANCH LOC             
STEPSKIP RES      0                                                             
         LI,R8    1                                                             
         STW,R8   STEPFLAG                                                      
         B        A03                                                           
STEPBRAN RES      0                                                             
         BAL,R8   SCAN                                                          
         CI,R6    2                                                             
         BNE      A08                                                           
         STW,R8   BRANCHF                                                       
         B        A03                                                           
STEPEX   RES      0                 GET HERE IF TEST IS SATISFIED               
         CI,R6    2                                                             
         BE       A03               END OF CARD  CONTINNUE                      
         BAL,R8   SCAN                                                          
         CI,R6    -1                                                            
         BE       A08               ERROR BRANCH                                
         STW,R8   JCPSETP           STORE NEW VALUE IN K:SSKIP                  
         B        A03                                                           
STEPFLAG DATA,4   0                                                             
OPS      RES      0                                                             
         TEXT     '  GTLTEQGELENEAZANNO'                                        
         BOUND    4                                                             
STEPINS  EQU      %-1                                                           
         BG       STEPEX                                                        
         BL       STEPEX                                                        
         BE       STEPEX                                                        
         BGE      STEPEX                                                        
         BLE      STEPEX                                                        
         BNE      STEPEX                                                        
         BAZ      STEPEX                                                        
         BANZ     STEPEX                                                        
         B        STEPEX                                                        
NUMOP    EQU      %-STEPINS                                                     
         TITLE    '*****PAGE DIRECTIVE*****'                                    
NEWPAGE  RES      0                                                             
         LI,R0    X'F1'                                                         
         STW,R0   *F:LL+2                                                       
         LI,R0    X'40'                                                         
         LI,R1    19                                                            
         STW,R0   *F:LL+2,R1                                                    
         BDR,R1   %-1                                                           
         CAL1,1   WRITELL                                                       
         B        A03                                                           
         TITLE    '**** PROCESS JOB COMMAND ****'                               
*                                                                               
*                                                                               
*                                                                               
B01      RES      0                                                             
         PSW,R6   JCP                                                           
         LI,R1    0                                                             
         STW,R1   CSKIPF                                                        
         STW,R1   JCPSETP                                                       
         STW,R1   BRANCHF                                                       
         BAL,R8   C20               DO ACCOUNTING FOR PRIOR JOB                 
         BAL,R8   B18               DO JOB AND TASK CLEANUP                     
         BAL,R8   B20               CLEAR PMD REQUESTS                          
         PLW,R6   JCP                                                           
         LW,R0    K:DATE1           SET UP START DATE/TIME                      
         SLS,R0   16                                                            
         AW,R0    K:DATE2                                                       
         STW,R0   K:ACCNAM+5                                                    
         LW,R0    K:TIME                                                        
         STW,R0   K:ACCNAM+6                                                    
         LI,R0    #BPGLIM                                                       
         STW,R0   K:BPGLIM          RESET OUTPUT PAGE LIMIT                     
         MTW,1    SCANPMB           FLAG TO SCAN:  NOT START OF CARD            
         LCI      2                                                             
         LM,R0    DFLTACNT                                                      
         STM,R0   K:ACCNAM          SET DEFAULT ACCOUNT NAME                    
         STM,R0   JCBBKG+JCBACCNT                                               
         LW,R0    KBLANKS                                                       
         LI,R1    3                                                             
         STW,R0   K:ACCNAM+1,R1     SET DEFAULT USER NAME                       
         STW,R0   JCBBKG+JCBACCNT+1,R1                                          
         BDR,R1   %-2                                                           
         DO       #SYMB                                                         
         LI,R0    1                                                             
         STW,R0   JOBPRI            INITIALIZE DEFAULT PRIORITY                 
         FIN                        #SYMB                                       
         CI,R6    2                                                             
         BE       B05               B IF NO MORE PARAMETERS                     
         LI,R7    SCANPM                                                        
         BAL,R8   SCAN              NO, GO GET ACCOUNT NO.                      
         CI,R6    1                                                             
         BL       A07               B IF NOT END OF FIELD                       
         LCI      2                                                             
         STM,R8   K:ACCNAM          SET ACCOUNT NAME                            
         STM,R8   JCBBKG+JCBACCNT                                               
         AI,R11   X100              INCREMENT EBCDIC FIELD NR IN REG            
         MTW,1    SCAN94            INREMENT EBCDIC FIELD NR IN MEM             
         LW,R1    SCAN98            GET LAST COL. SCANNED                       
         LI,R2    0                                                             
B03      AI,R1    1                 STEP COL. COUNT                             
         LB,R0    *K:CCBUF,R1       GET NEXT BYTE OF NAME                       
         CI,R0    X'40'             ARE WE DONE WITH NAME                       
         BE       B04               B IF YES                                    
         CI,R0    ','                                                           
         BE       B04               B IF YES                                    
         CI,R0    '.'                                                           
         BE       B04               B IF YES                                    
         CI,R2    12                TOO MANY CHARS.                             
         BE       A07               B IF TOO MANY CHARACTERS                    
         STB,R0   K:ACCNAM+2,R2     SAVE NAME FOR AL FILE                       
         STB,R0   JCBBKG+JCBACCNT+2,R2                                          
         AI,R2    1                 STEP CHAR. COUNT                            
         B        B03               GO BACK FOR NEXT CHAR. OF NAME              
B04      RES      0                                                             
         STW,R1   SCAN98            SET LAST CHARACTER POINTER                  
         CI,R0    ','                                                           
         BNE      B05               B IF NO MORE PARAMETERS                     
         LI,R0    2                                                             
         STW,R0   SCANPMA           SET TO SCAN HEX                             
         LI,R7    SCANPM            SCAN PARAMETER TABLE ADDRESS                
         BAL,R8   SCAN              GET NEXT WORD FROM COMMAND                  
         CI,R6    1                                                             
         BL       A07               B IF IMPROPER FORMAT                        
         CI,R8    7                                                             
         BG       A07               B IF TOO BIG FOR PRIORITY                   
         DO       #SYMB                                                         
         STW,R8   JOBPRI            SET JOB PRIORITY                            
         FIN                        #SYMB                                       
         CI,R6    1                                                             
         BG       B05               B IF NO MORE FIELDS                         
         BAL,R8   SCAN              GET NEXT FIELD                              
         CI,R6    2                                                             
         BNE      A07               B IF NOT END OF COMMAND                     
         CI,R8    X'FFF'                                                        
         BG       A07               B IF TOO BIG FOR JOB ID NR                  
         B        B06                                                           
B05      RES      0                                                             
         DO       #SYMB                                                         
         WD,0     DISABLE                                                       
         LH,R8    SYMB              GET DEFAULT JOB ID                          
         MTH,1    SYMB              UPDATE NEXT JOB ID TO USE                   
         WD,0     ENABLE                                                        
B06      STW,R8   JOB#                                                          
         LW,R11   R8                                                            
         BAL,R7   HEXBCD                                                        
         STW,R11  MSG43X            PUT JOB NR TEXT IN 'JOB ... ON'             
         LW,R11   KBLANKS                                                       
         STB,R11  MSG43X                                                        
         CAL1,2   TYPE2             TYPE JOB INTRODUCTION TO OC                 
         ELSE                       #SYMB                                       
B06      MTW,1    JOB#              DEFAULT JOB ID                              
         FIN                        #SYMB                                       
         LD,R0    B92                                                           
         STS,R0   K:JCP1            RESET AND SET PROPER JCP CONTROL BTS        
         LI,R0    0                                                             
         LI,R1    JCBSY                                                         
         STS,R0   JCBBKG            RESET NEW SY FLAG                           
         STW,R0   K:SY              RESET OLD SY FLAG                           
         STW,R0   A92               INTERNAL CMND SKIP FLAG                     
         STW,R0   K:LIMIT                                                       
         LI,R1    X'1FF'                                                        
         OR,R1    K:ASSIGN          RESET ASSIGN BUFFER START                   
         STW,R1   K:ASSIGN                                                      
         STW,R0   *K:ASSIGN         RESET NR OF ENTRIES                         
         LI,R1    1                                                             
         LW,R0    K:OV                                                          
         SLS,R0   -16               SET CURRENT SIZES OF OV/GO TO PERM.         
         STH,R0   K:OV,R1                                                       
         LW,R0    K:GO                                                          
         SLS,R0   -16                                                           
         STH,R0   K:GO,R1                                                       
         LI,R1    3                 PURGE ALL XI BT FILES BY CLEARING           
         LI,R2    0                   NAME                                      
         LI,R3    0                                                             
B12      RES      0                                                             
         CB,R1    BT#               PAST END OF BT FILES                        
         BG       B14               YES                                         
         STD,R2   RFT1,R1           NO, ZERO NAME                               
         AI,R1    1                                                             
         B        B12                                                           
B14      LI,R9    0                 SET SO BOTH GO/OV ARE SET UP                
         BAL,R8   DOGOOV            GO SET UP GO/OV                             
         LI,R0    0                                                             
         STH,R0   K:BTFILE          RESET SO NO SAVED XI FILES                  
         LH,R1    BTFILE                                                        
B16      LI,R0    0                 INITIALIZE ALL TABLES USED FOR              
         STH,R0   GSIZE,R1            :ALLOBT COMMAND                           
         STW,R0   FSIZE,R1                                                      
         STB,R0   FORM,R1                                                       
         STB,R0   SAVE,R1                                                       
         LI,R0    -1                                                            
         STH,R0   RSIZE,R1                                                      
         BDR,R1   B16                                                           
         LI,R0    0                                                             
         STW,R0   BFPT+6            SET BTD                                     
B165     RES      0                                                             
         LW,R1    BFPT              GET DCB ADDRESS                             
         LW,R1    1,R1              GET DCB WORD 1                              
         AND,R1   KXFF              SELECT OPLB INDEX                           
         BAL,R8   BURST             IS LL=KB PRINTER                            
         B        B176              SKIP BURST PAGE                             
         LW,R11   K:ACCNAM          SKIP BANNER IF NO IDS ON JOB CARD           
         CW,R11   DFLTACNT                                                      
         BE       B176                                                          
         LI,R3    2                 NR OF BREAK PAGES                           
         LW,R0    MSG60L            LENGTH OF MESSAGE                           
         LI,R11   MSG60             ADDRESS OF MESSAGE                          
         CAL1,8   TIMEFPT4                                                      
B17      RES      0                                                             
         LI,R1    '1'               TOP OF FORM VFC CODE                        
         STB,R1   MSG60                                                         
         LI,R2    6                 NUMBER OF LINES TO BREAK                    
B175     RES      0                                                             
         CAL1,1   BFPT              PRINT ONE LINE                              
         LI,R1    ' '               NORMAL VFC                                  
         STB,R1   MSG60                                                         
         BDR,R2   B175                                                          
         PSW,R0   JCP                                                           
         PSW,R3   JCP                                                           
         PSW,R11  JCP                                                           
         LW,R11   JOB#                                                          
         BAL,R7   HEXBCD            CONVERT JOB NR TO HEX                       
         STW,R11  BUFF1+35          PUT IN GENCHARS BUFFER                      
         LW,R10   A90+1             'JOB '                                      
         STW,R10  BUFF1+34                                                      
         STB,R10  BUFF1+35          BLANK OUT FIRST HEX CHAR                    
         LW,R1    BFPT              DCB ADDRESS                                 
         AND,R1   KX1FFFF                                                       
         LI,R10   BUFF1             PRINT BUFFER ADDRESS                        
         LI,R11   BUFF1+34          JOB ID NR TEXT ADDRESS                      
         BAL,R8   GENCHARS          PRINT BIG                                   
         B        ERRLL             B IF ERROR RETURN                           
         LI,R11   K:ACCNAM          ACCOUNT NAME TEXT ADDRESS                   
         BAL,R8   GENCHARS          PRINT BIG                                   
         B        ERRLL             ERROR RETURN                                
         LI,R11   JCBBKG+JCBACCNT+2 USER NAME BUFFER ADR                        
         BAL,R8   GENCHARS                                                      
         B        ERRLL                                                         
         PLW,R11  JCP                                                           
         PLW,R3   JCP                                                           
         PLW,R0   JCP                                                           
         BDR,R3   B17                                                           
B176     RES      0                                                             
         LW,R0    BFPT2                                                         
         CW,R0    BFPT                                                          
         BE       B177              B IF LO OUTPUT DONE                         
         XW,R0    BFPT              SET TO BREAK LO OUTPUT                      
         CAL1,1   OPENB             INSURE BFPT DCB IS OPEN                     
         CAL1,1   BR0COR                                                        
         CI,R8    1                                                             
         BNE      B165              B IF LL IS NOT SAME AS LO                   
B177     RES      0                                                             
         LW,R0    BFPT1                                                         
         STW,R0   BFPT              RESET TO OUTPUT ON LL                       
         LI,R1    '1'               TOP OF FORM                                 
         STW,R1   *F:LL+2           SET IN JOB COMMAND BUFFER                   
         CAL1,1   WRITELL           LOG THE JOB COMMAND                         
         LI,R0    3                                                             
         STW,R0   BFPT+6            SET BTD FOR VFC BYTE                        
         LI,R1    ' '               UPSPACE 1                                   
         STW,R1   BUFF1             SET IN BUFFER                               
         LI,R0    SITE                                                          
         BEZ      B178              B IF SITE NOT DEFINED                       
         LCI      14                                                            
         LM,R0    SITE                                                          
         STM,R0   BUFF1+1           MOVE INTO BUFFER                            
         LI,R0    57                BYTE COUNT                                  
         LI,R11   BUFF1             BUFFER ADDRESS                              
         CAL1,1   BFPT              LOG SITE DESCRIPTOR                         
B178     RES      0                                                             
         LW,R1    K:DATE2                                                       
         BEZ      A03               B IF DATE NOT DEFINED                       
         CAL1,8   TIMEFPT1                                                      
         LI,R0    17                BYTE COUNT                                  
         LI,R11   BUFF1             BUFFER ADDRESS                              
         CAL1,1   BFPT              LOG DATE/TIME                               
         LW,R1    KSIGN                                                         
         STS,R1   PCBPOINT          SET CPR PROGRAM FLAG                        
         LCI      5                                                             
         LM,R10   JCBBKG+JCBACCNT   GET ACCOUNT/USER NAME                       
         BAL,R8   SEARCHAI          VALIDATE ACCOUNT/USER NAME                  
         B        B90               INVALID NAME(S)                             
         LI,R0    0                                                             
         LW,R1    KSIGN                                                         
         STS,R0   PCBPOINT          RESET CPR PROGRAM FLAG                      
         B        A03               EXIT JOB CARD                               
*                                                                               
*                                   RESET CURRENT OP LABEL /SIG7-2097/*C5732    
B18      RES      0                                                             
         PUSH     R8                                                            
         LI,R6    BKGJID                                                        
         BAL,R8   JMTERM            PERFORM JOB CLEANUP                         
         PULL     R8                                                            
         LI,R1    C                                                             
         BAL,R7   CIFCAT                                                        
         CI,R8    FINCALL                                                       
         BNE      %+3               ALLOW FIN TO RESET C TO PERM ASSIGN         
         LB,R0    OPLBS2,R1                                                     
         STB,R0   OPLBS3,R1                                                     
         B        *R8                                                           
*                                                                               
*                                                                               
B20      RES      0                 ROUTINE TO CLEAR PMD REQUESTS               
         LI,R1    5                                                             
         LI,R0    0                                                             
         STW,R0   K:PMD-1,R1                                                    
         BDR,R1   %-1                                                           
         LI,R1    X'FEFE'                                                       
         STS,R0   K:PMD1            RESET FLAGS                                 
         B        *R8                                                           
*                                                                               
*                                                                               
B90      RES      0                 ILLEGAL ACCOUNT/USER NAME                   
         LI,R0    0                                                             
         LW,R1    KSIGN                                                         
         STS,R0   PCBPOINT          RESET CPR PROGRAM FLAG                      
         LI,R9    MSG46                                                         
         BAL,R8   LOGALM            MESSAGE: ILLEGAL ACCOUNT/USER NAME          
         B        A08A                                                          
CIFCAT   RES      0                                                             
         LW,R0    JCPCATW           IS CATALOG ACTIVE                           
         BEZ      0,R7              NO  BRANCH                                  
         LW,R5    K:JCP1                                                        
         CI,R5    X'04'             IS TYC ACTIVE                               
         BAZ      NOTYC             NO  BRANCH                                  
         LH,R6    JCPCATW           WAS TYC ACTIVE WHEN CAT CALL MADE           
         BLZ      NOTYC             YES  BRANCH                                 
         LI,R5    K:JCP1                                                        
         B        %+2                                                           
NOTYC    RES      0                                                             
         LI,R5    OPLBS3                                                        
         LB,R4    *R5,R1                                                        
         LI,R3    3                                                             
         LB,R2    JCPCATW,R3        WAS JOB ABORTED DURING CAP PROC             
*                                              WRAPUP                           
         BEZ      %+3               YES  STILL NEED TO CLOSE FILE               
         CB,R4    JCPCATW,R3        IS IT SP,CATALOG                            
         BNE      0,R7              NO  BRANCH                                  
         LH,R2    JCPCATW           GET C BEFORE CAT CALL                       
         STB,R2   *R5,R1                                                        
         LI,R3    X'20'                                                         
         STS,R3   K:CTST            FAKE A SY KEYIN                             
         BAL,R4   CLOSCOD0                                                      
RSETCAT  RES      0                                                             
         LD,R2    FAKECLOS                                                      
         STS,R2   K:CTST            RESET FAKE                                  
         STW,R2   JCPCATW                                                       
         B        0,R7                                                          
*                                                                               
*                                                                               
         BOUND    8                                                             
B92      DATA     1                                                             
         DATA     X'FDFB'                                                       
TIMEFPT1 GEN,8,24 X'10',BUFF1+1                                                 
TIMEFPT4 GEN,8,24 X'10',MSG60+14                                                
         TITLE    '**** PROCESS FIN COMMAND ****'                               
*                                                                               
*                                                                               
C01      RES      0                                                             
         CAL1,7   WALLFPT           WAIT FOR SERVICE COMPLETION                 
         BAL,R8   C20               ACCOUNTING                                  
         CAL1,1   WRITELL           LOG FIN COMMAND                             
         LI,R0    0                                                             
         LI,R1    5                                                             
         STW,R0   K:ACCNAM-1,R1     ZERO THE ACCOUNT/USER NAME                  
         STW,R0   JCBBKG+JCBACCNT-1,R1                                          
         BDR,R1   %-2                                                           
         LI,R0    0                                                             
         STW,R0   K:LIMIT          RESET BCKG LIMIT                             
         LI,R1    JCBSY                                                         
         STS,R0   JCBBKG            RESET NEW SY FLAG                           
         STW,R0   K:SY              RESET OLD SY FLAG                           
         LW,R1    C90                                                           
         STS,R0   K:JCP1            CLEAR JOB CARD READ FLAG                    
*                                   ATTEND, AND SKIP FLAGS                      
         BAL,R8   B18                                                           
FINCALL  RES      0                                                             
         LI,2     0                                                             
         LI,3     4                                                             
         STS,2    K:JCP1            CLEAR TY ACTIVE BIT                         
         STW,2    JCPCATW           ZERO CAT FLAG ON A FIN                      
         LW,R14   K:CCBUF           WA OF ASSIGN/CC PAGE                        
         BEZ      C10               B IF NOT ACQUIRED                           
         SLS,R14  -9                WA TO VPN                                   
         BAL,R8   MMRJRP            RELEASE PAGE                                
         NOP      0                                                             
         LI,R14   0                                                             
         STW,R14  K:CCBUF           INDICATE THAT CC/ASSIGN PAGE GONE           
C10      RES      0                                                             
         CAL1,9   EXIT                                                          
*                                   SBR TO WRITE AL FILE AND LOG TOTAL          
*                                     JOB TIME ON LL                            
C20      STW,R8   C29               SAVE RETURN                                 
         LW,R0    K:ACCNT           WAS JOB ACCOUNT. REQ. AT SYSGEN             
         BEZ      *C29              NO,EXIT                                     
         LW,R0    K:ACCNAM                                                      
         BEZ      *C29              EXIT IF JUST STARTED FROM IDLE              
         CAL1,7   WALLFPT           WAIT FOR SERVICE RUNDOWN                    
         LI,R1    0                                                             
         XW,R1    JCBBKG+JCBTIME    EXECUTION TIME IN MILISEC                   
         DW,R1    K1000             IN SEC                                      
         BNEZ     %+2               B IF NONZERO                                
         LI,R1    1                 1-SECOND MINIMUM                            
         STW,R1   K:ELTIM2          PUT IN AL BUFFER                            
         LI,R1    LL                IS LL=KB PRINTER                            
         BAL,R8   BURST             IF SO,                                      
         B        C205              SKIP ACCOUNTING                             
         LI,R0    0                                                             
         STW,R0   BFPT+6            SET BTD                                     
         LW,R0    MSG60L                                   /SIG7-4920/*C5732 C01
         LI,R1    C'1'              TOP OF FORM            /SIG7-4920/*C5732 C01
         STB,R1   MSG60                                    /SIG7-4920/*C5732 C01
         LI,R11   MSG60                                    /SIG7-4920/*C5732 C01
         CAL1,1   BFPT              1%%%%%%%%%%%%          /SIG7-4920/*C5732 C01
         LI,R1    C' '                                     /SIG7-4920/*C5732 C01
         STB,R1   MSG60                                    /SIG7-4920/*C5732 C01
         CAL1,1   BFPT              %%%%%%%%%%%%%          /SIG7-4920/*C5732 C01
         LW,R0    MSG61L                                   /SIG7-4920/*C5732 C01
         LI,R11   MSG61                                    /SIG7-4920/*C5732 C01
         LW,R1    K:VRSION                                 /SIG7-4920/*C5732 C01
         BNEZ     %+2               B IF VERSION NAME EXITS/SIG7-4920/*C5732 C01
         LW,R0    MSG61AL           BYTE LENGTH OF SHORTENED MSG                
         STW,R1   MSG61I            INSERT VERSION NAME                         
         CAL1,1   BFPT              XDS SIGMA 5/7 ...      /SIG7-4920/*C5732 C01
         LCI      3                                        /SIG7-4920/*C5732 C01
         LM,R0    K:ACCNAM+2                               /SIG7-4920/*C5732 C01
         STM,R0   MSG63+7                                  /SIG7-4920/*C5732 C01
         LW,R0    MSG63L                                   /SIG7-4920/*C5732 C01
         LW,R11   K:ACCNAM          ANY NAME/ACCT                               
         BNEZ     %+2               B IF YES                                    
         AI,R0    -12               NO. DECR BYTE CT BY 12                      
         LI,R11   MSG63                                    /SIG7-4920/*C5732 C01
         CAL1,1   BFPT              NAME                   /SIG7-4920/*C5732 C01
         LCI      2                                        /SIG7-4920/*C5732 C01
         LM,R10   K:ACCNAM                                 /SIG7-4920/*C5732 C01
         STM,R10  MSG64+7                                  /SIG7-4920/*C5732 C01
         LW,R0    MSG64L                                   /SIG7-4920/*C5732 C01
         CI,R10   0   ANY ACCT #?                          /SIG7-4920/*C5732 C01
         BNE      %+2    YES                               /SIG7-4920/*C5732 C01
         AI,R0    -8       NO MODIFY B/C                   /SIG7-4920/*C5732 C01
         LI,R11   MSG64                                    /SIG7-4920/*C5732 C01
         CAL1,1   BFPT              ACCOUNT                /SIG7-4920/*C5732 C01
         LW,R0    K:DATE2           WAS ENTERED            /SIG7-4920/*C5732 C01
         BEZ      C203              B IF DATE/TIME NOT KEYED IN                 
         CAL1,8   TIMEFPT2                                                      
         LW,R0    MSG65L                                   /SIG7-4920/*C5732 C01
         LI,R11   MSG65                                    /SIG7-4920/*C5732 C01
         CAL1,1   BFPT              SIGN-OFF               /SIG7-4920/*C5732 C01
C203     RES      0                                                             
         LI,R10   0                                        /SIG7-4920/*C5732 C01
         LW,R11   K:ELTIM2          GET TOTAL JOB TIME     /SIG7-4920/*C5732 C01
         DW,R10   K3600             CHANGE TO HR:MIN:SEC   /SIG7-4920/*C5732 C01
         STW,R10  R1                                       /SIG7-4920/*C5732 C01
         BAL,R8   BINBCD            CHANG HR TO BCD        /SIG7-4920/*C5732 C01
         STH,R10  MSG66+7           STORE HR IN IMAGE      /SIG7-4920/*C5732 C01
         LI,R10   0                                        /SIG7-4920/*C5732 C01
         LW,R11   R1                                       /SIG7-4920/*C5732 C01
         DW,R10   K60               GET MIN:SEC            /SIG7-4920/*C5732 C01
         STW,R10  R1                                       /SIG7-4920/*C5732 C01
         BAL,R8   BINBCD            CHANGE MIN TO BCD      /SIG7-4920/*C5732 C01
         STB,R10  MSG66+8                                  /SIG7-4920/*C5732 C01
         SLS,R10  -8                                       /SIG7-4920/*C5732 C01
         LI,R2    3                                        /SIG7-4920/*C5732 C01
         STB,R10  MSG66+7,R2                               /SIG7-4920/*C5732 C01
         LW,R11   R1                                       /SIG7-4920/*C5732 C01
         BAL,R8   BINBCD            CHANGE SEC TO BCD      /SIG7-4920/*C5732 C01
         LI,R2    1                                        /SIG7-4920/*C5732 C01
         STH,R10  MSG66+8,R2                               /SIG7-4920/*C5732 C01
         LW,R0    MSG66L                                   /SIG7-4920/*C5732 C01
         LI,R11   MSG66                                    /SIG7-4920/*C5732 C01
         CAL1,1   BFPT              TOTAL JOB TIME         /SIG7-4920/*C5732 C01
         LI,R0    X'CF'             SKIP 15 LINES          /SIG7-4920/*C5732 C01
         STB,R0   MSG60                                    /SIG7-4920/*C5732 C01
         LW,R0    MSG60L                                   /SIG7-4920/*C5732 C01
         LI,R11   MSG60                                    /SIG7-4920/*C5732 C01
         CAL1,1   BFPT              %%%%%%%%               /SIG7-4920/*C5732 C01
         LI,R1    C' '                                     /SIG7-4920/*C5732 C01
         STB,R1   MSG60                                    /SIG7-4920/*C5732 C01
         CAL1,1   BFPT              %%%%%%%%%%%            /SIG7-4920/*C5732 C01
C205     RES      0                                                             
         LI,R0    0                                                             
         LI,R1    JCBSY                                                         
         LS,R0    JCBBKG            SAVE BKG SY FLAG                            
         STS,R1   JCBBKG            SET TEMPORARY SY                            
         STW,R0   C30                                                           
         CAL1,1   DFMAL             YES, SET RECORD SIZE+BLOCKED FOR AL         
         CAL1,1   POSAL             DO FILE SKIP ON AL                          
C21      LI,R1    8                                                             
         LW,R0    K:ACCNAM-1,R1     MOVE AL ENTRY                               
         STW,R0   INBUF1-1,R1                                                   
         BDR,R1   %-2                                                           
C22      CAL1,1   WRITEAL           GO WRITE AL FILE                            
C22A     RES      0                                                             
         LI,R2    F:AL                                                          
         BAL,R4   CLOSCOD1          CLOSE AL FILE                               
C23      RES      0                                                             
         LW,R0    C30                                                           
         LI,R1    JCBSY                                                         
         STS,R0   JCBBKG            RESTORE SY FLAG                             
         B        *C29              EXIT                                        
C29      DATA     0                                                             
C30      DATA     0                 SAVE CELL FOR BKG SY FLAG                   
C90      DATA     X'04000003'                                                   
TIMEFPT2 GEN,8,24 X'10',MSG65+7                                                 
         TITLE    '**** PROCESS ASSIGN COMMAND ****'                            
*                                                                               
*                                                                               
D01      CI,R6    1                                                             
         BNE      A08               ERROR IF NOT END OF FIELD                   
         LW,R4    K:ASSIGN                                                      
         LW,R3    *R4                                                           
         CI,R3    48                                                            
         BGE      D80               BRANCH IF TOO MANY ASSIGNS                  
         AI,R4    -9                SET UP INDEX FOR ASSIGN TABLE               
         LW,R0    *K:ASSIGN                                                     
         STW,R0   D90               SAVE NO. ENTRIES                            
         LW,R1    ASNCTL            GET NR OF NON-I/O-ID VALUES                 
         LI,R0    0                                                             
         STB,R0   ASNFTBL,R1        ZERO THE FLAG SAVE TABLE                    
         BDR,R1   %-1                                                           
         BAL,R8   SCAN              GET DCB NAME                                
         CI,R6    0                                                             
         BNE      A08               ERROR IF NOT END OF SUBFIELD                
         LH,R0    R8                                                            
         CI,R0    X'FD47A'          M: IN BCD                                   
         BE       %+3                                                           
         CI,R0    X'FC67A'          F: IN BCD                                   
         BNE      A08               ERROR, DCB MUST STAR WITH M:, F:            
         LCI      2                                                             
         STM,R8   0,R4              PUT DCB NAME IN ASN TBL                     
         LI,R1    F:OPEN            DCB TO ASSIGN                               
         LW,R9    GIOBITS           FLAGS FOR WHAT IS PERMITTED                 
         BAL,R8   ASGNDCB           ASSIGN PER COMMAND                          
         LW,R0    GIOCT             GET RETURNED FLAGS                          
         CW,R0    GIOFBIT                                                       
         BAZ      D02               B IF NOT FILE ASSIGNMENT                    
         CAL1,1   OPEN              OPEN THE DCB TO VALIDATE FID                
         LI,R0    F:OPEN                                                        
         LW,R1    KX1FFFF                                                       
         STS,R0   CLOSE                                                         
         CAL1,1   CLOSE             CLOSE THE DCB                               
D02      RES      0                                                             
         LCI      6                                                             
         LM,R8    GIOCT                                                         
         STM,R8   2,R4              STORE I/O ID BLOCK IN ASN TBL               
D04      CI,R6    2                 END OF CARD                                 
         BNE      D06               NO                                          
         LI,R3    0                 INITIALIZE ASNCTL POINTER                   
*                                                                               
*        NOW PACK SAVED ASSIGNMENT VALUES INTO ASSIGN TABLE                     
D05      RES      0                                                             
         AI,R3    1                 INDEX TO NEXT ASSIGNED FIELD                
         LW,R7    ASNCTL,R3         GET ITS ASNCTL ENTRY                        
         LI,R1    1                                                             
         LB,R6    R7,R1             EXTRACT FIELD SIZE                          
         LCW,R6   R6                CHANGE TO RIGHT-SHIFT COUNT                 
         AND,R7   KXFF              EXTRACT ASSIGN TABLE ENTRY WORD NR          
         LW,R15   *R4,R7            GET THE ASSIGN TABLE WORD                   
         LB,R14   ASNFTBL,R3        GET ASSIGN FLAG FOR CURRENT VALUE           
         SLD,R14  -1                PACK THE FLAG                               
         LW,R14   ASNVTBL,R3        GET CURRENT VALUE                           
         SLD,R14  0,R6              PACK THE VALUE                              
         STW,R15  *R4,R7            PUT WORD BACK IN ASSIGN TABLE               
         CW,R3    ASNCTL                                                        
         BL       D05               B IF NOT DONE YET                           
*                                                                               
*        UPDATE ASSIGN TABLE POINTER AND COUNTER                                
         AI,R4    -1                REDUCE TO POINT TO NO. ENTRIES WORD         
         LW,R0    D90                                                           
         AI,R0    1                 STEP NO. ENTRIES                            
         STW,R0   *R4               SAVE AT TOP OF TABLE                        
         STW,R4   K:ASSIGN                                                      
         B        A03               EXIT                                        
D06      LI,R0    1                                                             
         STW,R0   SCANPMA           SET FOR BCD CONVERSION                      
         BAL,R8   SCAN              GET NEXT FILED                              
         CI,R6    -1                                                            
         BNE      D10               FIELD OK                                    
D08      LW,R0    D90               ERROR ON CARD                               
         STW,R0   *K:ASSIGN         RESTORE NO. OF ENTRIES                      
         B        A08               TAKE ERROR EXIT                             
D10      LW,R1    D91                                                           
         LI,R9    X'FFF00'                                                      
         CS,R8    D91,R1            SEARCH FOR KEYWORD                          
         BE       %+3               FOUND IT                                    
         BDR,R1   %-2                                                           
         B        D08               ERROR, BAD KEYWORD                          
         LW,R0    D92,R1                                                        
         B        *R0               GO TO PROPER ROUTINE                        
*                                                                               
*                                   BCD KEYWORD                                 
D15      RES      0                                                             
         STW,R8   ASNVTBL,R1        SET VALUE IN VALUE TEMP TBL                 
         LI,R8    1                                                             
         STB,R8   ASNFTBL,R1        SET FLAG IN ASSIGN FLAG TEMP TBL            
         CI,R6    0                                                             
         BE       D08               B IF NOT END OF FIELD                       
         B        D04               GO GET NEXT KEYWORD                         
*                                                                               
*                                                                               
D20      RES      0                 BCD KEYWORD                                 
         LI,R8    0                 MODE FIELD VALUE IS 0                       
D20A     RES      0                                                             
         LI,R1    ASNMOD            INDEX FOR MOD FIELD                         
         B        D15               B TO SAVE VALUE                             
*                                                                               
*                                                                               
D21      RES      0                 BIN KEYWORD                                 
         LI,R8    1                 MOD FIELD VALUE IS 1                        
         B        D20A                                                          
*                                                                               
*                                                                               
D22      RES      0                 VFC KEYWORD                                 
         LI,R8    1                 VFC FIELD VALUE IS 1                        
D22A     RES      0                                                             
         LI,R1    ASNVFC            INDEX FOR VFC FIELD                         
         B        D15               B TO SAVE VALUE                             
*                                                                               
*                                                                               
D23      RES      0                 NOVFC KEYWORD                               
         LI,R8    0                 VFC FIELD VALUE IS ZERO                     
         B        D22A                                                          
*                                                                               
*                                                                               
D26      RES      0                 PACK AND D1600 KEYWORDS                     
         LI,R8    1                 D/P FIELD VALUE IS 1                        
D26A     RES      0                                                             
         LI,R1    ASNDP             INDEX FOR D/P FIELD                         
         B        D15                                                           
*                                                                               
*                                                                               
D27      RES      0                 UNPACK AND D800 KEYWORDS                    
         LI,R8    0                 D/P FIELD VALUE IS ZERO                     
         B        D26A                                                          
*                                                                               
*                                   TRIES KEYWORD                               
D31      CI,R6    0                                                             
         BNE      D08               ERROR IF NOT END OF SUBFIELD                
         MTW,3    SCANPMA           SET FOR DECIMLA                             
         BAL,R8   SCAN              GO GET NO. OF REC. TRIES                    
         CI,R6    1                                                             
         BL       D08               ERROR                                       
         CI,R8    255                                                           
         BG       D08               ERROR IF NRT>255                            
         LI,R1    ASNNRT            INDEX FOR NRT FIELD                         
         B        D15               B TO SAVE VALUE                             
*                                                                               
*                                   RECL KEYWORD                                
D32      CI,R6    0                                                             
         BNE      D08               ERROR                                       
         MTW,3    SCANPMA           SET FOR DECIMAL                             
         BAL,R8   SCAN              GO GET REC. LENGTH                          
         CI,R6    1                                                             
         BL       D08               ERROR                                       
         CI,R8    32767                                                         
         BG       D08               ERROR IF MORE THAN 15 BITS                  
         LI,R1    ASNRSZ            INDEX FOR RSZ FIELD                         
         B        D15               B TO SAVE VALUE                             
*                                                                               
*                                                                               
D33      RES      0                 ASCII (TAPE) KEYWORD                        
         LI,R8    1                 ASC FIELD VALUE IS 1                        
D33A     RES      0                                                             
         LI,R1    ASNASC            INDEX FOR ASC FIELD                         
         B        D15               B TO SAVE VALUE                             
*                                                                               
*                                                                               
D34      RES      0                 EBCDIC (TAPE) KEYWORD                       
         LI,R8    0                 ASC FIELD VALUE IS ZERO                     
         B        D33A                                                          
*                                                                               
*                                                                               
D35      RES      0                 DRC KEYWORD                                 
         LI,R8    1                 DRC FIELD VALUE IS 1                        
D35A     RES      0                                                             
         LI,R1    ASNDRC            INDEX FOR DRC FIELD                         
         B        D15               B TO SAVE VALUE                             
*                                                                               
*                                                                               
D36      RES      0                 NODRC KEYWORD                               
         LI,R8    0                 DRC FIELD VALUE IS ZERO                     
         B        D35A                                                          
*                                                                               
*                                   BTD KEYWORD                                 
D37      RES      0                                                             
         CI,R6    0                                                             
         BNE      D08               B IF ERROR OR NO BTD VALUE                  
         MTW,3    SCANPMA           SET FOR DECIMAL                             
         BAL,R8   SCAN              GET BTD VALUE                               
         CI,R6    1                                                             
         BL       D08               B IF ERROR OR NOT END OF FIELD              
         CI,R8    0                                                             
         BL       D08               B IF TOO SMALL                              
         CI,R8    3                                                             
         BG       D08               B IF TOO LARGE                              
         LI,R1    ASNBTD            INDEX FOR BTD FIELD                         
         B        D15               B TO SAVE VALUE                             
*                                                                               
*                                   TOO MANY ASSIGNS                            
D80      LI,R9    MSG33                                                         
         BAL,R8   LOGALM            'TOO MANY !ASSIGNS'                         
         B        A08A                                                          
D90      DATA     0                 NO. OF OLD ASSIGN ENTRIES                   
D91      DATA     D92-D91-1         VALID KEYWORDS                              
         TEXT     'BCD '                                                        
         TEXT     'BIN '                                                        
         TEXT     'VFC '                                                        
         TEXT     'NOV '                                                        
         TEXT     'PAC '                                                        
         TEXT     'UNP '                                                        
         TEXT     'TRI '                                                        
         TEXT     'REC '                                                        
         TEXT     'D16 '                                                        
         TEXT     'D80 '                                                        
         TEXT     'ASC '                                                        
         TEXT     'EBC '                                                        
         TEXT     'DRC '                                                        
         TEXT     'NOD '                                                        
         TEXT     'BTD '                                                        
D92      DATA     0,D20,D21,D22,D23                                             
         DATA     D26,D27,D31,D32                                               
         DATA     D26,D27,D33,D34                                               
         DATA     D35,D36,D37                                                   
*                                                                               
*                                                                               
*        THE FOLLOWING TABLE CONTROLS THE REPRESENTATION                        
*        IN THE ASSIGN TABLE OF FIELDS TO BE ALTERED OTHER                      
*        THAN THOSE IDENTIFYING THE I/O MEDIUM.                                 
*                                                                               
*        WORD ZERO CONTAINS THE NUMBER OF ENTRIES.                              
*        EACH FOLLOWING WORD IS AN ENTRY WHICH DESCRIBES                        
*        THE LOCATION OF A DCB FIELD AND THE PACKING OF                         
*        ITS ASSIGNED VALUE IN THE ASSIGN TABLE.                                
*                                                                               
*        BYTE 0 OF AN ENTRY CONTAINS THE LEFT-SHIFT COUNT                       
*        TO SHIFT A VALUE FROM RIGHT-ALIGNED (NORMAL)                           
*        TO DCB-ALIGNED (NATURAL) POSITION IN A WORD.                           
*        BYTE 1 IS THE BIT LENGTH OF THE FIELD CONCERNED.                       
*        BYTE 2 IS THE DCB WORD IN WHICH THE FIELD RESIDES.                     
*        BYTE 3 IS THE ASSIGN TABLE WORD IN WHICH THE VALUE IS PACKED.          
*                                                                               
*        THE ENTRIES FOR FIELD VALUES PACKED IN A SINGLE ASSIGN                 
*        TABLE WORD ARE GROUPED IN THE CONTROL TABLE ORDERED                    
*        INVERSE TO THE ORDER IN WHICH THE VALUES WILL BE LEFT-SHIFTED          
*        OUT OF THE ASSIGN TABLE WORD.                                          
*                                                                               
*        THIS TABLE MUST BE THE DUPLICATE OF THE ONE IN BKL1                    
*        WHICH IS USED TO UNPACK THE ASSIGN TABLE.                              
*                                                                               
ASNCTL   CNAME                                                                  
         PROC                                                                   
LF       EQU      %-ASNCTL                                                      
         DATA,1   AF(1),AF(2),AF(3),AF(4)                                       
         PEND                                                                   
*                                                                               
ASNCTL   DATA     ASNCTLE-ASNCTL-1                                              
*        ENTRIES FOR ASSIGN TABLE WORD 8                                        
ASNNRT   ASNCTL   24,8,1,8          NRT                                         
ASNBTD   ASNCTL   4,2,0,8           BTD                                         
ASNVFC   ASNCTL   8,1,0,8           VFC                                         
ASNDP    ASNCTL   9,1,0,8           D/P                                         
ASNDRC   ASNCTL   10,1,0,8          DRC                                         
ASNASC   ASNCTL   11,1,0,8          ASC                                         
ASNMOD   ASNCTL   17,1,0,8          MOD                                         
*        ENTRIES FOR ASSIGN TABLE WORD 9                                        
ASNRSZ   ASNCTL   17,15,3,9         RSZ                                         
ASNCTLE  RES      0                                                             
*                                                                               
*                                                                               
*        THE FOLLOWING TABLES ARE USED TO SAVE ASSIGNED FIELD                   
*        VALUES UNTIL COMPLETION OF COMMAND ANALYSIS. THEY                      
*        HAVE THE SAME ORDER AS ASNCTL.                                         
*                                                                               
ASNVTBL  EQU      BUFF1             ASSIGNED VALUES (ENTRY=1 WORD)              
ASNFTBL  EQU      BUFF1+ASNCTLE-ASNCTL  PRESENCE FLAGS FOR VALUES               
*        (ENTRY=1 BYTE).  ENTRY CONTAINS ZERO IF FIELD IS NOT ASSIGNED,         
*        ONE IF IT IS.                                                          
         TITLE    '**** PROCESS DAL COMMAND ****'                               
*                                                                               
*                                   LISTS AL (ACCOUNTING LOG) FILE ONTO         
*                                     LO                                        
*                                   PURGES FILE WHEN DONE IF REQUESTED          
*                                                                               
E01      LI,R0    0                                                             
         STW,R0   E95               CLEAR PURGE FLAG                            
         CI,R6    2                 END OF CARD                                 
         BE       E02               YES                                         
         BAL,R8   SCAN              GO GET PAL PARAM.                           
         CI,R6    2                                                             
         BNE      A08               ERROR IF NOT END OF CARD                    
         LI,R9    X'FFF00'                                                      
         CS,R8    E96               IS PAL ON CARD                              
         BNE      A08               NO,ERROR                                    
         MTW,1    E95               SET FLAG TP PURGE AL                        
E02      CAL1,1   OPENAL            GO OPEN AL                                  
         LW,R0    K:DATE2                                                       
         BEZ      %+2               B IF DATE/TIME NOT KEYED IN                 
         CAL1,8   TIMEFPT3                                                      
         LI,R0    E90                                                           
         STW,R0   WRITELO+4                                                     
         LI,R0    BA(E90E)-BA(E90)                                              
         STW,R0   WRITELO+5                                                     
         CAL1,1   WRITELO           GO PRINT HEADER                             
         LI,R0    E91                                                           
         STW,R0   WRITELO+4                                                     
         LI,R0    62                                                            
         STW,R0   WRITELO+5                                                     
         CAL1,1   WRITELO           GO PRINT HEADING LINE                       
E03      LI,R1    16                                                            
         LW,R0    KBLANKS                                                       
         STW,R0   E92-1,R1          BLANK OUT IMAGE                             
         BDR,R1   %-1                                                           
         LI,R0    X'C0'                                                         
         STB,R0   E92               SET FOR SINGLE SPACE                        
E03C     CAL1,1   READAL            GO READ NEXT RECORD                         
         LI,R6    BA(INBUF1)                                                    
         LI,R7    BA(E92)+5                                                     
         LI,R9    8                                                             
         BAL,R8   MOVBYTE           GO STORE ACCOUNT IN IMAGE                   
         LI,R7    BA(E92)+15                                                    
         LI,R9    12                                                            
         BAL,R8   MOVBYTE           GO STORE NAME IN IMAGE                      
         LW,R1    INBUF1+5                                                      
         AND,R1   KXFFFF            R1=DAY OF YEAR                              
         BEZ      E09               NO DATE INPUT                               
         LI,R2    0                                                             
E04      LB,R0    K:MONTH,R2        CHANGE DAY OF YEAR TO MONTH, DAY            
         SW,R1    R0                                                            
         BLEZ     %+3               FOUND PROPER MONTH                          
         AI,R2    4                                                             
         B        E04                                                           
         AW,R1    R0                R1 NOW= DAY OF MONTH                        
         SLS,R2   -2                CHANGE TO WORD INDEX                        
         LW,R10   K:MONTH,R2        R10= NAME OF MONTH IN BCD                   
         LI,R6    R10*4+1                                                       
         LI,R7    BA(E92)+28                                                    
         LI,R9    3                                                             
         BAL,R8   MOVBYTE           GO STORE NAME OF MONTH                      
         LW,R11   R1                                                            
         BAL,R8   BINBCD            GO CHANGE DAY OF MONTH TO BCD               
         SLS,R10  16                                                            
         AI,R10   ','''             ADD IN COMMA, APOSTROPHE                    
         LI,R6    R10*4                                                         
         LI,R7    BA(E92)+33                                                    
         LI,R9    4                                                             
         BAL,R8   MOVBYTE           GO STORE DAY OF MONTH                       
         LH,R11   INBUF1+5          GET YEAR IN BINARY                          
         BAL,R8   BINBCD            CHANGE YEAR TO BCD                          
         LI,R6    R10*4+2                                                       
         LI,R9    2                 SET FOR 2 CHARS.                            
         BAL,R8   MOVBYTE           GO STORE YEAR IN IMAGE                      
         LI,R9    3                 SET FOR 3 CHARS. FOR HRS                    
         LI,R6    R10*4+1                                                       
         LI,R7    BA(E92)+41                                                    
         LI,R1    0                 R1=INDEX FOR INBUF1                         
E06      LI,R10   0                                                             
         LW,R11   INBUF1+6,R1       GET EITHER START TIME OR TOTAL TIME         
         DW,R10   K3600                                                         
         STW,R10  R2                SAVE REMAINDER                              
         BAL,R8   BINBCD            CHANGE HOURS TO BCD                         
         SLS,R10  8                                                             
         AI,R10   ':'               ADD IN COLON                                
         BAL,R8   MOVBYTE           MOVE HRS INTO IMAGE                         
         LI,R10   0                                                             
         LW,R11   R2                                                            
         DW,R10   K60               GET MIN. AND SEC.                           
         STW,R10  R2                SAVE SEC.                                   
         BAL,R8   BINBCD            CHANGE MIN. TO BCD                          
         SLS,R10  8                                                             
         AI,R10   ':'               ADD IN COLON TO MINUTES                     
         LI,R9    3                                                             
         LI,R6    R10*4+1                                                       
         BAL,R8   MOVBYTE           MOVE MINUTES INTO IMAGE                     
         LW,R11   R2                                                            
         BAL,R8   BINBCD            CHANGE SEC. TO BCD                          
         LI,R9    2                                                             
         LI,R6    R10*4+2                                                       
         BAL,R8   MOVBYTE           MOVE SECONDS INTO IMAGE                     
         CI,R1    0                 ARE WE DONE                                 
         BNE      E08               YES                                         
         AI,R1    1                 NO, STEP INDEX TO GET TOTAL TIME            
E07      LI,R9    4                 SET FOR 4 CGARS. FOR HOUR                   
         LI,R7    BA(E92)+52                                                    
         LI,R6    R10*4                                                         
         B        E06                                                           
E08      LI,R0    E92                                                           
         STW,R0   WRITELO+4                                                     
         LI,R0    61                                                            
         STW,R0   WRITELO+5                                                     
         CAL1,1   WRITELO           GO PRINT LINE FOR THIS ENTRY                
         B        E03               GO GET NEXT ENTRY                           
E09      LI,R6    BA(E94)                                                       
         LI,R7    BA(E92)+35                                                    
         LI,R9    7                                                             
         BAL,R8   MOVBYTE           GO MOVE 'UNKNOWN' INTO IMAGE                
         LI,R1    1                                                             
         B        E07                                                           
*                                                                               
*                                   ENTER HERE IF EOF RETURNED ON READ          
E10      LI,R0    E93                                                           
         STW,R0   WRITELO+4                                                     
         LI,R0    15                                                            
         STW,R0   WRITELO+5                                                     
         CAL1,1   WRITELO           GO PRINT END OF DUMP                        
         LW,R0    E95               IS PURGE FLAG SET                           
         BEZ      E12               NO                     /SIG7-1985/*C5732    
         LI,R1    JCBSY                                                         
         CW,R1    JCBBKG                                                        
         BANZ     E11               B IF BKG HAS SY PRIVILEGE                   
         LI,R9    MSG12                                                         
         BAL,R8   LOGALM            REQUEST SY PRIVILEGE                        
         CAL1,9   WAIT              WAIT FOR RESPONSE                           
         LI,R1    JCBSY                                                         
         CW,R1    JCBBKG                                                        
         BAZ      E12               STILL NO SY. SKIP PURGE.                    
E11      CAL1,1   REWINDAL          PURGE AL FILE          /SIG7-1985/*C5732    
         CAL1,1   WEOFAL                                   /SIG7-1985/*C5732    
E12      LI,R1    X'1FFFF'                                 /SIG7-1985/*C5732    
         LI,R0    F:AL                                                          
         STS,R0   CLOSE                                                         
         CAL1,1   CLOSE             GO CLOSE AL                                 
         B        A03               EXIT FOR NEXT CONTROL CARD                  
E90      TEXT     '1DUMP OF ACCOUNTING LOG (AL) FILE'                           
E90D     TEXT     '                '   16 BLANKS                                
E90E     RES      0                                                             
TIMEFPT3 GEN,8,24 X'10',E90D                                                    
E91      TEXT     'A    ACCOUNT    NAME            DATE     STRT TIME'          
         TEXT     'TOTAL TIME'                                                  
E92      EQU      BUFF1                                                         
E93      TEXT     'AEND OF AL DUMP'                                             
E94      TEXT     'UNKNOWN'                                                     
E95      DATA     0                 FLAG FOR PURGE                              
E96      TEXT     'PAL '                                                        
         TITLE    '**** PROCESS ATTEND,MESSAGE,PAUSE,CC COMMANDS ****'          
*                                                                               
*                                   ATTEND COMMAND                              
F01      RES      0                                                             
         LW,R1    K:JCP1                                                        
         CW,R1    KL02                                                          
         BANZ     H10               B IF ATTEND NOT ALLOWED                     
         LI,R1    2                                                             
         STS,R1   K:JCP1            SET ATTEND CARD READ FLAG                   
         B        A03               EXIT FOR NEXT COMMAND                       
*                                                                               
*                                   MESSAGE COMMAND                             
G01      LI,R0    0                                                             
         STW,R0   G90               SET FLAG THAT NO WAIT WHEN DONE             
G02      RES      0                                                             
         LI,R1    X'30'                                                         
         STS,R1   F:OC              BTD=3                                       
         LW,R1    K:CCBUF                                                       
         AI,R1    -1                                                            
         STW,R1   F:OC+2            BUFFER=CCBUF WITH PREFIX                    
         LI,R1    81                BYTE COUNT TO LOG CMND                      
         STW,R1   WROCBCT           SET BYTE COUNT IN FPT                       
         LI,R0    X'5A'             EXCLAM. MARK IN BCD                         
         STW,R0   *F:OC+2           ADD TO MSG OUT BUFFER                       
         CAL1,1   WRITEOC           GO OUTPUT MESSAGE                           
         LW,R0    G90                                                           
         BEZ      A03               MSG. COMMAND SO EXIT                        
         LW,R1    IDLE                                                          
         STS,R1   K:CTST            SET BKG IDLE BIT                            
         CAL1,7   G91               STOP CAL                                    
         B        A03               EXIT                                        
G90      DATA     0                 MSG. OR PAUSE FLAG                          
G91      DATA     X'4B800000'       STOP FPT                                    
         DATA     X'80'             LONG WAIT                                   
*                                                                               
*                                   PAUSE COMMAND                               
H01      RES      0                                                             
         LW,R1    K:JCP1                                                        
         CW,R1    KL01                                                          
         BANZ     H10               B IF PAUSE NOT ALLOWED                      
         MTW,1    G90                                                           
         B        G02                                                           
H10      RES      0                                                             
         LI,R9    MSG42                                                         
         BAL,R8   LOGALM            MESSAGE: ERROR: SYSTEM UNATTENDED           
         B        A08A              ABORT JOB                                   
*                                                                               
*                                   CC  COMMAND                                 
J01      LI,R1    1                                                             
         LB,R0    K:JCP1,R1         GET PREVIOUS ASSIGN. FOR C OP LABEL         
         LI,R1    C                                                             
         STB,R0   OPLBS3,R1         RESTORE C OP LABEL TO PREVIOUS ASS.         
         LI,R0    0                                                             
         LI,R1    4                                                             
         STS,R0   K:JCP1            CLEAR TY ACTIVE BIT                         
         B        A03               EXIT                                        
*                                                                               
*        SYC COMMAND                                                            
*                                                                               
K01      LI,R0    JCBSY             SY ON FLAG                                  
         STW,R0   K:SY              SPECIAL BCK FLAG                            
         LI,R3    JCBBKG            R3 = BCKJCB ADR                             
         LI,R1    JCBSY             MASK                                        
         STS,R0   0,R3                                                          
         B        A03               EXIT, FOR NEXT CONTROL CARD                 
*                                                                               
*        RSY COMAND                                                             
*                                                                               
K02      LI,R0    0                                                             
         B        K01+1                                                         
         TITLE    '****PROCESS LIMIT, STDLB COMMANDS ****'                      
*                                                                               
*                                   LIMIT COMMAND                               
L01      CI,R6    1                                                             
         BNE      A08               ERROR IF NOT END OF FIELD                   
         MTW,3    SCANPMA           SET FOR DECIMAL CONVERSION                  
         BAL,R8   SCAN              GET MAX. EXECUTION TIME                     
         CI,R6    1                                                             
         BL       A08               B IF SCAN ERROR                             
         LW,R9    R8                                                            
         MI,R9    60                CHANGE MIN. TO SEC.                         
         STW,R9   K:LIMIT           SAVE LIMIT TIME FOR BCKG JOB                
         CI,R6    2                                                             
         BE       A03               B IF NO PAGE LIMIT SPECIFIED                
         BAL,R8   SCAN              GET PAGE LIMIT                              
         CI,R6    2                                                             
         BNE      A08               B IF NOT END OF COMMAND                     
         CI,R8    X'8000'                                                       
         BGE      A08               B IF TOO BIG                                
         LI,R1    1                                                             
         STH,R8   K:BPGLIM,R1       SET LIMIT                                   
         B        A03               EXIT                                        
*                                                                               
*                                                                               
*                                   STDLB COMMAND                               
M01      CI,R6    1                                                             
         BNE      A08               ERROR IF NOT END OF FIELD                   
M02      CI,R6    2                                                             
         BE       A03               EXIT ON END OF CARD                         
         LI,R0    1                                                             
         STW,R0   SCANPMA           SET FOR BCD CONVERSION                      
         LI,R0    0                                                             
         LI,R7    SCANPM                                                        
         BAL,R8   SCAN              GO GET OP LABEL                             
         CI,R6    0                                                             
         BNE      A08               ERROR IF NOT END OF SUBFIELD                
         CI,R10   2                                                             
         BG       A08               ERROR, IF MORE THAN 2 CHARS.                
         LH,R1    OPLBS1                                                        
         LH,R8    R8                                                            
         CH,R8    OPLBS1,R1         SEARCH FOR OP LABEL                         
         BE       %+3               FOUND IT                                    
         BDR,R1   %-2                                                           
         B        A08               ERROR, CAN'T FIND OP LABEL                  
         LW,R9    KXFFFF                                                        
         STS,R8   STDLBFPT          INSERT OPLB NAME INTO FPT                   
         LW,R9    GIOBITS           FLAGS FOR ANY TYPE I/O ID                   
         STW,R9   GIOCT             SET THEM IN GETIOID CONTROL TBL             
         LI,R9    GIOCT             LOAD CONTROL TBL ADDRESS                    
         BAL,R8   GETIOID           GET I/O STREAM ID                           
         CI,R6    0                                                             
         BL       A08               B IF ERROR IN STREAM ID                     
         LW,R8    GIOCT             GET FLAGS FOR TYPE ID FOUND                 
         LI,R9    GIOCT+1           ADDRESS OF ID                               
         CW,R8    GIOOBIT                                                       
         BAZ      %+2               B IF NOT OPLABEL                            
         OR,R9    KSIGN             ADDRESS IS INDIRECT FOR OPLABEL             
         STW,R9   STDLBPTR          SET ID POINTER IN STDLB FPT                 
         LW,R9    GIOBITS                                                       
         STS,R8   STDLBBTS          SET P-BITS IN STDLB FPT                     
         LI,R0    0                 INITIALIZE                                  
         CI,R1    C                 IS IT THE C DEVICE                          
         BNE      SAROUND                                                       
         LB,R4    OPLBS3,R1         GET OLD ASSIGN                              
         LI,R3     3                                                            
         CB,R4    JCPCATW,R3        IS IT SP,CATALOG                            
         BNE      SAROUND           NO  BRANCH                                  
         XW,R0    JCPCATW           GET C BEFORE CAT CALL & RESET K:CAT         
SAROUND  RES      0                                                             
         CAL1,7   STDLBFPT          DO STDLB                                    
         LH,R0    R0                GET C BEFORE CAT CALL                       
         AND,R0   KXFF                                                          
         BEZ      M02               NOT RETURNING FROM SP,CATALOG               
         CB,R0    OPLBS3,R1         ARE WE RETURNING TO CAT CALLER              
         BE       M02               YES  BRANCH                                 
         CI,R0    X'80'             NO  WAS OLD C A RAD FILE                    
         BAZ      M02               NO  BRANCH                                  
         BAL,R4   CLOSCOD0          YES  CLOSE IT                               
         B        M02                                                           
*****                                                                           
*                                                                               
         SPACE    2                                                             
STDLBERR EQU      %         ERROR ROUTINE FOR STDLB CAL ERRORS                  
         B        ERRCAL                                                        
         TITLE    '**** PROCESS NAME, RUN COMMANDS ****'                        
*                                                                               
*                                                                               
N01      BAL,R1   PNC               PRINT NAME COMMAND     /SIG7-4947/*C015732  
         LI,R4    0                                                             
         STW,R4   SCANPMB           RESCAN PROCESSOR NAME                       
         BAL,R8   SCAN              GET FILE NAME AGAIN                         
         CI,R6    0                                                             
         BL       A08               B IF SCAN ERROR                             
         LCI      2                                                             
         STM,R8   GIOCT+2           SET FILE NAME                               
         DO       #DFACNT                                                       
         LM,R8    KBLANKS                                                       
         STM,R8   GIOCT+4           SET DEFAULT ACCOUNT NAME                    
         FIN                        #DFACNT                                     
         LI,R1    S:SPAI                                                        
         LH,R8    MDNAME,R1         GET AREA NAME                               
         AND,R8   KXFFFF            TRIM TO 2 BYTES                             
         STW,R8   GIOCT+1           SET DISK AREA NAME                          
         DO       #DFACNT                                                       
         LW,R8    GIOFA             FILE AND ACCOUNT NAMES                      
         ELSE                       #DFACNT                                     
         LW,R8    GIOFBIT           FILE NAME                                   
         FIN                        #DFACNT                                     
         LW,R9    GIOBITS                                                       
         STS,R8   ASGNBITS          SET FILE ID P-BITS                          
         LI,R8    GIOCT+1                                                       
         STW,R8   ASGNPTR           SET FID POINTER FOR ASN CAL                 
         LI,R1    F:DC                                                          
         CAL1,1   ASGNFPT           ASSIGN F:DC TO PROCESSOR                    
N02      RES      0                                                             
         LW,R4    GIOCT+1           GET AREA NAME                               
         LCI      2                                                             
         LM,R8    GIOCT+2           GET FILE NAME                               
         STW,R8   MSG6+7                                                        
         STW,R8   MSG7+3                                                        
         STW,R8   MSG8+7            STORE NAME IN POSSIBLE ALARMS               
         STW,R9   MSG6+8                                                        
         STW,R9   MSG7+4                                                        
         STW,R9   MSG8+8                                                        
         CAL1,1   READFH            GO READ FILE HEADER                         
N02C     LI,R1    X'1FFFF'          SET UP TO CLOSE RFT ENTRY FOR F:DC          
         LI,R0    F:DC                                                          
         STS,R0   CLOSE                                                         
         CAL1,1   CLOSE             GO CLOSE RFT ENTRY FOR F:DC                 
         LW,R0    BUFF1             WAS FILE EVER WRITTEN IN                    
         BEZ      N04C              NO,ERROR                                    
         LH,R0    R0                GET UPPER HW FOR VALIDITY CK                
         CI,R0    X'0C00'                                                       
         BAZ      N02D              B IF NEITHER PRI NOR SEC                    
         BE       N02D              B IF BOTH PRI AND SEC                       
         CI,R0    X'03FE'                                                       
         BAZ      N02E              B IF ZERO BETWEEN FLAGS AND ADDR            
N02D     RES      0                                                             
         LI,R9    MSG39             BAD ENTRY POINT                             
         B        A08B                                                          
N02E     LH,R0    BUFF1             IS IT A BKG PGM                             
         CI,R0    X'1000'           IS IT A PUB LIB                             
         BAZ      %+3               NO                                          
         LI,R9    MSG8              YES, GO OUTPUT ALARM                        
         B        A08B                                                          
         CI,R0    X'0800'           IS IT SECONDARY                             
*        IF SO, WILL LOAD IN BKG, EVEN IF FGD, TO ALLOW FOR                     
*        FGD/BKG PROCESSORS                                                     
         BAZ      N05               YES                                         
         LW,R0    K:JCP1            NO, FGD                                     
         CI,R0    8                 WAS FG KEYED-IN                             
         BAZ      ERRFGRQ           B IF NO FG KEYIN                            
         CI,R4    'BT'                                                          
         BNE      N30               B IF NOT BT AREA                            
         CD,R8    KOV                                                           
         BE       N30               B IF OV FILE (ELSE ILLEGAL)                 
N04C     LI,R9    MSG7              GO OUTPUT 'FILE XXX NONEXIST'               
         B        A08B                                                          
*                                   ALLOCATE BT FILES                           
*                                   ALLOCATE :ALLOBT FILES FIRST                
N05      LI,R8    0                 CHECK FOR DEBUG REQUEST                     
         LI,R9    DEBUGBIT                                                      
         LW,R1    KL2                                                           
         CW,R1    RUN+1                                                         
         BAZ      %+2                                                           
         LI,R8    DEBUGBIT                                                      
         STS,R8   K:JCP1            SET/RESET DEBUG BKG FLAG                    
         LW,R9    K:BTFILE                                                      
         AND,R9   KXFFFF            R9=LAST SECTOR NOT YET ALLOTED              
         LI,R8    0                 R8=FIRST SECTOR FOR NEXT NOSAVE FILE        
         LI,R7    0                 R7= INDEX FOR 'ALL' FILE                    
         LW,R11   KSIGN             R11=MASK FOR SAVE BIT                       
         LI,R1    3                 START AT X1                                 
N06      LB,R0    SAVE,R1           IS THIS FILE TO BE SAVED                    
         BEZ      N12               NO                                          
         LI,R10   -1                YES, SET SAVE BIT=1 LATER ON                
         LW,R3    FSIZE,R1          ALLOCATE SAVED FILES AT BACK END            
         BLZ      N11               'ALL' INPUT                                 
         STW,R9   RFT3,R1           STORE EOT FOR FILE                          
         SW,R9    R3                COMPUTE EOT-SIZE= BOT                       
         STW,R9   RFT2,R1           AND SET BOT                                 
         MTW,+1   RFT2,R1           ADJUST FOR ZERO RELATIVE STARTS             
N08      LH,R6    GSIZE,R1          GET GRANULE SIZE                            
         SLS,R6   2                 CHANGE TO BYTES                             
         BAL,R15  SETRFT            GO SET REST OF RFT ENTRIES                  
         LH,R0    RSIZE,R1                                                      
         SLS,R0   2                 GET REC. SIZE IN BYTES                      
         STH,R0   RFT5,R1           CHANGE TO INPUT VALUE                       
         LB,R0    FORM,R1                                                       
         STB,R0   RFT7,R1           STORE FORMAT                                
         STS,R10  K:BTFILE          SET SAVE BIT                                
N09      SLS,R11  -1                CYCLE MASK FOR SAVE BIT                     
         AI,R1    1                                                             
         CB,R1    BT#               PAST END OF BT FILES                        
         BLE      N06               NO                                          
         LW,R1    R7                YES, ANY 'ALL' INPUT                        
         BEZ      N10               NO                                          
         STW,R9   RFT3,R1           SET EOT FOR 'ALL' FILE                      
         LB,R0    SAVE,R1           IS THIS A SAVE FILE                         
         BEZ      %+3                NO                                         
         LW,R9    R8                                                            
         AI,R9    -1                RESET R9 TO START OF SAVED FILE             
         STW,R8   RFT2,R1           SET BOT FOR 'ALL' FILE                      
         LH,R6    GSIZE,R1                                                      
         SLS,R6   2                                                             
         BAL,R15  SETRFT            GO SET UP RFT FOR 'ALL' FILE                
         LH,R0    RSIZE,R1                                                      
         SLS,R0   2                                                             
         STH,R0   RFT5,R1           CHANGE REC. SIZE AND FORMAT                 
         LB,R0    FORM,R1                                                       
         STB,R0   RFT7,R1                                                       
         STS,R12  K:BTFILE                                                      
N10      LI,R1    1                                                             
         STH,R9   K:BTFILE,R1       SAVE NEXT LWA OF SAVE FILES                 
         STW,R8   N94               SAVE NEXT FWA TO USE                        
         CI,R7    0                  WAS THERE AN ALL INPUT                     
         BE       N15                NO                                         
         LI,R0    -1                YES, SET FLAG THAT NO ROOM LEFT             
         STW,R0   N94                                                           
         B        N15               GO DO DEFAULT ALLOCATIONS                   
N11      STD,R10  R12               SAVE MASK AND SAVE FLAG                     
         STW,R1   R7                SAVE INDEX OF 'ALL' FILE                    
         B        N09                                                           
N12      LH,R0    RSIZE,R1                                                      
         BLZ      N09               FILE NOT INPUT ON ALLOBT                    
         LI,R10   0                 SET TO NOT SAVE                             
         LW,R3    FSIZE,R1                                                      
         BLZ      N11               'ALL' INPUT                                 
         STW,R8   RFT2,R1           ALLOCATE NON-SAVE FILES AT FRONT            
         AW,R8    R3                OF THE AREA; SET BOT; COMPUTE EOT           
         STW,R8   RFT3,R1           PLUS 1 AND STORE.                           
         MTW,-1   RFT3,R1           ADJUST TO MAKE INCLUSIVE EOT                
         B        N08                                                           
*                                                                               
*                                   DO DEFAULT ALLOCATIONS OF BT                
N15      RES      0                                                             
         LI,R0    N96                                                           
         STW,R0   N97               INIT. ADDRESS FOR NOT MACRSYM               
         LD,R8    F:DC+5                                                        
         CD,R8    KMACROSY          IS PROG MACROSYM                            
         BE       N80               B IF YES                                    
         CD,R8    KAP               IS IT AP                                    
         BE       N80A              B IF YES                                    
N20      RES      0                                                             
         LB,R1    BT#               NR OF BT FILES SYSGENNED                    
         LI,R2    0                 TOTAL ALLOT UNITS                           
N21      RES      0                                                             
         LB,R3    *N97,R1           GET ALLOT UNITS FOR FILE                    
         BEZ      N22               B IF NOT TO BE ALLOTED                      
         LD,R8    RFT1,R1                                                       
         BEZ      N22               B IF NOT ALREADY ALLOTED                    
         LI,R3    0                 IF ALREADY ALLOTED,                         
         STB,R3   *N97,R1           RESET FLAG FOR DEFAULT ALLOT                
N22      RES      0                                                             
         AW,R2    R3                ACCUMULATE ALLOT UNITS                      
         BDR,R1   N21                                                           
*                                                                               
         STB,R2   *N97              SAVE TOTAL DEFAULT ALLOT UNITS              
         LI,R3    0                 PRESET ALLOT UNIT SIZE TO ZERO              
         CI,R2    0                                                             
         BE       N23               B IF NOTHING TO ALLOT                       
         LW,R4    N94               START OF AVAILABLE BT                       
         BLZ      N23               B IF THERE WAS AN ALLOBT ALL                
         LW,R3    K:BTFILE                                                      
         AND,R3   KXFFFF                                                        
         SW,R3    R4                                                            
         AI,R3    1                 NR OF SECTORS AVAILABLE                     
         BLEZ     N29               B IF NONE                                   
         DW,R3    R2                NR OF SECTORS PER ALLOT UNIT                
         CI,R3    0                                                             
         BLE      N29               B IF NOT ENUF                               
*                                                                               
N23      RES      0                                                             
         LI,R6    BTINDEX           GET WORDS PER SECTOR FOR DEVICE             
         LB,R6    MDDISCI,R6        BT AREA IS ON                               
         LH,R6    DISCNWPS,R6        AND CONVERT TO                             
         SLS,R6   2                   BYTES PER SECTOR                          
         LW,R2    N94               FIRST SECTOR TO ALLOT                       
         LB,R1    BT#               NR OF BT FILES SYSGENNED                    
N25      RES      0                                                             
         LB,R5    *N97,R1           ALLOT FACTOR                                
         MW,R5    R3                NR OF SECTORS TO ALLOT                      
         BEZ      N27               B IF NOT A DEFAULT ALLOT                    
         STW,R2   RFT2,R1           SET BOT FOR DEFAULT ALLOT                   
         AW,R2    R5                STEP BY SIZE TO NEXT AFTER END              
         STW,R2   RFT3,R1           SET EOT+1                                   
         MTW,-1   RFT3,R1           ADJUST TO TRUE EOT                          
         BAL,R15  SETRFT            SET REST OF RFT                             
N26      RES      0                                                             
         BDR,R1   N25                                                           
*                                                                               
*        DONE ALLOTTING BT FILES                                                
*                                                                               
         LCI      3+#DFACNT*2                                                   
         LM,R10   GIOCT+1                                                       
         STM,R10  *JCBBKG+JCBNXLM   SET NEXT BKG LOD MODULE ID                  
*                                                                               
         CAL1,7   WALLFPT           WAIT FOR SERVICE COMPLETIONS                
*                                                                               
         CAL1,9   EXIT              EXIT JCP.  NEXT LM WILL BE LOADED           
*                                                                               
*                                                                               
N27      RES      0                                                             
         LW,R10   RFT3,R1           TEST TO SEE IF FILESIZE > 0                 
         SW,R10   RFT2,R1                                                       
         BGEZ     N26               B IF FILE HAS NONZERO SIZE                  
         LD,R14   KZEROS                                                        
         STD,R14  RFT1,R1           FILE OF ZERO SIZE NOW IS NONEXIST.          
         B        N26                                                           
*                                                                               
N29      RES      0                                                             
         LI,R9    MSG11                                                         
         BAL,R8   LOGALM            'BT OVERFLOW' MESSAGE                       
         B        A08A                                                          
*                                                                               
*                                                                               
N30      LI,R0    -1                                                            
         STW,R0   N92               INIT. CELL TO POST STATUS IN                
         LD,R8    F:DC+5            GET FILE NAME                               
         STD,R8   RUN+2             STORE IN RUN CALL                           
N31      CAL1,5   RUN               CALL RUN                                    
         LW,R0    N92               GET STATUS                                  
         BLEZ     A03               EXIT, PROGRAM QUEUED OR LOADED              
         CI,R0    3                 IS PROG ALREADY LOADED                      
         BE       A03               YES,EXIT                                    
         CI,R0    4                 WAS PREVIOUS CALL MADE ON SAME PGM          
         BE       A03               YES,EXIT                                    
         CI,R0    5                 IS THERE NO ROOOM IN FP TABLE               
         BNE      A08A              NO,ERROR BUT ALARM LOGGED BY FGLD           
         LI,R9    MSG6              YES, LOG 'FPT FULL'                         
         B        A08B                                                          
         PAGE                                                                   
*                                                                               
*        ROUTINE TO MAKE SPECIAL CHECKS FOR VARIOUS                             
*        BT FILE ASSIGNMENTS FOR MACRSYM AND AP                                 
*        PROCESSORS.....FILE ALLOCATION IS BASED                                
*        ON COMBINATIONS OF SI,CI OPTIONS                                       
*                                                                               
*        USES R0-R9                                                             
*                                                                               
N80      RES      0                                                             
         LI,R5    0                 FLAG: MACRSYM                               
         LI,R0    N95               MACRSYM TABLE POINTER                       
         B        %+3                                                           
N80A     RES      0                                                             
         LI,R5    1                 FLAG: AP                                    
         LI,R0    N95A              XI FACTORS TABLE                            
         STW,R0   N97               SET FACTORS TABLE POINTER                   
         LI,R0    1                                                             
         STW,R0   SCANPMA           SET UP PARAM. FOR SCAN                      
         LI,R0    0                                                             
         STW,R0   SCANPMB                                                       
         LI,R7    SCANPM                                                        
         BAL,R8   SCAN              GO SCAN PAST NAME                           
         CI,R6    2                 ANY PARAM ON CARD                           
         BNE      N80C              YES...BEGIN PROCESSING                      
         LW,R5    R5                WHICH PROCESSOR                             
         BEZ      N20               B IF MACRSYM. DEFAULT SI, CI                
         B        N82               AP...DEFAULT SI                             
N80C     MTW,1    SCANPMB                                                       
         LI,R1    0                 RESET COUNT OF SI,CI                        
N81      MTW,1    SCAN87            FLAG TO IGNORE ERRORS  /SIG7-4191/*C015732  
         BAL,R8   SCAN              GO GET NEXT PARAM      /SIG7-4191/*C015732  
         MTW,-1   SCAN87            RESET FLAG TO ZERO     /SIG7-4191/*C015732  
         CW,R8    KCI               IS IT CI                                    
         BE       %+3               YES                                         
         CW,R8    KSI               NO,IS IT SI                                 
         BNE      %+2               NO                                          
         AI,R1    1                 YES,STEP COUNT                              
         CI,R6    2                 END OF CARD                                 
         BNE      N81               NO,GO BACK FOR NEXT PARAM                   
         CI,R1    1                 YES,WAS BOTH CI,SI ON CARD                  
         BG       N20               B IF YES                                    
N82      LI,R1    4                 SET FOR X2 AREA        /SIG710146/*C5732  03
         LW,R5    R5                WHICH PROCESSOR        /SIG710146/*C5732  03
         BNEZ     N86               AP..HANDLE X2,X4       /SIG710146/*C5732  03
*                 REMOVE X2 FROM MACRSYM ALLOCATION        /SIG710146/*C5732  03
         STB,R0   N95,R1            ALLOT FACTOR IS ZERO                        
         B        N20               RETURN                                      
*                                                          /SIG710146/*C5732  03
*                                                          /SIG710146/*C5732  03
*                 REMOVE X2/X4 ALLOCATION                  /SIG710146/*C5732  03
*                                                          /SIG710146/*C5732  03
N86      RES      0                                                             
         STB,R0   N95A,R1           ALLOT FACTOR IS ZERO FOR X2                 
         LI,R1    6                 SET INDEX TO CLEAR X4                       
         STB,R0   N95A,R1           ALLOT FACTOR IS ZERO FOR X4 OR X5           
         B        N20                                                           
*                                                                               
         BOUND    8                                                             
N87      DATA     0,0               SAVE CI ASSIGNMENT HERE                     
N88      DATA     0,0               SAVE SI ASSIGNMENT HERE                     
N89      DATA     0                                                             
*                                                                               
*                                   FLAGS                                       
N92      EQU      K:RUNJ            JCP RUN STATUS WORD                         
N94      DATA     0                 SAVE NEXT FWA HERE                          
*                                                                               
*                                   TABLES FOR SPECIAL ALLOCATION OF BT         
*                                                                               
N95      DATA,1   0,0,0,5,4,1,0,0,0,0,0,0   ALLOT FACTORS FOR MACRSYM BT FILES  
*                                                          /SIG710146/*C5732  03
*                 SPECIAL TABLE FOR AP ALLOCATION OF       /SIG710146/*C5732  03
*                 BT FILES...                              /SIG710146/*C5732  03
*                 NUMBERS REPRESENT RATIIO FOR X1-X5 FILES /SIG710146/*C5732  03
*                 BYTE 0= TOTAL FILE ALLOCATION...         /SIG710146/*C5732  03
*                                                          /SIG710146/*C5732  03
         BOUND    4                                                             
N95A     DATA,1   0,0,0,6,2,10,1,1,0,0,0,0                                      
*                                          X3 INTO FOR MACRSYM. BYTE 0=         
*                                          TOTAL NO. BT PARTS                   
         BOUND    4                                                             
N96      DATA,1   0,0,0,1,1,1,1,1,1,1,1,1    TABLE FOR PROCESSORS WITH          
*                                          NO SPECIAL ALLOCATION                
         BOUND    4                                                             
N97      DATA     0                 INDIRECT POINTER FOR N95,N96                
*                                                                               
*                                   RUN COMMAND                                 
P01      CI,R6    1                 RUN COMMAND                                 
         BNE      A08               NO,ERROR                                    
         LW,R9    GIOFA             FILE NAME WITH ACCOUNT PERMITTED            
         LI,R1    F:DC                                                          
         BAL,R8   ASGNDCB           ASSIGN LOAD MODULE TO F:DC                  
         CI,R6    1                                                             
         BL       A08               B IF SYNTAX ERROR IN LM NAME                
P02      LI,R0    X'1FF0'           GET DEFAULT PRI. AND INHIBIT PSTING         
         STH,R0   RUN+1                         OF SIGNALS AFTER QUEUING        
         CI,R6    2                                                             
         BGE      N02               B IF NO MORE PARAMETERS                     
         LW,R2    SCAN94            SAVE FIELD COUNT                            
         LW,R3    SCAN98            SAVE COLUMN INDEX                           
P03      BAL,R8   SCAN              SCAN FOR PRI. OR 'DEBUG'                    
         CI,R6    1                                                             
         BL       A08                                                           
         CI,R10   2                 2 CHARS. OR LESS SCANNED MEANS PRI.         
         BLE      P04               <2=PRI.                                     
         LW,R9    KL24              DEBUG                                       
         CS,R8    DEBUG                                                         
         BNE      A08                                                           
         LW,R1    KL2               SET DEBUG                                   
         STS,R1   RUN+1             BIT IN RUN CAL FPT                          
         B        P09                                                           
P04      STW,R3   SCAN98            SET TO RE-SCAN LAST FIELD                   
         STW,R2   SCAN94            SET TO RE-SCAN LAST FIELD                   
         MTW,1    SCANPMA           SET SCAN FOR HEX                            
         BAL,R8   SCAN              RE-SCAN THE FIELD                           
         CI,R8    X'7F'             TEST RANGE                                  
         BG       A08               LOWEST PRI. EXCEEDED                        
         CI,R8    0                 CAN'T HAVE NEG. PRI.                        
         BL       A08                                                           
         LI,R9    X'7F'             GET MASK                                    
         SLD,R8   20                ALIGN WITH FIEL IN FPT                      
         STS,R8   RUN+1             STORE PRI.                                  
P09      LI,R3    1                                                             
         STW,R3   SCANPMA           SET SCAN FOR EBCDIC                         
         CI,R6    2                                                             
         BNE      P03                                                           
         B        N02                                                           
*                                                                               
*                                                                               
P10      RES      0                 ROV COMMAND                                 
         LCI      4+#DFACNT*2                                                   
         LM,R8    ROVGIOCT          SET UP AS FOR 'RUN OV.BT'                   
         STM,R8   GIOCT                                                         
         LW,R9    GIOBITS                                                       
         STS,R8   ASGNBITS          SET P-BITS FOR ASSIGN CAL                   
         LI,R8    GIOCT+1                                                       
         STW,R8   ASGNPTR           SET FID POINTER FOR ASN CAL                 
         LI,R1    F:DC                                                          
         CAL1,1   ASGNFPT           ASSIGN F:DC TO OV.BT                        
         B        P02                                                           
*                                                                               
ROVGIOCT DATA     X'10000000'+#DFACNT*X'40000'                                  
         DATA     'BT'                                                          
         TEXT     'OV      '                                                    
         DO1      #DFACNT                                                       
         TEXT     '        '        ACCOUNT NAME (DEFAULTS TO SYSTEM)           
         TITLE    '**** PROCESS INIT COMMAND ****'                              
P101     RES      0                 INIT COMMAND PROCESSOR                      
         CI,R6    1                                                             
         BNE      A08               B IF NOT A FILE NAME NEXT                   
         LCI      EIFPT-INITFPT                                                 
         LM,R8    INITFPT                                                       
         STM,R8   BUFF1             MOVE INIT FPT INTO BUFFER                   
         LW,R9    GIOFA             FILE NAME WITH ACCOUNT PERMITTED            
         STW,R9   GIOCT                                                         
         LI,R9    GIOCT                                                         
         BAL,R8   GETIOID           GET LOAD MODULE NAME                        
         CI,R6    0                                                             
         BL       A08               B IF SYNTAX ERROR IN LM NAME                
         LW,R8    GIOCT+1           GET AREA NAME                               
         LW,R9    KXFFFF                                                        
         STS,R8   BUFF1             SET IT IN FPT                               
         LCI      2                                                             
         LM,R8    GIOCT+2           GET FILE NAME                               
         STM,R8   BUFF1+3           SET IT IN INIT FPT                          
         LW,R8    GIOCT                                                         
         LW,R9    GIOABIT                                                       
         STS,R8   BUFF1+1           SET/RESET ACNT NAME P-BIT                   
P110     RES      0                 PARAMETER SCAN LOOP                         
         CI,R6    1                                                             
         BG       P150              B IF NO MORE PARAMETERS                     
         BL       A08               B IF NOT START OF NEW PARAMETER             
         BAL,R8   SCAN              GET NEXT KEYWORD                            
         CI,R6    0                                                             
         BL       A08               B IF SCAN ERROR                             
         SLS,R8   -8                FIRST 3 CHARACTERS ONLY                     
         LW,R1    INITKEYS          NR OF KEYWORDS RECOGNIZED                   
         CW,R8    INITKEYS,R1                                                   
         BE       INITSUBS,R1       B IF FOUND                                  
         BDR,R1   %-2                                                           
         B        A08               B IF UNRECOGNIZED                           
*                                                                               
INITFPT  DATA     X'48800000'+'FP'  INIT FPT PROTOTYPE                          
         DATA     X'B0300030'                                                   
         PZE      INITERR                                                       
         TEXT     '        '                                                    
         DATA     0                                                             
IFPTJOB  TEXT     'CPR     '                                                    
         DATA     GIOCT+4                                                       
EIFPT    RES      0                                                             
*                                                                               
INITKEYS DATA     INITKEND-INITKEYS-1   NR OF KEYWORDS                          
         DATA     'JOB'             JOB NAME                                    
         DATA     'PRI'             PRIMARY OR PRIORITY                         
         DATA     'STO'             INIT WITH STOP                              
         DATA     'DEB'             INIT WITH DEBUG                             
         DATA     'TS '             INIT AS TIME SLICED                         
INITKEND EQU      %                                                             
*                                                                               
INITSUBS EQU      %-1               TABLE OF SUBROUTINES                        
         B        P115              JOB NAME                                    
         B        P125              PRIMARY OR PRIORITY                         
         B        P130              INIT WITH STOP                              
         B        P135              INIT WITH DEBUG                             
         B        P132              INIT AS TIME-SLICED                         
*                                                                               
INITERR  RES      0                 INIT ERROR PROCESSING ROUTINE               
         B        ERRCAL                                                        
*                                                                               
P115     RES      0                 JOB NAME                                    
         CI,R6    0                                                             
         BG       A08               B IF NAME IS NOT NEXT                       
         BAL,R8   SCAN              GET NAME                                    
         CW,R8    KBKG                                                          
         BE       A08               CANT INIT A BKG TASK                        
         LCI      2                                                             
         STM,R8   BUFF1+6           STORE JOB NAME IN FPT                       
         B        P110                                                          
*                                                                               
P125     RES      0                 PRIMARY OR PRIORITY                         
         CI,R6    0                                                             
         BG       P126              B IF NO PRIORITY VALUE FOLLOWS              
         LI,R0    2                 SCAN HEX NUMBER                             
         STW,R0   SCANPMA                                                       
         BAL,R8   SCAN              GET PRIORITY                                
         LI,R0    1                                                             
         STW,R0   SCANPMA           SET FOR EBCDIC SCAN                         
         CI,R6    0                                                             
         BL       A08               B IF HEX NR NOT FOUND                       
         STW,R8   BUFF1+5           PUT PRIORITY IN FPT                         
         LW,R1    KL01                                                          
         STS,R1   BUFF1+1           SET PRIORITY PRESENCE BIT                   
         B        P110                                                          
*                                                                               
P126     LI,R1    X'20'             PRIMARY                                     
         LI,R0    0                 RESET SECONDARY FLAG                        
         B        P136                                                          
*                                                                               
P130     LI,R1    X'40'             STOP                                        
         LW,R0    R1                SET STOP FLAG                               
         B        P136                                                          
P132     LI,R1    4                 TIME-SLICE                                  
         LW,R0    R1                SET TIME SLICE FLAG (F5)                    
         B        P136                                                          
*                                                                               
*                                                                               
P135     LI,R1    X'08'             DEBUG                                       
         LW,R0    R1                SET DEBUG FLAG                              
P136     CI,R6    0                                                             
         BLE      A08               NO VALUE MAY FOLLOW A FLAG KEY              
         STS,R0   BUFF1+1                                                       
         B        P110                                                          
*                                                                               
P150     RES      0                                                             
         LW,R1    KL01                                                          
         CW,R1    BUFF1+1                                                       
         BANZ     P160              B IF PRIORITY WAS SPECIFIED                 
         LCI      EIFPT-IFPTJOB                                                 
         LM,R8    BUFF1+6           MOVE JOB NAME FOREWARD                      
         STM,R8   BUFF1+5           OVER PRIORITY FIELD                         
P160     RES      0                                                             
         LW,R0    K:JCP1                                                        
         CI,R0    8                                                             
         BAZ      ERRFGRQ           B IF FG WAS NOT KEYED IN                    
         CAL1,7   BUFF1             DO THE INIT                                 
         B        A03                                                           
         TITLE    '**** PROCESS SJOB COMMAND ****'                              
P201     RES      0                 SJOB COMMAND                                
         LW,R0    K:JCP1                                                        
         CI,R0    8                                                             
         BAZ      ERRFGRQ           B IF NO FG KEYIN                            
         CI,R6    1                                                             
         BNE      A08               B IF JOB NAME NOT SUPPLIED                  
         LI,R1    SJOBFPT%-SJOBFPT                                              
         LW,R8    SJOBFPT-1,R1                                                  
         STW,R8   BUFF1-1,R1        MOVE SJOB FPT INTO BUFFER                   
         BDR,R1   %-2                                                           
         BAL,R8   SCAN              GET JOB NAME                                
         LCI      2                                                             
         STM,R8   BUFF1+SJNAME      SET JOB NAME                                
P205     RES      0                                                             
         CI,R6    1                                                             
         BL       A08               B IF NOT END OF FIELD                       
         BG       P250              B IF END OF COMMAND                         
         BAL,R8   SCAN              GET KEYWORD                                 
         LI,R9    X'FFF00'                                                      
         CS,R8    DEBUG                                                         
         BE       P209              B IF DEBUG DEVICE                           
         CS,R8    KACC                                                          
         BNE      A08               B IF NOT ACCNT NAME                         
*                                                                               
         CI,R6    0                                                             
         BNE      A08               B IF NAME DOESNT FOLLOW                     
         BAL,R8   SCAN                                                          
         LCI      2                                                             
         STM,R8   BUFF1+SJANAME     SET ACCOUNT NAME                            
         B        P205                                                          
*                                                                               
P209     RES      0                                                             
         CI,R6    0                                                             
         BNE      A08               B IF NO DEVICE NAME FOLLOWS                 
         BAL,R8   SCAN              GET DEVICE NAME                             
         LCI      2                                                             
         STM,R8   BUFF1+SJDDNAME    SAVE DEBUG DEVICE NAME                      
         SLD,R8   -24                                                           
         OR,R8    NLBB              CONVERT TO DCT16 FORM                       
         LH,R1    DCT#              NR OF DEVICES                               
P210     RES      0                                                             
         CD,R8    DCT16,R1                                                      
         BE       P205              B IF DEVICE NAME FOUND                      
P215     BDR,R1   P210              CHECK NEXT DEVICE                           
         B        A08               UNRECOGNIZED DEVICE NAME                    
*                                                                               
P250     RES      0                                                             
         CAL1,7   BUFF1             DO THE SJOB                                 
         LW,R8    BUFF1+SJDDNAME                                                
         BEZ      A03               B IF NO DEBUG DEVICE                        
         LCI      2                                                             
         LM,R8    BUFF1+SJNAME      GET JOB NAME                                
         BAL,R8   TMFINDJ           GET JOB ID                                  
         B        A03               NOT FOUND. FORGET IT                        
         LCI      2                                                             
         LM,R10   BUFF1+SJDDNAME    GET DEBUG DEVICE NAME                       
         STM,R10  JCBDBUG,R7        SET IN JCB JUST CREATED                     
         B        A03               DONE.                                       
*                                                                               
SJOBFPT  DATA     X'63800000'                                                   
         DATA     X'80340000'                                                   
         PZE      SJOBERR                                                       
SJNAME   EQU      %-SJOBFPT         REL LOC FOR JOB NAME                        
         DATA     0,0               SPACE FOR JOB NAME                          
         PZE      BUFF1+SJANAME     POINTER TO ACNT NAME                        
SJANAME  EQU      %-SJOBFPT         REL LOC FOR ACNT NAME                       
         DATA     0,0,0,0,0                                                     
SJDDNAME EQU      %-SJOBFPT+2       REL LOC FOR DEBUG DEVICE NAME               
         DATA     0,0                                                           
SJOBFPT% EQU      %                                                             
*                                                                               
SJOBERR  RES      0                                                             
         B        ERRCAL                                                        
*                                                                               
         TITLE    '***** BATCH COMMAND *****'                                   
         DO       #SYMB                                                         
P301     RES      0                                                             
         CI,R6    1                                                             
         BNE      A08               B IF NOT A FOLLOWING PARAM                  
         LCI      EBFPT-BATCHFPT                                                
         LM,R8    BATCHFPT                                                      
         STM,R8   BUFF1             MOVE FPT TO BUFFER                          
         LW,R9    GIOFA             FILE NAME WITH ACCOUNT PERMITTED            
         STW,R9   GIOCT                                                         
         LI,R9    GIOCT                                                         
         BAL,R8   GETIOID           GET BATCH FILE ID                           
         CI,R6    2                                                             
         BL       A08               B IF BATCH FILE ID SYNTAX ERROR             
         LCI      2                                                             
         LM,R8    GIOCT+2           GET FILE NAME                               
         STM,R8   MSG7+3            STORE IN FILE NONEXIST MSG                  
         LW,R8    GIOCT                                                         
         LW,R9    GIOBITS                                                       
         STS,R8   BUFF1+1           SET NECESSARY P-BITS                        
         CAL1,7   BUFF1             CALL BATCH SERVICE                          
         B        A03               DONE                                        
*                                                                               
BATCHERR RES      0                 ERROR RETURN FOR BATCH CAL                  
         LB,R9    R10               GET ERROR CODE                              
         CI,R9    X'71'                                                         
         BE       N04C              B IF NONEXISTENT FILE                       
         CI,R9    X'03'                                                         
         BE       N04C              B IF NONEXISTENT FILE                       
         B        ERRCAL            ALL OTHER ERRORS                            
*                                                                               
BATCHFPT DATA     X'67800000'       JOB CAL                                     
         DATA     X'90040010'       P1, P4, P14, WAIT                           
         DATA     BATCHERR          ERROR RETURN                                
         DATA     GIOCT+1           FILE/AREA NAME POINTER                      
         DATA     GIOCT+4           ACCOUNT NAME POINTER                        
EBFPT    RES      0                                                             
         FIN                        #SYMB                                       
*                                                                               
         TITLE    '**** PROCESS POOL, ALLOBT COMMANDS ****'                     
*                                                                               
*                                                                               
*                                                                               
*                                   ALLOBT COMMAND                              
R01      CI,R6    1                                                             
         BNE      A08               ERROR IF NOT END OF FIELD                   
         LI,R1    BTINDEX           INSURE THE BT AREA IS ALLOCATED             
         LB,R0    MDFLAG,R1                                                     
         CI,R0    ALLOC             IS THE ALLOCATED FLAG SET ?                 
         BAZ      A08               BT AREA NOT ALLOC., DON'T ALLOW  CMD        
         LI,R1    6                                                             
         LI,R0    -2                                                            
         STW,R0   FORM1-1,R1        HOUSEKEEP VALUES TO -2                      
         BDR,R1   %-1                                                           
R02      CI,R6    2                                                             
         BE       R04               END OF CARD                                 
         LI,R0    1                                                             
         STW,R0   SCANPMA           SET FOR EBCDIC                              
         BAL,R8   SCAN              GET NEXT KEYWORD                            
         LI,R9    X'FFF00'                                                      
         LW,R1    R90                                                           
         CS,R8    R90,R1            SEARCH FOR KEYWORD                          
         BE       %+3               FOUND IT                                    
         BDR,R1   %-2                                                           
         B        A08               ERROR ID CAN'T FIND KEYWORD                 
         LW,R0    R91,R1                                                        
         B        *R0               GO TO PROPER PROCESSING SECTION             
*                                                                               
R04      RES      0                                                             
         LI,R1    BTINDEX           GET SECTOR SIZE FOR THE BT AREA             
         LB,R1    MDDISCI,R1                                                    
         LH,R8    DISCNWPS,R1       FROM THE DISC TABLES FOR THE DEVICE         
         LW,R4    RFTX1             RECOVER FILE RFT INDEX                      
         BLEZ     R31B              B IF NOT SPECIFIED                          
         LW,R0    FORM1             SET UP DEFAULTS                             
         BGEZ     R05               FORMAT WAS INPUT BY USER                    
         CI,R4    2                 GO FILE                                     
         BNE      %+3               NO                                          
         LI,R0    1                 YES, SET DEFAULT TO BLOCKED                 
         B        %+2                                                           
         LI,R0    0                 SET DEFAULT TO UNBLOCKED                    
         STW,R0   FORM1                                                         
R05      LW,R0    FSIZE1                                                        
         CI,R0    -2                WAS FSIZE INPUT                             
         BNE      %+3               YES                                         
         LI,R0    1000              NO, SET DEFAULT TO 1000 RECORDS             
         STW,R0   FSIZE1                                                        
         LW,R0    RSIZE1                                                        
         BGEZ     R06               RSIZE WAS INPUT                             
         LW,R0    FORM1                                                         
         CI,R0    1                 GET FORMAT OF FILE                          
         BG       R23               COMPRESSED                                  
         BL       %+3               UNBLOCKED                                   
         LI,R0    128               BLOCKED, DEFAULT RSIZE=128                  
         B        R05D                                                          
         LW,R0    GSIZE1             WAS GRANULE SIZE INPUT                     
         BGEZ     %+2                YES,TAKE AS RSIZE                          
         LW,R0    R8                NO, TAKE DEFAULT AS SECT SIZE               
R05D     STW,R0   RSIZE1            SET DEFAULT SIZE                            
R06      CI,R0    128               IS RSIZE MORE THAN 128                      
         BLE      R07               NO                                          
         LI,R0    0                 YES, SET FORMAT TO UNBLOCKED                
         STW,R0   FORM1                                                         
R07      LW,R0    GSIZE1            WAS GSIZE INPUT                             
         BGEZ     %+2               YES                                         
         STW,R8   GSIZE1            NO, SET DEFAULT TO SECT SIZE                
         LW,R0    FSIZE1                                                        
         BLZ      R22               IF ALL WAS INPUT DON'T CALC. FSIZE          
         LW,R0    FORM1                                                         
         CI,R0    1                 GET FORMAT OF FILE                          
         BG       R25               COMPRESSED                                  
         BE       R26               BLOCKED                                     
         LI,R2    0                 UNBLOCKED, COMPUTE NO. SECTORS              
         LW,R3    RSIZE1            GET (RSIZE/SSIZE)*FSIZE                     
         DW,R2    R8                                                            
         CI,R2    0                                                             
         BE       %+2                                                           
         AI,R3    1                 ADD 1 IF REMAINDER                          
         MW,R3    FSIZE1                                                        
R20      STW,R3   FSIZE1            STORE NO. SECTORS FOR FILE                  
         LI,R1    1                 OV FILE                                     
         CI,R4    2                 GET FILE                                    
         BG       R22               XI FILE                                     
         BE       R21B              GO FILE                                     
         STH,R3   K:OV,R1           STORE NEW SIZE OF OV                        
         LI,R9    1                 SET TO DO ONLY OV                           
R21      BAL,R8   DOGOOV            GO ALLOCATE GO/OV                           
         LW,R0    FORM1                                                         
         STB,R0   RFT7,R4           STORE NEW PARAMETERS                        
         LW,R0    RSIZE1                                                        
         SLS,R0   2                 CHANGE TO BYTES                             
         STH,R0   RFT5,R4                                                       
         LW,R0    GSIZE1                                                        
         SLS,R0   2                 CHANGE TO BYTES                             
         STH,R0   RFT4,R4                                                       
         B        A03               EXIT                                        
R21B     STH,R3   K:GO,R1           STORE NEW SIZE OF GO                        
         LI,R9    0                 SET TO DO GO AND OV                         
         B        R21                                                           
R22      RES      0                                                             
         LB,R1    BT#               NR OF BT FILES SYSGENNED                    
         LI,R2    0                 CLEAR SUM CELL                              
         LAW,R0   FSIZE,R1          GET NR OF SECTORS FOR BT FILE               
         AW,R2    R0                ADD IN TO ACC. SUM                          
         BDR,R1   %-2                                                           
         LAW,R0   FSIZE,R4                                                      
         SW,R2    R0                SUBTRACT OFF SIZE BEING CHANGED AND         
         LAW,R3   FSIZE1            GET SPECIFIED SIZE (=1 FOR 'ALL')           
         AW,R2    R3                ADD IT IN                                   
         LW,R3    KXFFFF                                                        
         CS,R2    K:BTFILE          IS THERE ENUF BT SPACE LEFT                 
         BLE      R22C              YES                                         
         LI,R9    MSG5              NO                                          
         BAL,R8   LOGALM            GO OUTPUT 'CC ERR, BT OVERFLOW'             
         B        A08A              EXIT                                        
R22C     LW,R0    FSIZE1            STORE NEW VALUES FOR FILE                   
         STW,R0   FSIZE,R4                                                      
         LW,R0    FORM1                                                         
         STB,R0   FORM,R4                                                       
         LW,R0    RSIZE1                                                        
         STH,R0   RSIZE,R4                                                      
         LW,R0    GSIZE1                                                        
         STH,R0   GSIZE,R4                                                      
         LW,R0    SAVE1                                                         
         BLZ      A03                                                           
         STB,R0   SAVE,R4                                                       
         B        A03               EXIT                                        
R23      LI,R0    256                                                           
         STW,R0   RSIZE1            SET REC. SIZE=256 FOR COMPRESSED            
         B        R07                                                           
R25      LI,R0    25                ASSUME 25 CARDS PER BLK. BUFFER             
R25A     LW,R15   FSIZE1             GET NO. LOGICAL RECORDS                    
         LI,R14   0                                                             
         DW,R14   R0                                                            
         CI,R14    0                 R5=NO. BLK. BUFFERS NEEDED                 
         BE       %+2                                                           
         AI,R15   1                                                             
         LI,R3    256                                                           
         LI,R2    0                 R3=NO. SECT PER BLK. BUFFER                 
         DW,R2    R8                                                            
         CI,R2    0                                                             
         BE       %+2                                                           
         AI,R3    1                 STEP R3 IF A REMAINDER                      
         MW,R3    R15                R3=NO. SECTORS NEEDED FOR FILE             
         B        R20                                                           
R26      LI,R1    256                                                           
         DW,R1    RSIZE1                                                        
         LW,R0    R1                R0=NO. RECORDS PER BLK. BUFFER              
         B        R25A                                                          
*                                                                               
*                                                                               
R31      CI,R6    0                 PROCESS FILE KEYWORD                        
         BNE      A08               ERROR IF NOT END OF SUBFIELD                
         BAL,R8   SCAN              GET FILE NAME                               
         CI,R6    1                                                             
         BL       A08               ERROR                                       
         CI,R10   2                                                             
         BNE      A08               ERROR IF NOT 2 CHARS.                       
         LB,R4    BT#               NR OF BT FILES SYSGENNED                    
         LH,R8    R8                                                            
         CH,R8    BTFILE,R4         SEARCH FOR FILE NAME                        
         BE       %+3               FOUND IT, GO GET NEXT KEYWORD               
         BDR,R4   %-2                                                           
         B        A08               ERROR, CAN'T FIND FILE NAME                 
         STW,R4   RFTX1             SAVE RFT INDEX FOR FILE                     
         CI,R4    2                 IS FILE GO OR OV                            
         BG       R02               NO                                          
         LW,R0    K:BTFILE          YES, SEE IF ANY XI FILES SAVED              
         CW,R0    KL9                                                           
         BAZ      R02               NO, OK                                      
R31B     LI,R9    MSG9              YES, CAN'T ALLOW                            
         BAL,R8   LOGALM            GO OUT 'ILL. REALLOCATION OF BT'            
         B        A08A              EXIT                                        
*                                                                               
*                                                                               
R32      CI,R6    0                 PROCESS 'FORMAT' KEYWORD                    
         BNE      A08               ERROR IF NOT END OF SUBFIELD                
         BAL,R8   SCAN              GET FORMAT TYPE                             
         CI,R6    1                                                             
         BL       A08               ERROR                                       
         CI,R10   1                                                             
         BNE      A08               ERROR IF NOT 1 CHAR.                        
         LB,R8    R8                                                            
         CI,R8    'B'               IS IT A 'B'                                 
         BNE      R32C              NO                                          
         LI,R0    1                 YES, SET CODE FOR BLOCKED                   
R32B     STW,R0   FORM1                                                         
         B        R02                                                           
R32C     CI,R8    'C'               IS IT A 'C'                                 
         BNE      %+3               NO                                          
         LI,R0    2                 YES, SET CODE FOR COMPRESSED                
         B        R32B                                                          
         CI,R8    'U'               IS IT A 'U'                                 
         BNE      A08               NO, ERROR                                   
         LI,R0    0                 YES, SET CODE FOR UNBLOCKED                 
         B        R32B                                                          
*                                                                               
*                                                                               
R33      CI,R6    0                 PROCESS 'FSIZE' KEYWORD                     
         BNE      A08               ERROR IF NOT END OF SUBFIELD                
         MTW,4    SCANPMA           SET FOR EITHER DECIMAL OR BCD               
         BAL,R8   SCAN              GET FILE SIZE                               
         CI,R6    1                                                             
         BL       A08               ERROR                                       
         CI,R9    0                 WAS A DEC. NO. INPUT                        
         BE       R33C              YES                                         
         LI,R9    X'FFF00'          NO, MUST BE AN 'ALL'                        
         CS,R8    R92                                                           
         BNE      A08               NOT ALL, THUS AN ERROR                      
         LH,R1    BTFILE                                                        
         LW,R0    FSIZE,R1          WAS THERE A PREVIOUS ALL                    
         BLZ      A08               YES, CAN'T HAVE TWO ALL'S                   
         BDR,R1   %-2                                                           
         CI,R4    2                 IS IT GO OR OV FILE                         
         BLE      A08               YES,ERROR CAN'T BE ALL                      
         LI,R8    -1                SET FLAG FOR 'ALL' INPUT                    
R33C     STW,R8   FSIZE1            SAVE FILE SIZE                              
         B        R02               EXIT                                        
*                                                                               
*                                                                               
R34      LI,R1    0                 PROCESS 'RSIZE' INPUT                       
R34A     CI,R6    0                                                             
         BNE      A08               ERROR IF NOT END OF SUBFIELD                
         MTW,3    SCANPMA           SET FOR DECIMAL                             
         BAL,R8   SCAN              GET VALUE FOR RSIZE OR GSIZE                
         CI,R6    1                                                             
         BL       A08               ERROR                                       
         STW,R8   RSIZE1,R1         STORE EITHER RSIZE OR GSIZE                 
         B        R02                                                           
*                                                                               
*                                                                               
R35      LI,R1    1                 PROCESS 'GSIZE' KEYWORD                     
         B        R34A                                                          
*                                                                               
*                                                                               
R36      CI,R6    1                 PROCESS 'SAVE' KEYWORD                      
         BL       A08               ERROR IF NOT END OF FIELD                   
         LW,R1    RFTX1                                                         
         AI,R1    -3                                                            
         BLZ      R02               EXIT IF GO OR OV FILE                       
         LCW,R1   R1                R1= AMOUNT OF SHIFT                         
         LW,R0    KSIGN                                                         
         SLS,R0   0,R1                                                          
         CW,R0    K:BTFILE      WAS THIS FILE SAVED BEFORE /SIG7-1741/*C5732    
         BANZ     R31B              YES, ERROR. CAN'T REALLOCATE/CHANGE         
         LI,R0    1                                                             
         STW,R0   SAVE1             SET FLAG TO SAVE THIS FILE                  
         B        R02                                                           
R90      DATA     R91-R90-1         TABLE OF LEGAL KEYWORDS                     
         TEXT     'FIL '                                                        
         TEXT     'FOR'                                                         
         TEXT     'FSI '                                                        
         TEXT     'RSI '                                                        
         TEXT     'GSI '                                                        
         TEXT     'SAV '                                                        
R91      DATA     0                 ADDRESSES OF PROCESSING ROUTINES            
         DATA     R31                                                           
         DATA     R32                                                           
         DATA     R33                                                           
         DATA     R34                                                           
         DATA     R35                                                           
         DATA     R36                                                           
*                                   THE NEXT SIX CELLS MUST BE CONTIGUOUS       
FORM1    DATA     0                 FORMAT OF FILE                              
FSIZE1   DATA     0                 FILE SIZE                                   
RSIZE1   DATA     0                 RECORD SIZE                                 
GSIZE1   DATA     0                 GRANULE SIZE                                
SAVE1    DATA     0                 'SAVE' FLAG                                 
RFTX1    DATA     0                 RFT INDEX FOR FILE                          
*                                                                               
R92      TEXT     'ALL '                                                        
         TITLE    '**** PROCESS PMD COMMAND ****'                               
*                                                                               
*                                                                               
T01      LI,R0    0                                                             
         LI,R1    4                                                             
         STW,R0   K:PMD-1,R1        CLEAR 4 CELLS FOR LOC. TO DUMP              
         BDR,R1   %-1                                                           
         LI,R0    X'40'                                                         
         STW,R0   T90               SET INITIALLY TO COND. DUMP                 
         MTW,2    SCANPMA           SET TO BCD OR HEX CONVERSION                
T03      CI,R6    2                                                             
         BE       T08               END OF CARD                                 
         BAL,R8   SCAN              GET NEXT FIELD                              
         CI,R1    4                 ARE THERE MORE THAN 4 LOC.                  
         BE       A08               YES,ERROR                                   
         LW,R0    SCAN91            IS SCAN INSIDE A FIELD?                     
         BGZ      T05               YES                                         
T031     CI,R10   1                 WAS MORE THAN ONE CHAR READ                 
         BNE      A08               YES. ERROR                                  
         CI,R9    0                 WAS A HEX CHARACTER READ                    
         BNE      T035              NO.                                         
         CI,R8    X'E'              EBCDIC (GETS SCANNED AS HEX) REQ            
         BNE      A08               NO. ERROR                                   
T032     LI,R9    X'F000'           SET EBC FOR ALL DUMPS                       
         CI,R1    0                                                             
         BE       T033                                                          
         LI,R9    X'10000'          SET EBC FOR CURRENT DUMP                    
T033     LCW,R2   R1                                                            
         SLS,R9   0,R2              SHIFT FOR CURRENT DUMP FLAGS                
         STS,R9   K:PMD1                                                        
         B        T055                                                          
T035     LB,R8    R8                EBCDIC 'U' WAS LEFT JUSTIFIED               
         CI,R8    'U'               IS IT A 'U'                                 
         BNE      T036              B IF NOT                                    
         LI,R0    X'80'             YES                                         
         STW,R0   T90               FLAG FOR UNCONDITIONAL DUMP                 
         B        T055                                                          
T036     CI,R8    'T'                                                           
         BE       T032              B IF T (SAME AS E)                          
         CI,R8    'S'                                                           
         BNE      A08               B IF UNRECOGNIZED FLAG                      
         LI,R9    X'F0'             SET SHORTLINE FOR ALL DUMPS                 
         CI,R1    0                                                             
         BE       T033              B IF BEFORE FIRST ADDRESS PAIR              
         LI,R9    X'100'            SET SHORTLINE FOR CURRENT DUMP              
         B        T033                                                          
T05      CI,R9    0                                                             
         BNE      A08               ERROR IF NOT HEX                            
         CI,R6    0                                                             
         BNE      A08               ERROR IF NOT END OF SUBFIELD                
         CI,R10   5                                                             
         BG       A08               ERROR IF MORE THAN 5 CHARS                  
         CI,R8    X'20000'                                                      
         BGE      A08               YES, ERROR                                  
         CI,R8    X'10'                                                         
         BGE      %+2               B IF FWA .GT. REGS                          
         LI,R8    X'10'             USE X'10'.  REGS ARE ALWAYS DUMPED          
         LW,R2    R8                SAVE FWA                                    
         BAL,R8   SCAN              GET LWA                                     
         CI,R10   5                                                             
         BG       A08               ERROR IF MORE THAN 5 CHARS                  
         CI,R8    X'20000'                                                      
         BL       %+2                                                           
         LI,R8    X'1FFFF'                                                      
         CW,R8    R2                IS LWA LESS THAN FWA                        
         BL       A08               B IF SO                                     
         LW,R3    R8                                                            
         AI,R3    2                 ROUND TO NEXT DW (LWA+1)                    
         SLD,R2   -1                WA TO DA                                    
         STH,R2   R3                PACK                                        
         STW,R3   K:PMD,R1          SET IN TABLE                                
         AI,R1    1                                                             
T055     CI,R6    0                 WAS ANOTHER SUBFIELD PRESENT                
         BNE      T03               B IF NOT                                    
         BAL,R8   SCAN                                                          
         CI,R6    0                                                             
         BL       A08               B IF SCAN ERROR                             
         B        T031              CHECK FOR EBCDIC FLAG                       
T08      LW,R2    T90               GET TYPE OF DUMP                            
         LI,R3    X'C0'                                                         
         STS,R2   K:JCP1            STORE TYPE OF DUMP FOR PMD                  
         CI,R1    0                 WERE ANY LOC. INPUT                         
         BNE      A03               YES, EXIT                                   
         LW,R0    K:BACKBG          DEFAULT FWA                                 
         LI,R1    X'20000'                                                      
         SLD,R0   -1                WA TO DA                                    
         STH,R0   R1                PACK                                        
         STW,R1   K:PMD                                                         
         B        A03               EXIT                                        
*                                                                               
T90      DATA     0                 FLAG FOR TYPE OF DUMP                       
         TITLE    '**** PROCESS FILE,REC. POSITION COMMANDS ****'               
*                                                                               
*        UTILITY COMMON ENTRY POINT                                             
*                                                                               
U00      STW,R0   A91               SAVE UNIQUE ENTRY ADDR                      
         LI,R1    F:POS             DCB TO ASSIGN                               
         LW,R9    GIOBITS           FLAGS FOR WHAT TO PERMIT                    
         BAL,R8   ASGNDCB           ASSIGN PER COMMAND                          
         LW,R2    F:POS                                                         
         CI,R2    2                 CHECK ASN                                   
         BANZ     *A91              ENTER APPROPRIATE ROUTINE                   
         LW,R0    GIOCT+1           GET AREA NAME                               
         CI,R0    'BT'              MUST BE BT                                  
         BNE      A08               B IF NOT...ERROR                            
         B        *A91              BT AREA ALLOWED                             
*                                                                               
U99      RES      0                                                             
*        MUST CLOSE FILES TO KEEP RFT BOOKKEEPING STRAIGHT.                     
*        THIS DOES NOT LOSE POSITION BECAUSE                                    
*        ONLY BT FILES AND FILES ACCESSED VIA OPLABELS MAY BE                   
*        POSITIONED, AND THESE MAINTAIN THEIR RFT ENTRIES                       
*        (THUS THEIR POSITION) EVEN WHEN CLOSED.                                
         LI,R2    F:POS             DCB TO CLOSE                                
         BAL,R4   CLOSCOD1                                                      
         B        A03               B FOR NEXT COMMAND                          
*                                                                               
*                                   PFIL COMMAND                                
U01      RES      0                                                             
         CI,R6    2                                                             
         BE       U03               END OF CARD                                 
         BAL,R8   SCAN              GO GET BACK INPUT                           
         CI,R6    2                                                             
         BNE      A08               ERROR, NOT END OF CARD                      
         LI,R9    X'FFF00'                                                      
         CS,R8    U90                                                           
         BNE      A08               ERROR, NOT 'BAC'                            
         LI,R0    X'10'                                                         
         B        %+2                                                           
U03      LI,R0    0                                                             
         STW,R0   POSFILE+1                                                     
         CAL1,1   POSFILE           GO POSITION FILE                            
         B        U99               B TO CLOSE IF NECESSARY                     
*                                                                               
U90      TEXT     'BAC '                                                        
*                                                                               
*                                                                               
*                                   PREC COMMAND                                
V01      RES      0                                                             
         MTW,4    SCANPMA           SET TO BCD OR DECIMAL                       
         LI,R1    1                                                             
         STW,R1   POSREC+2          INITIALIZE NO. REC. TO ONE                  
         LI,R0    X8                INIT TO WAIT AND                            
         STH,R0   POSREC+1,R1       INIT. TO FORWARD                            
V02      CI,R6    2                                                             
         BE       V05               END OF CARD                                 
         BAL,R8   SCAN                                                          
         CI,R6    1                                                             
         BL       A08               ERROR                                       
         CI,R9    0                 IS IT A NO.                                 
         BNE      %+3               NO                                          
         STW,R8   POSREC+2          YES, STORE NO. REC. TO SKIP                 
         B        V02                                                           
         LI,R9    X'FFF00'                                                      
         CS,R8    U90               WAS 'BAC' INPUT                             
         BNE      A08               NO, ERROR                                   
         LI,R1    1                                                             
         LI,R0    X18               WAIT BIT AND                                
         STH,R0   POSREC+1,R1       SET BACKWARDS BIT IN FPT                    
         B        V02                                                           
V05      CAL1,1   POSREC            GO POSITION RECORD                          
         B        U99               B TO CLOSE IF NECESSARY                     
*                                                                               
*                                                                               
*                                   SFIL COMMAND                                
W01      RES      0                                                             
         MTW,4    SCANPMA                                                       
         LI,R2    1                 INITIALIZE NO. FILES TO ONE                 
         LI,R0    X'20'                                                         
         STW,R0   POSFILE+1         SET BIT TO SKIP, DIR=FWD                    
W02      CI,R6    2                                                             
         BE       W05               END OF CARD                                 
         BAL,R8   SCAN                                                          
         CI,R6    1                                                             
         BL       A08               ERROR                                       
         CI,R9    0                 WAS A NO. INPUT                             
         BNE      %+3               NO                                          
         LW,R2    R8                YES, SAVE NO. FILES TO SKIP                 
         B        W02                                                           
         LI,R9    X'FFF00'                                                      
         CS,R8    U90               WAS 'BAC' INPUT                             
         BNE      A08               NO, ERROR                                   
         LI,R0    X'10'                                                         
         AWM,R0   POSFILE+1         SET DIR BIT TO BACK                         
         B        W02                                                           
W05      CAL1,1   POSFILE           GO SKIP A FILE                              
         BDR,R2   %-1               LOOP TO SKIP PROPER NO.                     
         B        U99               B TO CLOSE IF NECESSARY                     
*                                                                               
*                                                                               
*                                   REWIND COMMAND                              
X01      RES      0                                                             
         CI,R6    2                                                             
         BNE      A08               ERROR IF NOT END OF CARD                    
         CAL1,1   REWIND                                                        
         B        U99               B TO CLOSE IF NECESSARY                     
*                                                                               
*                                                                               
*                                   UNLOAD COMMAND                              
Y01      RES      0                                                             
         CI,R6    2                                                             
         BNE      A08               ERROR                                       
         CAL1,1   UNLOAD                                                        
         B        U99               B TO CLOSE IF NECESSARY                     
*                                                                               
*                                                                               
*                                   WEOF COMMAND                                
Z01      RES      0                                                             
         LI,R1    1                 INITIALIZE NO. TO ONE                       
         CI,R6    2                                                             
         BE       Z03               END OF CARD                                 
         CI,R6    1                                                             
         BNE      A08               ERROR                                       
         MTW,3    SCANPMA           SET FOR DECIMAL                             
         BAL,R8   SCAN              GET NO. OF EOF'S                            
         CI,R6    2                                                             
         BNE      A08               ERROR IF NOT END OF CARD                    
         LW,R1    R8                                                            
Z03      CAL1,1   WEOF              WRITE AN EOF                                
         BDR,R1   Z03               LOOP TILL PROPER NO. WRITTEN                
         B        U99               B TO CLOSE IF NECESSARY                     
         PAGE                                                                   
*                                                                               
*                                                                               
*        SUBROUTINE TO TEST FOR KEYBOARD PRINTER DEVICE                         
*                 IF THE DEVICE SPECIFIED BY R1                                 
*                 IS A KEYBOARD PRINTER THEN                                    
*                 RETURN TO *R8 OTHERWISE RETURN *R8+1                          
BURST    LB,R1    OPLBS3,R1         TEST DEVICE                                 
         CI,R1    X'80'             IS IT A RAD FILE                            
         BANZ     BURSTX            YES                                         
         LB,R1    DCT4,R1           GET DEVICE TYPE                             
         CI,R1    DCT4:TY           KEYBOARD PRINTER                            
         BE       *R8                                                           
BURSTX   AI,R8    1                 RETURN+1                                    
         B        *R8                                                           
*                                                                               
*        SUBROUTINE TO CLOSE DCBS                                               
*        FIRST ENTRY EXPECTS:                                                   
*        (R0)= RFT INDEX OF FILE TO BE CLOSED                                   
*        BAL,R4   CLOSECOD0                                                     
*        SECOND ENTRY EXPECTS:                                                  
*        (R2)=DCB ADDR                                                          
*        DCB IS OPEN                                                            
*        BAL,R4    CLOSECOD1                                                    
*                                                                               
CLOSCOD0 AND,R0   KX7F              EXTRACT RFT INDEX                           
         STW,R0   F:CLOSE+1         STORE INDEX IN DCB                          
         LI,R0    X20                                                           
         LI,R3    1                                                             
         STB,R0   F:CLOSE,R3        SET OPEN BIT IN DCB                         
         LI,R2    F:CLOSE                                                       
CLOSCOD1 LW,R3    KX1FFFF                                                       
         STS,R2   CLOSE             STORE DCB ADDR IN FPT                       
         CAL1,1   CLOSE             CLOSE FILE                                  
         B        *R4               RETURN                                      
         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   PSW,R6   JCP               SAVE R6                                     
         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   JCP               RESTORE R6                                  
         B        0,R7              RETURN                                      
         TITLE    '**** CONT. CARD PROCESSING ****'                             
*                                                                               
*                                   ENTERED BY SCAN AFTER READING A ;           
*                                   READS AND LOGS NEXT CARD                    
CONTCRD  STW,R8   CONTCRD9                                                      
         CAL1,1   READC             READ NEXT CARD                              
         CAL1,1   CHKC              WAIT FOR READ COMPLETION                    
         CAL1,1   WRITELL           LOG IT                                      
         B        *%+1              EXIT                                        
CONTCRD9 DATA     0                                                             
         TITLE    '**** I/O ERROR PROCESSING ROUTINES ****'                     
*                                                                               
*                                                                               
ERRAL    STW,R8   R15               SAVE RETURN ADDRESS                         
         LB,R0    R10               GET ERROR CODE                              
         CI,R0    3                 IS IT FILE NOT RECOG.                       
         BNE      ERRAL2            NO                                          
         CI,R8    E01               IS IT TRYING TO WRITE AL FILE               
         BL       ERRAL7            B IF YES                                    
         LD,R8    F:AL+5            GET FILE NAME 'AL'                          
         B        ERRPOS2           LOG ALARM IF DAL,PAL CMD                    
ERRAL2   CI,R0    X'1C'             IS IT EOT ON AL                             
         BNE      ERRAL3            NO                                          
         CI,R15   E03C+1                                                        
         BE       E10               B IF DUMPING, NOT WRITING                   
         LD,R0    F:AL+5            YES,PRINT ALARM                             
         STW,R0   MSG13+5                                                       
         STW,R1   MSG13+6                                                       
         LI,R9    MSG13                                                         
         BAL,R8   LOGALM                                                        
         B        *R15              RETURN TO AFTER CAL                         
ERRAL3   CI,R0    5                 IS IT EOF                                   
         BNE      ERRAL4                                                        
         CI,R15   E03C+1                                                        
         BE       E10               B IF DUMPING, NOT WRITING                   
         B        ERRAL7                                                        
ERRAL4   CI,R0    X'55'             ERROR CONDITION (WP)                        
         BNE      ERRAL5                                                        
         B        A08A                                                          
ERRAL5   RES      0                                                             
         CI,R0    X'42'             WRITE PROTECTED                             
         BNE      ERRAL7            B IF NOT                                    
         LI,R9    MSG36             D1 AREA FGD....                             
         BAL,R8   LOGALM                                                        
         B        C22A              CLOSE AL FILE AND EXIT                      
ERRAL7   RES      0                                                             
         LW,R11   R0                I/O ERROR CODE TO R11                       
         BAL,R7   HEXBCD                                                        
         STH,R11  MSG37+7           ERROR CODE INTO MSG                         
         LW,R11   R15                                                           
         AI,R11   -1                CAL ADDR INTO R11                           
         BAL,R7   HEXBCD                                                        
         SLD,R10  24                                                            
         STW,R10  MSG37+9                                                       
         STW,R11  MSG37+10          ERROR ADDR INTO MSG                         
         LI,R9    MSG37                                                         
         BAL,R8   LOGALM                                                        
         CI,R15   E01                                                           
         BL       C23               CONTINUE IF WRITING, NOT DUMPING            
         B        A08A                                                          
ERROPEN  LB,R0    R10               GET ERROR CODE                              
         CI,R0    X'70'                                                         
         BE       %+3               B IF ILLEGAL AREA NAME                      
*                                   (MAY BE MOUNTED LATER)                      
         CI,R0    3                 IS IT NONEXIST. FILE                        
         BNE      ERRW              NO.  MSG35                                  
         LD,R8    F:OPEN+5          GET FILE NAME          /SIG7-7472/*C5732  03
         STW,R8   MSG40+8           YES...STORE FILE NAME  /SIG7-7472/*C5732  03
         STW,R9   MSG40+9                                                       
         LI,R2    1                                                             
         LH,R9    R8,R2                                                         
         CH,R9    KBLANKS           BLANKS                                      
         BNE      ERROPEN1          NO                                          
         LB,R2    BT#               NR OF BT FILES SYSGENNED                    
         LH,R8    R8                RIGHT JUSTIFY                               
         CH,R8    BTFILE,R2         SEARCH FOR FILENAME                         
         BE       D02               GO FINISH ASSIGN                            
         BDR,R2   %-2               FINISH SEARCH                               
ERROPEN1 EQU      %                 NO MSG FOR BT FILES                         
         LI,R9    MSG40                                    /SIG7-7472/*C5732  03
         BAL,R8   LOGALM            OUTPUT WARNING MSG     /SIG7-7472/*C5732  03
         B        D02               GO FINISH ASSIGN                            
ERRPOS   LB,R0    R10                GET ERROR CODE                             
         CI,R0    3                 IS IT UNRECOG. FILE NAME                    
         BNE      ERRPOS3            NO                                         
         LD,R8    F:POS+5           GET FILE NAME          /SIG7-7472/*C5732  03
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                                                          
ERRPOS3  CI,R0     5                IS IT EOF                                   
         BE       A03                YES, OK                                    
         CI,R0    X'1C'             IS IT EOT                                   
         BE       A03               YES,OK                                      
         CI,R0    X'1D'             IS IT BOT                                   
         BE       A03                YES,OK                                     
         B        ERRW              NO.  MSG35                                  
ERRC     LB,R0    R10                                                           
         CI,R0    5                 WAS AN EOD CARD READ                        
         BNE      ERRWCRIT          NO.  MUST STOP BKG.                         
         B        A03               YES, IGNORE IT                              
*                                                                               
*        PROCESS ERROR ON LOAD MODULE HEADER READ                               
*                                                                               
ERRDC    RES      0                                                             
         LW,R2    R8                SAVE CAL ADDRESS +1                         
         LB,R0    R10               REPOSITION ERROR CODE                       
         CI,R0    3                                                             
         BNE      ERRW              B IF NOT UNRECOG FILE ID                    
         LD,R8    F:DC+5            GET FILE NAME FOR ERR MSG                   
         LI,R3    1                                                             
         LH,R4    GIOCT+1,R3        GET AREA NAME                               
         CH,R4    MDNAME                                                        
         BE       ERRPOS2           B IF ALREADY 'SP'                           
         LI,R3    S:SPAI                                                        
         CH,R4    MDNAME,R3                                                     
         BNE      ERRPOS2           B IF NOT SYS PROC AREA                      
*        IF LOAD FROM SYS PROC AREA FAILED, TRY SP AREA                         
         LI,R4    'SP'              SP AREA NAME                                
         STW,R4   GIOCT+1           CHANGE AREA NAME                            
         LI,R1    F:DC                                                          
         CAL1,1   ASGNFPT           REASSIGN F:DC                               
         B        -1,R2             RETURN TO RETRY READ                        
*****                                                                           
ASGNERR  RES      0                                                             
         LI,R9    MSG45             CC ERR: FILE/DEV/OPLB NAME                  
         BAL,R8   LOGALM                                                        
         B        A08A                                                          
*****                                                                           
ERRCAL   RES      0                 CAL ERROR WITH CODE IN R10 BYTE 0           
         LB,R11   R10               GET ERROR CODE IN R11                       
         BAL,R7   HEXBCD            CONVERT IT TO EBCDIC                        
         STH,R11  MSG41X            PUT IT IN THE ERROR MESSAGE                 
         LI,R9    MSG41             MESSAGE TO OUTPUT                           
         B        A08B              B TO OUTPUT MSG                             
*****                                                                           
ERRFGRQ  RES      0                 FG KEYIN NEEDED                             
         LI,R9    MSG4              MESSAGE TO OUTPUT                           
         B        A08B              B TO OUTPUT MSG                             
*****                                                                           
ERRWCRIT RES      0                                                             
         LI,R15   1                 FLAG: MUST FIN BACKGROUND                   
         B        ERRW1                                                         
ERRW     RES      0                                                             
         LI,R15   0                 FLAG: SCAN TO NEXT JOB                      
ERRW1    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                                 
         CAL1,1   CLOSE2            ATTEMPT TO CLOSE DCB                        
         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                                                        
         LI,R7    SCANPM            IN CASE MUST CONTINUE                       
         CI,R15   0                                                             
         BE       A08A              B IF NOT CRITICAL ERROR                     
FORCEFIN RES      0                 FORCE BACKGROUND TO IDLE                    
         LI,R9    MSG44                                                         
         BAL,R8   LOGALM            TRY TO OUTPUT A !FIN MESSAGE                
         LI,R0    0                                                             
         LI,R1    5                                                             
         STW,R0   K:ACCNAM-1,R1     ZERO THE ACCOUNT/USER NAME                  
         STW,R0   JCBBKG+JCBACCNT-1,R1                                          
         BDR,R1   %-2                                                           
         LI,R0    0                                                             
         STW,R0   K:LIMIT           RESET BKG TIME LIMIT                        
         LI,R1    JCBSY                                                         
         STS,R0   JCBBKG            RESET NEW SY FLAG                           
         STW,R0   K:SY              RESET OLD SY FLAG                           
         LW,R1    C90                                                           
         STS,R0   K:JCP1            RESET ATTEND, SKIP, AND JOB                 
*                                   CARD READ FLAGS                             
         BAL,R8   B18               RESET OPLABELS, CLOSE FILES, ETC            
         LW,R14   K:CCBUF                                                       
         BEZ      FFIN1             B IF CC BUFFER IS NOT ASSIGNED              
         SLS,R14  -9                                                            
         BAL,R8   MMRJRP            RELEASE JOB RESERVED PAGE                   
         NOP      0                                                             
         LI,R14   0                                                             
         STW,R14  K:CCBUF           RESET CC BUFFER POINTER                     
FFIN1    CAL1,9   3                 ABORT                                       
*                                                                               
ERRLL    EQU      ERRWCRIT                                                      
ERRLO    EQU      ERRW                                                          
ERROC    EQU      ERRWCRIT                                                      
ERRCLO   EQU      ERRW                                                          
         TITLE    '**** SBR TO ALLOCATE AND SET BT FILES ****'                  
*                                                                               
*                                                                               
*                                   SBR TO SET REST OF RFT ENTRIES              
*                                     CALL IS BAL,R15  N80                      
*                                       WHERE R1=RFT INDEX                      
*                                             R6=BYTE/SECT. FOR BT              
*                                   USES  R0,R1,R6,R14,R15                      
SETRFT   STW,R15  SETRFT9           SAVE RETURN                                 
         LH,R14   BTFILE,R1         GET FILE NAME                               
         SLS,R14  16                                                            
         AI,R14   X'4040'           ADD IN BLANKS                               
         LW,R15   KBLANKS                                                       
         STD,R14  RFT1,R1           STORE NAME OF FILE                          
         LD,R14   SYSACNT           SET IN THE SYSTEM ACCOUNT                   
         STD,R14  RFTACNT,R1                                                    
         STH,R6   RFT4,R1           SET GRANULE SIZE                            
         STH,R6   RFT5,R1           RECORD SIZE                                 
         LI,R0    0                                                             
         STW,R0   RFT6,R1           FILE SIZE                                   
         STB,R0   RFT7,R1           ORGANIZATION= UNBLOCKED                     
         STH,R0   RFT10,R1         SET BLK BUFFER POSITION                      
         STW,R0   RFT11,R1          FILE POSITION = 0                           
         STH,R0   RFTE#,R1          CURRENT EXTENT = 0 (THE 1ST & ONLY)         
         STW,R0   RFTESZ,R1         ZERO EXTENT SIZE (NON EXTENSIBLE)           
         STB,R0   RFT13,R1          SET NO. USERS TO 0                          
         STB,R0   RFT15,R1          ZERO # OF BKGD USERS                        
         LW,R15   R1                SAVE RFT INDEX IN R15                       
         LB,R1    TCBPOINT          TASK ID                                     
         LB,R1    STILMID,R1        LOAD MODULE ID                              
         LW,R14   LMIRFT,R1         ADDR OF FILE ACTIVITY TABLE                 
         LW,R1    R15               R1= RFT INDEX                               
         CI,R14   0                 DOES LMIRFT EXIST                           
         BE       %+2               NO                                          
         STB,R0   *R14,R1           YES, ZERO # OF USERS                        
         LI,R0    0                 SHARABLE FILE JOB ID                        
         STB,R0   RFT14,R1          ZERO JOB NUMBER                             
         STB,R0   RFT9,R1           JOB ID FOR FILE                             
         LI,R0    3                                                             
         STB,R0   RFT8,R1           MASTD INDEX                                 
         LI,R0    1                                                             
         STW,R0   RFT12,R1          CURRENT RECORD NR                           
         B        *%+1                                                          
SETRFT9  DATA     0                                                             
*                                                                               
*                                                                               
*                                   THIS SBR ALLOCATES AND SETS UP GO/OV        
*                                   CALL IS                                     
*                                           BAL,R8   DOGOOV                     
*                                   WHERE                                       
*                                          R9=0, DO BOTH GO,OV                  
*                                            =1, DO ONLY OV                     
DOGOOV   STW,R9   DOGOOV9                                                       
         LI,R1    BTINDEX           SET INDEX FOR BT AREA                       
         LW,R9    MDEOA,R1          COMPUTE SIZE OF THE BT AREA                 
         SW,R9    MDBOA,R1                                                      
         LB,R6    MDDISCI,R1        FIND SECTOR SIZE FOR THE AREA               
         LH,R6    DISCNWPS,R6                                                   
         SLS,R6   2                 CONVERT TO BYTES PER SECTOR                 
         LI,R1    2                 R1=INDEX FOR GO                             
         LW,R0    DOGOOV9                                                       
         BEZ      %+4               DO BOTH GO/OV                               
         LW,R9    RFT2,R1           DO ONLY OV FILE                             
         AI,R9    -1                GET LWA FOR OV                              
         B        DOGOOV3                                                       
         LW,R3    K:GO                                                          
         AND,R3   KXFFFF            GET CURRENT SIZE OF GO                      
         STW,R9   RFT3,R1           STORE EOT FOR GO FILE                       
         SW,R9    R3                                                            
         CI,R9    -1                ARE WE OUT OF ROOM IN BT AREA               
         BL       DOGOOV5           YES                                         
         STW,R9   RFT2,R1           SET BOT+1 FOR GO                            
         MTW,+1   RFT2,R1           STEP TO TRUE BOT                            
         BAL,R15  SETRFT            GO SET REST OF RFT ENTRIES                  
         CI,R3    0                 IS FILE SIZE=0                              
         BNE      %+3                NO                                         
         LD,R14   KZEROS             YES, ZERO OUT NAME                         
         STD,R14  RFT1,R1                                                       
         LI,R0    120                                                           
         STH,R0   RFT5,R1           CHANGE RSIZE TO 120 BYTES                   
         LI,R0    1                                                             
         STB,R0   RFT7,R1           CHANGE ORGAN. TO BLOCKED                    
DOGOOV3  LI,R1    1                 R1= INDEX FOR OV                            
         LW,R3    K:OV                                                          
         AND,R3   KXFFFF            GET CURRENT SIZE OF OV                      
         STW,R9   RFT3,R1           SET EOT FOR OV                              
         SW,R9    R3                                                            
         CI,R9    -1                ARE WE OUT OF ROOM IN BT AREA               
         BL       DOGOOV5                                                       
         STW,R9   RFT2,R1           SET BOT-1 FOR OV                            
         MTW,+1   RFT2,R1           ADJUST TO TRUE BOT VALUE                    
         LW,R14   R9                COPY BOT-1 OF SAVE FILES, WHICH IS          
         LW,R15   KX7FFFFF          MAX EOT ALLOWED FOR NON-SAVE FILES          
         STS,R14  K:BTFILE          AND SAVE                                    
         BAL,R15  SETRFT            GO SET REST OF RFT                          
         CI,R3    0                 IS FILE SIZE=0                              
         BNE      *R8                NO                                         
         LD,R14   KZEROS             YES, ZERO OUT NAMR                         
         STD,R14  RFT1,R1                                                       
         B        *R8               EXIT                                        
DOGOOV5  LI,R9    MSG11                                                         
         BAL,R8   LOGALM            GO OUTPUT 'BT OVERFLOW'                     
         B        A08C              FLUSH THIS JOB                              
DOGOOV9  DATA     0                                                             
         TITLE    '**** SBR TO PRINT NAME COMMAND ****'    /SIG7-4947/*CO15732  
*                                   CALL   BAL,R1  PNC     /SIG7-4947/*CO15732  
*                                   USES R0,R4 (R7 UNTOUCH)/SIG7-4947/*CO15732  
PNC      LI,R4    3                                        /SIG7-4947/*CO15732  
         LB,R0    OPLBS3,R4                                /SIG7-4947/*CO15732  
         LI,R4    4                 ARE LL AND LO          /SIG7-4947/*CO15732  
         CB,R0    OPLBS3,R4         ON SAME DEVICE?        /SIG7-4947/*CO15732  
         BNE      PNCE              NO, SINGLE SPACE PRINT /SIG7-4947/*C015732  
         LI,R0    X'C3'             TRIPLE-SPACE FOR PROCESSOR NAME             
         STW,R0   *F:LL+2           BY SETTING FORMAT CONTROL CODE              
PNCE     CAL1,1   WRITELL           PRINT NAME COMMAND     /SIG7-4947/*C015732  
         LI,R0    X'C0'             RESTORE SINGLE SPACE IN/SIG7-4947/*CO15732  
         STW,R0   *F:LL+2           CASE OF CONTINUATN CARD/SIG7-4947/*CO15732  
         B        *R1               RETURN                 /SIG7-4947/*C015732  
         BOUND    8                                        /SIG7-4947*C015732   
PNCX     TEXT     '        '        STUFFED WITH PROC NAME /SIG7-4947*C015732   
         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'                                      
MSG3     DATA     LOGFLAG                                                       
         TEXTC    '!!SCHING FOR JOB CMD'                                        
MSG4     DATA     LOGFLAG                                                       
         TEXTC    '!!CC ERROR, FG KEY-IN REQUIRED'                              
MSG5     DATA     LOGFLAG                                                       
         TEXTC    '!!CC ERROR, BT OVERFLOW'                                     
MSG6     DATA     LOGFLAG                                                       
         TEXTC    '  LMI FULL, CANT LOAD  XXXXXXXX'                             
MSG7     DATA     LOGFLAG                                                       
         TEXTC    '!!FILE XXXXXXXX NONEXIST.'                                   
MSG8     DATA     LOGFLAG                                                       
         TEXTC    '!!PUB LIB,CAN''T LOAD   XXXXXXXX'                            
MSG9     DATA     LOGFLAG                                                       
         TEXTC    '!!CC ERROR, ILL.  REALLOCATION OF BT'                        
MSG11    DATA     LOGFLAG                                                       
         TEXTC    '!!BT OVERFLOW'                                               
MSG12    DATA     3                 BOTH LL AND OC                              
         TEXTC    'NEED SYC TO PURGE ACCOUNTING LOG'                            
MSG13    DATA     LOGFLAG                                                       
         TEXTC    '!!EOT ON FILE  XXXXXXXX'                                     
MSG33    DATA     LOGFLAG                                                       
         TEXTC    '!!TOO MANY ASSIGNS'                                          
MSG34    DATA     LOGFLAG                                                       
         TEXTC    '!!CC NOT ALLOWED IN MAPPED SYSTEM'                           
MSG35    DATA     LOGFLAG                                                       
         TEXTC    '!!CC IGNORED IN MAPPED SYSTEM'                               
MSG36    DATA     LOGFLAG                                                       
         TEXTC    '!!D1 AREA FGD, CAN''T UPDATE AL FILE'                        
MSG37    DATA     1                 OC ONLY                                     
         TEXTC    '!!ACCT LOG I/O ERROR X''  '',LOC XXXXX'                      
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'                                                         
MSG39    DATA     LOGFLAG                                                       
         TEXTC    '!!NOT A TASK LOAD MODULE'                                    
MSG40    DATA     LOGFLAG                                                       
         TEXTC    '!!WARNING: NONEXIST. FILE  XXNAMEXX'                         
MSG41    DATA     LOGFLAG                                                       
         GEN,8,24 BA(MSG41E)-BA(MSG41)-5,'!!U'                                  
         TEXT     'NABLE TO COMPLY, ERROR CODE '                                
MSG41X   DATA     0                 SPACE TO INSERT CODE                        
MSG41E   RES      0                                                             
MSG42    DATA     LOGFLAG                                                       
         TEXTC    '!!ERROR: SYSTEM UNATTENDED'                                  
         DO       #SYMB                                                         
MSG43    DATA     1                 OUTPUT TO OC ONLY                           
         GEN,8,24 BA(MSG43E)-BA(MSG43)-5,'!!B'                                  
         TEXT     'CKG JOB'                                                     
MSG43X   TEXT     ' JJJ'                                                        
         TEXT     ' ON '                                                        
MSG43E   RES      0                                                             
         FIN                        #SYMB                                       
MSG44    DATA     LOGFLAG                                                       
         TEXTC    '!FIN FORCED'                                                 
MSG45    DATA     LOGFLAG                                                       
         TEXTC    '!!CC ERR: FILE/DEV/OPLB NAME'                                
MSG46    DATA     LOGFLAG                                                       
         TEXTC    '!!ILLEGAL ACCOUNT/USER NAME'                                 
MSG60    RES      0                                                             
         DATA,1   ' '               VFC CHARACTER                               
         DO1      5                                                             
         DATA,9   'TELEFILE-'                                                   
         DO1      5                                                             
         DATA,8   '--------'                                                    
         DO1      5                                                             
         DATA,9   '-TELEFILE'                                                   
         BOUND    4                                                             
MSG60L   DATA     (%-MSG60)*4                              /SIG7-4920/*C5732 C01
MSG61    TEXT     'C       TELEFILE CPR-R OPERATING SYSTEM ****'                
MSG61A   TEXT     '  VERSION   '                                                
MSG61I   TEXT     'XXXX ****'                                                   
MSG61L   DATA     BA(%)-BA(MSG61)                                               
MSG61AL  DATA     BA(MSG61A)-BA(MSG61)                                          
MSG63    TEXT     'B       NAME .............. XXXXXXXXXXXX'                    
MSG63L   DATA     (%-MSG63)*4                              /SIG7-4920/*C5732 C01
MSG64    TEXT     '        ACCOUNT ........... XXXXXXXX'   /SIG7-4920/*C5732 C01
MSG64L   DATA     (%-MSG64)*4                              /SIG7-4920/*C5732 C01
MSG65    TEXT     'A       SIGN-OFF .......... '     (28 CHAR)                  
         TEXT     '                '                 (16 BLANKS)                
MSG65L   DATA     (%-MSG65)*4                              /SIG7-4920/*C5732 C01
MSG66    TEXT     '        TOTAL JOB TIME .... XX:XX:XX'   /SIG7-4920/*C5732 C01
MSG66L   DATA     (%-MSG66)*4                              /SIG7-4920/*C5732 C01
         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=ADDR 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              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                       
         LB,R0    *SCAN96           IS COLUMN ONE A COLON                       
         CI,R0    X'5A'             IS COLUMN ONE AN EXCLAM.                    
         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    MTW,0    SCAN87            FLAG SET TO IGNORE ERRS/SIG7-4191/*C015732  
         BNEZ     SCAN8A            YES, BRANCH            /SIG7-4191/*C015732  
         STW,R6   SCAN98                                                        
         LI,R6    -1                NO, SET TO ERROR EXIT  /SIG7-4191/*C015732  
         B        SCAN33            GO TO EXIT             /SIG7-4191/*C015732  
SCAN8A   LB,R10   *SCAN96,R6        SEARCH FOR COMMA AS    /SIG7-4191/*C015732  
         CI,R10   X'6B'              END OF FIELD          /SIG7-4191/*C015732  
         BE       SCAN8B            B IF COMMA             /SIG7-4191/*C015732  
         AI,R6    1                                        /SIG7-4191/*C015732  
         CI,R6    80                PAST COLUMN 80         /SIG7-4191/*C015732  
         BL       SCAN8A            NO, TRY AGAIN          /SIG7-4191/*C015732  
         LI,R6    2                 SET TO END OF CARD     /SIG7-4191/*C015732  
         B        SCAN33            EXIT                   /SIG7-4191/*C015732  
SCAN8B   STW,R6   SCAN98            SAVE COLUMN INDEX      /SIG7-4191/*C015732  
         LI,R10   -1                                       /SIG7-4191/*C015732  
         STW,R10  SCAN91            INIT. PARENTHESES FLAG /SIG7-4191/*C015732  
         MTW,1    SCAN90            STEP FIELD FLAG        /SIG7-4191/*C015732  
         MTW,1    SCAN92            STEP CONT. CARD FLAG   /SIG7-4191/*C015732  
         B        SCAN0             GO GET NEXT PARAM.     /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                      
         BNEZ     SCAN19A                                                       
         MTW,0    CATDEP            ARE WE IN CATALOG PROCEDURE                 
         BLZ      SCAN8             NO  ERROR                                   
*                                   RECYCLE TO EBCDIC CONVERSION                
*                                   SET R6 TO NEGATIVE                          
         SW,R6    SCAN95                                                        
         LI,R0    0                                                             
         STW,R0   SCAN95                                                        
         LI,R0    -9                                                            
         STW,R0   SCAN93                                                        
         LI,R0    -4                                                            
         STW,R0   SCAN98                                                        
         LI,R11   1                                                             
         LW,R8    SCAN89A                                                       
         LW,R9    SCAN89A                                                       
         B        SCAN7                                                         
SCAN19A  RES      0                                                             
         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                                                        
         LI,R6    80                                                            
         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                                          
         MTW,0    CATDEP                                                        
         BGE      SCAN41                                                        
         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.                       
*                                                                               
SCAN87   DATA     0                 1= SKIP TO NEXT FIELD IF A SYNTAX           
*                                    ERROR IS FOUND. USED WHEN SCANNING         
*                                    MACRSYM CARD FOR SI AND CI.                
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                              
ENDJCP   RES      0                                                             
         END                                                                    
