*******************                                                             
*     CPRMON      *                                                             
*******************                                                             
         PAGE                                                                   
PROLAY   SET      OLAYFLAG='CPR'                                                
PROLAY   SET      PROLAY+(OLAYFLAG='MMRO')                                      
PROLAY   SET      PROLAY+(OLAYFLAG='TEX')                                       
PROLAY   SET      PROLAY+(OLAYFLAG='MEDR')                                      
PROLAY   SET      PROLAY+(OLAYFLAG='SEX')                                       
PROLAY   SET      PROLAY+(OLAYFLAG='COCI')                                      
PROLAY   SET      PROLAY+(OLAYFLAG='DISC')                                      
PROLAY   SET      PROLAY+(OLAYFLAG='TAPE')                                      
PROLAY   SET      PROLAY+(OLAYFLAG='LP')                                        
PROLAY   SET      PROLAY+(OLAYFLAG='CARD')                                      
PROLAY   SET      PROLAY+(OLAYFLAG='TERM')                                      
PROLAY   SET      PROLAY+(OLAYFLAG='TIO3')                                      
PROLAY   SET      PROLAY+(OLAYFLAG='TTY ')                                      
         DO       OLAYFLAG='CPR'                                                
         DEF      A:RBM                                                         
         DEF      K:DPIDLE                                                      
         DEF      BITABLE                                                       
         DEF      M1,M2,X5,M3,M4,M5,M6,M7,M8,M9,M12,M15                         
         DEF      M16,M17,M19,M24,M25,M31,M32                                   
         DEF      X1,X2,X3,X4,X6,X7,X8,X9,XA,XB,XD60,XD3600                     
         DEF      XE,XF,X10,X20,X30,X3F,X40,X60,X70,X7D                         
         DEF      X7F,X80,XBF,XCF,XDF,XE0,XE7,XEF,XF0,XF7,XFB                   
         DEF      XFC,XFE,XFF,X1FF,X200,X380,X1000,X1700                        
         DEF      XFD                                                           
         DEF      X1800,X1F00,X2000,X3000,X4000,X6000,X7FFF                     
         DEF      X8000,XFE7D,XFF7F,XFF8F,XFFF0,XFFFF,X10000                    
         DEF      XFFFE,XFFF7                                                   
         DEF      X1FFFF,X20000,X20200,X404040,X1000001                         
         DEF      FFFFFE00,X7FFFF,XFFFF00,XFFFFFF,FBFFFFFF                      
         DEF      XF0F0F0,XF0F0F1                                               
         DEF      FFFFFF00                                                      
         DEF      EFFFFFFF,FFFFFEFF,FFFFEFFF,FFFDB5FF,FFFFE0FF                  
         DEF      FFFDFDFF,FFFDFFFF,FFFEFFFF,FFFF7FFF,FF7FFFFF                  
         DEF      FFFFBFFF,FFDFEFFF,FF01FFFF,C001FFFF,C0C0C0C0                  
         DEF      C0000030,X1FE00,FFFFFFE1,FFFFFFEF,BFFFFFFF                    
         DEF      FFFFFFBF,FDFFFFFF,FEFFFFFF,F7FFFFFF                           
         DEF      DFFFFFFF,DEFFFFFF                                             
         DEF      YFFFFFF,Y155A5A,FFFFF800,YFFFF                                
         DEF      YFF7E                                                         
         DEF      Y00FF,Y3030,Y00FE,Y007F,YFFFE,YFF8,YFF4                       
         DEF      YFF,Y7F,Y0002,Y000A,Y0011,Y001,Y002,Y003                      
         DEF      Y004,Y008,Y007,Y006,Y083,Y00C,Y00E                            
         DEF      Y0004,Y0006,Y0008                                             
         DEF      Y01,Y02,Y03,Y04,Y05,Y07,Y08                                   
         DEF      Y0A,Y0C,Y0F,Y1,Y2,Y3,Y4,Y4B,Y6,Y15,Y1C                        
         DEF      Y22,Y8,Y60,Y67,Y68,Y69,Y6F,Y82,YBE,YA,YC                      
         DEF      YD,YE,YF                                                      
         DEF      Y31                                                           
         DO1      #INSTSIM                                                      
         DEF      K:FPSIM,K:DECSIM,K:BYTSIM,K:CVSIM                             
         DEF      BLANKS,ZEROS,DIRECODE                                         
         DEF      CAL234,EODREC,L1015,POST05,POST10                             
         DEF      CALLSD10                                                      
         DEF      POSTEOD                                                       
         DEF      ERROR40,ERROR44                                               
         DEF      ERROR01,ERROR0A,ERROR2E,ERROR48,ERROR4A                       
         DEF      ERROR54,ERROR58,ERROR59,ERROR60,POST06                        
         DEF      CALLQ,CALLQP                                                  
         DO1      #ECB                                                          
         DEF      CUP3POST,FMDELECB                                             
         DO1      #ERRORLOG                                                     
         DEF      IOERROR,LOGSTACK,LOSTLOGS,GOODLOGS,IOLOG,LOGSTART             
         DEF      RELTEMP,GETTEMP,RELTEMPI,GETTEMPI                             
         DO1      #CRASH                                                        
         DEF      CRASHMSG                                                      
         DEF      CRASHPSD,CRASHLOC,CRASHREG,OPTIONS,SENSESW                    
         DEF      CRASHRES,SEEKADDR,OCDCT                                       
         DEF      CRASOLAY                                                      
         DO1      #MAP                                                          
         DEF      CRASHMAP                                                      
         DO       #SIGMA9                                                       
         DEF      CRASHI1,CRASHI2,CRASHI3                                       
         FIN      #SIGMA9                                                       
         DO1      #550                                                          
         DEF      FIGPANEL                                                      
         DEF      GTBL                                                          
         DEF      RUN99,EDT99,JOB99,TASK99                                      
         DEF      BINITFPT                                                      
         DO       #MAP=0                                                        
         DEF      FPSAV,BPSAV                                                   
         FIN      #MAP=0                                                        
         DO1      #MULTDSP                                                      
         DEF      TMDQ,TMDQR,TMDQA                                              
         DEF      EXIT,RBMEXIT,RBMEXITA,RBMEXITD,EXITABRT                       
         DO       #ECB                                                          
         DEF      EMPOST,SIGPOST,POLLPOST,ENQPOST,TMENQGO,TMREECB               
         DEF      EMDELECB,EMRSECB,EMRRECB,EMPOSTYC                             
         FIN      #ECB                                                          
         DEF      TMX1,TMX2,TMX4,TMX5                                           
         DEF      TMTPRIO,TMTRIG,TMRDLTRG,CTRIG,FGLTRIG                         
         DEF      TMSETERR,TMVALF3                                              
         DEF      BCRASH0,CAL1PSD,CLOCKPSD,COUNTER4                             
         DEF      CPPSD                                                         
         DEF      CTRTS,CTSTCB,CT1,BKGSTOP,BKGSTART                             
         DEF       FBACCNT1,FBACCNT2,FGDPSD                                     
         DEF      GINC,GUTEMP,DIOPSD,IOALT,IOPSD,JCBBKG,JCBRBM,SYSACNT          
         DEF      POFFPSD,PONPSD,SPRPSD                                         
         DEF      4CHAR                                                         
         DO1      #MTAPE                                                        
         DEF      FCREWMT,FCROFFMT,FCFSRMT,FCBSRMT,FCWMT,FCRMT                  
         DO1      #MTAPE                                                        
         DEF      FCFSFMTS,FCBSFMTS,FCFSFMT,FCBSFMT,FCWTMMT,FCRB9T              
         DO1      #7TTAPE                                                       
         DEF      FCW7TDEC,FCR7TDEC,FCW7TBIN,FCR7TBIN                           
         DEF      QUEUE,FMQUEUE,REQCOM,SERDEV,RIPOFF,CALLSD,RC28                
         DEF      %CALLSD,RIPTOFF,RC50                                          
         DEF      IOSCU,RE:ENT,COMLIST,IOINC,NEWIOCK,CL20                       
         DEF      USECOM,REPCOM,DELCOM,NEXTQUE,RESCHED                          
         DEF IOSTRT,SCHEDXIT,REQSTRT                                            
         DEF      MSG4A,MSG5,MSG9,MSG2,MSG4B                                    
         DO1      #ECB                                                          
         DEF      IOCRASH                                                       
         DEF      TDRDL,TDSTL,TDSTLIDL,TDRDLRET,TDDISPX,TDTRIG                  
         DEF      TDLAST                                                        
         DEF      TDRDLVL,TDRDLGP,TTFINAL                                       
         DO1      #INSTSIM                                                      
         DEF      TRAP12C                                                       
         DEF      TRAP,CRSHXPSD                                                 
         DEF      TRTN10,TRAP50                                                 
         DEF      TRAP40,TRAP41,TRAP42,TRAP43,TRAP44,TRAP45,TRAP46              
         DO1      #SIGMA9                                                       
         DEF      TRAP4C,TRAP4D                                                 
         DEF      UTIME,UTIMES,K:UTIME                                          
         DEF      SC:YEAR,SC:DAY,SC:SEC                                         
         DEF      SC:LIST,SC:BBCW,SC:DCB,SC:INIT                                
         DEF      SCEND                                                         
         DEF      KEYBUF                                                        
         DEF      CALERR,CALEXIT,GETFPTN,GETFPTNS,CALSTDX                       
         DEF      CONVADDR,GETPS,GETP,GETPI,GETPSI,GETPII,GETPSII               
         DEF      XPSDCMMD,MTWCMMD,CALFLAG,494A4B,CALREG,BALRBMSV               
         DEF      CKXABT,GETWD,SECTPERN,SECTPERB                                
         DEF      GETEFADR,POST,POST01,POST03,POST07                            
         DEF      CUPCOD1,CUPCOD2,CUPCOD3,CUPCOD4,DATA1C1D,ERROR03              
         DEF      DCBERR,T:LDEV                                                 
         DEF      MSGOUT,OUTMSG,TEMP                                            
         DEF      MSG6                                                          
         DEF      RBMSAVE,CLK1SAVE,CLK2SAVE,CLK3SAVE,CALENTRY                   
         DEF      CVTAREA,CVTFILE,CVTDISC                                       
         DEF      ENDAC                                                         
         DEF      FMABORT                                                       
         DO       #MAP                                                          
         DEF      FMGETRAD                                                      
         DEF      RBMSD                                                         
         FIN                                                                    
         DO1      #ROLL                                                         
         DEF      FMRELRAD,ROLL98                                               
         DEF      OMAN,OMANTPSD                                                 
        DO       #MAP                                                           
         DEF      OMANFP,OMANFPP,OMANPAGE,OMANFWA                               
         DEF      OMAN#PGS                                                      
        FIN      #MAP                                                           
         DEF      RENT:SN,RENT:D,SYMREENT,COUNT:D                               
         DO1      #MAP                                                          
         DEF      PLSEG#                                                        
         DEF      JOB#                                                          
         DO       #SYMB                                                         
         DEF      JOBPRI                                                        
         FIN      #SYMB                                                         
         DEF      TRAP90                                                        
         DEF      CFLAG                                                         
         DEF      IOCLOCK                                                       
         DEF      MOVEBYTS                                                      
         DEF      CCBUF                                                         
         DEF      CTIOSTK                                                       
          DEF      CUPCORE                                                      
          DEF      CUPDCB                                                       
          DEF      MSG1                                                         
         DO1      #PTAPE                                                        
         DEF      MSG8                                                          
*                                                                               
         DO1      #PAX                                                          
         DEF      ASCIITBL                                                      
         DEF      TRAPX,BADCAL                                                  
         DO1      (#MAP+#DEBUG+#TJE)>0                                          
         DEF      BKALTPSD,BRKSUB                                               
         DO       #DEBUG                                                        
         DEF      DBGBREAK                                                      
         FIN      #DEBUG                                                        
         DO1      #ERRORLOG                                                     
         DEF      PUSHLOG                                                       
         DO1      #SIGMA9                                                       
         DEF      MFIPSD,PFIPSD,MFITRIP,PFITRIP                                 
         DEF      IMAGE,FGLCSP,FGLBSP,FGLPUBL                                   
         DO       #TSLICE                                                       
         DEF      TSTICK,TS1SEC,TS1STICK                                        
         DEF      QUANTUM,QMIN,QSWAP,QMAX                                       
         DEF      TTICKS                                                        
         FIN      #TSLICE                                                       
         DO       #TJE                                                          
         DEF      CTLSUB,CTALTPSD                                               
         FIN      #TJE                                                          
         DO       #SIDEBUF                                                      
         DEF      SDPOSTER                                                      
         DO1      #ECB                                                          
         DEF      SDPSTACK                                                      
         FIN                                                                    
         DO1      #SIGMA9                                                       
         DEF      LASTPRTY                                                      
         DO1      #550                                                          
         DEF      QREG                                                          
         PAGE                                                                   
         ELSE     OLAYFLAG='CPR'                                                
         REF      RBM,K:DPIDLE                                                  
         REF      M1,M2,X5,M3,M4,M5,M6,M7,M8,M9,M12,M15                         
         REF      M16,M17,M19,M24,M25,M31,M32                                   
         REF      BITABLE                                                       
         REF      X1,X2,X3,X4,X6,X7,X8,X9,XA,XB,XD60,XD3600                     
         REF      XE,XF,X10,X20,X30,X3F,X40,X60,X70,X7D                         
         REF      X7F,X80,XBF,XCF,XDF,XE0,XE7,XEF,XF0,XF7,XFB                   
         REF      XFC,XFE,XFF,X1FF,X200,X380,X1000,X1700                        
         REF      XFD                                                           
         REF      X1800,X1F00,X2000,X3000,X4000,X6000,X7FFF                     
         REF      X8000,XFE7D,XFF7F,XFF8F,XFFF0,XFFFF,X10000                    
         REF      XFFFE,XFFF7                                                   
         REF      X1FFFF,X20000,X20200,X404040,X1000001                         
         REF      FFFFFE00,X7FFFF,XFFFF00,XFFFFFF,FBFFFFFF                      
         REF      XF0F0F0,XF0F0F1                                               
         REF      FFFFFF00                                                      
         REF      EFFFFFFF,FFFFFEFF,FFFFEFFF,FFFDB5FF,FFFFE0FF                  
         REF      FFFDFDFF,FFFDFFFF,FFFEFFFF,FFFF7FFF,FF7FFFFF                  
         REF      FFFFBFFF,FFDFEFFF,FF01FFFF,C001FFFF,C0C0C0C0                  
         REF      C0000030,X1FE00,FFFFFFE1,FFFFFFEF,BFFFFFFF                    
         REF      FFFFFFBF,FDFFFFFF,FEFFFFFF,F7FFFFFF                           
         REF      DFFFFFFF,DEFFFFFF                                             
         REF      YFFFFFF,Y155A5A,FFFFF800,YFFFF                                
         REF      YFF7E                                                         
         REF      Y00FF,Y3030,Y00FE,Y007F,YFFFE,YFF8,YFF4                       
         REF      YFF,Y7F,Y0002,Y000A,Y0011,Y001,Y002,Y003                      
         REF      Y004,Y008,Y007,Y006,Y083,Y00C,Y00E                            
         REF      Y0004,Y0006,Y0008                                             
         REF      Y01,Y02,Y03,Y04,Y05,Y07,Y08                                   
         REF      Y0A,Y0C,Y0F,Y1,Y2,Y3,Y4,Y4B,Y6,Y15,Y1C                        
         REF      Y22,Y8,Y60,Y67,Y68,Y69,Y6F,Y82,YBE,YA,YC                      
         REF      YD,YE,YF                                                      
         REF      Y31                                                           
         DO1      #INSTSIM                                                      
         REF      K:FPSIM,K:DECSIM,K:BYTSIM,K:CVSIM                             
         REF      BLANKS,ZEROS,DIRECODE                                         
         REF      CAL234,EODREC,L1015,POST05,POST10                             
         REF      CALLSD10                                                      
         REF      POSTEOD                                                       
         REF      ERROR40,ERROR44                                               
         REF      ERROR01,ERROR0A,ERROR2E,ERROR48,ERROR4A                       
         REF      ERROR54,ERROR58,ERROR59,ERROR60,POST06                        
         REF      CALLQ,CALLQP                                                  
         DO1      #ECB                                                          
         REF      CUP3POST,FMDELECB                                             
         DO1      #ERRORLOG                                                     
         REF      IOERROR,LOGSTACK,LOSTLOGS,GOODLOGS,IOLOG,LOGSTART             
         REF      RELTEMP,GETTEMP,RELTEMPI,GETTEMPI                             
         DO1      #CRASH                                                        
         REF      CRASHMSG                                                      
         REF      CRASHPSD,CRASHLOC,CRASHREG,OPTIONS,SENSESW                    
         DO1      #MAP                                                          
         REF      CRASHMAP                                                      
         DO       #SIGMA9                                                       
         REF      CRASHI1,CRASHI2,CRASHI3                                       
         FIN      #SIGMA9                                                       
         DO1      #550                                                          
         REF      FIGPANEL                                                      
         REF      GTBL                                                          
         REF      RUN99,EDT99,JOB99,TASK99                                      
         REF      BINITFPT                                                      
         DO       #MAP=0                                                        
         REF      FPSAV,BPSAV                                                   
         FIN      #MAP=0                                                        
         DO1      #MULTDSP                                                      
         REF      TMDQ,TMDQR,TMDQA                                              
         REF      EXIT,RBMEXIT,RBMEXITA,RBMEXITD,EXITABRT                       
         DO       #ECB                                                          
         REF      EMPOST,SIGPOST,POLLPOST,ENQPOST,TMENQGO,TMREECB               
         REF      EMDELECB,EMRSECB,EMRRECB,EMPOSTYC                             
         FIN      #ECB                                                          
         REF      TMX1,TMX2,TMX4,TMX5                                           
         REF      TMTPRIO,TMTRIG,TMRDLTRG,CTRIG,FGLTRIG                         
         REF      TMSETERR,TMVALF3                                              
         REF      BCRASH0,CAL1PSD,CLOCKPSD,COUNTER4                             
         REF      CPPSD                                                         
         REF      CTRTS,CTSTCB,CT1,BKGSTOP,BKGSTART                             
         REF       FBACCNT1,FBACCNT2,FGDPSD                                     
         REF      GINC,GUTEMP,DIOPSD,IOALT,IOPSD,JCBBKG,JCBRBM,SYSACNT          
         REF      POFFPSD,PONPSD,SPRPSD                                         
         REF      4CHAR                                                         
         REF      QUEUE,FMQUEUE,REQCOM,SERDEV,RIPOFF,CALLSD,RC28                
         REF      %CALLSD,RIPTOFF,RC50                                          
         REF      IOSCU,RE:ENT,COMLIST,IOINC,NEWIOCK,CL20                       
         REF      USECOM,REPCOM,DELCOM,NEXTQUE,RESCHED                          
         REF IOSTRT,SCHEDXIT,REQSTRT                                            
         REF      MSG4A,MSG5,MSG9,MSG2,MSG4B                                    
         DO1      #ECB                                                          
         REF      IOCRASH                                                       
         REF      TDRDL,TDSTL,TDSTLIDL,TDRDLRET,TDDISPX,TDTRIG                  
         REF      TDLAST                                                        
         REF      TDRDLVL,TDRDLGP,TTFINAL                                       
         DO1      #INSTSIM                                                      
         REF      TRAP12C                                                       
         REF      TRAP,CRSHXPSD                                                 
         REF      TRTN10,TRAP50                                                 
         REF      TRAP40,TRAP41,TRAP42,TRAP43,TRAP44,TRAP45,TRAP46              
         DO1      #SIGMA9                                                       
         REF      TRAP4C,TRAP4D                                                 
         REF      UTIME,UTIMES,K:UTIME                                          
         REF      SC:YEAR,SC:DAY,SC:SEC                                         
         REF      SC:LIST,SC:BBCW,SC:DCB,SC:INIT                                
         REF      SCEND                                                         
         REF      KEYBUF                                                        
         REF      CALERR,CALEXIT,GETFPTN,GETFPTNS,CALSTDX                       
         REF      CONVADDR,GETPS,GETP,GETPI,GETPSI,GETPII,GETPSII               
         REF      XPSDCMMD,MTWCMMD,CALFLAG,494A4B,CALREG,BALRBMSV               
         REF      CKXABT,GETWD,SECTPERN,SECTPERB                                
         REF      GETEFADR,POST,POST01,POST03,POST07                            
         REF      CUPCOD1,CUPCOD2,CUPCOD3,CUPCOD4,DATA1C1D,ERROR03              
         REF      DCBERR,T:LDEV                                                 
         REF      MSGOUT,OUTMSG,TEMP                                            
         REF      MSG6                                                          
         REF      RBMSAVE,CLK1SAVE,CLK2SAVE,CLK3SAVE,CALENTRY                   
         REF      CVTAREA,CVTFILE,CVTDISC                                       
         REF      ENDAC                                                         
         REF      FMABORT                                                       
         DO       #MAP                                                          
         REF      FMGETRAD                                                      
         REF      RBMSD                                                         
         FIN                                                                    
         DO1      #ROLL                                                         
         REF      FMRELRAD,ROLL98                                               
         REF      OMAN,OMANTPSD,OMAN#PGS                                        
         DO1      #MAP                                                          
         REF      OMANFP,OMANFPP,OMANPAGE,OMANFWA                               
         REF      RENT:SN,RENT:D,SYMREENT,COUNT:D                               
         DO1      #MAP                                                          
         REF      PLSEG#                                                        
         REF      JOB#                                                          
         DO       #SYMB                                                         
         REF      JOBPRI                                                        
         FIN      #SYMB                                                         
         REF      TRAP90                                                        
         REF      CFLAG                                                         
         REF      IOCLOCK                                                       
         REF      MOVEBYTS                                                      
         REF      CCBUF                                                         
         REF      CTIOSTK                                                       
          REF      CUPCORE                                                      
          REF      CUPDCB                                                       
          REF      MSG1                                                         
         DO1      #PTAPE                                                        
         REF      MSG8                                                          
         DO1      #PAX                                                          
         REF      ASCIITBL                                                      
         REF      TRAPX,BADCAL                                                  
         DO1      (#MAP+#DEBUG+#TJE)>0                                          
         REF      BKALTPSD,BRKSUB                                               
         DO       #DEBUG                                                        
         REF      DBGBREAK                                                      
         FIN      #DEBUG                                                        
         DO1      #ERRORLOG                                                     
         REF      PUSHLOG                                                       
         DO1      #SIGMA9                                                       
         REF      MFIPSD,PFIPSD,MFITRIP,PFITRIP                                 
         REF      IMAGE,FGLCSP,FGLBSP,FGLPUBL                                   
         DO       #TSLICE                                                       
         REF      TSTICK,TS1SEC,TS1STICK                                        
         REF      QUANTUM,QMIN,QSWAP,QMAX                                       
         REF      TTICKS                                                        
         FIN      #TSLICE                                                       
         DO       #TJE                                                          
         REF      CTLSUB,CTALTPSD                                               
         FIN      #TJE                                                          
         DO       #SIDEBUF                                                      
         REF      SDPOSTER                                                      
         DO1      #ECB                                                          
         REF      SDPSTACK                                                      
         FIN                                                                    
         FIN      OLAYFLAG='CPR'                                                
         PAGE                                                                   
         DO       1-(OLAYFLAG='INIT')                                           
         REF      RBMEND                                                        
         FIN                                                                    
*                                                                               
*                                                                               
* MEDIA **                                                                      
       DO       #MEDIA                                                          
* MEDR                                                                          
         DO       1-(OLAYFLAG='MEDR')                                           
         REF      MEDRLOOP                                                      
         REF      MEDRLOPA                                                      
         REF      MEDR900           COMMON NO-OP ERROR ROUTINE (B *R8)          
*                                                                               
*                                                                               
         DO       PROLAY=0                                                      
         REF      MEDIARES,MEDRIDCB,MEDRODCB,MEDRCTRL                           
         REF      MEDRMASN,MEDRVFCA,MEDRVFCB,MEDRBB1,MEDRBB2                    
         REF      MEDRSTCB,MEDRSTAK,MEDROC,MEDRFPTX,MEDRSTPS,MEDRIMAG           
         REF      MEDRRA,MEDRRB,MEDRWA,MEDRWB,MEDRCHKR,MEDRCHKW                 
         REF      MEDRJOB,MEDRTASK,MEDRITMP,MEDROTMP,MEDRERRS                   
         FIN      PROLAY=0                                                      
         FIN      'MEDR'                                                        
* MED1                                                                          
         DO       1-(OLAYFLAG='MED1')                                           
         REF      MEDIATSK          MAIN ENTRY POINT TO MEDIA                   
         REF      MED0EXIT                                                      
         REF      MED090,MED094     ERROR ROUTINES, READ AND WRITE              
         REF      MED099            DCB ERROR/ABNORMAL ROUTINE                  
         FIN      'MED1'                                                        
* MED2                                                                          
         DO       1-(OLAYFLAG='MED2')                                           
         REF      MED600            MAIN ENTRY TO PART 2                        
         REF      MED800,MED810,MED820,MED830,MED840,MED880                     
         FIN      'MED2'                                                        
       FIN      #MEDIA                                                          
*                                                                               
*                                                                               
         DO       1-(OLAYFLAG='OPEN')                                           
         REF      OPENX                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='CLOS')                                           
         REF      CLOSEX,CRFIL,CLOSRFIL                                         
         REF      CFUPDIR                                                       
         DO1      #DISKPAK                                                      
         REF      CFDPIDLE                                                      
*                                                                               
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='ALLO')                                           
         REF      ALLOT                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='DELE')                                           
         REF      DELETE,TRUNCATE                                               
         REF      FMDELETE                                                      
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='READ')                                           
         REF      READWR,DCBBUSY,FPTBSY,OPEN,CLOSE                              
READWRIT EQU      READWR                                                        
         REF      OPENDCB,CLOSEDCB                                              
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='RWDE')                                           
         REF      RWDEV                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='RWFI')                                           
         REF      RWFILE                                                        
         REF      FMCKWP,FMMASTX,RWFIL9                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='SDBF')                                           
         REF      OUTSDBUF,INSDBUF                                              
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='GETN')                                           
         REF      GETNRT,GETDCBAD,GETDCTX,FMOPL2AD,TESTBUF                      
         REF      FMBLDECB,SETOVR                                               
         DO       #SYMB                                                         
         REF      COOP                                                          
         FIN      #SYMB                                                         
         DO       #ECB                                                          
         REF      TESTWT4                                                       
         FIN      #ECB                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='DEVI')                                           
         REF      DEVI,DEVN,DFM,CORRES,DVF,DRC                                  
         REF      PROMPT                                                        
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='ASSI')                                           
         REF      ASSIGN                                                        
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='REWI')                                           
         REF      REWIND,WEOF,PRECORD,PFIL,SETUP                                
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='REWD')                                           
         REF      REWDEV                                                        
         REF      WEOFDEV,PRECDEV,PFILDEV                                       
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='PRIN')                                           
         REF      PRINT,TYPE                                                    
         REF      GENCHARS                                                      
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='IOEX')                                           
         REF      IOEX,STPIO1,STPIO2,STRTIO1,STRTIO2                            
         REF      DEACTV,ACTV                                                   
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='RWBF')                                           
         REF      RWBFIL,WBLOCK,WLBLOCK                                         
         REF      RBLOCK,IBBPARAM                                               
         REF      RELADBUF                                                      
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='FIND')                                           
         REF      FINDBB                                                        
         REF      FINDDIR,READDIR,WRITDIR                                       
         REF      FINDDIRX                                                      
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='RWEX')                                           
         REF      RWEXT                                                         
         REF      RWEXTSEQ,RWEXTDIR,FMGETEXT                                    
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TMTY')                                           
         REF      TMTYC,TMTYCB,TMTYCS,TMTYC15,TMTYC15S                          
         REF      TMCKADR,TMVADR,TMGRA                                          
         REF      TMCKADP                                                       
         DO       #ECB                                                          
         REF      EMGETECB,EMGETEM                                              
         REF      EMGETFPT                                                      
         FIN      #ECB                                                          
         REF      EMWAIT                                                        
         REF      CKENACTS,CKENACT,CKENACT1,CKENACT2                            
         REF      CKINTLAB,CKINTADR                                             
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TMGE')                                           
         REF      TMGETP,TMGETIDS                                               
TMGETPR  EQU      TMGETP                                                        
         REF      TMFINDJ,TMGETJID                                              
         REF      TMFINDT,TMGETTID                                              
         DO       #ECB                                                          
         REF      EMBLDECB                                                      
         REF      EMDATAI                                                       
         REF      EMDATAO                                                       
         REF      EMARECB                                                       
         REF      EMARECBX                                                      
         FIN      #ECB                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='SIGN')                                           
         REF      SIGNAL                                                        
         DO       #ECB                                                          
         REF      SIGNAL1,SIGCHK,SIGABNM                                        
         REF      POLL,POLLCHK,POLLABNM                                         
         REF      PPOST                                                         
         FIN      #ECB                                                          
         REF      START                                                         
         REF      STOP,TMSTOP                                                   
         DO1      #ECB                                                          
         REF      STIMER,STIMABNM                                               
         REF      GETTIME                                                       
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='PINI')                                           
         REF      PINIT                                                         
         DO1      #ECB                                                          
         REF      PINTABNM                                                      
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='RUN')                                            
         REF      RUN,SCHEDC                                                    
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='ENQ')                                            
         REF      ENQ                                                           
         DO       #ECB                                                          
         REF      DEQ,ENQCHK,ENQABNM,TMENQ,TMDEQ                                
         REF      TMDELAET                                                      
         FIN      #ECB                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='ARM')                                            
         REF      ARM,DISARM                                                    
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TERM')                                           
         REF      TERM,TMTERM,TMABORT                                           
         REF      ABORT                                                         
         REF      TMTRMT,TMABRTT,TMTRMJ,TMLM                                    
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='EXTM')                                           
         REF      EXTM                                                          
         REF      TMSETE,TMDCBERR                                               
         DO1      #ECB                                                          
         REF      KJOB                                                          
         REF      SEGLOAD                                                       
         REF      STATUS,MODIFY                                                 
         REF      RLS                                                           
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TT')                                             
         REF      TT,TTPRIM                                                     
         DO1      #MAP                                                          
         REF      FMTCL                                                         
         DO1      #TJE                                                          
         REF      TTLN                                                          
         FIN                                                                    
         DO       1-(OLAYFLAG='TTJO')                                           
         REF      TTJOB                                                         
         REF      JMTERM,FMJCL                                                  
         DO1      #ECB                                                          
         REF      JMTENQ                                                        
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='WAIT')                                           
         REF      WAIT,TMWALL                                                   
         DO1      #ECB                                                          
         REF      WAITALL,WAITANY,TEST                                          
         REF      TIME                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='CRSH')                                           
         REF      CRASH                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='KEYS')                                           
         REF      SCAN,GETIOID                                                  
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='KEY1')                                           
         REF      KEY1,KEY1A04                                                  
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='KEY2')                                           
         REF      KEY2                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='KEY3')                                           
         REF      KEY3                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='KEY4')                                           
         REF      KEY4                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='KEY5')                                           
         REF      KEY5                                                          
         FIN                                                                    
* KEY6                                                                          
         DO       1-(OLAYFLAG='KEY6')                                           
         REF      KEY6                                                          
         FIN                                                                    
* KEY7                                                                          
         DO       1-(OLAYFLAG='KEY7')                                           
         REF      KEY7                                                          
         FIN                                                                    
         DO       1-(OLAYFLAG='KEY8')                                           
         REF      KEY8                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='KEY9')                                           
         REF      KEY9                                                          
         FIN                                                                    
* SNAM                                                                          
         DO       1-(OLAYFLAG='SNAM')                                           
         REF      SNAM,SETNAME                                                  
         DO1      (#MAP+#DEBUG+#TJE)>0                                          
         REF      BREAK                                                         
*                                                                               
* M E D I A   C A L *                                                           
        DO       #MEDIA                                                         
         REF      MEDIACAL          CAL PROCESSOR ENTRY                         
        FIN      #MEDIA                                                         
*                                                                               
         FIN      'SNAM'                                                        
*                                                                               
         DO       1-(OLAYFLAG='STDL')                                           
         REF      STDLB                                                         
         DO       #ECB                                                          
         REF      STLBCHK                                                       
         FIN      #ECB                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='SCHE')                                           
         REF      SCHED                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='SCNE')                                           
         REF      SCNEXT,SCEMPTY,SCFIND,SCUPDATE                                
         REF      SCMSG                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='FGL3')                                           
         REF      FGL3,FGLMEMCK                                                 
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='SJOB')                                           
         REF      SJOB                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='BKL1')                                           
         REF      BKL1,BKLASSN                                                  
         FIN                                                                    
*                                                                               
         DO       #MAP=0                                                        
         DO       1-(OLAYFLAG='CKPT')                                           
         REF      CKPT                                                          
         FIN                                                                    
         FIN      #MAP=0                                                        
*                                                                               
         DO       1-(OLAYFLAG='FGL1')                                           
         REF      FGL1,FGLMSG                                                   
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='FGL2')                                           
         REF      FGL2,FGLBADLM,FGLOKLM                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='ESU')                                            
         REF      ESU                                                           
         REF      GETANAME,SEARCHAI                                             
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='CRS')                                            
         REF      CRS,SNAP                                                      
         DO1      #XRBM                                                         
         REF      RECALARM                                                      
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='CRS2')                                           
         REF      CRS2                                                          
         REF      CPRSYMBL                                                      
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='CRD')                                            
         REF      CRD                                                           
         FIN                                                                    
         DO       1-(OLAYFLAG='CKD')                                            
         REF      CKD                                                           
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='CKD2')                                           
         REF      CKD2                                                          
         FIN                                                                    
*                                                                               
         DO       #ERRORLOG                                                     
*                                                                               
         DO       1-(OLAYFLAG='LOG')                                            
         REF      LOG                                                           
         REF      INITLOG,HOURLOG,LOGPURGE                                      
         REF      ERRSEND                                                       
         FIN                                                                    
*                                                                               
         FIN                        #ERRORLOG                                   
*                                                                               
         DO       1-(OLAYFLAG='ABEX')                                           
         REF      ABEX,PMD,BKGSEQ,DBKG                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='DUMP')                                           
         REF      DUMP,DFGD,DFGDBAL                                             
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TRAP')                                           
         REF      TRAPS,TRAP5,TRTY,TEXIT,TRAPCRSH                               
         REF      TRAP70,TRTN,JTRAP                                             
         FIN                                                                    
*                                                                               
*                                                                               
         DO       #DEBUG                                                        
*                                                                               
*                                                                               
         DO       1-(OLAYFLAG='DBDW')                                           
         REF      DEBUG,:#CALENT,:#ALTENT,DBDW                                  
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='DBC1')                                           
         REF      DBC1,:#DUMP,:#INSRT,:#NAME                                    
         REF      :#SNAP,:#SNAPIT,:#LOOK,:#DMPRET                               
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='DBC2')                                           
         REF      DBC2,:#CONSG,:#TINIT,:#TRAPIN                                 
         REF      :#ASSGN,:#REMOV                                               
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='DBC3')                                           
         REF      DBC3,:#MODFY,:#RERCHK,:#PATCH                                 
         REF      :#DOVAL,:#DODMP,:#SCNDR                                       
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='DBS1')                                           
         REF      TTDEBUG                                                       
         REF      DBS1,:#SCAN,:#WKSQZ                                           
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='DBS2')                                           
         REF      DBS2,:#DOINIT,:#DOTRAP,:#DOSNAP                               
         REF      :#DORET,CSEARCH,USEARCH,OSEARCH                               
         REF      :#TRAPEX                                                      
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='DBS3')                                           
         REF      DBS3,:#SCNLCX,:#SCNLWX,:#SCNWDX                               
         REF      :#EXCT,:#QUIT,:#BRNCH                                         
         FIN                                                                    
*                                                                               
*                                                                               
         FIN      #DEBUG                                                        
*                                                                               
*                                                                               
         DO       #TJE                                                          
*                                                                               
*                                                                               
         DO       1-(OLAYFLAG='TEX1')                                           
         REF      VERACCNT,OFFVERBG,ANALYSE,TEXBUFFR                            
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TEX2')                                           
         REF      TEXEXEC,TESTLOOP                                              
         REF      ONOFFMSG                                                      
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TEL1')                                           
         REF      TELEXEC,TELERROR                                              
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TEL2')                                           
         REF      TELREAD,TELCNTRL                                              
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TEL3')                                           
         REF      TEL3                                                          
         FIN                                                                    
*                                                                               
         DO       PROLAY=0                                                      
         REF      TEXSTCB,TEXSTACK,TJE:NUM,TJE:NOW,TEXWORKS                     
         FIN      PROLAY=0                                                      
*                                                                               
         DO1      OLAYFLAG='COCI'                                               
         REF      TJE:NUM,TJE:NOW                                               
         FIN      #TJE                                                          
*                                                                               
         DO       #LN                                                           
         DO       1-(OLAYFLAG='COCI')                                           
         REF      COCIO,COCSRDV,COCRIP,COCTIME                                  
         FIN                                                                    
         DO       PROLAY=0                                                      
         REF      COCINIT,COCOP,COCIP                                           
         FIN      PROLAY=0                                                      
         FIN      #LN                                                           
*                                                                               
*                                                                               
         DO       #MAP                                                          
*                                                                               
*                                                                               
*                                                                               
         DO       1-(OLAYFLAG='MMO1')                                           
         REF      MMO1,MMCAL,MMSAC,MMGP,MMFOV,MMACT,MMVVPN                      
         REF      MMSEGCK,MMSDS,MMRDS,MMSETVPN                                  
         DO       #ROLL                                                         
         REF      MMSTART                                                       
         FIN      #ROLL                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='MMO2')                                           
         REF      MMO2,MMRP,MMDEACT,MMERASE,MMRELP,MMGETP                       
         REF      MMTSEC,MMTJOB,MMRELSD,MMRELS                                  
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='MMO3')                                           
         REF      MMO3,MMGPPS,MMRPPS,MMGTRP,MMGJRP                              
         REF      MMRTRP,MMRJRP,MMSWLK,MMTPRIM                                  
         REF      MMRPPSI                                                       
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='MMO4')                                           
         REF      MMO4                                                          
         DO       #ROLL                                                         
         REF      MMROLL,MMRISEG,MMICHK,MMCHECK,MMEXEC                          
         REF      MMSTOP,MMRECB,MMPOST                                          
         FIN      #ROLL                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='MMO5')                                           
         REF      MMO5                                                          
         DO       #ROLL                                                         
         REF      MMROUT,MMROLLIN,MMABNM,MMRFILE,MMRRFILE                       
         REF      MMRWRITE,MMRREAD                                              
         FIN      #ROLL                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='MMO6')                                           
         REF      MMO6                                                          
         DO       #ROLL                                                         
         REF      MMLOCK,MMUNLOCK,MMRPREF,PREFMODE                              
         FIN      #ROLL                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='MMRO')                                           
         REF      MMROOT,MMGSTM,MMRSTM,MMFMP,MMRILW,LOADMAP                     
         REF      LOADACI,TDLOAD,MMFETCH,MMSTORE                                
         DO1      #TSLICE                                                       
         REF      MMSWAP                                                        
         DO       #ROLL                                                         
         REF      MMMOVE,MMOMFPP                                                
         FIN      #ROLL                                                         
         DO       PROLAY=0                                                      
         REF      TMACIMC                                                       
         REF      MMROLTAB,MMRGF:RE                                             
         REF      MMAST,ROLL99,MMRSRGSV                                         
         REF      MMTSK99,MMRLEVEL,MMRSTIME,MMRPRIO,MMTBKGP                     
         REF      MMTPAGES,MMTPREQ,MMRTS,MMSTCB                                 
         DO1      #TJE                                                          
         REF      MMTSLEV           SWAP LEVEL                                  
         FIN      PROLAY=0                                                      
         FIN      'MMRO'                                                        
*                                                                               
* S Y M B I O N T S *                                                           
*                                                                               
         DO       #SYMB                                                         
*                                                                               
         DO       1-(OLAYFLAG='JOB1')                                           
         REF      JOB1              JOB CAL PROCESSOR                           
         REF      JOBSCAN,JSCAN                                                 
         FIN      'JOB1'                                                        
*                                                                               
         DO       1-(OLAYFLAG='JOB2')                                           
         REF      JOB2,JOBDLTE,SETPRI                                           
         REF      JOBDLTEA                                                      
         REF      SMDFOS,SMDFIS                                                 
         REF      JOBMSG                                                        
         FIN                                                                    
*                                                                               
         DO       PROLAY=0                                                      
         REF      SEX                                                           
         REF      SEX1                                                          
         REF      SYMBSTCB,SYMBSTAK                                             
         REF      SIZEOS,FPTLP,SIZEIS,FPTCR                                     
         REF      SYMCRSH,FPTOPEN,XJOB,XFIN,SM:C                                
         REF      SM:PRIO                                                       
         REF      BATCHMSG,FPTCLOS,SMSG1,SMSG2,SMSG3,SMSG4,SMSG5                
         REF      SMSG6,SMSG7,SMSG8,SYMB,FPTDELF,FMALLOT,FPTPRECB               
         REF      SYMCOUNT,FPTJOBDL,FPTSTMED,FPTWEOF,FPTPFILB                   
         REF      RCDCB,RCLOSE,RCTIMER,WCJOB,WCJOBN,WCDCB                       
         REF      WCSTART,RCDLTE,RCPOLL,RCPOST,SIZEFPTJ                         
         REF      FPTJOB,FPTSIG,BFJJJ000,DFLTP                                  
         REF      STOPME,TESTACAL,ADDRRW,ADDRMSC                                
         REF      FPTSTIM,RCFPT,RCOPEN,XEXU,WCFPT                               
         REF      SMENDAC,SMCUP3,FPTPREC                                        
         REF      WCSIG,CKSIG,FPTPOLBK,FPTPSTBK                                 
         REF      BATCHF,WCBUF,XBKG                                             
         REF      RCASSIGN,RCGIOBLK,RCAREA,RCACNT,RCPBITS                       
         FIN      PROLAY=0                                                      
*                                                                               
         DO       1-(OLAYFLAG='SYM1')                                           
         REF      SYM1                                                          
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='SYM2')                                           
         REF      SYM2,SMGETF                                                   
         REF      SMDEVERR,SMFEOD                                               
         REF      SMXKEY,SMGETOF                                                
         REF      SMCLOSF,SYMCUP,SMGETQF                                        
         REF      SMWMSG,SMWEOF,SMPRECB                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='SYM3')                                           
         REF      SYM3,SIMIKEY                                                  
         REF      RCEXU,RCFEOD,RCGETF                                           
         REF      WCGETJOB,RCJOB,SMJOBFIN                                       
         REF      WCSTSYM,SMBSYF,SMINIT,SMFINDF                                 
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='SYM4')                                           
         REF      SYM4                                                          
         REF      RCOOP,WCOOP                                                   
         REF      SMBCDHEX,SMHEXBCD                                             
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='SYM5')                                           
         REF      SYM5                                                          
         REF      RCCUPJ,RCCUPF                                                 
         REF      SMBACKUP,SMXTND                                               
         FIN                                                                    
*                                                                               
         DO1      1-(OLAYFLAG='IPLS')                                           
         REF      IPLSYM                                                        
         FIN      #SYMB                                                         
*                                                                               
*                                                                               
         DO       1-(OLAYFLAG='IPLM')                                           
         REF      IPLMM                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TIO1')                                           
         REF      TIO1,TI                                                       
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TIO2')                                           
         REF      TIO2,TIS15,TIS21,TIO2ABEN,TICRASH,TISREAD,TISAST              
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='TIO3')                                           
         REF      TIO3,TISEARCH,TISDECHN,TISD,TISCHN,TIO3DBUG                   
         REF      TIRFT                                                         
         FIN                                                                    
*                                                                               
         DO       1-(OLAYFLAG='PLO1')                                           
         REF      PLO1,PUBLIB                                                   
         FIN                                                                    
*                                                                               
*                                                                               
*                                                                               
         FIN      #MAP                                                          
*                                                                               
*                                                                               
         DO       1-(OLAYFLAG='CHEC')                                           
         REF      CHECK,DELFPT,CHKBAL,CHKBALA                                   
         REF      FMCHECK,FMCK1,FMCK2,FMCK3,CHECKA                              
         REF      TMSETPSD,TMSETREG                                             
         REF      EMSETR3,EMSETR3A                                              
         FIN                                                                    
***************************                                                     
*   SYSGEN   REFERENCES   *                                                     
***************************                                                     
         REF      MDNAME,MDFLAG,MDDCTI,MDBOA,MDEOA,MDDISCI                      
         DO1      #PRIV                                                         
         REF      MDVSN                                                         
         REF      DISCNWPS,DISCNSPT,DISCNTPC,DISCNCYL                           
         REF      DISCMAXS,DISCMINS,DISCSSFT,DISCTSFT,DISCCSFT                  
         REF      DCT1,DCT1P,DCT1A                                              
         REF      DCT2,DCT3,DCT4,DCT5                                           
         REF      DCT6,DCT7,DCT8,DCT9                                           
         REF      DCT10,DCT11,DCT12,DCT13                                       
         REF      DCT14,DCT15,DCT16,DCT17                                       
         REF      DCT18,DCT19,DCT20,DCT20A,DCT21                                
         REF       DCTRBM,DCTDCB,DCTJID,DCTMOD,DCTDISCI                         
        DO1      #ERRORLOG                                                      
         REF      DCTMODX,DCT#IO,DCT#ERR,LOGFLAG                                
        DO1      #SIDEBUF                                                       
         REF      DCTSDBUF                                                      
         REF      DCTDEBUG                                                      
        DO1      #TJE                                                           
         REF      DCTTJE                                                        
        DO1      #SYMB                                                          
         REF      DCTSYM1,DCTSYM2,DCTSYM3                                       
        DO1      #DP3243                                                        
         REF      DCTCD                                                         
         DO1      #PS                                                           
         REF      DCTSHARE                                                      
         REF      S:ISFSIZ                                                      
         REF      S:OSFSIZ                                                      
         REF      S:SPAI                                                        
         REF      CIT1,CIT2,CIT3                                                
         REF      CIT5,CIT6,IOQ1,IOQ2                                           
         REF      IOQ3,IOQ4,IOQ5                                                
         REF      IOQ7,IOQ8,IOQ9,IOQ10                                          
         REF      IOQ11,IOQ12,IOQ13,IOQ14                                       
        DO1      #ERRORLOG                                                      
         REF      IOQERROR                                                      
         REF      IOQECB,RFT1,RFT2,RFT3                                         
         REF      RFT4,RFT5,RFT6,RFT7                                           
         REF      RFT6A                                                         
         REF      RFT8,RFT9,RFT10,RFT11                                         
         REF      RFT12,RFT13,RFT14,RFT15                                       
         REF      RFT16,RFT17                                                   
         REF      RFTACNT                                                       
         REF      RFTESZ,RFTE#                                                  
         REF      S:SD                                                          
         REF      S:EDT                                                         
         REF      S:TENQ            #OF TASK ENQ                                
         REF      SITE                                                          
         DO       #550                                                          
         REF      CNFGADDR,CNFGSTAT,CNFGTYPE                                    
         FIN      #550                                                          
         REF      S:DEBUG                                                       
******************                                                              
*    ALARM       *                                                              
******************                                                              
         REF      ALARMREC                                                      
******************                                                              
*   TJE TABLES   *                                                              
******************                                                              
         DO       #LN                                                           
         REF      COH:DN            DEVICE ADDRESS OF COC                       
         REF      CO:AIIL           ALL INPUT INTERR LEVELS                     
         REF      CO:AOIL           ALL OUTPUT INTER LEVELS                     
         REF      CO:IIL            1ST INPUT INTERRUPT LEVEL                   
         REF      CO:OIL            1ST OUTPUT INTERRUPT LEVEL                  
         REF      CO:STAT                                                       
         REF      CO:OUTRS                                                      
         REF      CO:RCVON                                                      
         REF      CO:XDATA                                                      
         REF      CO:TRNDO                                                      
         REF      CO:RCVDO                                                      
         REF      CO:XSTOP                                                      
         REF      CO:LST            - RING BUFFER ADDR                          
         REF      CO:RINGE          LAST ADDR IN RING BUFFER                    
         REF      COH:RBS           RING BUFFER SIZE                            
         REF      CO:OUT                                                        
         REF      COH:II            INPUT INTERRUPT                             
         REF      COH:IO            OUTPUT INTERRUPT                            
         REF      COCHPB                                                        
         REF      COCOC                                                         
         REF      LB:UN                                                         
         REF      ARSZ              ACTUAL RECORD SIZE                          
         REF      BUFCNT                                                        
         REF      MODE                                                          
         REF      MODE2                                                         
         REF      MODE3                                                         
         REF      MODE4                                                         
         REF      MODECPR                                                       
         REF      COCTERM                                                       
         REF      RSZ                                                           
         REF      CPI                                                           
         REF      CPOS                                                          
         REF      COCII                                                         
         REF      COCIR                                                         
         REF      COCOI                                                         
         REF      COCOR                                                         
         REF      TL                                                            
         REF      EOMTIME                                                       
         REF      COD:LPC           LINE NUMBER RANGE                           
         REF      COD:HWL           HARDWIRED LINE MASK                         
         REF      CO:IN0                                                        
         REF      CO:INN                                                        
         REF      CO:OUT0                                                       
         REF      CO:CMND                                                       
         REF      COCBUF            COC BUFFER START                            
         REF      HRBA              SIZE OF COC BUFFER                          
         REF      LCOC              NUMBER OF COC -1                            
         REF      LNOL              NUMBER OF LINES TOTAL                       
         REF      COA:IIG                                                       
         REF      COA:OIG                                                       
         FIN      #LN                                                           
******************                                                              
*      LMI       *       LOAD MODULE INVENTORY                                  
******************            PARALLEL SUBTABLE BASE ADDRESSES:                 
*                             INDEX = LOAD MODULE ID                            
         REF      LMI1   DW   TASK OR PUBLIB NAME                               
         REF      LMI2   W                                                      
         REF      LMI3   W    JOB ID AND LWA IN REAL MEMORY                     
         REF      LMI4   W                                                      
         REF      LMI5   HW   STATUS, TYPE ENTRY AND FLAGS                      
         REF      LMI6   W                                                      
         REF      LMIRTS DW   RTS POINTER                                       
         REF      LMI8   B    MAX S-ECBS                                        
         REF      LMI9   B                                                      
         DO       #ECB                                                          
         REF      LMIAET  W   AET LENGTH AND ADDRESS                            
         REF      LMISECB W   S-ECB COUNT AND CHAIN HEAD                        
         REF      LMIRECB W   R-ECB COUNT AND CHAIN HEAD                        
         FIN      #ECB                                                          
         DO1      #MAP                                                          
         REF      LMIRFT                                                        
         REF      LMINAME           LMI1                                        
         REF      LMIPCB            LMI2                                        
         REF      LMIFWA            LMI2                                        
         REF      LMIJID            LMI3                                        
         REF      LMILWA            LMI3                                        
         REF      LMIPL             LMI4                                        
         REF      LMICTXT           LMI4                                        
         REF      LMISTAT           LMI5                                        
         REF      LMISDT            LMI6                                        
         REF      LMIMAXS           LMI8                                        
         REF      LMIMAXR           LMI9                                        
         REF      LMIUSERS          LMI9                                        
         REF      LMI#              LMI9                                        
******************                                                              
*      STI       *       SYSTEM TASK INVENTORY                                  
******************            PARALLEL SUBTABLE BASE ADDRESSES::                
*                             INDEX= TASK ID                                    
         REF      STIXRTS           RTS OF INTERRUPTED TASK                     
         REF      STIRTSB  DW RTS DOUBLEWORD AT COMPLETION OF LAST              
         REF      STIOVID  H  OVERLAY ID #                                      
*                                   CAL1 ENTRY                                  
         REF      STIJID   B  JOB ID (SJI INDEX)                                
         REF      STILMID  B  LOAD MODULE ID (LMI INDEX)                        
         REF      STIPRIO  W  PRIORITY AND FLAG BITS                            
         REF      STITCB   W  FLAGS AND TCB/STCB ADDRESS                        
         REF      STICOUNT B  COUNT OF EVENTS WAITING TO COMPLETE               
         DO1      #ECB                                                          
         REF      STITIME  W  CRITICAL TIMEOUT THRESHOLD                        
         DO       #MULTDSP                                                      
         REF      STIDNXT  B  CHAIN NEXT STI FOR DISPATCHING                    
         REF      STIRNXT  B  CHAIN NEXT STI FOR ROLL-OUT                       
         FIN      #MULTDSP                                                      
         REF      STISTAT  B  TASK DISPATCH STATUS                              
         REF      STISPCE  W  LINK TO TSPACE ACQUIRED FOR TASK, NOT             
*                                   LINKED TO ECBS                              
         DO       #TSLICE                                                       
         REF      STIQMIN  B        TIME-SLICE QUANTUM                          
         REF      STIQMAX  B        TME-SLICE MAX TIME                          
         FIN      #TSLICE                                                       
         REF      STITICK  H        TIME ACCOUNTING                             
******************                                                              
*     RDLI       *       CPR DISPATCHER LEVEL INVENTORY                         
******************                                                              
         REF      RDLIPRIO    BYTE      PRIORITY (1NT-4F) OF RDL                
         DO1      #MULTDSP                                                      
         REF      RDLISTI     BYTE      CHAIN HEADS INTO STI DISP CHAIN         
         REF      RDLITCB     WORD      XPSD RDLITCB                            
         REF      RDLIADD     HALF      RDL INTERRUPT LOCATION                  
         REF      RDLILVL1    HALF      LEVEL BIT RDL                           
         REF      RDLIGRP1    HALF      GROUP CODE RDL                          
         REF      RDLILVL2    HALF      LEVEL BIT STL                           
         REF      RDLIGRP2    HALF      GROUP CODE STL                          
******************                                                              
*      SJI       *       SYSTEM JOB INVENTORY                                   
******************            PARALLEL SUBTABLE BASE ADDRESSES:                 
*                             INDEX = JOB ID                                    
         REF      SJI1     WORD   BYTE 0= NUMBER OF WORDS IN FIXED JCB          
*                                 BYTES 1-3 = JCB REAL ADDRESS                  
         REF      SJI2     DBL.WORD  EBCDIC JOB NAME LEFT JUSTIFIED AND         
*                                 BLANK FILLED                                  
         REF      SJI3    BYTE    FLAGS. SJI3(0) CONTAINS MAX. NO. JOBS         
         REF      OPLB1,OPLB2,OPLB3                                             
         REF      INTLB1,INTLB2                                                 
         REF      OVLOAD1,OVLOAD2,OVLOAD3                                       
         REF      OVISK                                                         
OVILG    EQU      OVLOAD1                                                       
OVINM    EQU      OVLOAD2                                                       
OVIGR    EQU      OVLOAD3                                                       
         DO       #MAP                                                          
         REF      OVIMA,OVIECB,OVICT                                            
         FIN      #MAP                                                          
         REF      EPIEP,EPIB                                                    
         DO1      #PATCH                                                        
         DO1      1                                                             
         REF      OVIUSAGE                                                      
         REF      S:TRACE,S:TRACEN,S:TRACES,S:TRACET,S:TRACEP                   
         REF       WLOCK                                                        
         REF      S:TEMPN,S:TEMP,S:UTIME,S:JPT,S:XBB                            
         REF      OLAYFWA                                                       
         DO1      #MAP                                                          
         REF      IOLOCK,RMPT,PPT                                               
         PAGE                                                                   
*                                                                               
         REF      STVM,ETVM                                                     
***************************                                                     
*   COMMAND DEFINITIONS   *                                                     
***************************                                                     
*                                                                               
*                                                                               
ENABLE   CNAME    X'6D000027'       WRITE DIRECT                                
DISABLE  CNAME    X'6D000037'       WRITE DIRECT                                
         PROC                                                                   
LF       RES      0                                                             
         DO       #ONLINE                                                       
         NOP      0                                                             
         ELSE                                                                   
         DATA     NAME                                                          
         FIN                                                                    
         PEND                                                                   
*                                                                               
*                                                                               
PUSH     CNAME    1                                                             
PULL     CNAME    0                                                             
         PROC                                                                   
LF       RES      0                                                             
         DO       NUM(AF)=1                                                     
         GEN,1,7,4,20      1,8+NAME,AF(1),K:RTS                                 
         ELSE                                                                   
         LCFI     AF(1)&X'F'                                                    
         GEN,1,7,4,20      1,X'A'+NAME,AF(2),K:RTS                              
         FIN                                                                    
         PEND                                                                   
*                                                                               
*                                                                               
TRACE    CNAME                                                                  
         PROC                       (CF(2) CLOBERED)                            
LF       RES      0                                                             
         DO       #TRACE                                                        
         LI,CF(2) AF(1)             TRACE ID                                    
         LCI      AF(2)                                                         
         PSM,CF(2) TRACESTACK       PUSH 16                                     
         BCR,X'A' %+4               BRANCH IF OK                                
         LI,CF(2) -TRACESIZE+18      OTHERWISE RESET STACK                      
         MSP,CF(2) TRACESTACK                                                   
         B        %-6               AND TRY PUSH AGAIN                          
         FIN                                                                    
         PEND                                                                   
*                                                                               
*                                                                               
PSD      CNAME                                                                  
         PROC                                                                   
         BOUND    8                                                             
LF       GEN,32,32,32,8,24  0,0,AF(1),AF(2),0                                   
         PEND                                                                   
*                                                                               
*                                                                               
STACKDW  CNAME                      AF(1) IS STACK LOCATION                     
         PROC                       AF(2) IS STACK SIZE                         
         BOUND    8                 CF(2) AND CF(3) ARE TRAP MASKS              
LF       GEN,32,1,15,1,15 AF(1)-1,CF(2),AF(2),CF(3),0                           
         PEND                                                                   
*                                                                               
* PROC TO ENTER CONTROL TASK CONTEXT                                            
*                                                                               
ENTERCT CNAME                                                                   
         PROC                                                                   
         DO       NUM(CF)=2                                                     
:REG     SET      CF(2)                                                         
         ELSE                                                                   
:REG     SET      0                                                             
         FIN                                                                    
LF       LCI      0                                                             
         PSM,R0   LMIRTS+(2*CTLMID)                                             
         LI,:REG  LMIRTS+(2*CTLMID)                                             
         XW,:REG  K:RTS                                                         
         PUSH     :REG                                                          
         PEND                                                                   
*                                                                               
* PROC TO LEAVE THE CONTROL TASK CONTEXT                                        
*                                                                               
EXITCT   CNAME                                                                  
         PROC                                                                   
         DO       NUM(CF)=2                                                     
:REG     SET      CF(2)                                                         
         ELSE                                                                   
:REG     SET      0                                                             
         FIN                                                                    
LF       PULL     :REG                                                          
         STW,:REG  K:RTS                                                        
         LCI      0                                                             
         PLM,R0   LMIRTS+(2*CTLMID)                                             
         PEND                                                                   
*                                                                               
* PROC TO REQUEST MEMORY OR PROCESSOR POLLING                                   
*                                                                               
TRIPMFI  CNAME    BIT21                                                         
TRIPPFI  CNAME    BIT20                                                         
         PROC                                                                   
LF       RES      0                                                             
         DO       (#SIGMA9+#550)>0  SIGMA 9 AND 550 ONLY                        
         RD,CF(2)  X'1200'          READ STATE OF FI LEVEL                      
         CI,CF(2) NAME              IS IT ACTIVE OR WAITING                     
         BANZ     %+4               YES, DONT TRIP                              
*                                   NO                                          
         DO       NAME=BIT21                                                    
         MTW,1    MFITRIP           SET SOFTWARE TRIP FLAG                      
         ELSE                                                                   
         MTW,1    PFITRIP                                                       
         FIN                                                                    
*                                                                               
         LI,CF(2) NAME                                                          
         WD,CF(2) X'1700'           TRIGGER FI LEVEL                            
         FIN                                                                    
         PEND                                                                   
*                                                                               
* PROC TO CAUSE A CRASH                                                         
*                                                                               
CRASH    CNAME                                                                  
         PROC                                                                   
LF       RES      0                                                             
         XPSD,0   CRASHPSD          TRAP TO CRASH RECIEVER                      
         DO1      #CRASH                                                        
         TEXTC    AF(1)             CRASH ID                                    
         PEND                                                                   
*                                                                               
*                                                                               
BIFRBM   CNAME    8                 BRANCH IF CPR                               
BIFBKG   CNAME    4                 BRANCH IF BACKGROUND                        
BIFSEC   CNAME    2                 BRANCH IF SECONDARY                         
BIFMAP   CNAME    1                 BRANCH IF MAPPED                            
         PROC                                                                   
LF       LC       PCBPOINT                                                      
         GEN,1,7,4,3,17  AFA(1),X'69',NAME,AF(2),AF(1)                          
         PEND                                                                   
*                                                                               
*                                                                               
BIFUSER  CNAME    8                 BRANCH IF USER                              
BIFFGD   CNAME    4                 BRANCH IF FORGROUND                         
BIFPRIM  CNAME    2                 BRANCH IF PRIMARY                           
BIFREAL  CNAME    1                 BRANCH IF REAL                              
         PROC                                                                   
LF       LC       PCBPOINT                                                      
         GEN,1,7,4,3,17   AFA(1),X'68',NAME,AF(2),AF(1)                         
         PEND                                                                   
*                                                                               
*                                                                               
BIFBALA  CNAME    4                 BRANCH IF ALT BAL TO SERVICE                
BIFBAL   CNAME    2                 BRANCH IF BAL TO SERVICE                    
BIFBALS  CNAME    6                 BRANCH IF ANY BAL TO SERVICE                
BIFMU    CNAME    1                 BRANCH IF MONITOR USER                      
         PROC                                                                   
LF       LC       R3                                                            
         GEN,1,7,4,3,17   AFA(1),X'69',NAME,AF(2),AF(1)                         
         PEND                                                                   
BIFNBALA CNAME    4                 BRANCH IF NOT ALTERNALTE BAL                
BIFNBAL  CNAME    2                 BRANCH IF NOT BAL                           
BIFNMU   CNAME    1                 BRANCH IF NOT MU                            
         PROC                                                                   
LF       LC       R3                                                            
         GEN,1,7,4,3,17   AFA(1),X'68',NAME,AF(2),AF(1)                         
         PEND                                                                   
*                                                                               
* OVERLAY END PROC                                                              
*                                                                               
OLAYEND  CNAME                                                                  
         PROC                                                                   
         DO       AP                                                            
UNUSED   SET      (OLAYSIZE-ABSVAL(%))                                          
         DO       UNUSED<0                                                      
         ERROR,7  '**** OVERLAY TOO BIG ****'                                   
         ELSE                                                                   
         ERROR,*0 'UNUSED SPACE REMAINING IS:'                                  
         DISP     UNUSED                                                        
         DO       UNUSED>0                                                      
         DATA     OLAYFLAG                                                      
         FIN                                                                    
         FIN                                                                    
         ELSE                                                                   
UNUSED   EQU      OLAYSIZE-%                                                    
         FIN                                                                    
         PEND                                                                   
*                                                                               
*                                                                               
*                                                *** PAX ONLY ***               
* PROC TO BUILD ASCII TABLE                      *** PAX ONLY ***               
*                                                *** PAX ONLY ***               
ASCII    CNAME                                   *** PAX ONLY ***               
         PROC                                    *** PAX ONLY ***               
         LOCAL    J,LOC,I                        *** PAX ONLY ***               
LOC      SET      %                              *** PAX ONLY ***               
I        DO       NUM(AF)                        *** PAX ONLY ***               
         ORG      ASCIITBL                       *** PAX ONLY ***               
J        SET      0+AF(I)                        *** PAX ONLY ***               
         RES,1    J                              *** PAX ONLY ***               
         DATA,1   CTR                            *** PAX ONLY ***               
CTR      SET      CTR+1                          *** PAX ONLY ***               
         FIN                                     *** PAX ONLY ***               
         ORG      LOC                            *** PAX ONLY ***               
         PEND                                    *** PAX ONLY ***               
*                                                *** PAX ONLY ***               
*                                                                               
*                                                                               
:DOT     CNAME                      DEFINE DEVICE OPERATION TABLE CODES         
         PROC                       ..                                          
         DO1      NUM(LF)=1                                                     
LF       SET      %-DOT             DEFINE LABEL AS RELATIVE OFFSET             
         GEN,8,8,8,8 AF(1),AF(2),AF(3),AF(4) GENERATE 4-BYTE OPERATION          
         PEND                                                                   
         SPACE                                                                  
:CLIST   CNAME                      DEFINE COMMAND LIST POINTERS                
         PROC                       ..                                          
         DO1      NUM(LF)=1                                                     
LF       SET      BA(%)-BA(DOT)     DEFINE LABEL AS BYTE OFFSET                 
I        DO       NUM(AF)                                                       
         DATA,1   DA(AF(I))-DA(DOT)                                             
         FIN      I                                                             
         PEND                       ..                                          
         SPACE                                                                  
:CDW     CNAME                      DEFINE COMMAND DOUBLEWORD PROTOTYPES        
         PROC                       ..                                          
         BOUND    8                 FORCE DOUBLEWORD BOUNDARY FOR DATA          
LF       GEN,8,24 AF(1),AF(2)       GENERATE ORDER CODE & ANY ADDRESS           
         GEN,8,16,8 AF(3),AF(4),AF(5) GENERATE FLAGS, FUNCTION, COUNT           
         PEND                                                                   
         SPACE                                                                  
CAT      CNAME                                                                  
         PROC                       ..                                          
         GEN,4,12,16 AF(1),AF(2)-ORIG,AF(3)-ORIG                                
         PEND                                                                   
         SPACE                                                                  
*                                                                               
*        PROCS FOR ENQ/DEQ FLAG BIT TESTING                                     
*                                                                               
BIFJAET  CNAME    8                 BRANCH IF JOB LEVEL AET                     
BIFSEDT  CNAME    4                 BRANCH IF SYSTEM LEVEL EDT                  
BIFIMMED CNAME    2                 BRANCH IF IMMEDIATE (NO ECB)                
BIFSHAR  CNAME    1                 BRANCH IF SHARED                            
         PROC                                                                   
LF       LC       R9                                                            
         GEN,1,7,4,3,17  AFA(1),X'69',NAME,AF(2),AF(1)                          
         PEND                                                                   
BIFTAET  CNAME    8                 BRANCH IF TASK LEVEL AET                    
BIFJEDT  CNAME    4                 BRANCH IF JOB LEVEL EDT                     
BIFECB   CNAME    2                 BRANCH IF ECB TO BE CREATED                 
BIFEXCL  CNAME    1                 BRANCH IF EXCLUSIVE                         
         PROC                                                                   
LF       LC       R9                                                            
         GEN,1,7,4,3,17  AFA(1),X'68',NAME,AF(2),AF(1)                          
         PEND                                                                   
         SPACE    2                                                             
*                                                                               
*        ON LINE PROCS TO DELETE PRIVELEGED INSTRUCTIONS                        
*        MAY NEED ALTERNATE LOGIC IN CPR WHERE INSTR APPEAR                     
*                                                                               
         SPACE                                                                  
          DO      (META+AP)>0                                                   
         CLOSE    WD                                                            
WD       CNAME                                                                  
         PROC                                                                   
         DO       #ONLINE                                                       
LF       NOP                                                                    
         ELSE                                                                   
LF       GEN,1,7,4,3,17  AFA(1),X'6D',CF(2),AF(2),AF(1)                         
         FIN                                                                    
         PEND                                                                   
         SPACE                                                                  
         CLOSE    MMC                                                           
MMC      CNAME                                                                  
         PROC                                                                   
         DO       #ONLINE                                                       
LF       NOP                                                                    
         ELSE                                                                   
LF       GEN,1,7,4,3,17  AFA(1),X'6F',CF(2),AF(1),0                             
         FIN                                                                    
         PEND                                                                   
         CLOSE    LRA                                                           
LRA      CNAME                                                                  
         PROC                                                                   
         DO       #ONLINE                                                       
LF       NOP                                                                    
         ELSE                                                                   
LF       GEN,1,7,4,3,17  AFA(1),X'2C',CF(2),AF(2),AF(1)                         
         FIN                                                                    
         PEND                                                                   
         CLOSE    LPSD                                                          
LPSD     CNAME                                                                  
         PROC                                                                   
         DO       #ONLINE                                                       
LF       B        *AF(1),AF(2)      INDIRECT LPSD'S DO NOT WORK                 
         ELSE                                                                   
LF       GEN,1,7,4,3,17  AFA(1),X'0E',CF(2),AF(2),AF(1)                         
         FIN                                                                    
         PEND                                                                   
         SPACE                                                                  
         CLOSE    XPSD                                                          
XPSD     CNAME                                                                  
         PROC                                                                   
         DO       #ONLINE           NOT INDEXED OR INDIRECT XPSD                
LF       STW,R0   %+2               GET CURRENT LOC                             
         BAL,R0   %+2                                                           
         DATA     0                                                             
         AI,R0    5                    BUMP TO INST PAST B                      
         STW,R0   AF(1)             STORE INTO SAVE PSD LOC                     
         LW,R0    %-3                                                           
         B        *AF(1)+2          ENTER AT NEW PSD LOC                        
         ELSE                                                                   
LF       GEN,1,7,4,3,17  AFA(1),X'0F',CF(2),AF(2),AF(1)                         
         FIN                                                                    
         PEND                                                                   
          FIN     AP OR META                                                    
         PAGE                                                                   
****************************                                                    
*   REGISTER DEFINITIONS                                                        
****************************                                                    
R0       EQU      0                                                             
R1       EQU      1                                                             
R2       EQU      2                                                             
R3       EQU      3                                                             
R4       EQU      4                                                             
R5       EQU      5                                                             
R6       EQU      6                                                             
R7       EQU      7                                                             
R8       EQU      8                                                             
R9       EQU      9                                                             
R10      EQU      10                                                            
R11      EQU      11                                                            
R12      EQU      12                                                            
R13      EQU      13                                                            
R14      EQU      14                                                            
R15      EQU      15                                                            
         PAGE                                                                   
*   SYSTEM CELLS   *                                                            
********************                                                            
*                                                                               
*                                                                               
*                                                                               
*                                   EQUATES FOR SYSTEM FLAGS                    
*                                                                               
         DO       #ONLINE                                                       
*                                                                               
         REF      K:SYSTEM                                                      
         REF      K:BACKBG                                                      
         REF      K:BCKEND                                                      
         REF      K:FGDBG1                                                      
         REF      K:FGDEND                                                      
         REF      K:CCBUF                                                       
         REF      K:BPOOL                                                       
         REF      K:FGDBG2                                                      
         REF      K:FMBOX                                                       
         REF      K:FPOOL                                                       
         REF      K:UNAVBG                                                      
         REF      K:MASTD                                                       
         REF      K:NUMDA                                                       
         REF      K:VRSION                                                      
         REF      K:ACCNT                                                       
         REF      K:OV                                                          
         REF      K:KEYST                                                       
         REF      K:JCP1                                                        
         REF      K:CTST                                                        
         REF      K:SY                                                          
         REF      K:BPEND                                                       
         REF      K:CTWD                                                        
         REF      K:CTGL                                                        
         REF      K:BLOAD                                                       
         REF      K:BAREA                                                       
         REF      K:ASSIGN                                                      
         REF      K:RUNF                                                        
         REF      K:HIINT                                                       
         REF      K:FGDBG3                                                      
         REF      K:PMD                                                         
         REF      K:DCB                                                         
         REF      K:KEYIN                                                       
         REF      K:FGDBG4                                                      
         REF      K:DELTA                                                       
         REF      K:QUEUE                                                       
         REF      K:BTFILE                                                      
         REF      K:GO                                                          
         REF      K:PAGE                                                        
         REF      K:RDBOOT                                                      
         REF      K:DCT1                                                        
         REF      K:DCT16                                                       
         REF      K:OPLBS1                                                      
         REF      K:OPLBS3                                                      
         REF      K:RFT4                                                        
         REF      K:RFT5                                                        
         REF      K:SERDEV                                                      
         REF      K:REQCOM                                                      
         REF      K:INITX                                                       
         REF      K:FGLD                                                        
         REF      K:PMD1                                                        
         REF      K:PMD2                                                        
         REF      K:PMD3                                                        
         REF      K:RUNBPL                                                      
         REF      K:CLK1                                                        
         REF      K:CLK2                                                        
         REF      K:CLK3                                                        
         REF      K:ABTLOC                                                      
         REF      K:MSG1                                                        
         REF      K:MSG2                                                        
         REF      K:MSG3                                                        
         REF      K:MSG4                                                        
         REF      K:MSG5                                                        
         REF      K:MSG6                                                        
         REF      K:MSG7                                                        
         REF      K:MSG8                                                        
         REF      K:MSG9                                                        
         REF      K:MSG10                                                       
         REF      K:MSG11                                                       
         REF      K:MSG12                                                       
         REF      K:MSG13                                                       
         REF      K:MSG14                                                       
         REF      K:MSG15                                                       
         REF      K:MSG16                                                       
         REF      K:XITSIM                                                      
         REF      K:TRPSIM                                                      
         REF      K:PPGMOT                                                      
         REF      K:MONTH                                                       
         REF      K:DATE1                                                       
         REF      K:DATE2                                                       
         REF      K:TIME                                                        
         REF      K:BPGLIM                                                      
         REF      K:LIMIT                                                       
         REF      K:ACCNAM                                                      
         REF      K:ELTIM2                                                      
         REF      K:PTCH                                                        
         REF      K:PTCHND                                                      
         REF      K:IOWD                                                        
         REF      K:IOGL                                                        
         REF      K:CPWD                                                        
         REF      K:CPGL                                                        
         REF      K:IOLOCK                                                      
         REF      K:RMPT                                                        
         REF      K:BMEM                                                        
         REF      K:JAET                                                        
         REF      K:RTS                                                         
         REF      K:MDNAME          POINTER TO MDNAME TABLE                     
         REF      K:MASTID                                                      
         REF      K:RBMEND                                                      
         REF      K:RUNJ                                                        
         REF      K:PPT                                                         
         PAGE                                                                   
         ELSE                                                                   
*                                                                               
*                                                                               
K:SYSTEM EQU      X'2B'             MONITOR IDENTIFICATION (CPRIDENT)           
*        BITS     MEANING                                                       
*        0-3      OLAYFLAG='CPR' (CPR = 3)                                      
*        4-7      EXPANSION                                                     
*        8-11     VERSION  (C=3, D=4, ETC.)                                     
*        12-15    UPDATE   (1,2,3, ETC.)                                        
*        16-23    UNDEFINED                                                     
*        24-25    00 - SIGMA 5                                                  
*                 01 - SIGMA 6/7                                                
*                 10 - SIGMA 9                                                  
*                 11 - 560                                                      
*        26       N/A (MULTIPROGRAMMED BATCH)                                   
*        27       N/A (DMS CAPABILITY)                                          
*        28       N/A (NEW FILE MANAGEMENT)                                     
*        29       REAL-TIME ROUTINES                                            
*        30       N/A (REMOTE BATCH)                                            
*        31       N/A (SYMBIONT ROUTINES)                                       
         PAGE                                                                   
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'            CPR 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 CMND NOT ALLOWED                                      
*        BIT  7=1, PAUSE CMND NOT ALLOWED                                       
*       BITS 8-15, PREVIOUS ASSIGN. OF C DEVICE(FOR TY KEY-IN)                  
*        BITS 16-21                 UNUSED                                      
*        BIT 22   1 MEANS SYSTEM PROCESSOR EXECUTING                            
*        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, CPR 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        
*                                   PRIORITY OF THE SUBTASK IS DEFINED          
*                                    BY THE ORDER IN WHICH THE BIT IS           
*                                    CHECKED IN THE CONTROL TASK. FIRST         
*                                    BIT CHECKED IS HIGHEST PRIORITY,ETC        
*                                   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 CT DUMP                                              
*        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/*C        
*        BIT 13=1, EXECUTE ERROR LOGGER                                         
*        BIT 14=1, CKPT DEFERRED DURING BKG ABORT                               
*        BIT 15=1, BKG IS IN THE WAIT FOLLOWING ABORT ATTENDED MODE             
*        BIT 16=1, LOAD SCHED                                                   
*        BIT 25=1, DO HOURLY LOG                                                
*        BIT 27=1, FGL1 CALLED FROM FGL2                                        
*        BIT 28=1, CTASK IS RUNNING                        /SIG7-1553/*C        
*        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= CONTROL TASK INTERRUPT NO.             
*                                   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         
*                                    CPR FILE                                   
K:KEYIN  EQU      X'169'            KEYIN RESPONSE BUFFER- 2 WORDS              
K:MDBOT  EQU      X'16D'            ADDRESS OF MDBOT                            
K:MDEOT  EQU      X'16E'            ADDRESS OF MDEOT                            
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'            FLAGS FOR DUMP                              
K:CTDR7  EQU      X'181'            SAVE R7 DURING BREAK IN CT DUMP             
K:DBTS   EQU      X'182'            POINTER TO TSPACE FOR BKG PMD               
K:KEYDCB EQU      X'183'            DCB FOR READING KEYINS                      
*                                   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'                                                        
K:DCT4   EQU      X'18F'            ADDRESS OF DCT4  TABLE                      
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/*C        
K:MSG15  EQU      X'1CF'            UNABLE LOAD BKG PUB LIB/SIG7-3785/*C        
K:MSG16  EQU      X'1D7'            CKPT WAITING FOR BKG   /SIG7-3785/*C        
*                                            I/O RUNDOWN   /SIG7-3785/*C        
*                                                                               
K:XITSIM EQU      X'1E6'            UNIMP INST NORMAL RETURN                    
K:TRPSIM EQU      X'1E7'            UNIMP INST TRAP RETURN                      
K:PPGM0T EQU      X'1E8'            UNIMP INST MEM PROT ERR RETURN              
*                 X'1E9'            UNUSED                                      
*                 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               
*                                   HW 1 = REMAINING PAGES                      
*                                        = 0 IF NO LIMIT                        
*                                   HW 0 = REMAINING LINES IN THIS PAGE         
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:PTCH   EQU      X'207'            BEGINNING ADDR. OF PATCH AREA               
K:PTCHND EQU      X'208'            ENDING ADDR. OF PATCH AREA                  
K:IOWD   EQU      X'209'            IO TRIGGER VALUES                           
K:IOGL   EQU      X'20A'                                                        
K:UNUSED1 EQU     X'20B'            UNUSED K:                                   
K:SYS1    EQU     X'20C'            SAVE K:SYSTEM DURING REBOOT                 
K:IOLOCK EQU      X'20D'                                                        
K:RMPT   EQU      X'20E'            RMPT LOCATION AND LENGTH                    
K:BMEM   EQU      X'20F'            MAX NO OF BKG PAGES                         
K:JAET   EQU      X'210'            NO OF ALLOCATABLE DCT ENTRIES               
K:RTS    EQU      X'211'            CPR STACK PTR                               
K:MDNAME EQU      X'212'            ADDR OF MDNAME TABLE                        
K:DCT1X  EQU      X'213'            ADDR OF DCT1   TABLE                        
K:RBMEND EQU      X'214'            LWA OF RESIDENT CPR                         
K:RUNJ   EQU      X'215'            STATUS FROM JCP RUN CAL                     
K:PPT    EQU      X'216'            PARTITION POINTER TABLE POINTER             
K:FSMM   EQU      X'217'            PAGES,END ADDRES FOR F SMM                  
K:MDBOA  EQU      X'218'            MAST DIR START OF AREA TABLE                
K:MDEOA  EQU      X'219'            END OF AREA TABLE                           
K:MDDCTI EQU      X'21A'            DCT INDEX TABLE                             
*                                                                               
*                                                                               
         FIN      #ONLINE                                                       
*                                                                               
*                                                                               
BLIMITS  EQU      K:BACKBG                                                      
FLIMITS  EQU      K:FGDBG1                                                      
         PAGE                                                                   
*                                                                               
*                                                                               
KNF      EQU      -X'F'                                                         
KN1      EQU      -1                                                            
K0       EQU      0                                                             
K1       EQU      1                                                             
K2       EQU      2                                                             
K3       EQU      3                                                             
K4       EQU      4                                                             
K5       EQU      5                                                             
K6       EQU      6                                                             
K7       EQU      7                                                             
K8       EQU      8                                                             
K9       EQU      9                                                             
KA       EQU      X'A'                                                          
KB       EQU      X'B'                                                          
KC       EQU      X'C'                                                          
KD       EQU      X'D'                                                          
KE       EQU      X'E'                                                          
KF       EQU      X'F'                                                          
K10      EQU      X'10'                                                         
K11      EQU      X'11'                                                         
K14      EQU      X'14'                                                         
K16      EQU      X'16'                                                         
K1C      EQU      X'1C'                                                         
K20      EQU      X'20'                                                         
K29      EQU      X'29'                                                         
K2E      EQU      X'2E'                                                         
K2F      EQU      X'2F'                                                         
K30      EQU      X'30'                                                         
K36      EQU      X'36'                                                         
K40      EQU      X'40'                                                         
K41      EQU      X'41'                                                         
K42      EQU      X'42'                                                         
K44      EQU      X'44'                                                         
K48      EQU      X'48'                                                         
K4A      EQU      X'4A'                                                         
K54      EQU      X'54'                                                         
K55      EQU      X'55'                                                         
K58      EQU      X'58'                                                         
K59      EQU      X'59'                                                         
K5A      EQU      X'5A'                                                         
K5B      EQU      X'5B'                                                         
K60      EQU      X'60'                                                         
K67      EQU      X'67'                                                         
K70      EQU      X'70'                                                         
K71      EQU      X'71'                                                         
K72      EQU      X'72'                                                         
K73      EQU      X'73'                                                         
K74      EQU      X'74'                                                         
K77      EQU      X'77'                                                         
K80      EQU      X'80'                                                         
KC0      EQU      X'C0'                                                         
KE7      EQU      X'E7'                                                         
KF0      EQU      X'F0'                                                         
KFD      EQU      X'FD'                                                         
KFE      EQU      X'FE'                                                         
KFF      EQU      X'FF'                                                         
K100     EQU      X'100'                                                        
K200     EQU      X'200'                                                        
K800     EQU      X'800'                                                        
K1000    EQU      X'1000'                                                       
K1800    EQU      X'1800'                                                       
K1FFF    EQU      X'1FFF'                                                       
K2000    EQU      X'2000'                                                       
K4000    EQU      X'4000'                                                       
K8000    EQU      X'8000'                                                       
KC000    EQU      X'C000'                                                       
KFFFF    EQU      X'FFFF'                                                       
K1FFFF   EQU      X'1FFFF'                                                      
K20000   EQU      X'20000'                                                      
I128K    EQU      X'20000'          128K CONSTANT                               
IOD1     EQU      1                 IO DATA AREA TYPES                          
IOD2     EQU      2                                                             
IOD3     EQU      3                                                             
IOD4     EQU      4                                                             
CUPWORD  EQU      4                 ECB OFFSET FOR CLEANUP WORD                 
         DO       #ONLINE                                                       
         REF      TCBPOINT,PCBPOINT                                             
         ELSE                                                                   
PCBPOINT EQU      X'4E'                                                         
TCBPOINT EQU      X'4F'                                                         
         FIN                                                                    
PRIORITY EQU      TCBPOINT                                                      
TYSIZE   EQU      140                                                           
LPSIZE   EQU      133                                                           
CPSIZE   EQU      120                                                           
IOOKCODE EQU      1                 NORMAL TYC VALUE                            
DCT4:TY  EQU      1                                                             
DCT4:LP  EQU      6                                                             
DCT4:LPL EQU      11                                                            
DCT4:DP  EQU      12                                                            
DCT4:DPX EQU      14                                                            
         PAGE                                                                   
*                                                                               
BIT0     EQU      X'80000000'                                                   
BIT1     EQU      1**30                                                         
BIT2     EQU      1**29                                                         
BIT3     EQU      1**28                                                         
BIT4     EQU      1**27                                                         
BIT5     EQU      1**26                                                         
BIT6     EQU      1**25                                                         
BIT7     EQU      1**24                                                         
BIT8     EQU      1**23                                                         
BIT9     EQU      1**22                                                         
BIT10    EQU      1**21                                                         
BIT11    EQU      1**20                                                         
BIT12    EQU      1**19                                                         
BIT13    EQU      1**18                                                         
BIT14    EQU      1**17                                                         
BIT15    EQU      1**16                                                         
BIT16    EQU      1**15                                                         
BIT17    EQU      1**14                                                         
BIT18    EQU      1**13                                                         
BIT19    EQU      1**12                                                         
BIT20    EQU      1**11                                                         
BIT21    EQU      1**10                                                         
BIT22    EQU      1**9                                                          
BIT23    EQU      1**8                                                          
BIT24    EQU      1**7                                                          
BIT25    EQU      1**6                                                          
BIT26    EQU      1**5                                                          
BIT27    EQU      1**4                                                          
BIT28    EQU      1**3                                                          
BIT29    EQU      1**2                                                          
BIT30    EQU      1**1                                                          
BIT31    EQU      1**0                                                          
         PAGE                                                                   
* TYC CODES                                                                     
TYCOK    EQU      1                 OK                                          
TYCLOST  EQU      2                 LOST DATA                                   
TYCBOT   EQU      3                 BOT                                         
TYCEOT   EQU      5                 EOT                                         
TYCTM    EQU      6                 TAPE MARK                                   
TYCERR   EQU      8                 ERROR                                       
TYCINCST EQU      X'11'             INCONSISTANT STATUS                         
TYCPGABT EQU      X'10'             PAGE ABORT                                  
* FLAGS                                                                         
FLGRETRY EQU      BIT16             RETRY                                       
FLGINTER EQU      BIT18             INTER-OP                                    
FLGKEYNC EQU      BIT20             KEY-IN NOC                                  
FLGKEYC  EQU      BIT19             KEY-IN C                                    
FLGHOLD  EQU      BIT21             CHANNEL HOLD                                
FLGFOLOW EQU      BIT17             FOLLOW-ON                                   
FLGMSG   EQU      BIT22                                                         
         PAGE                                                                   
*                                                                               
* I/O STATUS BITS                                                               
*                                                                               
* AIO                                                                           
AIODO    EQU      BIT0              DATA OVERRUN                                
AIOICL   EQU      BIT8              INCORRECT LENGTH                            
AIOTDE   EQU      BIT9              TRANSMISSION DATA ERROR                     
AIOZBCI  EQU      BIT10             ZERO BYTE COUNT INTERRUPT                   
AIOCEI   EQU      BIT11             CHANNEL END INTERRUPT                       
AIOUEI   EQU      BIT12             UNUSUAL END INTERRUPT                       
*                                                                               
* TIO                                                                           
TIOIP    EQU      BIT0              INTERRUPT PENDING                           
TIODNO   EQU      BIT2              DEVICE NOT OPERATIONAL                      
TIODU    EQU      BIT1              DEVICE UNAVAILABLE                          
TIODB    EQU      BIT1+BIT2         DEVICE BUSY                                 
TIODA    EQU      BIT3              DEVICE AUTOMATIC                            
TIODUE   EQU      BIT4              DEVICE UNUSUAL END                          
TIODCNO  EQU      BIT6              DEVICE CONTROLER NOT OPERATIONAL            
TIODCU   EQU      BIT5              DEVICE CONTROLER UNAVAILABLE                
TIODCB   EQU      BIT5+BIT6         DEVICE CONTROLER BUSY                       
TIOICL   EQU      BIT8              INCORRECT LENGTH                            
TIOTDE   EQU      BIT9              TRANSMISSION DATA ERROR                     
TIOTME   EQU      BIT10             TRANSMISSION MEMORY ERROR                   
TIOMAE   EQU      BIT11             MEMORY ADDRESS ERROR                        
TIOIOPME EQU      BIT12             IOP MEMORY ERROR                            
TIOIOPCE EQU      BIT13             IOP CONTROL ERROR                           
TIOIOPH  EQU      BIT14             IOP HALT                                    
TIOSIOPB EQU      BIT15             SIOP BUSY                                   
*                                                                               
* TDV                                                                           
TDVIP    EQU      TIOIP                                                         
TDVICL   EQU      TIOICL                                                        
TDVTDE   EQU      TIOTDE                                                        
TDVTME   EQU      TIOTME                                                        
TDVMAE   EQU      TIOMAE                                                        
TDVIOPME EQU      TIOIOPME                                                      
TDVIOPCE EQU      TIOIOPCE                                                      
TDVIOPH  EQU      TIOIOPH                                                       
TDVSIOPB EQU      TIOSIOPB                                                      
*                                                                               
*                                                                               
* ERROR LOGGING VALUES                                                          
*                                                                               
*                                                                               
STACKSIZ EQU      16                                                            
*                                                                               
         PAGE                                                                   
*                                                                               
CAL1PUSH EQU      20                21 WORDS PUSHED INTO RTS BY CAL1            
DCFLAG   EQU      BIT0                                                          
IZCFLAG  EQU      BIT1                                                          
CCFLAG   EQU      BIT2                                                          
ICEFLAG  EQU      BIT3                                                          
HTEFLAG  EQU      BIT4                                                          
IUEFLAG  EQU      BIT5                                                          
SILFLAG  EQU      BIT6                                                          
SKIPFLAG EQU      BIT7                                                          
*                                                                               
CC       EQU      (CCFLAG+HTEFLAG+IUEFLAG+SILFLAG)**-24                         
NCC      EQU      (ICEFLAG+HTEFLAG+IUEFLAG+SILFLAG)**-24                        
DC       EQU      X'FF'&((DCFLAG+HTEFLAG+IUEFLAG)**-24)                         
SKIP     EQU      SKIPFLAG**-24                                                 
*                                                                               
01SEC    EQU      1                 ONE SECOND                                  
50SEC    EQU      10                50  SECOND                                  
*                                                                               
* BDP LP BITS                                                                   
*                                                                               
TDVRM1   EQU      BIT2              RECOVERY MODE 1                             
TDVRM2   EQU      BIT1              RECOVERY MODE 2                             
*                                                                               
* RAD/DISC PACK FUNCTION CODES                                                  
*                                                                               
FCRRAD   SET      0                                                             
FCWRAD   SET      1                                                             
FCSNSRAD SET      2                                                             
FCCKWRAD SET      3                                                             
FCWCWRAD SET      4                                                             
FCRCWRAD SET      5                                                             
*                                                                               
* MAGNETIC TAPE FUNCTION CODES                                                  
*                                                                               
FCRMT    SET      0                                                             
FCWMT    SET      1                                                             
FCRB9T   SET      2                                                             
FCWTMMT  SET      3                                                             
FCBSRMT  SET      4                                                             
FCFSRMT  SET      5                                                             
FCBSFMT  SET      6                                                             
FCFSFMT  SET      7                                                             
FCREWMT  SET      8                                                             
FCROFFMT SET      9                                                             
FCR7TBIN SET      10                                                            
FCW7TBIN SET      11                                                            
FCRB7TB  SET      12                                                            
FCR7TDEC SET      13                                                            
FCW7TDEC SET      14                                                            
FCRB7TD  SET      15                                                            
FCFSFMTS SET      20                                                            
FCBSFMTS SET      21                                                            
*********************************                                               
* LINE PRINTER FUNCTIONS                                                        
*********************************                                               
FCWLPWOF SET      0                                                             
FCWLPF   SET      1                                                             
FCFLP    SET      2                                                             
******************************                                                  
* CARD FUNCTIONS             *                                                  
******************************                                                  
FCRCRBIN SET      0                                                             
FCRCRAUT SET      1                                                             
FCWCPBCD SET      0                                                             
FCWCPBIN SET      1                                                             
**********************************************************************          
* TTY FUNCTIONS                                                                 
**********************************************************************          
FCRKPWE  SET      0                                                             
FCWKP    SET      1                                                             
FCWKPWDN SET      2                                                             
FCRKPWOE SET      3                                                             
FCRKPWNL SET      4                                                             
FCWNL    SET      5                                                             
FCWKPWNL SET      6                                                             
         DO       #LN                                                           
FCWLN    EQU      7                                                             
FCRLN    EQU      8                                                             
         FIN      #LN                                                           
**********************************************************************          
* PAPER TAPE FUNCTIONS                                                          
**********************************************************************          
FCRPTAUT SET      0                                                             
FCWPTBCD SET      1                                                             
FCRPTCNT SET      2                                                             
FCWPTBIN SET      3                                                             
FCRPTDIR SET      4                                                             
FCWPTDIR SET      5                                                             
FCRPTBCD SET      6                                                             
FCRPTBIN SET      7                                                             
FCRPTIM  SET      8                                                             
************************************************************************        
* PLOTTER FUNCTIONS                                                             
************************************************************************        
FCWPL    SET      0                                                             
         LIST     1-(OLAYFLAG='CPR')                                            
         DO       1-(OLAYFLAG='CPR')                                            
         DATA     0                                                             
         ORG      %-1                                                           
         SYSTEM   CPREQU                                                        
         FIN      1-(OLAYFLAG='CPR')                                            
         LIST     1                                                             
********************************                                                
* END OF CPRMON                *                                                
********************************                                                
         END                                                                    
