         TITLE    'SIGMA 5/7 RBM'                                               
         SYSTEM   SIG9P                                                         
         PSYS     0                                                             
         SYSTEM   OPTIONS                                                       
*                                                                               
****************************                                                    
*   EXTERNAL DEFINITIONS   *                                                    
****************************                                                    
*                                                                               
OLAYFLAG EQU      'CPR'                                                         
         SYSTEM   CPRMON                                                        
         TITLE    'CORE CONSTANTS'                                              
         PAGE                                                            0103000
*  LIST 0                                                                       
RBM      EQU      %                                                             
A:RBM    EQU      RBM                                                           
*                                                                        0104000
*******************                                                      0105000
*   STATIC DATA   *                                                      0106000
*******************                                                      0107000
*                                                                        0108000
*                                                                        0109000
*                                                                        0110000
*        BIT TABLE                                                              
*                                                                               
BITABLE  RES      0                                                             
BITS     DO       32                                                            
         DATA     1**(32-BITS)                                                  
         FIN                                                                    
         PAGE                                                                   
*    MASKS                                                               0111000
M1       EQU      BITABLE+31                                                    
M2       DATA     X'3'                                                   0113000
*        X5 MUST PRECEED M3, AND X5 MUST BE ON DW BDRY     /SIG7-5346/*C5732 C01
*        DOUBLE WORD USED FOR CLM TEST (TRAP CODE)         /SIG7-5346/*C5732 C01
         BOUND    8                                        /SIG7-5346/*C5732 C01
X5       DATA     5                                        /SIG7-5346/*C5732 C01
M3       DATA     X'7'                                                   0114000
M4       DATA     X'F'                                                   0115000
M5       DATA     X'1F'                                                         
M6       DATA     X'3F'                                                  0116000
M7       DATA     X'7F'                                                  0117000
M8       DATA     X'FF'                                                  0118000
M9       DATA     X'1FF'                                                 0119000
M12      DATA     X'FFF'                                                        
M15      DATA     X'7FFF'                                                0120000
M16      DATA     X'FFFF'                                                0121000
M17      DATA     X'1FFFF'                                               0122000
M19      DATA     X'7FFFF'                                               0123000
M24      DATA     X'FFFFFF'                                              0124000
M25      DATA     X'1FFFFFF'                                                    
M31      DATA     X'7FFFFFFF'                                                   
M32      DATA     -1                                                            
*                                                                        0125000
*                                                                        0126000
*    CONSTANTS  (RIGHT JUSTIFIED)                                        0127000
X1       EQU      M1                                                     0128000
X2       EQU      BITABLE+30                                                    
X3       EQU      M2                                                     0130000
X4       EQU      BITABLE+29                                                    
X7       EQU      M3                                                     0131000
         BOUND    8                                        /SIG7-2064/*C5732 C01
X8       DATA     8               X8/DATA 9 USED-IOINT TEST/SIG7-2064/*C5732 C01
X9       DATA     9                                        /SIG7-5326/*C5732 C01
XB       DATA     11                                       /SIG7-5326/*C5732 C01
XA       DATA     10                                                            
X6       DATA     6                                                             
XD60     DATA     60                                                            
XD3600   DATA     3600                                                          
XE       DATA     X'E'                                                          
XF       EQU      M4                                                     0133000
X10      EQU      BITABLE+27                                                    
X20      EQU      BITABLE+26                                                    
X30      DATA     X'30'                                                         
X3F      EQU      M6                                                     0136000
X40      EQU      BITABLE+25                                                    
X60      DATA     X'60'                                                         
X70      DATA     X'70'                                                         
X7D      DATA     X'7D'                                                         
X7F      EQU      M7                                                     0138000
X80      EQU      BITABLE+24                                                    
XBF      DATA     X'BF'                                                  0140000
XCF      DATA     X'CF'                                                  0141000
XDF      DATA     X'DF'                                                         
XE0      DATA     X'E0'                                                         
XE7      DATA     X'E7'                                                  0142000
XEF      DATA     X'EF'                                                  0143000
XF0      DATA     X'F0'                                                         
XF7      DATA     X'F7'                                                         
XFB      DATA     X'FB'                                                  0144000
XFC      DATA     X'FC'                                                         
XFD      DATA     X'FD'                                                         
XFE      DATA     X'FE'                                                  0145000
XFF      EQU      M8                                                     0146000
X100     EQU      BITABLE+23                                                    
X1FF     EQU      M9                                                     0147000
X200     EQU      BITABLE+22                                                    
X380     DATA     X'380'                                                        
X400     EQU      BITABLE+21                                                    
X800     EQU      BITABLE+20                                                    
X1000    EQU      BITABLE+19                                                    
X1700    DATA     X'1700'                                                       
X1800    DATA     X'1800'                                                       
X1F00    DATA     X'1F00'                                                       
X2000    EQU      BITABLE+18                                                    
X3000    DATA     X'3000'                                                       
X4000    EQU      BITABLE+17                                                    
X6000    DATA     X'6000'                                                       
X7FFF    EQU      M15                                                    0150000
X8000    EQU      BITABLE+16                                                    
XFE7D    DATA     X'FE7D'                                                       
XFF7F    DATA     X'FF7F'                                                       
XFF8F    DATA     X'FF8F'                                                       
XFFF0    DATA     X'FFF0'                                                       
XFFF7    DATA     X'FFF7'                                                       
XFFFE    DATA     X'FFFE'                                                       
XFFFF    EQU      M16                                                    0151000
X10000   EQU      BITABLE+15                                                    
X1FE00   DATA     X'0001FE00'                                                   
X1FFFF   EQU      M17                                                    0152000
X20000   EQU      BITABLE+14                                                    
X20200   DATA     X'20200'                                                      
XFFFF00  DATA     X'00FFFF00'                                                   
FFFFFE00 DATA     X'FFFFFE00'                                                   
FFFFFF00 DATA     X'FFFFFF00'                                                   
X7FFFF   EQU      M19                                                    0154000
X404040  DATA     X'404040'                                                     
X1000001 DATA     X'1000001'                                                    
XF0F0F0  DATA     X'00F0F0F0'                                                   
XF0F0F1  DATA     X'00F0F0F1'                                                   
XFFFFFF  EQU      M24                                                    0155000
FBFFFFFF DATA     X'FBFFFFFF'                                                   
FCFFFFFF DATA     X'FCFFFFFF'                                                   
EFFFFFFF DATA     X'EFFFFFFF'                                                   
FFFFFEFF DATA     X'FFFFFEFF'                                                   
FFFFE0FF DATA     X'FFFFE0FF'                                                   
FFFFEFFF DATA     X'FFFFEFFF'                                            0157000
FFFDB5FF DATA     X'FFFDB5FF'       USED BY DFM                                 
FFFDFDFF DATA     X'FFFDFDFF'                                                   
FFFDFFFF DATA     X'FFFDFFFF'                                                   
FFFEFFFF DATA     X'FFFEFFFF'                                                   
FFFF7FFF DATA     X'FFFF7FFF'                                                   
FFFFBFFF DATA     X'FFFFBFFF'                                                   
         DO       #DUALFLG                                                      
FFA0FFFF DATA     X'FFA0FFFF'                                                   
FF50FFFF DATA     X'FF50FFFF'                                                   
         FIN      #DUALFLG                                                      
FF7FFFFF DATA     X'FF7FFFFF'                                                   
FFDFEFFF DATA     X'FFDFEFFF'                                            0158000
FF01FFFF DATA     X'FF01FFFF'                                                   
C001FFFF DATA     X'C001FFFF'                                                   
C0000030 DATA     X'C0000030'                              /SIG7-2064/*C5732 C01
FFFFFFE1 DATA     X'FFFFFFE1'                                                   
FFFFFFEF DATA     X'FFFFFFEF'                                                   
C0C0C0C0 DATA     X'C0C0C0C0'                                                   
B3FFFFFF DATA     X'B3FFFFFF'                                                   
BFFFFFFF DATA     X'BFFFFFFF'                                                   
FFFFFFBF DATA     X'FFFFFFBF'                                                   
FDFFFFFF DATA     X'FDFFFFFF'                                                   
FEFFFFFF DATA     X'FEFFFFFF'                                                   
F7FFFFFF DATA     X'F7FFFFFF'                                                   
DEFFFFFF DATA     X'DEFFFFFF'                                                   
DFFFFFFF DATA     X'DFFFFFFF'                                                   
FFFFF800 DATA     X'FFFFF800'                                                   
*                                                                        0159000
*                                                                        0160000
*    CONSTANTS  (LEFT JUSTIFIED)                                         0161000
YFFFFFF  DATA     X'FFFFFF00'                                                   
Y155A5A  DATA     X'155A5A00'                                                   
YFFFF    DATA     X'FFFF0000'                                                   
Y00FF    DATA     X'00FF0000'                                                   
Y3030    DATA     X'30300000'                                                   
Y000A    DATA     X'000A0000'                                                   
Y00FE    DATA     X'00FE0000'                                                   
Y007F    DATA     X'007F0000'                              /SIG7-5174/*C015732  
YFFFE    DATA     X'FFFE0000'                                            0162000
YFF7E    DATA     X'FF7E0000'                                           INSDR170
YFF8     DATA     X'FF800000'                                                   
YFF4     DATA     X'FF400000'                                                   
YFF      DATA     X'FF000000'                                            0163000
Y7F      DATA     X'7F000000'                              /SIG7-5174/*C015732  
Y0002    EQU      X20000                                                        
Y0004    EQU      BITABLE+13                                                    
Y0006    DATA     X'00060000'                                                   
Y0008    EQU      BITABLE+12                                                    
Y0011    DATA     X'110000'                                                     
Y001     EQU      BITABLE+11                                                    
Y002     EQU      BITABLE+10                                                    
Y003     DATA     X'00300000'                                                   
Y004     EQU      BITABLE+9                                                     
Y008     EQU      BITABLE+8                                                     
Y007     DATA     X'00700000'                                                   
Y006     DATA     X'00600000'                                                   
Y083     DATA     X'08300000'                                                   
Y00C     DATA     X'00C00000'                                                   
Y00E     DATA     X'00E00000'                                                   
Y01      EQU      BITABLE+7                                                     
Y02      EQU      BITABLE+6                                                     
Y03      DATA     X'03000000'                                                   
Y05      DATA     X'05000000'                                                   
Y04      EQU      BITABLE+5                                                     
Y07      DATA     X'07000000'                                                   
Y08      EQU      BITABLE+4                                                     
Y0A      DATA     X'0A000000'                                                   
Y0C      DATA     X'0C000000'                                                   
Y0F      DATA     X'0F000000'                                                   
Y1       EQU      BITABLE+3                                                     
Y2       EQU      BITABLE+2                                                     
Y3       DATA     X'30000000'                                                   
Y31      DATA     X'31000000'                                                   
Y4       EQU      BITABLE+1                                                     
Y4B      DATA     X'4B000000'                                                   
Y6       DATA     X'60000000'                                                   
Y15      DATA     X'15000000'                                            0172000
Y1C      DATA     X'1C000000'                                                   
Y22      DATA     X'22000000'                                                   
Y8       EQU      BITABLE                                                       
Y60      DATA     X'60000000'                                                   
Y67      DATA     X'67000000'                                                   
Y68      DATA     X'68000000'                                                   
Y69      DATA     X'69000000'                                                   
Y6F      DATA     X'6F000000'                                                   
Y82      DATA     X'82000000'                                                   
YBE      DATA     X'BE000000'                                                   
YA       DATA     X'A0000000'                                            0174000
YC       DATA     X'C0000000'                                                   
YD       DATA     X'D0000000'                                                   
YE       DATA     X'E0000000'                                                   
YF       DATA     X'F0000000'                                                   
*                                                                        0175000
*                                                                        0176000
*    TEXT CONSTANTS                                                      0177000
*                                                                        0178000
*                                                                        0179000
         DO       #PAX                                                          
MDL2310  DATA     '2310'            PAX LINE PRINTER                            
         FIN      #PAX                                                          
EODREC   TEXT     '!EOD'                                                        
MTWCMMD  MTW,0    0                 FOR FILLING IDLE INTERRUPTS                 
         DO       #MAP                                                          
XPSDCMMD XPSD,8   SPRPSD            FOR FILLING IDLE INTERRUPTS                 
         ELSE     #MAP                                                          
XPSDCMMD EQU      MTWCMMD                                                       
         FIN                        #MAP                                        
CALFLAG  DATA     LMICAL2           CAL2 CONNECTED FLAG                         
         DATA     LMICAL3           CAL3 CONNECTED                              
         DATA     LMICAL4           CAL4 CONNECTED                              
*                                                                               
CALCCB   DATA     0                 CCB ADDR, CAL2,3,4 LINKAGE                  
BALRBMSV BAL,R1   RBMSAVE                                                       
         BOUND    8                                                      0180000
CKXABT   DATA     5,3               DOUBLEWORD CONSTANT                         
L1015    DATA     X'10',X'15'                              /SIG7-5323/*C015732  
CAL234   DATA     X'FA'             DATA WORDS FOR PRIORITY/SIG7-1984/*C5732    
         DATA     X'FC'             TESTS FOR CALS 2,3,4   /SIG7-1984/*C5732    
494A4B   DATA     X'49'             DATA WORDS FOR LOCATION/SIG7-1984/*C5732    
         DATA     X'4B'             TESTS FOR CALS 2,3,4   /SIG7-1984/*C5732    
L5051    DATA     X'50'             DATA WORDS FOR LOCATION/SIG7-3559/*C5732    
         DATA     X'51'             TESTS/ POWER ON/OFF    /SIG7-3559/*C5732    
BLANKS   TEXT     '        '        A DOUBLEWORD OF BLANKS               0181000
ZEROS    DATA,8   0                 A DOUBLEWORD OF ZEROS                0182000
DIRECODE DATA     X'55555555'       H00 DIRECTORY SECTOR CODE WORDS             
         DATA     X'AAAAAAAA'                                                   
         BOUND    8                                                             
DATA1C1D DATA     X'1C',X'1D'       PFIL,PREC FPT CODES                         
         DO       #MTAPE                                                        
SKIPFILE DATA     FCFSFMTS,FCBSFMTS SFIL,PFIL,PREC CODES                        
SRECFB   DATA     FCBSRMT,FCFSRMT   SREC, FWD & BACK CODES                      
SRECFILE DATA     FCBSRMT,FCFSFMT   SREC,SFIL FUNC CODECODE                     
         FIN                                                                    
*                                                                               
*    PROGRAM STATUS DOUBLEWORDS                                          0183000
CAL1PSD  PSD      CAL1PROC,7                                                    
FGDPSD   PSD      0,K20             PSD USED BY FGL2       /SIG7-4986/*C015732  
IOPSD    PSD      IOINT                                                  0185000
DIOPSD   PSD      IOALT             ALTERNATE I/O LEVEL                         
CPPSD    PSD      CPINT             CONTROL PANEL INTERRUPT PSD                 
CLOCKPSD PSD      CLOCK                                                         
PONPSD   PSD      POWERON,7                                                     
POFFPSD  PSD      POWEROFF,7                                                    
SPRPSD   PSD      SPRINT                                                        
*                                                                               
CUPCOD1  EQU      Y01               CODE TO POST STATUS IN ONE CORE WORD        
CUPCOD2  EQU      Y02               CODE TO POST STATUS IN DCB                  
CUPCOD3  EQU      Y03               CODE TO BAL TO SUBROUTINE W/POST STATUS     
         DO1      #ECB                                                          
CUP3POST GEN,8,24 3,CALLPOST                                                    
CUPCOD4  EQU      Y04               CODE FOR NO END ACTION                      
*                                                                        0191000
*                                                                        0192000
         BOUND    8                                                             
TEMP     DATA,8   0                 TEMPORARY DOUBLEWORD                        
CPINT9   DATA,8   0                 TEMP STORAGE FOR C PANEL TASK               
CLOCKTMP RES      16                                                            
         DO       #TIMEOUT                                                      
CLOCKTCB DATA     0                 SAVE OF TCBPOINT IN CLOCK                   
CLOCKRTS DATA     0                 SAVE OF K:RTS IN CLOCK                      
         FIN      #TIMEOUT                                                      
CALREG   EQU      TEMP              TEMP SAVE AREA REGS CAL2,3,4                
*                                       ENTRY LINKAGE                           
JOB#     DATA     -1                JOB NR OF EXECUTING BKG JOB                 
         DO       #SYMB                                                         
JOBPRI   DATA     1                 PRIORITY OF RUNNING BKG JOB                 
         FIN      #SYMB                                                         
IOCLOCK  DATA     0                                                             
COUNTER4 DATA     15000             SET TO 30 SEC FOR PATCHING                  
CPINT11  DATA     0                 SAVE R11 CP INT LVL                         
EDT99    DATA     0                 EDT CREATION RE-ENT COUNT                   
RUN99    DATA     0                 REN-ENTRANCY COUNT, LMI                     
TASK99   DATA     0                 TASK RE-ENT COUNT                           
         DO       #ROLL                                                         
ROLL98   DATA     0                 ROLLOUT REENT COUNT                         
         FIN      #ROLL                                                         
         DO1      #MAP                                                          
PLSEG#   DATA     0                 PUB LIB SEGMENT NUMBER                      
RENT:SN  DATA     0                 SNAM RE-ENT COUNT                           
RENT:D   DATA     1                 DIRECTORY READ/WRITE RE-ENT COUNT           
SYMREENT DATA     0                 DIRECTORY RE-ENT COUNT(SYMBIONT)            
COUNT:D  DATA     0                 # OF TIMES DIR UPDATE REENTERED             
JOB99    DATA     0                 JOB RE-ENT COUNT                            
BINITFPT DATA     0                 POINTER TO BKG INIT FPT IN TSPCE            
*                                   STORAGE FOR SCHED PROCESSOR                 
SC:YEAR  DATA     0                 CLOCK CELL FOR YEAR                         
SC:DAY   DATA     0                 CLOCK CELL FOR DAY                          
SC:SEC   DATA     0                 CLOCK CELL FOR SECOND                       
SC:LIST  DATA     0                 CHAIN OF ACTIVITIES FOR SCHED               
SC:BBCW  DATA     0                 BLOCKING BUFFER CONTROL WORD                
SC:DCB   DATA     0                 POINTER FOR SCHED FILE DCB                  
SC:INIT  DATA     0                 POINTER FOR INIT FPT                        
*                                                                               
         DO       #MAP=0                                                        
FPSAV    DATA     0                 SAVE K:FPOOL VALUE DURING FMEM 0            
BPSAV    DATA     0                 SAVE K:BPOOL VALUE DURING CKPT              
         FIN      #MAP=0                                                        
*    TEMPORARY STORAGE                                                   0193000
         BOUND    8                                                      0194000
*                                                                        0196000
*                                                                        0197000
*     FLAGS                                                              0198000
CTFLAGS  DATA     0                                                      0199000
CTSIMIND DATA     0                 CONTROL TASK SIMULATION INDICATOR    0201000
CFFLAGS  DATA     0                                                             
*                                                                        0202000
*                                                                        0203000
CTIOSTK  STACKDW,1,1 IOSTK,10                                                   
IOSTK    RES      10                                                            
*                                                                               
* BUFFER SPACE FOR CONTROL TASK PROCESSES                                       
*                                                                               
IMAGE    RES      20                BUFFER FOR KEYIN MESSSAGE                   
FGLCSP   DATA     0                 FGL CONTROL SPACE POINTER                   
FGLBSP   DATA     0                 FGL BUFFER SPACE POINTER                    
FGLPUBL  DATA     0                 FGL PUBLIBS LMI INDEX LIST                  
         TITLE    'ASSEMBLY OPTION DATA FOR ANALYZE'                            
OPTIONS  RES      0                                                             
 GEN,1,1,1,1,1,1,1,1   #CFILES,#9TTAPE,#7TTAPE,#MTAPE,;                         
                        #CRASH,#VDUMP,#ERRORLOG,#CREAD                          
 GEN,1,1,1,1,1,1,1,1   #CPUNCH,#JOBACCT,#IOEX,#LPRINT,;                         
                        #PLOTTER,#RAD,#TBT,#DP7246                              
 GEN,1,1,1,1,1,1,1,1   #DP7270,#DP7275,#DP7261,#DP7266,;                        
                        #DISKPAK,#DISQING,#RADQING,#RUNQ                        
 GEN,1,1,1,1,1,1,1,1   #SIGMA9,#INSTSIM,#DUALFLG,#TIMEOUT,;                     
                        #CPRMAP,#ECB,#SIDEBUF,0                                 
         SYSTEM   CPREQU                                                        
         TITLE    'DISPATCHER AND TASK MANAGEMENT CONTROLS'                     
*                                                                               
*        DISPATCHER AND TASK MANAGEMENT CONTROLS                                
*                                                                               
TDRDLVL  DATA     0                 CURRENT RDL LEVEL BITS                      
TDRDLGP  DATA     0                 CURRENT RDL GROUP (TRIGGER)                 
TDTRIG   DATA     1                 SWITCH FOR SOFTWARE TRIGGER                 
*                                       OF DISPATCHER                           
TDLAST   DATA     0                 TASKID OF LAST TASK DISPATCHED              
*                                   (IF MAPPED)                                 
UTIMES   DATA     S:UTIME           USER INTERVALS PER SECOND,                  
*                                   INIT DIVIDES INTO 500 & STORES              
K:UTIME  DATA     0                 USER CLOCK                                  
UTIME    DATA     0                 INTERVAL COUNTER FOR PULSE                  
*                                                                               
*        PERMANENT TASK STCB'S                                                  
*                                                                               
         BOUND    8                 CONTROL TASK STCB                           
CTSTCB   DATA     0,0               ENTRY PSD IN IPL CODE                       
         DATA     CTSTCB+4,0        INTERMEDIATE PSD                            
         STM,R0   CTSTCB+10         SAVE REG                                    
         BAL,R1   RBMSAVE                                                       
         GEN,8,24 X'A0',0           PCBPOINT                                    
         GEN,8,24 CTID,CTSTCB       TCBPOINT                                    
         DATA     TDRDLRET,0        ENTRY PSD TO DISP                           
         RES      16                REGISTER SAVE AREA                          
         DATA     0,0,0,0,0,0       AST,ACI,RDL,-,APSD                          
*                                                                               
         DO       #MAP                                                          
CTRTS    RES      200+16*#ERRORLOG  CONTROL TASK TEMP STACK                     
         ELSE     #MAP                                                          
CTRTS    RES      150+16*#ERRORLOG                                              
         FIN      #MAP                                                          
*                                                                               
*                                                                               
         PAGE                                                                   
*   THE FOLLOWING TABLE IS USED TO DETERMINE IF                                 
*   A DEVICE IS A LINE PRINTER OR KEYBOARD PRINTER.                             
*                                                                               
*   TABLE IS INDEXED BY DEVICE TYPE (DCT4)                                      
*                                                                               
*   A VALUE OF 1 MEANS LISTING DEVICE.                                          
*                                                                               
T:LDEV   RES      0                                                             
         DATA,1   0           0     NO (IOEX)                                   
         DATA,1   1           1     TY                                          
         DATA,1   0           2     PR                                          
         DATA,1   0           3     PP                                          
         DATA,1   0           4     CR                                          
         DATA,1   0           5     CP                                          
         DATA,1   1           6     LP                                          
         DATA,1   0           7     DC                                          
         DATA,1   0           8     9T                                          
         DATA,1   0           9     7T                                          
         DATA,1   0          10     CP,LOW COST                                 
         DATA,1   1          11     LP,LOW COST                                 
         DATA,1   0          12     DP                                          
         DATA,1   0          13     PL                                          
         DATA,1   0          14                                                 
         DATA,1   1          15     LP,BDP                                      
         BOUND    4                                                             
         PAGE                                                                   
*  THE FOLLOWING TABLE IS USED TO DETERMINE IF                                  
*   A DEVICE IS A FIXED RECORD LENGTH DEVICE.                                   
*                                                                               
*  THE TABLE IS INDEXED BY DEVICE TYPE (DCT4).                                  
*                                                                               
*  A VALUE OF 1 MEANS FIXED RECORD LENGTH; 0 MEANS NOT.                         
*                                                                               
         DO       #MAP                                                          
T:FRLDEV RES      0                                                             
         DATA,1   0           0     NO (IOEX)                                   
         DATA,1   1           1     TY                                          
         DATA,1   0           2     PR                                          
         DATA,1   0           3     PP                                          
         DATA,1   1           4     CR                                          
         DATA,1   1           5     CP                                          
         DATA,1   1           6     LP                                          
         DATA,1   0           7     DC                                          
         DATA,1   0           8     9T                                          
         DATA,1   0           9     7T                                          
         DATA,1   1          10     CP,LOW COST                                 
         DATA,1   1          11     LP,LOW COST                                 
         DATA,1   0          12     DP                                          
         DATA,1   0          13     PL                                          
         DATA,1   0          14                                                 
         DATA,1   1          15     LP,BDP                                      
         DATA,1   0                 9T                                          
         BOUND    4                                                             
         FIN                                                                    
         PAGE                                                                   
         BOUND    8                                                             
JCBRBM   GEN,24,8     0,1           JOBID OF RBM JOB = 1                        
         GEN,16,16    0,0           BKG ONLY USE                                
         GEN,8,24     0,0           TRAP ADDRESS SECONDARY TASKS                
         GEN,8,24     0,0           TRAP ADDRESS PRIMARY TASKS                  
         GEN,8,24     16,OPLBS1     OPLB1 POINTER -BYTE 0 ALTERED BY INIT       
         GEN,8,24     16,OPLBS2     OPLB2 POINTER, BYTE 0 ALTERED BY INIT       
         DO       #MAP                                                          
         GEN,8,24 25,CPRBB          BBCW TABLE SIZE, ADDR OF BBCW TABLE         
         ELSE     #MAP                                                          
         DATA     0                                                             
         FIN      #MAP                                                          
         GEN,8,24     0,0           JPT POINTER                                 
         GEN,8,24     0,0           AET POINTER                                 
         GEN,8,24     0,0           EDT POINTER-HEAD                            
         GEN,8,24     0,0           EDT POINTER-TAIL                            
         DO       #MAP                                                          
         DATA     RBMSD                                                         
         ELSE     #MAP                                                          
         DATA     0                                                             
         FIN      #MAP                                                          
         DATA     0,0               DEBUG CONTROL WORDS                         
         DATA     0                 BREAK CONTROL WORD                          
         DATA     0                 TEX BLK. BUFF. ADR.                         
         DATA     0                 AREA ID FOR TASK INIT                       
         DATA     0                 TABS POINTER                                
SYSACNT  TEXT     #SYSACNT          DEFAULT SYSTEM ACCOUNT                      
         DATA     0,0,0             USER ID                                     
         DATA     0                 JOB TIME ACCOUNTING                         
         DO       #MAP                                                          
CPRBB    DATA     0                 BBCW TABLE WORD 0                           
        DO1       24                ZERO REST OF JCB SPACE                      
         DATA     0                                                             
         FIN      #MAP                                                          
CPRTIME  DATA     0                 SYSTEM OVERHEAD CHARGED HERE                
         PAGE                                                                   
         BOUND    8                                                             
JCBBKG   GEN,24,8     0,2           JOBID OF BKGD.= 2                           
         GEN,16,16     X'20',0       BKGD. MAX = 32 PAGES                       
         GEN,8,24     0,0                                                       
         GEN,8,24     0,0                                                       
         GEN,8,24     16,OPLBS1     BYTE 0 ALTERED BY INIT                      
         GEN,8,24     16,OPLBS3     BYTE 0 ALTERED BY INIT                      
         DO       #MAP                                                          
         GEN,8,24 25,BKGBB          BBCW TABLE SIZE, ADDR OF BBCW TABLE         
         ELSE     #MAP                                                          
         DATA     0                                                             
         FIN      #MAP                                                          
         GEN,8,24     0,0                                                       
         GEN,8,24     0,0                                                       
         GEN,8,24     0,0                                                       
         GEN,8,24     0,0                                                       
         DO       #MAP                                                          
         DATA     BKGSD                                                         
         ELSE     #MAP                                                          
         DATA     0                                                             
         FIN      #MAP                                                          
         DATA     0,0               DEBUG COUNTOL WORDS                         
         DATA     0                 BREAK CONTROL WORD                          
         DATA     0                 TEX BLK BUFF                                
         DATA     0                 AREA ID. FOR TASK INIT                      
         DATA     0                 TABS POINTER                                
         TEXT     #SYSACNT          DEFAULT SYSTEM ACCOUNT                      
         DATA     0,0,0             USER ID                                     
         DATA     0                 JOB TIME ACCOUNTING                         
         DO       #MAP                                                          
BKGBB    DATA     0                 BBCW TABLE WORD 0                           
         DO1      24                                                            
         DATA     0                 24 BB CONTROL WORDS                         
         FIN      #MAP                                                          
         PAGE                                                                   
         DO       #MAP                                                          
         BOUND    8                                                             
BKGSD    EQU      %                 SEG DESC FOR BKG                            
         DATA     BKGSD+16                                                      
         GEN,8,24 3+3*#SIGMA9M,X'1E000'                                         
         DATA     X'23309002',0                                                 
         DATA     X'01010100'       ACT,INAC,USER                               
         DATA,1   0,12,1,0                                                      
         DATA     -1                ACCESS CODES                                
         DO1      9                                                             
         DATA     0                                                             
         DO1      3+3*#SIGMA9M                                                  
         DATA     0                                                             
         BOUND    8                                                             
RBMSD    EQU      %                                                             
         DATA     RBMSD+16                                                      
         GEN,8,24 3+3*#SIGMA9M,X'1E000'                                         
         DATA     X'23309002',0                                                 
         DATA     X'01010100'       ACT,INAC,USER                               
         DATA,1   0,12,1,0                                                      
         DATA     -1                ACCESS CODES                                
         DO1      9                                                             
         DATA     0                                                             
         DO1      3+3*#SIGMA9M                                                  
         DATA     0                                                             
         FIN      #MAP                                                          
         PAGE                                                                   
**********************                                                   0351000
*   SYSTEM BUFFERS   *                                                   0352000
**********************                                                   0353000
*                                                                        0354000
CCBUF    RES      30                                                     0356000
***********************************                                      0356015
*   C DEVICE CONTROL PARAMETERS   *                                      0356020
***********************************                                      0356025
*                                                                        0356030
*                                                                        0356035
*                                                                        0356090
*                                                                        0356095
CFLAG    DATA     0                                                      0356110
*                                                                        0356115
         PAGE                                                                   
***************                                                                 
*   RBMSAVE   *                                                                 
***************                                                                 
*                                                                               
*                                                                               
*   THIS ROUTINE SAVES THE CONTEXT FOR CENTRALLY CONNECTED TASKS                
*                                                                               
*                                   ENTRY FOR CLOCK INT.                        
CLK1SAVE LW,R2    K:CLK1+1          REFURNISH CLOCK VALUE                       
         STW,R2   K:CLK1                                                        
         B        RBMSAVE                                                       
*                                   ALL  B  RBMSAVE  ARE MODIFIED BY            
*                                     THE RBM INIT. ROUTINE IF FB JOB           
*                                      ACCOUNTING WAS CHOSEN AT SYSGEN          
CLK2SAVE LW,R2    K:CLK2+1          REFURNISH CLOCK VALUE                       
         STW,R2   K:CLK2                                                        
         B        RBMSAVE                                                       
CLK3SAVE LW,R2    K:CLK3+1          REFURNISH CLOCK VALUE                       
         STW,R2   K:CLK3                                                        
*                                   ENTRY FOR NON CLOCK INT.                    
RBMSAVE  LD,R2    *R1               NEW PCB & TCB POINTERS                      
         AND,R2   RTCBTRIG          RESET END-ACTION TRIGGER FLAG               
         XW,R2    PCBPOINT                                                      
         XW,R3    TCBPOINT                                                      
         STD,R2   *R1               SAVE OLD POINTERS                           
         LB,R2    TCBPOINT          GET TASK INDEX                              
         LW,R3    K:RTS             GET OLD RTS                                 
         STW,R3   STIXRTS,R2        PRESERVE IT                                 
         LB,R2    STILMID,R2        GET LMI INDEX                               
         SLS,R2   1                 ADJUST FOR DBLWRD                           
         AI,R2    LMIRTS            ADD BASE OF STACK POINTERS                  
         STW,R2   K:RTS             SAVE FOR USE                                
         AI,R1    2                                                             
*                                                                               
         DO       #ONLINE                                                       
         LW,R0    0,R1              ENTER VIA BRANCH IF ON-LINE                 
         B        *R0                                                           
         ELSE                                                                   
         LPSD,8   *R1               ENTER TASK WITH NEW REGISTER BLOCK          
         FIN                                                                    
         PAGE                                                                   
***************                                                                 
*   RBMEXIT   *                                                                 
***************                                                                 
*                                                                               
*                                                                               
*   THIS ROUTINE EXITS FROM A CENTRALLY CONNECTED TASK, RESTORING               
*    THE CONTEXT OF THE INTERRUPTED TASK AND CLEARING THE INTERRUPT             
*                                                                               
RBMEXIT  DISABLE                    EXIT AND CLEAR LEVEL (M:EXIT)               
         STW,R1   TEMP              SAVE R1 IN THIS REG BLOCK                   
         LI,R1    0                 R1= EXIT 'TYPE' FLAG                        
         B        RBMEXITX                                                      
RBMEXITA DISABLE                    EXIT AND DONT CLEAR LEVEL (SCHED)           
         STW,R1   TEMP              SAVE R1                                     
         LI,R1    1                 R1= EXIT 'TYPE'                             
         B        RBMEXITX                                                      
RBMEXITD DISABLE                    EXIT AND DISARM (M:EXDA)                    
         STW,R1   TEMP              SAVE R1                                     
         LI,R1    2                 R1= EXIT 'TYPE'                             
RBMEXITX RES      0                                                             
         STW,R1   EXITTEMP          STORE EXIT 'TYPE'                           
         LW,R1    TEMP              RESTORE R1 IN CURRENT REG BLOCK             
         LRP      ZEROS             GET REG BLOCK ZERO POINTER                  
         LW,R1    TCBPOINT          POINTER TO TCB (NEW REG BLOCK)              
         LW,R3    7,R1              OLD TCB POINTER                             
         LW,R2    6,R1              OLD PCB POINTER                             
         CW,R2    XTCBTRDC          TEST FOR AN END-ACTION TRIGGER              
         BANZ     RBMEXITC              OR DISCONNECT                           
*                                   RE-ENTER TASK IF YES                        
RBMEXITB XW,R2    PCBPOINT              NONE, DO EXIT                           
         LB,R0    TCBPOINT          SAVE OLD TASK ID FOR RTS                    
         XW,R3    TCBPOINT                                                      
         STW,R2   6,R1              SAVE PCB POINTER                            
         STW,R3   7,R1              SAVE TCB POINTER                            
         LW,R2    R0                GET OLD TASK ID                             
         LW,R0    STIXRTS,R2        GET OLD RTS                                 
         STW,R0   K:RTS             RESTORE IT                                  
*                                                                               
         AND,R1   M17               EXTRACT TCB ADDRESS                         
         OR,R1    EXITLPSD                                                      
EXITSTR  LW,R2    EXITTEMP          GET FLAG                                    
         AND,R1   EXITMASK,R2       FIX LPSD                                    
         STW,R1   EXITTEMP                                                      
         LB,R2    TCBPOINT          GET STI INDEX                               
         LH,R2    STIOVID,R2        GET ACTIVE OVERLAY                          
         BEZ      EXITNOV           NONE ACTIVE                                 
         DO       #MAP                                                          
         BIFMAP   EXITOV1           B IF MAPPED                                 
         FIN      #MAP                                                          
         CW,R2    OMANOV            IS IT STILL ACTIVE                          
         BNE      EXITOV            NO                                          
         LB,R2    OMANTYC           GET COMPLETION                              
         CI,R2    1                 IS IT DONE NORMALLY                         
         BE       EXITNOV           ITS IN                                      
*                                                                               
         DO       #MAP                                                          
         B        EXITOV                                                        
*                                                                               
EXITOV1  LH,R2    OVIMA,R2          GET PAGE ADDRESS                            
         BEZ      EXITOV            NOT IN                                      
         DO       #SIGMA9M                                                      
         CH,R2    OMANPAGE                                                      
         ELSE     #SIGMA9M                                                      
         CB,R2    OMANPAGE                                                      
         FIN      #SIGMA9M                                                      
         BE       EXITNOV           STILL ACTIVE                                
         FIN      #MAP                                                          
*                                                                               
EXITOV   LW,R0    0,R1              PSD WORD 1                                  
         STW,R0   CAL1PSD                                                       
         LW,R0    1,R1              PSD WORD2                                   
         STW,R0   CAL1PSD+1                                                     
         LW,R0    OMANPSD                                                       
         STW,R0   0,R1              OMAN WORD 1                                 
         LW,R0    OMANPSD+1                                                     
         STW,R0   1,R1              OMAN WORD 2                                 
*                                                                               
EXITNOV  RES      0                                                             
*                                                                               
         LW,R0    2,R1              GET  INTERMEDIATE PSD WORD 0                
         LCF      R0                CC= # OF SAVED REGISTERS                    
         LM,R0    10,R1             RESTORE SAVED REGISTERS                     
EXITTEMP DATA     0                                                             
         DO       #ONLINE                                                       
EXITLPSD B        *0                ENTER PREV TASK BY BRANCH                   
         ELSE                           IF ON-LINE                              
EXITLPSD LPSD,X'B' 0                                                            
         FIN                                                                    
*                                                                               
EXITMASK DATA     X'FFB1FFFF'                                                   
         DATA     X'FF81FFFF'                                                   
         DATA     X'FFA1FFFF'                                                   
*                                                                               
SIMINT   AND,R2   RTCBTRIG          RESET THE END ACTION TRIGGER                
         STW,R2   6,R1              STORE BACK                                  
         AI,R1    8                 POINT PSD                                   
         DO       #ONLINE                                                       
         LW,R0    0,R1              RE-ENTER VIA BRANCH IF ON-LINE              
         B        *R0                                                           
         ELSE                                                                   
         LPSD,8   *R1               REENTER TASK                                
         FIN                                                                    
RBMEXITC CW,R2    XTCBTRIG          WAS IT A TRIGGER?                           
         BANZ     SIMINT                YES, SIMULATE ENTRY                     
         LB,R4    TCBPOINT              NO, DISCONNECT WHILE                    
         DO1      #MULTDSP                                                      
         XPSD,0   TMDQR                 ACTIVE, REMOVE FROM                     
         LI,R0    0                     DISP QUEUE, FREE STI                    
         STW,R0   STITCB,R4                                                     
         LW,R4    STIPRIO,R4            IS THE LOCATION NOW IN                  
         LB,R4    R4                    USE                                     
         LW,R5    X'4F',R4          GET PRIOR INTERRUPT INSTRUCTION             
         CW,R5    MTWCMMD                                                       
         BNE      RBMEXITE          B IF INTERRUPT IN USE NOW                   
         DO       #MAP                                                          
         LW,R5    XPSDCMMD                                                      
         STW,R5   X'4F',R4          SET TO REPORT SPURIOUS TRIGGERS             
         FIN      #MAP                                                          
         LI,R0    2                     NOT IN USE, EXIT DISARMED               
RBMEXITE STW,R0   EXITTEMP                                                      
         AND,R2   XTCBNDSC              RESET DISCONNECT                        
         B        RBMEXITB              AND CONTINUE WITH EXIT                  
         TITLE    'CLOCK'                                                       
*************                                                                   
*   CLOCK   *                                                                   
*************                                                                   
*                                                                               
*   THIS ROUTINE IS ENTERED EVERY 500 CLOCK PULSES         /SIG7-2202/*C5732    
*   ROUTINE INITIALIZES THE 500 CPS COUNTER & TESTS FOR END OF                  
*      5 SEC INTERVAL FOR I/O TIMEOUT                                           
*                                                                               
         DO       #TSLICE                                                       
CLOCK    EQU      %                                                             
         LCFI     3                 SAVE 3 REGISTERS                            
         STM,R0   CLOCKTMP                                                      
         DO       #SIGMA9>#550      IF SIGMA 9                                  
         LI,R0    0                                                             
         STW,R0   LASTPSD           CLEAR LOOKAHEAD PFI LOOP CHECK              
         FIN      #SIGMA9>#550                                                  
         LW,R0    TSTICK            TIME SLICE TICKS                            
         STW,R0   COUNTER4          SET COUNT PULSE LOCATION                    
         MTW,1    TTICKS            INCREMENT TOTAL TICKS                       
         LW,0     CLOCKPSD          WERE WE IN IDLE LOOP                        
         AND,0    X1FFFF                                                        
         CI,0     TDSTLIDL+2                                                    
         BNE      %+2                                                           
         MTW,1    TITICKS           YES                                         
         MTW,1    TITICKS+1                                                     
*                                                                               
         LB,R1    TCBPOINT          TASK ID                                     
         LB,R0    STISTAT,R1        TASK STATUS                                 
         CI,R0    STISLICE          INTERRUPTED TASK TIME-SLICED                
         BAZ      CLOCK001          B IF NO                                     
         MTB,1    STIQMAX,R1        UP MAX IN CORE TIME                         
         MTB,-1   STIQMIN,R1        HAS HE EXCEEDED HIS TIME QUANTUM            
         BNEZ     CLOCK001          B IF                                        
         LW,R2    TDRDLVL           TRIGGER THE CURRENT RDL                     
         WD,R2    *TDRDLGP          LEVEL TO RE-DISPATCH                        
         MTW,1    TDTRIG            SET SOFTWARE TRIGGER FLAG                   
*                                                                               
CLOCK001 EQU      %                                                             
         MTH,1    STITICK,R1        TIME ACCOUNTING                             
         MTW,-1   TS1SEC            CHECK FOR 1 SEC ELAPSED                     
         BEZ      CLOCK002          B IF YES                                    
         LCFI     3                 RESTORE REGISTERS                           
         B        CLOCKEX1          AND EXIT                                    
*                                                                               
CLOCK002 EQU      %                                                             
         LW,R0    TS1STICK          REFRESH TIME COUNTER                        
         STW,R0   TS1SEC                                                        
         LCFI     13                NUMBER OF REGISTERS                         
         STM,R3   CLOCKTMP+3        TO SAVE                                     
         ELSE     #TSLICE                                                       
CLOCK    EQU      %                                                             
         LCFI     0                 SAVE REGISTERS                              
         STM,R0   CLOCKTMP                                                      
         LI,R2    S:UTIME           RESET THE TIMER INTERVAL                    
         STW,R2   COUNTER4                                                      
         LB,R1    TCBPOINT                                                      
         MTH,1    STITICK,R1        TIME ACCOUNTING                             
         FIN      #TSLICE                                                       
         MTW,1    K:UTIME                                                       
*                                                                               
         DO       #TIMEOUT                                                      
CLOCK00  LW,R0    CTSTCB+STCBSTCB   SET TCBPOINT TO CONTROL                     
         XW,R0    TCBPOINT             TASK VALUE AN USE                        
         STW,R0   CLOCKTCB             THEIR TEMP STACK                         
         LI,R0    LMIRTS+(2*CTLMID)     FOR TIMEOUT                             
         XW,R0    K:RTS                                                         
         STW,R0   CLOCKRTS              SAVE OLD K:RTS VALUE                    
         LB,R5    STI#              GET NO. OF STI ENTRIES                      
CLOCK03  MTW,0    STITCB,R5         THIS ONE IN USE                             
         BEZ      CLOCK06           NO                                          
         LW,R0    STITIME,R5        IS THERE SOMETHING TO TIMEOUT               
         BEZ      CLOCK06           NO                                          
         SW,R0    K:UTIME           OVER THRESHOLD                              
         BGZ      CLOCK06           NO                                          
         BAL,R7   TMTIMOUT          GO CHECK ECBS                               
CLOCK06  BDR,R5   CLOCK03           DO NEXT                                     
         FIN      #TIMEOUT                                                      
FBACCNT1 BIFFGD   CLOCK01           DO BACKGROUND ACCTG                         
FBACCNT2 RES      0                                                             
         MTW,-1   K:LIMIT           DECREMENT BKGD LIMIT COUNTER                
         BNEZ     CLOCK01           B IF TIME NOT UP                            
         LW,R3    Y08               SET ABORT/EXIT                              
         STS,R3   K:CTST                                                        
         LI,R2    -1                                                            
         STW,R2   K:ABTLOC          SET FLAG                                    
         BAL,R11  CTRIG             TRIGGER CONTROL TASK                        
*                                                                               
CLOCK01  MTW,-1   UTIME             DECREMENT AND TEST 1 SECOND                 
         BNEZ     CLOCKEX           COUNTER THRESHOLD                           
         LW,R2    UTIMES            RESET THE  COUNTER TO THE NUMBER            
         STW,R2   UTIME             OF USER INTERVALS/SECOND                    
*                                                                               
         MTW,1    K:TIME            BUMP 1 SECOND COUNTER                       
*                                                                               
         LI,R8    0                                                             
         LW,R9    K:TIME                                                        
         DW,R8    X5                                                            
         CI,R8    0                 HAS 5 SECONDS ELAPSED                       
         BNEZ     CLOCKEX           NO, EXIT CLOCK ROUTINE                      
*                                   YES DO 5 SECOND EVENTS                      
         PAGE                                                                   
*                                                                               
* 5 SECOND EVENTS                                                               
*                                                                               
         MTW,1    IOCLOCK           BUMP I/O TIME-OUT COUNTER                   
*                                                                               
*  CHECK THE CURRENT DATE/TIME AGAINST NEXT-TIME-TO-RUN                         
*                                                                               
         LW,R8    SC:YEAR           SE IF ANYTHING'S SCHEDED                    
         BEZ      CLOCK015          NO                                          
         LW,R8    K:DATE1           DAYS IN YR/YEAR                             
         AND,R8   M16                                                           
         AI,R8    1900              WHOLE YEAR                                  
         CW,R8    SC:YEAR           HAS YEAR ARRIVED                            
         BG       CLOCK012          YES                                         
         BL       CLOCK015          NO                                          
         LW,R8    K:DATE2                                                       
         CW,R8    SC:DAY            HAS DAY ARRIVED                             
         BG       CLOCK012          YES                                         
         BL       CLOCK015          NO                                          
         LW,R8    K:TIME                                                        
         CW,R8    SC:SEC            HAS SECOND ARRIVED                          
         BL       CLOCK015          NO                                          
CLOCK012 RES      0                                                             
         LI,R3    BIT16                                                         
         STS,R3   K:CTST            SET TO RUN SCHED                            
         BAL,R11  CTRIG             RUN CTRL TASK                               
         PAGE                                                                   
*                                                                               
* CHECK ON COC                                                                  
*                                                                               
CLOCK015 RES      0                                                             
         DO       #LN                                                           
         LH,R8    DCT7              EXTENDED DCT SIZE                           
         SH,R8    DCT1              TRUE SIZE                                   
         BEZ      %+2                                                           
         BAL,R8   COCTIME           GO CHECK COC                                
         FIN      #LN                                                           
         PAGE                                                                   
*                                                                               
* CHECK ALL TRUE DEVICES FOR A TIME-OUT                                         
*                                                                               
         LH,R1    DCT7              NUMBER OF NON-COC DEVICES                   
         LW,R0    IOCLOCK           CURRENT CLOCK TIME                          
CLOCK01A RES      0                                                             
         LB,R2    DCT5,R1           GET SWITCHES                                
         CI,R2    (BIT0+BIT4+BIT5+BIT6)**-24 ANY VALID CLOCK TIMING             
         BAZ      CLOCK01B          NO                                          
*                                   YES                                         
         CW,R0    DCT11,R1          IS THIS DEVICE TIMED-OUT                    
         BL       CLOCK01B          NO                                          
*                                   MAYBE                                       
         LB,R2    DCT18,R1          GET TIME-OUT INCREMENT                      
         BEZ      CLOCK01B          NONE, DONT TIMEOUT                          
         CI,R2    255               255 IS ALSO A NULL TIMEOUT                  
         BE       CLOCK01B          DONT TIME-OUT                               
*                                   TIME-OUT AS OCCURED                         
         PSW,R1   CTIOSTK           SAVE DEVICE PTR                             
*                                                                               
         LI,R2    BIT26                                                         
         WD,R2    X'1700'           TRIP I/O INTERRUPT                          
CLOCK01B BDR,R1   CLOCK01A          LOOP THRU ALL I/O DEVICES                   
*                                                                               
         LW,R9    K:TIME                                                        
         LI,R8    0                                                             
         DW,R8    X6                                                            
         CI,R8    0                 HAS 30 SECONDS PASSED                       
         BNEZ     CLOCKEX           NO, EXIT CLOCK                              
*                                   YES, DO 30 SEC EVENTS                       
         PAGE                                                                   
*                                                                               
* 30 SECOND EVENTS                                                              
*                                                                               
         LW,R3    Y1                YES,TIME TO SERVICE ALL                     
         STS,R3   K:CTST            DEVICES                                     
         LI,R4    CTID              CONTROL TASKID                              
         BAL,R8   TMTRIG            TRIGGER ONLY DISP                           
         DO       #ERRORLOG                                                     
         MTW,0    LOGFLAG                                                       
         BEZ      CLOCK04           NO ERROR LOGGING                            
*                                   YES                                         
         LW,R3    K:TIME            GET TIME IN SECONDS                         
         LI,R2    0                                                             
         DW,R2    XD3600                                                        
         CI,R2    0                 IS THERE A REMAINDER                        
         BNEZ     CLOCKEX           YES, EXIT CLOCK ROUTINE                     
*                                   NO, DO HOURLY EVENTS                        
         PAGE                                                                   
*                                                                               
* HOURLY EVENTS                                                                 
*                                                                               
*                                   YES, LOG TIME STAMP                         
         LI,R7    BIT25                                                         
         STS,R7   K:CTST            FLAG FOR HOURLY LOGGING                     
         BAL,R11  CTRIG             TRIGGER CONTROL TASK                        
         DO       #550                                                          
         TRIPMFI,R11                POLL ALL MEMORY BANKS EVERY HOUR            
         FIN      #550=0                                                        
CLOCK04  RES      0                                                             
         FIN      #ERRORLOG                                                     
*                                                                               
         LW,R2    K:TIME            TIME OF DAY IN SECONDS                      
         CI,R2    86400                                                         
         BL       CLOCKEX           NOT, EXIT                                   
         PAGE                                                                   
*                                                                               
* DAILY EVENTS                                                                  
*                                                                               
         LI,R2    0                                                             
         STW,R2   K:TIME            YES, ZERO TIME OF DAY                       
         LW,R3    K:DATE2           DAY OF YEAR                                 
         AI,R3    1                 INCREMENT                                   
         STW,R3   K:DATE2                                                       
         CH,R3    K:DATE1           COMPARE TO MAX                              
         BLE      CLOCKEX           B IF NOT END OF YEAR                        
         LI,R3    1                                                             
         STW,R3   K:DATE2           INITIALIZE DAY OF YEAR                      
         MTW,1    K:DATE1           INCREMENT YEAR                              
         PAGE                                                                   
*                                                                               
* CLOCK EXIT                                                                    
*                                                                               
CLOCKEX  RES      0                                                             
         DO       #TIMEOUT                                                      
         LW,R0    CLOCKTCB          RESTORE TCBPOINT AND K:RTS                  
         STW,R0   TCBPOINT                                                      
         LW,R0    CLOCKRTS                                                      
         STW,R0   K:RTS                                                         
         FIN      #TIMEOUT                                                      
         LCFI     0                 RESTORE REGISTERS                           
CLOCKEX1 EQU      %                                                             
         LM,R0    CLOCKTMP                                                      
         LPSD,X'B'  CLOCKPSD                                                    
         TITLE    'DISPATCHER'                                                  
***********************************************************************         
*        RBM DISPATCHER                                                         
***********************************************************************         
*                                                                               
*        THE RBM DISPATCHER CONSISTS OF ONE CENTRALLY CONNECTED PRIMARY         
*        TASK WHICH OPERATES AT TWO INTERRUPT LEVELS.  'CENTRAL' CNX            
*        MEANS THAT ENTRY (TO THE HIGHER ONE) SAVES CONTEXT IN A TCB.           
*        FROM THAT POINT ON, BOTH LEVELS OR THE LOWER LEVEL ARE HIGH.           
*        SUBSEQUENT ENTRIES TO THE HIGHER LEVEL AS IT BECOMES ACTIVE            
*        ARE 'DIRECT', EITHER ABORTING THE ACTIVITY OF THE LOWER LEVEL,         
*        OR SAVING ITS CONTEXT IN A SECONDARY TASK CONTROL BLOCK.               
*        FINAL EXIT FROM THE PAIR OF LEVELS USES THE ORIGINAL TCB.              
*                                                                               
*        RBM DISPATCHER LEVEL CODE.- HIGHER OF INTERRUPT PAIR                   
*                                                                               
*                                   IDLE ENTRY                                  
TDRDL    LW,R2    PCBPOINT          SET R2=RDLI INDEX                           
         LH,R9    RDLILVL2,R2       IF STL INTERRUPT EXISTS, TRIGGER            
         BEZ      TDRDL0                ARM AND ENABLE STL                      
         LH,R1    RDLIGRP2,R2                                                   
         WD,R9    -X'500',R1            ARM AND ENABLE                          
         WD,R9    0,R1                  TRIGGER                                 
         B        TDRDL0            SET TO NOT IDLE MODE                        
*                                                                               
*                                   ENTRY BACK TO RDL FOLLOWING                 
*                                       DISPATCH OF A SECONDARY TASK            
*                                       ENTRY VIA RBMSAVE WHICH SAVES           
*                                       CONTEXT OF SECONDARY TASK IN            
*                                       HIS STCB.                               
TDRDLRET LB,R4    TCBPOINT          SET R4=STI OF LAST TASK                     
         LW,R2    PCBPOINT          INDEX TO DISP LEVEL                         
         LW,R0    RDLITCB,R2        TCB ADDRESS                                 
         STW,R0   TCBPOINT                                                      
         LI,R0    LMIRTS+(2*CTLMID)                                             
         STW,R0   K:RTS                                                         
         ENABLE                                                                 
         LB,R0    STISTAT,R4            RESET 'IN-EXECUTION'                    
         AND,R0   XSTINEXC                                                      
         STB,R0   STISTAT,R4                                                    
*                                       ZERO CURRENT TASK ID                    
         DO       #MULTDSP                                                      
         DO       #TSLICE                                                       
         LB,R1    STISTAT,R4        CHECK IF RETURNED TASK                      
         CI,R1    STISLICE          IS TIME-SLICED                              
         BAZ      TDRDLT2           B IF NO                                     
         CI,R1    STISTOP+STISUSP   CHECK IF STOPPED OR SUSPENDED               
         BANZ     TDRDLT0           B IF YES                                    
         LB,R1    STICOUNT,R4       CHECK FOR WAITED OPERATION                  
         BEZ      TDRDLT1           B IF NONE                                   
TDRDLT0  EQU      %                                                             
         LW,R1    QMIN              IF WAIT,STOP OR SUSPEND GIVE                
         STB,R1   STIQMIN,R4        THIS TASK ANOTHER TIME QUANTUM              
TDRDLT1  EQU      %                                                             
         LB,R1    STIQMIN,R4        CHECK IF LAST TIME-QUANTUM                  
         BNEZ     TDRDLT2           EXHUSTED IF SO THEN RE-QUEUE                
         LW,R1    STITCB,R4         TO BOTTOM OF DISPATCHER QUEUE               
         OR,R1    XSTICA            SET CHAIN-AFTER                             
         STW,R1   STITCB,R4                                                     
TDRDLT2  EQU      %                                                             
         FIN      #TSLICE                                                       
         LW,R0    STITCB,R4             IF CA IS SET, MOVE THE STI              
         CW,R0    XSTICA                TO THE END OF ITS PRIORITY              
         BAZ      TDRDLCHK              GROUP IN THE DISPATCHER QUEUE           
         XPSD,0   TMDQ                                                          
*                                                                               
TDRDLCHK LW,R0    STIPRIO,R4        IS TASK JUST 'RETURNED'                     
         LI,R1    X'FF'                 DISPATCHED AT THIS OR                   
         CS,R0    PCBPOINT              OR A LOWER DISPATCHER                   
         BLE      TDRDL0                LEVEL? IF YES, CONTINUE                 
         BAL,R8   TMTRIG                NO, TRIGGER THE HIGHER                  
*                                       LEVEL AND DISPATCH HIM                  
*                                       THERE.                                  
*                                   ENTRY TO RDL WHILE IN THE PROCESS O         
*                                   DISPATCHING                                 
*                                                                               
         FIN      #MULTDSP                                                      
TDRDL0   RES      0                                                             
TDRDL1   RES      0                                                             
         LI,R2    1                                                             
         LH,R1    RDLIADD,R2        GET ADDR OF DISPATCHER INTERRUPT            
         CI,R1    X'5D'             IS IT THE CONTROL PANEL                     
         BNE      TDRDL1A           NO, BRANCH                                  
         MTW,0    TDTRIG            IS SOFTWARE TRIGGER SET                     
         BNEZ     TDRDL1A           YES                                         
         BAL,R11  CTRIGA            GO SET CONTROL TASK UP                      
         LW,R1    Y04               SET KEYIN BIT                               
         STS,R1   K:CTST                                                        
TDRDL1A  RES      0                                                             
         LI,R0    0                 RESET THE SWITCH                            
         STW,R0   TDTRIG                                                        
         LW,R2    PCBPOINT          SET THE RDL INTERRUPT TO ABORT THE          
         LH,R1    RDLIADD,R2            STL ACTIVITY IN-PROCESS                 
         LW,R0    TDDISPX               WHICH WILL BE DISPATCHING               
         STW,R0   0,R1                                                          
*                                                                               
TDRDL7   RES      0                                                             
         LW,R1    XBIT3             30 SEC TIMER BIT                            
         CW,R1    K:CTST            IS 30 SEC I/O SERVICE NEEDED                
         BAZ      TDRDL7A           NO                                          
         LI,R0    0                                                             
         STS,R0   K:CTST                                                        
         LH,R1    DCT7              DO CALLS ON SERDEV                          
TDRDL7B  OR,R1    YFF               MASK OFF DEVICE                             
         PUSH     R1                SAVE R1                                     
         BAL,R2   SERDEV                                                        
         PULL     R1                RESTORE R1                                  
         AND,R1   M8                MASK DEVICE                                 
         BDR,R1   TDRDL7B           NEXT ONE                                    
TDRDL7A  RES      0                                                             
         DISABLE                                                                
         LI,R0    X'7FFF'           MASK                                        
         CW,R0    CTIOSTK+1         IS THERE ANY DEFERED I/O TO DO              
         BAZ      TDRDLX            PRIOR TO SCHEDULING                         
*                                                                               
         PLW,R1   CTIOSTK           GET DCT INDEX                               
         ENABLE                         DUMMY PRIORITY OF BACKGROUND            
         OR,R1    YFF                                                           
*                                       TO FORCE I/O TO DO CLEANUP AND          
         BAL,R2   SERDEV                INITIATIONS                             
         B        TDRDL7A           LOOP TILL STACK EMPTY                       
*                                                                               
TDRDLX   LPSD,3   TDSTL+2               OV IN DISP CONTEXT                      
         SPACE    5                                                             
*                                                                               
*        SECONDARY TASK LEVEL DISPATCHER - LOWER INTERRUPT LEVEL                
*                                                                               
TDSTL    PSD      TDSTL1            DIRECT CONNECTION- OLD PSD IS               
*                                       DISCARDED.                              
*                                                                               
TDSTL1   LW,R3    PCBPOINT                                                      
         AND,R3   M8                    R3=RDLI INDEX                           
*                                                                               
         LH,R0    RDLILVL1,R3       SETUP RDL LEVEL AND GROUP CODES             
         STW,R0   TDRDLVL               TO THE CURRENT LEVEL                    
         LH,R0    RDLIGRP1,R3                                                   
         STW,R0   TDRDLGP                                                       
         DO       #MULTDSP                                                      
TDSTL2   LB,R4    RDLISTI,R3        GET SUB-HEAD OF DISPATCHER CHAIN.           
*                                       BEGINS WITH SECONDARY TASKS TO          
*                                       BE DISPATCHED AT THE RDL/STL,           
*                                       FOLLOWED BY PRIMARY TASKS               
*                                       EXECUTING BETWEEN THIS RDL/STL,         
*                                       AND THEN INTO SECONDARY TASKS           
*                                       AT THE NEXT RDL/STL                     
TDSTL3   BEZ      TDSTLIDL          NEXT TASK ID = 0 IS THE END OF THE          
*                                       DISPATCHER QUEUE, DO IDLE               
*                                       HOUSEKEEPING                            
         LW,R0    STIPRIO,R4        IF THE NEXT ENTRY IS CONTROLLED             
         AND,R0   M8                    BY THIS DISPATCHER LEVEL                
         CW,R0    R3                    BYTE 3 OF STIPRIO WILL HAVE             
*                                       THE RDLI INDEX IN R3                    
         BNE      TDSTLX                IF NOT, EXIT TO THE NEXT                
*                                       LEVEL TO CONTINUE.                      
         ELSE     #MULTDSP                                                      
TDSTL2   LI,R4    1                 SEARCH FOR NEXT                             
TDSTL3   CB,R4    STI#              HAVE ALL STI ENTRIES CKD                    
         BG       TDSTLX            YES                                         
         FIN      #MULTDSP                                                      
*                                                                               
TDSTL3A  RES      0                                                             
         LW,R0    STITCB,R4         IS IT VALID TASK                            
         BEZ      TDSTLNXT          NO                                          
         LB,R0    STISTAT,R4        TEST THE SECONDARY TASK STATE TO            
*                                       SEE IF IT IS ELIGIBLE FOR EXEC.         
         BEZ      TDSTL4                STATUS=00, NO NON-ECB ROADBLOCK         
*                                       IN EFFECT,                              
*                                       STATUS#00, ROADBLOCKED                  
         CI,R0    STISTOP+STISUSP   IS STOP OR SUSPEND SET                      
         DO       #TSLICE                                                       
         BANZ     TDSTL3D           B IS YES - CHECK FOR START                  
         CI,R0    STIROLLD+STIPRIM+STIINIT     NOW CHECK FOR OTHER              
*                                              TYPE OF ROADBLOCK                
         BANZ     TDSTLNXT          B IF YES - SKIP                             
         CI,R0    STISLICE          TIME SLICED                                 
         BAZ      TDSTLNXT          B IF NO                                     
         DO       #SWAP                                                         
         CI,R0    STISWAP           IS HE ON SWAP-IN QUEUE                      
         BANZ     TDSTL3Z           B IF YES TO CHECK FOR TIME                  
         LB,R0    STIQMAX,R4        MAX TIME IN CORE UP                         
         CW,R0    QMAX              IF YES CHECK FOR TASK TO                    
         BL       TDSTL3B           SWAP IN -- B IF NOT TIME YET                
         CW,R4    TDSWAPX           IS THIS THE LAST TASK TO BE                 
         BE       TDSTL3B           CHECKED FOR SWAP IF SO THEN                 
         STW,R4   TDSWAPX           REDISPATCH IF NOT CHECK FOR SWAP            
         DISABLE                                                                
         BAL,R8   MMSWAP            CHECK SWAP CONDITIONS                       
         B        TDSTL3B           NO SWAP YET                                 
         B        TDSTLIDL          WAIT TO GET GOING                           
TDSTL3Z  EQU      %                                                             
         LB,R1    STILMID,R4        GET SWAPPED TASKS LMID                      
         LW,R1    LMISECB,R1        AND HIS FIRST S-ECB                         
         BEZ      TDSTLNXT          STILL BEING CREATED-SKIP IT                 
         LW,R0    ECBCTL,R1         SEE IF THIS IS THE MM ECB                   
         CI,R0    ECBTMM            IF SO THEN CHECK FOR SWAP IN                
         BNE      TDSTLNXT          B IF NOT MM TYPE-STILL IN CREATION          
         LW,R0    ECBTIME,R1        NOW SEE IF TIME TO BRING HIM IN             
         BEZ      TDSTLNXT          B IF STILL IN CREATION PHASE                
         CW,R0    TTICKS            IS IT TIME TO BRING HIM IN                  
         BG       TDSTLNXT          NOT TIME YET - KEEP GOING                   
TDSTL3Z1 EQU      %                                                             
         DISABLE                                                                
         BAL,R8   MMRILW            SET HIM UP TO COME IN                       
         ENABLE                                                                 
         B        TDSTL1            RESCAN                                      
*                                                                               
TDSWAPX  DATA     %                 CONTAINS LAST TASK CHECKED FOR SWAP         
         FIN      #SWAP                                                         
*                                                                               
TDSTL3B  EQU      %                                                             
         ENABLE                                                                 
         LB,R0    STIQMIN,R4        WAS LAST QUANTUM EXHUSTED                   
         BNEZ     TDSTL4            B IF NO                                     
         LW,R0    QMIN              CURRENT QUANTUM VALUE                       
         STB,R0   STIQMIN,R4        SET NEW QUANTUM TIME                        
         B        TDSTL4                                                        
         ELSE     #TSLICE                                                       
         BAZ      TDSTLNXT          B IF NO - HE IS ROADBLOCKED                 
         FIN      #TSLICE                                                       
TDSTL3D  EQU      %                                                             
         DISABLE                    START OVERRIDE STOP LOGIC                   
         LW,R12   STIPRIO,R4            IS START SET?                           
         CI,R12   STISTRT                                                       
         BAZ      TDSTLNXT              NOT SET, LEAVE STOP IN EFFECT           
         EOR,R12  XSTISTRT              START IS SET, FIRST RESET               
         STW,R12  STIPRIO,R4            START                                   
         AND,R0   XSTINSTP              RESET STOP                              
         AND,R0   XSTINSUS          REMOVE SUSPENDED STATE                      
         STB,R0   STISTAT,R4                                                    
*                                                                               
         LW,R0    STITCB,R4                                                     
         AND,R0   XSTINLW                                                       
         STW,R0   STITCB,R4         RESET LONG WAIT BIT                         
         ENABLE                                                                 
         B        TDSTL3A           STILL NON ZERO, NEXT TASK                   
TDSTL4   LB,R0    STICOUNT,R4       IS THE SECONDARY TASK IN AN ECB-            
         BEZ      TDSTLGO               ROADBLOCKED STATE,  NO                  
*                                                                               
TDSTLNXT RES      0                                                             
         ENABLE                                                                 
         DO       #MULTDSP                                                      
         LB,R4    STIDNXT,R4        ADVANCE TO THE NEXT TASK IN THE             
         ELSE     #MULTDSP                                                      
         AI,R4    1                 NEXT TASK                                   
         FIN      #MULTDSP                                                      
         B        TDSTL3                DISPATCHER QUEUE, THIS TASK IS          
*                                       NOT DISPATCHABLE                        
*                                                                               
*                                                                               
TDSTLIDL ENABLE                     LOOP ON IDLE                                
         WAIT                       WAIT FOR AN INTERRUPT                       
         DO       #SIGMA9>#550      IF SIGMA 9                                  
         LI,R0    0                                                             
         STW,R0   LASTPSD           CLEAR LOOKAHEAD PFI LOOP CHECK              
         FIN      #SIGMA9>#550                                                  
         B        TDSTLIDL                                                      
*                                                                               
TDSTLGO  EQU      %                 DISPATCH A SECONDARY TASK                   
*                                       BYTE 0 OF TCBPOINT = TASK ID            
*                                       OF TASK BEING DISPATCHED,               
*                                       CONTROLS PRIORITY AT PROPER             
*                                       LEVEL.                                  
         DO       #MAP                                                          
         LW,R1    STITCB,R4         IF THE TASK USES THE MAP,                   
         LW,R0    STCBPCB,R1            LOAD THE HARDWARE                       
         CW,R0    XSTCBMAP              MAP AND ACI                             
         BAZ      TDSTL10                                                       
         BAL,R8   TDLOAD            CALL DISPATCHER ENTRY TO MAP                
*                                       LOADING SUBR, R4=TASK ID                
         B        TDSTLNXT           +1 DISPATCH ABORTED DUE TO                 
         FIN                            TRANSIENT STATES IN A SEGMENT           
*                                    +2 MAP/ACT LOADING COMPLETE                
*                                       R3 STILL = RDLI INDEX                   
*                                       R4 STILL = TASK ID                      
         LW,R1    STITCB,R4         ENTER THE TASK VIA RBMEXIT                  
TDSTL10  AND,R1   M17                   R1= THE TCB (STCB) TO LOAD              
         DISABLE                    IF THE ALTERNATE PSD FLAG                   
         LW,R0    STIPRIO,R4            IS SET, SWAP THE PSDS                   
         CW,R0    XSTIALT               AND RESET THE FLAG                      
         BAZ      TDSTLA                NOT SET                                 
         EOR,R0   XSTIALT                                                       
         STW,R0   STIPRIO,R4                                                    
         LI,R2    STCBAPSD                                                      
         LD,R6    *R1,R2                                                        
         XW,R6    0,R1                                                          
         XW,R7    1,R1                                                          
         STD,R6   *R1,R2                                                        
*                                                                               
TDSTLA   ENABLE                                                                 
*                                                                               
         AW,R1    Y0F               CONVERT R1 TO AN XPSD COMMAND               
         LH,R2    RDLIADD,R3            R2 = RDL INTERRUPT LOCATION             
         LW,R3    R1                SET UP TCBPOINT IN R3                       
         STB,R4   R3                    TASK ID, TCB ADDRESS                    
         LB,R0    STISTAT,R4        SET THE 'IN-EXECUTION' BIT                  
         OR,R0    XSTIEXEC                                                      
         LI,R8    0                                                             
         LB,R7    STIJID,R4         JOB ID                                      
         LW,R7    SJI1,R7           JCB ADDRESS                                 
         AI,R7    JCBTIME           OFFSET TO TIME ACCUMULATOR                  
         CI,R4    MAXSYSID          IS TASK A SYSTEM TASK ?                     
         BG       TDSTLB            B IF NOT SYSTEM TASK                        
         LI,R7    CPRTIME           CHARGE TO CPR OVERHEAD                      
TDSTLB   EQU      %                                                             
         DISABLE                                                                
         STB,R0   STISTAT,R4                                                    
         DO       #TSLICE                                                       
         LW,R5    TSTICK                                                        
         SLS,R5   1                 TIMES TWO MILLISECS PER PULSE               
         ELSE     #TSLICE                                                       
         LI,R5    1000              FOR 1 SEC TICKS                             
         FIN      #TSLICE                                                       
         MH,R5    STITICK,R4        YEILDS MILLISECONDS                         
         AWM,R5   0,R7              ACCUMULATE CPU TIME                         
         STH,R8   STITICK,R4        RESET TIME ACCUMULATOR                      
         STW,R3   TCBPOINT          ALTER TCBPOINT                              
         OR,R1    Y008              SET BIT TO CHANGE REG POINTERS              
         STW,R1   0,R2                  ALTER THE XPSD FOR RDL TO               
*                                       SAVE INTO STCB                          
         B        RBMEXITA          EXIT VIA A SPECIAL RBM EXIT,                
*                                                                               
*                                   EXIT FROM PAIR OF DISPATCHER LEVELS         
*                                                                               
TDSTLX   RES      0                                                             
         DO       #MULTDSP                                                      
         CH,R3    RDLILVL1          IS THE NEXT LEVEL NON-EXISTANT?             
         BE       TDERROR               YES, QUEUE ERROR                        
         LW,R4    RDLITCB,R3        MODIFY THE XPSD IN THE INTERRUPT            
         LW,R5    R4                                                            
         LI,R0    X'0F'             CREATE AN XPSD                              
         STB,R0   R4                                                            
         OR,R4    Y008              RESTORE REGISTER POINTERS                   
         LH,R2    RDLIADD,R3        R5=TCBPOINT FOR EXIT, R2=                   
*                                   RDL INTERRUPT LOCATION.                     
         LH,R9    RDLILVL2,R3       DISABLE THE STL LEVEL FOR SAFETY            
         LH,R1    RDLIGRP2,R3                                                   
         DISABLE                                                                
         WD,R9    -X'0200',R1                                                   
         AI,R3    1                                                             
         LH,R9    RDLILVL1,R3       TRIGGER THE UPPER LEVEL OF THE              
         LH,R1    RDLIGRP1,R3       NEXT LOWER DISPATCHER PAIR                  
         WD,R9    0,R1                                                          
         LI,R1    1                 SET THE SOFTWARE TRIGGERED                  
         STS,R1   TDTRIG                SWITCH                                  
         OR,R4    Y008              SET BIT TO CHANGE REG. POINTERS             
         STW,R4   0,R2                  SET XPSD                                
         STW,R5   TCBPOINT          TCBPOINT TO TCB IN WHICH CONTEXT            
         B        RBMEXITD              OF LOWER PRIORITY TASK                  
*                                       WAS  SAVED, EXIT DISARMED               
*                                                                               
TDERROR  CRASH    'DISPATCHER QUEUE ERROR'                                      
         ELSE     #MULTDSP                                                      
         LH,R0    RDLILVL2,R3       NULL LEVEL                                  
         BEZ      TDSTLIDL          YES IDLE                                    
         LPSD,3   DISPONE           NO CLEAR                                    
         BOUND    8                                                             
DISPONE  DATA     0,TDSTLIDL                                                    
         FIN      #MULTDSP                                                      
*        XPSD'S AND PSD DOUBLEWORD CONSTANTS USED BY THE DISPATCHER             
*                                                                               
TDDISPX  XPSD,0   TDDISPP           XPSD WHEN DISPACTHING                       
TDDISPP  PSD      TDRDL0            ABORTS STL ACTIVITY                         
         DO       #TSLICE                                                       
         TITLE    'TIME SLICING CONSTANTS'                                      
*                                                                               
*                                                                               
SLICE    EQU      50                1 SEC IS DIVIDED INTO SLICE PERIODS         
*                                                                               
TICKS    EQU      (1000/SLICE)/2    #TICKS IN SLICE                             
PERIOD   EQU      1000/SLICE        PERIOD IN MILLISECONDS                      
*                                                                               
*                                                                               
TSTICK   DATA     TICKS             NUMBER OF 2 MS TICKS BEFOR                  
*                                   CLOCK ROUTINE IS ENTERED                    
*                                   INITIALLY SET TO 25 --                      
*                                   =50 MS PERIOD                               
*                                                                               
TS1SEC   DATA     SLICE             NUMBER OF SLICE PERIODS FOR 1 SEC           
*                                   THIS CELL IS COUNTED DOWN BY CLOCK          
*                                                                               
TS1STICK DATA     SLICE             REFRESH VALUE FOR TS1SEC                    
*                                                                               
*                                                                               
TTICKS   DATA     0                 TOTAL TICKS SINCE SYSTEM BOOT               
TITICKS  DATA     0                 TOTAL IDLE TICKS SINCE BOOT                 
         DATA     0                 TOTAL TICKS SINCE BOOT                      
*                                                                               
*                                                                               
*        THE FOLLOWING ARE CONTRO PARAMETERS USED TO COMPUTE                    
*                 THE TIME QUANTUM QMIN,QSWAP,QMAX                              
*                                                                               
*                                                                               
QUANTA   EQU      100               MILLISECONDS                                
*                                                                               
QUANTUM  DATA     QUANTA            TIME QUANTUM IN MS                          
QMIN     DATA     QUANTA/PERIOD     VALUE IN TIME TICKS                         
QSWAP    DATA     (3*QUANTA+PERIOD)/PERIOD    IN TIME TICKS                     
QMAX     DATA     (5*QUANTA+PERIOD)/PERIOD    IN TIME TICKS                     
*                                                                               
*                                                                               
         FIN      #TSLICE                                                       
         TITLE    'TASK MANAGEMENT SUBR - REQUEUE TASK      TMDQ'               
         DO       #MULTDSP                                                      
******************                                                              
*     TMDQ       *       SUBROUTINE TO ALTER THE POSITION OF A SECONDAR         
******************            TASK IN THE DISPATCHER QUEUE                      
*                                                                               
* ENTRY: R1       TASK TO BE MOVED                                              
*        XPSD,0   TMDQ                                                          
* EXIT:  +1       ENABLED OR DISABLED AS AT ENTRY,                              
*        R0       RDLI LEVEL CORRESPONDING TO TASK (R1)                         
* REGISTERS USED: R0,R1,R9-R10                                                  
*           SAVED:R2-R8,R11-R15                                                 
* STACK WORDS: NONE                                                             
* SUBROUTINES CALLED- NONE                                                      
* NOTES:  EXECUTES DISABLED, TRAPS CAUSE MONCRASH                               
TMDQ     PSD      TMDQ1,7                                                       
TMDQTMP  EQU      TEMP              R2-R3 SAVE AREA                             
TMDQ1    STD,R2   TMDQTMP           SAVE R2-R3                                  
         LW,R0    STIPRIO,R4        SEE IF A REQUEUE CAN CHANGE                 
         LW,R1    XSTIPR                THE STI WRT ITS                         
         LB,R2    STIRNXT,R4                                                    
         LB,R3    STIDNXT,R4            NEIGHBORS                               
         CS,R0    STIPRIO,R3                                                    
         BGE      TMDQ2                 YES, DO THE REQUEUE                     
         CS,R0    STIPRIO,R2                                                    
         BLE      TMDQ2                 YES, DO REQUEUE                         
         LI,R2    0                     RESET CHAIN AFTER                       
         LW,R3    XSTICA                                                        
         STS,R2   STITCB,R4                                                     
         LD,R2    TMDQTMP           RESTORE REGS AND EXIT                       
         LPSD,0   TMDQ                                                          
TMDQ2    LD,R2    TMDQTMP                                                       
         XPSD,0   TMDQR                 DELINK                                  
         XPSD,0   TMDQA                 RELINK                                  
         LPSD,0   TMDQ              EXIT                                        
         TITLE    'TASK MANAGEMENT SUBR - REMOVE A TASK FROM DQ. TMDQR'         
******************                                                              
*    TMDQR       *       SUBROUTINE TO REMOVE A TASK FROM THE DISPATCH/         
******************            ROLL-OUT CHAINS                                   
*                                                                               
* ENTRY: R4       TASK ID                                                       
*        XPSD,0   TMDQR                                                         
* EXIT   +1       ENABLED/DISABLED = MODE OF CALLER,                            
*                                                                               
* REGISTERS USED: NONE                                                          
*           SAVED: R0-R15                                                       
* STACK SPACE: NONE                                                             
* SUBROUTINES: NONE                                                             
* NOTES: EXECUTES DISABLED, TRAPS CAUSE MONCRASH                                
*                                                                               
TMDQR    PSD      TMDQR0,7                                                      
TMDQR0   STD,R2   TMDQTMP           SAVE R2 AND R3                              
         LB,R2    STIRNXT,R4        GET NEXT AND PREV MEMBERS AND CHAIN         
         LB,R3    STIDNXT,R4            THEM TO EACH OTHER VS VIA R4            
         STB,R3   STIDNXT,R2            TASK.                                   
         STB,R2   STIRNXT,R3                                                    
*                                                                               
         LH,R2    RDLILVL1          SEARCH RDLI FOR REMOVED TASK AS             
*                                       SUB-CHAIN HEAD AND SET HEAD TO          
TMDQR1   CB,R4    RDLISTI,R2            NEXT TASK IN CHAIN                      
         BNE      %+2                                                           
         STB,R3   RDLISTI,R2                                                    
         BDR,R2   TMDQR1                                                        
         CB,R4    RDLISTI               DO ZEROTH ENTRY                         
         BNE      %+2                                                           
         STB,R3   RDLISTI                                                       
         LD,R2    TMDQTMP           RESTORE R2 AND R3 AND                       
         MTW,1    TASK99                                                        
         LPSD,0   TMDQR                 EXIT                                    
         TITLE    'TASK MANAGEMENT SUBR - ADD A TASK TO DQ. TMDQA'              
******************                                                              
*    TMDQA       *       SUBROUTINE TO ADD A TASK TO THE DISPATCHER AND         
******************            ROLL-OUT QUEUES                                   
*                                                                               
* ENTRY: R4       TASK ID                                                       
*        XPSD,0   TMDQA                                                         
* EXITS: +1       ENABLED/DISABLED = MODE OF CALLER                             
*                                                                               
* REGISTERS USED: R0,R1,R9                                                      
*           SAVED: R2-R8,R10-R15                                                
* STACK WORDS: NONE                                                             
* SUBROUTINES: NONE                                                             
* NOTES: EXECUTES DISABLED, TRAPS CAUSE MONCRASH                                
*                                                                               
*                                                                               
TMDQA    PSD      TMDQA0,7                                                      
*                                                                               
TMDQA0   STD,R2   TMDQTMP           SAVE R2-R3                                  
         DO1      #TSLICE                                                       
         STW,R6   TMDQR6            SAVE R6                                     
         LH,R2    RDLILVL1          SEARCH RDLI FOR ENTRY WHICH CORRES-         
         LW,R0    STIPRIO,R4            PONDS TO TASK BEING ADDED.              
         LB,R9    R0                    R2=RDLI INDEX FOR TASK                  
         CB,R9    RDLIPRIO,R2       IF GTR OR = PRIO, LEVEL FOUND.              
         BGE      TMDQA7                LESS CONTINUE SEARCH                    
         BDR,R2   %-2                                                           
         LB,R9    STISTAT,R4        IN ZEROTH ENTRY                             
         CI,R9    STIPRIM               OK FOR PRIMARY BUT IF SECONDARY         
         BANZ     TMDQA1                FORCE INTO FIRST (HIGHEST) RDL          
         AI,R2    1                     LEVEL.                                  
         LB,R9    RDLIPRIO,R2           GET RDL HARDWARE BYTE                   
         STB,R9   R0                    FORCE NEW TASK TO RDL LEVEL             
TMDQA05  LW,R3    STITCB,R4             NOW SET RDLLVL AND RDLGRP INTO          
         LH,R9    RDLILVL1,R2           STCBRDL                                 
         LH,R1    RDLIGRP1,R2                                                   
         STH,R1   R9                                                            
         STW,R9   STCBRDL,R3                                                    
TMDQA1   LI,R1    3                 SET THE RDLI INDEX IN THE                   
         STB,R2   R0,R1                STI TO THE RDL LEVEL UNDER               
         STW,R0   STIPRIO,R4            WHICH THE TASK IS CONTROLLED            
*                                                                               
         LW,R1    XSTIPR            R1 =PRIORITY MASK                           
         LW,R9    STITCB,R4         R9=CHAIN  AFTER FLAG                        
         LB,R3    RDLISTI,R2        R3=SUB-CHAIN HEAD                           
TMDQA2   BEZ      TMDQA4                                                        
         CS,R0    STIPRIO,R3        PRIORITY:NEXT MEMBER IN CHAIN               
         BG       TMDQA3                GREATER-SEARCH ON                       
         BL       TMDQA4                LESS-INSERT HERE                        
         CW,R9    XSTICA            EQUAL-TEST CHAIN AFTER                      
         DO       #TSLICE                                                       
         BANZ     TMDQA8            B IF CA IS ON                               
         LB,R6    STISTAT,R3                                                    
         CI,R6    STISLICE          IS NEXT TASK IN QUEUE TIME SLICED           
         BANZ     TMDQA4            B IF YES - QUEUE HERE                       
TMDQA2A  EQU      %                                                             
         LB,R6    STISTAT,R4        IS SUBJECT TASK TIME-SLICED, IF YES         
         CI,R6    STISLICE          THEN KEEP GOING TO FIND NEXT                
         BAZ      TMDQA4            TIME-SLICED TASK - B IF NOT TS              
         ELSE     #TSLICE                                                       
         BAZ      TMDQA4            IF NOT CA THEN QUEUE HERE                   
         FIN      #TSLICE                                                       
TMDQA3   LB,R3    STIDNXT,R3        SET R3=NEXT TASK ID                         
         B        TMDQA2                                                        
*                                                                               
TMDQA4   LB,R1    STIRNXT,R3        SET R1=PREVIOUS TASK                        
         STB,R4   STIDNXT,R1        CHAIN PREV (R1) TO CURRENT (R4) AND         
         STB,R3   STIDNXT,R4            ONTO NEXT (R3) IN D-CHAIN               
         STB,R4   STIRNXT,R3        REVERSE IN R-CHAIN (R3 TO R4 TO R1)         
         STB,R1   STIRNXT,R4                                                    
*                                                                               
         AND,R9   XSTINCA           RESET CHAIN AFTER                           
         STW,R9   STITCB,R4                                                     
*                                   LOOK FOR NEW RDLI CHAIN HEADS               
TMDQA5   CB,R3    RDLISTI,R2        IS NEXT TASK = CHAIN HEAD?                  
         BNE      TMDQA6                NO                                      
         STB,R4   RDLISTI,R2            YES-STORE NEW TASK AND KEEP             
         BDR,R2   TMDQA5                SEARCHING FOR,PREV NULL SUB-            
         CB,R3    RDLISTI               CHAINS, DO ZEROTH ENTRY                 
         BNE      TMDQA6                                                        
         STB,R4   RDLISTI                                                       
TMDQA6   LD,R2    TMDQTMP           RESTORE R2 AND R3                           
         DO1      #TSLICE                                                       
         LW,R6    TMDQR6            RESTORE R6                                  
         MTW,1    TASK99                                                        
         LPSD,0   TMDQA             EXIT                                        
TMDQA7   LCF      STISTAT,R4                                                    
         BCS,8    TMDQA1                                                        
         B        TMDQA05                                                       
         DO       #TSLICE                                                       
TMDQA8   EQU      %                                                             
         LB,R6    STISTAT,R3        CHECK IF NEXT TASK IN QUEUE IS              
         CI,R6    STISLICE          TIME SLICED IF NO THEN KEEP                 
         BAZ      TMDQA3            GOING - IF YES TNEN CHECK                   
         B        TMDQA2A           IF SUBJECT TASK IS TME SLICED               
*                                                                               
TMDQR6   DATA     0                 SAVE CELL FOR R6                            
*                                                                               
         FIN      #TSLICE                                                       
         FIN      #MULTDSP                                                      
         TITLE    '***CONTROL PANEL INTERRUPT TASK***'                          
******************************************************************              
*                                                                *              
*        C O N T R O L   P A N E L   I N T E R R U P T   T A S K *              
*                                                                *              
******************************************************************              
*                                                                               
*                                   EXECUTES WHEN OPERATOR ACTIVATES            
*                                     INTERRUPT SWITCH ON CONSOLE.              
*                                   IF THERE IS NO INT. FOR THE CONTROL         
*                                     TASK, THE CONTROL TASK IS TIED TO         
*                                     THE CONTROL PANEL INTERRUPT.              
*                                                                               
*                                                                               
CPINT    STD,R0   CPINT9            SAVE R0,R1                                  
         STW,R11  CPINT11           SAVE R11 AND TRIGGER THE                    
         BAL,R11  CTRIGA                                                        
         LW,R11   CPINT11           CONTROL TASK                                
CPINT2   LW,R1    Y04                                                           
         STS,R1   K:CTST            SET BIT TO XEQ KEYIN TASK                   
CPINT3   LD,R0    CPINT9            RESTORE R0,R1                               
         LPSD,X'B'  CPPSD           EXIT                                        
*                                                                               
         BOUND    8                                                             
         TITLE    '**** RBM CONTROL TASK ****'                                  
***********************************************************                     
*                                                         *                     
*              R B M   C O N T R O L   T A S K            *                     
*                                                         *                     
***********************************************************                     
*                                                                               
*                                   DOES I/O CLEANUP                            
*                                   CALLS IN PROPER SUBTASK OVERLAY             
*                                     AND TRANSFERS CONTROL TO IT               
*                                                                               
*                                                                               
*                                                                               
CTEXIT   LI,R1    8                 RESET CONTROL TASK RUNNING                  
         STS,R0   K:CTST            RESET CT RUNNING                            
         DO       #MAP                                                          
*        ITS AN EXIT                                                            
*                 ITS A STOP                                                    
*                                   NO, ITS                                     
         CAL1,9   9                 *****SUPERWAIT*****                         
         ELSE     #MAP                                                          
         CAL1,7   CTSTOP            STOP THE CONTROL TASK                       
*                                                                               
*                                                                               
         LW,R0    K:JCP1            IS BKG ACTIVE                               
         CW,R0    Y4                                                            
         BAZ      %+2               NO                                          
         CAL1,7   BKGSTOP           STOP THE BACKGROUND                         
         FIN      #MAP                                                          
*                                                                               
CT1      EQU      %                 CONTROL TASK SCAN                           
         LB,R0    K:FGLD            SHOULD WE RUN FGD LOAD/RLS                  
         BEZ      CT10C             NO                                          
         LI,R0    0                                                             
         STB,R0   K:FGLD                                                        
         LW,R1    Y4                SET BIT TO RUN FGLD                         
         STS,R1   K:CTST                                                        
CT10C    LW,R0    K:CTST            ANY SUBTASKS TO XEQ                         
         CI,R0    BIT25+BIT13+BIT16 ANY LOGGING TASKS OR SCHED                  
         BANZ     CT12              YES                                         
         CW,R0    YFF8              ANY SUBTASKS TO EXECUTE                     
         DO       #MAP=0                                                        
         BANZ     CT12              YES                                         
         LB,R0    K:JCP1            NO, IS BCKGD CKPTED OR BEING                
         CI,R0    X'30'               USED BY FGD                               
         BANZ     CTEXIT            YES                                         
         CI,R0    X'40'             IS BACKGROUND ACTIVE                        
         BAZ      CTEXIT            NO                                          
         LW,R0    K:CTST            GET STATUS                                  
         CW,R0    Y01               IN IDLE                                     
         BANZ     CTEXIT            YES                                         
         CAL1,7   BKGSTART          START BACKGROUND                            
         B        CTEXIT            NO,STOP CONTROL TASK                        
         ELSE     MAP=0                                                         
         BAZ      CTNONE            B IF NUTHIN TO DO                           
         FIN      MAP=0                                                         
CT12     RES      0                                                             
         LI,R15   CT1               FOR OVERLAY EXITS                           
         LB,R1    K:JCP1            BCKGD STS INDICATORS                        
*                                                                               
* TESTS FOR SUBTASKS ARE ORDERED BY PRIORITY  (FIRST = HIGHEST)                 
*                                                                               
******************FIRST PRIORITY****************************************        
         CW,R0    Y04               IS IT KEYIN                                 
         BAZ      CT12D             NO                                          
         CI,R1    8                  BEEN TURNED ON                             
         BAZ      KEY1              NO, BRANCH                                  
         LW,R2    K:KEYST                                                       
         BNEZ     KEY1              YES, BRANCH                                 
******************SECOND PRIORITY**********************                         
CT12D    RES      0                                                             
         DO       #MAP=0                                                        
         CW,R0    Y8                IS IT CKPT                                  
         BANZ     CKPT              YES                                         
         FIN      #MAP=0                                                        
******************THIRD PRIORITY***********************                         
         CW,R0    Y4                IS IT RUN/RLS                               
         BANZ     FGL1              YES                                         
******************FOURTH PRIORITY**********************                         
         DO       #MAP=0                                                        
         CW,R0    Y2                NO, IS IT RESTART                           
         BANZ     CKPT              YES                                         
         FIN      #MAP=0                                                        
*******************NEXT PRIORITY***************                                 
         DO       #ERRORLOG                                                     
         CI,R0    BIT25             HOUR LOGGING                                
         BANZ     HOURLOG           YES                                         
*                                   NO                                          
         CI,R0    BIT13             ERROR LOG FILING                            
         BANZ     LOG               YES                                         
         FIN      #ERRORLOG                                                     
******************ANOTHER PRIOITY*************************                      
         CI,R0    BIT16             SCHED LOAD BIT                              
         BANZ     SCHED             YES                                         
******************SIXTH PRIORITY**********************                          
         CW,R0    Y08               IS IT ABORT/EXIT                            
         BAZ      CT12E             NO                                          
         CI,R1    X'30'             CKPTED OR IN USE BY FGD                     
         BANZ     CT1               YES                                         
         B        ABEX              GO TO ABEX                                  
CT12E    RES      0                                                             
******************SEVENTH PRIORITY**************************************        
         CW,R0    Y02               IS IT CT DUMP                               
         BAZ      CT13              B IF NOT                                    
         B        DFGD              GO DO IT                                    
******************EIGHTH PRIORITY***************************************        
CT13     RES      0                                                             
         DO       #MAP=0                                                        
         CW,R0    Y04               NO, NEED TO WAIT FOR KEYIN                  
         BANZ     CT1               YES, BRANCH                                 
         FIN      #MAP=0                                                        
******************NINTH PRIORITY****************************************        
         CW,R0    Y008              IS IT BKGD LOAD                             
         BAZ      CTNONE            NOTHING TO DO                               
         CI,R1    X'30'             CKPTED OR IN USE BY FGD                     
         BANZ     CT1               YES                                         
         B        BKL1              NO                                          
*                                                                               
*IF BKG ABORTS DURING INITIATION, THERE IS A PERIOD WHEN                        
*THE INIT FPT HAS BEEN POSTED AND THE FLAG TO RUN BKL1                          
*TO CHECK IT HAS NOT BEEN SET (SINCE TERMINATION IS                             
*NOT COMPLETE, BKL1 SHOULD NOT RUN). HOWEVER THE FPT                            
*MUST BE CHECKED, OR CT WILL NOT WAIT IN SUPERWAIT, THUS                        
*KEEPING BKG FROM FINISHING TERMINATION.                                        
*                                                                               
CTNONE   RES      0                                                             
         MTW,0    BINITFPT                                                      
         BEZ      CTEXIT            B IF BKG INIT NOT IN PROGRESS               
         CAL1,1   CKBINIT                                                       
CKBEX    B        CTEXIT            CHECK BKG ERROR/BUSY EXIT                   
         PAGE                                                                   
CTSTOP   GEN,8,24 X'4B',0                                                       
BKGSTOP  GEN,8,24 X'4B',X'800000'   STOP BACKGROUND                             
         DATA     P3+P11+F0+F7                                                  
         DATA     'BKG '                                                        
         DATA     'BKG '                                                        
BKGSTART GEN,8,24 X'4A',X'800000'   START BACKGROUND                            
         DATA     P3+P11+F7                                                     
         DATA     'BKG '                                                        
         DATA     'BKG '                                                        
CKBINIT  GEN,1,7,24  1,X'29',BINITFPT   CHECK THE BKG INIT FPT                  
         GEN,16,16   X'A040',0          BUT IGNORE THE RESULTS                  
         PZE      CKBEX                                                         
         PZE      CKBEX                                                         
         PAGE                                                                   
*END-ACTION ROUTINE FOR INIT CAL FROM SCHED                                     
SCEND    RES      0                                                             
         LI,R1    BIT16             SCHED BIT                                   
         STS,R1   K:CTST            SET SCHED LOAD FLAG                         
         LW,R0    R11               SAVE END-ACTION RETURN                      
         BAL,R11  CTRIG             FIRE OFF CONTROL TASK                       
         B        *R0               RETURN                                      
*                                                                               
         TITLE    'RBM CAL1 PROCESSOR'                                   0357000
**********************                                                   0359000
*   CAL1 PROCESSOR   *                                                   0360000
**********************                                                   0361000
*                                                                        0362000
*                                                                        0363000
*     THIS ROUTINE IS ENTERRED UPON OCCURRENCE OF EACH CAL1              0364000
*     ROUTINE EXITS THROUGH TABLE C1T  WITH THE R FIELD OF THE CAL1      0365000
*        USED AS AN INDEX                                                0366000
*     AT ENTRY INTERRUPTS ARE DISABLED                                   0367000
*                                                                        0368000
         LOCAL    RBM                                                           
RBM      EQU      0                                                             
CAL1PROC STCF     CFFLAGS                                                       
         STD,R0   TEMP                                                          
         DO       #MAP*(#ONLINE=0)                                              
         LH,R0    CAL1PSD           MAP BIT                                     
         BAL,R1   SETMAP            SET MAPPED IF NEEDED                        
         FIN      #MAP*(#ONLINE=0)                                              
         BAL,R0   OMAN              CHECK FOR ENTRY OR EXIT                     
         LD,R0    TEMP                                                          
         PUSH     3,R0              SAVE R0-R2                           0370000
         LD,R0    CAL1PSD           GET THE PSD                          0371000
         LB,R2    CFFLAGS                                                       
         ENABLE                                                          0373000
         PUSH     15,R3             SAVE R3-R15 AND PSD                  0374000
         LI,R7    0                 CLEAR MU FLAG                               
         LB,R3    TCBPOINT          TASK ID                                     
         LH,R4    STIOVID,R3        SAVE OVERLAY ID                             
         PUSH     R4                                                            
         LD,R4    STIRTSB,R3        GET RTSB                                    
         BEZ      CALENT1           FLAG IF NON-ZERO TO SET MU BOT              
         STW,R4   R7                SET FLAG NON-ZERO                           
CALENT1  PUSH     2,R4              SAVE RTSB                                   
         LD,R4    *K:RTS                                                        
         STD,R4   STIRTSB,R3        SET RTSB TO CURRENT SPD                     
*                                   STACK HAS 21 WORDS.PSD,R16-                 
*                                   -R0,STIOVID,SAVED STIRTSB                   
*                                                                               
******     RBM TEMP STACK CONTENT ADDED    ********                             
*            *********************                                              
*   HI CORE  *STIRTSB SECOND WORD *    ADDRESS POINTED BY K:RTS                 
*            *STIRTSB FIRST WORD  *                                             
*            *STIOVID             *                                             
*            *PSD SECOND WORD   *                                               
*            * PSD FIRST WORD   *                                        0379000
*            * R15              *                                        0380000
*            * R14              *                                        0381000
*            * R13              *                                        0382000
*            * R12              *                                        0383000
*            * R11              *                                        0384000
*            * R10              *                                        0385000
*            * R9               *                                        0386000
*            * R8               *                                        0387000
*            * R7               *                                        0388000
*            * R6               *                                        0389000
*            * R5               *                                        0390000
*            * R4               *                                        0391000
*            * R3               *                                        0392000
*            * R2               *                                        0393000
*            * R1               *                                        0394000
*   LO CORE  * R0               *                                        0395000
*            ********************                                        0396000
*                                                                        0397000
*                                                                        0398000
*                                                                        0399000
*                                                                        0400000
*   R FIELD OF THE CAL1 IS IN R2, PSD IS IN R0,R1                        0401000
CALENT2  RES      0                                                             
         SLS,R2   -4                POSITION R FIELD                     0402000
         CI,R2    HICAL1            COMPARE FOR R FIELD IN RANGE         0403000
         BG       BADCAL            NOT, BRANCH                                 
         CI,R2    9                                                             
         BE       CAL19             B IF CAL1,9                                 
         LB,R10   C1TB1,R2          OFFSET OF BEGINNING OF CODES                
         LB,R11   C1TB2,R2          OFFSET OF BEGINNING OF ROUTINES             
         LB,R2    C1TB3,R2          NO OF CODES TO R2                           
         BEZ      BADCAL                                                        
         AI,R10   CTBBASE           COMPUTE ADDRESS                             
         AI,R11   CTBBASE           COMPUTE ADDRESS                             
         BAL,R8   GETCODE                                                       
         LB,R4    TCBPOINT          GET TASKID                                  
* NOW WE HAVE:  FPT CODE IN R1                                                  
*               FPT ADDRESS IN R0                                               
%1       CB,R1    *R10,R2           COMPARE CODE                                
         BE       %2                B IF FOUND                                  
         BDR,R2   %1                LOOP IF ANY LEFT                            
         B        BADCAL                                                        
%2       LH,R2    *R11,R2           GET OFFSET OF ROUTINE                       
         AI,R2    RBM               COMPUTE ADDRESS                             
         STW,R0   R3                MOVE FPT ADDRESS TO R3                      
         CI,R7    0                 SEE IF MUST SET MU BIT                      
         BEZ      0,R2              NO,SO ENTER ROUTINE                         
         OR,R3    Y1                SET MU (BIT 3 IN R3)                        
         B        0,R2              ENTER ROUTINE WITH MU SET                   
*                                                                               
CAL1PER  LD,R0    CAL1PSD                                                       
         STD,R0   TRAP50                                                        
         LI,R1    TRAP50                                                        
         B        TRAP5                                                         
*                                                                               
*                                                                               
* TABLE OF OFFSETS OF THE VARIOUS TABLES CONTAINING THE FPT CODES               
*                                                                               
         BOUND    4                                                             
C1TB1    DATA,1   0                                                             
         DATA,1   CAL11CDS-CTBBASE                                              
         DATA,1   CAL12CDS-CTBBASE                                              
         DATA,1   0                                                             
         DATA,1   0                                                             
         DATA,1   CAL15CDS-CTBBASE                                              
         DATA,1   0                                                             
         DATA,1   CAL17CDS-CTBBASE                                              
         DATA,1   CAL18CDS-CTBBASE                                              
HICAL1   EQU      BA(%)-BA(C1TB1)                                               
*                                                                               
*                                                                               
* TABLE OF OFFSETS OF THE VARIOUS TABLES CONTAINING THE ROUTINE ENTRIES         
*                                                                               
         BOUND    4                                                             
C1TB2    DATA,1   0                                                             
         DATA,1   CAL11ADS-CTBBASE                                              
         DATA,1   CAL12ADS-CTBBASE                                              
         DATA,1   0                                                             
         DATA,1   0                                                             
         DATA,1   CAL15ADS-CTBBASE                                              
         DATA,1   0                                                             
         DATA,1    CAL17ADS-CTBBASE                                             
         DATA,1   CAL18ADS-CTBBASE                                              
*                                                                               
*                                                                               
* TABLE OF NO OF FPT CODES USED FOR THE VARIOUS CAL1'S                          
*                                                                               
         BOUND    4                                                             
C1TB3    DATA,1   0                                                             
         DATA,1   NCAL11S                                                       
         DATA,1   NCAL12S                                                       
         DATA,1   0                                                             
         DATA,1   0                                                             
         DATA,1   NCAL15S                                                       
         DATA,1   0                                                             
         DATA,1   NCAL17S                                                       
         DATA,1   NCAL18S                                                       
*                                                                               
*                                                                               
*                                                                               
         BOUND    4                                                             
CTBBASE  EQU      %                                                             
         PAGE                                                                   
*********************                                                           
*   CAL1,1 TABLES   *                                                           
*********************                                                           
*                                                                               
*                                                                               
         BOUND    4                                                             
CAL11CDS DATA,1   0,X'2B',3,5,X'22',X'1D',X'1C',2,1,;      /SIG7-2651/*C5732 C01
                  X'14',X'15',X'29',X'11',X'10',8,9                             
         DATA,1   X'0B'                                                         
         DATA,1   X'2C'                                                         
*                                                                               
         BOUND    4                                                             
CAL11ADS DATA,2   0                                                             
         DATA,2   CORRES-RBM        CORRESPONDENCE         /SIG7-2651/*C5732 C01
         DATA,2   REWIND-RBM        UNLOAD                                      
         DATA,2   DVF-RBM           DEV VERTICAL FORMAT                         
         DATA,2   DFM-RBM                                                       
         DATA,2   PRECORD-RBM                                                   
         DATA,2   PFIL-RBM                                                      
         DATA,2   WEOF-RBM                                                      
         DATA,2   REWIND-RBM        REWIND                                      
         DATA,2   OPEN-RBM                                                      
         DATA,2   CLOSE-RBM                                                     
         DATA,2   CHECK-RBM                                                     
         DATA,2   READWRIT-RBM                                                  
         DATA,2   READWRIT-RBM                                                  
         DATA,2   ASSIGN-RBM                                                    
         DATA,2    DEVN-RBM                                                     
         DATA,2   DRC-RBM                                                       
         DATA,2   PROMPT-RBM                                                    
NCAL11S  EQU      HA(%)-HA(CAL11ADS)-1                                          
         PAGE                                                                   
*********************                                                           
*   CAL1,2 TABLES   *                                                           
*********************                                                           
*                                                                               
*                                                                               
         BOUND    4                                                             
CAL12CDS DATA,1   0,1,2                                                         
*                                                                               
         BOUND    4                                                             
CAL12ADS DATA,2   0                                                             
         DATA,2   PRINT-RBM                                                     
         DATA,2   TYPE-RBM                                                      
NCAL12S  EQU      HA(%)-HA(CAL12ADS)-1                                          
         PAGE                                                                   
*********************                                                           
*   CAL1,5 TABLES   *                                                           
*********************                                                           
*                                                                               
*                                                                               
*                                                                               
         BOUND    4                                                             
CAL15CDS DATA,1   0,X'10',X'11',X'0E',X'0F',X'12',X'13',X'14',X'15'             
         DATA,1   X'16',X'17'                                                   
         DATA,1   X'0C',X'0B',X'03',X'04',0,1,2,7,8                             
*                                                                               
         BOUND    4                                                             
CAL15ADS DATA,2   0                                                             
         DATA,2   STPIO1-RBM        STOP ALL SYSTEM I/O                         
         DATA,2   STRTIO1-RBM       START ALL SYSTEM I/O                        
         DATA,2   STPIO2-RBM        STOP BCKG I/O                               
         DATA,2   STRTIO2-RBM       START BCKG I/O                              
         DATA,2   IOEX-RBM          SIO FOR IOEX                                
         DATA,2   IOEX-RBM          TIO FOR IOEX                                
         DATA,2   IOEX-RBM          TDV FOR IOEX                                
         DATA,2   IOEX-RBM          HIO FOR IOEX                                
         DATA,2   DEACTV-RBM        DEACTIVATE I/O                              
         DATA,2   ACTV-RBM          ACTIVATE I/O                                
         DATA,2   RUN-RBM                                                       
         DATA,2   RLS-RBM                                                       
         DATA,2   DISARM-RBM                                                    
         DATA,2   ARM-RBM                                                       
         DATA,2   TRIGGER-RBM                                                   
         DATA,2   DISABLE-RBM                                                   
         DATA,2   ENABLE-RBM                                                    
         DATA,2   SLAVE-RBM                                                     
         DATA,2   MASTER-RBM                                                    
NCAL15S  EQU      HA(%)-HA(CAL15ADS)-1                                          
         BOUND     4                                                            
CAL17CDS DATA,1    0,X'40',X'41',X'42',X'43',X'44',X'45',X'46'                  
         DATA,1    X'47',X'48',X'49',X'4A',X'4B',X'4C',X'4D'                    
         DATA,1    X'4E',X'4F',X'50',X'51',X'52',X'53',X'54'                    
         DATA,1   X'55',X'56',X'57',X'58',X'59',X'5A',X'5B'                     
         DATA,1   X'5C',X'5D',X'5E',X'5F',X'60',X'61'                           
         DATA,1   X'62',X'63',X'64'                                             
         DATA,1   X'65'                                                         
         DO1      #ERRORLOG                                                     
         DATA,1   X'66'             ERRSEND                                     
         DATA,1   X'67'             JOB                                         
         DATA,1   X'68'             SCHED                                       
         DATA,1   X'69',X'6A'       RECALARM, TRGALARM                          
         BOUND     4                                                            
CAL17ADS DATA,2    0                                                            
         DO       #ECB                                                          
         DATA,2    WAITALL-RBM      FPT CODE = 40                               
         DATA,2    WAITANY-RBM                 41                               
         DATA,2    TEST-RBM                    42                               
         DATA,2    SIGNAL-RBM                  43                               
         DATA,2    STIMER-RBM                  44                               
         DATA,2    POLL-RBM                    45                               
         DATA,2    PPOST-RBM                   46                               
         ELSE     #ECB                                                          
         DATA,2   BADCAL-RBM                                                    
         DATA,2   BADCAL-RBM                                                    
         DATA,2   BADCAL-RBM                                                    
         DATA,2   BADCAL-RBM                                                    
         DATA,2   BADCAL-RBM                                                    
         DATA,2   BADCAL-RBM                                                    
         DATA,2   BADCAL-RBM                                                    
         FIN      #ECB                                                          
         DATA,2    DELFPT-RBM                  47                               
         DATA,2    PINIT-RBM                   48                               
         DATA,2    EXTM-RBM                    49                               
         DATA,2    START-RBM                   4A                               
         DATA,2    STOP-RBM                    4B                               
         DO       #ECB                                                          
         DATA,2    ENQ-RBM                     4C                               
         DATA,2    DEQ-RBM                     4D                               
         ELSE     #ECB                                                          
         DATA,2   BADCAL-RBM                                                    
         DATA,2   BADCAL-RBM                                                    
         FIN      #ECB                                                          
         DATA,2    STATUS-RBM                  4E                               
         DATA,2    MODIFY-RBM                  4F                               
         DO       #MAP*#ROLL                                                    
         DATA,2    PREFMODE-RBM                50 PREFMODE                      
         ELSE     #MAP*#ROLL                                                    
         DATA,2   BADCAL-RBM        50                                          
         FIN      #MAP*#ROLL                                                    
         DATA,2    SETNAME-RBM                 51                               
         DO        #MAP                                                         
         DATA,2    MMCAL-RBM                   52 (ACTIVATE)                    
         DATA,2    MMCAL-RBM                   53 (DEACTIVATE)                  
         DATA,2    MMCAL-RBM                   54 (ERASE)                       
         DATA,2    MMCAL-RBM                   55 (LOCK)                        
         DATA,2    MMCAL-RBM                   56 (UNLOCK)                      
         DATA,2    MMCAL-RBM                   57 (GETPAGE)                     
         DATA,2    MMCAL-RBM                   58 (RELPAGE)                     
        DO       #MEDIA                                                         
         DATA,2   MEDIACAL-RBM                 59 (MEDIA)                       
        ELSE     #MEDIA                                                         
         DATA,2   BADCAL-RBM        59                                          
        FIN      #MEDIA                                                         
         ELSE                                                                   
         DATA,2    BADCAL-RBM                  52                               
         DATA,2    BADCAL-RBM                  53                               
         DATA,2    BADCAL-RBM                  54                               
         DATA,2    BADCAL-RBM                  55                               
         DATA,2    BADCAL-RBM                  56                               
         DATA,2    BADCAL-RBM                  57                               
         DATA,2    BADCAL-RBM                  58                               
         DATA,2    BADCAL-RBM                  59                               
         FIN                                                                    
         DATA,2    ALLOT-RBM                   5A                               
         DATA,2    DELETE-RBM                  5B                               
         DATA,2    TRUNCATE-RBM                5C                               
         DATA,2    JTRAP-RBM                   5D                               
         DATA,2    TRTY-RBM                    5E                               
         DATA,2    TEXIT-RBM                   5F                               
         DATA,2    CALRTN-RBM                  60                               
         DATA,2    GETTIME-RBM                 61                               
         DATA,2    STDLB-RBM                   62                               
         DO       #ECB                                                          
         DATA,2    SJOB-RBM                    63                               
         DATA,2    KJOB-RBM                    64                               
         ELSE     #ECB                                                          
         DATA,2   BADCAL-RBM                                                    
         DATA,2   BADCAL-RBM                                                    
         FIN      #ECB                                                          
         DO       #DEBUG                                                        
         DATA,2   DEBUG-RBM         65                                          
         ELSE     #DEBUG                                                        
         DATA,2   BADCAL-RBM        65                                          
         FIN      #DEBUG                                                        
         DO       #ERRORLOG                                             2018.010
         DATA,2   ERRSEND-RBM       66                                          
         ELSE                       #ERRORLOG                           2019.010
         DATA     BADCAL-RBM                                            2019.020
         FIN                        #ERRORLOG                           2019.030
        DO       #SYMB                                                          
         DATA,2   JOB1-RBM                     67 (JOB)                         
        ELSE                                                                    
         DATA,2   BADCAL-RBM        67 (JOB)                                    
        FIN      #SYMB                                                          
         DATA,2   SCHEDC-RBM        68                                          
         DO       #XRBM                                                         
         DATA,2   RECALARM-RBM      69                                          
         DATA,2   TRGALARM-RBM      6A                                          
         ELSE     #XRBM                                                         
         DATA,2   BADCAL-RBM                                                    
         DATA,2   BADCAL-RBM                                                    
         FIN      #XRBM                                                         
NCAL17S  EQU       HA(%)-HA(CAL17ADS)-1                                         
         PAGE                                                                   
*********************                                                           
*   CAL1,8 TABLES   *                                                           
*********************                                                           
*                                                                               
*                                                                               
*                                                                               
         BOUND    4                                                             
CAL18CDS DATA,1   0,X'14',1,X'10'                                               
         DATA,1   X'E'                                                          
*                                                                               
         BOUND    4                                                             
CAL18ADS DATA,2   0                                                             
         DATA,2   TRAP70-RBM                                                    
         DATA,2   SEGLOAD-RBM                                                   
         DATA,2   TIME-RBM                                                      
         DO       (#MAP+#DEBUG+#TJE)>0                                          
         DATA,2   BREAK-RBM         M:INT CAL                                   
         ELSE     (#MAP+#DEBUG+#TJE)>0                                          
         B        BADCAL-RBM        M:INT CAL                                   
         FIN      (#MAP+#DEBUG+#TJE)>0                                          
NCAL18S  EQU      HA(%)-HA(CAL18ADS)-1                                          
         PAGE                                                                   
*************                                                                   
*   CAL19   *                                                                   
*************                                                                   
*                                                                               
*   THIS ROUTINE PROCESSES ALL CAL1,9 CALLS                                     
*   AT ENTRY THE R FIELD OF THE CAL1 IS IN R3 & THE PSD IS IN R0,R1             
*                                                                               
CAL19    BAL,R4   GETWD                                                         
         BAL,R5   ANLZSB                                                        
         BAL,R4   ISEXU                                                         
         B        CAL19             YES, LOOP                                   
         AND,R1   M17               EXTRACT ADDRESS FIELD                       
         CI,R1    NCAL19S           COMPARE TO NUMBER OR CAL1,9'S               
         BG       BADCAL            GREATER, ERROR                              
         B        C19TB,1           B THROUGH TABLE                             
C19TB    B        BADCAL            CAL1,9   0                                  
         B        EXIT              CAL1,9   1                                  
         B        ABORT             CAL1,9   2                                  
         B        ABORT             CAL1,9   3                                  
         B        BADCAL            CAL1,9   4                                  
         B        TRTN              CAL1,9    5                                 
         B        BADCAL            CAL1,9 6                                    
         B        BADCAL            CAL1,9   7                                  
         B        TERM              CAL1,9   8                                  
         B        WAIT              CAL1,9   9                                  
         B         EXDA       CAL1,9  X'A'= EXIT DISARMED                       
NCAL19S  EQU      %-C19TB-1                                                     
         LOCAL                                                                  
         PAGE                                                            0466000
***************                                                          0467000
*   CALEXIT   *                                                          0468000
*   CALERR    *                                                                 
***************                                                          0469000
*                                                                        0470000
*   THIS ROUTINE PERFORMS EXIT TO INSTRUCTION FOLLOWING USER CAL         0471000
*                                                                        0472000
*****AT ENTRY:USER CONTEXT IS ON TOP OF RBM TEMP STACK AS SHOWN                 
*                     ABOVE IN CAL1PROC                                  0474000
*                                                                        0475000
CALSTDX  CI,R15   TYCF0             SERIOUS ERROR                               
         BL       CALEXIT               NO                                      
CALERR   CI,R15   TYCABORT          TAKE APPROPRIATE EXIT                       
         BL       BADCAL                FD=TRAP '50'                            
         BE       TMABORT               FE=ABORT TASK                           
*                                       FF=SYSTEM CRASH                         
CRSHXPSD CRASH    'SYSTEM ERROR IN CAL1 PROCESSOR'                              
*                                                                        0476000
CALEXIT  RES      0                                                             
         LB,R3    TCBPOINT          GET TASK ID                                 
         LD,R4    STIRTSB,R3        RESTORE STACK POINTER                       
         STD,R4   *K:RTS            TO WHAT IT WAS AT BRANCH TO CAL             
         PULL     2,R4              PULL SAVED RTSB                             
CALEX3   STD,R4   STIRTSB,R3        RESTORE RTSB                                
         PULL     R2                GET ORIG OVID                               
         LW,R4    *K:RTS            FOR FIRST PSD WORD                          
         MTW,1    -1,R4             INCREMENT RETURN                            
         CH,R2    STIOVID,R3        STILL THERE                                 
         BE       %0700             YES                                         
         DISABLE                                                                
         STH,R2   STIOVID,R3        GET IT BACK                                 
         CI,R2    0                                                             
         BE       %0700                                                         
         LD,R0    OMANPSD           GET EXIT ENTRY                              
         XW,R0    -1,R4             GET OLD FIRST WORD PSD                      
         XW,R1    0,R4              GET OLD SECOND WORD                         
         STD,R0   CAL1PSD           SET UP OMAN ENTRY                           
*                                                                               
%0700    EQU      %                                                             
         DO       (#MAP+#DEBUG+#TJE)>0                                          
         LD,R0    STIRTSB,R3        ARE WE GOING BACK TO USER                   
         BEZ      %0720             B IF YES - IF NO ITS CAL WITIN CAL          
         FIN      (#MAP+#DEBUG+#TJE)>0                                          
%0710    PULL     16,R2             PULL PSD AND R2-R15                         
         DISABLE                                                         0479000
         STD,R0   TEMP              PSD TO TEMP                          0480000
         PULL     2,R0              RESTORE R0,R1                        0481000
         LPSD,8   TEMP                                                          
         DO       (#MAP+#DEBUG+#TJE)>0                                          
%0720    EQU      %                                                             
         LB,R1    STILMID,R3                                                    
         DISABLE                                                                
         LH,R0    LMISTAT,R1                                                    
         CI,R0    LMIT                                                          
         BANZ     %0710             B IF IN TERMINATION NOW                     
         CI,R0    LMIBREAK          BREAK WHILE IN CAL                          
         BANZ     %0730             B IF YES                                    
         FIN      (#MAP+#DEBUG+#TJE)>0                                          
         DO       #TJE                                                          
         CI,R0    LMICTL            CONTROL WHILE IN CAL                        
         BANZ     %0740             B IF YES                                    
         FIN      #TJE                                                          
         DO       #DEBUG                                                        
         LW,R0    LMIPCB,R1                                                     
         LB,R0    R0                                                            
         CI,R0    LMIDEBUG          TASK RUNNING WT DEBUG                       
         BAZ      %0710             B IF NO  - EXIT CAL                         
         LB,R2    STIJID,R3                                                     
         LW,R2    SJI1,R2           GETJCB ADDRESS                              
         LW,R0    0,R2              GET FIRST WORD OF JCB                       
         AND,R0   XJCBDBGI          ISOLATE DEBUG INIT FIELD                    
         CW,R0    Y01               IS IT IN INITIALIZATION                     
         BNE      %0710             B IFNO                                      
         LD,R0    DBUGPSD                                                       
         XW,R0    -1,R4             SWAP PSD'S TO GO TO DEBUG                   
         XW,R1    0,R4                                                          
         STD,R0   CAL1PSD           SAVE FR DEBUG                               
         B        %0710             EXIT CAL T DEBUG INITIALIZATION             
*                                                                               
         ELSE     #DEBUG                                                        
         B        %0710                                                         
         FIN      #DEBUG                                                        
         DO       (#MAP+#DEBUG+#TJE)>0                                          
%0730    EQU      %                                                             
         AND,R0   XLMINBRK          RESET BREAK BIT                             
         STH,R0   LMISTAT,R1                                                    
         LD,R0    BREAKPSD                                                      
         XW,R0    -1,R4             SWAP PSD'S TO GO TO BREAK CDE               
         XW,R1    0,R4                                                          
         STD,R0   TRAP51            SAVE FOR BREAK LOGIC                        
         B        %0710             EXIT CAL T BREAK OUT OF TASK                
         FIN      (#MAP+#DEBUG+#TJE)>0                                          
*                                                                               
         DO       #TJE                                                          
%0740    EQU      %                                                             
         AND,R0   XLMINCTL          RESET CONTROL BIT                           
         STH,R0   LMISTAT,R1                                                    
         LD,R0    CTLPSD                                                        
         XW,R0    -1,R4             SWAP PSD'S TO GO TO CONTROL CODE            
         XW,R1    0,R4                                                          
         STD,R0   TRAP52            SAVE FOR CNTRL LOGIC                        
         B        %0710             EXIT CAL TO BREAK OUT OF TASK               
*                                                                               
         FIN      #TJE                                                          
         PAGE                                                            0491000
***************                                                          0492000
*   GETCODE   *                                                          0493000
***************                                                          0494000
*                                                                        0495000
*    ROUTINE GETS THE CODE FROM THE FPT FOR THOSE CALS WHICH USE         0496000
*      FPTS. ROUTINE LOCATES THE CAL, DETERMINES ITS EFFECTIVE           0497000
*      ADDRESS, AND TAKES THE CODE FROM THAT ADDRESS                     0498000
*                                                                        0499000
*     INPUT:  PSD IN R0,R1                                               0500000
*                                                                        0501000
*     OUTPUT: FPT CODE IN R1                                             0502000
*             FPT ADDRESS IN R0                                          0503000
*                                                                        0504000
*     CALLING SEQUENCE:                                                  0505000
*        BAL,R8   GETCODE                                                0506000
*                                                                        0507000
*     REGISTERS USED: R0,R1,R4,R14,R15                                   0508000
*                                                                        0509000
*     SUBROUTINES USED: GETWD,ANLZSB,ISEXU                               0510000
GETCODE  BAL,R4   GETWD             TRAP INSTRUCTION TO R1               0511000
         BAL,R5   ANLZSB            EFFECTIVE ADDR OF INST TO R0         0512000
         BAL,R4   ISEXU             IS INST IN R1 AN EXU?                0513000
         B        GETCODE           YES,LOOP                             0514000
*HERE WE HAVE THE EFFECTIVE ADDRESS OF THE FPT IN R0                     0515000
         LB,R1    *R0               GET CODE                             0516000
         AND,R1   M7                MASK OUT CODE                               
         B        *R8               RETURN                               0517000
         PAGE                                                            0518000
*************                                                            0519000
*   GETWD   *                                                            0520000
*************                                                            0521000
*                                                                        0522000
*    ROUTINE RETURNS THE WORD WHOSE ADDRESS BEFORE THE CONTEXT           0523000
*      SAVE IS CONTAINED IN RO. THIS MEANS THAT IF THE ADDRESS           0524000
*      IS THAT OF A REG, THE ROUTINE MUST RETRIEVE THE WORD FROM         0525000
*      THE USER TEMP STACK. THE INPUT ADDRESS IS CONVERTED IN R0         0526000
*                                                                        0527000
*      INPUT: R0 CONTAINS THE ADDRESS                                    0528000
*                                                                        0529000
*                                                                        0530000
*      OUTPUT:R1 CONTAINS THE WORD WHICH WAS IN THE ADDRESS              0531000
*             R0 CONTAINS THE CURRENT ADDRESS OF THE WORD                0532000
*                                                                        0533000
*      CALLING SEQUENCE:                                                 0534000
*        BAL,R4   GETWD                                                  0535000
*                                                                        0536000
*      REGISTERS USED: R0,R1,R4                                          0537000
*                                                                        0538000
GETWD    AND,R0   M17               MASK ADDRESS                         0539000
         CI,R0    KF                REGISTER ADDRESS?                    0540000
         BG       GTWD1             NO, BRANCH AROUND                    0541000
         LB,R1    TCBPOINT          GET TASK ID                                 
         LD,R1    STIRTSB,R1        GET FIRST WORD OF SPD                       
         AW,R0    R1                ADD TO REG                                  
         AI,R0    -CAL1PUSH         SUBTRACT OFF SET                            
*   WE NOW HAVE THE ADDRESS IN R0                                        0544000
GTWD1    LW,R1    *R0               GET WORD                             0545000
         B        0,R4              RETURN                                      
         PAGE                                                            0547000
**************                                                           0548000
*   ANLZSB   *                                                           0549000
**************                                                           0550000
*                                                                        0551000
*     ROUTINE DETERMINES THE EFFECTIVE ADDRESS OF AN INSTRUCTION         0552000
*      REGARDLESS OF INDEXING AND/OR INDIRECTION AND/OR REG ADDRESSES    0553000
*                                                                        0554000
*     INPUT: R1 CONTAINS THE INSTRUCTION                                 0555000
*                                                                        0556000
*     OUTPUT: R0 CONTAINS THE EFFECTIVE ADDRESS                          0557000
*             R1 CONTAINS THE INSTRUCTION UNCHANGED                      0558000
*     CALLING SEQUENCE:                                                  0559000
*        BAL,R5   ANLZSB                                                 0560000
*                                                                        0561000
*     REGISTERS USED: R0,R1,R4,R5,R14,R15                                0562000
*                                                                        0563000
ANLZSB   LW,R14   R1                COPY INSTRUCTION & TEST INDIRECT     0564000
         BGEZ     ANLZ1             B NOT INDIRECT                       0565000
         LW,R0    R1                INDIRECT, INST TO R0                 0566000
         BAL,R4   GETWD             GET DIRECTLY ADDRESSED WORD          0567000
*HERE WE HAVE THE ADDRESS BEFORE INDEXING IN R1                          0568000
ANLZ1    LW,R15   R1                COPY ADDR BEFORE INDEXING TO R15     0569000
         LH,R0    R14               HI ORDER HALFWORD OF INST            0570000
         SLS,R0   -1                RT JUSTIFY X FIELD                   0571000
         AND,R0   M3                MASK X FIELD                         0572000
         BEZ      ANLZ2             B NO INDEXING                        0573000
         BAL,R4   GETWD             GET CONTENTS OF X REG IN R1          0574000
         LW,R0    R1                INDEX VALUE TO R0                    0575000
*AT ANLZ2 WE HAVE THE INDEX VALUE IN R0, THE ADDR BEFORE INDEXING IN     0576000
*   R15, THE INSTRUCTION IN R14                                          0577000
ANLZ2    AW,R0    R15               COMPUTE EFFECTIVE ADDR BEFORE SAVE   0578000
         BAL,R4   GETWD             CONVERT ADDRESS IN R0                0579000
         LW,R1    R14               RESTORE INST TO R1                   0580000
         B        0,R5              RETURN                                      
         PAGE                                                            0582000
*************                                                            0583000
*   ISEXU   *                                                            0584000
*************                                                            0585000
*                                                                        0586000
*                                                                        0587000
*                                                                        0588000
*   ROUTINE TESTS AN INSTRUCTION TO DETERMINE IF IT IS AN EXU            0589000
*                                                                        0590000
*   INPUT:  INSTRUCTION IN R1                                            0591000
*                                                                        0592000
*   OUTPUT: R1 UNCHANGED. RETURN TO +1 IF EXU, +2 OTHERWISE              0593000
*                                                                        0594000
*   REGISTERS USED: R15                                                  0595000
*                                                                        0596000
*   CALLING SEQUENCE:                                                    0597000
*        BAL,R4   ISEXU                                                  0598000
*                                                                        0599000
*                                                                        0600000
ISEXU    LB,R15   R1                OP CODE TO R15                       0601000
         CI,R15   K67               EXU?                                 0602000
         BE       0,R4              YES, RET +1                                 
         CI,R15   KE7               EXU*?                                0604000
         BE       0,R4              YES, RET +1                                 
         B        1,R4              NO, RETURN +2                        0606000
         TITLE    'EXIT - EXDA - ABORT FROM TASKS'                              
************                                                                    
*   EXIT   *                                                                    
*   EXDA   *                                                                    
************                                                                    
*                                                                               
*   THIS ROUTINE PROCESSES ALL EXIT CALLS                                       
*                                                                               
EXDA     LI,R1    1                 SET SWITCH FOR DISARMED EXIT                
         BIFBKG   EXIT              IF BKG, TREAT LIKE EXIT                     
         B        EXITABRT          FGD, R1=EXIT/EXDA SWITCH                    
*                                                                               
EXIT     LI,R1    0                 NO BITS TO SET IN K:JCP1                    
         LW,R3    EXIT9                                                         
EXITABRT LB,R2    TCBPOINT          STI INDEX                                   
         LD,R4    STIRTSB,R2         CAL STACK BASE                             
         BEZ      %+2               IF PRESENT                                  
         STD,R4   *K:RTS            RESET                                       
         LI,R5    0                 CLEAR FOR LATER                             
         BIFPRIM  FGEXIT            PRIMARY TASKS GO TO RBMEXIT                 
         BIFBKG   EXITABT5          BACKGROUND, SET JCP FLAGS                   
         LB,R13   TCBPOINT                                                      
         CI,R13   CTID                                                          
         BNE      EXITSEC           B IF NOT IN CONTROL TASK                    
         BIFRBM   EXITSEC           BRANCH IF REALLY CONTROL TASK               
         B        EAEXIT            B IF PRIMARY INITIALIZATION EXIT            
EXITSEC  B        TMTERM            TERMINATE SECONDARIES                       
EXITABT5 DISABLE                                                                
         STS,R3   K:CTST                                                        
         BAL,R11  CTRIG             TRIGGER CONTROL TASK                        
         ENABLE                                                                 
         B        %                 WAIT FOR CTRL TASK TO STOP BKG              
EAEXIT   LD,R1    STIRTSB,R2        FROM CAL                                    
         BEZ      EXIT8             NO                                          
         STD,R5   STIRTSB,R2                                                    
         LI,R12   -(CAL1PUSH+1)   REMOVE ALL CAL ENTRY JUNK                     
         MSP,R12  *K:RTS                FROM RTS                                
EXIT8    LPSD,0   FGDPSD            FGD EXIT BACK TO FGL2                       
EXIT9    DATA     X'08000004'       ABEX AND EXIT                               
*                                                                               
FGEXIT   STD,R5   STIRTSB,R2                                                    
         LI,R12   -CAL1PUSH+15      REMOVE PSD AND OTHER WORDS                  
         MSP,R12  *K:RTS                FROM RTS                                
         CI,R1    0                 EXIT DISARMED?                              
         BNE      FGEXDA                YES                                     
         PULL     16,R0             RESTORE REGS                                
         B        RBMEXIT           EXIT TASK                                   
*                                                                               
FGEXDA   PULL     16,R0             RESTORE REGISTERS                           
         B        RBMEXITD              EXIT DISARMED                           
         PAGE                                                                   
****************                                                                
*   MOVEBYTS   *                                                                
****************                                                                
*                                                                               
*   AT ENTRY:     R4     TO ADDRESS  (BYTE)                                     
*                 R6     FROM ADDRESS  (BYTE)                                   
*                 R14    COUNT                                                  
*                 R9     LINK                                                   
*                 R7     WORKING REGISTER                                       
*                                                                               
MOVEBYTS LB,R7    0,R6                                                          
         STB,R7   0,R4                                                          
         AI,R4    1                                                             
         AI,R6    1                                                             
         BDR,R14  MOVEBYTS                                                      
         B        *R9                                                           
         TITLE    'TASK MANAGEMENT EXITS'                                       
*                                                                               
*                                   CAL EXITS FOR NEW CAL1,7                    
*                                                                               
TMX5     RES      0                                                             
         DO1      #ECB                                                          
         BAL,R8   EMDELECB          EXIT TO DEL ECB, P0ST                       
         NOP                                                                    
         ENABLE                                                                 
TMX1     BAL,R8   TMSETERR          SET PSD AND REGS ON ERRORS                  
TMX2     BAL,R8   TMTYC15S          STORE COMPLETION WORD                       
         B        CALSTDX               STANDARD CAL EXIT                       
         SPACE    1                                                             
TMX4     BAL,R8   TMTYCB            POST FPT BUSY                               
         B        CALSTDX               STANDARD CAL EXIT                       
         SPACE    1                                                             
         SPACE    1                                                             
TMXPR8   PULL     R8                GOOD EXIT WITH PULL OF R8                   
TMX8P1   AI,R8    1                 GOOD EXIT FROM A SUBROUTINE                 
         B        *R8                   EXIT                                    
         TITLE    'POSTING SUBROUTINES'                                         
*                                                                               
*        SIGNAL POSTING SUBROUTINE                                              
*                                                                               
         DO       #ECB                                                          
SIGPOST  RES      0                                                             
         PUSH     R8                    SAVE EXIT                               
         LW,R0    ECBSECB,R2        ANY S-LINK                                  
         BEZ      SIGPST1               NO                                      
         LW,R4    R7                SAVE R7                                     
         DISABLE                                                                
         BAL,R8   EMRRECB           REMOVE ECB FROM R-CHAIN                     
         NOP                            IGNORE ERRORS                           
         ENABLE                                                                 
         LW,R7    R4                RESTORE R7                                  
SIGPST1  BAL,R8   EMPOSTYC          POST THE ECB                                
         B        TMXPR8            PULL R8, INCR AND EXIT                      
         SPACE    5                                                             
*                                                                               
*        POSTING SUBROUTINE FOR POLL                                            
*                                                                               
POLLPOST PUSH     R8                SAVE THE RETURN ADDRESS                     
         PUSH     3,R2              R2-R4                                       
         BAL,R8   EMPOSTYC              POST THE ECB                            
         PULL     3,R2              R2-R4                                       
         B        TMXPR8            EXIT                                        
         SPACE    5                                                             
*                                                                               
*        STIMER POST SETS COMPLETION TO NORMAL, THEN IS                         
*                 SIGNAL POST                                                   
STIMPOST LW,R6    TYCWNORM          SET COMPLETION WORD TO NORMAL               
         B        SIGPOST           POST LIKE SIGNAL ECB                        
         PAGE                                                                   
*******************                                                             
*    ENQPOST      *    SUBR TO POST AN ENQ ECB                                  
*******************                                                             
*                                                                               
* ENTRY  R2       ECB ADDRESS                                                   
*        R7       EDT ADDRESS                                                   
*        BAL,R8   ENQPOST                                                       
* EXIT   +1       ERROR                                                         
*        +2       GOOD                                                          
*                                                                               
* REGISTERS USED: R0-R4,R6,R8-R15                                               
*          SAVED: R5,R7                                                         
* STACK WORDS:    1                                                             
* SUBROUTINES:    EMPOSTYC,TMREECB,TMENQGO                                      
*                                                                               
ENQPOST  PUSH     R8                SAVE EXIT                                   
         PUSH     R7                                                            
         LW,R1    ECBDATA,R2            R1=AET ADDRESS                          
         LW,R7    AETEDT,R1         R7= EDT ADDRESS                             
         LB,R0    R6                IS THE POST NORMAL?                         
         CI,R0    TYCNORM                                                       
         BNE      ENQPST1               NO, BYPASS UPDATE                       
*                                                                               
         BAL,R8   TMENQGO           UPDATE INDICATORS AND COUNTS                
         ENABLE                                                                 
*                                       IN AET AND EDT                          
*                                                                               
ENQPST1  BAL,R8   TMREECB               REMOVE ECB FR EDT CHAIN                 
*                                                                               
         BAL,R8   EMPOSTYC          POST THE ECB                                
*                                                                               
         PULL     R7                RESTORE R7                                  
         B        TMXPR8            GO PULL R8 AND TAKE +2 EXIT                 
         FIN      #ECB                                                          
         TITLE    'TASK MANAGEMENT SUBR - TRIGGER DISPATCHER'                   
******************       SUBROUTINES TO TRIGGER RDL LEVELS                      
*    TMTPRIO     *            ONLY IF TASK PRIORITY > OR = CURRENT              
*    TMTRIG      *            ON A TASK OTHER THAN CURRENT UNCONDIT'NLY         
*    TMRDLTRG    *            ON THE CURRENT TASK.                              
******************                                                              
* ENTRY:                                                                        
*        R4       TASK ID BEING TESTED (TMTPRIO AND TMTRIG)                     
*        BAL,R8   TMTRIG OR                                                     
*        BAL,R8   TMRDLTRG                                                      
* EXITS: +1       ALL EXITS, ENABLE/DISABLE = MODE OF CALLER                    
*                                                                               
* REGISTERS USED: R1,R9                                                         
*           SAVED: R0,R2-R8,R10-R15                                             
* STACK WORDS:NONE                                                              
* NOTES: TRAPS TO CALLER                                                        
*                                                                               
TMTPRIO  BIFPRIM  TMTRIG            IF PRIMARY NOW, ALWAYS TRIG                 
         LW,R0    STIPRIO,R4            SECONDARY, COMPARE                      
         LB,R0    R0                    HARDWARE BYTE TO R0-BYTE 3              
         LB,R1    TCBPOINT          COMPARE TO HARDWARE BYTE OF CURRENT         
         LW,R1    STIPRIO,R1            TASK                                    
         CB,R0    R1                                                            
         BL       TMTRIG                LESS (HIGHER PRIORITY)- TRIGGER         
         BG       TMTRIGX               GREATER (LOWER PRIORITY)-EXIT           
         LW,R0    STIPRIO,R4            EQUAL -COMPARE SOFTWARE BYTES           
         LH,R0    R0                                                            
         SLS,R1   8                                                             
         CB,R0    R1                                                            
         BG       TMTRIGX               GREATER (LOWER PRIO) EXIT               
*                                   EQUAL OR LESS, EQUAL OR HIGHER PR           
         DO       #TSLICE                                                       
         LB,R9    STISTAT,R4        CHECK AFFECTED TASK FOR TIME-SLICE          
         CI,R9    STISLICE          AND IF SO DO NOT ALLOW TS TASK TO           
         BAZ      TMTRIG            INTERRUPT ANOTHER T-S TASK UNLESS           
         LB,R1    STILMID,R4        THE AFFECTED TASK IS BACKGROUND             
         LH,R0    LMISTAT,R1        GET AFFECTED TASKS FLAGS AND IF             
         CI,R0    LMIBKG            HE IS BACKGROUND DO TRIGGER                 
         BANZ     TMTRIG            OTHERWISE CHECK CURRENT TASK                
         LB,R1    TCBPOINT          AND PERFORM TRIGGER ONLY IF                 
         LB,R0    STISTAT,R1        HE IS NON - TIME SLICED                     
         CI,R0    STISLICE                                                      
         BANZ     TMTRIGX           B IF TIMESLICED                             
         FIN      #TSLICE                                                       
         DO       #ONLINE                                                       
TMTRIG   B        TMRDLTRG          ONLINE, ENTER DISPATCHER                    
         ELSE                                                                   
TMTRIG   LI,R1    1                 SET THE SOFTWARE TRIGGER                    
         STS,R1   TDTRIG                SWITCH                                  
         DO       #MULTDSP                                                      
         LW,R1    STITCB,R4             TRIGGER RDL                             
         LW,R9    STCBRDL,R1                                                    
         LH,R1    R9                                                            
         ELSE     #MULTDSP                                                      
         LW,R1    K:CTWD            FOR CONTROL TASK                            
         LW,R9    K:CTGL                                                        
         FIN      #MULTDSP                                                      
         WD,R9    0,R1                                                          
         FIN                                                                    
TMTRIGX  B        *R8               EXIT                                        
*                                                                               
TMRDLTRG LI,R9    1                 SET THE SOFTWARE TRIGGER BIT                
         STS,R9   TDTRIG                                                        
         DO       #ONLINE           ON LINE RETURN TO DISPATCHER                
         LB,R1    TCBPOINT          ON LINE RETURN FROM CURRENT                 
         LW,R1    STITCB,R1             TASK TO DISPATCHER                      
         STW,R8   0,R1                  RETURN ADDRESS=NEXT DISP                
TMRDLTX  B        3,R1              ENTER AT LCFI TO SAVE REGS                  
         ELSE                                                                   
         LW,R9    TDRDLVL           TRIGGER THE CURRENT RDL                     
         WD,R9    *TDRDLGP          LEVEL                                       
TMRDLTX  B        *R8                                                           
         FIN                                                                    
         TITLE    'TASK MANAGEMENT SUBR - ALTER RTS FOR EXIT  TMSETERR'         
******************                                                              
*    TMSETERR    *       SUBROUTINE  TO SET R8 AND R10 IN RTS IF ERROR          
******************            OCCURED ON CAL1.   ALTERS RETURN PSD              
*                *            ACCORDING TO STANDARD FPT SPECS.                  
*                                                                               
* ENTRY: R2       DCB ADDRESS (I/O ONLY)                                        
*        R3       FPT ADDRESS                                                   
*        R15      ERROR CODE (BYTE 3)                                           
*        BAL,R8   TMSETERR    IF FPT ERROR/ABNORMAL ADDRESSES TO BE USE         
*                                                                               
*                                                                               
*                                                                               
* EXIT:  +1       ALL CONDITIONS, R15=TYC                                       
*                                                                               
* REGISTERS USED: R0,R8,R14,R15 IF ERROR                                        
*           SAVED: R1-R7,R9-R13                                                 
* STACK WORDS: 5                                                                
* SUBROUTINES: GETFPTN, TMSETREG,TMSETPSD                                       
* NOTES: TRAPX SAVED AND RESTORED                                               
*        TRANSLATES TYC'S LESS THAN OR EQUAL TO X'18'                           
*                                                                               
TMSETERR CI,R15   TYCNORM           IF TYC IS 00 OR 01, EXIT TO                 
         BLE      *R8                   CALLER                                  
         BIFBALA  TMSETE            OK TO CHANGE REG,PSD                        
         BIFBAL   *R8               ENTRY INTERNALLY, LEAVE RTS                 
*                                       OR TASK TERM? NO REG,PSD                
*                                       CHANGING                                
         B        TMSETE            GO DO PSD,REG SETTING                       
         TITLE    'TASK MANAGEMENT SUBR- TIMEOUT S-ECBS     TMTIMOUT'           
         DO       #TIMEOUT                                                      
******************                                                              
*    TMTIMOUT    *       SUBROUTINE TO TIMEOUT S-ECBS BELONGING TO              
******************            THE TASK WHOSE ID IS GIVEN                        
*                                                                               
* ENTRY: R5       TASK ID WHOSE ECB'S ARE TO BE TIMED-OUT                       
*        BAL,R7   TMTIMOUT                                                      
* EXIT   +1       TIMEOUTS DONE                                                 
*                                                                               
* REGISTERS USED; R0-R4,R6,R8-R15                                               
*           SAVED: R5,R7                                                        
* STACK WORDS: NONE                                                             
* SUBROUTINES: EMPOST - POSTING SUBROUTINE                                      
* NOTES                                                                         
*                                                                               
TMTIMOUT EQU      %                                                             
*                                                                               
TMTIMO1  RES      0                 GET LOAD MODULE ID OF TASK BEING            
*                                    TIMED.                                     
         LB,R2    STILMID,R5        R2= LMID                                    
         LW,R0    STITIME,R5        IS THERE A TIMER IN PROCESS                 
         BEZ      0,R7                  NO                                      
         SW,R0    K:UTIME           OVER THRESHOLD?                             
         BGZ      0,R7                  NO                                      
*                                                                               
         PUSH     R7                SAVE THE EXIT                               
         LI,R0    0                     BEFORE SCANNING ECB'S, SET              
         STW,R0   STITIME,R5            TASK'S CRITICAL TIME TO ZERO            
         DISABLE                        TIMED-OUT                               
         LW,R2    LMISECB,R2            GET S-ECB CHAIN HEAD                    
         B        TMTIMO3               DO FIRST S-ECB                          
TMTIMO2  LW,R2    ECBSECB,R2            GET NEXT S-ECB IN CHAIN                 
TMTIMO3  AND,R2   M24                                                           
         BEZ      TMTIMO9               NEXT ID=0, END, EXIT                    
         LW,R0    ECBFPT,R2             ECB BUSY?                               
         CW,R0    XECBBUSY                                                      
         BAZ      TMTIMO2                 NO- DO NEXT                           
         CW,R0    XECBTO            IF IN TIMEOUT BY ANOTHER                    
         BANZ     TMTIMO2               LOWER DISP, SKIP IT                     
         DO       #SWAP                                                         
         LW,R1    ECBCTL,R2         CHECK IF MM TYPE                            
         CI,R1    ECBTMM            AND IF SO DO NOT TIME OUT                   
         BE       TMTIMO2           B TO SKIP TIMEOUT                           
         FIN      #SWAP                                                         
         LW,R1    ECBTIME,R2            ECB TIMED?                              
         BEZ      TMTIMO2                 NO- DO NEXT                           
         SW,R1    K:UTIME               TIME THRESHOLD REACHED?                 
         BGZ      TMTIMO5                 NO- DO NEXT                           
*                                                                               
         OR,R0    XECBTO                                                        
         STW,R0   ECBFPT,R2                                                     
         LW,R6    TIMEOUT           POST THE ECB,                               
         LW,R7    ECBSECB,R2        SAVE NEXT ECB IN CHAIN                      
         BAL,R8   EMPOST                                                        
         B        TMTIMO4           NOT POSTED, REMOVE T0 FLAG                  
         LW,R2    R7                SET R2 TO NEXT ECB                          
         B        TMTIMO3               AND CONTINUE                            
*                                                                               
TMTIMO4  LI,R0    0                 RESET TO FLAG IN ECB                        
         LW,R1    XECBTO                                                        
         STS,R0   ECBFPT,R2                                                     
         LW,R2    R7                    SET R2 TO NEXT ECB                      
         B        TMTIMO3               AND CONTINUE                            
*                                                                               
TMTIMO5  LW,R0    ECBTIME,R2            S-ECB TIME FOUND, IS IT                 
         CW,R0    STITIME,R5            MORE CRITICAL THAN CURRENT              
         BGE      TMTIMO8           THRESHOLD IN STI..NO, BRANCH                
TMTIMO7  RES      0                                                             
         STW,R0   STITIME,R5            YES, SET A NEW CRITICAL TIME            
         B        TMTIMO2               IN THE STI                              
*                                                                               
TMTIMO8  LW,R1    STITIME,R5        IS THE CURRENT THRESHOLD ZERO               
         BEZ      TMTIMO7           YES, STORE FIRST ECB TIME FOUND             
         B        TMTIMO2           CONTINUE                                    
*                                                                               
TMTIMO9  PULL     R7                EXIT TO CALLER                              
         B        0,R7                                                          
         FIN      #TIMEOUT                                                      
         TITLE    'TASK MANAGEMENT SUBR - VALIDATE WAIT (F3) TMVALF3'           
******************                                                              
*    TMVALF3     *       VALIDATES F3 PARM IN STANDARD FPT (IE NOT              
******************            PRIMARY WITH WAIT                                 
* ENTRY: R3       FPT ADDRESS                                                   
*        BAL,R8   TMVALF3                                                       
* EXIT:  +1       ERROR, R15=X'6B' INVALID WAIT                                 
*        +2       AOK                                                           
* REGISTERS USED: R0, R15 IF ERRORS                                             
*           SAVED: R1-R14,R15 IF GOOD                                           
* STACK WORDS: NONE                                                             
* SUBROUTINES: NONE                                                             
*                                                                               
TMVALF3  BIFSEC   TMVALF3X          SECONDARY WAITS ARE ALWAYS LEGAL,           
         LW,R0    0,R3                  IS FPT EXTENDED?                        
         CW,R0    XFPTP0                BY P0 BIT                               
         BAZ      TMVALF3E              NO, ERROR                               
         LW,R0    1,R3                  PRIMARY MUST HAVE F3=0,                 
         CI,R0    FPTF3                 NO-WAIT.                                
         BAZ      TMVALF3X              AOK                                     
TMVALF3E CI,R15   TYC6B                 ERROR  SET R15 IF NOT ALREADY           
         BG       TMVAL3X1              GREATER.                                
         LI,R15   TYC6B                                                         
TMVAL3X1 B        *R8                                                           
TMVALF3X AI,R8    1                                                             
TMVAL3X2 B        *R8                                                           
         TITLE    'TASK MANAGEMENT SUBR - CONTROL TASK TRIGGER  CTRIG'          
******************                                                              
*    CTRIG       *       SUBROUTINE TO TRIGGER THE CONTROL TASK                 
******************                                                              
*                                                                               
* ENTRY: BAL,R11  CTRIG                                                         
* EXIT:  +1       NORMAL                                                        
* REGISTERS USED: -                                                             
*           SAVED: R0-R15                                                       
* STACK WORDS: 2  (SPUSH)                                                       
* SUBROUTINES: NONE                                                             
FGLTRIG  EQU      %                 ENTRY TO TRIGGER FOREGROUND                 
         MTB,1    K:FGLD            INDICATE FGLD SHOULD RUN                    
         PUSH     R11                   SAVE EXIT                               
         BAL,R11  CTRIG                 TRIGGER THE CTL TASK                    
         LW,R11   K:CTST                FLGD SET RUNNING?                       
         CW,R11   Y4                                                            
         BAZ      FGLTRG1               NO                                      
         LW,R11   Y0008                 YES                                     
         STS,R11  K:CTST               SET RECYCLE                              
FGLTRG1  PULL     R11               FETCH EXIT REG                              
         B        *R11                  EXIT                                    
*                                                                               
CTRIGA   DISABLE                    SAVE REGS                                   
         STD,R2   TEMP                                                          
*                                   DO NOT SET INTERNAL                         
         B        CTRIGB                TRIGGER FLAG                            
CTRIG    DISABLE                                                                
         STD,R2   TEMP                                                          
         LI,R3    1                 SET THE SOFTWARE TRIGGERED                  
         STS,R3   TDTRIG               BIT                                      
CTRIGB   LI,R2    CTID              SET THE START BIT IN THE STI                
         LW,R3    XSTISTRT              FOR THE CONTROL TASK                    
         STS,R3   STIPRIO,R2                                                    
         DO       #MULTDSP                                                      
         LW,R3    STITCB,R2         TRIGGER CT RDL LEVEL.                       
         LW,R3    STCBRDL,R3                                                    
         LH,R2    R3                                                            
         ELSE     #MULTDSP                                                      
         LW,R2    K:CTWD                                                        
         LW,R3    K:CTGL                                                        
         FIN      #MULTDSP                                                      
         WD,R3    0,R2                                                          
         LD,R2    TEMP                                                          
         ENABLE                                                                 
         B        *R11                                                          
         TITLE    'ENQ  MGMT SUBR TO DO ASSIGNMENT OF ENQ'                      
*******************                                                             
*    TMENQGO      *    SUBR TO ALTER BITS AND COUNTS IN AET                     
*******************      AND EDT WHEN ASSIGNMENT IS ACTUALLY MADE               
*                                                                               
* ENTRY  R1       AET                                                           
*        R7       EDT ADDRESS                                                   
*        ENTER DISABLED, EXITS DISABLED                                         
*        BAL,R8   TMENQGO                                                       
* EXIT   +1                                                                     
*                                                                               
* REGISTERS USED: R0,R4  (R4 RESET TO TASK ID ON EXIT)                          
*          SAVED: R1-R3,R5-R15                                                  
* STACK WORDS:    NONE                                                          
* SUBROUTINES:    NONE                                                          
*                                                                               
         DO       #ECB                                                          
TMENQGO  LW,R0    AETEDT,R1         SET AND RESET AET AND EDT                   
         LW,R4    EDTEDT,R7             FLAGS, COUNTERS, ETC                    
         OR,R0    XAETENQ               AET NOW ENQUEUED                        
         CW,R0    XAETSHAR              EXCLUSIVE?                              
         BAZ      TMEQG2                YES                                     
         OR,R4    XEDTSHAR              NO,  SET EDT SHARED                     
TMEQG2   STW,R0   AETEDT,R1                                                     
         STW,R4   EDTEDT,R7                                                     
         LI,R4    EDTUSE                INCR USE COUNT                          
         MTB,1    *R7,R4                                                        
         CW,R0    XAETJAET              IS THE ENQ A DEVICE                     
         BAZ      TMEQG3                ASSIGNMENT?                             
         LW,R0    AETECB,R1             YES, FETCH JOB ID                       
         LB,R0    R0                                                            
         LW,R4    EDTNAME,R7            'NAME' IS DCT INDEX                     
         STB,R0   DCTJID,R4             SET JOB ID                              
*                                                                               
TMEQG3   LB,R4    TCBPOINT              SET R4=TCBPOINT                         
         B        *R8                   EXIT                                    
         TITLE    'ENQ  MGMT SUBR TO REMOVE AN ECB FROM EDT CHAIN'              
*******************                                                             
*    TMREECB      *    SUBR TO REMOVE AN ECB FROM AN EDT CHAIN                  
*******************                                                             
*                                                                               
* ENTRY  R2       ECB ADDRESS                                                   
*        R7       EDT ADDRESS                                                   
*        BAL,R8   TMREECB                                                       
* EXIT   +1       ECB REMOVED                                                   
* REGISTERS USED: R15 IF ERROR                                                  
*          SAVED: R0-R14,R15 IF GOOD                                            
* STACK WORDS:    2                                                             
* SUBROUTINES:    NONE                                                          
*                                                                               
TMREECB  PUSH     2,R3              SAVE REGISTERS                              
         AND,R2   M24                   ISOLATE ADDRESS                         
         LI,R4    0                     R4=PREV ECB                             
         DISABLE                                                                
         LW,R3    EDTECB,R7             R3=NEXT ECB                             
TMREE1   AND,R3   M24                   END OF CHAIN?                           
         BEZ      TMREE5                YES, NOT IN CHAIN                       
         CW,R2    R3                    IS IT THE ONE TO BE                     
         BE       TMREE2                REMOVED?                                
         LW,R4    R3                    NO, SET R4=PREV                         
         LW,R3    ECBRECB,R3            R3=NEXT                                 
         B        TMREE1                CONTINUE                                
TMREE2   LW,R3    ECBRECB,R2        ENTRY FOUND, REMOVE IT                      
         CI,R4    0                     REMOVING CHAIN HEAD?                    
         BE       TMREE3                YES                                     
         STW,R3   ECBRECB,R4            NO, CHAIN PREV TO NEXT                  
         B        TMREE4                ECB WRT ONE BEING REMVD                 
TMREE3   LW,R4    EDTECB,R7         SAVE USE COUNT                              
         LB,R4    R4                                                            
         STB,R4   R3                                                            
         STW,R3   EDTECB,R7             AND STORE NEW CHAIN HEAD                
TMREE4   LI,R3    0                 ZERO R-CHAIN                                
         STW,R3   ECBRECB,R2                                                    
TMREE5   ENABLE                                                                 
         PULL     2,R3                                                          
         B        *R8                                                           
         TITLE    'ECB MANAGEMENT SUBR - DELETE AN ECB      EMDELECB'           
******************                                                              
*    EMDELECB    *       SUBROUTINE TO DELETE AN ECB INCLUDING ANY              
******************            ATTACHED DATA AREAS                               
*                                                                               
* ENTRY: R2       ECB ID                                                        
*        BAL,R8   DELECB                                                        
* EXITS: +1       ERROR       R15= X'FF' SYSTEM ERROR, ECB NOT IN               
*                                        CHAIN OR COUNT NEGATIVE                
*        +2       NORMAL      R15=ENTRY VALUE                                   
* REGISTERS USED: R0,R15 IF ERRORS                                              
*          SAVED: R1-R14                                                        
* STACK WORDS:    5                                                             
* SUBROUTINES: RELTEMP, EMRSECB, EMRRECB                                        
*                                                                               
EMDELECB PUSH     5,R7              SAVE R7-R11                                 
EMDELE1  LW,R7    ECBDATA,R2        TEST FOR A DATA AREA                        
         MTB,0    R7                LENGTH=0, NOT AN AREA                       
         BEZ      EMDELE2                                                       
         LW,R0    0,R7                  REMOVE FIRST DATA AREA                  
         DISABLE                        AND CHAIN ECB TO                        
         STW,R0   ECBDATA,R2            NEXT AREA IN CHAIN                      
         BAL,R8   RELTEMPI          RELEASE DATA AREA                           
         B        EMDELE1                                                       
*                                                                               
EMDELE2  RES      0                                                             
         DISABLE                                                                
         BAL,R8   EMRRECB           REMOVE ECB FROM R-CHAIN                     
         B        EMDELE5               ERROR                                   
         BAL,R8   EMRSECB               REMOVE FROM S-CHAIN                     
         B        EMDELE5               ERROR                                   
         LW,R7    R2                RELEASE ECB TO T-SPACE MNGR                 
         LI,R2    ECBSIZE                                                       
         STB,R2   R7                                                            
         BAL,R8   RELTEMPI          RLS ECB TSPACE                              
         PULL     5,R7                                                          
         AI,R8    1                                                             
         B        *R8                                                           
EMDELE5  PULL     5,R7                                                          
         B        *R8                                                           
         TITLE    'ECB MANAGEMENT SUBR - REMOVE AN R-ECB    EMRRECB'            
******************                                                              
*    EMRRECB     *       SUBROUTINE TO REMOVE AN R-ECB FROM THE R-CHAIN         
******************                                                              
*                                                                               
* ENTRY: R2       ECB ID                                                        
*        BAL,R8   EMRRECB                                                       
*        +1       ERROR EXIT                                                    
*        +2       NORMAL                                                        
* REGISTERS USED: R0-R1,R7,R15 IF ERRORS                                        
*           SAVED: R2-R6,R8-R14,R15    IF NO ERRORS                             
* SUBROUTINES: NONE                                                             
*                                                                               
EMRRECB  LI,R0    0                     R0=PREV R-ECB                           
         AND,R2   M24                   R2=ECB TO BE REMOVED                    
         LI,R7    ECBRTID               R7=R-TASK ID                            
         LB,R7    *R2,R7                                                        
         BEZ      EMRRE5                NOT LINKED                              
         LW,R1    LMIRECB,R7            R1=FIRST ECB IN CHAIN                   
EMRRE1   AND,R1   M24                                                           
         BEZ      EMRRE5            B IF ECB NOT ON CHAIN                       
         CW,R1    R2                    = ECB TO BE REMOVED?                    
         BE       EMRRE2                YES                                     
         LW,R0    R1                    SET PREV= OLD NEXT ECB                  
         LW,R1    ECBRECB,R1            NEXT = NEW NEXT ECB ' CONTINUE          
         B        EMRRE1                                                        
EMRRE2   LW,R1    LMIRECB,R7        DECREMENT THE R-ECB COUNT                   
         MTB,-1   R1                                                            
         STW,R1   LMIRECB,R7                                                    
         CI,R0    0                     REMOVNG CHAIN HEAD                      
         BNE      EMRRE3                NO                                      
         LB,R0    R1                    SAVE R-ECB COUNT AND                    
         LW,R1    ECBRECB,R2            COMBINE WITH NEW CHAIN                  
         STB,R0   R1                    HEAD AND STORE                          
         STW,R1   LMIRECB,R7                                                    
         B        EMRRE4                                                        
EMRRE3   LW,R1    ECBRECB,R2            CHAIN PREV ECB TO THE                   
         LI,R7    ECBRECB               NEXT ECB                                
         STW,R1   *R0,R7                                                        
EMRRE4   LI,R0    0                 ZERO THE R-ECB CHAIN WORD                   
         STW,R0   ECBRECB,R2                                                    
EMRRE5   RES      0                                                             
         AI,R8    1                 SET TO GOOD EXIT                            
         B        *R8                   EXIT                                    
         TITLE    'ECB MGMT SUBR - REMOVE AN ECB FROM S-ECB CHAIN'              
******************                                                              
*    EMRSECB     *       REMOVE ECB FROM S-ECB CHAIN                            
******************                                                              
*                                                                               
* ENTRY: R2       ECBID                                                         
*                                                                               
* EXITS: +1       ERROR  R15= X'FF'                                             
*        +2       NORMAL                                                        
* REGISTERS USED: R0,R1,R7,R8,R15    IF ERRORS                                  
*           SAVED: R2-R6,R9-R14,R15  IF GOOD                                    
* STACK WORDS: NONE                                                             
* SUBROUTINES: NONE                                                             
*                                                                               
*                                                                               
EMRSECB  LI,R0    0                     R0=PREV S-ECB                           
         AND,R2   M24                   R2=ECB TO REMOVE                        
         LI,R7    ECBSTID                                                       
         LB,R7    *R2,R7            R7 = LMID                                   
         BEZ      EMRSE5                NOT LINKED, EXIT                        
         LW,R1    LMISECB,R7            R1=NEXT S-ECB                           
EMRSE1   AND,R1   M24                                                           
         BEZ      EMRSE7                END OF CHAIN?                           
         CW,R1    R2                    =ECB TO BE REMOVED                      
         BE       EMRSE2                YES                                     
         LW,R0    R1                    NO- LINK ON THROUGH CHAIN               
         LW,R1    ECBSECB,R1                                                    
         B        EMRSE1                                                        
EMRSE2   LW,R1    LMISECB,R7        FOUND - DECREMENT S-ECB COUNT               
         MTB,-1   R1                                                            
         STW,R1   LMISECB,R7                                                    
         CI,R0    0                     REMOVING CHAIN HEAD?                    
         BNE      EMRSE3                NO                                      
         LB,R0    R1                    SAVE COUNT                              
         LW,R1    ECBSECB,R2            R1= NEW HEAD S-ECB                      
         STB,R0   R1                    STORE IN CHIAN HEAD                     
         STW,R1   LMISECB,R7                                                    
         B        EMRSE4                                                        
EMRSE3   LW,R1    ECBSECB,R2            R1=NEXT ECB FR ECB                      
         LI,R7    ECBSECB               BEING DELINKED, MOVE                    
         STW,R1   *R0,R7                TO PREV ECB IN CHAIN                    
EMRSE4   LI,R0    0                 ZERO SECB WORD IN ECB REMOVED               
         STW,R0   ECBSECB,R2                                                    
EMRSE5   RES      0                                                             
         AI,R8    1                 SET TO GOOD EXIT                            
         B        *R8                                                           
EMRSE7   CRASH    'EMRSECB'         CHAIN ERROR IN S-ECB                        
         TITLE    'ECB MANAGEMENT SUBR - ENTER POSTING SUBR. EMPOST'            
******************                                                              
*    EMPOST      *          LINKAGE TO ENTER THE POSTING SUBROUTINE             
******************            FOR THE ECB                                       
*                                                                               
* ENTRY: R2       ECB ADDRESS                                                   
*        R6       COMPLETION STATUS WORD                                        
*        R8       LINK                                                          
*        R0,R1,   USED BY EMPOST                                                
*        R3-R15   PASSED ON TO POSTING SUBROUTINE                               
*        BAL,R8   EMPOST                                                        
* EXITS  +1       ERROR, R15 = TYC = X'86' ILLEGAL ECB ID                       
*                                  = VALUES SET BY INDIVIDUAL POSTING           
*                                    SUBROUTINES FOR THE ECB TYPE               
*                                                                               
*        +2       NORMAL, POST WAS SUCCESSFUL                                   
*                                                                               
* REGISTERS USED:  R0,R1,  R15 IF ERRORS                                        
*           SAVED: R2-R14, R15 IF NO ERRORS                                     
* STACK WORDS: 0                                                                
* SUBROUTINES: PASSES CONTROL TO ECB POSTING SUBROUTINE, LINK IN R8             
* NOTES: ALWAYS ENTERS POSTING SUBR ENABLED                                     
* TRAPS: NOT ALTERED                                                            
*                                       R2=ECB ID                               
*                                       R5=CONTENT FOR SIGNAL ADDRESS           
*                                       R6=TYC/COMPL STATUS WORD                
*                                       R7,R12-R15 I/O ARGUMENTS                
*                                       R8=LINK                                 
EMPOST   DISABLE                                                                
         LW,R0    ECBFPT,R2             POSTING.                                
         CW,R0    XECBPOST              TESTS/SETS POST                         
         BAZ      EMPOST2               TESTS ECB TYPE =0                       
*                                                                               
*                                                                               
EMPOST1  LI,R15   TYC86             EXIT TO CALLER- NO CHANGE IN                
         B        *R8                   EXECUTION MODE                          
EMPOST2  LW,R1    ECBCTL,R2             IF POSTABL, SETS POST,                  
         AND,R1   XECBTYPE              RETURNS +2, R1=ECB TYPE                 
         BEZ      EMPOST1                                                       
         OR,R0    XECBPOST                                                      
         STW,R0   ECBFPT,R2                                                     
*                                   8 MARCH 78                                  
         LB,R0    EMPOSTX,R1        GET ECB TYPE                                
         CI,R0    6                 ENQ TYPE?                                   
         BE       %+2               YES, DONT ENABLE                            
*        B        %+2               YES, DONT ENABLE                            
         ENABLE                                                                 
         LB,R1    EMPOSTX,R1            GOOD - POST SET,                        
         LW,R0    EMPOSTB,R1            R1= ECB TYPE                            
         B        *R0               ENTER POSTING SUBROUTINE                    
EMPOSTCR CRASH    'ECB TYPE ERROR, EMPOST'                                      
         PAGE                                                                   
***********************************************************************         
*        ECB TYPES AND ECB TYPE TABLES                                          
***********************************************************************         
*                                                                               
*        ECB POSTING SUBROUTINE INDEX TABLE       ONE ENTRY/ECB TYPE            
*                                                                               
         BOUND    4                                                             
EMPOSTX  DATA,1   0           +ECB TYPE   0  ILLEGAL                            
         DATA,1   1           YIELDS      1  I/O                                
         DATA,1   2           INDEX INTO  2  SIGNAL                             
         DATA,1   3           EMPOSTB     3  STIMER                             
         DATA,1   4                       4  POLL                               
         DATA,1   2                       5  INIT-SIGNAL POST                   
         DATA,1   6                       6  ENQ                                
         DATA,1   5                       7  MM REQ                             
         DATA,1   6                       8  STDLB-ENQ POST                     
*                                                                               
*        ECB POSTING SUBROUTINE BRANCH TABLE      ONE ENTRY/INDEX               
*                                                                               
EMPOSTB  B        EMPOSTCR    +INDEX    0    ECB TYPES                          
         B        FMABORT           1    1-I/O                                  
         B        SIGPOST               2    2,5-SIGNAL,INIT                    
         B        STIMPOST              3    3-STIMER                           
         B        POLLPOST              4    4-POLL                             
         DO       #MAP&#ROLL                                                    
         B        MMPOST                7    7-MEM REQ                          
         ELSE                                                                   
         B        EMPOSTCR                                                      
         FIN      #MAP&#ROLL                                                    
         B        ENQPOST               6    6,8-ENQ,STDLB                      
         TITLE    'ECB MANAGEMENT SUBR - POST ECB, DO END ACT. EMPOSTYC'        
******************                                                              
*    EMPOSTYC    *       SUBROUTINE TO STORE TYPE COMLETION INTO ECB,           
******************            UPDATING DISPATCHER CONTROLS OR DOING             
*                             END-ACTION                                        
* ENTRY: R2       ECB ID                                                        
*        R3       1ST HALF OF TDV STATUS(I/O ONLY)                              
*        R4       TIO STATUS (I/O ONLY)                                         
*        R5       VALUE FOR SIGNAL ADDRESS                                      
*        R6       TYC WORD                                                      
*        R7       DCT INDEX (I/O ONLY)                                          
*        R8       LINK                                                          
*        R9       2ND HALF OF TDV STATUS (I/O ONLY)                             
*        BAL,R8   EMPOSTYC                                                      
* EXIT   +1       ALL RETURNS, EXITS ENABLED                                    
*                                                                               
* REGISTERS USED.  R0-R4,R6,R8-R15 (BAL END ACION )                             
*           SAVED: R5,R7                                                        
*                                                                               
* SUBROUTINES: TMDQ,TMTPRIO                                                     
* NOTES: ECB MAY BE DELETED BY RETURN FROM EMPOSTYC                             
*   EXECUTES DISABLED FROM START TO FINISH                                      
*                                                                               
*                                                                               
EMPOSTYC DISABLE                                                                
         PUSH     R8                SAVE LINK                                   
         PUSH     7,R3              SAVE I/O END-ACTION INFO.                   
         STW,R6   ECBCOMPL,R2       STORE TYPE COMPLETION WORD AND SET          
         LW,R10   XECBNBSY              BUSY=0                                  
         AND,R10  ECBFPT,R2             R10=SEC ACTION FLAGS                    
         STW,R10  ECBFPT,R2                                                     
         LW,R9    ECBSECB,R2            R9=LMID OF S-TASK                       
         LW,R6    ECBENDAC,R2           R6=PRIMARY END ACTION                   
         LB,R4    R9                R4= TASK LMID                               
         BEZ      EMPTYC1           NO S-TASK, DELETE ECB                       
         CW,R10   XECBDP            IS DELETE ON POST SET                       
         BAZ      EMPTYC2           NO, BRANCH                                  
EMPTYC1  RES      0                 HERE THE ECB WILL BE DELETED                
         PUSH     R6                SAVE PRIMARY END ACTION                     
*                                       CREATION PHASE                          
*                                       FIRST SAVE ENDACTION                    
         BAL,R8   EMDELECB          DELETE THE ECB                              
         NOP                                                                    
         PULL     R6                RESTORE T6                                  
         LI,R10   0                 NO SECONDARY END-ACTION                     
EMPTYC2  RES      0                                                             
         BAL,R3   EMPTYC3           DO SEC. AND TRIGGER END-ACTIONS             
         LW,R1    R6                R1= PRIMARY END ACTION WORD                 
         PULL     7,R3              RESTORE I/O END ACTION DATA                 
         XPSD,0   EMPTYCO           SWITCH TO REAL MODE, DISABLED               
EMPTYCA  RES      0                 HERE FROM ABOVE XPSD                        
         LI,R11   EMPTYCF           RETURN FOR VIRTUAL CALLER                   
         LW,R0    EMPTYCO           GET CALLER'S PSD WORD 0                     
         CW,R0    XBIT9             IS CALLER MAPPED                            
         BANZ     %+3               YES, R11 SET CORRECTLY                      
         LI,R11   EMPTYCG           SET R11 FOR REAL CALLER EXIT                
         ENABLE                                                                 
         LB,R0    R1                R0= END ACTION TYPE                         
         BEZ      *R11              EXIT IF NONE                                
         CI,R0    ECBEABAL          IS IT BAL TYPE END-ACTION                   
         BNE      EMPTYCB           NO, BRANCH                                  
         LW,R6    R4                R6= TIO STATUS                              
         LW,R8    R3                R8= 1ST HALF OF TDV STATUS                  
         B        0,R1              BAL,R11 TO USER'S END ACTION                
*                                                                               
EMPTYCB  RES      0                                                             
         CI,R0    ECBEASIG          IS IT SIGNAL TYPE END ACTION                
         BNE      *R11              NO, EXIT                                    
         STW,R5   0,R1              YES, STORE SIGNAL VALUE                     
         B        *R11              EXIT                                        
*                                                                               
EMPTYCF  LPSD,0   EMPTYCN           MAPPED CALLER, SWITCH TO MAP MODE           
EMPTYCG  PULL     R11               REAL CALLER, LEAVE MODE REAL                
         B        *R11              EXIT EMPOSTYC                               
*                                                                               
*                                                                               
*   CHECK FOR AND DO END-ACTIONS FOR SECONDARY AND TRIGGER TYPE                 
*   END ACTIONS FOR PRIMARY.   DO NOT DO BAL AND SIGNAL                         
*   END ACTIONS HERE.                                                           
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*   AT ENTRY:     R3   BAL REGISTER                                             
*                 R4   S-LINK LOAD MODULE ID                                    
*                 R6   PRIMARY END ACTION WORD                                  
*                 R10  ECB WORD 1 OR 0 IF NO SEC. END-ACTION                    
*                                                                               
EMPTYC3  CI,R4    0                 LMID PROVIDED?                              
         BE       EMPTYC5           B IF NO S-LINK LMID                         
         LW,R0    LMISDT,R4         GET THE TASK ID FOR SECONDARY               
         LB,R4    R0                    END ACTIONS                             
         BNEZ     EMPTYC5                                                       
         LI,R10   0                     NO SECONDARY END ACTIONS                
EMPTYC5  CI,R6    0                 ANY PRIMARY END ACTIONS?                    
         BE       EMPTYC7               NO                                      
         LB,R1    R6                    FIRST TO SIGNAL AND                     
         CI,R1    ECBEASIG          IS IT SIGNAL TYPE E.A.                      
         BE       EMPTYC7           YES, DEFER IT                               
         CI,R1    ECBEABAL          IS IT BAL TYPE E.A.                         
         BE       EMPTYC7           YES, DEFER IT                               
         WD,R6    TMTRIGAD,R1           TRIGGER LEVEL, THEN SET TRIGGER         
         SLS,R6   8                     BIT IN TASKS TCB, GET LOC OF            
*        SWITCH TO REAL MODE TO SET TRIGGER BIT IN TCB                          
         XPSD,0   EMPTYCP                                                       
EMPTYC6  RES      0                 HERE FROM %-1                               
         LI,R1    X'1FFFF'          MASK FOR STS INSTRUCTION                    
         LI,R0    EMPTYC7           SET ADDRESS FOR LPSD TO FOLLOW              
         STS,R0   EMPTYCP           STORE ADDR IN PSD                           
         LB,R1    R6                    XPSD TO FIND TCB (PRIO+4F=XPSD)         
         LW,R1    X'4F',R1              XPSD ADDRESSES TCB                      
         LW,R0    TCBPCB,R1                                                     
         OR,R0    XTCBTRIG                                                      
         STW,R0   TCBPCB,R1                                                     
*        SWITCH BACK TO MODE AT SUBROUTINE ENTRY                                
         LPSD,0   EMPTYCP                                                       
EMPTYC7  EQU      %                                                             
         DO1      #SWAP                                                         
         MTB,1    STIQMAX,R4        INCR ONE TICK FOR EACH ECB                  
         CW,R10   XECBWD            SECONDARY END ACTION REQUESTED              
         BAZ      EMPTYC10          NO                                          
*   DO SECONDARY END-ACTION                                                     
         LB,R0    STICOUNT,R4       COUNTER ALREADY ZERO?                       
         BEZ      EMPTYC10          ALREADY ZERO ,BRANCH                        
         MTB,-1   STICOUNT,R4           DECREMENT IT                            
         BNEZ     EMPTYC9           B IF COUNT NOT ZERO                         
*   HERE THE COUNT HAS GONE TO ZERO. DO SECONDARY END-ACTION.                   
         LW,R8    STITCB,R4         IS TASK COMING OFF LONG WAIT                
         DO       #SWAP                                                         
         CW,R8    XSTIBLK           IS IT BLOCKED                               
         BANZ     EMPTYC7A          YES                                         
         FIN      #SWAP                                                         
        DO       #ROLL                                                          
         DO       #TJE                                                          
         CW,R8    XSTITINP          IS IT TERM INPUT                            
         BANZ     EMPTYC7A          YES                                         
         FIN      #TJE                                                          
         CW,R8    XSTILW            IF SO THEN CHECK FOR ROLL-OUT               
         BAZ      EMPTYC8           B IF NOT LONG WAIT                          
EMPTYC7A BAL,R8   MMRILW            SET HIM UP TO ROLL-IN                       
        FIN      #ROLL                                                          
*                                                                               
         DO1      #TSLICE                                                       
         B        EMPTYC8A          ALSO DISP HIGH                              
EMPTYC8  EQU      %                                                             
         DO       #TSLICE                                                       
         LB,R8    STISTAT,R4        CHECK IF TASK IS                            
         CI,R8    STISLICE          TIME-SLICED                                 
         BAZ      EMPTYC8A          B IF NOT TIME-SLICED                        
         LB,R1    STILMID,R4        GET LMID                                    
         LH,R0    LMISTAT,R1                                                    
         CI,R0    LMIBKG            CHECK FOR BACKGROUND TASK                   
         BAZ      EMPTYC8B          B IF NOT BACKGROUND                         
EMPTYC8A EQU      %                                                             
         FIN      #TSLICE                                                       
        DO1      #MULTDSP                                                       
         XPSD,0   TMDQ                  YES, REQUEUE TO TOP                     
         DO1      #TSLICE                                                       
EMPTYC8B EQU      %                                                             
         BAL,R8   TMTPRIO               OF PRIO GROUP                           
EMPTYC9  B        0,R3              RETURN                                      
*                                                                               
EMPTYC10 LB,R0    STISTAT,R4        SUPER STOP                                  
         CW,R0    XSTISUSP                                                      
         BAZ      EMPTYC9           NO                                          
         EOR,R0   XSTISUSP          RESET                                       
         STB,R0   STISTAT,R4                                                    
         B        EMPTYC8           GET IT GOING                                
*                                                                               
*                                                                               
         BOUND    8                 DOUBLEWORD PSD FOR SWITCHIN                 
EMPTYCN  GEN,9,1,22  0,1,EMPTYCG    MAPPED                                      
         DATA     0                                                             
EMPTYCO  DATA     0,0               CALLER'S PSD SAVED HERE                     
         DATA     EMPTYCA           NEW LOCATION                                
         DATA     X'07000000'       UNMAPPED,DISABLED                           
         BOUND    8                                                             
EMPTYCP  DATA     0,0               SAVED PSD                                   
         DATA     EMPTYC6           NEX PSD WORD 0; REAL MODE                   
         DATA     X'07000000'       NEW PSD WORD 1; DISABLED                    
         FIN      #ECB                                                          
         TITLE    'POSTEOD SUBROUTINE'                                          
***************                                                                 
*   POSTEOD   *                                                                 
***************                                                                 
*                                                                               
*   ROUTINE DOES CLEANUP AND POSTING WHEN AN                                    
*   EOT CONDITION OCCURS ON A RAD FILE.                                         
*                                                                               
*   AT ENTRY:     R1   FPT CODE                                                 
*                 R2   DCB ADDRESS                                              
*                 R3   FPT ADDRESS                                              
*                 R7   RFT INDEX                                                
*                                                                               
*                                                                               
POSTEOD  RES      0                                                             
         CI,R1    K10               IS FPT CODE READ                            
         BE       %+2                                                           
         MTW,-1   RFT6,R7           DECREMENT FILE SIZE                         
         LW,R6    RFT17,R7          R6= BBCW ADDRESS                            
         BEZ      POST05                                                        
         LI,R8    0                                                             
         STW,R8   RFT17,R7                                                      
         STB,R8   RFT14,R7          ZERO JOB USING BLK BUFFER                   
         PUSH     2,R2              SAVE R2,R3                                  
         BAL,R11  RELADBUF          UNTIE AND RELEASE BB                        
         PULL     2,R2              RESTORE R2,R3                               
         B        POST05                                                        
*                                                                               
*                                                                               
         DO       #ECB                                                          
IOCRASH  CRASH    'CANT DELETE ECB'                                             
         FIN      #ECB                                                          
         TITLE    'CVTFILE - CONVERT RFT INDEX AND FILE POSITION'               
*                                                                               
* IN:    R7       RFT INDEX                                                     
*        R14      SECTOR NUMBER RELATIVE TO FILE START                          
*        R5       LINK                                                          
*                                                                               
* OUT:   R12      SEEK ADDRESS                                                  
*        R7       DCT INDEX                                                     
*        R15      TYC               (IF ERROR)                                  
*                                                                               
* EXIT + 1 IS OK EXIT                                                           
* EXIT + 0 IS ERROR EXIT                                                        
*                                                                               
*                                                                               
* TYC = 70 IF MASTER DICTIONARY INDEX INVALID OR AREA NOT ALLOCATED             
* TYC = 1C IF REQUEST EXCEEDS END OF FILE, AREA OR DISC                         
* TYC = 1D IF REQUEST PRECEEDS DISC START                                       
* TYC = 71 IF RFT INDEX INVALID                                                 
* TYC = 4F IF DCT INDEX INVALID                                                 
*                                                                               
CVTFILE  RES      0                                                             
         CH,R7    RFT4              IS RFT INDEX OK                             
         BLE      CVTFILE2          YES                                         
*                                   NO                                          
         LI,R15   X'71'             CODE FOR BAD FILE ID                        
         B        0,R5                                                          
********                                                                        
CVTFILE2 RES      0                                                             
         PUSH     R14                                                           
         AW,R14   RFT2,R7           ADD START FILE SECTOR #                     
         CW,R14   RFT3,R7           IS IT TOO BIG                               
         BLE      CVTFILE4          NO                                          
*                                   YES                                         
         LI,R15   X'1C'             SET EOT TYC                                 
         PULL     R14                                                           
         B        0,R5              ERROR EXIT                                  
********                                                                        
CVTFILE4 RES      0                                                             
         LB,R6    RFT8,R7           GET MASTER DICTIONARY INDEX                 
         B        CVTAREA1          AND CONTINUE CONVERSION                     
         TITLE    'CVTAREA - CONVERT MD INDEX AND AREA POSITION'                
*                                                                               
* IN:    R6       MD INDEX                                                      
*        R14      SECTOR NUMBER RELATIVE TO AREA START                          
*        R5       LINK                                                          
*                                                                               
* OUT:   R12      SEEK ADDRESS                                                  
*        R7       DCT INDEX                                                     
*        R15      TYC               (IF ERROR)                                  
*                                                                               
* EXIT + 1 IS OK EXIT                                                           
* EXIT + 0 IS ERROR EXIT                                                        
*                                                                               
*                                                                               
* TYC = 70 IF MASTER DICTIONARY INDEX INVALID OR AREA NOT ALLOCATED             
* TYC = 1C IF REQUEST EXCEEDS END OF AREA OR DISC                               
* TYC = 1D IF REQUEST PRECEEDS DISC START                                       
* TYC = 4F IF DCT INDEX INVALID                                                 
*                                                                               
CVTAREA  RES      0                                                             
         PUSH     R14                                                           
CVTAREA1 RES      0                                                             
         CW,R6    K:NUMDA           CHECK MD INDEX LIMITS                       
         BLE      CVTAREA2          OK                                          
*                                   BAD                                         
         LI,R15   X'70'             MD ERROR CODE                               
         PULL     R14                                                           
         B        0,R5                                                          
********                                                                        
CVTAREA2 RES      0                                                             
         LB,R12   MDFLAG,R6         GET MD FLAGS                                
         CI,R12   ALLOC             IS DICTIONARY ALLOCATED                     
         BANZ     CVTAREA3          YES                                         
*                                   NO                                          
         LI,R15   X'70'             MD ERROR CODE                               
         PULL     R14                                                           
         B        0,R5                                                          
********                                                                        
CVTAREA3 RES      0                                                             
         AW,R14   MDBOA,R6          ADD START OF AREA                           
         CW,R14   MDEOA,R6          IS IT TOO BIG                               
         BLE      CVTAREA4          OK                                          
*                                   TOO BIG                                     
         LI,R15   X'1C'             SET EOT TYC                                 
         PULL     R14                                                           
         B        0,R5                                                          
********                                                                        
CVTAREA4 RES      0                                                             
         LB,R7    MDDCTI,R6         GET DCT INDEX                               
         B        CVTDISC1          AND CONTINUE                                
         TITLE    'CVTDISC - CONVERT DCT INDEX AND DISC POSITION'               
*                                                                               
* IN:    R7       DCT INDEX                                                     
*        R14      SECTOR NUMBER RELATIVE TO DISC START                          
*        R5       LINK                                                          
*                                                                               
*                                                                               
* OUT:   R12      SEEK ADDRESS                                                  
*        R7       DCT INDEX                                                     
*        R15      TYC               (IF ERROR)                                  
*                                                                               
* EXIT + 1 IS OK EXIT                                                           
* EXIT + 0 IS ERROR EXIT                                                        
*                                                                               
*                                                                               
* TYC = 1C IF REQUEST EXCEEDS END OF AREA OR DISC                               
* TYC = 1D IF REQUEST PRECEEDS DISC START                                       
* TYC = 4F IF DCT INDEX INVALID                                                 
*                                                                               
CVTDISC  RES      0                                                             
         PUSH     R14                                                           
CVTDISC1 RES      0                                                             
         CH,R7    DCT1              IS DCT INDEX OK                             
         BLE      CVTDISC2          YES                                         
*                                   NO                                          
         LI,R15   X'4F'             BAD DCT INDEX FORMED                        
         PULL     R14                                                           
         B        0,R5              ERROR EXIT                                  
********                                                                        
CVTDISC2 RES      0                                                             
         PUSH     R5                SAVE LINK                                   
         LB,R5    DCTDISCI,R7       GET DISC TABLE INDEX                        
         CW,R14   DISCMAXS,R5       IS IT TOO BIG                               
         BLE      CVTDISC4          NO                                          
*                                   YES                                         
         LI,R15   X'1C'             SET EOT TYC                                 
         PULL     R5                                                            
         PULL     R14                                                           
         B        0,R5              ERROR EXIT                                  
********                                                                        
CVTDISC4 RES      0                 NOW START SEEK ADDRESS CONVERSION           
         CW,R14   DISCMINS,R5       IS IT TOO SMALL                             
         BGE      CVTDISC3          NO                                          
*                                   YES                                         
         LI,R15   X'1D'             BOT CODE                                    
         PULL     R5                                                            
         PULL     R14                                                           
         B        0,R5              ERROR EXIT                                  
********                                                                        
CVTDISC3 RES      0                                                             
         PUSH     2,R15             SAVE R15 AND R0                             
         SLD,R14  -32               CLEAR R14                                   
*                                                                               
         LB,R0    DISCNSPT,R5       GET NSPT                                    
         DW,R14   R0                GET SECTOR # IN R14                         
         LB,R0    DISCSSFT,R5       GET SECTOR SHIFT                            
         SLS,R14  *R0               POSITION SECTORS                            
         LW,R12   R14               AND PUT IN R12                              
         LI,R14   0                                                             
         LH,R0    DISCNTPC,R5       GET NUMBER OF TRACKS/CYLINDER               
         DW,R14   R0                GET TRACK # AND CYLDER #                    
         LB,R0    DISCTSFT,R5       GET TRACK SHIFT                             
         SLS,R14  *R0               POSITION TRACK #                            
         OR,R12   R14               AND MERGE IT INTO R12                       
         LB,R0    DISCCSFT,R5       GET CYLINDER SHIFT                          
         SLS,R15  *R0               POSITION CYLINDER #                         
         OR,R12   R15               MERGE IN CYLINDER #                         
         PULL     2,R15                                                         
         PULL     R5                                                            
         PULL     R14                                                           
         B        1,R5              EXIT AT NORMAL (OK) EXIT                    
         TITLE    'CALL QUEUE'                                                  
*************                                                                   
*   CALLQ   *                                                                   
*************                                                                   
*                                                                               
*   THIS ROUTINE CALLS QUEUE & WAITS FOR COMPLETION OF THE I/O                  
*   ENTER AT CALLQP IF PRIORITY IS IN R13                                       
*                                                                               
*   AT ENTRY:     R2    DCB ADDRESS IF CLEANUP CODE = 1 OR 2                    
*                 R3    FPT ADDRESS IF CLEANUP CODE = 1 OR 2                    
*                 R4    FUNCTION CODE                                           
*                 R5    LINK                                                    
*                 R7    DCT INDEX                                               
*                 R8    CLEANUP INFO WORD 1                                     
*                 R9    CLEANUP INFO WORD 2                                     
*                 R10   VIRTUAL I/O BUFFER ADDRESS (BYTE) OR ZERO               
*                 R11   BYTE COUNT                                              
*                 R12   RAD SEEK ADDRESS                                        
*                 R13   PRIORITY IF ENTRY IS TO CALLQP                          
*                 R15   -1 IF NOT A DIRECTORY UPDATE                            
*                       OTHERWISE, R15 HAS REENTRANCE COUNT TO BE               
*                       CHECKED AGAINST RENT:D IN FMQUEUE SUBR.                 
*                                                                               
*   AT EXIT:      R6     TYC CODE                                               
*                                                                               
*                                                                               
CALLQ    RES      0                                                             
         LB,R6    TCBPOINT          STI INDEX (WORD ALIGNMENT)                  
         LW,R6    STIPRIO,R6        PRIORITY WORD                               
         LB,R13   R6                HARDWARE PRIORITY                           
CALLQP   RES      0                 R13= PRIORITY                               
         LW,R1    R2                DCB ADDRESS TO R1                           
         PUSH     R5                SAVE LINK                                   
         DO       #ECB                                                          
         LI,R6    40                R6 = RETRY COUNT                            
         DO       #SYMB                                                         
         PUSH     13,R1             SAVE R1-R13                                 
         BAL,R5   COOP              CALL COOPERATIVE ROUTINE                    
         B        CALLQER0          +1, ERROR WITH TYC IN R9                    
         B        CALLQ10           +2, SYMBIONT I/O DONE                       
         PULL     13,R1             CLEANUP STACK                               
         FIN      #SYMB                                                         
         BAL,R5   FMQUEUE           QUEUE THE REQUEST                           
         B        CALLQER1          ERROR                                       
         LW,R0    4,R2              GET CLEANUP WORD FROM ECB                   
         LB,R0    R0                CLEANUP CODE TO R0                          
         CI,R0    2                 IS CLEANUP CODE 1 OR 2                      
         BLE      %+2               YES (R3= FPT ADDR)                          
         LI,R3    0                 CUPCODE= 3 OR 4,SET FPT ADDR=0              
         LB,R4    TCBPOINT          R4= TASK ID                                 
         BAL,R8   FMCK2             WAIT FOR IO TO COMPLETE                     
         B        IOCRASH           SHOULD NEVER GET HERE                       
         LW,R6    R15               TYC TO R6                                   
         CI,R6    TYCNORM                                               3428.010
         BNE      CALLQER3          B IF NOT NORMAL TYC                 3428.020
         PULL     R5                RESTORE LINK TO R5                          
         B        1,R5              RETURN + 2 (NORMAL)                         
*                                                                               
* PROCESS CALLQ ERRORS                                                          
*                                                                               
*                                                                               
         DO       #SYMB                                                         
CALLQER0 RES      0                                                             
         LW,R15   R9                R15= TYC                                    
         PULL     13,R1             RESTORE REGISTERS                           
         LW,R6    R15               MOVE ERROR CODE TO R6                       
         B        CALLQER3                                                      
         FIN      #SYMB                                                         
CALLQER1 RES      0                                                             
         LW,R6    R9                R6= ERROR CODE                              
CALLQER3 LW,R2    R1                DCB ADDRESS TO R2                           
         PULL     R5                RESTORE LINK                                
         B        0,R5              RET +1 (ERROR)                              
         DO       #SYMB                                                         
CALLQ10  RES      0                                                             
         PULL     13,R1             RESTORE R1-13                               
         LI,R6    TYCNORM           NORMAL COMPLETION                           
         LW,R2    R1                                                            
         PULL     R5                                                            
         B        1,R5              TAKE NORMAL EXIT (+2)                       
         FIN      #SYMB                                                         
         ELSE     #ECB                                                          
         LW,R6    R15               SAVE ACTIVITY COUNT IN R6                   
         BAL,R5   FMBLDECB          INITIALIZE R2                               
         PULL     R5                                                            
         LI,R15   X'F'                                                          
         SLS,R15  20                                                            
         LW,R14   Y001                                                          
         STS,R14  R2                SET CUPCODE= 1                              
         LW,R15   M17                                                           
         LI,R14   0                 CLEAR AND ALLOCATE                          
         DISABLE                                                                
         PUSH     R14                A STATUS WORD                              
         LW,R14   *K:RTS            R14= STATUS ADDRESS                         
         ENABLE                                                                 
         STS,R14  R2                STORE IN R2                                 
         LI,R15   X'40000'                                                      
         STS,R15  R2                SET BIT THAT R2 CONTAINS STATUS ADDR        
*   SET CUPWORD FOR QUEUE                                                       
         LB,R15   R8                R8= INPUT CLEANUP CODE                      
         CI,R15   2                 TEST TYC                                    
         BLE      %+2               B IF R3 CONTAINS AN FPT ADDR                
         LI,R3    0                 SET FPT ADDRESS=0 FOR CHECK                 
         LW,R8    R14               R8= POST ADDR                               
         AND,R8   M17               MASK                                        
         OR,R8    CUPCOD1           SET CODE FOR POST                           
         LW,R15   R6                R15 NOW CONTAINS ACTIVITY COUNT             
         LI,R6    3                 NRT                                         
         PUSH     R5                SAVE LINK                                   
         BAL,R5   QUEUE                                                         
         B        CALLQER2          ERROR                                       
         LB,R4    TCBPOINT          TASK ID FOR CHECK                           
         BAL,R8   FMCK2             WAIT FOR I/O TO COMPLETE                    
         NOP                                                                    
         PULL     R5                                                            
         PULL     R6                R6= COMPLETION STATUS WORD                  
         LB,R6    R6                R6= TYC                                     
         B        1,R5              RETURN +2                                   
*                                                                               
CALLQER2 RES      0                                                             
         PULL     R5                                                            
         PULL     R6                                                            
         LI,R6    3                 ERROR CODE FOR DEVICE DOWN                  
         B        0,R5              TAKE ERROR EXIT (+1)                        
         FIN      #ECB                                                          
         PAGE                                                                   
*************                                                                   
*  FMQUEUE  *                                                                   
*************                                                                   
*                                                                               
*   ROUTINE BUILDS AN I/O ECB, LOCKS BUFFER PAGES AND                           
*   QUEUES THE REQUEST.                                                         
*                                                                               
*   AT ENTRY:     R1    DCB ADDRESS                                             
*                 R3    FPT ADDRESS                                             
*                 R4    FUNCTION CODE                                           
*                 R5    LINK                                                    
*                 R6    NUMBER OF RETRIES                                       
*                 R7    DCT INDEX                                               
*                 R8    CLEANUP INFO WORD 1                                     
*                 R9    CLEANUP INFO WORD 2                                     
*                 R10   BYTE ADDRESS OF BUFFER (VIRTUAL)                        
*                 R11   BYTE COUNT                                              
*                 R12   SEEK ADDRESS (RAD/DISK) OR # REC TO PASS (MT)           
*                 R13   PRIORITY                                                
*                 R15   -1 MEANS DO NOT CHECK REENTRANCE COUNT.                 
*                       ANY OTHER VALUE IS COMPARED WITH RENT:D                 
*                       CONTENTS AND AN ERROR IS RETURNED IF                    
*                       THE VALUES DO NOT MATCH. IF THE VALUES                  
*                       COMPARE AND THE FUNCTION CODE IS WRITE,                 
*                       RENT:D IS INCREMENTED BEFORE CALLING QUEUE.             
*                                                                               
*                                                                               
*   AT NORMAL EXIT:  R2   ECB ID                                                
*                    R9   XXXXXXXX                                              
*   AT ERROR EXIT:   R2   XXXXXXXX                                              
*                    R9   ERROR CODE                                            
*                                                                               
*                                                                               
FMQUEUE  RES      0                                                             
         PUSH     R5                SAVE LINK                                   
         DO       #ROLL                                                         
         LW,R14   ROLL98            GET ACTIVITY COUNT                          
FMQ1     PUSH     4,R8              SAVE CLEANUP INFO AND BUFFER INFO           
         FIN      #ROLL                                                         
         PUSH     2,R14             SAVE RE-ENTRANCE COUNTS                     
         BAL,R5   FMBLDECB          BUILD AN ECB; R2= ECB ID AT RETURN          
         DO1      #ECB                                                          
         B        FMQERR1           ERROR, R15= ERROR CODE                      
         PULL     2,R14             RESTORE ACTIVITY COUNTS                     
         DISABLE                                                                
         DO       #ROLL                                                         
         CW,R14   ROLL98            WERE WE REENTERED                           
         BNE      FMQ7              YES, START OVER                             
         BAL,R5   FMLOCK            NO, LOCK REAL PAGES                         
         FIN      #ROLL                                                         
         CI,R15   -1                IS THIS A DIRECTORY ACCESS                  
         BE       FMQ5              NO, BRANCH                                  
         CW,R15   RENT:D            YES, IS THE COUNT THE SAME                  
         BNE      FMQ9              NO, WE WERE RE-ENTERED                      
         CI,R4    FCWRAD            WRITING A DIRECTORY SECTOR                  
         BNE      FMQ5              NO, BRANCH                                  
         MTW,1    RENT:D            YES, INCREMENT DIR. ACTIVITY COUNT          
FMQ5     RES      0                                                             
         BAL,R5   QUEUE             QUEUE THE REQUEST                           
         B        FMQERR2           DEVICE DOWN, ERROR                          
         DO       #ROLL                                                         
         PULL     4,R8              CLEANUP STACK                               
         FIN      #ROLL                                                         
         PULL     R5                RESTORE LINK                                
         B        1,R5              TAKE NORMAL EXIT (+2)                       
*                                                                               
*   HERE WE HAVE BEEN REENTERED                                                 
         DO       #ROLL                                                         
FMQ7     RES      0                                                             
         ENABLE                                                                 
         BAL,R8   FMDELECB          CLEANUP WHAT WE HAVE DONE                   
         PULL     4,R8              R8-R11 SAME AS AT ENTRY NOW                 
         LW,R14   ROLL98            GET ACTIVITY COUNT                          
         B        FMQ1                                                          
         FIN      #ROLL                                                         
*                                                                               
*                                                                               
FMQ9     RES      0                                                             
         LI,R0    TYCREENT          TYC FOR REENTERED                           
         MTW,1    COUNT:D           INCREMENT TRACE COUNTER                     
         B        FMQERR4           CLEANUP AND EXIT                            
*                                                                               
*   PROCESS ERRORS                                                              
         DO       #ECB                                                          
FMQERR1  RES      0                                                             
         LI,R5    -2                REMOVE TWO WORDS FROM STACK                 
         MSP,R5   *K:RTS                                                        
         DO       #ROLL                                                         
         PULL     4,R8                                                          
         FIN      #ROLL                                                         
         PULL     R5                R5= LINK                                    
         LW,R9    R15               R9= ERROR CODE                              
         B        0,R5              TAKE ERROR EXIT (+1)                        
         FIN      #ECB                                                          
*                                                                               
*                                                                               
FMQERR2  RES      0                                                             
         LI,R0    K3                'DEVICE DOWN' ERROR                         
FMQERR4  RES      0                                                             
         DO       #ECB                                                          
         ENABLE                                                                 
         BAL,R8   FMDELECB          DELETE THE ECB                              
         DO       #ROLL                                                         
         PULL     4,R8                                                          
         FIN      #ROLL                                                         
         FIN      #ECB                                                          
         PULL     R5                RESTORE LINK                                
         LW,R9    R0                ERROR CODE TO R9                            
         B        0,R5              TAKE ERROR EXIT                             
         PAGE                                                                   
****************                                                                
*   FMDELECB   *                                                                
****************                                                                
*                                                                               
*   ROUTINE UNLOCKS I/O BUFFER PAGES AND DELETES THE ECB                        
*                                                                               
*   AT ENTRY:     R2   ECB ID                                                   
*                 R8   LINK                                                     
*                                                                               
*   ROUTINE SAVES ALL REGISTERS                                                 
*   ROUTINE ALWAYS RETURNS +1                                                   
*                                                                               
         DO       #ECB                                                          
FMDELECB RES      0                                                             
         PUSH     16,R0             SAVE ALL REGISTERS                          
         DO       #ROLL                                                         
         BAL,R8   FMRELRAD          UNLOCK BUFFER                               
         FIN      #ROLL                                                         
         LI,R8    0                                                             
         STW,R8   ECBRECB,R2        ZERO R-TASK INFORMATION                     
         BAL,R8   EMDELECB          DELETE THE ECB                              
         B        IOCRASH           ERROR, CANT DELETE THE ECB                  
         ENABLE                                                                 
         PULL     16,R0                                                         
         B        *R8               RETURN                                      
         FIN      #ECB                                                          
         TITLE    'FMGETRAD ROUTINE'                                            
****************                                                                
*   FMGETRAD   *                                                                
****************                                                                
*                                                                               
*                                                                               
*                                                                               
*    ROUTINE DETERMINES REAL ADDRESS OF I/O BUFFER FOR MAPPED                   
*     TASKS AND ALSO DOES ONE OR MORE OF THE FOLLOWING:                         
*     1. CREATE A SIDE BUFFER IN RBM TSPACE AND MOVE RECORD TO                  
*         THE TSPACE BUFFER IF THE I/O IS FOR OUTPUT.                           
*     2. COMPILE A LIST OF THE REAL PAGES WHICH CONTAIN USER'S BUFFER.          
*     3. BUILD A SKELETON IOCD LIST WHEN BUFFER IS IN DISCONTIGUOUS             
*         REAL PAGES.                                                           
*                                                                               
*       BAL,R5    FMGETRAD                                                      
*                                                                               
*    AT ENTRY:    REGISTERS SAME AS AT ENTRY TO QUEUE                           
*                 R5      LINK                                                  
*                                                                               
*    AT EXIT:     R10,R11 SET FOR QUEUE, R1-R9,R12-R14 UNCHANGED                
*                 R15     TYC IF ERRORS ARE FOUND                               
*                                                                               
*    ROUTINE RETURNS +1 IF UNSUCCESSFUL, +2 OTHERWISE                           
*                                                                               
*                                                                               
*                                                                               
         DO       #MAP                                                          
FMGETRAD RES      0                                                             
         BIFREAL  1,R5              RETURN IF USER REAL                         
         LW,R15   R10                                                           
         SLS,R15  -2                BUFFER VIRTUAL FWA                          
         CW,R15   STVM              IS BUFFER=0 OR IN RBM                       
         BL       1,R5              YES, RETURN                                 
         PUSH     7,R3              SAVE R3-R9                                  
*   CHECK FOR READING C DEVICE; SIDE BUFFER IF YES.                             
         CW,R8    Y008              IS CREAD BIT SET                            
         BANZ     FMGRA1            YES, SIDE BUFFER                            
*   CHECK FOR FIXED RECORD LENGTH DEVICE                                        
         LB,R5    DCT4,R7           DEVICE TYPE                                 
         CI,R5    DCT4:TY                                                       
         BNE      FMGRA0            B IF NOT A TTY DEVICE                       
         LW,R0    ECBRECB,R2        GET FPT CODE FROM ECB                       
         LB,R0    R0                                                            
         CI,R0    X'10'                                                         
         BE       FMGRA2            B IF SIDEBUFFER READ                        
FMGRA0   RES      0                                                             
         LB,R6    T:FRLDEV,R5                                                   
         BEZ      FMGRA5            B IF NOT FXD REC LENGTH DEV.                
*                                                                               
*   THE I/O IS TO A FIXED LENGTH RECORD DEVICE                                  
*   SIDE BUFFERING WILL BE USED IF THE BUFFER IS IN REAL MEMORY                 
*   GREATER THAN 128K OR IF THE BUFFER IS IN DISCONTIGUOUS                      
*   REAL PAGES.                                                                 
FMGRA1   RES      0                                                             
         DO       #PAX                                                          
         LW,R9    DCTMOD,R7         GET MODEL NUMBER                            
         CW,R9    MDL2310           IS IT SPECIAL PAX LINE PRINTER              
         BE       FMGRA2            YES, MUST SIDE BUFFER                       
         FIN      #PAX                                                          
*   GET REAL LAST WORD ADDRESS OF BUFFER                                        
*                                                                               
         LW,R9    R10               BYTE ADDRESS OF BUFFER                      
         AW,R9    R11               ADD BYTE COUNT                              
         AI,R9    -1                R9= ADDRESS OF LAST BYTE                    
         LW,R6    R9                SAVE IN R6                                  
         SLS,R9   -2                CONVERT TO WORD ADDRESS                     
         BAL,R8   TMCKADR                                                       
         NOP                                                                    
         AND,R9   M24                   REMOVE WLOCKS                           
         CI,R9    I128K             BUFFER IN REAL CORE > 128K                  
         BGE      FMGRA2            YES                                         
*                                   NO,CHECK IF BUFF. CROSSES PAGE              
         SLS,R6   -11               R6= PAGE CONTAINING LBA OF BUFF             
         LW,R0    R10               BYTE ADDR. OF BUFFER                        
         SLS,R0   -11               PAGE CONTAINING FBA OF BUFFER               
         CW,R0    R6                FBA AND LBA IN SAME PAGE                    
         BE       FMGRA5            YES                                         
*   CHECK IF THE BUFFER IS IN CONTIGUOUS REAL PAGES                             
         SLS,R9   -9                R9=REAL PAGE CONTAING BUFF. LWA             
         LW,R6    R9                SAVE IN R6                                  
         LW,R9    R10               R9= VIRTUAL FBA OF BUFFER                   
         SLS,R9   -2                VIRTUAL FWA OF BUFFER                       
         BAL,R8   TMCKADR           GET REAL FWA OF BUFFER IN R9                
         NOP                                                                    
         AND,R9   M24                   REMOVE WLOCKS                           
         CI,R9    I128K             BUFFER IN REAL CORE > 128K                  
         BGE      FMGRA2            YES                                         
         SLS,R9   -9                REAL PAGE CONTAINING BUFF. FWA              
         AI,R9    1                 INCR FIRST PAGE                             
         CW,R9    R6                CHECK IF BUFFER IS IN                       
*                                    CONTIGUOUS REAL PAGES.                     
         BE       FMGRA5            B IF YES                                    
*                                                                               
*   SIDE BUFFER USING RBM TSPACE                                                
*                                                                               
FMGRA2   RES      0                 CREATE A SIDE BUFFER IN TSPACE              
         PUSH     2,R10             SAVE R10,R11                                
         LW,R5    R11               SAVE BYTE COUNT IN R5                       
         LI,R7    4                 GET 4 WORDS                                 
         BAL,R8   GETTEMP                                                       
         B        FMGRAER2                                                      
         STW,R7   0,R2              STORE DATA AREA ADDR IN ECB                 
         ENABLE                                                                 
         LW,R6    R7                SAVE ADDR. IN R6                            
         LW,R7    R5                USER BYTE COUNT TO R7                       
         SLS,R7   -2                CONVERT TO WORDS                            
         AI,R7    2                 NO. WORDS TO GET IN TSPACE                  
*                                                                               
         BAL,R8   GETTEMP           GET SPACE                                   
         B        FMGRAER2          ERROR                                       
         STW,R7   0,R6              STORE ADDR IN 1ST DATA AREA                 
         ENABLE                                                                 
         LW,R5    R7                R5= ADDR OF BUFFER DATA AREA                
         PULL     2,R10             RESTORE REGISTERS R10,R11                   
         AI,R5    1                 WORD ADDR OF TSPACE BUFFER                  
         SLS,R5   2                 CONVERT TO BYTE ADDRESS                     
*  CHECK FPT CODE STORED IN ECB. IF  THE I/O IS AN OUTPUT OPERATION             
*  THE USER DATA RECORD WILL BE MOVED TO THE TSPACE BUFFER TO BE                
*  WRITTEN FROM THERE.                                                          
         LW,R0    ECBRECB,R2        FPT CODE FROM ECB.                          
         LB,R0    R0                R0= FPT CODE                                
         CI,R0    X'10'             IS IT A READ                                
         BE       FMGRA4            YES, DO NOT MOVE BUFFER                     
         LI,R0    IOD1              NO, GET DATA AREA TYPE                      
         STB,R0   R5                R5= IOD,REAL BUFF. ADDR.                    
         STW,R5   1,R6              STORE INTO 1ST DATA AREA                    
*  MOVE DATA RECORD TO TSPACE BUFFER                                            
         LW,R14   R11               COUNT TO R14                                
         LW,R4    R5                'TO' ADDR. TO R4                            
         LW,R6    R10               'FROM' ADDR TO R6                           
         BAL,R9   MOVEBYTS                                                      
FMGRA3   LW,R10   R5                R10= REAL BYTE ADDR OF BUFFER               
         AND,R10  M24                                                           
         PULL     7,R3              RESTORE R3-R9                               
         B        1,R5              TAKE NORMAL EXIT (+2)                       
*  DATA RECORD WILL BE READ INTO TSPACE BUFFER                                  
FMGRA4   RES      0                                                             
         LI,R0    IOD2              DATA AREA TYPE                              
         STB,R0   R5                R5= IOD,REAL BUFFER ADDR                    
         STW,R5   1,R6              STORE INTO DATA AREA                        
         STW,R10  2,R6              STORE VIRTUAL BUFF ADDR INTO                
*                                    DATA AREA                                  
         B        FMGRA3                                                        
*                                                                               
*                                                                               
*  HERE THE REAL PAGES CONTAINING THE USER BUFFER WILL BE LOCKED                
*  INTO CORE.                                                                   
*                                                                               
FMGRA5   RES      0                 COMPUTE NO PAGES IN BUFFER                  
         LW,R3    R10               VIRTUAL FBA OF BUFFER                       
         AW,R3    R11               BYTE COUNT                                  
         AI,R3    -1                VIRTUAL LBA OF BUFFER                       
         SLS,R3   -11               VIRTUAL PAGE CONTAINING LBA                 
         LW,R0    R10                                                           
         SLS,R0   -11               VIRTUAL PAGE CONTAINING FBA                 
         SW,R3    R0                                                            
         AI,R3    1                 R3= NO PAGES IN BUFFER                      
*  GET TSPACE FOR SAVING LOCKED PAGE NUMBERS                                    
         LW,R7    R3                                                            
         SLS,R7   -1                DIVIDE BY 2 (NO PAGES PER WORD)             
         AI,R7    3                 ROUND UP AND ADD 2 WORDS FOR                
*                                    CONTROL INFORMATION                        
         PUSH     2,R10                                                         
         BAL,R8   GETTEMP                                                       
         B        FMGRAER2          ERROR                                       
         PULL     2,R10                                                         
         STW,R7   0,R2              DATA AREA ADDRESS TO ECB                    
         LI,R6    IOD3                                                          
         LW,R5    R3                                                            
         STB,R6   R5                DATA AREA WORD 1=IOD,NO. PAGES              
         AI,R7    2                 R7=ADDR OF LOCKED PAGES IN                  
*                                     DATA AREA.                                
*    GET THE REAL PAGES CONTAINING THE I/O BUFFER AND STORE                     
*      THE PAGE NUMBERS INTO THE DATA AREA.                                     
*  R3= NO. PAGES                                                                
*  R7= ADDRESS OF LOCKED PAGE TABLE IN DATA AREA                                
*                                                                               
         LW,R4    Y8                SET 'INP' MEANING PAGES NOT LOCKED YET      
         STW,R4   0,R7              STORE IN DATA AREA, WORD 2, BIT 0           
         ENABLE                                                                 
         LW,R4    R10               ADDR OF FIRST BYTE OF BUFFER                
FMGRA6   LW,R9    R4                1ST/NEXT VIRTUAL ADDR.                      
         SLS,R9   -2                CONVERT TO WORD ADDRESS                     
         BAL,R8   TMCKADR           GET REAL ADDRESS IN R9                      
         NOP                                                                    
         AND,R9   M24                   REMOVE WRITE LOCKS                      
         SLS,R9    -9                  CONVERT TO PAGE                          
         STH,R9    *R7,R3              STORE REAL PAGE IN DATA AREA             
         AI,R4    2048              INCR BUFFER ADDR                            
         BDR,R3   FMGRA6            GET NEXT PAGE                               
         STW,R5    -1,R7               STORE IOD AND NO. LOCKED PAGES           
*                                                                               
*  CHECK TO SEE IF THE REAL PAGES ARE CONTIGUOUS AND ASCENDING                  
*   IF YES, NO IOCD LIST REQUIRED                                               
*   IF NOT, BUILD A SKELETON IOCD LIST IN TSPACE                                
*                                                                               
         LW,R3    -1,R7             GET IOD,NO. PAGES FROM DATA AREA            
         AND,R3   M24                                                           
FMGRA7   LH,R5    *R7,R3            1ST/NEXT PAGE                               
         AI,R5    1                                                             
         BDR,R3   %+2                                                           
         B        FMGRA11           DONE, ALL PAGES CONTIGUOUS                  
         CH,R5    *R7,R3            COMPARE TO NEXT PAGE                        
         BE       FMGRA7            CHECK NEXT PAGE                             
*                                                                               
*  HERE IF PAGES ARE NOT CONTIGUOUS AND AN IOCD LIST MUST BE BUILT              
*   CHANGE IOD TO 4                                                             
         LW,R6    R7                SAVE PAGE TABLE ADDRESS IN R6               
         LW,R7    -1,R6             GET NO. PAGES                               
         LI,R5    IOD4                                                          
         STB,R5   R7                CHANGE IOD PARAMETER                        
         STW,R7   -1,R6             STORE BACK INTO DATA AREA                   
*  COMPUTE AMOUNT OF TSPACE NEEDED FOR IOCD LIST                                
*   ONE DOUBLEWORD REQUIRED PER PAGE PLUS A DOUBLEWORD OF ZEROS                 
*   PRECEEDING AND TRAILING THE IOCD LIST                                       
         AND,R7   M7                                                            
         SLS,R7   1                 R7= NO. DOUBLEWORDS X 2                     
         AI,R7    4                 ADD 2 DOUBLEWORDS                           
         PUSH     2,R10             SAVE R10,R11                                
         BAL,R8   GETTEMP           R7= SIZE,DATA AREA ADDR.                    
         B        FMGRAER3          ERROR                                       
         PULL     2,R10             STORE CLIST DATA AREA ADDR                  
         STW,R7   -2,R6              IN 1ST DATA AREA.                          
         ENABLE                                                                 
*   GET REAL FBA OF I/O BUFFER                                                  
         LW,R9    R10               VIRTUAL FBA                                 
         BAL,R8   FMGETRBA          REAL FBA IN R9                              
         NOP                                                                    
         LW,R8    R9                MOVE ADDR TO R8                             
*   GET NO. BYTES IN 1ST PAGE                                                   
         LW,R9    R10               VIRTUAL FBA                                 
         AND,R9   FFFFF800                                                      
         AI,R9    K800                                                          
         SW,R9    R10               R9= NO. BYTES IN 1ST PAGE                   
*   BUILD IOCD LIST AND STORE INTO DATA AREA                                    
         LW,R3    -1,R6             R3= NO. PAGES IN BUFFER                     
         SLS,R7   -1                SHIFT R7 TO A DOUBLEWORD INDEX              
FMGRA8   AI,R7    1                 R7 POINTS TO 1ST/NEXT CLIST ETRY            
         STD,R8   0,R7              STORE IOCD                                  
         AI,R3    -1                R3 POINTS TO NEXT PAGE                      
         LH,R8    *R6,R3            GET NEXT PAGE IN R8                         
         SLS,R8   11                CONVERT TO BYTE ADDRESS                     
         SW,R11   R9                REMAING BYTE COUNT                          
         CI,R11   2048              IS RBC LESS THAN A PAGE                     
         BLE      FMGRA9            YES                                         
         LI,R9    2048              NO,SET BYTE COUNT= ONE PAGE                 
         B        FMGRA8            LOOP BACK FOR NEXT IOCD                     
FMGRA9   RES      0                                                             
         LW,R9    R11               R9= RBC                                     
         AI,R7    1                 INCR IOCD INDEX                             
         STD,R8   0,R7              STORE LAST IOCD                             
         LD,R8    ZEROS                                                         
         AI,R7    1                                                             
         STD,R8   0,R7              STORE A DOUBLE-WORD OF ZEROS                
*  SET R10,R11 FOR QUEUE                                                        
         LW,R10   -2,R6             GET IOCD DATA AREA ADDRESS                  
         AND,R10  M24               MASK                                        
         AI,R10   2                 INCR ADDR TO IOCD LIST ADDR.                
         SLS,R10  -1                R10=DOUBLEWORD ADDR OF IOCD LIST            
         OR,R10   Y8                SET BIT 0 FOR QUEUE                         
         LW,R11   -1,R6                                                         
         AND,R11  M24               R11= NO DOUBLEWORDS IN IOCD LIST            
FMGRA10  PULL     7,R3              RESTORE REGISTERS                           
         B        1,R5              NORMAL RETURN (+2)                          
FMGRA11  LW,R9    R10               VIRTUAL BYTE ADDRESS                        
         BAL,R8   FMGETRBA          GET REAL BYTE ADDRESS                       
         NOP                                                                    
         LW,R10   R9                R10= REAL BYTE ADDRESS                      
         B        FMGRA10           EXIT                                        
*                                                                               
*   PROCESS ERROR RETURNS FROM SUBROUTINES                                      
*                                                                               
FMGRAER1 RES      0                                                             
         PULL     7,R3                                                          
         B        0,R5              RETURN +1, TYC IN R15                       
*                                                                               
FMGRAER3 RES      0                                                             
         DO       #ROLL                                                         
         BAL,R8   FMRELRAD          UNLOCK BUFFER                               
         FIN      #ROLL                                                         
FMGRAER2 RES      0                                                             
         PULL     9,R3              PULL ORIGINAL R3-R9 AND R10,R11             
         B        0,R5                                                          
         FIN                                                                    
         TITLE    'FMGETRBA--GET REAL BYTE ADDRESS'                             
****************                                                                
*   FMGETRBA   *                                                                
****************                                                                
*                                                                               
*                                                                               
*                                                                               
*    ROUTINE DETERMINES A REAL BYTE ADDRESS GIVEN A VIRTUAL                     
*    BYTE ADDRESS                                                               
*                                                                               
*    ENTER VIA    BAL,R8   FMGETRBA                                             
*                                                                               
*    AT ENTRY:    R9     VIRTUAL BYTE ADDRESS                                   
*                 R8     LINK                                                   
*                                                                               
*    AT EXIT:     R9     REAL BYTE ADDRESS                                      
*                                                                               
*    SUBROUTINES USED:   TMCKADR                                                
*                                                                               
*    REGISTERS USED:     R15 IF ERROR, R0,R9                                    
*                                                                               
*    ROUTINE EXITS: +1 IF ERROR, +2 IF NORMAL                                   
*                                                                               
*                                                                               
         DO       #MAP                                                          
FMGETRBA RES      0                                                             
         PUSH     R9                SAVE VIRTUAL BYTE ADDR                      
         PUSH     R8                SAVE LINK                                   
         SLS,R9   -2                MAKE R9 WORD ADDRESS                        
         BAL,R8   TMCKADR           GET REAL ADDR IN R9                         
         B        FMGRBAER                                                      
         PULL     R8                RESTORE LINK                                
FMGRBA1  RES      0                                                             
         LW,R0    R9                REAL ADDR TO R0                             
         AND,R0   M24                   REMOVE WLOCKS                           
         SLS,R0   2                 CONVERT TO BYTE ADDRESS                     
         PULL     R9                RESTORE VIRTUAL BYTE ADDR                   
         AND,R9   M2                                                            
         OR,R9    R0                                                            
         AI,R8    1                                                             
         B        *R8               RETURN +2                                   
*                                                                               
FMGRBAER RES      0                 R15= TYC                                    
         PULL     R8                RESTORE LINK                                
         AI,R8    -1                SET R8 FOR ERROR RETURN (+1)                
         B        FMGRBA1           GET REAL BYTE ADDRESS                       
         FIN                                                                    
         PAGE                                                                   
***************                                                                 
*   CALLPOST  *                                                                 
***************                                                                 
*                                                                               
*                                                                               
*   ROUTINE CALLS I/O POST ROUTINE                                              
*   ROUTINE CALLED FROM REQCOM VIA SIMULATED BAL,R14                            
*   ROUTINE SIMULATES A BAL,R8 FMPOST                                           
*                                                                               
*   AT ENTRY:     R2      ECB I.D.                                              
*                 R5-R9   I/O STATUS                                            
*                 R10,11  END-ACTION DOUBLEWORD (ALWAYS CUPCOD3)                
*                 R12     TYPE COMPLETION                                       
*                 R13     REMAINING BYTE COUNT                                  
*                 R14     LINK                                                  
*                 R15     REAL BUFFER ADDRESS                                   
*                                                                               
*                                                                               
         DO       #ECB                                                          
CALLPOST RES      0                                                             
         LW,R4    R6                R4= TIO STATUS                              
         LW,R3    R8                R3= 1ST HALF OF TDV STATUS                  
         LW,R8    R14               SIMULATE BAL,R8 AND RETURN TO               
         B        FMPOST             REQCOM (RC30) AT FMPOST EXIT               
         PAGE                                                                   
**************                                                                  
*   FMPOST   *                                                                  
**************                                                                  
*                                                                               
*   ROUTINE POSTS COMPLETION STATUS IN THE ECB                                  
*   AND UNLOCKS THE I/O BUFFER (IF APPLICABLE)                                  
*                                                                               
*                                                                               
*   AT ENTRY:     R2   ECB I.D.                                                 
*                 R3   1ST HALF OF TDV STATUS                                   
*                 R4   TIO STATUS                                               
*                 R5   AIO STATUS                                               
*                 R7   DCT INDEX                                                
*                 R8   LINK                                                     
*                 R9   2ND HALF OF TDV STATUS                                   
*                 R12  TYPE COMPLETION                                          
*                 R13  REMAINING BYTE COUNT                                     
*                                                                               
FMPOST   RES      0                                                             
         PUSH     R8                SAVE LINK REGISTER                          
         DO       #ROLL                                                         
         PUSH     3,R5              SAVE R5-R7                                  
         BAL,R8   FMRELRAD          UNLOCK I/O BUFFER PAGES                     
         PULL     3,R5              RESTORE R5-R7                               
         FIN                                                                    
         AND,R13  M17               RBC                                         
         LW,R6    ECBRECB,R2        INITIAL BYTE COUNT                          
         AND,R6   M17               MASK                                        
         SW,R6    R13               R6= ACTUAL RECORD SIZE                      
         STB,R12  R6                R6= COMPLETION STATUS WORD                  
         LI,R8    0                                                             
         STW,R8   ECBRECB,R2        DELETE R-TASK INFO                          
         BAL,R8   EMPOSTYC          STORE COMPL STATUS IN ECB                   
         PULL     R8                                                            
         B        *R8               RETURN                                      
         FIN      #ECB                                                          
         PAGE                                                                   
*************                                                                   
*   FMLOCK  *                                                                   
*************                                                                   
*                                                                               
*   ROUTINE INCREMENTS THE IOLOCK COUNT FOR REAL BUFFER PAGES                   
*   WHEN APPLICABLE.                                                            
*                                                                               
*   AT ENTRY:   REGISTERS SAME AS AT ENTRY TO QUEUE (R2 MUST BE ECB ID)         
*   REGISTERS DESTROYED:   NONE                                                 
*                                                                               
*   ENTERED WITH INTERRUPTS INHIBITED. EXITS IN SAME STATE.                     
*                                                                               
*                                                                               
         DO       #ROLL                                                         
FMLOCK   RES      0                                                             
         BIFREAL  0,R5              EXIT IF CALLER IS REAL                      
         PUSH     3,R5              SAVE R5-R7                                  
         LW,R7    0,R2              GET DATA AREA WORD FROM ECB                 
         BEZ      FMLOCKX           NONE, EXIT                                  
         LW,R5    1,R7              GET WORD 1 IN DATA AREA (IOD,K)             
         LB,R6    R5                R6=IOD PARAMETER= DATA AREA TYPE            
         CI,R6    IOD2                                                          
         BLE      FMLOCKX           NO PAGES TO LOCK, EXIT                      
         AI,R7    2                 R7 POINTS TO START OF PAGES TO LOCK         
         AND,R5   M24               R5= K= NO. OF PAGES TO LOCK                 
         LW,R6    0,R7              R6= WORD 2 OF DATA AREA                     
         BGEZ     FMLOCKX           EXIT IF PAGES ALREADY LOCKED                
         AND,R6   M31               ELSE RESET 'IN PROCESS FLAG'                
         STW,R6   0,R7              STORE BACK INTO DATA AREA                   
         LH,R6    *R7,R5            GET 1ST/NEXT REAL PAGE NUMBER               
         MTB,1    IOLOCK,R6         LOCK THE PAGE                               
         BDR,R5   %-2               GET NEXT PAGE                               
FMLOCKX  PULL     3,R5              RESTORE R5-R7                               
         B        0,R5              RETURN                                      
         PAGE                                                                   
****************                                                                
*   FMRELRAD   *                                                                
****************                                                                
*                                                                               
*                                                                               
*                                                                               
*   ROUTINE DECREMENTS THE IOLOCK COUNT FOR REAL BUFFER PAGES                   
*    WHEN APPLICABLE.                                                           
*                                                                               
*                                                                               
*   AT ENTRY:     R2     ECB I.D.                                               
*                 R8     LINK                                                   
*                                                                               
*   REGISTERS USED:   R5,R6,R7                                                  
*                                                                               
*                                                                               
FMRELRAD RES      0                                                             
         DISABLE                                                                
         LW,R7    0,R2              GET DATA AREA WORD FROM ECB                 
         BEZ      FMREL3            NO DATA AREA, EXIT                          
         LW,R5    1,R7              GET WORD 1 IN DATA AREA (IOD,K)             
         LB,R6    R5                R6= IOD PARAMETER                           
         CI,R6    IOD2                                                          
         BLE      FMREL3            EXIT IF IOD=1 OR 2                          
         AI,R7    2                 R7 POINTS TO START OF LOCKED                
*                                     PAGES IN DATA AREA.                       
         AND,R5   M24               MASK                                        
         LW,R6    0,R7              GET WORD 2 OF DATA AREA                     
         BLZ      FMREL1            EXIT, PAGES NOT LOCKED YET                  
         LH,R6    *R7,R5            GET 1ST/NEXT PAGE                           
         MTB,-1   IOLOCK,R6         DECREMENT PAGE LOCK COUNT                   
         BDR,R5   %-2               LOOP                                        
FMREL1   RES      0                                                             
         LI,R5    0                                                             
         STW,R5   -1,R7             DONE, ZERO OUT IOD WORD                     
FMREL3   RES      0                                                             
         ENABLE                                                                 
         B        *R8                                                           
         FIN      #ROLL                                                         
         PAGE                                                                   
***************                                                                 
*   FMABORT   *                                                                 
***************                                                                 
*                                                                               
*   ROUTINE CALLED WHEN AN ABORT OR TERMINATE CONDITION IS                      
*     DETECTED IN EMWAIT AND THE I/O IS NOT DONE.                               
*   ROUTINE RETURNS +2 NORMALLY, +1 IS I/O IS BUSY                              
*                                                                               
*   AT ENTRY:    R2    ECB I.D.                                                 
*                R8    LINK                                                     
*                R15   ERROR CODE AS FOLLOWS;                                   
*                 1    MEANS DELFPT                                             
*                 FC   MEANS NORMAL TERMINATION                                 
*                 FE   MEANS ABORT                                              
*                                                                               
*                                                                               
FMABORT  RES      0                                                             
         PUSH     7,R2              SAVE R2-R8                                  
         LW,R4    R2                R4= ECB I.D.                                
         LB,R2    TCBPOINT          TASK I.D.                                   
         LW,R2    STIPRIO,R2        PRIORITY WORD                               
         LB,R2    R2                R2= TASK PRIORITY                           
         LB,R3    IOQ4              R3= NO. OF QUEUE ENTRIES                    
         DO1      #ECB                                                          
         LW,R5    M17               MASK FOR COMPARE                            
         DISABLE                                                                
FMABORT1 RES      0                                                             
         DO       #ECB                                                          
         CS,R4    IOQECB,R3         DOES ECB ID MATCH                           
         ELSE     #ECB                                                          
         CW,R4    IOQECB,R3         DOES ECB ID MATCH                           
         FIN      #ECB                                                          
         BE       FMABORT3          YES                                         
         BDR,R3   FMABORT1          NO, LOOP                                    
*   NO MATCH FOUND; UNLOCK BUFFER AND DELETE ECB.                               
         DO       #ECB                                                          
         LW,R2    R4                R2= ECB I.D.                                
         BAL,R8   FMDELECB          DELETE THE ECB                              
         LI,R15   TYC100            TYC MEANS ECB HAS BEEN DELETED              
         FIN      #ECB                                                          
         B        FMABORT5          EXIT                                        
*                                                                               
*   HERE A MATCHING ECB ID WAS FOUND IN QUEUE.  EITHER KILL IT OR               
*   WAIT FOR THE REQUEST TO COMPLETE NORMALLY.                                  
FMABORT3 RES      0                                                             
         CI,R15   X'FC'             NORMAL TERMINATION                          
         BNE      FMABORT4          NO, RIP IT OFF                              
         LB,R6    IOQ7,R3           YES, GET DCT INDEX                          
         LB,R5    DCT5,R6           DCT SWITCHES                                
         CI,R5    X'E'              ANY 'BAD' BITS SET                          
         BANZ     FMABORT4          YES, RIP IT OFF                             
         PULL     7,R2              RESTORE REGISTERS                           
         B        *R8               TAKE BUSY RETURN (+1)                       
FMABORT4 RES      0                                                             
         BAL,R5   RIPOFF            KILL AND CLEANUP REQUEST                    
FMABORT5 RES      0                                                             
         ENABLE                                                                 
         PULL     7,R2                                                          
         AI,R8    1                                                             
         B        *R8               TAKE NORMAL RETURN (+2)                     
         TITLE    'SECTPERN SUBROUTINE'                                         
****************                                                                
*   SECTPERN   *                                                                
****************                                                                
*                                                                               
*   ROUTINE COMPUTES THE NUMBER OF SECTORS REQUIRED TO CONTAIN N BYTES          
*                                                                               
*   AT ENTRY TO SECTPERB:                                                       
*                                                                               
*        R5       DISC TABLE ENTRY INDEX                                        
*        R8       LINK                                                          
*        R15      BYTE COUNT (N)                                                
*                                                                               
*   AT ENTRY TO SECTPERN:                                                       
*                                                                               
*        R6       AREA INDEX                                                    
*        R8       LINK                                                          
*        R15      BYTE COUNT (N)                                                
*                                                                               
*   AT EXIT:                                                                    
*        R15      NUMBER OF SECTORS REQUIRED FOR N BYTES                        
*        R14      DESTROYED                                                     
*        R5       DISC TABLINDEX                                                
*                                                                               
SECTPERN RES      0         ENTRY FOR AREA INDEX GIVEN                          
         LB,R5    MDDISCI,R6        SET DISC TABLE INDEX                        
*                                                                               
SECTPERB RES      0         ENTRY FOR DISC TABLE INDEX GIVEN                    
         LH,R14   DISCNWPS,R5       GET SECTOR SIZE FOR THE DISC                
         SLS,R14  2                 CONVERT TO BYTES                            
         AI,R15   -1                ADJUST INPUT BYTE COUNT                     
         DW,R15   R14               GET SECTORS - 1                             
         AI,R15   1                 ROUND UP TO FULL SECTORS                    
         B        *R8               RETURN                                      
         TITLE    'PARAMETER FETCH ROUTINES'                                    
*                                                                        1831000
*   ROUTINE GETS THE NTH OPTIONAL PARAMETER FROM AN FPT                  1832000
*                                                                        1833000
*   RETURN IS +1 IF PARAMETER IS ABSENT                                  1834000
*             +2 IF PARAMETER IS PRESENT                                 1835000
*                                                                        1836000
*   AT ENTRY:   R3 FPT ADDRESS                                           1837000
*               R5  LINK                                                 1838000
*               R15 N                                                    1839000
*                                                                        1840000
*   AT EXIT:    R14 ADDRESS OF PARAMETER                                 1841000
*               R15 PARAMETER (0 IF PARAMETER ABSENT)                    1842000
*                                                                        1843000
*   REGISTERS USED:  R0                                                  1844000
*                                                                        1845000
* CASE 1 - PARAMETER MAY NOT BE INDIRECTED.                                     
*          P0 IS REQUIRED                                                       
*                                                                               
GETPS    RES      0                                                             
GETFPTNS RES      0                                                             
         CI,R15   -1                IS IT FOR PREVIOUS WORD                     
         BE       FPT0              YES                                         
*                                   NO                                          
         LW,R0    0,R3              FPT WORD 0 TO R0                            
         CW,R0    XFPTP0                EXTENDED?                               
         BANZ     GETFPTN               YES                                     
%0322    RES      0                                                             
         LI,R15   0                     NO                                      
         B        0,R5                  EXIT                                    
         PAGE                                                                   
*                                                                               
* CASE 2 - PARAMETER MAY NOT BE INDIRECTED.                                     
*          P0 IS NOT REQUIRED                                                   
*                                                                               
GETP     RES      0                                                             
GETFPTN  RES      0                                                             
         CI,R15   -1                IS IT FOR PREVIOUS WORD                     
         BNE      %+2               FASTER WHEN BRANCHING                       
         B        FPT0              YES                                         
*                                   NO                                          
         LW,R0    1,R3              FPT WORD 1 TO R0                            
         LI,R14   1                 INITIAL FPT POSITION                        
         AI,R15   BITABLE-1                                                     
         CW,R0    *R15              IS PARAMETER THERE                          
         BAZ      %0322             PARAMETER NOT THERE                         
         AI,R15   -(BITABLE-1)                                                  
%0321    RES      0                                                             
         SLS,R0   1                 SHIFT LEFT ONE                              
         BCR,8    %+2               SKIP IF OLD BIT 0 NOT SET                   
         AI,R14   K1                INCREMENT FPT POSITION               1852000
         BDR,R15  %0321             LOOP IF NOT NTH TIME                 1853000
         LW,R15   *R14,R3           YES, GET PARAMETER                   1856000
         AW,R14   R3                COMPUTE PARAMETER ADDRESS            1857000
         B        1,R5              RETURN +2                            1858000
*                                                                               
*                                                                               
* GET FPT WORD ZERO                                                             
*                                                                               
FPT0     RES      0                                                             
         LW,R14   R3                GET ADDRESS                                 
         LW,R15   0,R3              AND CONTENT                                 
         B        1,R5              EXIT +2                                     
         PAGE                                                                   
*                                                                               
*                                                                               
* CASE 3 - PARAMETER MAY BE INDIRECT EITHER THRU A REGISTER OR A CORE           
*          LOCATION. P0 NOT REQUIRED.                                           
GETPI    RES      0                                                             
         PUSH     R5                                                            
         BAL,R5   GETP              GET A PARAMETER                             
         B        GOTNOP            GOT NO PARAMETER                            
*                                                                               
GETPIX   BAL,R0   GETPIND                                                       
         PULL     R5                                                            
         B        1,R5              SKIP EXIT                                   
*****                                                                           
GOTNOP   PULL     R5                RESTORE R5                                  
         B        0,R5              ERROR EXIT                                  
******                                                                          
*                                                                               
*                                                                               
*                                                                               
* CASE 4 - LIKE CASE 3, BUT P0 REQUIRED                                         
*                                                                               
GETPSI   RES      0                                                             
         PUSH     R5                                                            
         BAL,R5   GETPS                                                         
         B        GOTNOP                                                        
         B        GETPIX                                                        
         PAGE                                                                   
*                                                                               
*                                                                               
* CASE 5 - PARAMETER IS AN ADDRESS AND MAY BE INDIRECT EITHER                   
*           THRU A REGISTER OR A CORE LOCATION. P0 NOT NEEDED.                  
GETPII   PUSH     R5                SAVE LINK                                   
         BAL,R5   GETPI                                                         
         B        GOTNOP                                                        
GETPIIX  BAL,R0   CONVADDR                                                      
         PULL     R5                                                            
         B        1,R5              SKIP EXIT                                   
*                                                                               
* CASE 6 - LIKE CASE 5 BUR P0 IS NEEDED                                         
*                                                                               
GETPSII  PUSH     R5                                                            
         BAL,R5   GETPSI                                                        
         B        GOTNOP                                                        
         B        GETPIIX                                                       
         PAGE                                                                   
*                                                                               
* OLD VERSION FOR COMPATABILITY                                                 
*                                                                               
GETEFADR RES      0                                                             
         PUSH     R14               SAVE R14                                    
         PUSH     R0                SAVE LINK                                   
         BAL,R0   GETPIND           GO THRU INDIRECTION                         
         PULL     R0                RESTORE LINK                                
         PULL     R14               RESTORE R14                                 
         B        *R0               EXIT                                        
*****                                                                           
*                                                                               
* INDIRECTION TEST AND FETCH                                                    
*                                                                               
GETPIND  RES      0                                                             
         CI,R15   0                 TEST FOR INDIRECT                           
         BGEZ     *R0               NOT INDIRECT                                
*                                   INDIRECT                                    
         LI,R14   X'1FFFF'                                                      
         AND,R14  R15               MASK                                        
         CI,R14   R15               CHECK FOR REGISTER                          
         BG       PNOTREG           NOT A REGISTER                              
*                                   IS A REGISTER                               
         PUSH     R1                SAVE R1                                     
         LB,R1    TCBPOINT          STI INDEX                                   
         LD,R1    STIRTSB,R1        ADDR OF STACK                               
         AW,R14   R1                ADD TO REG ADDR                             
         AI,R14   -CAL1PUSH         SUB OFFSET                                  
         PULL     R1                RESTORE R1                                  
PNOTREG  LW,R15   *R14              GET PARAMETER                               
PNOTIND  B        *R0                                                           
         TITLE    'CONVERT REGISTER ADDR TO ACTUAL ADDR'                        
*                                                                               
* CONVERT A REGISTER ADDRESS TO AN ACTUAL ADDRESS                               
* DONT CONVERT REAL ADDRESSES                                                   
* FETCH CONTENT OF RESULTENT ADDRESS                                            
*                                                                               
* INPUT:                                                                        
* R0     LINK                                                                   
* R15    ADDRESS TO CONVERT                                                     
*                                                                               
* OUTPUT:                                                                       
* R14    CONVERTED ADDRESS                                                      
* R15    CONTENT OF THAT ADDRESS                                                
* R0     STILL LINK                                                             
* ALL OTHERS UNCHANGED                                                          
*                                                                               
CONVADDR RES      0                                                             
         OR,R15   XBIT0             SET INDIRECT BIT                            
         B        GETPIND           GET PROPER RESULT NOW                       
         TITLE    'ERROR ROUTINES'                                              
*                                                                        1860000
**************************                                               1861000
*   I/O ERROR ROUTINES   *                                               1862000
**************************                                               1863000
*                                                                        1864000
*                                                                        1865000
*   THESE ROUTINES SET THE ERROR CODE IN R9 AND BRANCH TO DCBERR OR      1866000
*      FPTERR                                                            1867000
*                                                                        1868000
*                                                                        1869000
*   AT ENTRY:   R1   FPT CODE                                            1870000
*               R2   DCB ADDRESS                                         1871000
*               R3   FPT ADDRESS                                         1872000
*               USER CONTEXT IS ON TOP OF THE USER TEMP STACK AS         1873000
*                    SHOWN IN CAL1 PROCESSOR                             1874000
*                                                                        1875000
*                                                                        1876000
ERROR01  LI,R9    1                 DCB OPENED WITH INCORRECT PARAMETERS 1877000
         B        DCBERR                                                 1878000
*                                                                        1879000
ERROR03  LI,R9    3                 ASSIGNED RAD FILE DOESNT EXIST       1880000
         B        DCBERR                                                 1881000
*                                                                        1882000
ERROR0A  LI,R9    KA                TRYING TO CLOSE A CLOSED DCB         1883000
         B        DCBERR                                                 1884000
*                                                                        1885000
ERROR2E  LI,R9    K2E               TRYING TO OPEN AN OPEN DCB           1886000
         B        DCBERR                                                 1887000
*                                                                        1888000
*                                                                        1889000
ERROR40  LI,R9    K40               TRYING TO READ OUTPUT DEVICE         1890000
         B        DCBERR                                                 1891000
*                                                                        1892000
ERROR44  LI,R9    K44               TRYING TO WRITE INPUT DEVICE         1893000
         B        DCBERR                                                 1894000
*                                                                        1895000
ERROR48  LI,R9    K48               NON RT REQUEST ON BUSY DCB           1896000
         B        DCBERR                                                 1897000
*                                                                        1898000
ERROR4A  LI,R9    K4A               USER BUFFER ERROR                    1899000
         B        DCBERR                                                 1900000
*                                                                        1900500
ERROR54  LI,R9    K54                                                           
         B        DCBERR                                                        
*                                                                               
ERROR55  LI,R9    K55               RAD FILE CANNOT BE OPENED            1900510
         B        DCBERR             RFT FULL OR SOMETHING ELSE          1900520
*                                                                        1901000
ERROR58  LI,R9    X'58'                                                         
         B        DCBERR                                                 1903000
*                                                                        1904000
ERROR59  LI,R9    K59               DCB HAS BEEN CHANGED SINCE IT WAS    1905000
         B        DCBERR                OPENED                           1906000
*                                                                               
ERROR5B  LI,R9    K5B               ILLEGAL JOB ID FOR RAD FILE CLOSE           
         B        DCBERR                                                        
*                                                                        1907000
ERROR60  LI,R9    K60               READ REQUEST ON A SHARED DEVICE      1908000
         B        DCBERR                                                 1909000
         PAGE                                                            1910000
*********************                                                    1911000
*   POST ROUTINES   *                                                    1912000
*********************                                                    1913000
*                                                                        1914000
*   THESE ROUTINES POST THE TYC IN THE PROPER USER FPT OR DCB            1915000
*   THESE ROUTINES ARE NORMALLY ENTERED AFTER LOGICAL I/O IS COMPLETED.         
*                                                                        1917000
*   AT ENTRY:     R2     DCB ADDRESS                                            
*                 R3     FPT ADDRESS                                            
*                 R10    BUFFER ADDRESS                                         
*                 R11    ACTUAL RECORD SIZE                                     
*                 R12    TYPE COMPLETION CODE                                   
*                                                                               
*                                                                        1919000
POST01   LI,R12   K1                                                            
         LW,R13   R11               BYTE COUNT                                  
         B        POST1                                                         
*                                                                               
POST03   LI,R12   K3                BEGINNING OF TAPE TYC                       
         B        POST                                                          
*                                                                               
POST05   LI,R12   K5                END OF TAPE TYC                      1920000
         B        POST                                                   1921000
*                                                                               
POST06   LI,R12   K6                EOD TYC                                     
         B        POST                                                          
*                                                                        1922000
POST07   LI,R12   K7                END OF FILE TYC                      1923000
         B        POST                                                   1924000
*                                                                        1925000
POST10   LI,R12   10                WP VIOLATION TYC                     1926000
         B        POST                                                   1927000
*                                                                        1928000
POST     LI,R13   0                 SET ARS = 0                          1929000
POST1    LI,R15   10                                                            
         BAL,R5   GETFPTN                                                       
         B        POST1A            B IF TYPE 1                                 
         LW,R15   R10               BUFFER ADDRESS TO R15                       
         LW,R10   R14               STATUS ADDR TO R10                          
         LI,R14   1                 CUP CODE FOR CORE                           
POST1B   STB,R14  R10               CUP CODE TO R10 BYTE 0                      
         LI,R5    POSTEXIT          SIMULATE BAL,R5                             
         PUSH     9,R13                                                         
         LW,R2    R2                                                            
         BGEZ     RC28              B NOT CREAD                                 
         B        RC32                                                          
*                                                                               
POST1A   LW,R15   R10               BUFFER ADDR                                 
         LW,R10   R2                DCB ADDR TO R10                             
         LI,R14   2                 CUP CODE                                    
         B        POST1B                                                        
*                                                                               
*                                                                               
POSTEXIT RES      0                                                             
         LW,R15   R12               TYC TO R15                                  
         BAL,R8   TMSETERR          CHANGE USER PSD,R8,R10 IF FPT ERR           
         CI,R15   TYCF0             TEST ERROR CODE                             
         BGE      CALERR            DO NOT EXIT TO USER                         
         B        CALEXIT                                                       
         PAGE                                                            1939000
**************                                                           1940000
*   DCBERR   *                                                           1941000
**************                                                           1942000
*                                                                        1943000
*    THIS ROUTINE IS ENTERRED WHEN AN ERROR IS DISCOVERRED WHICH IS      1944000
*      TO RESULT IN THE DCB ERROR OR ABNORMAL RETURN BEING TAKEN.        1945000
*      IF THE ERROR OR ABNORMAL RETURN IS NOT GIVEN, THE PROGRAM IS      1946000
*      ABORTED IF BACKGROUND AND RELEASED IF FOREGROUND                  1947000
*                                                                        1948000
*    AT ENTRY:    R3   FPT ADDRESS                                       1949000
*                 R1   FPT CODE                                          1950000
*                 R2   DCB ADDRESS                                       1951000
*                 R9   ERROR CODE                                        1952000
*                 USER TEMP STACK CONTAINS CONTEXT ON TOP AS ILLUSTRATED 1953000
*                     IN CAL1 PROCESSOR                                  1954000
*                                                                        1955000
*                                                                        1956000
*                                                                        1957000
*                                                                        1958000
DCBERR   LW,R15   R9                ERROR CODE TO R15                           
         BAL,R8   TMDCBERR          CHANGE USER PSD,R8,R10                      
         CI,R15   TYCF0                                                         
         BGE      CALERR            DO NOT EXIT TO USER                         
         B        CALEXIT                                                       
         TITLE    'I/O TABLE DOCUMENTATION'                                     
*                                                                               
* I/O SUPERVISOR CODE DESIGNED AND WRITTEN BY:                                  
*                                                                               
*                 GENE MALLORY                                                  
*                 5656 BUFFALO AVE.                                             
*                 VAN NUYS, CALIF.                                              
*                 91401                                                         
*                                                                               
*                 213-988-3975                                                  
*                                                                               
*                                                                               
*                                                                               
* DCT1            ACTIVE I/O ADDRESS FOR DEVICE            HW                   
*                                                                               
* DCT1P           PRIMARY (P) DEVICE ADDRESS               HW                   
*                                                                               
* DCT1A           ALTERNATE (A) DEVICE ADDRESS             HW                   
*                                                                               
* DCT2            CIT PTR                                  BYTE                 
*                                                                               
* DCT3   BIT 0    OUTPUT LEGAL                             BYTE                 
*        BIT 1    INPUT LEGAL                                                   
*        BIT 2    DEVICE DOWN                                                   
*        BIT 3    DEVICE TIMED OUT                                              
*        BIT 4    SIO FAILED                                                    
*        BIT 5    I/O ABORTED                                                   
*        BIT 6/7  11 - USE EITHER SUB-CHANNEL                                   
*                 10 - USE THE A SUB-CHANNEL ONLY                               
*                 01 - USE THE P SUB-CHANNEL ONLY                               
*                 00 - BUSY BOTH SUB-CHANNELS                                   
*                                                                               
* DCT4            DEVICE TYPE                              BYTE                 
*                                                                               
* DCT5   BIT 0    DEVICE BUSY                              BYTE                 
*        BIT 1    WAITING FOR CLEAN-UP                                          
*        BIT 2    INTER-OP                                                      
*        BIT 3    DATA TRANSFER                                                 
*        BIT 4    KEY-IN PENDING                                                
*        BIT 5    DEFER SIO START                                               
*        BIT 6    DEVICE MANUAL                                                 
*        BIT 7    IOEX                                                          
*                                                                               
* DCT6            IOQ PTR                                  BYTE                 
*                                                                               
* DCT7            COMMAND LIST PTR                         HW                   
*                                                                               
* DCT8/9          HANDLER ADDRESSES                        WD/WD                
*                                                                               
* DCT10           RE-ENTRANCE COUNTER                        HW                 
*                                                                               
* DCT11           TIME-OUT VALUE                           WD                   
*                                                                               
* DCT12           END-ACTION/AIO STATUS                    WD                   
*                                                                               
* DCT13           TDV STATUS                               DW                   
*                                                                               
* DCT14           BACKGROUND STOP COUNT                    BYTE                 
*                                                                               
* DCT15           ALL STOP COUNT                           BYTE                 
*                                                                               
* DCT16           DEVICE NAME IN EBCDIC                    DW                   
*                                                                               
* DCT17           RETRY AND CONTINUATION CODES             HW                   
*                                                                               
* DCT18           I/O TIME OUT INCREMENT                   BYTE                 
*                                                                               
* DCT19           AIO CONDITION CODES                      BYTE                 
*                                                                               
* DCT20           TDV CONDITION CODES                      BYTE                 
*                                                                               
* DCT20A          TIO CONDITION CODES                      BYTE                 
*                                                                               
* DCT21           TIO STATUS                               HW                   
*                                                                               
* DCTMOD          DEVICE MODEL # IN EBCDIC                 WORD                 
*                                                                               
* DCTMODX         DEVICE MODEL # IN HEX                    HW                   
*                                                                               
* DCT#ERR         NUMBER OF I/O ERRORS FOR DEVICE          WORD                 
*                                                                               
* DCT#IO          NUMBER OF I/O STARTS FOR DEVICE          WORD                 
*                                                                               
* DCTJID          JOB ID FOR RESERVED DEVICES              BYTE                 
*                                                                               
* DCTJID IF 0     SHARABLE DEVICE                          BYTE                 
*        IF FF    NON-SHARABLE DEVICE, NOT IN USE                               
*        ELSE     NON-SHARABLE DEVICE, JID OF USER                              
*                                                                               
* DCTDCB          NUMBER OF OPEN DCB'S                     BYTE                 
*                                                                               
* DCTDEBUG        (INT. LEVEL - X'40') FOR BREAK           BYTE                 
*                                                                               
         PAGE                                                                   
*                                                                               
* CIT1            QUEUE HEAD                               BYTE                 
*                                                                               
* CIT2            QUEUE TAIL                               BYTE                 
*                                                                               
* CIT3   BIT 0    SUB-CHANNEL P BUSY                       BYTE                 
*        BIT 1    SUB-CHANNEL A BUSY                                            
*        BIT 2    SUB-CHANNEL P HELD                                            
*        BIT 3    SUB-CHANNEL A HELD                                            
*        BIT 4    SUAL ACCESS CHANNEL                                           
*        BIT 5    PREFERED CHANNEL (0=P;1=A)                                    
*                                                                               
* CIT5            HOLDING REQUEST Q PTR FOR SUB-CHANNEL P  BYTE                 
*                                                                               
* CIT6            HOLDING REQUEST Q PTR FOR SUB-CHANNEL A  BYTE                 
*                                                                               
         PAGE                                                                   
*                                                                               
*                                                                               
* IOQ1            BACKWARD LINK IN Q                       BYTE                 
*                                                                               
* IOQ2            FORWARD LINK IN Q                        BYTE                 
*                                                                               
* IOQ3   BIT 0    REQUEST BUSY                             BYTE                 
*        BIT 5-7  000 - REQUIRE BOTH SUB-CHANNELS                               
*                 001 - RESTRICTED TO SUB-CHANNEL P                             
*                 010 - RESTRICTED TO SUB-CHANNEL A                             
*                 100 - USE EITHER SUB-CHANNEL                                  
*                                                                               
* IOQ4            INITIAL FUNCTION CODE                    BYTE                 
*                                                                               
* IOQ5            CURRENT FUNCTION CODE                    BYTE                 
*                                                                               
* IOQ7            DEVICE INDEX (DCT)                       BYTE                 
*                                                                               
* IOQ8            BYTE ADDR OF BUFFER                      WD                   
*                                                                               
* IOQ9            BYTE COUNT                               HW                   
*                                                                               
* IOQ10           MAX RETRY COUNT                          BYTE                 
*                                                                               
* IOQ11           CURRENT RETRY COUNT                      BYTE                 
*                                                                               
* IOQ12           SEEK ADDRESS/SPACE COUNT/MISC            WD                   
*                                                                               
* IOQ13           END ACTION DATA                          DW                   
*                                                                               
* IOQ14           PRIORITY                                 BYTE                 
*                                                                               
* IOQECB          ECB PTR                                  WORD                 
*                                                                               
* IOQERROR        ERROR LOG BUFFER PTR                     WORD                 
*                                                                               
         TITLE    'QUEUE'                                                       
*************                                                            2019000
*   QUEUE   *                                                            2020000
*************                                                            2021000
*                                                                        2022000
*   ROUTINE QUEUES UP THE I/O REQUEST                                    2023000
*   ROUTINE RETURNS +1 IF DEVICE DOWN, +2 OTHERWISE                      2024000
*                                                                        2025000
*    AT ENTRY:  R2   ECB I.D.                                                   
*               R4   I/O FUNCTION CODE                                          
*                R5   LINK                                               2027000
*                R6   NUMBER OF RETRIES                                  2028000
*                R7   DCT INDEX                                          2029000
*               R8   CLEANUP INFO WORD 1                                 2030000
*               R9   CLEANUP INFO WORD 2                                 2031000
*                R10  I/O BUFFER ADDRESS (BYTE ADDR)                     2032000
*                R11  I/O LENGTH (IN BYTES)                              2033000
*                R12  RAD SEEK ADDRESS OR # REC TO PASS (MT)                    
*                R13  PRIORITY                                           2035000
*                                                                        2036000
*   REGISTERS R0 - R7 PRESERVED;  R8 - R15 CLOBBERED                            
*                                                                        2039000
*                                                                        2040000
         PAGE                                                                   
*******************************************************************             
*  THIS CODE IS OVER WRITTEN DURING CRASH BECAUSE IT IS USED                    
* TO SAVE REGISTERS, MAP, AND INTERRUPT STATE                                   
*******************************************************************             
QUEUE    RES      0                                                             
*                                                                               
         BOUND 32                                                               
         DO1      #CRASH                                                        
CRASHMSG RES      16                PLACE FOR CRASH MESSAGE                     
CRASHREG RES      16                                                            
         DO1      #MAP                                                          
CRASHMAP RES      256                                                           
         DO       #SIGMA9                                                       
CRASHI1  RES,2    16                                                            
CRASHI2  RES,2    16                                                            
CRASHI3  RES,2    16                                                            
         FIN      #SIGMA9                                                       
CRASHRES RES      4                 PUSH STACK FOR CONVSECT                     
SEEKADDR RES      1                 SEEK ADDRESS                                
SENSESW  RES      1                                                             
OCDCT    RES      1                 OC INDEX DURING CRASH                       
         BOUND    8                                                             
CRASHLOC RES      2                                                             
*                                                                               
         DO1      #T85                                                          
BSTACK   RES      16                T85 BRANCH STACK AT CRASH TIME              
         DO1      #550                                                          
QREG     RES      X'20'             550 Q REGISTERS AT CRASH TIME               
         DO1      #550                                                          
FIGPANEL RES      13                ROOM FOR 13 CHASSIS OF STATUS               
         BOUND    16                                                            
CRASOLAY RES      512               CRASH OVERLAY LOCATION                      
         ORG      QUEUE                                                         
         PAGE                                                                   
**********************************************************                      
* QUEUE QUEUE QUEUE QUEUE QUEUE QUEUE QUEUE QUEUE QUEUE  *                      
**********************************************************                      
*QUEUE   RES      0                                                             
         DO       #IOEX                                                         
         LB,R15   DCT5,R7           GET DCT5 FLAGS                              
         CI,R15   1                 IS IOEX PRE-EMPT BIT SET                    
         BANZ     *R5               RETURN +1, CANT USE DEVICE                  
         FIN      #IOEX                                                         
         LC       DCT3,R7           GET DEVICE STATUS TO CC                     
         BCR,2    %0041             DEVICE NOT DOWN                             
*                                   DEVICE DOWN                                 
         CW,R8    XBIT10            DIAGNOSTIC REQUEST                          
         BAZ      0,R5              NO, ERROR REQUEST                           
         B        %0047             YES, HONOR REQUEST                          
****                                                                            
%0041    CW,R8    XBIT10            DIAGNOSTIC REQUEST                          
         BANZ     0,R5              YES, ERROR REQUEST                          
*                                   NO, HONOR REQUEST                           
*   NOW WE BREAK A FREE QUEUE ENTRY FROM THE POOL                        2047000
%0047    PUSH     8,R0              PUSH R0-R7                                  
%0043    LH,R1    DCT7              SIZE OF DCT FOR DRIVING I/O                 
%0042    DISABLE                                                         2051000
         LB,R3    IOQ2              POINTER TO HEAD OF FREE ENTRY POOL   2052000
         BEZ      %0046             POOL EMPTY, BRANCH                   2053000
*                                                                               
         LB,R15   IOQ2,R3           GET FORWARD LINK                            
         BNEZ     %0042A            BRANCH IF NOT LAST FREE Q ENTRY             
         CI,R13   1                 IS THIS A OMAN REQUEST                      
         BNE      %0046             NO, DONT USE THE LAST FREE Q                
*                                                                               
%0042A   RES      0                                                             
         CI,R13   KFF               BACKGROUND REQUEST?                  2054000
         BNE      %0040             NO, BRANCH                           2055000
         LB,R15   IOQ3              CURRENT NO OF BKGD ENTRIES IN USE           
         CB,R15   IOQ1              COMPARE TO MAX                              
         BL       %0045             LESS, BRANCH                         2058000
%0046    ENABLE                                                          2059000
*   NOW WE DRIVE THE I/O DEVICES IN AN ATTEMPT TO FREE A QUEUE ENTRY     2060000
         PUSH     15,R4             SAVE R4-R2                                  
         BAL,R2   SERDEV                                                 2062000
         PULL     15,R4             RESTORE R4-R2                               
         BDR,R1   %0042             LOOP THRU DCT TABLE                         
         B        %0043             ZERO, START LOOP AGAIN               2067000
%0045    MTB,1    IOQ3              INCREMENT NO OF BGRND ENTRIES USED   2068000
%0040    LB,R1    IOQ2,R3           GET FWD LINK FROM FREE ENTRY         2069000
         STB,R1   IOQ2              SET AS HEAD OF FREE ENTRY POOL       2070000
         PAGE                                                                   
*  HERE WE HAVE REGS AS AT ENTRY WITH WORKING QUEUE ENTRY INDEX IN R3    2072000
*  WE NOW PROCEED TO BUILD THE QUEUE ENTRY                               2074000
%0044    EQU      %                                                             
         STB,R7   IOQ7,R3           SET DCT INDEX                        2076000
         STB,R6   IOQ10,R3          SET NO OF RETRIES (MAX)              2077000
         STB,R6   IOQ11,R3          INITIALIZE WORKING NO OF RETRIES     2078000
         STB,R13  IOQ14,R3          SET PRIORITY                         2079000
         STB,R4   IOQ4,R3           SET FUNCTION CODE                    2080000
         STW,R2   IOQECB,R3         ECB I.D.                                    
         STB,R4   IOQ5,R3           SET CURRENT FUNCTION STEP            2081000
         STD,R8   IOQ13,R3          SET CLEANUP END ACTION                      
         STW,R10  IOQ8,R3           SET BUFFER ADDRESS                   2082000
         STH,R11  IOQ9,R3           SET BYTE COUNT                       2083000
         STW,R12  IOQ12,R3          SET RAD SEEK ADR/#REC TO PASS(MT)           
*                                                                               
         LB,R6    R8                GET CUPCODE                                 
         BNEZ     %+2               IS IT NON-ZERO                              
         BAL,R14  IOINC             IF NOT IM LOST                              
*                                                                               
         CI,R6    2                 IS IT CUPCORE OR CUPDCB                     
         BG       %0044B            NO                                          
*                                                                               
         MTB,4    R8                CHANGE CUP CODES TO X CODES (4 OR 5)        
         STD,R8   IOQ13,R3          AND RE-STORE                                
*                                   YES, POST IBC HERE                          
         DO       #MAP                                                          
         CW,R10   Y8                IS THIS A DATA CHAIN REQUEST                
         BAZ      %0044AA           NO, INITIAL BYTE COUNT IS IN R11            
*                                   YES, MUST  COMPUTE IBC                      
         LW,R1    R11               GET NO OF DW IN CHAIN                       
         SLS,R10  1                 MAKE IT THE WA(CHAIN)                       
         AI,R10   -1                BACK UP ONE FOR BDR                         
         LI,R4    0                 CLEAR COUNTER                               
         LI,R5    0                                                             
*                                                                               
         AD,R4    *R10,R1           ADD UP DW'S                                 
         BDR,R1   %-1                                                           
*                                                                               
         LW,R11   R5                PUT IBC IN R11                              
         FIN      #MAP                                                          
%0044AA  LW,R4    R11               PUT IBC IN R4                               
         BNEZ     %+2               SKIP IF NOT 16K                             
         LI,R4    X'10000'          SET TO 16K IF ZERO                          
         LW,R5    M17               16 K MASK                                   
*                                                                               
         CI,R6    1                 IS IT CUP CORE                              
         BE       %0044A            YES, DONT SHIFT                             
*                                   NO, ITS CUPDCB                              
         SLD,R4   17                POSITION                                    
         AI,R8    4                 POINT TO DCB ARS WORD                       
%0044A   STS,R4   *R8               STORE IN ARS FIELD OR POST WORD             
*                                                                               
%0044B   RES      0                                                             
         DO       #LN                                                           
         CH,R7    DCT1              COC LINE                                    
         BG       COCIO             YES, RETURN TO %CALLSD                      
         FIN      #LN                                                           
         DO       #DUALFLG                                                      
         LB,R4    DCT3,R7           GET DEVICE ACCESS KEY                       
         AND,R4   X3                ..                                          
         LB,R4    IOQINIT,R4        SET IOQ ACCESS KEY                          
         ELSE                                                                   
         LI,R4    0                 SINGLE-ACCESS, KEY = 0                      
         FIN                                                                    
         STB,R4   IOQ3,R3           SAVE IN INITIAL IOQ SWITCHES                
         PAGE                                                                   
%0049    EQU      %                                                             
*  THE QUEUE ENTRY IS BUILT                                              2088000
*  WE NOW MUST PLACE IT IN THE QUEUE FOR THE PROPER CHANNEL              2089000
*  WE HAVE:    R3   QUEUE ENTRY INDEX                                    2090000
*              R7   DCT INDEX                                            2091000
*              R13  PRIORITY                                             2093000
         DISABLE                    DISABLE DURING INSERT  /SIG7-1613/*B5732    
         LB,R4    DCT2,R7           CIT INDEX TO R4                      2094000
         LB,R2    CIT1,R4           INDEX OF HEAD OF CHANNEL QUEUE TO R2 2095000
         BEZ      %0051             B IF CHANNEL QUEUE EMPTY             2096000
%0053    CB,R13   IOQ14,R2          NOT EMPTY COMPARE PRIORITY           2097000
         BL       %0052             BRANCH IF CURRENT REQUEST HIGHER     2098000
         LB,R2    IOQ2,R2           NOT HIGHER, GET NEXT ENTRY IN QUEUE  2099000
         BNEZ     %0053             NOT END OF QUEUE, LOOP               2100000
*  WE ARE AT THE END OF THE QUEUE.  WE SHALL INSERT THIS ENTRY AT THE    2101000
*    TAIL OF THE QUEUE                                                   2102000
         LB,R1    CIT2,R4           CHANNEL QUEUE TAIL POINTER TO R1     2103000
         STB,R3   CIT2,R4           SET NEW QUEUE TAIL POINTER TO CURR   2104000
         STB,R3   IOQ2,R1           SET FWD LINK IN PREV LAST ENTRY      2105000
         LI,R2    0                 FWD LINK FOR CURRENT ENTRY           2106000
         B        %0054                                                  2107000
*  HERE QUEUE IS EMPTY.  R3 CONTAINS THE CURRENT QUEUE ENTRY INDEX,      2108000
*       R4 CONTAINS THE CIT INDEX                                        2109000
%0051    STB,R3   CIT1,R4           SET QUEUE HEAD POINTER               2110000
         STB,R3   CIT2,R4           SET QUEUE TAIL POINTER               2111000
         LI,R1    0                 BWD LINK FOR CURRENT ENTRY           2112000
         LI,R2    0                 FWD LINK FOR CURRENT ENTRY           2113000
         B        %0054                                                  2114000
*  HERE WE HAVE LOCATED THE SPOT IN THE QUEUE FOR THE CURRENT ENTRY      2115000
*  R2 CONTAINS THE INDEX OF THE ENTRY BEFORE WHICH THE CURRENT ENTRY     2116000
*     IS TO BE QUEUED                                                    2117000
%0052    LB,R1    IOQ1,R2           BWD LINK OF NEXT ENTRY IN QUEUE      2118000
         BEZ      %0055                                                  2119000
         STB,R3   IOQ2,R1           NOT TOP, SET FWD LINK OF HIGHER ENT  2120000
         B        %0056                                                  2121000
%0055    STB,R3   CIT1,R4           SET CIT HEAD TO CURRENT ENTRY        2122000
%0056    STB,R3   IOQ1,R2           SET BLINK OF NEXT ENT TO CURR ENTRY  2123000
%0054    STB,R1   IOQ1,R3           SET CURR ENTRY BWD LINK              2124000
         STB,R2   IOQ2,R3           SET CURR ENT FWD LINK                2125000
         ENABLE                                                          2126000
*                                                                        2127000
*  QUEUEING IS COMPLETE SO WE CALL SERVICE DEVICE                        2128000
*                                                                        2129000
%CALLSD  EQU      %                                                             
         LW,R1    R7                DCT INDEX TO R1                      2130000
%0057    BAL,R2   SERDEV                                                        
%0059    PULL     8,R0              RESTORE R0 - R7                             
         B        1,R5              RETURN +2                            2134000
*                                                                               
* IOQ ACCESS KEYS USED FOR DUAL ACCESS SYSTEMS                                  
*                                                                               
         DO       #DUALFLG                                                      
* INDEXED BY DCT3 BITS 6+7; GIVES IOQ3 BITS 5-7 FOR Q SETUP                     
IOQINIT  DATA,1   0,1,2,4           INITIAL IOQ ACCESS KEYS                     
         FIN                                                                    
         PAGE                                                                   
**************                                                                  
*   CALLSD   *                                                                  
**************                                                                  
*                                                                               
*                                                                               
*   AT ENTRY:     R1     FPT CODE                                               
*                 R2     DCB ADDRESS                                            
*                 R3     FPT ADDRESS                                            
*                 R5     LINK                                                   
*                                                                               
*                                                                               
CALLSD   PUSH     7,R1              SAVE R1-R7                                  
         LW,R7    1,R2              DCB WORD 1                                  
         LW,R8    0,R2              DCB WORD 0                                  
         CI,R8    K2                                                            
         BAZ      CALLSD1           B IF RAD FILE                               
         BAL,R4   GETDCTX           GET DCT INDEX IN R7                         
         NOP                                                                    
         CI,R7    X'80'                                    /SIG7-2097/*C5732    
         BANZ     CALLSD1           B IF RFT INDEX BIT SET /SIG7-2097/*C5732    
         LW,R1    R7                DCT INDEX TO R1                             
         B        CALLSD2                                                       
CALLSD1  AND,R7   M7                EXTRACT RFT INDEX                           
         LB,R5    RFT8,R7           AREA INDEX TO R5                            
         LB,R4    MDDCTI,R5         GET DCT INDEX FOR THE AREA                  
         LW,R1    R4                TO R1                                       
CALLSD2  RES      0                                                             
         BAL,R2   SERDEV                                                        
         PULL     7,R1              RESTORE REGS                                
         B        0,R5              RETURN                                      
         PAGE                                                                   
*                                                                               
* CALLSD10                                                                      
*                                                                               
CALLSD10 PUSH     7,R1                                                          
         LW,R1    R7                                                            
         B        CALLSD2           GO CALL SERVICE DEVICE                      
         TITLE    'SERVICE DEVICE'                                              
*                                                                        2146000
*                                                                        2148000
*****************************************************************               
* SERVICE A DEVICE WHEN AN I/O EVENT HAS OCCURED                                
*****************************************************************               
*        R1 IS THE DCT INDEX UPON ENTRY                                         
*        R2 IS THE LINK                                                         
*        ALL REGISTERS CLOBBERED                                                
*                                                                        2150000
*        BAL,R2   SERDEV                                                 2151000
*                                                                        2152000
*    USES ALL REGS                                                       2153000
*                                                                        2154000
SERDEV   RES      0                                                             
         DO       #MAP                                                          
         DO       #550                                                          
         RD,R3    X'300'            GET Q0 (PSD WORD 0) IN R3                   
         CW,R3    XBIT9             IS MAP BIT SET                              
         BANZ     SERDEV3           BRANCH IF MAPPED                            
         ELSE     #550=0                                                        
         XPSD,0   SDPSD             GO TEST FOR MAPPED CASE                     
         FIN      #550=0                                                        
         FIN      #MAP                                                          
         AND,R1   M7                MASK OFF DCT INDEX                          
         BNEZ     %+2               OK IF NOT ZERO                              
         BAL,R14  IOINC             ERROR IF ZERO DCT                           
         CH,R1    DCT7              IS IT TOO BIG                               
         BLE      %+2                                                           
         BAL,R14  IOINC             ERROR IF TOO BIG                            
         DO       #LN                                                           
         CH,R1    DCT1              IS IT A COC LINE                            
         BG       COCSRDV           YES, RETURN *R2                             
         FIN      #LN                                                           
         PAGE                                                                   
******************************************************************              
* CHECK ON INITIAL DEVICE STATE AND CLEAN-UP OR TIME CHECK IF NEEDED            
******************************************************************              
DRIVEIO  LW,R15   R2                SAVE RETURN ADDRESS IN R15                  
         LB,R2    DCT2,R1           SET PERMANENT CIT INDEX IN R2               
DSERV    RES      0                                                             
         ENABLE                                                                 
         SCD,R0   64                DELAY FOR INTERRUPTS TO OCCUR               
         DISABLE                                                                
*                                                                               
         LB,R3    CIT1,R2           GET Q ENTRY                                 
         BEZ      SCHEDXIT          NONE, NOTHING TO DO                         
*                                   YES, I HAVE A Q ENTRY TO WORK ON            
DSERV2   RES      0                                                             
         LB,R1    IOQ7,R3           GET DCT INDEX                               
         LB,R8    DCT5,R1           GET DCT SWITCHES                            
         CI,R8    (BIT0+BIT4+BIT5+BIT6)**-24 CLOCK TIMING NEEDED                
         BANZ     CLOCKIO           YES                                         
*                                   NO                                          
         CI,R8    BIT1**-24         IS CLEAN-UP NEEDED                          
         BANZ     CLEANUP           YES                                         
*                                   NO                                          
DSERV3   RES      0                                                             
         LB,R13   IOQ14,R3          GET PRIORITY                        4965.010
         CI,R13   X'FF'             IS IT FOREGROUND                            
         BE       DSERV4            NO, ITS BACKGROUND                          
*                                   YES, ITS FOREGROUND                         
         CI,R8    (BIT6+BIT4)**-24  IS IT MANUAL OR KEY-IN PENDING              
         BANZ     CANTWAIT          YES, KILL REQUEST                           
*                                   NO                                          
DSERV4   RES      0                                                             
         LB,R3    IOQ2,R3           GET NEXT Q ENTRY                            
         BNEZ     DSERV2            GOT MORE TO DO                              
         B        IOSCHED           NO TRY TO SCHEDULE A NEW OPERATION          
         PAGE                                                                   
         DO       #MAP                                                          
******************************************************************              
* IF MAPPED, RESCHEDULE I/O PROCESSING TO A DIFFERENT LEVEL                     
******************************************************************              
         DO       #550                                                          
SERDEV3  RES      0                                                             
         ELSE     #550=0                                                        
SDPSD    PSD      SERDEV3,7         ENTER UNMAPPED MODE                         
SERDEV3  RES      0                                                             
         LI,R0    BIT9**-16                                                     
         CH,R0    SDPSD             IS IT MAPPED                                
         BANZ     %+2               YES, CANT SERDEV                            
         LPSD,0   SDPSD             NO, GO AND SERDEV                           
         FIN      #550=0                                                        
*                                                                               
         PSW,R1   CTIOSTK           PUSH SERDEV CONTROL WORD                    
         LW,R15   R2                MOVE LINK REGISTER TO R15                   
         LW,R2    K:IOGL            IS THERE AN I/O LEVEL                       
         BGZ      SERDEV4           YES                                         
*  LIST 1                                                                       
         BLZ      SERDEV6           BRANCH IF DISPATCHER IS TO CLEAN-UP         
         LI,R2    BIT26             I/O INTERRUPT LEVEL BIT                     
         WD,R2    X'1700'           TRIGGER I/O INTERRUPT LEVEL                 
         B        SERDEV5           AND EXIT                                    
         PAGE                                                                   
SERDEV6  RES      0                 TRIGGER HIGH DISPATCHER LEVEL               
         LI,R1    1                                                             
         LH,R9    RDLILVL1,R1                                                   
         LH,R2    RDLIGRP1,R1                                                   
         WD,R9    0,R2              TRIGGER DISPATCHER                          
         STW,R1   TDTRIG            SET SOFTWARE BIT                            
SERDEV5  RES      0                                                             
         DO       #550                                                          
         B        SCHEDXIT                                                      
         ELSE     #550=0                                                        
         LI,R1    SCHEDXIT-SERDEV-1                                             
         AWM,R1   SDPSD                                                         
         LPSD,0   SDPSD             EXIT TO SCHEDXIT                            
         FIN      #550=0                                                        
*                                                                               
SERDEV4  RES      0                 TRIGGER I/O LEVEL                           
         WD,R2    *K:IOWD                                                       
         B        SERDEV5           AND EXIT                                    
         FIN      #MAP                                                          
         PAGE                                                                   
******************************************************************              
* INITIAL DEVICE OK, TRY TO START A REQUEST FOR THIS CHANNEL                    
*******************************************************************             
*                 R2  - CIT INDEX                                               
*                 R15 - LINK                                                    
IOSCHED  RES      0                                                             
RESCHED  RES      0                                                             
         ENABLE                                                                 
         SCD,R0   64                DELAY FOR INTERRUPTS                        
IOSCHED1 DISABLE                    RELEASE ANY PENDING INTERRUPTS              
         LB,R3    CIT1,R2           GET HEAD OF CHANNEL QUEUE                   
         BEZ      SCHEDXIT          ARE THERE ANY PENDING REQUESTS.             
*                                                                               
         LB,R5    CIT3,R2           YES, GET SUBCHANNEL STATUS BYTE             
         SLS,R5   -4                FORM INDEX FROM BUSY/HOLD FLAGS             
*                                                                               
* INT LOADS BITS 0-4 OF E.W. TO CC; BITS 4-15 TO R(EVEN);                       
*           BITS 16-31 TO R(ODD)                                                
*                                                                               
IOSCHED2 INT,R8   SELECTAB,R5       GET SCHEDULING KEY & COMPARE MASK           
         BCS,8    SCHEDHLD          CHECK CHANNEL HOLD IF SPECIFIED             
* BRANCH IF BOTH SUB-CHAN BUSY OR IF EITHER NON-BUSY AND HELD                   
* R8 - MASK TO CHECK IOQ ENTRY FOR STARTABILITY                                 
* R9 - USED IN STARTIO IN CASE CANT START                                       
         PAGE                                                                   
*****************************************************************               
* A CHANNEL MAY BE STARTABLE, CHECK DEVICE STATE                                
*****************************************************************               
IOSCHED3 CB,R8    IOQ3,R3           ELSE SCAN QUEUE FOR FREE REQUEST            
         BANZ     NEXTQUE           THAT IS STARTABLE ON AVAILABLE S.C.         
REQSTRT  LW,R10   R3                SAVE CURRENT IOQ INDEX                      
         LB,R1    IOQ7,R3           GET INDEX OF DEVICE FOR THIS REQUEST        
         BNEZ     %+2               IS DCT INDEX ZERO                           
         BAL,R14  IOINC             IF YES, IM LOST                             
         LB,R4    DCT5,R1           CHECK DEVICE STATE FOR AVAILABILITY         
         SCS,R4   -5                ISOLATE BUSY/CLEANUP/INTEROP FLAGS          
         CW,R4    Y4                AND CHECK FOR DEVICE KEYIN PENDING          
         EXU      REQSERV,R4        GO IF CLEANUP, NO GO IF BUSY/KEYIN          
* IF BUSY, THEN GO TO REQNSTRT                                                  
* IF KEY-IN, THEN GO DIRECTLY TO REQNSTRT                                       
* IF CLEAN-UP, THEN GO DIRECTLY TO CLEANUP                                      
* IF INTER-OP, THEN GET IN R3 THE HOLDING Q PTR                                 
* OTHERWISE CONTINUE WITH R3 UNCHANGED                                          
         PAGE                                                                   
*****************************************************************               
* READY TO START REQUEST, CHECK STOP COUNTS AND 3243 PROBLEM                    
*****************************************************************               
         CW,R3    XBIT0             IS THIS A HOLD REQUEST                      
         BANZ     IOSCHED4          YES, MUST START                             
*                                   NO                                          
         CI,R4    1                 IS THIS AN INTER-OP STEP                    
         BE       IOSCHED4          YES, MUST START                             
*                                   NO                                          
         MTB,0    DCT15,R1          IS ALL STOP COUNT POSITIVE                  
         BNEZ     REQNSTRT          YES, CANT START                             
*                                                                               
         LB,R4    IOQ14,R3          GET REQUEST PRIORITY                        
         CI,R4    X'FF'             IS IT BACKGROUND                            
         BNE      IOSCHED4          NO, MAY START                               
*                                   YES, IT IS BACKGROUND                       
         MTB,0    DCT14,R1          IS BACKGROUND STOP COUNT POSITIVE           
         BNEZ     REQNSTRT          YES, DONT START                             
IOSCHED4 RES      0                 TRY TO START I/O                            
         DO       #DP3243                                                       
         LB,R4    DCTCD,R1          GET ASSOCIATED DEVICE                       
         BEZ      IOSCHED5          SKIP IF ZERO                                
*                                   THIS IS A SHARED ARM DISK                   
         LB,R4    DCT5,R4           GET THAT DEVICES FLAGS                      
         CI,R4    X'FA'             IS IN USE AT ALL                            
         BANZ     REQNSTRT          YES, ABORT SCHEDULING FOR THIS DEVICE       
         FIN      #DP3243                                                       
         PAGE                                                                   
*****************************************************************               
* TRY TO START THIS REQUEST NOW                                                 
*****************************************************************               
IOSCHED5 RES      0                                                             
         DO       #DUALFLG                                                      
         LB,R4    IOQ3,R3           START OR INTEROP, R3 HAS REQUEST            
         AND,R4   X7                EXTRACT 3-BIT IOQ ACCESS KEY                
         CH,R5    ACCHECK,R4        ARE REQUIRED SUBCHANNELS AVAILABLE.         
         BAZ      STARTIO           YES, START I/O ACTIVITY FOR REQUEST         
         BL       SCHEDXIT          NO, ARE BOTH SUBCHANNELS REQUIRED.          
         ELSE                                                                   
         LI,R4    0                 SINGLE-ACCESS ONLY, FORCE KEY TO 0          
         B        STARTIO           GO DIRECTLY TO STARTIO                      
         FIN                                                                    
*****************************************************************               
* UNABLE TO START THIS REQUEST                                                  
*****************************************************************               
REQNSTRT INT,R3   R10               NO, RESTORE CURRENT IOQ INDEX               
         BCS,8    CHANBLK           IF SUBCHANNEL HELD, BLOCK IT OUT.           
* BRANCH IF FLAG SET BY SCHEDHLD INDICATES AN ATTEMPT TO FREE A HOLD            
* CHANBLK = SCHEDXIT IF NO DEVICE POOLING                                       
NEXTQUE  LB,R3    IOQ2,R3           OTHERWISE, CONTINUE QUEUE SCAN              
         BNEZ     IOSCHED3          ARE THERE ANY MORE REQUESTS.                
SCHEDXIT ENABLE                     NO, REMOVE INTERRUPT INHIBITS               
         B       *R15               GO BACK TO CALLING PROGRAM                  
         PAGE                                                                   
*****************************************************************               
* CHANNEL HAS A HOLD ACTIVE, SEE WHAT CAN BE DONE.                              
*****************************************************************               
SCHEDHLD AND,R8   M2                MASK R8 JUST IN CASE                        
         AI,R8    SCCHECK           SUBCHANNEL HELD OR BOTH BUSY, CHECK         
         EXU     *R8                IF BOTH BUSY (FCN=0), EXIT SCHEDULER        
* EXIT IF BOTH BUSY                                                             
* GET Q PTR OF HOLDING REQUEST IF EITHER HELD                                   
* OTHERWISE CRASH                                                               
         BNEZ     %+2               IS HOLD Q INDEX ZERO                        
         BAL,R14  IOINC             IF YES, IM LOST                             
         OR,R3    Y8                HELD - REQUEST INDEX IN R3 - FLAG           
         B        REQSTRT           ATTEMPT SERVICE OF HOLDING REQUEST          
*****************************************************************               
* CHANNEL HOLD CANT BE STARTED, TRY OTHER HALF IF POSSIBLE                      
*****************************************************************               
         DO       #DUALFLG                                                      
CHANBLK  LB,R4    IOQ3,R3           HELD SUBCHANNEL BLOCKED, EXTRACT KEY        
         AND,R4   X3                ..                                          
         AH,R5    ACCHECK,R4        SET REQUIRED SUBCHANNELS UNAVAILABLE        
         B        IOSCHED2          RE-SCHEDULE WITH NEW CHANNEL STATUS         
         ELSE                                                                   
CHANBLK  EQU      SCHEDXIT          SINGLE-ACCESS CHANNEL BLOCKED               
         FIN                                                                    
*                                                                               
         PAGE                                                                   
*                                                                               
* SCCHECK INDEXED BY AF(2) OF SELECTTAB                                         
SCCHECK  B        SCHEDXIT          FUNCTION 0 .. BOTH SUBCHANNELS BUSY         
         LB,R3    CIT5,R2           FUNCTION 1 .. SUBCHANNEL 1 HELD             
         DO       #DUALFLG                                                      
         LB,R3    CIT6,R2           FUNCTION 2 .. SUBCHANNEL 2 HELD             
         ELSE                                                                   
         BAL,R14  IOINC             ERROR                                       
         FIN                                                                    
         BAL,R14  IOINC             ERROR                                       
*                                                                               
************************************************                                
*                                                                               
* REQSERV INDEXED BY FITS 0-2 OF DCT5                                           
REQSERV  BANZ     REQNSTRT          0 .. NO START IF KEY-IN PENDING             
         LB,R3    DCT6,R1           1 .. INTER-OP, GET WAITING REQUEST          
         B        CLEANUP           2 .. CLEANUP PENDING, PROCESS               
INVAL    BAL,R14  IOINC             3 .. NO SUCH ANIMAL .. S.C. 40              
         B        REQNSTRT          4 .. DEVICE BUSY, NO GO                     
          BAL,R14  IOINC                                                        
          BAL,R14  IOINC                                                        
          BAL,R14  IOINC                                                        
*                                                                               
         PAGE                                                                   
*                                                                               
IOINC     CRASH    'I/O SYSTEM INCONSISTANCY'                                   
************************************************                                
*                                                                               
* ACCHECK INDEXED BY BITS 5-7 OF IOQ3; CORRESPONDS TO BITS 0-3                  
*         OF CIT3                                                               
         DO       #DUALFLG                                                      
ACCHECK  GEN,16   X'C'              000 .. BOTH SUBCHANNELS REQUIRED            
         GEN,16   X'8'              001 .. SUBCHANNEL 1 REQUIRED                
         GEN,16   X'4'              010 .. SUBCHANNEL 2 REQUIRED                
         GEN,16   X'0'              011 .. UNDEFINED ACCESS KEY                 
         GEN,16   X'0'              100 .. UNASSIGNED DUAL-ACCESS DEVICE        
         FIN                                                                    
         BOUND    4                                                             
         TITLE    'SERVICE DEVICE SELECT TABLE'                                 
         SPACE                                                                  
*        SELECTAB .. CENTRAL SCHEDULING DECISION TABLE.  AN ENTRY IN            
*        THIS TABLE IS SELECTED ACCORDING TO THE VALUE OF CIT3 BITS             
*        0 THRU 3 (SUBCHANNEL 'BUSY' & 'HOLD' FLAGS).  TABLE FORMAT:            
*                                                                               
*             BIT  0         AT LEASE ONE SUBCHANNEL IDLE-HELD OR               
*                            BOTH SUBCHANNELS BUSY                              
*             BITS 8-15      IF BIT 0 IS 1, THIS IS A SPECIAL FUNCTION          
*                            CODE, WITH 0 = BOTH SC'S BUSY, 1 = SC1             
*                            HELD, & 2 = SC2 HELD.  IF BIT 0 IS 0,              
*                            THIS IS A COMPARE MASK FOR THE IOQ ACCESS          
*                            KEY.  BIT 8 WILL ALWAYS BE 1, WITH BIT 14          
*                            1 IF SC2 BUSY & BIT 15 1 IF SC1 BUSY.              
*             BITS 16-19     USED BY 'ASSIGNSC' TO SELECT SUBCHANNEL            
*             BITS 24-31     CIT CHECK MASK (INVERSE OF CIT3(0-3))              
*                                                                               
* SELECTAB INDEXED INTO BY BITS 0-3 OF CIT3                                     
*                                                                               
         PAGE                                                                   
**********************************************************************          
* DUAL ACCESS CHANNEL BUSY/HOLD CONTROL TABLE                                   
**********************************************************************          
SELECT   COM,1,3,12,3,1,12 AF(1),0,AF(2),AF(3),AF(4),(%-SELECTAB||15)**4        
SELECTAB SELECT   0,X'80',-3,1      0 .. I-F/I-F .. UNRESTRICTED CHANNEL        
         SELECT   1,2,-3,0          1 .. I-F/I-H .. SCHEDULE HELD SC2           
         SELECT   1,1,-2,0          2 .. I-H/I-F .. SCHEDULE HELD SC1           
         SELECT   1,1,0,0           3 .. I-H/I-H .. BOTH HELD, SC1 FIRST        
         SELECT   0,X'82',-3,0      4 .. I-F/B-F .. SCHEDULE SC1 ONLY           
         SELECT   0,X'82',-3,0      5 .. I-F/B-H .. LIKEWISE - SC1 ONLY         
         SELECT   1,1,0,0           6 .. I-H/B-F .. SCHEDULE HELD SC1           
         SELECT   1,1,0,0           7 .. I-H/B-H .. SAME AS ABOVE - SC1         
         SELECT   0,X'81',-2,0      8 .. B-F/I-F .. SCHEDULE IF DUAL-ACC        
         SELECT   1,2,0,0           9 .. B-F/I-H .. SCHEDULE HELD SC2           
         SELECT   0,X'81',-2,0      A .. B-H/I-F .. SC2 AVAIL IF DUAL-AC        
         SELECT   1,2,0,0           B .. B-H/I-H .. SUBCHANNEL 2 HELD           
         SELECT   1,0,0,0           C .. B-F/B-F .. BOTH BUSY, NOTHING          
         SELECT   1,0,0,0           D .. B-F/B-H .. CAN BE SCHEDULED.           
         SELECT   1,0,0,0           E .. B-H/B-F .. NOTE: I=IDLE, B=BUSY        
         SELECT   1,0,0,0           F .. B-H/B-H .. AND F=FREE, H=HELD          
         TITLE    'I/O TIMEOUT ROUTINE'                                         
**********************************************************************          
* I/O TIME-OUT CHECKS (ALSO TIMES MANUAL AND KEY-IN PENDING MSGS)               
**********************************************************************          
*        CLOCKIO .. PERFORM I/O TIMEOUT CHECK FOR SCHEDULER.  IF TIME           
*        EXCEEDED AND TIME-OUT INCREMENT IS NON-ZERO, FOLLOWING WILL            
*        HAPPEN, DEPENDING ON DCT STATUS INFORMATION:                           
*                                                                               
*        1.  DEVICE BUSY-MANUAL.  IF STILL IN MANUAL STATE, OPERATOR            
*            WILL BE NOTIFIED.  IF NOW IN AUTOMATIC STATE, TIMEOUT              
*            WILL BE SET FOR I/O NOW IN PROGRESS.                               
*        2.  DEVICE BUSY, NOT MANUAL.  I/O WILL BE HALTED AND CLEANUP           
*            REQUEST SET.                                                       
*        3.  DEVICE KEY-IN PENDING.  OPERATOR WILL BE NOTIFIED WITH             
*            'KEY-IN PENDING' MESSAGE.                                          
*        4.  DEVICE DEFERED SIO START SET, THE DEVICE WILL BE                   
*            IDLED AND THE BIT RESET AND AN ATTEMPT MADE TO                     
*            SCHEDULE I/O ON IT AGAIN                                           
*                                                                               
*        R1 HAS DCT INDEX UPON ENTRY TO CLOCKIO.                                
         PAGE                                                                   
**************************************************************                  
* I/O TIME-OUT FUNCTIONS                                                        
**************************************************************                  
CLOCKIO  LW,R10   DCT11,R1          GET EXPECTED COMPLETION TIME                
         CW,R10   IOCLOCK           IS THERE A TIME OUT YET                     
         BGE      DSERV3            NO, NO FURTHER CHECK NEEDED                 
*                                   MAYBE                                       
         LB,R9    DCT18,R1          GET TIMEOUT INCREMENT                       
         BEZ      DSERV3            IF ZERO, THEN NO TIMEOUT CHECK NEEDED       
         CI,R9    255               IS IT MAXIMUM INCREMENT.                    
         BE       DSERV3            YES, NO TIMEOUT CHECKS NEEDED               
*                                   YES, A TIME-OUT HAS OCCURED                 
         LH,R10   DCT1,R1           YES, PROBABLY WILL NEED I/O ADR.            
         LB,R8    DCT5,R1           GET DEVICE STATUS IN R8                     
         CI,R8    BIT5**-24         IS THIS A DEFERED SIO START                 
         BAZ      NOTDEFER          NO                                          
*                                   YES                                         
*                                                                               
* RESTART A SIO DEFERAL                                                         
*                                                                               
         AND,R8   XBIT31            CLEAR OUT ALL BITS EXCEPT IOEX              
         STB,R8   DCT5,R1           STORE FLAGS                                 
*                                                                               
         LB,R3    DCT6,R1           GET IOQ PTR                                 
         LI,R0    0                                                             
         STB,R0   IOQ3,R3           CLEAR IOQ BUSY                              
         B        DSERV             AND RESCHEDULE                              
         PAGE                                                                   
*********************************************************************           
* MANUAL, BUSY OR KEY-IN PENDING                                                
*********************************************************************           
NOTDEFER RES      0                                                             
         CI,R8    (BIT6+BIT4)**-24  IS IT MANUAL OR KEY-IN PENDING              
         BAZ      CLOCKOUT          NO, I/O TIMED OUT                           
*                                   YES, MANUAL OR KEY-IN PENDING               
         AW,R9    IOCLOCK           COMPUTE NEXT TIMEOUT VALUE                  
         STW,R9   DCT11,R1          SAVE FOR NEXT TIME                          
         MTB,2    DCT18,R1          ADD 10 SEC TO TIMEOUT INCREMENT             
*                                                                               
         LI,R13   MSG0                                                          
         CI,R8    BIT4**-24         IS IT A KEY-IN PENDING CASE                 
         BANZ     TYPEKMSG          YES, TYPE KEY-IN PENDING MESSAGE            
*                                   NO, TEST FOR MANUAL                         
         TIO,R11 *R10               GET CURRENT I/O STATUS                      
         AND,R11  Y1                EXTRACT MANUAL/AUTOMATIC FLAG               
         BCR,11   TYPEMMSG          TYPE 'MANUAL' IF STATUS SAYS SO             
         LB,R4    DCT5,R1           GET SWITCHES                                
         AND,R4   XFD               CLEAR MANUAL FLAG                           
         STB,R4   DCT5,R1           AND RESTORE                                 
         B        DSERV             AND RESCHEDULE                              
         PAGE                                                                   
*********************************************************************           
* OUTPUT MANUAL (OR KEY-IN PENDING) MESSAGE                                     
*********************************************************************           
* OUTPUT MANUAL MESSAGE AND RETURN TO SCHEDULER                                 
TYPEMMSG RES      0                                                             
         LI,R13   MSG1              MANUAL MESSAGE                              
TYPEKMSG RES      0                                                             
         BAL,R5   MSGOUT            QUEUE UP MESSAGE                            
         DO       #SWAP                                                         
         LB,R3    DCT6,R1           GET IOQ PTR FOR IOBLOCK                     
         BAL,R5   IOBLOCK           AND POST TASK AS BLOCKED                    
         FIN      #SWAP                                                         
         B        DSERV             AND RESCHEDULE                              
*******************************************************                         
* CANT WAIT FOR KEY-IN OR MANUAL FOR FOREGROUND REQUESTS                        
********************************************************                        
CANTWAIT RES      0                                                             
         LI,R11   0                 SET RBC TO 0                                
         LI,R12   4                 SET TYC TO 4                                
         MTH,1    DCT10,R1          BUMP RE:ENT COUNT                           
         BAL,R5   REQCOM            WRAP UP REQUEST                             
         B        DSERV             AND START SCHEDULING AGAIN                  
         PAGE                                                                   
*********************************************************************           
* THIS SETS UP FOR A I/O SOFTWARE TIME-OUT TERMINATION                          
*********************************************************************           
CLOCKOUT RES      0                                                             
         TRIPPFI,R9                 TRIP PFI AND POLL PROCESSORS                
         LI,R11   X'10'             TIME OUT FLAG                               
         B        ABORTSET          SET UP FLAGS                                
**********************************************************************          
* THIS SETS UP FOR AN I/O ABORT                                                 
*********************************************************************           
ABORTIO  RES      0                                                             
         LI,R11   4                 GET ABORT FLAG                              
ABORTSET RES      0                                                             
         LB,R9    DCT3,R1           PICK UP CURRENT FLAGS                       
         OR,R9    R11               SET UP NEW FLAGS                            
         STB,R9   DCT3,R1           STORE FLAGS                                 
         PAGE                                                                   
*********************************************************************           
* THIS HALTS ACTIVE I/O, LOGS A TIME-OUT AND CALLS INTSIM                       
*********************************************************************           
HALTIO   RES      0                                                             
         HIO,R11  *R10              FORCE IO HALT                               
         DO       #ERRORLOG                                                     
         STCF     DCT19,R1          SAVE HIO CC AS AIO CC                       
         MTW,0    LDCT#ERR          TEST IF ERRLOG SYSGENED IN                  
         BEZ      NOLOGHIO                                                      
         LH,R5    DCT1,R1           GET DEVICE ADDR                             
         AND,R11  YFFFF             MASK                                        
         OR,R11   R5                STUFF                                       
         STW,R11  DCT12,R1          SAVE AS FAKE AIO STATUS                     
*                                                                               
         TIO,R11  *R10              TIO                                         
         STCF     DCT20A,R1         SAVE TIO CC                                 
         LH,R11   R11                                                           
         STH,R11  DCT21,R1          SAVE TIO STATUS                             
*                                                                               
         TDV,R10  *R10              TDV                                         
         STCF     DCT20,R1          TDV CC                                      
         STD,R10  DCT13,R1          TDV STATUS DW                               
*                                                                               
         LB,R3    DCT6,R1           GET IOQ INDEX                               
         BAL,R0   IOLOGTO           AND LOG TIMEOUT                             
*                                                                               
NOLOGHIO RES      0                                                             
         FIN      #ERRORLOG                                                     
CLOCKXIT BAL,R5   INTSIM            FAKE INTERRUPT                              
         B        DSERV                                                         
         TITLE    'INTERRUPT SIMULATION FOR TIMED OUT IO'                       
*********************************************************************           
* THIS HIO'S THE DEVICE AND SIMULATES AN I/O INTERRUPT                          
*********************************************************************           
*                                                                               
*                 BAL,R5   INTSIM      DCT INDEX PASSED IN R1                   
*                 ...      ...         USES REGISTERS 6 THRU 9                  
*                                                                               
*        THE FOLLOWING ACTIONS WILL BE TAKEN:                                   
*                                                                               
*        1.  DEVICE STATE SWITCHED FROM 'BUSY' TO 'CLEANUP-PENDING'             
*        2.  IF DATA TRANSFER WAS SET, 'SUBCHANNEL-BUSY' IS RESET.              
*                                                                               
INTSIM   LB,R8    DCT5,R1           GET DCT SWITCHES(2)                         
         AND,R8   X7F               RESET DEVICE BUSY FLAG                      
         OR,R8    X40               SET CLEANUP PENDING FLAG                    
         CI,R8    X'10'             WAS THERE DATA TRANSFER.                    
         BAZ      INTSEXIT          NO, SKIP CHANNEL STATUS RESET               
         LB,R6    DCT2,R1           YES, GET CIT INDEX (DON'T USE R2)           
         LB,R9    CIT3,R6           GET CHANNEL STATUS FLAGS                    
         DO       #DUALFLG                                                      
         LB,R7    DCT6,R1           GET INDEX OF REQUEST USING DEVICE           
         LB,R7    IOQ3,R7           EXTRACT 3-BIT IOQ ACCESS KEY                
         AND,R7   X3                ..                                          
         OR,R9    CBFLAGS,R7        RESET SUBCHANNEL BUSY INDICATOR             
         EOR,R9   CBFLAGS,R7                                                    
         ELSE                                                                   
         OR,R9    CBFLAGS           SINGLE-ACCESS IMPLEMENTATION                
         EOR,R9   CBFLAGS                                                       
         FIN                                                                    
         STB,R9   CIT3,R6           RESTORE CHANNEL STATUS                      
INTSEXIT STB,R8   DCT5,R1           RESTORE DEVICE SWITCHES(2)                  
         B        0,R5              RETURN TO CALLING PROGRAM                   
         TITLE    'RIPOFF - THIS RIPS OFF ANY Q ENTRY AND FREES IT'             
**********************************************************************          
* RIPOFF - THIS RIPS OFF ANY IOQ ENTRY PROPERLY                                 
**********************************************************************          
*                                                                               
* R3 - IOQ PTR FOR Q ENTRY TO BE RIPPEDOFF                                      
* R5 - LINK                                                                     
* ALL REGISTERS ARE CLOBBERED                                                   
*                                                                               
RIPOFF   RES      0                                                             
         PUSH     R5                                                            
         DISABLE                                                                
*                                                                               
*                                                                               
         LB,R1    IOQ7,R3           GET DCT INDEX                               
         DO       #LN                                                           
         CH,R1    DCT1              COC LINE                                    
         BG       COCRIP            YES, RETURN TO RIPTOFF                      
         FIN      #LN                                                           
         LB,R4    DCT6,R1           GET ITS IOQ INDEX                           
         CW,R4    R3                IS IT THE SAME                              
         BNE      RIPOFF10          NO, ITS NOT BUSY FOR IT                     
         DO       #LD                                                           
         LB,R0    DCT4,R1                                                       
         CI,R0    19                IS IT A LD TYPE                             
         BE       RIPOFF10          YES, JUST DEQUEUE                           
         FIN      #LD               NO, CONTINUE ON                             
*                                   YES, IT BELONGS TO THIS ONE                 
         LH,R4    DCT1,R1           GET DEVICE ADDRESS                          
         HIO,R0   0,R4              AND STOP IT                                 
*                                                                               
         LB,R8    DCT5,R1           GET DCT SWITCHES                            
         CI,R8    X'10'             IS DATA TRANSFER SET                        
         BAZ      RIPOFF05          NO, DONT RESET CHANNEL BUSY                 
         PAGE                                                                   
         LB,R6    DCT2,R1           YES, GET CIT INDEX (DON'T USE R2)           
         LB,R9    CIT3,R6           GET CHANNEL STATUS FLAGS                    
         DO       #DUALFLG                                                      
         LB,R7    IOQ3,R3           EXTRACT 3-BIT IOQ ACCESS KEY                
         AND,R7   X3                ..                                          
         OR,R9    CBFLAGS,R7        RESET SUBCHANNEL BUSY INDICATOR             
         EOR,R9   CBFLAGS,R7                                                    
         ELSE                                                                   
         OR,R9    CBFLAGS           SINGLE-ACCESS IMPLEMENTATION                
         EOR,R9   CBFLAGS           SINGLE-ACCESS IMPLEMENTATION                
         FIN                                                                    
         STB,R9   CIT3,R6           RESTORE CHANNEL STATUS                      
         PAGE                                                                   
RIPOFF05 RES      0                                                             
         LB,R5    DCT2,R1           GET CIT PTR                                 
         LB,R4    IOQ3,R3           GET REQUEST CODE FROM IOQ3                  
         AND,R4   M3                AND MASK                                    
*                                                                               
         LB,R9    CIT3,R5           GET CHANNEL STATUS FLAGS                    
         CW,R9    CHFLAGS,R4        IS SUBCHANNEL CURRENTLY BEING HELD.         
         BAZ      RIPOFF08          NO                                          
         LW,R2    R5                PUT CIT INDEX IN R2 FOR ANLZ                
         ANLZ,R6  CHSAVE,R4         YES, GET CIT HOLD TABLE ADDR IN R6          
         LB,R7    0,R6              GET INDEX OF HOLDING REQUEST                
         CW,R7    R3                IS IT THE SAME REQUEST                      
         BNE      RIPOFF08          NO, CANNOT RELEASE HOLD                     
         OR,R9    CHFLAGS,R4        YES, RESET SUBCHANNEL HOLD FLAG(S).         
         EOR,R9   CHFLAGS,R4                                                    
         STB,R9   CIT3,R5           ..                                          
         LI,R7    0                                                             
         STB,R7   0,R6              CLEAR SUBCHANNEL HOLD REQUEST INDEX         
RIPOFF08 RES      0                                                             
         LI,R4    0                                                             
         STB,R4   DCT5,R1           CLEAR DCT 5 SWITCHES                        
*                                                                               
         LI,R4    (BIT3+BIT4+BIT5)**-24                                         
         LB,R5    DCT3,R1                                                       
         OR,R5    R4                                                            
         EOR,R5   R4                RESET BITS 3,4 AND 5                        
         STB,R5   DCT3,R1                                                       
*                                                                               
         B        RIPOFF10                                                      
         PAGE                                                                   
RIPOFF10 RES      0                 CHECK TO SEE IF ITS ALREADY FREE            
         LI,R4    0                 GET FREE CHAIN PTR PTR                      
RIPOFF20 LB,R4    IOQ2,R4           GET NEXT ENTRY OFF FREE CHAIN               
         BEZ      RIPOFF30          END OF FREE CHAIN, NOT HERE                 
*                                                                               
         CW,R3    R4                IS IT THIS ENTRY                            
         BNE      RIPOFF20          NO, LOOK AGAIN                              
*                                                                               
         ENABLE                     YES                                         
         B        RIPTOFF2                                                      
********                                                                        
RIPOFF30 RES      0                 RIP IT OFF THE CIT CHAIN                    
         LI,R11   0                 SET RBC TO ZERO                             
         LI,R12   IOABORT           SET TYC TO ABORT                            
         MTH,1    DCT10,R1          BUMP RE:ENT COUNT JUST IN CASE              
*                                                                               
         BAL,R5   REQCOM            DO REQUEST COMPLETION                       
*                                                                               
RIPTOFF  RES      0                                                             
         BAL,R2   SERDEV            KEEP CHANNEL GOING                          
RIPTOFF2 RES      0                                                             
         PULL     R5                RESTORE LINK                                
         B        0,R5              AND EXIT                                    
         PAGE                                                                   
*********************************************************************           
* I/O BLOCKED - SET A FLAG TO ALLOW ROLL-OUT OF TASK                            
*********************************************************************           
* R5     LINK                                                                   
* R3     IOQ INDEX                                                              
* ALL REGISTERS SAVED                                                           
*                                                                               
         DO       #SWAP                                                         
IOBLOCK  RES      0                                                             
         PUSH     2,R1                                                          
         LW,R1    IOQECB,R3         GET ECB PTR                                 
         BEZ      NOIOBLK           NONE                                        
*                                                                               
         LW,R2    ECBSECB,R1                                                    
         LB,R2    R2                                                            
         LW,R1    LMIPCB,R2                                                     
         CW,R1    XLMISEC           IS IT SEC                                   
         BAZ      NOIOBLK                                                       
*                                                                               
         LW,R2    LMISDT,R2                                                     
         LB,R2    R2                STI INDEX                                   
         LW,R1    XSTIBLK                                                       
         STS,R1   STITCB,R2         SET BLOCK BIT                               
NOIOBLK  RES      0                                                             
         PULL     2,R1                                                          
         B        0,R5              RETURN                                      
         FIN      #SWAP                                                         
         TITLE    'START I/O'                                                   
*********************************************************************           
* STARTIO - START I/O FOR A IOQ REQUEST                                         
*********************************************************************           
*        AT THIS POINT, THERE IS A STARTABLE REQUEST IN R3.  THE DEVICE         
*        ACTIVITY COUNTER IS SET IN R14 AND INTERRUPTS ARE ENABLED.             
*        THE I/O HANDLER PRE-PROCESSOR IS CALLED UNLESS USER COMMAND            
*        LIST IS SPECIFIED.  HANDLER RETURN IS TO 'IOSST'.                      
*                                                                               
*        R0  ..  DOUBLEWORD ADDRESS OF COMMAND LIST                             
*        R1  ..  DCT INDEX                                                      
*        R2  ..  FLAGS, SERDEV EXIT, CIT INDEX (3,10,19)                        
*        R3  ..  REQUEST IOQ INDEX                                              
*        R4  ..  HANDLER FLAGS, SUBCHANNEL ALLOCATION CODE (8,24)               
*        R9  ..  CIT 4 BIT CHANNEL STATUS CHECK MASK                            
*        R10 ..  DEVICE OPERATION TABLE ('DOT') FOR 'IOSST'                     
*        R14 ..  DEVICE ACTIVITY COUNT FOR RE-ENTRANCY CHECK                    
*        R15 ..  LINK FOR SERVICE DEVICE                                        
*                                                                               
STARTIO  LH,R14   DCT10,R1          START, SET DEVICE ACTIVITY COUNTER          
         ENABLE                     RUN HANDLER & INITIAL START ENABLED         
         STH,R9   R1                SAVE 4-BIT CHANNEL STATUS CHECK MASK        
* R9 IS THE RIGHT HALF OF SELECTAB ENTRY                                        
         LW,R6    DCT8,R1           GET HANDLER PRE-PROCESSOR ADDRESS           
         DO       #IOEX                                                         
         LW,R7    IOQ8,R3           CHECK FOR IOEX                              
         LC       R7                GET BITS 0-3 TO CC                          
         BCS,4    %+2               SKIP IF IOEX                                
         B        0,R6              ELSE BRANCH TO PRE HANDLER                  
         PAGE                                                                   
*********************************************************************           
* QUEUED IOEX PRE-HANDLER                                                       
*********************************************************************           
* BRANCH TO DEVICE PRE-PROCESSOR IF NOT AN IOEX REQUEST                         
         DO       #DUALFLG                                                      
         BCR,2    %+2               YES, IS OPERATION RESTRICTED TO SC1.        
         LB,R4    SSCFORCE,R4       YES, FORCE TO SC1 IF UNALLOCATED.           
         FIN                                                                    
         LW,R0    R7                SET COMMAND LIST ORIGIN IN R0               
         AND,R0   M24               MASK OUT FLAG BITS                          
         LH,R8    IOQ9,R3           GET I/O TIMEOUT INCREMENT                   
         LI,R9    0                 SET NULL RE-TRY & FOLLOW-ON CODES           
         B        IOSTRT            GO TO ENTRY DISABLE POINT                   
         ELSE     #IOEX                                                         
         B        0,R6              ENTER PRE-HANDLER                           
         FIN      #IOEX                                                         
         PAGE                                                                   
*********************************************************************           
*********  DEVICE PRE-HANDLER RETURNS HERE  *************************           
*********************************************************************           
IOSST    AND,R0   M16               HANDLER RETURN, MASK COMMAND LIST           
         LB,R7    IOQ5,R3           GET CURRENT FUNCTION STEP INDEX             
         INT,R8  *R10,R7            GET 'DOT' INFORMATION FROM HANDLER          
         AND,R8   XFF               MASK TIMEOUT INCREMENT IN BYTE 2            
*        IOSTRT .. INITIATE I/O ACTIVITY ON COMPLETED COMMAND LIST.             
*        REGISTER SETUP IS AS IN STARTIO, WITH R8 CONTAINING THE                
*        TIMEOUT INCREMENT (IN 5-SECOND INTERVALS) FOR THE OPERATION            
*        AND R9 CONTAINING THE RE-TRY & FOLLOW-ON OPERATIONS.  THE              
*        OBJECTIVE IS TO GET THE I/O GOING AS SOON AS POSSIBLE; THUS,           
*        THE FRANTIC CODE AT THE BEGINNING.                                     
IOSTRT   DISABLE                    DISABLE POINT, START CRITICAL CODE          
         CH,R14   DCT10,R1          HAS START/CLEANUP BEEN SCHEDULED.           
         BNE      RESCHED           YES, RE-ENTERED, ABORT I/O START            
*                                   NO, NOT RE:ENTERED                          
         DO       #DP3243                                                       
         LB,R5    DCTCD,R1          GET ASSOCIATED DEVICE                       
         BEZ      IOSTRT0           SKIP IF ZERO                                
*                                   THIS IS A SHARED ARM DISK                   
         LB,R5    DCT5,R5           GET THAT DEVICES FLAGS                      
         CI,R5    X'FA'             IS IN USE AT ALL                            
         BANZ     RESCHED           YES, ABORT SCHEDULING FOR THIS DEVICE       
         FIN      #DP3243                                                       
         PAGE                                                                   
*********************************************************************           
* SET UP FOR SIO NOW THAT WE ARE REALLY READY TO START                          
*********************************************************************           
IOSTRT0  RES      0                 NO, GO AHEAD AND START                      
         LI,R14   0                 CLEAR MSG PTR                               
         LB,R5    CIT3,R2           NO PRE-EMPT, GET CHANNEL STATUS             
         LB,R10   IOQ3,R3           AND GET REQUEST SWITCH BYTE                 
         DO       #DUALFLG                                                      
         EXU      CHANTEST,R4       SELECT RELEVANT STATUS IF ASSIGNED          
         FIN                                                                    
         CH,R5    R1                HAS ASSIGNED S.C. STATUS CHANGED.           
         BANZ     RESCHED           YES, ABORT START, BACK TO IOSCHED           
IOSTRT1  STB,R8   DCT18,R1          NO, SAVE I/O TIMEOUT INTERVAL COUNT         
         STH,R9   DCT17,R1          SAVE RE-TRY & FOLLOW-ON CODES               
         LB,R9    DCT5,R1           PICK UP DCT5 FLAGS                          
         AND,R9   X1                SAVE IOEX FLAG                              
         DO       #DUALFLG                                                      
         EXU      IOALOAD,R4        GET DEVICE I/O ADDRESS IN R6                
         ELSE                                                                   
         LH,R6    DCT1,R1           SINGLE-ACCESS ONLY, GET I/O ADDRESS         
         FIN                                                                    
         DO       #PS                                                           
*                                                                               
         LB,R13   DCTSHARE          ARE THERE SHARED DEVICES                    
         BEZ      IOSTRT1C          NO, B                                       
         LB,R13   DCTSHARE,R1       IS THIS DEVICE SHARED                       
         BEZ      IOSTRT1C          NO                                          
         CI,R13   1                 SHARE VIA DUAL DEVICE CONTROLLER            
         BE       IOSTRT1C          YES                                         
         CI,R13   X'8'              IS DEVICE UNAVAILABLE                       
*        BANZ     IOSTRT1D          YES                                         
         BANZ     IOSTRT1C          YES, SKIP PS LOGIC                          
         CI,R13   X'4'              IS DEVICE 'MANUAL AVAILABLE'                
*                                   DEVICE IS AUTOMATIC AVAILABLE               
         AND,R13  XF0               R13 = SWITCH NO ONLY                        
         AW,R13   PSDIOADR          BUILD SWITCH DIO CODE                       
         OR,R13   M2                SET S,T BITS                                
         WD,R13   *R13              TRY TO SWICH DEVICE TO US                   
         BCS,1    IOSTRT1A          B, IF OTHER CPU OWNER                       
         LB,R13   DCTSHARE,R1                                                   
         OR,R13    M2               SET DEVICE IN USE(RESERVED)                 
         STB,R13  DCTSHARE,R1       S,T BITS ARE ACQUIRED FLAG                  
         B        IOSTRT1C                                                      
IOSTRT1A RES      0                 OTHER CPU HAS DEVICE                        
*        BCS,2    IOSTRT1B          B IF MANUALLY SWITCHED                      
         B        %+1                %%% ONLY DO MANUAL CASE &&                 
         STH,R6   DCT1,R1                                                       
         LCI      4                 FAKE:                                       
         STCF     R13                     SIO STAT = DEVICE UNAVAIL.            
         LCI      1                       SIO CC   = BUSY                       
         B        IOREJECT          FORCE RETRY IN 5 SEC.                       
IOSTRT1B RES      0                 MAUNUAL SWITCHED TO OTHER CPU               
         LI,R12   0                                                             
         LI,13    0                                                             
         LCFI     0                                                             
         STCF     DCT20,R1          TDV CC                                      
         STD,R12  DCT13,R1          TDV STATUS                                  
         STW,R12  DCT13,R1          AIO STATUS                                  
         LB,R6    DCT3,R1                                                       
         OR,R6    Y8                FORCE SIO FAILURE                           
         STB,R6   DCT3,R1                                                       
         B        NOLOGSIO                                                      
IOSTRT1D RES       0                                                            
*        OR,R9     X2               SEWT MANUAL FLAG IN DCT SWITCHES            
*        LI,R14    MSG10            OUTPUT 'UNAABILABLE MESSAGE                 
*        LI,R8     20/5             SET 20 SECOND TIMER                         
*        B         IOSTRT3                                                      
*SG10    TEXTC     ' UNAVAILABLE'                                               
         STH,R6   DCT1,R1                                                       
         NOP                                                                    
         NOP                                                                    
         NOP                                                                    
         B         IOSTRT2B                                                     
PSDIOADR DATA     X'9F00'           PER. SWITCH DIO ADDRESS                     
IOSTRT1C RES      0                                                             
         FIN      #PS                                                           
         DO       #ERRORLOG                                                     
         LI,R13   DCT#IO            IS ERROR LOGGING SYSGENED                   
         BEZ      %+2               NO                                          
         MTW,1    DCT#IO,R1         YES, BUMP SIO COUNT                         
         FIN      #ERRORLOG                                                     
         PAGE                                                                   
**********************************************************************          
* SIO SIO SIO SIO SIO SIO SIO SIO SIO SIO SIO SIO SIO SIO SIO SIO SIO           
**********************************************************************          
         DO1      #DUALFLG                                                      
         STH,R6   DCT1,R1           DCT1 = "ACTIVE" I/O ADDRESS                 
**********************************************************                      
         SIO,R12  0,R6              ATTEMPT I/O START ON THIS ADDRESS           
**********************************************************                      
         DO       #SIGMA9                                                       
         BCS,14   IOREJECT                                                      
         ELSE                                                                   
         BCS,12   IOREJECT          IF IT FAILED, EXIT TO ANALYZE FAULT         
         FIN      #SIGMA9                                                       
         LC       R13               CHECK FOR DEVICE 'MANUAL' OR 'AUTO'         
         BCS,1    IOSTRT3           AUTOMATIC, CONTINUE PROCESSING              
* BRANCH IF SIO STATUS BIT 3 (AUTO) SET                                         
         PAGE                                                                   
*******************************************************************             
* ANALYZE MANUAL STATE                                                          
*******************************************************************             
         LB,R7    DCT4,R1           GET DEVICE TYPE                             
         CI,R7    1                 IS IT TYA01                                 
         BE       IOSTRT3           NO MESSAGE                                  
         DO       #PTAPE                                                        
         CI,R7    2                 IS IT A PAPER TAPE READER/PUNCH (2/3)       
         BL       IOSTRT2           NO, IT IS MANUAL                            
         CI,R7    3                                                             
         BG       IOSTRT2           NO, IT IS MANUAL                            
*                                                                               
         AI,R7    -1                FORM MASK FOR MANUAL BITS                   
         SLS,R7   28                READER = BIT 3  PUNCH = BIT 2               
*                                                                               
         TDV,R13  0,R6              GET DEVICE STATUS                           
*                                                                               
         CW,R13   R7                IS DEVICE MANUAL                            
         BANZ     IOSTRT2           YES                                         
*                                   NO                                          
         CW,R7    XBIT1             IS PAPER LOW                                
         BAZ      IOSTRT3           NO                                          
         LI,R14   MSG8              YES, SET PAPER LOW MESSAGE                  
         B        IOSTRT3                                                       
         FIN      #PTAPE                                                        
         PAGE                                                                   
******************************************************************              
* DEVICE IS REALLY MANUAL, SET UP FOR MESSAGE OR SIO REJECT                     
******************************************************************              
IOSTRT2  RES      0                                                             
         LB,R7    IOQ14,R3          GET REQUEST PRIORITY                        
         CI,R7    X'FF'             IS IT BACKGROUND                            
         BNE      IOSTRT2A          NO, REJECT MANUAL                           
*                                   YES                                         
         MTB,0    IOQ10,R3          TEST RETRY COUNT                            
         BEZ      IOSTRT2A          NO RETRIES, REJECT MANUAL                   
*                                   RETRIES ALLOWED                             
         LB,R7    K:JCP1            GET JCP FLAGS                               
         CI,R7    BIT7**-24         IS IT A NO PAUSE MODE                       
         BAZ      IOSTRT2B          NO, ALLOW MANUAL                            
IOSTRT2A RES      0                 YES, REJECT MANUAL                          
         LCI      0                                                             
         B        IOREJECT          REJECT WITH CC=0                            
**                                                                              
IOSTRT2B RES      0                                                             
         OR,R9    X2                SET MANUAL FLAG IN DCT SWITCHES             
         LI,R14   MSG1              SET UP TO OUTPUT 'MANUAL' MESSAGE           
         LI,R8    20/5              AND SET 20 SECOND TIMER                     
         PAGE                                                                   
******************************************************************              
* I/O NOW STARTED (DEVICE MAY BE MANUAL), SET UP ALL FLAGS                      
******************************************************************              
IOSTRT3  RES      0                                                             
         STB,R8   DCT18,R1          SET UP TIMER INCREMENT                      
         AW,R8    IOCLOCK           ADD CURRENT I/O CLOCK VALUE                 
         STW,R8   DCT11,R1          SAVE I/O DEADLINE VALUE IN DCT              
         OR,R9    X80               SET DEVICE TO 'BUSY' MODE                   
         LC       R4                GET I/O HANDLER PRE-PROCESSOR FLAGS         
         BCS,8    IOSTEX2           IS SUBCHANNEL RELEASE SPECIFIED.            
* BRANCH IF SUB-CHANNEL RELEASE FLAG INDICATED BY POST-HANDLER                  
         BCR,2    IOSTRT4           NO, IS SUBCHANNEL TO BE HELD.               
* BRANCH IF NO CHANNEL HOLD INDICATED BY POST HANDLER                           
         OR,R5    CHFLAGS,R4        YES, SET APPROPRIATE HOLD FLAGS.            
         EXU      CHSAVE,R4         SAVE REQUEST INDEX IN CIT5 OR CIT6          
IOSTRT4  OR,R5    CBFLAGS,R4        SET APPROPRIATE SUBCHANNEL(S) BUSY          
         OR,R9    X10               AND SET DEVICE 'DATA-TRANSFER' BIT          
IOSTEX2  STB,R3   DCT6,R1           LINK THIS REQUEST TO DEVICE                 
         STB,R5   CIT3,R2           SAVE CHANNEL STATUS FLAGS                   
         STB,R9   DCT5,R1           AND DEVICE STATUS BYTE 2                    
         OR,R10   X80               SET REQUEST BUSY IN IOQ3 SWITCHES           
IOSTEX3  STB,R10  IOQ3,R3           RESTORE UPDATE IOQ3 SWITCH BYTE             
         MTH,1    DCT10,R1          UPDATE DEVICE ACTIVITY COUNTER              
         ENABLE                     REMOVE INTERRUPT INHIBITS                   
         LW,R13   R14               IS THERE ANY MESSAGE TO BE OUTPUT.          
         BEZ      %+2               NO, DON'T ASK FOR ANY TYPEOUT               
         BAL,R5   MSGOUT            YES, PASS MESSAGE INDEX IN R13              
         LC       DCT5,R1           WAS CLEANUP SET BY I/O START.               
         BCR,4    IOSCHED1          NO, RE-ENTER SCHEDULER FOR MORE I/O         
         B        DSERV             YES, CHECK DEVICE PRIOR TO SCHEDULER        
         PAGE                                                                   
******************************************************************              
* DUAL ACCESS CONTROL TABLES                                                    
******************************************************************              
         DO       #DUALFLG                                                      
CHANTEST NOP                        SUBCHANNEL ASSIGNMENT CHECK LIST            
         AND,R1   FFA0FFFF          001 .. SC1 .. ISOLATE CHECK MASK            
         AND,R1   FF50FFFF          010 .. SC2 .. ISOLATE CHECK MASK            
         B        FORCESC           011 .. DUAL-ACCESS RESTRICTED TO SC1        
         B        ASSIGNSC          100 .. UNASSIGNED DUAL-ACCESS               
         SPACE                                                                  
IOALOAD  LH,R6    DCT1P,R1          LOAD I/O ADDRESS: 00 = BOTH SC'S            
         LH,R6    DCT1P,R1          01 .. ON SC1 .. PRIMARY I/O ADDRESS         
         LH,R6    DCT1A,R1          10 .. ON SC2 .. SECONDARY ADDRESS           
         BAL,R14  IOINC             ERROR                                       
         FIN                                                                    
         SPACE                                                                  
CHSAVE   STB,R3   CIT5,R2           SAVE HOLDING REQUEST - BOTH SC'S            
         DO       #DUALFLG                                                      
         STB,R3   CIT5,R2           01 .. HOLD ON SUBCHANNEL 1                  
         STB,R3   CIT6,R2           10 .. HOLD ON SUBCHANNEL 2                  
         ELSE                                                                   
         BAL,R14  IOINC             ERROR                                       
         BAL,R14  IOINC             ERROR                                       
         FIN                                                                    
         BAL,R14  IOINC             ERROR                                       
         PAGE                                                                   
CBFLAGS  DATA     X'C0'             SUBCHANNEL BUSY FLAGS: 00 = BOTH            
         DO       #DUALFLG                                                      
         DATA     X'80'             01 .. SUBCHANNEL 1 ONLY                     
         DATA     X'40'             10 .. SUBCHANNEL 2 ONLY                     
         FIN                                                                    
         SPACE                                                                  
CHFLAGS  DATA     X'30'             SUBCHANNEL HOLD FLAGS: 00 = BOTH            
         DO       #DUALFLG                                                      
         DATA     X'20'             01 .. SUBCHANNEL 1 HELD                     
         DATA     X'10'             10 .. SUBCHANNEL 2 HELD                     
         SPACE                                                                  
SSCFORCE DATA     X'00010200'       ALLOCATION CODE TRANSLATION TABLE           
         DATA     X'03000000'       TO FORCE DUAL-ACCESS TO S.C. 1 ONLY         
         FIN                                                                    
         PAGE                                                                   
*        FORCESC .. FORCE DUAL-ACCESS TO SUBCHANNEL 1 OPERATION.                
*        ASSIGNSC .. ROUTINE TO DETERMINE SUBCHANNEL ASSIGNMENT FOR             
*        A NEW OPERATION ON A DUAL-ACCESS DEVICE.  ASSIGNMENT HAS               
*        BEEN DELAYED TO 'IOSTRT' TIME IN ORDER TO AVOID RE-SCHEDULING          
*        DUE TO PRE-EMPTION OF THE SUBCHANNEL BY A HIGHER-PRIORITY              
*        TASK.  ALGORITHM WORKS AS FOLLOWS:                                     
*                                                                               
*        1.  IF NEITHER SUBCHANNEL IS AVAILABLE (NOT BUSY, NOT HELD),           
*            THE I/O SCHEDULER IS RE-ENTERED.                                   
*        2.  IF ONE AND ONLY ONE SUBCHANNEL IS AVAILABLE, THAT SUB-             
*            CHANNEL IS TAKEN BY DEFAULT.                                       
*        3.  IF BOTH SUBCHANNELS ARE AVAILABLE, THE 'PREFERRED' BIT             
*            IS EXTRACTED FROM THE CIT STATUS AND IS USED TO SELECT             
*            THE SUBCHANNEL TO BE USED.  THE BIT IS THEN INVERTED.              
*                                                                               
         DO       #DUALFLG                                                      
FORCESC  LI,R4    1                 DUAL-ACCESS DEVICE FORCED TO SC1            
         AI,R10   -3                FORCE IOQ ACCESS KEY TO 001                 
         CI,R5    X'A0'             IS SUBCHANNEL 1 IDLE AND FREE.              
         BAZ      IOSTRT1           YES, RETURN TO START I/O ON SC1             
         B        IOSTEX3           NO, RE-SCHEDULE WITH NEW ACCESS KEY         
*                                                                               
ASSIGNSC SCS,R5   -3                R4 KEY = 100: UNASSIGNED DUAL-ACCESS        
         LH,R6    SELECTAB,R5       GET RIGHT HALFWORD OF SELECTAB ENTRY        
         BGEZ     SCHEDXIT          IS ANY SUBCHANNEL IDLE & FREE.              
         SAD,R6   -13               YES, SET UP SUBCHANNEL SELECT DATA:         
         AND,R7   Y8                SC1|-3/0, SC2|-2/0, EITHER|-3/1**31         
         AD,R4    R6                SELECT, INVERT 'PREFERRED' IF EITHER        
         SCS,R5   3                 RESTORE (POSSIBLY NEW) CIT STATUS           
         LI,R10   7                 MOVE SUBCHANNEL INDEX TO IOQ3               
         AND,R10  R4                TO FORM NEW IOQ ACCESS KEY                  
         B        IOSTRT1           AND RETURN TO CONTINUE I/O START            
         FIN                                                                    
         PAGE                                                                   
**********************************************************************          
* I/O REJECT, THE I/O START WAS NOT FULLY SUCCESSFUL, ANALYZE I/O CC            
**********************************************************************          
*        IOREJECT .. PROCESS REJECTED 'SIO' INSTRUCTION.  ACTION TO             
*        BE TAKEN IS A FUNCTION OF CONDITION CODE STATUS AS FOLLOWS:            
*                                                                               
*        00 .. FORGROUND REQUEST RETURNED MANUAL.  HIO DEVICE AND               
*              TREAT AS AN SIO REJECT                                           
*        01 .. SIMPLE SIO REJECTION.  REVERSE IOQ ACCESS KEY IF DEVICE          
*              IS DUAL-ACCESS AND DEVICE IS 'RESERVED' -- A CONDITION           
*              NORMALLY UNEXPECTED BUT MAY OCCUR AFTER SPECIAL I/O,             
*              SUCH AS SYSTEM START-UP OR RECOVERY.                             
*        10 .. SELECTOR IOP BUSY WITH ANOTHER CONTROLLER OR CON-                
*              TROLLER BUSY WITH ANOTHER DEVICE.  SET 'SIO-FAIL'                
*              BIT IN DCT3 AND CLEANUP PENDING.                                 
*        11 .. DEVICE ADDRESS NOT RECOGNIZED.  SET 'SIO-FAIL' AND               
*              CLEANUP PENDING.                                                 
* SIO REJECTED OR FORGROUND SIO MANUAL                                          
IOREJECT RES      0                                                             
         STCF     DCT19,R1          SAVE SIO CC                                 
         LH,R12   R13               GET SIO STATUS                              
         STH,R12  DCT21,R1          AND SAVE IT                                 
         LB,R6    DCT3,R1           GET DEVICE STATUS BYTE 1                    
         LCF      DCT19,R1          GET SIO CC                                  
         DO1      #SIGMA9                                                       
         BCS,2    SIOFAIL           BRANCH IF STATUS INFO BAD                   
         BCR,4    SIOFAIL           CC2 RESET, IS EITHER 10 OR 00               
         BCS,8    SIOFAIL           CC1 SET, IS 11 CASE                         
         LC       R13               GET SIO STATUS BITS 0 TO 3                  
         BCS,2    SIOFAIL           DEVICE STATUS 11                            
         BCR,4    SIOFAIL           DEVICE STATUS 00                            
*                                   DEVICE STATUS 10                            
         PAGE                                                                   
**********************************************************************          
* DEVICE BUSY WITH OTHER DUAL ACCESS CHANNEL, IS IT POOLING OR REDUNTANT        
***********************************************************************         
*                                                                               
* NOW DEVICE INDICATES A BUSY CONFLICT BETWEEN COMPETING CONTROLERS             
* IF DEVICE IS DUAL ACCESSABLE, SWITCH KEY AND TRY OVER                         
* IF DEVICE IS NOT DUAL, THIS MUST BE A DUAL-REDUNDANT CASE                     
*        AND IO IS DEFERED FOR 5 SECONDS                                        
*                                                                               
         DO       #DUALFLG                                                      
         LI,R7    3                                                             
         CS,R6    R7                IS THIS A DUAL ACCESS DEVICE KEY = 11       
         BE       SWCHKEY           YES, TRY OTHER CHANNEL                      
         FIN                        #DUALFLG     NO, DEFER SIO START            
         OR,R9    X4                SET DEFER SIO START BIT                     
         OR,R4    Y8                SET FLAG TO NOT BUSY OR HOLD CHANNEL        
         LI,R8    5/5               SET A 5 SECOND TIME OUT VALUE               
         B        IOSTRT3           FINISH UP AND EXIT                          
         SPACE    3                                                             
         DO       #DUALFLG                                                      
SWCHKEY  RES      0                                                             
         EOR,R10  X3                RESCHEDULE ON OTHER CONTROLER               
         B        IOSTEX3           BY INVERTING IOQ ACCESS KEY.                
         FIN                                                                    
         PAGE                                                                   
******************************************************************              
* SIO FAILURE OR REJECT, LOG PROBLEM AND ASK FOR A KEY-IN                       
******************************************************************              
         SPACE                                                                  
SIOFAIL  EQU      %                                                             
         DO       #EN                                                           
         LB,R12   DCT4,R1           GET DEVICE TYPE                             
         CI,R12   ENTYPE            SKIP IF NOT ETHERNET                        
         BNE      SIOREAL                                                       
         SPACE                                                                  
         LC       DCT19,R1          GET SIO CC                                  
         BCS,8+2  SIOREAL           SKIP IF TROUBLE                             
         BCR,4    SIOREAL           SKIP IF WIERD                               
         SPACE                                                                  
         LC       R13               GET SIO STATUS (0-3)                        
         BCR,8    SIOREAL           SKIP IF NO INTERRUPT PENDING                
         SPACE                                                                  
         MTH,1    DCT10,R1          UPDATE REENTRANCY COUNT                     
         B        SCHEDXIT          TERMINATE SERVICE DEVICE                    
         SPACE                                                                  
SIOREAL  EQU      %                                                             
         FIN      #EN                                                           
         OR,R6    X8                SET SIO FAILURE BIT                         
         STB,R6   DCT3,R1           ..                                          
*                                                                               
         LH,R6    DCT1,R1           GET DEVICE ADDR                             
         DO       #ERRORLOG                                                     
         TDV,R12  0,R6              TDV                                         
         STCF     DCT20,R1          TDV CC                                      
         STD,R12  DCT13,R1          TDV STATUS DW                               
         FIN      #ERRORLOG                                                     
*                                                                               
         HIO,R0   0,R6              HALT DEVICE IN CASE OF MANUAL               
*                                                                               
         DO       #ERRORLOG                                                     
         MTW,0    LDCT#ERR          TEST IF ERRLOG SYSGENED IN                  
         BEZ      NOLOGSIO          B IF NOT SYSGENED IN                        
         LCF      DCT19,R1          IS IT A FORGROUND MANUAL                    
         BCR,12   NOLOGSIO          YES, DONT LOG                               
*                                   NO, LOG IT                                  
         LH,R12   DCT21,R1          GET SIO STATUS                              
         SLS,R12  16                                                            
         OR,R12   R6                COMPOSE FAKE AIO STATUS                     
         STW,R12  DCT12,R1          SAVE FOR LOGGING                            
*                                                                               
         PUSH     4,R6                                                          
         BAL,R0   IOLOGSIO          LOG SIO FAILURE                             
         PULL     4,R6                                                          
NOLOGSIO RES      0                                                             
         FIN      #ERRORLOG                                                     
         OR,R9    X40               SET CLEAN-UP BIT                            
         OR,R9    X10               SET DATA TRANSFER BIT ON                    
         B        IOSTEX2           FINISH UP I/O START & EXIT                  
         TITLE    'I/O INTERRUPT RECEIVER'                                      
*                                                                        2392000
IOINT    EQU      %                                                      2393000
******************************************************************              
* I/O INTERRUPT RECIEVER                                                        
******************************************************************              
         ENTERCT                    ENTER CONTROL TASK CONTEXT                  
IO05     RES      0                                                             
         DO1      #ERRORLOG                                                     
         LI,R7    0                 PRESET R7 FOR LOGINTER                      
************************************************                                
         AIO,R1   0                 ACKNOWLEDGE INT                      2400000
************************************************                                
         STCF     DCT19             TEMPORARILY SAVE CC                         
         DO1      #SIGMA9                                                       
         BCS,2    LOGINTER          LOG CC3 SET CASES                           
         BCS,8    IO40              NO MORE INTERRUPTS NEED SERVICING           
         LW,R2    R1                AIO INFO                             2402000
         AND,R2   M16               MASK DEVICE ADDR                     2403000
         LH,R7    DCT1              DCT LENGTH TO R7                     2404000
         CH,R2    DCT1,R7           IS THIS RIGHT DCT INDEX              2405000
         BE       IO10              YES                                  2406000
IO11     BDR,R7   %-2               NO, TRY NEXT                         2407000
         DO       #XRBM                                                         
         B        ATTN              PROCESS ATTENTION INTERRUPT                 
         ELSE     #XRBM                                                         
         B        IO05              ANY MORE TO DO                              
         FIN      #XRBM                                                         
         PAGE                                                                   
******************************************************************              
* CHECK FOR A IOEX DEVICE OR FOR A BUSY DEVICE                                  
******************************************************************              
IO10     LB,R6    DCT5,R7           STATUS SWITCHES                             
         DO       #IOEX                                                         
         CI,R6    1                 IS IOEX PRE-EMPTING                         
         BANZ     IO100             YES, PREE-EMPT I/O INTERRUPT                
*                                   NO                                          
         FIN      #IOEX                                                         
         CI,R6    X'80'             IS DEVICE BUSY                              
         BAZ      IO11              NO, TRY SOME MORE      /SIG7-8710/*C5732  02
         LB,R5    DCT2,R7           GET CIT INDEX          /SIG7-4368/*C015732  
*                                   GOT THE RIGHT DEVICE                        
         PAGE                                                                   
******************************************************************              
* DEVICE FOUND (DCTX IN R7), COLLECT I/O STATUS                                 
******************************************************************              
         LB,R4    CIT3,R5           GET CIT SWITCHES       /SIG7-4368/*C015732  
         LB,R3    DCT3,R7           GET DCT3 SWITCHES      /SIG7-4368/*C015732  
IO14     RES      0                 COLLECT AND SAVE STATUS                     
         STW,R1   DCT12,R7          SAVE AIO STATUS                             
         TDV,R8   *R2               GET TDV STATUS AND CC                       
         DO       #SIGMA9                                                       
         BCS,10   LOGINTER          IGNORE IF BAD STATUS                        
         ELSE                                                                   
         BCS,8    LOGINTER          IGNORE IF BAD STATUS                        
         FIN      #SIGMA9                                                       
         STCF     DCT20,R7          SAVE TDV CC                                 
         STD,R8   DCT13,R7          SAVE TDV STATUS                             
         TIO,R9   *R2               GET TIO STATUS                              
         DO       #SIGMA9                                                       
         BCS,10   LOGINTER          IGNORE IF BAD STATUS                        
         ELSE                                                                   
         BCS,8    LOGINTER          IGNORE IF BAD STATUS                        
         FIN      #SIGMA9                                                       
         STCF     DCT20A,R7         SAVE TIO CC                                 
         LH,R9    R9                RIGHT JUSTIFY STATUS                        
         STH,R9   DCT21,R7          SAVE TIO STATUS                             
         LB,R8    DCT19             GET AIO CC                                  
         STB,R8   DCT19,R7          SAVE AIO CC PERMANENTLY                     
         PAGE                                                                   
******************************************************************              
* SET UP DEVICE AND CHANNEL SWITCHES TO SHOW INTERRUPT RECIEVED                 
******************************************************************              
         LB,R6    DCT5,R7           GET DCT DEVICE SWITCHES                     
         LB,R4    DCT2,R7           GET CIT INDEX                               
         LB,R4    CIT3,R4           GET CHANNEL SWITCHES                        
         AND,R6   X7D               RESET DEVICE BUSY, MANUAL                   
         OR,R6    X40               SET CLEANUP PENDING                  2420000
         CI,R6    X'10'             DATA TRANSFER                        2421000
         BAZ      IO17              NO                                          
         LB,R3    DCT6,R7           GET IOQ INDEX                               
         LB,R3    IOQ3,R3           GET IOQ SWITCHES                            
         AND,R3   X3                EXTRACT ACCESS KEY                          
         OR,R4    CBFLAGS,R3        SET SUBCHANNEL(S) NOT BUSY                  
         EOR,R4   CBFLAGS,R3                                                    
         STB,R4   CIT3,R5           RESTORE CIT SWITCHES                 2426000
IO17     STB,R6   DCT5,R7           RESTORE DCT SWITCHES                        
IO22     RES      0                                                             
         LW,R1    R7                TRANSFER DCT INDEX                   2433000
******************************************************************              
* STACK DCT INDEX FOR SERDEV PROCESSING AT SOME CLEAN-UP LEVEL                  
******************************************************************              
         PSW,R1   CTIOSTK           SAVE FOR DEFERED I/O                        
         BSO      IO38              OVERFLOW, DONT DEFER                        
         B        IO05              GO AIO UNTIL DONE                           
         PAGE                                                                   
*****************************************************************               
* VARIOUS CLEAN-UP LEVEL PROCESSES                                              
*****************************************************************               
IO40     RES      0                                                             
         LI,R2    X'3FFF'           MASK                                        
         CW,R2    CTIOSTK+1         IS STACK EMPTY                              
         BAZ      IO40A             YES, JUST EXIT                              
*                                   NO, GOT TO PROCESS                          
         LW,R2    K:IOGL            IS I/O TO BE DEFERED                        
         BEZ      IO36              NO                                          
*                                   YES, IS THERE A SPECIAL LEVEL               
         BGZ      IO30              YES                                         
         LI,R1    1                 USE HIGHEST DISP                            
         LH,R9    RDLILVL1,R1       GET LEVEL BITS                              
         LH,R2    RDLIGRP1,R1       GROUP BITS                                  
         WD,R9    0,R2              TRIGGER IT                                  
         STW,R1   TDTRIG            SOFTWARE TRIGGERED                          
IO40A    EXITCT                     EXIT I/O INTERRUPT LEVEL                    
         LPSD,X'B'  IOPSD           EXIT IO INTERRUPT LEVEL                     
*********                                                                       
IO30     RES      0                                                             
         WD,R2    *K:IOWD           *** TRIGGER ALTERNATE LEVEL ***             
         B        IO40A                 AND EXIT LEVEL                          
*********                                                                       
IO36     RES      0                                                             
         PLW,R1   CTIOSTK           GET A CONTROL WORD FOR SERDEV               
         BSU      IO40A                                                         
IO38     RES      0                                                             
         BAL,R2   SERDEV            CALL SERVICE DEVICE                         
         B        IO05              GO TRY AIO AGAIN                            
         PAGE                                                                   
************************************                                            
* I/O ALTERNATE LEVEL              *                                            
************************************                                            
*                                                                               
IOALT    RES      0                                                             
         ENTERCT                    ENTER CONTROL TASK CONTEXT                  
*                                                                               
IO46     RES      0                                                             
         DISABLE                                                                
         PLW,R1   CTIOSTK           GET A CONTROL WORD FOR SERDEV               
         BSU      IO50              UNDERFLOW, EXIT                             
*                                                                               
         ENABLE                                                                 
         BAL,R2   SERDEV            CALL SERVICE DEVICE                         
         B        IO46              SEE IF ANY MORE TO DO                       
*                                                                               
************************************                                            
*                                                                               
IO50     EXITCT                     EXIT CONTROL TASK CONTEXT                   
         LPSD,X'B'  DIOPSD          EXIT ALT IO LEVEL                           
         PAGE                                                                   
*****************************************************************               
* IOEX I/O INTERRUPT PREEMPTION LOGIC                                           
*****************************************************************               
         DO       #IOEX                                                         
IO100    RES      0                 I/O INTERRUPT PRE-EMPTION                   
         LW,R11   DCT12,R7          GET PRE-EMPT END-ACTION                     
         BEZ      IO40A             EXIT IF NONE                                
*                                   OTHERWISE DO IT                             
         LW,R5    R1                AIO STATUS TO R5                            
*                                                                               
         LH,R1    DCT1,R7           DEVICE ADDRESS                              
         TDV,R8   0,R1              TDV STATUS TO R8 AND R9                     
*                                                                               
         TIO,R3   0,R1              TIO STATUS                                  
         LH,R6    R3                TO R6                                       
*                                                                               
         BAL,R4   ENDAC             AND DO END ACTION                           
*                                                                               
         B        IO40A             AND EXIT LEVEL                              
         FIN      #IOEX                                                         
************************************                                            
         PAGE                                                                   
*****************************************************************               
* ATTENTION INTERRUPT HANDLER                                                   
*****************************************************************               
*                                                                               
* AIO STATUS IS IN R1                                                           
* AIO DEVICE ADDR IS IN R2                                                      
* ALL REGISTERS CAN BE USED                                                     
*                                                                               
         DO       #XRBM                                                         
ATTN     RES      0                                                             
         LH,R7    DCT1              # OF DCT ENTRIES                            
         CH,R2    DCT1,R7           IS ADDR THE SAME                            
         BE       ATTN10            FOUND IT                                    
         BDR,R7   %-2               LOOP                                        
         B        LOGINTER                                                      
         PAGE                                                                   
ATTN10   RES      0                                                             
         LW,R15   DCT8,R7           EXAMINE PRE-HANDLER                         
         CW,R15   ATTNOK            WORD FOR ATTENTION                          
         BAZ      ATTN11            BIT - SKIP IF OFF                           
         SPACE                                                                  
         AI,R15   -1                TRUE IMPLIES PROCESS                        
         BAL,R14  *R15              VIA PREHANDLER-1                            
         B        IO22              EXIT: STACK DCT INDEX                       
         B        ATTNMSG           EXIT: ISSURE ATTN MESS                      
         SPACE                                                                  
ATTN11   EQU      %                                                             
ATTNOK   EQU      BITS+0                                                        
ENTYPE   EQU      18                ETHERNET DCT4 DEVICE 'TYPE'                 
         LB,R6    DCT4,R7                                                       
         CI,R6    18                                                            
         BLE      %+2                                                           
         BAL,R14  IOINC                                                         
         B        %+1,R6            JUMP ON DEVICE TYPE                         
         B        ATTNIOEX          0 IOEX                                      
         B        ATTNTTY           1  TTY                                      
         B        LOGINTER          2  PR                                       
         B        LOGINTER          3  PP                                       
         B        LOGINTER          4  CR                                       
         B        LOGINTER          5  CP                                       
         B        LOGINTER          6  LP                                       
         B        ATTNDC            7  DC                                       
         B        ATTN9T            8  9T                                       
         B        ATTN7T            9  7T                                       
         B        LOGINTER          10 CP                                       
         B        LOGINTER          11 LP                                       
         B        LOGINTER          12 DP                                       
         B        LOGINTER          13 PL                                       
         B        ATTNDP            14 DP                                       
         B        LOGINTER          15 LP                                       
         B        LOGINTER          16 9T                                       
         B        LOGINTER          17 RB                                       
         B        ATTNIOEX          18 SPECIAL USER DEVICE                      
         PAGE                                                                   
*************************************************************************       
* ATTENTION INTERRUPT HANDLER FOR TELETYPE DEVICES                              
*************************************************************************       
         DO       #550                                                          
ATTNTTY  RES      0                                                             
         CW,R1    XBIT2             IS IT AN ATTENTION                          
         BAZ      LOGINTER          NO                                          
         LI,R3    OC                GET OC INDEX                                
         CB,R7    OPLBS2,R3         IS DEVICE THE OC                            
         BNE      ATTNBRK           NO, BREAK TASK                              
         LI,R3    BIT27                                                         
         WD,R3    X'1700'           TRIGGER CP INTERRUPT                        
         B        IO05              GO SERVICE ANY MORE INTERRUPTS              
*                                                                               
* SIMULATE BREAK INTERRUPT IN TASK                                              
*                                                                               
ATTNBRK  RES      0                                                             
         LD,R10   DCT16,R7          GET DEVICE NAME                             
         SLD,R10  24                SHIFT OFF NL,BANG,BANG                      
         AW,R11   X404040           ADD IN BLANKS                               
         LB,R6    SJI3              GET JOB COUNT                               
         CD,R10   SJI2,R6           IS IT THIS JOB                              
         BE       ATTNBRK5          YES                                         
         BDR,R6   %-2               NO, LOOP                                    
         B        IO05              NO SUCH JOB, GO AIO AGAIN                   
*                                                                               
ATTNBRK5 RES      0                                                             
         LW,R7    SJI1,R6           GET JCB ADDR                                
         BAL,R8   BRKSUB            GO AND SIMULATE BREAK                       
         B        IO05              GO SERVICE ANY MORE INTERRUPTS              
         ELSE     #550=0                                                        
ATTNTTY  B        LOGINTER                                                      
         FIN      #550=0                                                        
         PAGE                                                                   
************************************************************************        
* ATTENTION INTERRUPT HANDLER FOR MAG TAPE AND DISC PACKS                       
************************************************************************        
ATTNDC   RES      0                                                             
ATTNDP   RES      0                                                             
ATTN7T   RES      0                                                             
ATTN9T   RES      0                                                             
         CW,R1    XBIT1             IS ATTENTION BIT SET IN AIO STATUS          
         BAZ      LOGINTER          NO, LOG AS AN ERROR                         
         SPACE                                                                  
ATTNMSG  EQU      %                                                             
ATTNIOEX EQU      %                                                             
         LI,R13   MSGATTN                                                       
         LW,R1    R7                PUT DCT INDEX IN R1                         
         BAL,R5   MSGOUT                                                        
         B        IO05              GO SERVICE ANY MORE INTERRUPTS              
*                                                                               
MSGATTN  TEXTC    ' ATTENTION INTERRUPT '                                       
         FIN      #XRBM                                                         
         PAGE                                                                   
************************************************************************        
* LOG UNEXPECTED I/O INTERRUPTS                                                 
************************************************************************        
         DO       (#ERRORLOG)&(#XRBM)                                           
LOGINTER RES      0                                                             
         MTW,0    LOGFLAG           SHOULD LOGGING BE DONE                      
         BEZ      IO05              NO, GO BACK TO AIO                          
*                                   YES                                         
         LI,R5    0                 DEFAULT MODEL #                             
         CI,R7    0                 WAS A DEVICE FOUND                          
         BEZ      %+2               NO                                          
         LH,R5    DCTMODX,R7        YES, GET MODEL NUMBER                       
*                                                                               
         MTW,1    LOSTLOGS          BUMP LOST LOG COUNT                         
         LI,R7    LOGSIZE                                                       
         BAL,R8   GETTEMPI          GET SPACE FOR LOG                           
         B        IO05              NO SPACE, GO BACK TO AIO                    
         MTW,-1   LOSTLOGS          FIX LOST LOG COUNT BACK                     
*                                                                               
         LI,R6    LOGMODEL          MODEL NUMBER                                
         STH,R5   *R7,R6                                                        
*                                                                               
         LI,R6    LOGCOUNT                                                      
         LI,R8    4                                                             
         STB,R8   *R7,R6            LOG COUNT                                   
*                                                                               
         STW,R1   LOGAIOST,R7       AIO STATUS                                  
*                                                                               
         LI,R6    LOGAIOCC                                                      
         LB,R8    DCT19                                                         
         STB,R8   *R7,R6            AIO CC                                      
         PAGE                                                                   
         LI,R6    LOGTYPE                                                       
         LI,R8    X'13'                                                         
         STB,R8   *R7,R6            LOG TYPE                                    
*                                                                               
         BAL,R0   PUSHLOG                                                       
*                                                                               
         B        IO05              GO AND SERVICE ANY MORE INTERRUPTS          
         ELSE     (#ERRORLOG)&(#XRBM)                                           
LOGINTER EQU      IO05                                                          
         FIN      (#ERRORLOG)&(#XRBM)                                           
         TITLE    'I/O CLEAN UP'                                                
*****************************************************************               
* I/O CLEAN-UP - ALL POST-HANDLING, AND COMPLETION REPORTING                    
*****************************************************************               
*                                                                               
*        IF PRIORITY PERMITS, THE DEVICE ACTIVITY COUNT IS SET IN R14,          
*        INTERRUPTS ARE ENABLED, AND THE REQUEST CURRENTLY BEING SER-           
*        VICED BY THE DEVICE IS PROCESSED BY THE I/O HANDLER, WITH              
*        THE DEVICE RETURNED TO THE 'FREE', 'INTER-OP', OR 'KEYIN-              
*        PENDING' STATE, AS APPLICABLE.  REGISTER SETUP:                        
*                                                                               
*        R1  ..  PRIORITY, DCT INDEX (8,24)                                     
*        R2  ..  FLAGS, SERDEV EXIT, CIT INDEX (3,10,19)                        
*        R3  ..  SCRATCH, IOQ INDEX (8,24)                                      
*        R11  ..  REMAINING BYTE COUNT (RBC) FROM POST-HANDLER                  
*        R12 ..  FLAGS RETURNED FROM HANDLER:                                   
*                BIT 16 .. RE-TRY SEQUENCE                                      
*                BIT 17 .. FOLLOW-ON SEQUENCE                                   
*                BIT 18 .. INTER-OPERATIVE REQUEST                              
*                BIT 19 .. KEY-IN PENDING (NORMAL)                              
*                BIT 20 .. KEY-IN PENDING (SPECIAL)                             
*                BIT 21 .. CONTINUE CHANNEL HOLD                                
*                BYTE 3 .. TYPE OF COMPLETION                                   
*        R13 ..  MESSAGE TO BE TYPED (0 IF NONE)                                
*        R14 ..  DEVICE ACTIVITY COUNT                                          
*        R15 ..  NOT USED - RESERVED FOR FUTURE SYSTEMS                         
         PAGE                                                                   
**************************************************************************      
* I/O CLEAN UP                                                                  
**************************************************************************      
CLEANUP  LH,R14   DCT10,R1          SET DEVICE ACTIVITY COUNTER                 
         LB,R3    DCT6,R1           PRE-EMPT REQUEST INDEX                      
         ENABLE                     RUN I/O HANDLER IN ENABLED STATE            
*                                                                               
         DO       #IOEX                                                         
         LW,R5    IOQ8,R3           CHECK FOR IOEX                              
         CW,R5    XBIT1             IS BIT 1 SET                                
         BANZ     IOEXCU            YES, ITS IOEX                               
         FIN      #IOEX                                                         
*                                                                               
         LB,R5    DCT3,R1           GET DCT SWITCHES                            
         CI,R5    4                 WAS I/O ABORTED                             
         BANZ     ABORTCU           YES                                         
*                                   NO                                          
         CI,R5    8                 DID SIO FAIL                                
         BANZ     BADSIOCU          YES                                         
*                                   NO                                          
         CI,R5    X'10'             DID OPERATION TIME-OUT                      
         BANZ     TIMOUTCU          YES                                         
*                                   NO                                          
         LW,R5    DCT9,R1           GET I/O HANDLER CLEANUP ENTRY               
         B        0,R5              CALL HANDLER POST-PROCESSOR                 
         PAGE                                                                   
**********************************************************                      
********   DEVICE POST-PROCESSOR RUNS HERE       *********                      
**********************************************************                      
IOSCU    DISABLE                    RETURN FROM HANDLER POST-PROCESSOR          
         CH,R14   DCT10,R1          WAS START/CLEANUP RE-ENTERED.               
         BNE      RESCHED           YES, CLEANUP HAS ALREADY BEEN DONE          
         MTH,1    DCT10,R1          NO, INCREMENT ACTIVITY COUNT                
         LB,R4    DCT3,R1           RESET TIMEOUT/SIO-FAIL IN DCT3              
         DO       #MAP                                                          
         LD,R6    DCT13,R1          CDW INDEX TO R6                             
         AND,R6   M24               MASK OFF ADDRESS                            
         CI,R6    DA(ROOTEND)       IS IT A VALID ADDR                          
         BG       CUP15             NO, DONT BOTHER TO ADD UP                   
         LD,R8    0,R6              GET CDW                                     
         LB,R8    R9                GET FLAGS                                   
CUP10    CI,R8    BIT24             DATA CHAINING                               
         BAZ      CUP15             NO, BRANCH                                  
         AI,R6    1                 YES                                         
         LD,R8    0,R6              GET NEXT CDW                                
         LB,R8    R9                SAVE FLAGS                                  
         AND,R9   M16               MASK BYTE COUNT                             
         AW,R11   R9                AND ADD TO RBC                              
         B        CUP10             LOOP AGAIN                                  
         FIN      #MAP                                                          
         PAGE                                                                   
CUP15    RES      0                 REMAINING BYTE COUNT CORRECT                
         AND,R4   XE7               ..                                          
         STB,R4   DCT3,R1           ..                                          
         LB,R5    IOQ3,R3           GET REQUEST SWITCH BYTE                     
         LI,R4    3                 EXTRACT ASSIGNMENT CODE FROM IOQ3           
         AND,R4   R5                ..                                          
         LB,R8    DCT5,R1           SET UP SWITCHES(2) IN R8                    
         AND,R8   M4                SAVE DATA-XFER, CONTROL-TASK, MODE          
         LB,R9    CIT3,R2           GET CHANNEL STATUS FLAGS                    
         CW,R9    CHFLAGS,R4        IS SUBCHANNEL CURRENTLY BEING HELD.         
         BAZ      IOSCCHK           NO, CONTINUE CLEANUP CHECKS                 
         ANLZ,R6  CHSAVE,R4         YES, GET CIT HOLD TABLE ADDRESS             
         LB,R7    0,R6              GET INDEX OF HOLDING REQUEST                
         CI,R12   FLGRETRY+FLGFOLOW IF NO RETRY OR FOLLOW ON                    
         BAZ      CUP18             CLEAR HOLD                                  
         CI,R12   FLGRETRY          IS IT A RETRY                               
         BAZ      CUP17             NO                                          
*                                   YES                                         
         MTB,0    IOQ11,R3          IS RETRY COUNT ZERO                         
         BEZ      CUP18             YES, CLEAR HOLD                             
CUP17    RES      0                 NO, CHECK HOLD FLAG                         
         CI,R12   FLGHOLD           IS SUBCHANNEL TO REMAIN HELD.               
         BAZ      IOSCCHK           NO                                          
CUP18    RES      0                 YES                                         
* LIST 0                                                                        
         EOR,R7   R3                IS IT HELD FOR THIS REQUEST                 
         BNEZ     IOSCCHK           NO                                          
*                                   YES, CLEAR HOLD                             
         OR,R9    CHFLAGS,R4        NO, RESET SUBCHANNEL HOLD FLAG(S).          
         EOR,R9   CHFLAGS,R4                                                    
         STB,R9   CIT3,R2           ..                                          
         STB,R7   0,R6              CLEAR SUBCHANNEL HOLD REQUEST INDEX         
         PAGE                                                                   
IOSCCHK  CI,R12   FLGRETRY+FLGFOLOW+FLGKEYC+FLGKEYNC                            
         BAZ      REQTERM           NO, REQUEST COMPLETE, END-ACTION            
         CI,R12   FLGKEYC+FLGKEYNC                                              
         BANZ     IOKEYIN           YES, GO TO KEY-IN PROCESSOR.                
         AND,R5   M7                NO, RESET REQUEST 'BUSY' FLAG               
         STB,R5   IOQ3,R3           SO THAT REQUEST MAY BE STARTED              
         LH,R10   DCT17,R1          GET RETRY/FOLLOW-ON CODES                   
         CI,R12   FLGRETRY          IS RE-TRY FLAG SET BY HANDLER.              
         BAZ      IOFOLLOW          NO, FOLLOW-ON, PRESUMABLY NO ERROR          
         DO       #ERRORLOG                                                     
         MTB,0    IOQ11,R3          IS THIS THE LAST RETRY                      
         BEZ      CUP20             YES, DONT FORCE LOG HERE                    
*                                   NO                                          
         BAL,R0   IOERROR           DO ERROR LOGGING                            
CUP20    RES      0                                                             
         FIN      #ERRORLOG                                                     
         LI,R13   MSG2              FORCE ERROR MESSAGE                         
         MTB,-1   IOQ11,R3          YES, RE-TRY, DECREMENT RE-TRY COUNT         
         BNC      REQERR            NO MORE ATTEMPTS - ERROR COMPLETIOM         
         SLS,R10  -8                RE-TRY OK, GET HANDLER FUNCTION CODE        
IOFOLLOW STB,R10  IOQ5,R3           SAVE CODE AS NEXT FUNCTION STEP             
         CI,R12   FLGINTER          IS INTER-OPERATION REQUESTED.               
         BAZ      %+2               NO, SEQUENCE IS 'INTERRUPTABLE'             
         OR,R8    X20               YES, SET DEVICE INTER-OPERATION MODE        
         LI,R13   0                 NO MSG FOR RE-TRY/FOLLOW-ON                 
IOSCEXIT STB,R8   DCT5,R1           SAVE UPDATED DCT SWITCHES(2)                
IOCUEXIT ENABLE                     NOW PERMIT INTERRUPTS TO FIRE               
         MTB,0    IOQ10,R3          TEST RETRY COUNT                            
         BEZ      IOSCHED           IF = 0, SKIP MESSAGE                        
         CI,R13   0                 IS MESSAGE TO BE OUTPUT.                    
         BEZ      IOSCHED           NO, SKIP MESSAGE OUTPUT                     
         BAL,R5   MSGOUT            YES, CALL TO OUTPUT MSG IN R13              
         B        IOSCHED           ENTER SCHEDULER                             
         PAGE                                                                   
**********************************************************                      
* I/O KEY-IN VALIDITY TESTS                                                     
**********************************************************                      
IOKEYIN  RES      0                                                             
         LB,R10   DCT4,R1           GET DEVICE TYPE                             
         CI,R10   1                 IS IT A TTY                                 
         BNE      IOKEYIN2          NO                                          
*                                   YES                                         
         LI,R12   4                 SET SPECIAL TYC CODE                        
         B        RC15              AND COMPLETE REQUEST                        
**                                                                              
IOKEYIN2 RES      0                                                             
         LB,R10   IOQ14,R3          GET PRIORITY OF REQUEST                     
         CI,R10   KFF               IS IT BACKGROUND                            
         BNE      CANTKEY           NO, NO KEY-IN ALLOWED                       
*                                   YES                                         
         MTB,0    IOQ10,R3          WERE THERE ANY RETRIES REQUESTED            
         BEZ      CANTKEY           NO, DONT ASK OPERATOR FOR HELP              
*                                   YES                                         
         LB,R10   K:JCP1            GET JCP FLAGS                               
         CI,R10   BIT7**-24         ARE WE IN A NO PAUSE MODE                   
         BANZ     CANTKEY           YES, NO KEY-IN ALLOWED                      
*                                   NO                                          
         CB,R1    MDDCTI            IS IT THE SYSTEM RAD                        
         BNE      KEYINOK           NO, ALLOW KEY-IN                            
*                                   YES, CANT KEY-IN FOR SYSTEM RAD             
CANTKEY  LI,R12   4                 TYC = 4                                     
         B        RC15              AND SET REQUEST COMPLETE                    
         PAGE                                                                   
**************************************************                              
* KEY-IN SETUP                                                                  
**************************************************                              
KEYINOK  RES      0                                                             
         OR,R8    X8                SET KEY-IN FLAG IN DCT5                     
         LD,R10   DCT13,R1          GET TDV STATUS INFORMATION                  
         STH,R12  R11               SAVE FLAGS, TYC WITH TDV INFO               
         STD,R10  DCT13,R1          ..                                          
         LI,R10   20/5              SET UP A 20 SECOND TIMER                    
         STB,R10  DCT18,R1          SET UP TIMEOUT INCREMENT                    
         LW,R10   IOCLOCK                                                       
         AI,R10   -1                FORCE FIRST TIMEOUT                         
         STW,R10  DCT11,R1          ..                                          
         DO1      #SWAP                                                         
         BAL,R5   IOBLOCK           SET FLAG TO ALLOW ROLL OUT                  
         B        IOSCEXIT          GO RESTORE DCT SWITCHES & EXIT              
         PAGE                                                                   
****************************************************                            
* IOEX POST HANDLER                                                             
****************************************************                            
         DO       #IOEX                                                         
IOEXCU   RES      0                 IOEX POST HANDLER                           
         LI,R12   TYCOK             TYPE CODE OK                                
         LD,R10   DCT13,R1          GET TDV STATUS FOR RBC                      
         B        IOSCU             AND CLEANUP                                 
         FIN      #IOEX                                                         
*                                                                               
*                                                                               
****************************************************                            
* BAD SIO CLEAN-UP                                                              
****************************************************                            
BADSIOCU RES      0                 SIO FAILURE CLEAN UP                        
         LB,R4    DCT19,R1          GET SIO CC                                  
         DO       #SIGMA9                                                       
         SLS,R4   -5                GET THREE BITS OF SIO CC                    
         ELSE                                                                   
         SLS,R4   -6                GET TWO BITS OF SIO CC                      
         FIN                                                                    
         BAL,R0   RE:ENT            CHECK RE-ENTRANCE                           
         EXU      BADSIOM,R4        PICK UP PROPER MESSAGE                      
* MESG PTR IN R13 NOW                                                           
         LI,R12   FLGKEYNC          FLAG FOR KEY-IN, NO C                       
         LI,R11   0                 RBC                                         
         B        IOSCU             FINISH CLEANUP                              
         PAGE                                                                   
****************************************************                            
* I/O ABORT CLEAN-UP                                                            
*****************************************************                           
ABORTCU  RES      0                 ABORT /I/O CLEAN UP                         
         LI,R13   0                 NO MESSAGE                                  
         LI,R12   IOABORT           TYC ABORT                                   
         LI,R11   0                 RBC                                         
         B        IOSCU             FINISH CLEANUP                              
*                                                                               
*                                                                               
*****************************************************                           
* TIME-OUT CLEAN-UP                                                             
*****************************************************                           
TIMOUTCU RES      0                 TIME OUT CLEAN UP                           
         LI,R13   MSG3              TIME OUT MESSAGE                            
         LI,R12   FLGKEYNC          FLAG FOR KEY-IN, NO C                       
         LI,R11   0                 RBC                                         
         B        IOSCU             FINISH CLEANUP                              
         PAGE                                                                   
**************************************************************************      
* SIO REJECT MESSAGE SELECTION                                                  
**************************************************************************      
BADSIOM  RES      0                 TABLE FOR SIO REJECT MESSAGES               
         LI,R13   MSG1              DEVICE MANUAL (FOREGROUND)                  
         DO1      #SIGMA9                                                       
         BAL,R14  IOINC                                                         
         LI,R13   MSG4B             SIO REJECT                                  
         DO1      #SIGMA9                                                       
         BAL,R14  IOINC                                                         
         LI,R13   MSG4D             IOP BUSY                                    
         DO1      #SIGMA9                                                       
         BAL,R14  IOINC                                                         
         LI,R13   MSG4              DEVICE NOT RECOGNIZED                       
         DO1      #SIGMA9                                                       
         BAL,R14  IOINC                                                         
************************************************************                    
         TITLE    'REQUEST COMPLETE'                                            
**************************************************************************      
* REQUEST COMPLETE, POST COMPLETION AND DO ANY END-ACTION                       
**************************************************************************      
*                                                                        2537000
*    R1,R3,R4 SET AS FOR CLEANUP                                         2538000
*                                                                        2539000
*    R1 HAS THE DCT INDEX                                                       
*    R3 HAS THE IOQ PTR                                                         
*    R4 HAS THE CIT PTR                                                         
*    R11 HAS RBC                                                         2541000
*    R12 HAS TYC                                                         2542000
*                                                                        2543000
*        BAL,R5   REQCOM                                                 2544000
*                                                                        2545000
*    R13 TO R4 WILL BE SAVED        *                                    2546000
*                                                                        2547000
REQERR   LI,R12   TYCERR            ERROR-FORCE ENTRY FROM 'IOSCU'              
         B        RC15              ..                                          
REQTERM  CI,R12   FLGMSG            IS THERE AN UNCONDITIONAL MSG               
         BANZ     RC10              YES                                         
         LI,R13   0                 NO, CLEAR MSG PTR                           
RC10     RES      0                                                             
         DO       (#RADQING+#DISQING)>0                                         
         CI,R12   FLGINTER                                                      
         BAZ      RC15              SKIP IF INTER OP NOT SET                    
         OR,R8    X20               SET DCT5 FLAG                               
         FIN      QUEUING                                                       
RC15     STB,R8   DCT5,R1           SAVE DCT SWITHCHES                          
         LI,R5    IOCUEXIT          SET RETURN ADDRESS IN R5                    
         PAGE                                                                   
*************************************************************************       
* REQUEST COMPLETE, DE-LINK IOQ ENTRY AND RETURN IT TO POOL                     
*************************************************************************       
REQCOM   RES      0                                                             
         AND,R12  M8                MASK OUT TYC CODE                           
         LB,R1    IOQ7,R3           GET DCT INDEX                               
         LB,R4    DCT2,R1           GET CIT INDEX                               
         LW,R2    R4                AND COPY TO R2                              
RC22     LB,R6    IOQ2,R3           FLINK                                2557000
         LB,R7    IOQ1,R3           BLINK                                2558000
         BEZ      RC24              FIRST ENTRY                          2559000
         STB,R6   IOQ2,R7           CUR FLINK TO PREV FLINK              2560000
         B        %+2                                                    2561000
RC24     STB,R6   CIT1,R4           CUR FLINK TO HEAD                    2562000
         AI,R6    0                 TEST FLINK                           2563000
         BEZ      RC26              LAST ENTRY                           2564000
         STB,R7   IOQ1,R6           CUR BLINK TO NEXT BLINK              2565000
         B        %+2                                                    2566000
RC26     STB,R7   CIT2,R4           CUR BLINK TO TAIL                    2567000
*                                                                        2568000
         LB,R7    IOQ2              FREE ENTRY POOL HEAD POINTER TO R7   2569000
         STB,R7   IOQ2,R3           TO FLINK                             2570000
         STB,R3   IOQ2              SET NEW FREE ENTRY POOL HEAD POINTER 2571000
         LB,R6    IOQ14,R3          REQUEST PRIORITY                            
         CI,R6    KFF               TEST FOR BGRND                              
         BNE      %+2               NO, BRANCH                           2574000
         MTB,-1   IOQ3              YES DECREMENT NO OF BGRND ENTRIES    2575000
         DO       #PS                                                           
         LB,R6    DCTSHARE                                                      
         BEZ      RC4                                                           
         LB,R6    DCTSHARE,R1       DEVICE ON PS?                               
         BEZ      RC4               NO                                          
         CI,R6    8                 DEVICE UNAVAILABLE                          
         BANZ     RC4               YES, IMPOSSILBE BUT SKIP                    
         CI,R6    4                 DEVICE MANUAL AVAILABLE                     
         BANZ     RC4               YES                                         
*        DISABLE                   ALREAY DISABLED WHEN CALLED...               
         LH,R7    DCT1                                                          
         LW,R9    R1                                                            
         AND,R9   XFF               R9 = DCTX ALONE                             
RC1      CW,R7    R9               IS THIS OUR DEVICE                           
         BE       RC2               YES, DONT TEST                              
         CB,R6    DCTSHARE,R7       DID THIS DEV ALSO ACQUIRE SWITCH            
         BE       RC3               YES                                         
RC2      BDR,R7   RC1                                                           
*                 SWITCH NOT IN USE BY OTHER DEVICES-RELEASE                    
         AND,R6   XF0                                                           
         AW,R6    PSDIOADR                                                      
         OR,R6    X2                SET T BIT                                   
         WD,R6    *R6               RELEASE SWITCH                              
RC3      LB,R6    DCTSHARE,R1       RESET RESERVED BIT                          
         AND,R6   XFC                                                           
         STB,R6   DCTSHARE,R1                                                   
*   INTERRRUPTS ARE DISABLED WHEN WHEN ENTER THIS....WHY                        
*        ENABLE                    NO!!!!!!!!                                   
RC4      RES      0                                                             
         FIN      #PS                                                           
         PAGE                                                                   
*************************************************************************       
* REQUEST COMPLETE, CLEAR ANY CHANNEL HOLDS NOW THAT IOQ ENTRY IS GONE          
*************************************************************************       
         LB,R7    IOQ3,R3                                                       
         AND,R7   M3                GET REQUEST CODE                            
*                                                                               
         LB,R9    CIT3,R4           GET CHANNEL STATUS                          
         CW,R9    CHFLAGS,R7        IS SUB-CHANNEL HELD                         
         BAZ      RC26A             NO                                          
*                                   YES                                         
         ANLZ,R6  CHSAVE,R7         GET HOLD TABLE ADDR                         
         LB,R10   0,R6              GET HOLDING INDEX                           
         CB,R10   R3                IS IT THIS REQUEST                          
         BNE      RC26A             NO                                          
*                                   YES                                         
         OR,R9    CHFLAGS,R7        RESET HOLD FLAGS                            
         EOR,R9   CHFLAGS,R7                                                    
         STB,R9   CIT3,R4                                                       
*                                                                               
         LI,R9    0                                                             
         STB,R9   0,R6              CLEAR HOLD INDEX                            
RC26A    RES      0                                                             
         LI,R6    0                                                             
         STB,R6   IOQ3,R3           ZERO FLAGS                                  
         PAGE                                                                   
**************************************************************************      
* REQUEST COMPLETE, SET UP REGISTERS FOR END-ACTION AND LOG ANY ERRORS          
**************************************************************************      
RC27     PUSH     9,R13                                                         
         LW,R13   R11               R13= RBC                                    
         LD,R10   IOQ13,R3          END ACTION TO R10,R11                       
         LW,R15   IOQ8,R3           BUFFER ADDRESS TO R15                       
         LW,R2    IOQECB,R3         GET ECB ID IN R2                            
         LB,R7    IOQ7,R3           DCT INDEX IN R7                             
         LI,R6    0                                                             
         STW,R6   IOQECB,R3         ZERO ECB I.D.                               
         STB,R6   IOQ7,R3           ZERO DCT INDEX                              
         LD,R8    DCT13,R1          GET TDV STATUS DW                           
         LH,R6    DCT21,R1          GET TIO STATUS HW                           
         LW,R5    DCT12,R1          GET AIO STATUS WORD                         
         DO       #ERRORLOG                                                     
         LI,R0    DCT#IO            IS ERROR LOGGING SYSGENED                   
         BEZ      RC27A             NO, SKIP THIS                               
         PUSH     4,R6              SAVE R6-R9                                  
         BAL,R0   IOLOG             YES, LOG IF NECESSARY                       
         PULL     4,R6              RESTORE R6-R9                               
         PAGE                                                                   
*************************************************************************       
* REQUEST COMPLETE, PERFORM ANY END-ACTION NEEDED                               
*************************************************************************       
RC27A    RES      0                                                             
         FIN      #ERRORLOG                                                     
         MTW,0    K:IOGL            WAS I/O DEFERED                             
         BNEZ     %+2               YES                                         
         ENABLE                     NO, MAY ENABLE HERE                         
*                                                                        2578000
         CW,R10   Y004              IS THERE END ACTION                         
         BAZ      RC50              NO, SKIP AROUND                             
*                                                                               
         DO       #ECB                                                          
         CW,R15   XBIT1             IS THIS AN IOEX REQUEST                     
         BAZ      RC50              NO, DEFER END-ACTION TO EMPOSTYC            
         FIN      #ECB              YES, DO END ACTION NOW FOR IOEX             
         PUSH     R2                SAVE ECB ID                                 
         BAL,R4   ENDAC             DO END ACTION                               
         PULL     R2                RESTORE ECB ID                              
         PAGE                                                                   
*************************************************************************       
* REQUEST COMPLETE, CHECK FOR C DEVICE READ                                     
*************************************************************************       
RC50     RES      0                                                             
         CW,R10   Y008              TEST FOR C READ                             
         BAZ      RC31A             NO, CONTINUE                                
RC32     CI,R12   1                 YES, TEST TYC                               
         BNE      RC31A             B IF NOT NORMAL                             
         PUSH     5,R5              SAVE END-ACTION INFORMATION                 
         LW,R6    R15               BUFFER ADDRESS                              
         LB,R4    0,R6              FIRST BYTE                                  
         CI,R4    '!'               TEST FOR BANG                               
         BNE      RC29              NO, BRANCH                                  
         LI,R4    BA(CCBUF)                                                     
         LI,R14   80                                                            
         BAL,R9   MOVEBYTS                                                      
         LI,R12   TYCEOD            SET TYC IN CASE OF EOD RECORD               
         LW,R4    CCBUF             GET 1ST FOUR BYTES OF RECORD                
         CW,R4    EODREC            IS IT AN EOD RECORD                         
         BE       RC29              YES, BRANCH                                 
         LI,R4    1                                                             
         LI,R12   7                 EOF TYC                                     
         PULL     5,R5              R5-R9= BAL END-ACTION INFO.                 
         B        RC31                                                          
         PAGE                                                                   
**************************************************************************      
* REQUEST COMPLETE, SET UP FOR END ACTION POSTING                               
**************************************************************************      
RC29     RES      0                                                             
         PULL     5,R5              RESTORE END-ACTION INFO.                    
         LI,R4    0                 SET CFLAG= 0.                               
RC31     STW,R4   CFLAG                                                         
RC31A    RES      0                                                             
         DO       1-#ECB                                                        
         LB,R1    R2                GET LMID                                    
         BEZ      RC28A             NONE                                        
         LH,R1    LMISTAT,R1        GET STATU                                   
         CI,R1    LMIT+LMIA         IS IT TERMING OR ABORTING                   
         BANZ     RC30              YES,NO POSTING                              
RC28A    RES      0                                                             
         FIN      1-#ECB                                                        
RC28     LB,R1    R10               CLEANUP ROUTINE INDEX                       
         LI,R14   RC30              SIMULATE BAL,14                      2585000
         B        CUPTAB-1,R1                                                   
RC30     PULL     9,R13             RESTORE REGS                         2587000
         B        0,R5              RETURN FROM REQCOM                          
**************************************************************************      
* REQUEST COMPLETE POSTING JUMP TABLE                                           
**************************************************************************      
CUPTAB   B        CUPCORE                                                2589000
         B        CUPDCB                                                 2590000
         B        *R10                                                   2591000
         B        *R14                                                   2592000
         B        CUPCOREX                                                      
         B        CUPDCBX                                                       
         TITLE    'END-ACTION SUBROUTINE'                                       
***************************************************************************     
* END ACTION POSTING ROUTINE                                                    
***************************************************************************     
*                                                                               
*        R0,R1,R3,R14    - USABLE                                               
*        R2 - ECB ID                                                            
*        R4 - LINK                                                              
*        R5 - AIO STATUS                                                        
*        R6 - TIO STATUS HW                                                     
*        R7 - DCT INDEX                                                         
*        R8/R9 - TDV DW OF STATUS                                               
*        R10/R11 - END-ACTION DW FROM IOQ13                                     
*        R10,R12,R13,R15 - ARE NOT USED BUT MUST BE SAVED ANYWAY                
*        R12 - TYC                                                              
*        R13 - MSG PTR                                                          
*        R15 - BUFFER ADDR                                                      
*                                                                               
ENDAC    RES      0                                                             
         LB,R2    R11               GET CODE                                    
         CI,R2    KFF               IS IT A BAL TYPE                            
         BE       ENDAC20           YES                                         
*                                   NO                                          
         CI,R2    X'7F'             IS IT A SIGNAL TYPE                         
         BE       ENDAC10           YES                                         
*                                   NO                                          
         PAGE                                                                   
***************************************************************************     
* TRIGGER TYPE END ACTION POSTING                                               
***************************************************************************     
         OR,R2    X1700             ASSUME IT IS A TRIGGER TYPE                 
         LH,R3    R11               GET ADDRESS CODE                            
         AND,R3   M8                AND MASK                                    
         AI,R3    X'4F'             AND FORM INTERRUPT ADDRESS                  
         LW,R3    0,R3              GET XPSD FROM INTERRUPT LOC                 
************************************                                            
         WD,R11   0,R2              TRIGGER INTERRUPT                           
************************************                                            
         LW,R2    5,R3              CHECK XPSD REF+5 FOR                        
         CW,R2    BALRBMSV          A BAL,R1 RBMSAVE                            
         BNE      ENDAC60           BRANCH WHEN   DIRECTLY CONNECTED            
*                                                                               
         LW,R1    XTCBTRIG          OTHERWISE SET FLAG                          
         STS,R1   6,R3              IN THE TCB                                  
         B        ENDAC60                                                       
         PAGE                                                                   
***************************************************************************     
* SIGNAL TYPE END ACTION POSTING                                                
***************************************************************************     
ENDAC10  RES      0                 POST END-ACTION                             
         DO       #MAP                                                          
         LI,R3    0                                                             
         LI,R2    %+2                                                           
ENDAC47  XPSD     R0                ENTER UN-MAPPED MODE                        
*                                                                               
         STW,R5   *R11              POST AIO STATUS                             
*                                                                               
         AI,R1    ENDAC60-(ENDAC47+1)                                           
         AI,R0    ENDAC60-(ENDAC47+1)                                           
         LPSD,0   R0                RESTORE MAP AND EXIT TO ENDAC60             
************************************                                            
         ELSE     #MAP                                                          
         STW,R5   *R11              POST AIO STATUS                             
         B        ENDAC60                                                       
         FIN      #MAP                                                          
************************************                                            
         PAGE                                                                   
**************************************************************************      
* BAL TYPE END ACTION POSTING                                                   
**************************************************************************      
ENDAC20  RES      0                 BAL TYPE END-ACTION                         
         DO       #MAP                                                          
         PUSH     0,R0              SAVE ALL REGISTERS                          
*                                                                               
         LI,R2    ENDAC30                                                       
         LI,R3    0                                                             
         XPSD     R0                ENTER UN-MAPPED MODE AT ENDAC30             
*                                                                               
ENDAC30  RES      0                                                             
         CW,R0    XBIT9             IS OLD PSD MAPPED                           
         BAZ      ENDAC40           NO                                          
*                                   YES                                         
         BAL,R11  *R11              DO BAL TYPE END ACTION                      
*                                                                               
         LI,R2    ENDAC50                                                       
         AW,R2    XBIT9             MAP BIT                                     
         LI,R3    0                                                             
         LPSD,0   R2                RESTORE MAP BIT AND GO TO ENDAC50           
************************************                                            
ENDAC40  BAL,R11  *R11              UN-MAPPED CASE                              
         ELSE     #MAP                                                          
         PUSH     0,R0              SAVE ALL REG                                
         BAL,R11  *R11              BAL TO USER CODE                            
         FIN      #MAP                                                          
ENDAC50  PULL     0,R0              RESTORE ALL REG                             
ENDAC60  B        *R4               RETURN                                      
         TITLE    'IOLOG - I/O ERROR LOGGING'                                   
*************************************************************************       
* I/O ERROR LOG FORMAT                                                          
*************************************************************************       
*      WORD       CONTENT                                                       
*        0        TYPE = X'15'***COUNT = X'D'***MODEL # IN HEX (HW)             
*        1        RELATIVE TIME                                                 
*        2        AIO STATUS                                                    
*        3        MFI***AIO CC***TDV CC***TIO CC                                
*        4/5      TDV STATUS DW                                                 
*        6/7      CURRENT COMMAND DW                                            
*        8        TIO STATUS HW***RETRIES REQUESTED***RETRIES REMAINING         
*        9        SIO COUNT                                                     
*       10        VOLUME ID                                                     
*       11        MORE VOLUME ID***ORIGINAL F CODE***CURRENT F CODE             
*       12        SEEK ADDRESS (IOQ12)                                          
*                                                                               
*                                                                               
* FOR SIO FAILURE: TYPE = X'11';WORD 2 = SIO STATUS;COUNT = 6                   
*                                                                               
* FOR TIMEOUT: TYPE = X'12';WORD 2 = HIO STATUS                                 
*                                                                               
* TRANSIENT STATUS IS COLLECTED BY IOERROR SUBROUTINE.                          
* FIXED STATUS IS COLLECTED BY IOLOG SUBROUTINE                                 
         PAGE                                                                   
************************************************************************        
* I/O ERROR LOG ROUTINE (FIXED LOG STATUS COLLECTED HERE)                       
************************************************************************        
         DO       #ERRORLOG                                                     
*                                                                               
* IOLOG - IF THE TYC IS AN ERROR COMPLETION, OR IF IOQERR IS NON-ZERO,          
*         AN ERROR BUFFER IS COMPLETED AND PLACED IN THE ERROR                  
*         LOG STACK.                                                            
*                                                                               
* REGISTER         ENTRY             EXIT                                       
*                                                                               
* R0               LINK              SAVED                                      
* R1               DCT INDEX         SAVED                                      
* R2,R5,R13-R15       -              SAVED                                      
* R3               IOQ INDEX         SAVED                                      
* R4               CIT INDEX         SAVED                                      
* R6-R9               -              CLOBBERED                                  
* R10              CCA               SAVED                                      
* R11              RBC               SAVED                                      
* R12              TYC               SAVED                                      
*                                                                               
**********************************************************************          
* I/O LOG FOR I/O ERROR, I/O TIMEOUT AND I/O SIO FAILURE                        
**********************************************************************          
*                                                                               
*        DO NOT CALL THESE ROUTINES IF ERROR LOGGING                            
*        IS NOT BOTH ASSEMBLED AND SYSGENNED IN.                                
*        I.E , TEST LDCT#ERR BEFORE BAL                                         
*                                                                               
IOLOGSIO RES      0                                                             
         LI,R6    X'11'             SIO FAILURE CODE                            
         STB,R6   R0                                                            
         B        IOLOG05                                                       
*********                                                                       
IOLOGTO  RES      0                 ENTRY FOR TIME OUT  LOG                     
         LI,R6    X'12'             IO TIMEOUT CODE                             
         STB,R6   R0                                                            
         B        IOLOG05                                                       
*********                                                                       
IOLOG    RES      0                 ENTRY FOR DEVICE ERROR LOG                  
*        IT IS SAFE TO CALL THIS SUBROUTINE ALTHOUGH                            
*        UNDERTAIN IF LOGGING HAS BEEN PREVIOULSY                               
*        INITIATED ON AN OPERATION OR NOT                                       
         LI,R6    X'15'                                                         
         STB,R6   R0                IO ERROR CODE                               
         CI,R12   X'F8'             IS IT AN ERROR TYC (>7)                     
         BAZ      IOLOG10           NO                                          
*                                   YES                                         
         CI,R12   IOABORT           IS IT AN ABORT TYC                          
         BE       IOLOG10           YES, DONT CREATE A LOG                      
*                                                                               
         MTW,0    IOQERROR,R3       IS AN ERROR LOG STARTED                     
         BNEZ     IOLOG10           YES                                         
*                                   NO                                          
         MTW,0    LOGFLAG           RETURN WHEN NOT LOGGING                     
         BEZ      *R0               TO AVOID DOUBLE COUNTING                    
*                                                                               
IOLOG05  RES      0                                                             
         PUSH     R0                SAVE R0                                     
         BAL,R0   IOERROR           START ERROR LOG                             
         PULL     R0                                                            
         PAGE                                                                   
************************************************************************        
* I/O LOG - IF THERE IS A LOG BUFFER, FINISH IT AND STACK IT                    
************************************************************************        
IOLOG10  LI,R7    0                                                             
         XW,R7    IOQERROR,R3       CLEAR IOQERR AND GET BUFFER PTR             
         BEZ      *R0               NO LOG IF NONE                              
*                                                                               
         LI,R6    LOGTYPE                                                       
         LB,R8    R0                                                            
         STB,R8   *R7,R6                                                        
*                                                                               
         LI,R6    LOGCOUNT                                                      
         CI,R8    X'11'             SELECT PROPER LENGTH CODE                   
         BE       %+3                                                           
         LI,R8    X'D'                                                          
         B        %+2                                                           
         LI,R8    6                                                             
         STB,R8   *R7,R6                                                        
*                                                                               
         LI,R6    LOGMODEL                                                      
         LH,R8    DCTMODX,R1        MODEL NUMBER IN DECIMAL                     
         STH,R8   *R7,R6                                                        
*                                                                               
         LI,R6    LOGRTYI                                                       
         LB,R8    IOQ10,R3          INITIAL RETRY REQUESTS                      
         STB,R8   *R7,R6                                                        
*                                                                               
         LI,R6    LOGRTYR                                                       
         LB,R8    IOQ11,R3          RETRIES REMAINING COUNT                     
         CI,R8    X'FF'                                                         
         BNE      %+2                                                           
         LI,R8    0                                                             
         STB,R8   *R7,R6                                                        
         PAGE                                                                   
**************************************************************************      
* MORE I/O LOG                                                                  
**************************************************************************      
         LI,R6    LOGIOQ4                                                       
         LB,R8    IOQ4,R3                                                       
         STB,R8   *R7,R6            INITIAL FUNCTION CODE                       
*                                                                               
         LW,R8    DCT#IO,R1         I/O COUNT                                   
         STW,R8   LOGIOCNT,R7                                                   
*                                                                               
         PUSH     6,R0              SAVE R0-R5                                  
         DO       #XRBM                                                         
         LCI      4                                                             
         LM,R2    LOGSENSE,R7       GET SENSE DATA IF ANY                       
         FIN      #XRBM                                                         
*                                                                               
         LI,R8    0                                                             
         XW,R8    10,R7             GET SEEK ADDRESS                            
         STW,R8   LOGSKADR,R7       AND PUT IT IN RIGHT PLACE                   
         PAGE                                                                   
*********************************************************************           
* ADD VOLUME ID CODE HERE WHEN AVAILABLE                                        
*********************************************************************           
*                                                                               
         BAL,R0   PUSHLOG           STACK UP I/O LOG ENTRY                      
*                                                                               
         DO       #XRBM                                                         
         LI,R7    4                                                             
         MTW,0    R1,R7             IS THERE ANY SENSE DATA                     
         BNEZ     SENSELOG          YES                                         
         BDR,R7   %-2               LOOP                                        
*                                   NO                                          
         FIN      #XRBM                                                         
         PULL     6,R0              RESTORE R0-R5                               
         B        *R0               AND EXIT                                    
         PAGE                                                                   
         DO       #XRBM                                                         
SENSELOG RES      0                                                             
         PUSH     7,R9              SAVE REGISTERS                              
         LI,R7    LOGSIZE                                                       
         BAL,R8   GETTEMPI          GET TEMP SPACE                              
         B        IOLOG90           CANT GET                                    
*                                                                               
         LCI      4                                                             
         STM,R2   2,R7              PUT SENSE DATA INTO LOG ENTRY               
*                                                                               
         LI,R6    LOGTYPE                                                       
         LI,R8    X'16'                                                         
         STB,R8   *R7,R6            LOG TYPE                                    
*                                                                               
         LI,R6    LOGCOUNT                                                      
         LI,R8    6                                                             
         STB,R8   *R7,R6            LOG COUNT                                   
*                                                                               
         LI,R6    1                                                             
         LH,R8    DCT1,R1           DEVICE ADDR                                 
         STH,R8   *R7,R6                                                        
*                                                                               
         BAL,R0   PUSHLOG                                                       
*                                                                               
         B        %+2                                                           
IOLOG90  MTW,1    LOSTLOGS                                                      
         PULL     7,R9                                                          
         PULL     6,R0              RESTORE R0 THRU R5                          
         B        *R0                                                           
         FIN      #XRBM                                                         
         TITLE    'IOERROR - I/O ERROR LOGGING'                                 
**************************************************************************      
* IOERROR -  IF NECESSARY GETS SPACE AND STARTS FILLING AN ERROR                
*            LOG BUFFER.  ALL EVANESCENT DATA TO BE LOGGED HERE                 
**************************************************************************      
* REGISTER        ENTRY             EXIT                                        
*                                                                               
* R0              LINK              SAVED                                       
* R1              DCT INDEX         SAVED                                       
* R2,R5           -                 SAVED                                       
* R3              IOQ INDEX         SAVED                                       
* R4              CIT INDEX         SAVED                                       
* R6-R15          -                 SAVED                                       
*                                                                               
LDCT#ERR DATA     DCT#ERR           DCT#ERR LITERAL                             
*                                   (=0 IF ERRLOG NOT SYSGENED)                 
IOERROR  RES      0                                                             
         MTW,0    LDCT#ERR                                                      
         BEZ      *R0               RETURN: ERRLOG NOT SYSGENNED                
         MTW,1    DCT#ERR,R1        COUNT I/O ERRORS                            
         MTW,0    LOGFLAG           IS ERROR LOGGING ON                         
         BEZ      *R0               NO                                          
*                                                                               
         PUSH     11,R6             SAVE R6-R0                                  
         LW,R7    IOQERROR,R3       IS THERE A LOG BUFFER                       
         BNEZ     IOERROR1          YES                                         
*                                   NO, GET ONE                                 
         LI,R7    LOGSIZE                                                       
         BAL,R8   GETTEMPI          GET SPACE FOR LOG BUFFER                    
         B        IOERROR9          CANT                                        
*                                                                               
         LI,R6    LOGSIZE           CLEAR OUT LOG BUFFER                        
         LI,R8    0                                                             
         AI,R6    -1                                                            
         STW,R8   *R7,R6                                                        
         BNEZ     %-2                                                           
         PAGE                                                                   
IOERROR1 RES      0                                                             
         STW,R7   IOQERROR,R3       SAVE PTR                                    
*                                                                               
         LI,R8    0                                                             
         STW,R8   LOGSENSE,R7                                                   
         STW,R8   LOGSENSE+1,R7                                                 
         STW,R8   LOGSENSE+2,R7                                                 
         STW,R8   LOGSENSE+3,R7     CLEAR OLD SENSE DATA OUT                    
*                                                                               
         LW,R8    DCT12,R1          AIO STATUS                                  
         STW,R8   LOGAIOST,R7                                                   
*                                                                               
         DO       #SIGMA9                                                       
         LI,R8    0                 FOR SIGMA 9 USE 0                           
         ELSE                                                                   
         RD,R8    X'10'             BUT, FOR SIGMA 7 GET MFI                    
         FIN                                                                    
         LI,R6    LOGIOMFI                                                      
         STB,R8   *R7,R6                                                        
*                                                                               
         LI,R6    LOGAIOCC                                                      
         LB,R8    DCT19,R1          AIO COND. CODE                              
         DO       #SIGMA9                                                       
         CI,R8    X'20'             CC3 SET                                     
         BAZ      IOERROR3          NO                                          
         TRIPPFI,R15                YES, CAUSE POLLING                          
         PAGE                                                                   
IOERROR3 RES      0                                                             
         FIN                                                                    
         STB,R8   *R7,R6                                                        
*                                                                               
         LI,R6    LOGTDVCC                                                      
         LB,R8    DCT20,R1          TDV COND. CODE                              
         DO       #SIGMA9                                                       
         CI,R8    X'20'             CC3 SET                                     
         BAZ      IOERROR4          NO                                          
         TRIPPFI,R15                YES, CAUSE POLLING                          
IOERROR4 RES      0                                                             
         FIN                                                                    
         STB,R8   *R7,R6                                                        
*                                                                               
         LI,R6    LOGTIOCC                                                      
         LB,R8    DCT20A,R1         TIO COND. CODE                              
         DO       #SIGMA9                                                       
         CI,R8    X'20'             CC3 SET                                     
         BAZ      IOERROR6          NO                                          
         TRIPPFI,R15                YES, CAUSE POLLING                          
         PAGE                                                                   
IOERROR6 RES      0                                                             
         FIN                                                                    
         STB,R8   *R7,R6                                                        
*                                                                               
         LD,R8    DCT13,R1          TDV STATUS DOUBLE WORD                      
         DO       #SIGMA9                                                       
         CI,R9    BIT13             IOP CONTROL ERROR                           
         BAZ      IOERROR7          NO                                          
         TRIPPFI,R15                YES, CAUSE POLLING                          
IOERROR7 RES      0                                                             
         CW,R8    XBIT2             CONTROL CHECK FAULT                         
         BAZ      IOERROR8          NO                                          
         TRIPPFI,R15                YES, CAUSE POLLING                          
IOERROR8 RES      0                                                             
         FIN                                                                    
         DO       #550                                                          
         LH,R6    R9                GET TDV STATUS HW                           
         CI,R6    (BIT10+BIT11+BIT12)**-16                                      
         BAZ      IOERRORB                                                      
         TRIPMFI,R15                                                            
         PAGE                                                                   
IOERRORB RES      0                                                             
         LB,R6    R8                IOP STATUS BYTE                             
         CI,R6    (BIT1+BIT3)**-16                                              
         BAZ      IOERRORC                                                      
         TRIPMFI,R15                                                            
IOERRORC RES      0                                                             
         FIN      #550                                                          
         LI,R6    LOGTDVST                                                      
         STD,R8   *R7,R6                                                        
*                                                                               
         LW,R6    R8                PLACE PTR TO CCD IN R6 SO CAN INDEX         
         AND,R6   M24               MASK OFF ADDRESS                            
         CI,R6    DA(ROOTEND)       IS IT A CPR ADDRESS                         
         BG       IOERRORE          NO, DONT PICK UP                            
*                                   YES                                         
         LD,R8    0,R6              TDV COMMAND DOUBLEWORD                      
         LI,R6    LOGCCD                                                        
         STD,R8   *R7,R6                                                        
*                                                                               
         PAGE                                                                   
IOERRORE RES      0                                                             
         LH,R8    DCT21,R1          TIO STATUS                                  
         DO       #SIGMA9                                                       
         CI,R8    BIT13**-16        IOP CONTROL ERROR                           
         BAZ      IOERRORA          NO                                          
         TRIPPFI,R15                YES, CAUSE POLLING                          
IOERRORA RES      0                                                             
         FIN                                                                    
         DO       #550                                                          
         CI,R8    (BIT10+BIT11+BIT12)**-16                                      
         BAZ      IOERRORD                                                      
         TRIPMFI,R15                                                            
         PAGE                                                                   
IOERRORD RES      0                                                             
         FIN      #550                                                          
         LI,R6    LOGTIOST                                                      
         STH,R8   *R7,R6                                                        
*                                                                               
IOERROR5 RES      0                                                             
         LI,R6    10                TEMPORARY PLACE FOR SEEK ADDRESS            
         LW,R8    IOQ12,R3            SEEK ADDRESS FOR ROTATING MEMORY          
         STW,R8   *R7,R6              OTHERWISE, GARBAGE                        
*                                                                               
         LI,R6    LOGIOQ5                                                       
         LB,R8    IOQ5,R3                                                       
         STB,R8   *R7,R6            CURRENT FUNCTION CODE                       
*                                                                               
         MTW,-1   LOSTLOGS                                                      
IOERROR9 MTW,1    LOSTLOGS                                                      
         PULL     11,R6             RESTORE REGISTERS                           
         B        *R0               AND RETURN                                  
         TITLE    'PUSHLOG -  ADD A LOG BUFFER TO THE LOG STACK'                
**********************************************************************          
* PUSHLOG - ADDS A LOG BUFFER TO THE STACK AND TRIGGERS THE CONTROL             
*           TASK TO FILE THE LOG                                                
**********************************************************************          
* REGISTERS       ENTRY             EXIT                                        
*                                                                               
* R0              LINK              SAVED                                       
* R1-R6,R10-R15   -                 SAVED                                       
* R7              BUFFER PTR        SAVED                                       
* R8-R9           -                 CLOBBERED                                   
PUSHLOG  RES      0                                                             
         DO       #TSLICE                                                       
         LW,R9    TS1STICK                                                      
         SW,R9    TS1SEC            GET QUANTA ELAPSED                          
         MW,R9    TSTICK            GET TICKS ELAPSED                           
*                                                                               
         AW,R9    TSTICK                                                        
         SW,R9    COUNTER4          PLUS CURRENT TICKS                          
         ELSE     #TSLICE                                                       
         LI,R9    500                                                           
         SW,R9    COUNTER4          TICKS ELAPSED                               
         FIN      #TSLICE                                                       
         MI,R9    2                 TIMES 2 TO GET MS THIS SEC                  
         XW,R9    R8                SAVE R9                                     
*                                                                               
         LW,R9    K:TIME            SEC SINCE MIDNIGHT                          
         MI,R9    1000              NOW MS SINCE MIDNIGHT                       
         AW,R9    R8                ADD IN CURRENT MS                           
         STW,R9   LOGTIME,R7        PLACE IN LOG                                
         PSW,R7   LOGSTACK          PUSH LOG PTR INTO STACK                     
         BCR,10   PUSHLOG5          BRANCH IF PUSH OK                           
         PAGE                                                                   
         PUSH     10,R7             SAVE R7-R0                                  
         MTW,1    LOSTLOGS          COUNT LOST LOGS                             
         BAL,R8   RELTEMPI                                                      
*                                                                               
         PULL     10,R7             RESTORE REGISTERS                           
*                                                                               
PUSHLOG5 RES      0                 TRIGGER CT TO FILE LOGS                     
         PUSH     R11                                                           
         LI,R11   X'40000'          SET RUN EROR LOGGER                         
         STS,R11  K:CTST            AND TRIGGER                                 
         PUSH     4,R1                                                          
         LW,R1    XSTISTRT                                                      
         LI,R4    CTID                                                          
         STS,R1   STIPRIO,R4        SET START BIT                               
         BAL,R8   TMTRIG            TRIGGER DISPATCHER                          
         PULL     4,R1                                                          
         PULL     R11                                                           
         B        *R0                                                           
*                                                                               
         TITLE    'LOG STACK'                                                   
*                                                                               
LOGSTACK STACKDW,1,1 %+2,STACKSIZ                                               
         RES      STACKSIZ                                                      
*                                                                               
GOODLOGS DATA     0                 NUMBER OF LOG RECORDS FILED                 
*                                                                               
LOSTLOGS DATA     0                 NUMBER OF LOG RECORDS LOST                  
*                                                                               
LOGSTART DATA     0                 UTIME OF START OF ERROR                     
*                                   STATISTICS ACCUMULATION                     
         TITLE    'TRAPLOG -  FAULT TRAP ERROR LOGGING'                         
* TRAPLOG - THIS LOGS ALL FAULT TRAPS                                           
*                                                                               
* REGISTERS       ENTRY             EXIT                                        
* R0              LINK              LINK                                        
* R1     TRAP PTR AND CC            SAVED                                       
* R2-R15          -                 SAVED                                       
TRAPLOG  RES      0                                                             
         DO       #TRAPLOG                                                      
         MTW,0    LOGFLAG           ERROR LOGGING ON                            
         BEZ      *R0               NO                                          
*                                                                               
         ENTERCT,R15                ENTER CONTROL TASK CONTEXT                  
         LW,R2    TRAPTBL           GET TRAP INDEX                              
         LW,R6    M24                                                           
         AND,R6   R1                MASK OFF TRAP ADDR                          
TRAPLOG1 CW,R6    TRAPTBL,R2        LOOK FOR TRAP ADDR                          
         BE       TRAPLOG3          FOUND                                       
         BDR,R2   TRAPLOG1          LOOP                                        
         CRASH    'TRAPLOG'         OR CRASH                                    
TRAPLOG3 RES      0                                                             
         LI,R7    LOGSIZE                                                       
         BAL,R8   GETTEMPI          GET A LOG BUFFER                            
         B        CANTLOG           CANT                                        
         PAGE                                                                   
         LI,R6    LOGSIZE-1                                                     
         LI,R8    0                                                             
         STW,R8   *R7,R6            CLEAR BUFFER                                
         BDR,R6   %-1                                                           
*                                                                               
         LI,R6    LOGTRPCC                                                      
         LB,R8    R1                                                            
         STB,R8   *R7,R6            TRAP CC                                     
*                                                                               
         LI,R6    LOGTYPE                                                       
         LB,R8    TRAPTYPE,R2                                                   
         STB,R8   *R7,R6            TRAP TYPE CODE                              
*                                                                               
         LI,R6    LOGCOUNT                                                      
         LI,R8    8                 WORD COUNT                                  
         STB,R8   *R7,R6            WORD COUNT                                  
*                                                                               
         AND,R1   M17               MASK OFF TRAP ADDRESS                       
         PAGE                                                                   
         LI,R6    LOGTRPDW                                                      
         LD,R8    *R1                                                           
         STD,R8   *R7,R6            TRAP PSD                                    
         DO       #SIGMA9                                                       
         CW,R8    XBIT9             IS IT MAPPED MODE                           
         AND,R8   M17               MASK OFF ADDRESS PART                       
         BAZ      TRAPLOG4          NO, USE AS IS                               
*                                   YES, NEED TO GET REAL ADDRESS               
         CI,R1    TRAP4C            IS IT A PARITY TRAP                         
         BE       TRAPLOG5          YES, DONT DARE LRA                          
*                                   NO                                          
         LCI      8                                                             
         LRA,R8   R8                GET REAL ADDR                               
         AND,R8   M24                                                           
TRAPLOG4 LI,R6    LOGTRPAD                                                      
         STW,R8   *R7,R6            REAL ADDR TO LOG                            
*                                                                               
         WD,R0    X'47'             GET IN REAL EXTENDED                        
         LCI      1                                                             
         LMS,R8   *R8               GET CONTENT OF REAL ADDR                    
         WD,R0    X'46'             LEAVE REAL EXTENDED                         
         LI,R6    LOGTRPIN                                                      
         STW,R8   *R7,R6            TRAPPED INSTRUCTION TO LOG                  
         FIN      #SIGMA9                                                       
TRAPLOG5 RES      0                                                             
         BAL,R0   PUSHLOG                                                       
         B        %+2                                                           
CANTLOG  MTW,1    LOSTLOGS                                                      
         EXITCT                     EXIT CONTROL TASK CONTEXT                   
         B        *R0               AND RETURN                                  
         PAGE                                                                   
*                                                                               
* TRAP LOG TABLES                                                               
*                                                                               
TRAPTBL  DATA     LASTTRAP-%-1                                                  
         DATA     TRAP46                                                        
         DO1      #SIGMA9                                                       
         DATA     TRAP4C                                                        
         DO1      #SIGMA9                                                       
         DATA     TRAP4D                                                        
LASTTRAP RES      0                                                             
*                                                                               
TRAPTYPE DATA,1   0                                                             
         DATA,1   X'19'                                                         
         DO1      #SIGMA9                                                       
         DATA,1   X'17'                                                         
         DO1      #SIGMA9                                                       
         DATA,1   X'1D'                                                         
         BOUND    4                                                             
         ELSE     #TRAPLOG                                                      
         B        *R0               RETURN                                      
         FIN      #TRAPLOG                                                      
         FIN      #ERRORLOG                                                     
         TITLE    'I/O POSTING ROUTINES'                                        
************************************                                     2594000
*   CLEAN-UP END ACTION ROUTINES   *                                     2595000
************************************                                     2596000
*                                                                        2597000
*   THESE ROUTINES PERFORM CLEAN-UP END ACTION                           2598000
*   THEY POST THE COMPLETION STATUS                                      2599000
*                                                                        2600000
*   AT ENTRY:   R10,11  END-ACTION DOUBLEWORD                            2601000
*               R12      TYPE OF COMPLETION CODE                         2602000
*               R13     ACTUAL RECORD SIZE (CUPCORE,CUPDCB)                     
*                       REMAINING BYTE COUNT  (CUPCOREX,CUPDCBX)                
*               R14      LINK                                            2604000
*               R15      BUFFER ADDRESS                                  2605000
*                                                                        2606000
*                                                                        2607000
CUPCOREX RES      0                                                             
         LCW,R13  R13               MAKE RBC NEGATIVE                           
         AW,R13   *R10              ADD IBC TO MAKE ARS                         
         AND,R13  M17                                                           
*                                                                               
CUPCORE  EQU      %                                                             
         STW,R13  *R10              STORE ARS                                   
         STB,R12  *R10              AND PUT IN TYC BYTE                         
         B        *R14              RETURN                               2610000
*                                                                               
         PAGE                                                                   
*                                                                               
CUPDCBX  RES      0                                                             
         LW,R1    R10               DCB ADDR TO R1                              
         LW,R11   4,R1              GET DCB WORD4                               
         SLS,R11  -17               SHIFT TO GET IBC                            
         SW,R11   R13               SUBTRACT RBC TO GET ARS                     
         LW,R13   R11               AND PUT IT IN R13                           
*                                                                               
CUPDCB   LW,R1    R10               DCB ADDRESS TO R1                    2611000
         LW,R11   YFFFE            MASK FOR RSZ & ARS IN DCB             2612000
         STB,R12  R10               TYC CODE                                    
         SLS,R10  -7                POSITION TO BIT 14                          
         STS,R10  2,R1              PUT INTO DCB WORD 2                  2615000
*                                                                               
         LW,R11   M15                                                           
         LW,R10   R13               GET ARS                                     
         SLD,R10  17                POSITION                                    
         STS,R10  4,R1              PUT IN DCB                                  
*                                                                               
         LW,R10   *R1               WORD 0 OF DCB                        2619000
         AND,R10  FFFFEFFF          RESET BUSY                           2620000
         STW,R10  *R1               RESTORE                              2621000
         B        *R14              RETURN                               2622000
         TITLE    'SPECIAL POSTING FOR SIDE BUFFERED REQUESTS'                  
*                                                                               
* R14    LINK                                                                   
* R7     DCT INDEX                                                              
* R12    TYC                                                                    
* R13    RBC                                                                    
*                                                                               
         DO       #SIDEBUF                                                      
SDPOSTER RES      0                                                             
         AND,R13  M16               MASK OFF RBC                                
         LCW,R13  R13               MAKE RBC NEGATIVE                           
         LW,R6    DCTSDBUF,R7       GET POST WORD ADDR                          
         AW,R13   0,R6              ADD IBC                                     
         STB,R12  R13               STUFF TYC                                   
         STW,R13  0,R6              POST CELL                                   
         DO       #ECB                                                          
SDPLOOP  RES      0                                                             
         PLW,R4   SDPSTACK          GET WAITING TASK ID                         
         BSU      *R14              NO MORE WAITING TASKS                       
         DISABLE                                                                
         MTB,0    STICOUNT,R4                                                   
         BEZ      %+2               WAIT COUNT ZERO                             
         MTB,-1   STICOUNT,R4       DECREMENT WAIT COUNT                        
         ENABLE                                                                 
         BAL,R8   TMTRIG            TRIGGER DISPATCHER                          
         B        SDPLOOP           AND GET ANOTHER                             
         ELSE     NO ECBS                                                       
         B        *R14              RETURN                                      
         FIN      #ECB                                                          
         BOUND    8                                                             
SDPSTACK STACKDW,1,1 %+2,8                                                      
         RES      8                                                             
         FIN      #SIDEBUF                                                      
         TITLE    'MESSAGE OUT'                                                 
*                                                                               
* NON-I/O MESSAGE OUT ROUTINE                                                   
*                                                                               
* R13    ADDRESS OF TEXTC MESSAGE                                               
* R5     LINK                                                                   
*        ALL REGISTERS PRESERVED                                                
*                                                                               
OUTMSG   RES      0                                                             
         PUSH     14,R2             SAVE REGISTERS                              
         LI,R4    FCWKPWNL          MSG WITH NEW LINE                           
         LI,R1    0                 FUDGE DCT INDEX NOT EQUAL TO OC INDEX       
         B        MSGENTRY                                                      
         PAGE                                                                   
*                                                                        2789000
MSGOUT   EQU      %                 IO MESSAGE OUTPUT                    2790000
*                                                                        2791000
*    R1 HAS DCT INDEX                                                    2792000
*    R13 HAS MESSAGE ADDR (WORD)                                         2794000
*    R5 IS THE LINK                                                             
*    ALL REGISTERS PRESERVED                                                    
         PUSH     14,R2             SAVE REGISTERS                              
         LW,R12   R1                DCT INDEX                                   
         LI,R4    FCWKPWDN          I/O MESSAGE FORMAT                          
MSGENTRY RES      0                                                             
         LI,R7    OC                                                            
         LB,R7    OPLBS2,R7         GET DCT INDEX OF OC                         
         AND,R1   M8                MASK OUT DCT INDEX                          
         CW,R1    R7                IS IT THE SAME AS OC DEVICE                 
         BE       NOQ4MSG           YES, DONT TRY TO OUTPUT OC ERROR            
*                                   NO, NOT OC                                  
         LB,R11   *R13              BYTE COUNT TO R11                    2804000
         LW,R10   R13               MESSAGE ADDRESS TO R10      ******** 2805000
         SLS,R10  2                 MAKE BYTE ADDRESS           ******** 2806000
         AI,R10   1                 SKIP OVER COUNT                      2807000
         LI,R13   X'FF'             SET PRIORITY TO MINIMUM (BKG)               
         LW,R8    CUPCOD4           SET CODE TO POST NO STATUS           2814000
         PAGE                                                                   
         DISABLE                                                                
         LB,R5    IOQ2              GET FREE Q CHAIN HEAD                       
         LB,R5    IOQ2,R5           GET NEXT FLINK                              
         BEZ      NOQ4MSG           BRANCH IF NONE                              
*                                                                               
         LB,R5    IOQ3              # OF BKG Q ENTRIES IN USE                   
         CB,R5    IOQ1              COMPARE WITH # ALLOWED                      
         BGE      NOQ4MSG           Q FULL, DROP MESSAGE                        
*                                   OK                                          
         LB,R2    DCT2,R7           GET OC CHANNEL INDEX                        
         LB,R2    CIT1,R2           GET OC Q HEAD                               
         B        %+2               SKIP CHAIN STEP FIRST TIME                  
QMSGLOOP LB,R2    IOQ2,R2           CHAIN FORWARD                               
         BEZ      NEWMSG            END OF CHAIN, ITS A NEW MESSAGE             
*                                   NEXT Q ENTRY                                
         CB,R1    IOQ7,R2           IS THE DCT INDEX THE SAME                   
         BNE      QMSGLOOP          NO, SKIP THIS ONE                           
*                                   YES, SAME DCT                               
         CW,R10   IOQ8,R2           IS THIS THE SAME MESSAGE                    
         BNE      QMSGLOOP          NO, KEEP SCANNING                           
         BE       NOQ4MSG           YES, DONT Q ANOTHER IDENTICAL MSG           
********                                                                        
NEWMSG   RES      0                 ADD A NEW MESSAGE TO THE Q                  
         LI,R2    0                 SET FOR NO ECB                              
         LI,R6    10                NUMBER OF RECOVERY TRIES                    
         BAL,R5   QUEUE             QUEUE IT                             2816000
         NOP                                                             2817000
NOQ4MSG  RES      0                                                             
         ENABLE                                                                 
         PULL     14,R2             RESTORE R2-R15                              
         B        *R5               RETURN                                      
         TITLE    'I/O MESSAGES'                                                
MSG0     TEXTC    ' KEY-IN PENDING'                                             
MSG1     TEXTC    ' MANUAL'                                                     
MSG2     TEXTC    ' ERROR'                                                      
MSG3     TEXTC    ' I/O TIMED OUT'                                              
MSG4     TEXTC    ' UNRECOGNIZED'                                               
MSG4A    TEXTC    ' ERROR, NOT-OPERATIONAL'                                     
MSG4B    TEXTC    ' SIO REJECT, CC = 01--'                                      
MSG4D    TEXTC    ' SIO REJECT, CC = 10--'                                      
MSG5     TEXTC    ' WRITE PROTECTED'                                            
K:DPIDLE EQU      %                                                             
MSG6     TEXTC    ' IDLE'                                                       
MSG7     TEXTC    ' FAULT'                                                      
         DO1      #PTAPE                                                        
MSG8     TEXTC    ' LOW'                                                        
MSG9     TEXTC    ' TEST MODE'                                                  
         TITLE    'PAX ASCII TRANSLATE TABLE'                                   
         DO       #PAX                                                          
ASCIITBL RES      0                                        *** PAX ***          
         DO1      64                                       *** PAX ***          
         DATA     X'20202020'                              *** PAX ***          
*                                                          *** PAX ***          
CTR      SET      X'20'                                    *** PAX ***          
 ASCII  ' ','!','"','#','%','%','&','''','(',')','*','+',',','-','.','/'        
 ASCII  '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?'         
 ASCII  '@','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'         
 ASCII  'P','Q','R','S','T','U','V','W','X','Y','Z','|','\','~','^',''         
CTR      SET      X'0A'                                    *** PAX ***          
         ASCII    X'A',X'20',X'C'                          *** PAX ***          
         FIN      #PAX                                                          
         TITLE    'RE:ENT AND 4CHAR SUBROUTINES'                                
*                                                                               
* I/O SYSTEM RE-ENTRANCE TEST                                                   
*                                                                               
RE:ENT   DISABLE                                                                
         CH,R14   DCT10,R1                                                      
         BE       *R0               NOT RE-ENTERED                              
         ENABLE                                                                 
         B        *R15              RE-ENTERED                                  
*                                                                               
* 4CHAR FETCHES THE FIRST 4 CHARACTERS OF A BUFFER FOR !EOD TESTING             
*                                                                               
4CHAR    LW,R7    IOQ8,R3           BUF ADDRESS                                 
         LI,R6    -4                                                            
         LB,R8    0,R7              GET BYTE                                    
         STB,R8   R0+1,R6                                                       
         AI,R7    1                                                             
         BIR,R6   %-3                                                           
         B        *R5                                                           
         TITLE    'COMLIST - BUILDS ALL COMMAND LISTS'                          
*                                                                        3289000
          BOUND    4                                                     3290000
COMLIST  EQU      %                 COMMAND LIST BUILDER                 3291000
*                                                                        3292000
*    R10 HAS DOT ADDR                                                    3293000
*                                                                        3294000
*    OTHER REGS AS FOR STARTIO                                           3295000
*                                                                        3296000
         LH,R7    DCT7,R1           GET COMMAND LIST ADDR                3297000
         LB,R5    IOQ5,R3           FUNCTION CODE                        3299000
         LW,R6    *R10,R5           COMMAND LIST INDEX                   3300000
         LB,R6    R6                POSITION                             3301000
CL5      LB,R5    *R10,R6           COMMAND INDEX                        3302000
         LD,R8    *R10,R5           GET COMMAND                          3303000
REPCOM   RES      0                                                             
CL7      LI,R5    2                 INDEX TO FUNCTION                    3304000
         BAL,R0   RE:ENT            CHECK RE:ENT BEFORE BRANCH                  
         ENABLE                                                                 
         LB,R5    R9,R5             FUNCTION                             3305000
         AND,R9   FFFF00FF          CLEAR FUNCTION BYTE                  3306000
         B        %+1,R5            TRANSFER VECTOR                      3307000
         B        CL90              STORE COMMAND AS IS                  3308000
         B        CL10              SEEK ADDR IN IOQ12                   3309000
         B        CL20              DATA TRANSFER                        3310000
         B        CL30              IO MESSAGE                           3311000
         B        CL40              SPECIAL HANDLER FUNCTION             3312000
*                                                                        3313000
CL10     LI,R11   IOQ12                                                  3314000
         AW,R11   R3                IOQ12+INDEX IS BUF ADDR              3315000
         SLS,R11  2                 CONVERT TO BYTE ADDR                 3316000
         OR,R8    R11               TO COMMAND                           3317000
         B        CL90              GO STORE                             3318000
*                                                                        3319000
CL20     LW,R11   IOQ8,R3           GET BUF ADDR                         3320000
         DO       #MAP                                                          
         CW,R11   Y8                IS THIS A DATA CHAIN REQUEST                
         BANZ     CL22              YES                                         
*                                   NO                                          
         FIN      #MAP                                                          
         AND,R11  M24               MASK BUFFER ADDRESS                         
         OR,R8    R11               TO COMMAND                           3322000
         LH,R11   IOQ9,R3           GET BYTE COUNT                       3323000
         AND,R11  M16               MASK                                 3324000
         OR,R9    R11               TO COMMAND                           3325000
         B        CL90              GO STORE                             3326000
*                                                                        3327000
         DO       #MAP                                                          
CL22     RES      0                                                             
         LI,R5    X'FFFF'                                                       
         AND,R5   R11               DW PTR TO DATA CHAIN                        
         LB,R8    R8                ORDER CODE                                  
         LB,R9    R9                FLAGS                                       
*                                                                               
         LH,R11   IOQ9,R3           CDW COUNT                                   
*                                                                               
CL23     RES      0                                                             
         LD,R12   0,R5              GET CHAIN CDW                               
         STB,R8   R12               PUT IN ORDER                                
         STB,R9   R13               PUT IN FLAGS                                
*                                                                               
         CI,R11   1                 IS THIS THE LAST CDW                        
         BE       CL24              YES                                         
*                                   NO                                          
         OR,R13   YE                SET BITS 0,1,2                              
         EOR,R13  Y6                RESET BITS 1 AND 2 (0=DC)                   
*                                                                               
CL24     RES      0                                                             
         BAL,R0   RE:ENT            CHECK FOR RE-ENTRANCE                       
         STD,R12  0,R5              STORE MODIFIED CDW BACK                     
         ENABLE                                                                 
*                                                                               
         AI,R5    1                 BUMP DATA CHAIN PTR                         
         BDR,R11  CL23              LOOP UNTIL LAST CDW                         
*                                                                               
         LW,R12   Y08               TIC ORDER                                   
         AW,R12   R7                ADD IN CLIST DW PTR                         
         AI,R12   1                 TO NEXT CDW                                 
         LI,R13   0                 SECOND HALF OF TIC                          
*                                                                               
         BAL,R0   RE:ENT            CHECK FOR REENTRANCE                        
         STD,R12  0,R5              PUT IN TRAILING TIC                         
         ENABLE                                                                 
*                                                                               
         LW,R8    IOQ8,R3           DATA CHAIN PTR                              
         LI,R0    8                 TIC ORDER                                   
         STB,R0   R8                PUT IN TIC CDW                              
         SLS,R9   24                MOVE FLAGS BACK FOR CL90 ONLY               
         B        CL90                                                          
         FIN      #MAP                                                          
CL30     LW,R11   IOQ12,R3          DCT FOR DEVICE NAME                  3328000
         AND,R11  XFF               MASK                                 3329000
         SLS,R11  3                 MUL BY 8 TO ADD DW'S                 3330000
         AI,R11   BA(DCT16)+1       GET BYTE ADDR OF ALARM                      
         AI,R9    -1                DEC BYTE COUNT                              
         OR,R8    R11               TO COMMAND                           3332000
         B        CL90              GO STORE                             3333000
*                                                                        3334000
CL40     LW,R11   R8                ROUTINE ADDRESS                      3335000
         AND,R8   YFF               MASK ORDER CODE                      3336000
         B        *R11              GO BACK TO HANDLER                   3337000
*                                                                        3338000
*                                                                        3340000
DELCOM   EQU      %                 RETURNS HERE TO DELETE COMMAND       3341000
         AI,R6    1                 INC COMMAND INDEX                    3342000
         B        CL5                                                    3343000
*                                                                        3345000
CL90     EQU      %                                                      3346000
USECOM   EQU      %                                                             
*                                                                        3347000
         BAL,R0   RE:ENT                                                        
         STD,R8   0,R7              STORE COMMAND DW                     3352000
*                                                                        3353000
         ENABLE                                             **ENABLE**   3354000
*                                                                        3355000
         CW,R9    YA                LAST IF NO CHAINING                  3356000
         BANZ     CL94                                                          
         LH,R0    DCT7,R1                                                       
         B        IOSST                                                         
CL94     AI,R6    1                 INC COMMAND INDEX                           
         AI,R7    1                 INC COMMAND ADDR                     3359000
         B        CL5                                                    3360000
*                                                                        3361000
FFFF00FF DATA X'FFFF00FF'                                                3362000
         TITLE    'NEWIOCK - CHECKS I/O FOR ANY ERROR'                          
************************************                                            
*   NEW I/O ERROR CHECKER          *                                            
************************************                                            
* INPUT:  R1  - PRIORITY/DCT INDEX                                              
*         R2  - CIT INDEX                                                       
*         R3  - IOQ INDEX                                                       
*         R9  - LINK                                                            
*         R14 - DEVICE ACTIVITY COUNT                                           
*                                                                               
* OUTPUT: R0, R1, R2, R3, R4, R7, R14, AND R15 UNCHANGED                        
*         R6  - AIO STATUS RIGHT JUSTIFIED                                      
*         R5  - TDV STATUS RIGHT JUSTIFIED                                      
*         R8  - TIO STATUS RIGHT JUSTIFIED                                      
*         R10/R11 - TDV DW                                                      
*         R12 - ZERO                                                            
*         R13 - MSG2 ADDRESS                                                    
*                                                                               
* THE ROUTINE WILL RETURN DIRECTLY IF ANY OF THE FOLLOWING                      
* CONDITIONS EXIST, OTHERWISE IT WILL SKIP RETURN.                              
*                                                                               
*        AIO CC 1 OR 2 NOT ZERO                                                 
*        TDV CC 1 OR 2 NOT ZERO                                                 
*        AIO STATUS 8,9 OR 12  NOT ZERO                                         
*        TDV STATUS 8,9,10,11,12,13,14 OR 15 NOT ZERO                           
*                                                                               
*                                                                               
         PAGE                                                                   
NEWIOCK  RES      0                                                             
         LW,R6    DCT12,R1          AIO STATUS                                  
         SLS,R6   -16               RIGHT JUSTIFIED                             
*                                                                               
         LH,R8    DCT21,R1          TIO STATUS RIGHT JUSTIFIED                  
*                                                                               
         LD,R10   DCT13,R1          TDV DW                                      
*                                                                               
         LH,R5    R11               TDV STATUS RIGHT JUSTIFIED                  
*                                                                               
         LI,R12   0                                                             
         LI,R13   MSG2              ERROR MESSAGE AS DEFAULT                    
*                                                                               
         LCF      DCT19,R1          AIO CC                                      
         BCS,12  *R9                EXIT                                        
*                                                                               
         LCF      DCT20,R1          TDV CC                                      
         BCS,12  *R9                EXIT                                        
*                                                                               
         CI,R6   (BIT8+BIT9+BIT12)**-16                                         
         BANZ    *R9                EXIT                                        
*                                                                               
         CI,R5   (BIT8+BIT9+BIT10+BIT11+BIT12+BIT13+BIT14+BIT15)**-16           
         BANZ    *R9                EXIT                                        
*                                                                               
         AI,R9    1                 NO ERROR                                    
         B       *R9                SKIP EXIT                                   
         TITLE    'POWER ON/OFF ROUTINES'                                       
*                                                                               
* POWER ON/OFF ROUTINES                                                         
*                                                                               
* NOTE: THESE ROUTINES DO NOT RECOVER FROM POWER FAULTS                         
*       THEY ONLY CRASH CLEANLY.                                                
*                                                                               
POWEROFF RES      0                                                             
         LCI      0                                                             
         STM,R0   CRASHREG          SAVE REGISTERS                              
         WAIT                                                                   
         B        %-1                                                           
****************************                                                    
POWERON  RES      0                                                             
         LW,R0    XBIT8             WAIT (APPROX 8 SEC.)                        
         BDR,R0   %                 FOR THINGS TO SETTLE                        
*                                                                               
         LCI      0                                                             
         LM,R0    CRASHREG          RESTORE REGISTERS                           
         CRASH    'POWER FAULT'                                                 
         TITLE    'SPURIOUS EXTERNAL INTERRUPT ROUTINE'                         
*                                                                               
* REPORT SPURIOUS EXTERNAL INTERRUPTS                                           
*                                                                               
SPRINT   RES      0                                                             
         ENTERCT                                                                
         LI,R13   SPRMSG                                                        
         BAL,R5   OUTMSG                                                        
         EXITCT                                                                 
         LPSD,X'A'  SPRPSD          CLR AND DISARM LEVEL, LOAD REG PTR          
*                                                                               
SPRMSG   TEXTC    '!! SPURIOUS EXTERNAL INTERRUPT'                              
*                                                                               
         TITLE    'CRASH PROCESSING'                                            
*                                                                               
*                                                                               
***************************************                                         
*                                                                               
         DO       #TRACE                                                        
TRACESTACK STACKDW,1,1 TRACESTK,TRACESIZE                                       
TRACESTK RES      TRACESIZE                                                     
         FIN      #TRACE                                                        
*                                                                               
*                                                                               
***************************************                                         
*                                                                               
*                                                                               
CRASHPSD PSD      MONCRASH,7        MASTER, UNMAPPED, INHIBITED                 
*                                                                               
MONCRASH RES      0                                                             
         MTW,1    CRASHTEST         WAS CRASH RE-ENTERED                        
         BGZ      %                 YES, HANG HERE                              
*                                   NO, GO ON                                   
         LCI      0                                                             
         STM,R0   CRASHREG          SAVE ALL REGISTERS                          
         DO       #T85                                                          
         LCI      0                                                             
         DATA     X'27100000'+BSTACK READ/SAVE BRANCH STACK                     
         FIN      #T85                                                          
         DO       #550                                                          
         RD,R3    X'31D'            GET AND SAVE LAST BRANCH (Q29)              
         LI,R2    -X'20'                                                        
         RD,R1    X'320',R2         READ Q REGISTERS                            
         STW,R1   QREG+X'20',R2     SAVE THEM                                   
         BIR,R2   %-2               LOOP THRU                                   
         STW,R3   QREG+X'1D'        SAVE LAST BRANCH                            
         FIN      #550                                                          
*                                                                               
         LD,R0    CRASHPSD          GET CRASH PSD                               
         STD,R0   CRASHLOC          SAVE IN IN CASE OF RE:ENTRANCE              
*                                                                               
         DO       #MAP                                                          
         LH,R0    CRASHPSD                                                      
         BAL,R1   SETMAP            ENTER MAPPED IF MAPPED BEFORE               
         FIN      #MAP                                                          
         PAGE                                                                   
         LI,R1    X'200'            CRASH HOWL (2 SEC DELAY FOR IO)             
HOWL     MI,R1    X'201'                                                        
         SLS,R1   -9                                                            
         LW,R0    R1                                                            
         BDR,R0   %                                                             
         WD,R0    X'42'             TRIGGER TONE                                
         CI,R1    X'1800'                                                       
         BL       HOWL                                                          
         DO       #CRASH                                                        
         LW,R6    CRASHPSD          GET CRASH LOCATION                          
         AND,R6   M24               GET ADDRESS PART                            
         LCI      13                                                            
         LM,R7    0,R6              PICK UP MESSAGE                             
         STM,R7   CRASHMSG          AND PUT IN BUFFER                           
         LB,R7    *R6               GET BYTE COUNT                              
         LI,R6    BA(CRASHMSG)+1    AND BYTE ADDR                               
         STD,R6   MSGCDW                                                        
         FIN      #CRASH                                                        
*                                                                               
         WD,R0    X'41'             SET ALARM                                   
*                                                                               
         DO       #SIGMA9           FOR SIGMA 9                                 
         LI,R7    X'1B00'+(X'2400'*#550) RESET ALL I/O PROCESSORS               
         RIO      0,R7                                                          
         AI,R7    -X'0100'                                                      
         BGEZ     %-2                                                           
         LI,R2    X'7FFFF'                                                      
         BDR,R2   %                 WAIT FOR 1 SEC FOR RIO TO FINISH            
         ELSE                       FOR SIGMA 5/7                               
         LH,R7    DCT1              NUMBER OF I/O DEVICES                       
HIOLOOP  LH,R6    DCT1,R7           HALT ALL DEVICES                            
         AIO,R0   *R6               CLEAR ANY INTERRUPT ANYWAY                  
         HIO,R0   *R6                                                           
         BDR,R7   HIOLOOP                                                       
         FIN      #SIGMA9                                                       
*        LIST      1                                                            
         DO        #PS                                                          
         LB,R1     DCTSHARE                                                     
         BEZ      %158                                                          
         LB,R1     MDDCTI           R1=SP  DCTX                                 
          LB,R6     DCTSHARE,R1                                                 
         BEZ      %158                                                          
         AND,R6    XF0                                                          
         AI,R6    X'B'              FORCE,T,S BITS                              
         AW,R6     PSDIOADR                                                     
         WD,R6     *R6              FORCE  DISK TIO US                          
         BCS,1     %                HANG  IF OTRHER CPU STILL OWNER             
%158     RES       0                                                            
         FIN       #PS                                                          
*        LIST      0                                                            
         PAGE                                                                   
*                                                                               
         LI,R6    OC                                                            
*                                                                               
         LB,R6    OPLBS2,R6         GET OC DCT INDEX                            
         STW,R6   OCDCT             SAVE OCDCT VALUE                            
         CI,R6    BIT0**-24         IT IS A DCT ISNT IT                         
         BANZ     NOOC              NO                                          
*                                   YES                                         
         LH,R6    DCT1,R6           GET DEVICE ADDRESS                          
         LI,R0    DA(CRASHCDW)      GET CDW PTR                                 
*************************************                                           
         SIO,R0   *R6               PUT OUT CRASH MESSAGE                       
*************************************                                           
         PAGE                                                                   
NOOC     LH,R1    CRASH                                                         
         AND,R1   M7                                                            
         BEZ      CRASH             CRASH IS RESIDENT                           
*                                   GOT TO READ IN CRASH                        
         LW,R0    OVISK,R1          GET SEEK ADDRESS                            
         STW,R0   SEEKADDR          AND SAVE IT                                 
*                                                                               
         LB,R1    MDDCTI            GET SP DCT INDEX                            
         LH,R1    DCT1,R1           GET SP DEVICE ADDRESS                       
*                                                                               
         LI,R0    DA(READCDWS)      READ CDWS                                   
         SIO,R0   0,R1              READ IN OVERLAY                             
         LI,R2    1000                                                          
         BDR,R2   %                                                             
         BCS,12   %-3                                                           
*                                                                               
         LI,R2    1000                                                          
         BDR,R2   %                 DELAY                                       
         TIO,R0   0,R1              IS I/O DONE                                 
         BCS,12   %-3               NO, LOOP                                    
         B        CRASOLAY          YES, BRANCH TO IT                           
********                                                                        
         BOUND    8                                                             
READCDWS GEN,8,24 3,BA(SEEKADDR)                                                
         DATA     CCFLAG+4          BYTE CNT OF 4 ALWAYS WORKS                  
         GEN,8,24 2,BA(CRASOLAY)                                                
         DATA     1024                                                          
         PAGE                                                                   
CRASHTEST DATA    -1                CRASH RE-ENTRANCE FLAG                      
*                                                                               
         BOUND    8                                                             
CRASHCDW GEN,8,24 5,BA(CRASHTXT)                                                
         GEN,1,31 #CRASH,SILFLAG+16                                             
         DO1      #CRASH                                                        
MSGCDW   RES      2                                                             
*                                                                               
         DO       #MAP                                                          
CRASHTXT DATA     X'40055A5A'                                                   
         TEXT     'ALARM ***'                                                   
         ELSE                                                                   
CRASHTXT DATA     X'155A5A40'                                                   
         TEXT     'ALARM ***'                                                   
         FIN      #MAP                                                          
         DO1      #SIGMA9                                                       
LASTPRTY DATA     0                                                             
BCRASH0  RES      0                                                             
         CRASH    'NO INSTRUCTION SIMULATORS'                                   
*                                                                               
         TITLE    'MEMORY FAULT INTERRUPT'                                      
         DO       (#SIGMA9+#550)>0                                              
*                                                                               
* MEMORY FAULT INTERRUPT RECIEVER                                               
*                                                                               
* PSD CC = 0, ALL INHIBITS SET                                                  
*                                                                               
MFIPSD   PSD      MFINT,7                                                       
*                                                                               
MFINT    RES      0                                                             
         ENTERCT                    ENTER CONTROL TASK CONTEXT                  
         DO1      #550=0                                                        
         LD,R0    MFIPSD            GET OLD PSD                                 
         LI,R3    1                 FLAG INDICATING MFI                         
         B        FINT              GO TO COMMON CODE                           
         TITLE    'PROCESSOR FAULT INTERRUPT'                                   
*                                                                               
* PROCESSOR FAULT INTERRUPT                                                     
*                                                                               
* PSD CC = 0, ALL INHIBITS SET                                                  
*                                                                               
PFIPSD   PSD      PFINT,7                                                       
*                                                                               
PFINT    RES      0                                                             
         ENTERCT                    ENTER CONTROL TASK CONTEXT                  
         DO1      #550=0                                                        
*                                                                               
         LD,R0    PFIPSD                                                        
         LI,R3    0                 FLAG FOR PFI                                
         B        FINT              GO TO COMMON CODE                           
         TITLE    'COMMON FAULT INTERRUPT CODE'                                 
*                                                                               
* COMMON FAULT INTERRUPT CODE                                                   
*                                                                               
         DO       #550=0                                                        
         BOUND    8                                                             
LASTPSD  DATA     0,0                                                           
         FIN      #550=0                                                        
*                                                                               
* R3 = 1 IF MFI                                                                 
* R3 = 0 IF PFI                                                                 
* R0/1 = PSD WHERE INTERRUPTED                                                  
*                                                                               
FINT     RES      0                                                             
*                                                                               
         LI,R2    0                                                             
         XW,R2    PFITRIP,R3        TEST SOFTWARE TRIGGER FLAG                  
         BNEZ     NOFILOG           DONT LOG IF NOT HARDWARE                    
         DO       #550=0                                                        
*                                                                               
         CD,R0    LASTPSD           IS IT THE SAME AS LAST TIME                 
         BE       STUCKFI           YES, IM STUCK                               
         STD,R0   LASTPSD           NO, SAVE IT FOR NEXT TIME                   
         FIN      #550=0                                                        
*                                                                               
         DO       #ERRORLOG                                                     
         MTW,0    LOGFLAG           ERROR LOGGING ON                            
         BEZ      NOFILOG           NO                                          
*                                   YES                                         
         LI,R7    LOGSIZE           GET A LOG BUFFER                            
         BAL,R8   GETTEMPI                                                      
         B        CANTFILOG         CANT                                        
*                                   OK                                          
         LI,R6    LOGCOUNT          SET WORD COUNT                              
         LI,R8    2                                                             
         STB,R8   *R7,R6                                                        
* LOG TYPE CODE                                                                 
         LI,R6    LOGTYPE                                                       
         LI,R8    X'30'                                                         
         AW,R8    R3                                                            
         STB,R8   *R7,R6                                                        
*                                                                               
         BAL,R0   PUSHLOG           STACK UP A LOG RECORD                       
         FIN      #ERRORLOG                                                     
*                                                                               
* START POLLING                                                                 
*                                                                               
NOFILOG  RES      0                                                             
         B        %+1,R3                                                        
         B        PFIPOLL                                                       
         B        MFIPOLL                                                       
*****************                                                               
         DO       #550=0                                                        
STUCKFI  CRASH    'STUCK IN FAULT INTERRUPT LOOP'                               
         FIN      #550=0                                                        
         TITLE    'MFI POLL CODE'                                               
*                                                                               
* MFI POLLING                                                                   
*                                                                               
MFIPOLL  RES      0                                                             
         LW,R1    K:UNAVBG                                                      
         AI,R1    -1                                                            
         B        %+2                                                           
MFIPOLUP AI,R1    -8191                                                         
         BLZ      POLLEXIT                                                      
*                                                                               
         DO       #550                                                          
         LCI      10                                                            
         LMS,R5   0,R1                                                          
         ELSE     #550=0                                                        
         LCI      10                                                            
         LMS,R6   0,R1                                                          
         LCI      9                                                             
         LMS,R5   0,R1                                                          
         FIN      #550=0                                                        
         LCI      12                                                            
         LMS,R4   0,R1                                                          
*                                                                               
         DO       #550                                                          
         CW,R4    XBIT1             POWER FAULT                                 
         BANZ     MUBAD             YES                                         
*                                   NO                                          
         CI,R4    X'1FF'            ANY BAD MEMORY BITS                         
         BAZ      MFIPOLUP          NO                                          
         B        MUOK                                                          
*******                                                                         
MUBAD    RES      0                                                             
         ELSE     #550=0                                                        
         LH,R0    R4                                                            
         CI,R0    X'7F80'           ANY MEMORY ERROR FLAG SET                   
         BAZ      MFIPOLUP                                                      
*                                                                               
         CI,R0    X'0100'                                                       
         BAZ      MUOK                                                          
         FIN      #550=0                                                        
MUCRASH  CRASH    '!!MEMORY FAULT'                                              
         PAGE                                                                   
MUOK     RES      0                                                             
         DO       #ERRORLOG                                                     
         MTW,0    LOGFLAG                                                       
         BEZ      MFIPOLUP          NO ERROR LOGGING                            
*                                   ERROR LOGGING ON                            
         LI,R7    LOGSIZE                                                       
         BAL,R8   GETTEMPI                                                      
         B        %+2               CANT GET SPACE                              
         B        LOGMSTST          GOT SPACE                                   
         MTW,1    LOSTLOGS                                                      
         B        MFIPOLUP                                                      
* MEMORY STATUS                                                                 
LOGMSTST RES      0                                                             
         LCI      3-#550                                                        
         STM,R4   LOGMSTAT,R7                                                   
* LOG TYPE                                                                      
         LI,R6    LOGTYPE                                                       
         LI,R0    X'43'-#550                                                    
         STB,R0   *R7,R6                                                        
* LOG SIZE                                                                      
         LI,R6    LOGSIZE                                                       
         LI,R0    5-#550                                                        
         STB,R0   *R7,R6                                                        
* ENTER LOG                                                                     
         BAL,R0   PUSHLOG                                                       
*                                                                               
         DO       #CRASH                                                        
         LI,R13   MUCRASH+1                                                     
         BAL,R5   OUTMSG                                                        
         FIN      #CRASH                                                        
         FIN      #ERRORLOG                                                     
         B        MFIPOLUP                                                      
         TITLE    'PFI POLLING'                                                 
*                                                                               
PFIPOLL  RES      0                                                             
         DO       #550=0                                                        
         LI,R1    X'1F01'                                                       
PFIPOLUP RES      0                                                             
         POLR,R2  0,R1              POLL PROCESSOR                              
         BCR,12   NEXTPROC          NO ERROR STATUS                             
         BCS,8    NEXTPROC          NO PROCESSOR                                
         STCF     R2                FORMAT CC INTO STATUS                       
*                                                                               
         DO       #ERRORLOG                                                     
         MTW,0    LOGFLAG           ERROR LOGGING ON                            
         BEZ      PFIALARM          NO                                          
*                                   YES                                         
         LI,R7    LOGSIZE           GET A LOG BUFFER                            
         BAL,R8   GETTEMPI                                                      
         B        %+2               CANT GET SPACE                              
         B        PFILOGER          CAN GET                                     
         MTW,1    LOSTLOGS                                                      
         B        PFIALARM                                                      
*                                   OK                                          
PFILOGER RES      0                                                             
         LI,R6    LOGCOUNT          PUT IN COUNT                                
         LI,R8    3                                                             
         STB,R8   *R7,R6                                                        
* LOG TYPE CODE                                                                 
         LI,R6    LOGTYPE                                                       
         LI,R8    X'32'                                                         
         STB,R8   *R7,R6                                                        
* POLL STATUS AND CC                                                            
         STW,R2   LOGPSTAT,R7                                                   
* PROCESSOR ID                                                                  
         CI,R1    X'1B01'                                                       
         BNE      %+2                                                           
         AI,R1    3                                                             
*                                                                               
         LI,R6    LOGPADDR                                                      
         STH,R1   *R7,R6                                                        
*                                                                               
         BAL,R0   PUSHLOG                                                       
*                                                                               
         FIN      #ERRORLOG                                                     
PFIALARM RES      0                                                             
         DO       #CRASH                                                        
         LI,R13   PRCRASH+1                                                     
         BAL,R5   OUTMSG                                                        
         FIN      #CRASH                                                        
NEXTPROC AI,R1    -X'100'                                                       
         BGEZ     PFIPOLUP                                                      
         B        POLLEXIT                                                      
PRCRASH  CRASH    '!!PROCESSOR FAULT'                                           
         PAGE                                                                   
         ELSE     550                                                           
*                                                                               
* 550 PROCESSOR POLLING                                                         
*                                                                               
         LB,R1    CNFGTYPE          NUMBER OF PROCESSORS                        
FIGLOOP  RES      0                                                             
         LB,R2    CNFGADDR,R1       GET ADDRESS                                 
         SLS,R2   8                 POSITION IT                                 
         POLR,R4  0,R2              GET AND CLEAR STATUS                        
         BCS,8    FIGBAD            BAD STATUS                                  
         BCR,14   FIGNEXT           NO STATUS                                   
         STCF     R4                SAVE CC                                     
         STW,R4   CNFGSTAT,R1       SAVE CC AND STATUS                          
*                                                                               
         LB,R3    CNFGTYPE,R1       GET PROCESSOR TYPE                          
         CW,R4    FIGMASK1,R3       IS STATUS BAD ENOUGH TO CRASH               
         BAZ      FIGGOOD           NO                                          
PRCRASH  CRASH    '!!PROCESSOR FAULT'                                           
**********************************                                              
FIGGOOD  RES      0                                                             
         CW,R4    FIGMASK2,R3       IS MFI NECESSARY                            
         BAZ      FIGNEXT           NO                                          
         TRIPMFI,R9                 YES                                         
         DO       #ERRORLOG                                                     
         B        FIGNEXT                                                       
FIGBAD   MTW,1    LOSTLOGS          BUMP LOST LOGS                              
         ELSE     #ERRORLOG=0                                                   
FIGBAD   RES      0                                                             
         FIN      #ERRORLOG=0                                                   
*                                                                               
FIGNEXT  BDR,R1   FIGLOOP           LOOP THRU ALL PROCESSORS                    
*                                                                               
* IT DIDNT CRASH, NOW TRY TO LOG STATUS                                         
*                                                                               
         DO       #ERRORLOG                                                     
         MTW,0    LOGFLAG           ERROR LOGGING ON                            
         BEZ      POLLEXIT          NO                                          
*                                   YES                                         
         LB,R1    CNFGTYPE          GET COUNT AGAIN                             
LOOPFIG  RES      0                                                             
         LW,R2    CNFGSTAT,R1       GET STATUS                                  
         LCF      R2                                                            
         BCR,14   NEXTFIG           NO ERROR STATUS                             
*                                   STATUS                                      
         LI,R7    LOGSIZE                                                       
         BAL,R8   GETTEMPI                                                      
         B        BADFIG            CANT GET A LOG BUFFER                       
*                                   GOT A LOG BUFFER                            
         LI,R6    0                                                             
         STW,R6   CNFGSTAT,R1       CLEAR STATUS BEING LOGGED                   
*                                                                               
         STW,R2   LOGPSTAT,R7       SAVE STATUS AND CC                          
*                                                                               
         LI,R6    LOGTYPE                                                       
         LI,R8    X'32'                                                         
         STB,R8   *R7,R6            TYPE                                        
*                                                                               
         LI,R6    LOGCOUNT                                                      
         LI,R8    3                                                             
         STB,R8   *R7,R6            COUNT                                       
*                                                                               
         LI,R6    LOGPADDR                                                      
         LB,R8    CNFGADDR,R1                                                   
         SLS,R8   8                                                             
*                                                                               
         LB,R9    CNFGTYPE,R1       GET TYPE                                    
         OR,R8    R9                OR INTO ADDR FIELD                          
         STH,R8   *R7,R6            ADDRESS                                     
*                                                                               
         BAL,R0   PUSHLOG           STACK LOG ENTRY                             
*                                                                               
         DO       #CRASH                                                        
         LI,R13   PRCRASH+1                                                     
         BAL,R5   OUTMSG                                                        
         FIN      #CRASH                                                        
         B        NEXTFIG                                                       
BADFIG   MTW,1    LOSTLOGS                                                      
*                                                                               
NEXTFIG  BDR,R1   LOOPFIG                                                       
         FIN      #ERRORLOG                                                     
         B        POLLEXIT                                                      
         FIN      550                                                           
         PAGE                                                                   
         DO1      #ERRORLOG                                                     
CANTFILOG MTW,1   LOSTLOGS                                                      
POLLEXIT RES      0                                                             
         CI,R3    1                 IS IT MFI                                   
         BE       MFIEXIT                                                       
*                                   IT IS PFI EXIT                              
         EXITCT                     EXIT CONTROL TASK CONTEXT                   
         LPSD,X'B'  PFIPSD                                                      
***                                                                             
MFIEXIT  RES      0                                                             
         EXITCT                     EXIT CONTROL TASK CONTEXT                   
         LPSD,X'B'  MFIPSD                                                      
PFITRIP  DATA     0                                                             
MFITRIP  DATA     0                                                             
         PAGE                                                                   
*                                                                               
* MASKS FOR 550 PROCESSOR POLLING                                               
*                                                                               
         DO       #550                                                          
*                                                                               
* MASK FOR CRASH BITS                                                           
*                                                                               
FIGMASK1 DATA     0                                                             
         DATA     BIT18+;           BASIC PROCESSOR (CPU)                       
                  +BIT24+;                                                      
                  BIT25+;                                                       
                  BIT26+;                                                       
                  BIT28+;                                                       
                  BIT29+;                                                       
                  BIT30+;                                                       
                  BIT31                                                         
         DATA     BIT21             MEMORY INTERFACE                            
         DATA     0                 PROCESSOR INTERFACE                         
         DATA     BIT19+BIT20       MIOP                                        
         DATA     0                                                             
         DATA     0                                                             
         DATA     0                 SYSTEM CONTROL UNIT                         
*                                                                               
* MFI TRIGGER MASK BITS                                                         
*                                                                               
FIGMASK2 DATA     0                                                             
         DATA     BIT22+BIT23       BASIC PROCESSOR (CPU)                       
         DATA     0                 MEMORY INTERFACE                            
         DATA     0                 PROCESSOR INTERFACE                         
         DATA     BIT17+BIT21       MIOP                                        
         DATA     0                                                             
         DATA     0                                                             
         DATA     0                 SYSTEM CONTROL UNIT                         
         FIN      #550                                                          
         FIN      SIGMA9 OR 550                                                 
         TITLE    '**** PROCESS ALL TRAPS ****'                                 
*                                                                               
*                                                                               
*                                   THIS ROUTINE PROCESSES ALL TRAPS            
*                                     EXCEPT THE CAL TRAP                       
*                                                                               
*        R0 = HALF WORD 0 OF PSD                                                
*        R1 = LINK                                                              
         DO       #MAP                                                          
SETMAP   CI,R0    BIT9**-16         IS MAP ON                                   
         BAZ      *R1               RETURN                                      
         LPSD,0   SETMAPX           YES                                         
         BOUND    8                                                             
SETMAPX  DATA     BIT9+SETMAP1      TURN MAP ON                                 
         DATA     X'07000000'                                                   
SETMAP1  B        *R1               RETURN                                      
         FIN      #MAP                                                          
*                                                                               
*                                                                               
         PAGE                                                                   
BADCAL   EQU      %                                                             
TRAPX    EQU      %                                                             
         DISABLE                                                                
         LB,R1    TCBPOINT          STI INDEX                                   
         LD,R1    STIRTSB,R1        BASE OF CAL STACK                           
         LW,R2    -CAL1PUSH+16,R1   1ST PSD                                     
         LW,R3    -CAL1PUSH+17,R1   2ND PSD                                     
         STD,R2   TRAP50            FAKE TRAP 50                                
         LD,R2    TRAP50+2          TO LOOK                                     
         STW,R2   -CAL1PUSH+16,R1   LIKE OTHERS                                 
         STW,R3   -CAL1PUSH+17,R1                                               
         B        CALEXIT           UNDO THE STACK                              
*                                                                               
         TITLE    'SUBROUTINE TO EFFECT A BREAK'                                
*                                                                               
*        AT ENTRY R6=SJI                                                        
*                 R7=JCB                                                        
*                 R8=LINK                                                       
*                                                                               
*        EXIT TO  LINK                                                          
*                                                                               
*        USES REGISTERS  R0,R1,R2,R3,R4,R5                                      
*                                                                               
*                                                                               
         DO      (#MAP+#DEBUG+#TJE)>0                                           
BRKSUB   EQU      %                                                             
         LI,R0    0                                                             
         STB,R0   R8                SET BREAK FLAG                              
         DISABLE                                                                
         LW,R0    JCBREAK,R7        GET BREAK CONTROL WORD                      
         BEZ      CTLSUB            IF  NO BREAK  TRY  CONTROL Y                
         LB,R4    R0                GET TASK ID                                 
         LB,R5    STILMID,R4        GET LOAD MODULE ID                          
BRK01    EQU      %                                                             
         LH,R0    LMISTAT,R5        GET TASK STATUS                             
         CI,R0    LMIT              IS HE TERMING                               
         BANZ     BRKEX             B IF YES -FORGET IT                         
         LI,R1    LMIBREAK          SETUP FOR BREAK                             
         DO       #TJE                                                          
         LCF      R8                CHECK BREAK OR CONTROL                      
         BEZ      BRK02             B IF BREAK                                  
         LI,R1    LMICTL            CONTROL BIT                                 
         FIN      #TJE                                                          
BRK02    EQU      %                                                             
         OR,R0    R1                SET APPROPRIATE FLAG                        
         STH,R0   LMISTAT,R5        RESTORE IN TABLE                            
         CI,R0    LMISEC            IS THE TASK PRIMARY                         
         BAZ      BRKEX             B IF YES -CALEXIT WILL CATCH                
         LB,R0    STISTAT,R4        CHECK FOR SUSPENDED                         
         CI,R0    STISUSP           IS HE SUSPENDED                             
         BAZ      BRK02A            B IF NO                                     
         AND,R0   XSTINSUS          REMOVE SUSPENSION                           
         STB,R0   STISTAT,R4        RESTORE IN TABLES                           
BRK02A   EQU      %                                                             
         LD,R0    STIRTSB,R4        IS HE IN A CAL                              
         BNEZ     BRKTRIG           B IF YES, JUST WAKE HIM UP                  
*                                   FOR TASK IN A CAL, CALEXIT WILL DO XFER     
         LD,R0    BKALTPSD          SETUP FOR BREAK                             
         DO       #TJE                                                          
         LCF      R8                CHECK FOR CONTROL                           
         BEZ      BRK03             B IF BREAK                                  
         LD,R0    CTALTPSD          SETUP FOR CONTROL Y                         
         FIN      #TJE                                                          
BRK03    EQU      %                                                             
         LI,R2    STCBAPSD                                                      
         LW,R3    STITCB,R4         GET TCB ADDRESS                             
         STD,R0   *R3,R2            SET ALTERNATE PSD                           
         LW,R0    STIPRIO,R4                                                    
         OR,R0    XSTIALT                                                       
         STW,R0   STIPRIO,R4        SET ALT DISPATCH FLAG                       
BRKTRIG  RES      0                                                             
         LW,R2    R8                SAVE LINK                                   
         BAL,R8   TMTRIG            TRIGGER HIS DISPATSHER                      
         LW,R8    R2                RESTORE LINK                                
BRKEX    EQU      %                                                             
         DO1      #TJE=0                                                        
CTLSUB   EQU      %                                                             
         ENABLE                                                                 
         B        *R8               RETURN                                      
         FIN     (#MAP+#DEBUG+#TJE)>0                                           
*                                                                               
         DO       #TJE                                                          
CTLSUB   EQU      %                                                             
         LI,R0    1**4              FLAG FOR CONTROL FUNCTION                   
         STB,R0   R8                                                            
         LB,R5    LMI#              NUMBER OF LMI'S                             
         LB,R4    STI#              NUMBER OF STI'S                             
         DISABLE                                                                
CTL01    EQU      %                                                             
         LW,R0    LMIJID,R5         JOB ID                                      
         CB,R6    R0                IS IT IN THE RIGHT JOB                      
         BNE      CTL02             B IF NO                                     
         LD,R0    LMINAME,R5        GET LMN NAME                                
         CD,R0    TELNAME           IS IT THE TEL TASK                          
         BE       CTL03             B IF YES                                    
CTL02    EQU      %                                                             
         BDR,R5   CTL01             GO FOR NEXT LMN                             
         B        BRKEX             NOT FOUND GET OUT                           
CTL03    EQU      %                                                             
         LB,R0    STILMID,R4        LMN ID                                      
         CW,R0    R5                THIS TASK                                   
         BE       BRK01             B IF YES                                    
         BDR,R4   CTL03             GO FOR NEXT TASK                            
         B        BRKEX             SOMTHING IS WRONG - SKIP IT                 
*                                                                               
         BOUND    8                                                             
*                                                                               
TELNAME  TEXT     'TEL     '                                                    
*                                                                               
         FIN      #TJE                                                          
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
*        BREAK ROUTINE FOR ALTERNATE DISPATCH                                   
*                                                                               
*                                                                               
*                                                                               
         DO      (#MAP+#DEBUG+#TJE)>0                                           
         BOUND    8                                                             
BKALTPSD EQU      %                                                             
         GEN,4,28 4,ALTBREAK        STORE 4 REGS                                
         GEN,8,24 7,0               INHIBIT                                     
*                                                                               
ALTBREAK EQU      %                                                             
         STM,R0   ALTEMP            SET SOME REGISTERS                          
         LI,R2    STCBAPSD                                                      
         LD,R0    *TCBPOINT,R2      GET OLD PSD                                 
         STD,R0   TRAP51                                                        
         LB,R1    TCBPOINT          TASK ID                                     
         LB,R1    STILMID,R1        LMID                                        
         LH,R0    LMISTAT,R1        STATUS FLAGS                                
         AND,R0   XLMINBRK          RESET BREAK FLAG                            
         STH,R0   LMISTAT,R1        REPLACE IN TABLE                            
         LCI      4                                                             
         LM,R0    ALTEMP            RESTORE REGS                                
         B        TRAP51A           FAKE TRAP                                   
*                                                                               
ALTEMP   DATA     0,0,0,0           REGISTER SAVE                               
         FIN     (#MAP+#DEBUG+#TJE)>0                                           
         DO       #TJE                                                          
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
*        CONTROL  ROUTINE  FOR  ALTERNATE  DISPATCH                             
*                                                                               
*                                                                               
*                                                                               
         BOUND    8                                                             
CTALTPSD EQU      %                                                             
         GEN,4,28 4,ALTCTL          STORE 4 REGS                                
         GEN,8,24 7,0               INHIBIT                                     
*                                                                               
ALTCTL   EQU      %                                                             
         STM,R0   ALTEMP            SAVE REGS                                   
         LI,R2    STCBAPSD                                                      
         LD,R0    *TCBPOINT,R2      GET OLD PSD                                 
         STD,R0   TRAP52            TRAPPED PSD                                 
         LB,R1    TCBPOINT          TASK ID                                     
         LB,R0    STILMID,R1        LMID                                        
         LH,R0    LMISTAT,R1                                                    
         AND,R0   XLMINCTL          RESET CONTROL FLAG                          
         STH,R0   LMISTAT,R1                                                    
         LCI      4                                                             
         LM,R0    ALTEMP            RESTORE REGS                                
         B        TRAP52A                                                       
*                                                                               
*                                                                               
         FIN      #TJE                                                          
         TITLE    '****PROCESS ALL TRAPS****'                                   
         BOUND    8                                                             
TRAP     DATA     0                 TRAP CC AND ADDRESS                         
         DATA,1   X'40',0,0,X'40'   CONTROL WORD FOR EACH TRAP                  
*                                     BYTE 0= MASK FOR TRAP CONTROL             
*                                     BYTE 1= UNUSED                            
*                                     BYTE 2= INDEX FOR ALARM TO TYPE           
*                                     BYTE 3= CODE TO STORE IN TEMP STK         
*                                                                               
*        NONALLOWED OPERATION  - CC MEANING                                     
*                                8  NONEXISTENT INSTRUCTION                     
*                                4  NONEXISTENT MEMORY ADDRESS                  
*                                2  PRIVILEGED INSTRUCTION IN SLAVE             
*                                1  MEMORY PROTECTION                           
*                                                                               
*                                                                               
*                                                                               
TRAP40   DATA     0,0               STORED PSD FROM TRAP 40                     
         DATA     TRAP40A           NEW PSD                                     
         GEN,8,24 7,0               LOCK OUT INT.                               
TRAP40A  STD,R0   TRAP90            SAVE R0,R1                                  
         STCF     TRAP90+3          SAVE CC TO PASS TO USER                     
         DO       #MAP                                                          
         STCF     SETMAPX           KEEP CC                                     
         LH,R0    TRAP40                                                        
         BAL,R1   SETMAP            TURN MAP ON IF ENTERED MAPPED               
         LCF      SETMAPX                                                       
         FIN      #MAP                                                          
         DO       #INSTSIM                                                      
         BIFRBM   TRAP40A1          BRACH IF RBM                                
         LCF      TRAP90+3          GET CC                                      
         BCR,7    TRAP12            BRANCH IF NONEXISTENT INSTRUCTION           
TRAP40A1 RES      0                                                             
         LCF      TRAP90+3          GET CC                                      
         STCF     R0                 SAVE CONDITIONS                            
         BCS,2    TRAP40B           BRANCH IF PRIVILEGED INST.                  
         BIFRBM   TRAP40B                                                       
         LI,R1    12                CHECK FOR                                   
         CB,R1    *PCBPOINT,R1       TRAP IN SIMULATOR                          
         BE       TRTN60              BRANCH IF IT IS                           
TRAP40B  LW,R0    TRAP90+3          GET CC                                      
         AND,R0   YFF               MASK CONDITIONS                             
         AI,R0    TRAP40             ADD NONALLOWED OPERATION ADDRESS           
         STW,R0   R1                  SET IN R1                                 
         B        TRAP1                PROCESS AS NORMAL TRAP                   
         ELSE                                                                   
         STCF     R0                GET COND. CODES                             
         LI,R1    TRAP40                                                        
         LB,R0    R0                RIGHT JUSTIFY TRAP CC'S                     
         STB,R0   R1                                                            
         B        TRAP1                                                         
         DATA     0                 UNUSED WORD                                 
         FIN                                                                    
*                                                                               
         PAGE                                                                   
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   X'20',0,4,X'41'                                               
*        UNIMPLEMENTED INSTRUCTION                                              
TRAP41   DATA     0,0               STORED PSD FROM TRAP 41                     
         DATA     TRAP41A           NEW PSD                                     
         GEN,8,24 7,0                                                           
TRAP41A  STD,R0   TRAP90            SAVE R0,R1                                  
         LB,R0    TRAP41                                                        
         STB,R0   TRAP90+3          SAVE USER CC AND FLOAT CONTROLS             
         DO       #INSTSIM                                                      
         DO       #MAP                                                          
         LH,R0    TRAP41                                                        
         BAL,R1   SETMAP            TRUN MAP ON IF ENTERED MAPPED               
         FIN      #MAP                                                          
         LI,R0    TRAP41                                                        
         B        TRAP12B                                                       
         ELSE                                                                   
         LI,R1    TRAP41                                                        
         B        TRAP1A                                                        
         FIN                                                                    
*                                                                               
         PAGE                                                                   
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   X'10',0,5,X'42'                                               
*                                                                               
*        PUSH-DOWN STACK LIMIT                                                  
*                                                                               
TRAP42   DATA     0,0               STORED PSD FROM TRAP 42                     
         DATA     TRAP42A           NEW PSD                                     
         GEN,8,24 7,0               LOCK OUT INT.                               
TRAP42A  STD,R0   TRAP90            SAVE R0,R1                                  
         LB,R0    TRAP42                                                        
         STB,R0   TRAP90+3          SAVE USER CC AND FLOAT CONTROLS             
         LI,R1    TRAP42            R1=ADDRESS OF STORED PSD                    
         B        TRAP1A                                                        
*                                                                               
         PAGE                                                                   
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   2,0,6,X'43'                                                   
*                                                                               
*        FIXED-POINT ARITHMETIC OVERFLOW                                        
*                                                                               
TRAP43   DATA     0,0               STORED PSD FROM TRAP 43                     
         DATA     TRAP43A           NEW PSD                                     
         GEN,8,24 7,0               LOCK OUT INT.                               
TRAP43A  STD,R0   TRAP90            SAVE R0,R1                                  
         LB,R0    TRAP43                                                        
         STB,R0   TRAP90+3          SAVE USER CC AND FLOAT CONTROLS             
         LI,R1    TRAP43            R1=ADDRESS OF STORED PSD                    
         B        TRAP1A                                                        
*                                                                               
         PAGE                                                                   
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   8,0,6,X'44'                                                   
*                                                                               
*        FLOATING-POINT FAULT                                                   
*                                                                               
TRAP44   DATA     0,0               STORED PSD FROM TRAP 44                     
         DATA     TRAP44A           NEW PSD                                     
         GEN,8,24 7,0               LOCK OUT INT.                               
TRAP44A  STD,R0   TRAP90            SAVE R0,R1                                  
         LB,R0    TRAP44                                                        
         STB,R0   TRAP90+3          SAVE USER CC AND FLOAT CONTROLS             
         LI,R1    TRAP44            R1=ADDRESS OF STORED PSD                    
         B        TRAP1A                                                        
*                                                                               
         PAGE                                                                   
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   4,0,6,X'45'                                                   
*                                                                               
*        DECIMAL ARITHMETIC FAULT                                               
*                                                                               
TRAP45   DATA     0,0               STORED PSD FROM TRAP 45                     
         DATA     TRAP45A           NEW PSD                                     
         GEN,8,24 7,0               LOCK OUT INT.                               
TRAP45A  STD,R0   TRAP90            SAVE R0,R1                                  
         LB,R0    TRAP45                                                        
         STB,R0   TRAP90+3          SAVE USER CC AND FLOAT CONTROLS             
         LI,R1    TRAP45            R1=ADDRESS OF STORED PSD                    
         B        TRAP1A                                                        
*                                                                               
         PAGE                                                                   
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   X'80',0,7,X'46'                                               
*                                                                               
*        WATCHDOG TIMER RUNOUT                                                  
*                                                                               
TRAP46   DATA     0,0               STORED PSD FROM TRAP 46                     
         DATA     TRAP46A           NEW PSD                                     
         GEN,8,24 7,0               LOCK OUT INT.                               
TRAP46A  STD,R0   TRAP90            SAVE R0,R1                                  
         STCF     TRAP90+3          SAVE CC TO PASS TO USER                     
         DO1      #SIGMA9                                                       
         STCF     R0                SAVE TRAP CC                                
         TRIPPFI,R1                 CAUSE PFI AND PROCESSOR POLLING             
         DO1      #550                                                          
         TRIPMFI,R1                 CAUSE MEMORY POLLING                        
         LI,R1    TRAP46            R1=ADDRESS OF STORED PSD                    
         PAGE                                                                   
         DO       #SIGMA9                                                       
         DO       #TRAPLOG                                                      
         LCF      R0                                                            
         STCF     R1                PUT TRAP CC IN R1 PTR                       
         BAL,R0   TRAPLOG           YES, LOG TRAP                               
         LW,R0    R1                RESTORE RO                                  
         FIN      #TRAPLOG                                                      
*                                                                               
         SLS,R0   -28               MOVE TRAP CC TO BITS 28-31                  
         CI,R0    BIT28             DID INSTRUCTION COMPLETE                    
         BNE      %+3               NO, SKIP                                    
         LD,R0    TRAP90            RESTORE R0 AND R1                           
         LPSD,1   TRAP46            AND EXIT BACK                               
         CI,R0    BIT29+BIT31       IS IT A I/O OR DIO HANG UP                  
         BAZ      TRAPCR            NO, CRASH                                   
*                                   YES                                         
         CI,R0    BIT29             IS IT AN IO HANG UP                         
         BAZ      TRAP1             NO, IT A DIO HANG UP                        
*                                   NO, ITS AN IO HANG IN MONITOR               
         MTW,1    TRAP46            BUMP ADDR TO NEXT INST                      
         LCF      TRAP46                                                        
         LCI      X'C'              FORCE CC TO 1100                            
         STCF     TRAP46            PUT IN PSD                                  
         LD,R0    TRAP90            RESTORE R0 AND R1                           
         LPSD,1   TRAP46            AND IGNORE TRAP, IO WILL USE CC             
         ELSE     NOT SIGMA 9 OR 550                                            
         DO       #TRAPLOG                                                      
         BAL,R0   TRAPLOG           YES,LOG TRAP                                
         FIN      #TRAPLOG                                                      
*                                                                               
         B        TRAP1                                                         
         FIN      #SIGMA9                                                       
         PAGE                                                                   
         DO       #SIGMA9                                                       
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   0,0,10,X'4C'      CONTROL WORD                                
*                                                                               
*        MEMORY PARITY ERROR - SIGMA 9 ONLY                                     
*                                                                               
TRAP4C   DATA     0,0               STORED PSD FROM TRAP 4C                     
         DATA     TRAP4CA           NEW                                         
         GEN,8,24 7,0                PSD                                        
TRAP4CA  RES      0                                                             
         DO       #550                                                          
         BCS,15   %+2               REGISTER BLOCK ERROR                        
         LM,R0    M1                YES, GOT TO CLOBBER ALL REGISTERS           
         FIN      #550              NO, CAN SAVE REGISTERS                      
         STD,R0   TRAP90            SAVE R0 AND R1                              
         DO1      #ERRORLOG                                                     
         STCF     R0                SAVE TRAP CC                                
         TRIPPFI,R1                 CAUSE PFI AND PROCESSOR POLLING             
         DO1      #550                                                          
         TRIPMFI,R1                 CAUSE MEMORY POLLING                        
         LI,R1    TRAP4C            PROCESS                                     
*                                                                               
         DO       #TRAPLOG                                                      
         LCF      R0                                                            
         STCF     R1                SAVE TRAP CC IN R1 PTR                      
         BAL,R0   TRAPLOG           YES, LOG TRAP                               
         FIN      #TRAPLOG                                                      
*                                                                               
         B        TRAP1                                                         
*                                                                               
         FIN      #SIGMA9                                                       
         PAGE                                                                   
         DO       #SIGMA9                                                       
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
*                                                                               
         DATA,1   X'40',0,11,X'4D'                                              
*                                                                               
*        INSTRUCTION EXCEPTION TRAP - SIGMA 8/9 ONLY                            
*                                                                               
TRAP4D   DATA     0,0                                                           
         DATA     TRAP4DA                                                       
         GEN,8,24 7,0                                                           
*                                                                               
TRAP4DA  RES      0                                                             
         STD,R0   TRAP90                                                        
         STCF     R0                                                            
         TRIPPFI,R1                 CAUSE PFI AND PROCESSOR POLLING             
         LI,R1    TRAP4D            SET UP R1                                   
*                                                                               
         DO       #TRAPLOG                                                      
         LCF      R0                                                            
         STCF     R1                PUT TRAP CC IN R1 PTR                       
         BAL,R0   TRAPLOG           YES, LOG TRAP                               
         LCF      R1                                                            
         STCF     R0                PUT CC BACK IN R0                           
         FIN      #TRAPLOG                                                      
*                                                                               
         SLS,R0   -28                                                           
         CI,R0    1                 IS IT AN ILLEGAL REGISTER TRAP              
         BNE      TRAPCR            NO, CRASH                                   
*                                   YES, TREAT AS ILLEGAL OP                    
         B        TRAP1                                                         
         FIN                                                                    
         PAGE                                                                   
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   1,0,8,X'50'                                                   
*                                                                               
*        TRAP CONTROL WORDS FOR ILLEGAL PARAMETER MESSAGE                       
*                                                                               
TRAP50   DATA     0,0               KLUDGE TRAP 50 TO LOOK LIKE OTHERS          
         DATA     TRAP50A-1         ADJUST FOR CALEXIT                          
         GEN,8,24  7,0                                                          
TRAP50A  STD,R0   TRAP90                                                        
         LI,R1    TRAP50                                                        
         B        TRAP1A                                                        
         PAGE                                                                   
         DO      (#MAP+#DEBUG+#TJE)>0                                           
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   0,0,9,X'51'                                                   
*                                                                               
*        TRAP CONTROL WORDS FOR BREAK FUNCTION                                  
*                                                                               
TRAP51   DATA     0,0                                                           
BREAKPSD DATA     TRAP51A                                                       
         GEN,8,24 7,0                                                           
TRAP51A  EQU      %                                                             
         STD,R0   TRAP90                                                        
         LI,R1    TRAP51                                                        
         B        TRAP1A                                                        
*                                                                               
         DO       #TJE                                                          
         PAGE                                                                   
         RES      1                                                             
         BOUND    8                                                             
         ORG      %-1                                                           
         DATA,1   0,0,9,X'52'       CONTROL TRAP                                
*                                                                               
*        TRAP CONTROL WORDS FOR CONTROL FUNCTION                                
*                                                                               
TRAP52   DATA     0,0                                                           
CTLPSD   DATA     TRAP52A                                                       
         GEN,8,24 7,0                                                           
TRAP52A  EQU      %                                                             
         STD,R0   TRAP90                                                        
         LI,R1    TRAP52                                                        
         B        TRAP1A                                                        
*                                                                               
         FIN      #TJE                                                          
         FIN     (#MAP+#DEBUG+#TJE)>0                                           
         PAGE                                                                   
*                                                                               
TRAPCR   RES      0                                                             
         LW,R0    TRAPCRSH          IS IT RESIDENT                              
         AND,R0   M16               GET JUST ADDRESS                            
         CI,R0    OLAYFWA+OLAYSIZE                                              
         BGE      TRAPCRSH          YES                                         
         LD,R0    TRAP90            RESTORE R0,R1                               
         CRASH    'TRAP FAULT'                                                  
*                                                                               
TRAP1    RES      0                                                             
         LW,R0    1,R1              GET TRAP PSD WORD 2                         
         CW,R0    Y07               ARE ANY INHIBITS SET                        
         BANZ     TRAPCR            YES, NOT REENTRANT, CRASH                   
*                                   NO                                          
TRAP1A   LW,R0    K:RTS                                                         
         CI,R0    LMIRTS+(2*CTLMID) IS TRAP IN I/O OR TRAP CODE                 
         BE       TRAPCR            YES, CRASH                                  
*                                   NO                                          
         LB,R0    TCBPOINT          GET TASK ID                                 
         DO       #MAP                                                          
         XW,R0    R1                NEED AN INDEX REGISTER                      
         LB,R1    STILMID,R1        LOAD MODULE ID                              
         XW,R0    R1                RESTORE R1                                  
         CI,R0    NEXTID#                                                       
         BL       TRAPCR            B IF SYSTEM TASK                            
         FIN      #MAP                                                          
         DO       #SIGMA9                                                       
         LPSD,1   CLRPDF                                                        
         BOUND    8                                                             
CLRPDF   DATA     TRAP2                                                         
         GEN,8,24 7,0                                                           
*                                                                               
TRAP2    RES      0                                                             
         FIN      #SIGMA9                                                       
         STW,R2   TRAP90+2          SAVE R2                                     
         DO       #MAP                                                          
         LH,R0    *R1               GET HALF WORD 0                             
         LW,R2    R1                                                            
         BAL,R1   SETMAP            TURN MAP ON IF ENTERED MAPPED               
         LW,R1    R2                                                            
         FIN      #MAP                                                          
         LI,R2    2                                                             
         LH,R0    *PCBPOINT,R2                                                  
         AND,R0   M15               R0=NO. CELLS LEFT IN TEMP STACK             
         CI,R0     22               ABORT PROG. IF NOT ENUF/SIG7-1882/*B5732    
         BL        TRAP5            ROOM IN TEMP STACK     /SIG7-1882/*B5732    
         STW,R1   R2                SAVE R1 IN R2                               
         LI,R0    0                 ALWAYS PUT EXTRA WORD OF 0 IN TS            
         PSW,R0   *PCBPOINT                                                     
         LW,R0    *PCBPOINT         GET TOP OF TS                               
         CI,R0    1                 IS IT ODD                                   
         BANZ     %+3               YES, DON'T HAVE TO PUSH EXTRA WORD          
         LI,R0    -1                PUSH EXTRA -1 TO FORCE ON DW BND            
         PSW,R0   *PCBPOINT         STORE EXTRA WORD IN STACK                   
         LD,R0    *R2                                                           
         LCI      2                                                             
         PSM,R0   *PCBPOINT         PUSH PSD                                    
         LD,R0    TRAP90                                                        
         LCI      2                                                             
         PSM,R0   *PCBPOINT         PUSH R0,R1                                  
         LW,R1    R2                RESTORE R1                                  
         LW,R2    TRAP90+2          RESTORE R2                                  
         LCFI     14                                                            
         PSM,R2   *PCBPOINT         PUSH R2-R15 INTO TS                         
         PSW,R2   *PCBPOINT         PUSH EXTRA WORD INTO TS SO 19 WDS           
         LB,R10   TRAP90+3          SAVE THE CC                                 
         ENABLE                                                                 
         B        TRAPS             GO HANDLE IT NON-RESIDENTLY                 
         DO       #INSTSIM                                                      
TRAP12   STCF     R1                MERGE CC                                    
         LI,R0    TRAP40             WITH TRAP LOCATION                         
         SCS,R1   8                   AND SAVE IN                               
         STB,R1   R0                   R0                                       
TRAP12B  LI,R1    18                OPEN 18-WORD                                
TRAP12C  MSP,R1   *PCBPOINT          STACK                                      
         LI,R1    -15               LET R1 POINT TO                             
         AW,R1    *PCBPOINT          REGISTER STORAGE                           
         LCI      14                SAVE                                        
         STM,R2   2,R1               R2-R15                                     
         LD,R6    *R0               GET USER'S PSD                              
         LB,R2    *R6               GET OP CODE            /SIG7-5346/*C5732 C01
         AND,R2   M7                IGNORE IND BIT         /SIG7-5346/*C5732 C01
         CLM,R2   X5                CAL2,3,4               /SIG7-5346/*C5732 C01
         BCS,9    TRAP12D           NO                     /SIG7-5346/*C5732 C01
         LI,R2    -18               CLEAR UNIMP IN STACK   /SIG7-5346/*C5732 C01
         MSP,R2   *PCBPOINT                                /SIG7-5346/*C5732 C01
         LW,R1    R0                SET R1                 /SIG7-5346/*C5732 C01
         B        TRAP1                                    /SIG7-5346/*C5732 C01
TRAP12D  LD,R2    TRAP90            GET SAVED R0/R1        /SIG7-5346/*C5732 C01
         ENABLE                     ALLOW INTERRUPTS      *** ENABLE ***        
         STW,R6   -2,R1             SAVE PSD                                    
         STW,R7   -1,R1              IN STACK                                   
         STW,R2   0,R1              SAVE R0 AND                                 
         STW,R3   1,R1               R1 IN STACK                                
         B        TRAP20                                                        
TRAP13   LW,R4    0,R6              GET INSTRUCTION                             
         BGZ      TRAP16B            BRANCH IF DIRECT                           
         CW,R4    Y1C               CHECK FOR LEGAL INDIRECT                    
         BANZ     TRAP15             BRANCH IF LEGAL                            
TRAP14   LW,R0    Y8                NONEXISTENT                                 
         B        TRTN50             INSTRUCTION                                
TRAP15   CI,R4    X'1FFF0'          CHECK FOR REGISTER                          
         BANZ     TRAP16             BRANCH IF NOT                              
         AW,R4    R1                  POINT TO REGISTER STORAGE                 
TRAP16   AND,R4   M31               RESET INDIRECT BIT                          
         CS,R4    K:FGDEND          CHECK NONEXISTENT MEMORY REF                
         BGE      TRAP14             BRANCH IF NONEXISTENT                      
         LS,R4    0,R4              GET DIRECT ADDRESS                          
TRAP16B  LB,R2    R4                 AND OPERATION CODE                         
         SCS,R2   -1                PAIR OP CODES                               
TRAP16D LB,R3     TBLUN1,R2          AND GET                                    
         LW,R6    *R0               1ST WORD OF USER PSD                INSDR170
         AND,R6   YFF7E             MASK OUT ADR, FORCE MASTER MODE     INSDR170
         OR,R6    TBLUN4,R3         GET SIMULATION ADR                  INSDR170
         MTW,0    TBLUN4,R3         WAS THERE A SIMULATION ENTRY ADR    INSDR170
         BGZ      TRAP18            OK TO SIMULATE                              
         BEZ      TRAP14             NO SIMULATION ROUTINE                      
TRAP17   BIR,R6   TRAP19            BRANCH IF EXECUTE                           
         AI,R2    X'C'              CHECK FOR                                   
         BLZ      TRAP16D            EDIT BYTE STRING                           
         B        TRAP14            OP CODE X'62' - NONEXISTENT                 
TRAP18   LI,R5    12                SET SIMULATORS                              
         STB,R5   *PCBPOINT,R5       FLAG IN BYTE 1 OF PCB WORD 4               
         LCI      2                 SET FOR 2 REGS                      INSDR170
         PSM,4    *PCBPOINT         PUSH 2 INTO USER STACK              INSDR170
         XPSD,R0  R4                                                    INSDR170
* NOTE THAT THE ABOVE PUSH MEANS DIRECTLY CONNECTED TASKS CANNOT USE    INSDR170
* INSTRUCTION SIMULATION.  OF COURSE, THIS WAS ALREADY THE CASE, SO     INSDR170
* NO DAMAGE IS DONE.....                                                INSDR170
*                                                                               
TRAP19   LH,R3    R4                EXTRACT                                     
         AND,R3   XE                 INDEX                                      
         BEZ      TRAP19B             BRANCH IF NONE                            
         SLS,R3   -1                ALIGN AND                                   
         AW,R4    *R3,R1             ADD REGISTER VALUE                         
TRAP19B  LW,R6    R4                EFFECTIVE ADDRESS OF EXECUTE                
TRAP20   LI,R5    X'1FFFF'          ADDRESS MASK                                
         AND,R6   M17               EXTRACT ADDRESS                             
         CI,R6    15                CHECK FOR REGISTER                          
         BG       TRAP13             BRANCH IF NOT                              
         AW,R6    R1                POINT TO                                    
         B        TRAP13             REGISTER STORAGE                           
*                                                                               
TBLUN4   DATA     0                 NONEXISTENT                                 
K:FPSIM  B        U:XITSIM          XW X'1E6' UNIMP INST NORMAL RETURN          
K:DECSIM B        U:TRPSIM          XW X'1E7' UNIMP INST TRAP RETURN            
K:BYTSIM B        NOPPGM0T          XW X'1E8' UNIMP INST MEM PROT ERR           
K:CVSIM  DATA     0                 XW X'1E9' UNUSED                            
         DATA     -2,-1             EXECUTE, EDIT(MAYBE)                        
TBLUN1   DATA     0,0,0,X'101'                0-1F                              
         DATA     0,X'4000000',0,X'101'      20-3F                              
         DATA     X'3000000',0,0,0           40-5F                              
         DATA     X'3060005',0,2,X'2020202'  60-7F                              
*                                                                               
         FIN                                                                    
         BOUND    8                                                             
TRAP90   DO1      14                TRAP BUFFER                                 
         DATA     0                                                             
         DO       #INSTSIM                                                      
         B        TRTN10             PROCESS RETURN TRAP CAL                    
U:XITSIM RES      0                 RETURN FROM SIMULATOR                       
*                 R1 POINTS TO R0 STORAGE                                       
*                 CC IN HIGH-ORDER R8, STORAGE MASK IN R9                       
*                                                                               
         LI,R0    1                 SET FOR RETURN TO SIMULATOR                 
         FIN                                                                    
TRTN10   LW,R6    -2,R1             GET                                         
         LW,R7    -1,R1              PSD                                        
         AW,R6    R0                ADJUST RETURN LOCATION                      
         LI,R4    12                RESET                                       
         STB,R0   *PCBPOINT,R4      SIMULATOR FLAG                              
         LI,R4    -18               RECOVER                                     
         DISABLE                                         *** DISABLE ***        
         MSP,R4   *PCBPOINT         RECOVER STACK                               
         STD,R6   TRAP90+2          SAVE PSD AND                                
         STS,R8   TRAP90+2          CONDITIONS             /SIG7-3960/*C01      
         STB,R0   TRAP              SET FOR SIMULATOR RETURN                    
         LCI      0                 RELOAD                                      
         LM,0     0,R1               REGISTERS                                  
         STD,R0   TRAP90            SAVE R0,R1             /SIG7-5528/*C5732 C01
         LB,R0    TRAP              GET SIMULATOR FLAG                          
         CI,R0    1                                                             
         BE       TRTN30                                                        
         PLW,R0   *PCBPOINT         PULL ONE EXTRA WORD TO SEE IF FILLER        
         CI,R0    0                 IS THIS THE ONLY FILLER                     
         BE       %+2               YES                                         
         PLW,R0   *PCBPOINT         NO,PULL LAST WORD                           
         LB,R1    TCBPOINT          STI INDEX                                   
         LD,R1    STIRTSB,R1        BASE OF CAL STACK                           
         LCI      14                                                            
         STM,R2   -CAL1PUSH+2,R1    SET UP CALEXIT                              
         LCI      4                                                             
         LM,R2    TRAP90            R0,R1,PSD                                   
         LCI      2                                                             
         STM,R2   -CAL1PUSH,R1      R0,R1                                       
         LCI      2                                                             
         STM,R4   -CAL1PUSH+16,R1   PSD                                         
         ENABLE                                                                 
         B        CALEXIT           UNDUE STACK AND RETURN                      
TRTN30   LW,R0    TRAP90                                                        
         LPSD,0   TRAP90+2          RETURN TO USER                              
*                                                                               
         DO       #INSTSIM                                                      
U:TRPSIM RES      0                 SIMULATE TRAP RETURN FROM SIMULATOR         
*                 R1, R8, & R9 SAME AS FOR U:XITSIM                             
*        CC1 = 0  DECIMAL FAULT                                                 
*        CC1 = 1  FLOATING-POINT FAULT                                          
         STS,R8   -2,R1             INSERT CC                                   
         LI,R4    12                RESET                                       
         STB,R9   *PCBPOINT,R4      SIMULATION FLAG                             
         LI,R0    TRAP45            ASSUME DECIMAL FAULT                        
         BCR,8    TRTN40             BRANCH IF IT IS                            
         LI,R0    TRAP44            FLOATING-POINT FAULT                        
TRTN40   DISABLE                                         *** DISABLE *          
         STW,R0   TRAP                                                          
         B        TRTN70                                                        
NOPPGM0T LW,R0    Y1                SIMULATE MEMORY PROTECTION TRAP             
TRTN50   LI,R1    12                SIMULATOR FLAG                              
         DISABLE                                         *** DISABLE ***        
TRTN60   AND,R0   YFF               MASK CONDITIONS                             
         STB,R0   *PCBPOINT,R1       RESET SIMULATOR FLAG                       
         AI,R0    TRAP40              ADD NONALLOWED OPERATION ADDRESS          
         STW,R0   TRAP                 AND SAVE IN TRAP TEMP                    
TRTN70   LI,R1    -18               RESTORE                                     
         MSP,R1   *PCBPOINT          STACK POINTER                              
         LI,R1    3                 LET R1 POINT TO                             
         AW,R1    *PCBPOINT         R0 STORAGE                                  
         LCI      14                RESTORE                                     
         LM,R2    2,R1               R2 - R15                                   
         STD,R2   TRAP90+2          SAVE R2,R3                                  
         LCI      4                 RESTORE PSD AND                             
         LM,R0    -2,R1              R0,R1                                      
         STD,R2   TRAP90            SAVE R0,R1                                  
         STD,R0   *TRAP             SET PSD IN TRAP PSD SAVE                    
         LD,R2    TRAP90+2          RESTORE R2,R3                               
         LW,R1    TRAP              GET CC AND TRAP ADDRESS AND                 
         LCF      R1                                                            
         STCF     TRAP90+3          SAVE CC FOR TRAPS                           
         B        TRAP1              PROCESS AS NORMAL TRAP                     
         ELSE                                                                   
U:XITSIM EQU      K:XITSIM          B % IN X'1E6'                               
U:TRPSIM EQU      K:TRPSIM          B % IN X'1E7'                               
NOPPGM0T EQU      K:PPGM0T          B % IN X'1E8'                               
         FIN                                                                    
         DO       #DEBUG                                                        
         TITLE    '*** DEBUG INITIALIZATION PROCESSOR ***'                      
DBUG01   EQU      %                                                             
         STD,R0   TEMP                                                          
         DO       #MAP                                                          
         LH,R0    CAL1PSD                                                       
         BAL,R1   SETMAP            GET PROPER MODE                             
         FIN      #MAP                                                          
         LI,R1    2                                                             
         LH,R0    *PCBPOINT,R1                                                  
         AND,R0   M15                                                           
         CI,R0    2                 NEED TWO CELLS IN STACK                     
         BL       DBUG02            NOT ENUF                                    
         LD,R0    CAL1PSD                                                       
         LCI      2                                                             
         PSM,R0   *PCBPOINT         SAVE OLD PSD                                
         LD,R0    TEMP                                                          
         ENABLE                                                                 
         B        :#CALENT                                                      
DBUG02   EQU      %                                                             
         LB,R1    TCBPOINT                                                      
         LB,R1    STILMID,R1                                                    
         LW,R0    LMIPCB,R1                                                     
         AND,R0   XLMINDBG          RESET DEBUG BIT                             
         STW,R0   LMIPCB,R1                                                     
         LB,R1    TCBPOINT                                                      
         LB,R1    STIJID,R1                                                     
         LW,R1    SJI1,R1                                                       
         LW,R0    0,R1                                                          
         AND,R0   XJCBNDBG          RESET DEBUG INTERLOCK BIT                   
         AND,R0   FCFFFFFF                                                      
         STW,R0   0,R1              REPLACE IN JCB                              
         LD,R0    TEMP                                                          
         LPSD,8   CAL1PSD           RETUN T USER - NO DEBUG                     
*                                                                               
*                                                                               
         BOUND    8                                                             
DBUGPSD  DATA     DBUG01                                                        
         GEN,8,24 7,0                                                           
DBGBREAK RES      0                                                             
BREAKIN  RES      0                 BREAKIN OF A DEBUG DEVICE                   
         STCF     BKTEMP            SAVE CONDITION CODES                        
         LCFI     8                 AND SAVE REGISTERS                          
         STM,R0   BKTEMP1                                                       
         LB,R1    BKTEMP            GET PRESENCE INDEX                          
         SLS,R1   -4                FROM THE CONDITION CODES                    
         AI,R1    1                 AND ADJUST TO A COUNT(1-16)                 
         LH,R3    DCT1              NR OF DEVICES TO SEARCH                     
BKIN1    LB,R0    DCTDEBUG,R3       SEE IF DEBUG DEVICE PRESENT                 
         BEZ      %+3               NO -                                        
         BDR,R1   %+2               YES, PRESENCE INDEX MATCH                   
         B        BKIN2             ON MATCH, DEVICE INDEX IN R3                
         BDR,R3   BKIN1             LOOP UNTIL CORRECT DEVICE FOUND             
*        ERROR CONDITION IF MATCH CAN'T BE FOUND                                
         B        BKOUT                                                         
BKIN2    LH,R0    DIMASK            SEARCH FOR DI OPLABEL                       
         LB,R7    SJI3              GET JOB INVENTORY SIZE                      
BKIN3    LW,R6    SJI1,R7           GET A JCB POINTER                           
         BEZ      BKIN6             TRY AGAIN IF NULL ENTRY                     
         LW,R1    0,R6              IS JOB USING DEBUG                          
         CW,R1    XJCBDBG                                                       
         BAZ      BKIN6             IF NOT, TRY NEXT JOB                        
         LI,R4    JCBOPL1B          AND ITS OPLABEL COUNT                       
         LB,R4    *R6,R4                                                        
         BEZ      BKIN6             IF NULL, MOVE ON                            
         LW,R5    JCBOPL1,R6        OTHERWISE GET TABLE POINTER                 
BKIN4    CH,R0    *R5,R4            TEST FOR DI OPLABEL                         
         BNEZ     BKIN5             AND CONTINUE IF NOT                         
         LW,R5    JCBOPL2,R6        OTHERWISE, CHECK DEVICE INDEX               
         CB,R3    *R5,R4            FOR MATCH WITH INTERRUPT DEVICE             
         BNEZ     BKIN6             ON NO MATCH, TRY NEXT JOB                   
         B        BKIN7             ON MATCH, OUT TO SET BREAK                  
BKIN5    BDR,R4   BKIN4             TRY ANOTHER OPLABEL                         
BKIN6    BDR,R7   BKIN3             TRY ANOTHER JCB                             
*        ERROR IF NO MATCHING ARE FOUND                                         
         B        BKOUT                                                         
BKIN7    RES      0                                                             
         LW,R0    JCBREAK,R6        GET BREAK ADDRESS                           
         BEZ      BKOUT             IF EMPTY, CHECK OUT                         
         LB,R1    R0                GET TASK ID                                 
         LB,R2    STILMID,R1        NOW GET LMI INDEX                           
         LH,R7    LMISTAT,R2                                                    
         OR,R7    XLMIBRK           SET BREAK BIT                               
         STH,R7   LMISTAT,R2                                                    
         CI,R7    LMISEC            TEST IF PRIMARY                             
         BAZ      BKOUT             YES- JUST EXIT                              
         LD,R6    STIRTSB,R1        TEST IF IN CAL PROCESSOR                    
         BNEZ     BKOUT             YES - JUST EXIT                             
         LW,R7    STIPRIO,R1        CHECH ON ALTERNATE PSD                      
         CI,R7    XSTIALT                                                       
         BANZ     BKOUT             ALREADY SET - CHECK OUT                     
         OR,R7    XSTIALT           OTHERWISE, SET                              
         STW,R7   STIPRIO,R1                                                    
         LW,R4    STITCB,R1         GET TCB ADDRESS                             
         LI,R5    STCBAPSD                                                      
         LD,R6    BKALTPSD          AND SET ALTERNATE PSD                       
         STD,R6   *R4,R5                                                        
         B        BKOUT             AND EXIT                                    
BKOUT    RES      0                 RETURN FROM BREAK                           
         LB,R0    DCTDEBUG,R3                                                   
         AI,R0    X'4F'                                                         
         LW,R1    *R0               GET BREAK XPSD                              
         STW,R1   BKTEMP            SAVE AS REFERENCE                           
         LCFI     8                 RESTORE REGISTERS                           
         LM,R0    BKTEMP1                                                       
         LPSD,3   *BKTEMP                                                       
*                                                                               
*                                                                               
*                                                                               
BKTEMP   RES      1                 TEMP FOR CONDITION CODES                    
BKTEMP1  RES      8                 TEMP FOR REGISTER SAVE                      
DIMASK   DATA     'DIDI'                                                        
         FIN      #DEBUG                                                        
         TITLE    '**** PROCESS MASTER/SLAVE CAL ****'                          
*                                                                               
*                                   CHANGES PSD TO EITHER MASTER OR             
*                                     SLAVE MODE                                
*                                                                               
MASTER   LI,R0    0                 0 FOR MASTER MODE                           
         B        %+2                                                           
SLAVE    LI,R0    -1                1 FOR SLAVE MODE                            
         BIFFGD   SLAVE1                                                        
         LI,R1    X'200'            SYSTEM PROCESSOR BIT                        
         CW,R1    K:JCP1            BACKGROUND STATUS FLAGS                     
         BAZ      TRAPX             B IF BKG BUT NOT PROCESSOR                  
SLAVE1   RES      0                                                             
         LW,R1    Y008              BIT 8=M/S BIT                               
         LD,R2    STIRTSB,R4        GET CAL BASE                                
         AI,R2    -CAL1PUSH+16      SET R2=PSD IN THE STACK                     
         LW,R6    0,R2                  FETCH PSD AT CAL ENTRY                  
         LW,R7    1,R2                  AND PUSH IT FOR                         
         PUSH     2,R6                 THE DEBUGGER                             
         PULL     2,R6                  PULLIT TO KEEP STCK EVEN                
         STS,R0   0,R2              SET OR RESET M/S BIT                        
         DO       #SIGMA9           IF SIGMA 9, SET MAPPED                      
         LW,R1    XBIT9                 MM BIT TO MA                            
         LS,R0    0,R2                  R0=1 IF MM=1, MAPPED                    
         BEZ      CALEXIT               UNMAPPED, EXIT                          
         LW,R1    XBIT8                 FETCH MS BIT                            
         LS,R0    0,R2                  REVERSE IT AND STORE                    
         EOR,R0   XBIT8                 INTO MA                                 
         STS,R0   1,R2                                                          
         FIN                                                                    
         B        CALEXIT                                                       
         TITLE    'TRIGGER,DISABLE,ENABLE CAL PROCESSOR'                        
*        CAL1,5   FPT CODE 0        TRIGGER                                     
*        CAL1,5   FPT CODE 1        DISABLE                                     
*        CAL1,5   FPT CODE 2        ENABLE                                      
TRIGGER  EQU      %                                                             
DISABLE  EQU      %                                                             
ENABLE   EQU      %                                                             
         LW,R15   0,R3              VERIFY THE INTERRUPT                        
         CI,R15   FPTI2                 I2=0, ADDRESS                           
         BAZ      TRIGBAL               I2=1, LABEL                             
         BAL,R4   CKINTLAB                                                      
         B        TRIGBAD                                                       
         B        TRIG0                                                         
TRIGBAL  BAL,R4   CKINTADR                                                      
         B        TRIGBAD                                                       
TRIG0    CI,R14   X'51'-X'4F'       IS TO 49,4A,4B,50 OR 51?                    
         BG       %+3               OK                                          
         LI,R15   TYC61             BAD ADDRESS                                 
         B        TRIGBAD                                                       
         LB,R9    R15               R9=GROUP CODE                               
         AH,R9    TRIGTBL,R1            PLUS CONTROL BITS                       
         WD,R15   *R9                   DO WD TO INTERRUPT                      
         B        CALEXIT               EXIT                                    
TRIGBAD  LW,R0    0,R3              ERROR ADDRESS PROVIDED?                     
         CW,R0    XBIT10                                                        
         BAZ      BADCAL                NO, TRAP                                
         LW,R9    1,R3                  YES, PUT IT INTO                        
         BAL,R6   TMSETPSD              RTS STACK                               
         CI,R15   X'F0'                 ERROR LEVEL                             
         BG       CALERR                ERROR EXIT                              
         B        CALEXIT                                                       
         PAGE                                                                   
TRIGTBL  DATA,2   X'1700'           0 TRIGGER                                   
         DATA,2   X'1500'           1 DISABLE                                   
         DATA,2   X'1400'           2 ENABLE                                    
         TITLE    'CAL CONNECT LOGIC'                                           
*                                                                               
*        CAL CONNECTION LINKAGE                                                 
*                                                                               
*        XPSD IN TRAP WILL BE TO 'CCB' FORMATTED AS FOLLOWS:                    
*                                                                               
*  CCB   0,1      SAVED PSD                                                     
*        2,3      INTERMEDIATE PSD                                              
*        4        STD,R0     CALREG                                             
*        5        BAL,R1     CALENTRY                                           
*        6,7      ENTRY PSD                                                     
*                                                                               
*        ENTERS   DISABLED                                                      
*                                                                               
CALENTRY STCF     R1                SAVE ENTRY CC IN POINTER TO                 
*                                       PSD FOR CAL                             
         AI,R1    -(CCBBAL+1)       SET R1=CCB ADDRESS                          
         STW,R1   CALCCB                SAVE ADDR OF CCB                        
         DO       #MAP                                                          
         LH,R0    *R1               FETCH THE MAPPED MODE OF                    
         BAL,R1   SETMAP                CURRENT TASK AND                        
         FIN      #MAP                  SWITCH TO IT                            
         LD,R0    *CALCCB           GET SAVED PSD                               
         LCFI     2                     AND PUSH INTO                           
         PSM,R0   *PCBPOINT             USERS STACK                             
         LD,R0    CALREG            RESTORE R0-R1 AND                           
         LCFI     0                     PUSH ALL 16 REGS                        
         PSM,R0   *PCBPOINT                                                     
*                                                                               
         MTW,6    CALCCB            SET ADDR TO EPSD                            
         LD,R2    *CALCCB           FETCH ENTRY PSD                             
         ENABLE                                                                 
         DO       #MAP                                                          
         BIFREAL  CALREAL               UNMAPPED                                
         OR,R2    XBIT9                 MAPPED, TURN ON INPSD                   
         CW,R2    XBIT8             MASTER?                                     
         BANZ     CALREAL               NO                                      
         OR,R3    XBIT8                 YES, SET MA FOR PROTECTED               
         FIN      #MAP                                                          
CALREAL  CW,R2    XBIT4             AI INDICATOR ON?                            
         BAZ      CALGO                 NO, DO LPSD                             
         LB,R0    CALCCB                YES, FETCH CC                           
         SLS,R0   -4                    RIGHT JUSTIFY AND                       
         AW,R2    R0                    ADD TO ENTRY ADDRESS                    
         EOR,R2   XBIT4                 REVERSE INDICATOR                       
CALGO    LW,R0    PCBPOINT          SET R0=ADDRESS OF STCK DBLWORD              
         LPSD,0   R2                ENTER THE CALLERS ROUTINE                   
         TITLE    'CALRTN CAL PROCESSOR'                                        
*                                                                               
*        CALRTN   CAL PROCESSOR                                                 
*                                                                               
CALRTN   LD,R1    STIRTSB,R4        FETCH THE RTS STACK ADDR                    
         LCFI     14                    AT END OF CAL ENTRY                     
         PLM,R2   *PCBPOINT             REMOVE REGS 2-15                        
         LCFI     14                    FROM USERS STACK AND                    
         STM,R2   -CAL1PUSH+R2,R1       STORE OVER REGS IN RTS                  
         LCFI     4                     REMOVE PSD AND REGS 0-1                 
         PLM,R2   *PCBPOINT             FROM USERS STACK AND                    
         LCFI     2                     STORE OVER REGS AND                     
         STM,R4   -CAL1PUSH,R1          PSD IN RTS                              
         LCFI     2                                                             
         STM,R2   -CAL1PUSH+16,R1                                               
         B        CALEXIT           EXIT                                        
         PAGE                                                                   
         DO       #XRBM                                                         
TRGALARM RES      0                 TRIGGER ALARM                               
         DISABLE                                                                
         BIFBKG   BADCAL            NOT ALLOWED IF BKG                          
         LW,R0    0,R3              R0=ADDR OF TEXTC MSSG                       
         LB,R1    *R0               R1=BYTE COUNT                               
         CI,R1    51                                                            
         BLE      %+2               RESTRICT MESSAGE TO                         
         LI,R1    51                51 BYTES                                    
         STB,R1   X'27'             SET BYTE COUNT                              
         LB,R2    *R0,R1            MOVE REST OF MSG                            
         STB,R2   X'27',R1                                                      
         BDR,R1   %-2                                                           
*                                                                               
         PULL     5,R0                                                          
         PULL     16,R0             RESTORE REGISTERS FROM CAL                  
*                                                                               
         B        X'26'             EXECUTE CRASH                               
*                                                                               
         FIN      #XRBM                                                         
         TITLE    'FINAL PHASE OF SECONDARY TASK TERMINATION'                   
*******************                                                             
*    TTFINAL      *    LOGIC TO PERFORM                                         
*******************      SECONDARY TASK TERMINATION.  MUST                      
*                        BE RESIDENT,  USES TT OVERLAY                          
*                 ENTRY IS VIA ALTERNATE PSD OR A DIRECT                        
*                 BRANCH WITH SECONDARY TASKS CONTEXT IN                        
*                 EFFECT.                                                       
TTFINAL  LB,R4    TCBPOINT          SET R4=TASK ID                              
         LI,R5    0                                                             
         STH,R5   STIOVID,R4        ZERO OVERLAY I.D.                           
         LB,R5    STILMID,R4            R5=LMID                                 
         LB,R6    STIJID,R4         R6=JID                                      
         DISABLE                    CHECK FOR REENTRY INTO                      
         LH,R0    LMISTAT,R5            TTFINAL                                 
         CI,R0    LMITENT                                                       
         BANZ     TTFCR                 YES, CRASH                              
         AI,R0    LMITENT               NO, SET ENTRY BIT                       
         STH,R0   LMISTAT,R5                                                    
         ENABLE                                                                 
         LW,R1    XSTCBRBM          SET THE RBM BIT IN PCBPOINT                 
         STS,R1   PCBPOINT              FLAGS                                   
         LD,R0    ZEROS             ZERO STI RTS BASE ADDR                      
         STD,R0   STIRTSB,R4                                                    
         DO       #MAP                                                          
         LW,R0    *K:RTS            IF THE TEMP STACK IS IN                     
         CI,R0    RBM                   TSPACE (BELOW START OF                  
         BGE      TTF01                 RBM), USE IT                            
         FIN      #MAP                                                          
         LI,R1    3                 REMOVE ANY JUNK FROM TI                     
         LCH,R0   *K:RTS,R1             STACK AND USE IT                        
         MSP,R0   *K:RTS                                                        
         DO       #MAP                                                          
         B        TTF02                                                         
TTF01    LI,R7    TTRTS             GET A RELIABLE TEMP STACK                   
         BAL,R8   GETTEMP                                                       
         B        TTF03             NO RTS STACK SPACE IN TSPACE                
         ENABLE                     TASK IS ALREADY IN TERMINATION              
         LW,R8    R7                    NO NEED TO PREVENT LOSS                 
         AI,R8    -1                    OF TSPACE DUE TO TERM                   
         AND,R8   M17                   REMOVE LENGTH                           
         LB,R9    R7                    BUILD AND STORE RTS                     
         STH,R9   R9                    CONTROL DOUBLEWORD                      
         AND,R9   YFFFF                                                         
         STD,R8   *K:RTS                                                        
*                                                                               
         FIN      #MAP                                                          
TTF02    BAL,R8   TT                GO TO TT OVERLAY AND DO                     
*                                   TERMINATION LOGIC                           
*                 REGISTERS AT RETURN MUST BE AS FOLLOWS:                       
*                 R1 - LEVEL BIT FOR DISPATCHER CONTROLLING TT                  
*                 R2 - GROUP (TRIGGER FORMAT) OF DISPATCHER                     
*                 R4 - TASK ID (STI INDEX)                                      
*                 R5 - LOAD MODULE ID (LMI INDEX)                               
*                 R6 - RDLI INDEX OF DISPATCHER                                 
*                 R12 - TCBPOINT FROM TASKS STCB                                
*                 R13 - PCBPOINT FROM TASKS STCB                                
*                 R14 - ZERO                                                    
*                 R15 - ZERO                                                    
*                                                                               
         DO       #MAP                                                          
         LW,R7    *K:RTS            BUILD THE RELTEMP ARGUMENT                  
         AI,R7    1                                                             
         LI,R3    2                     AND FREE THE TEMPSTACK                  
         LH,R0    *K:RTS,R3                                                     
         STB,R0   R7                    SPACE ACQUIRED                          
         BAL,R8   RELTEMPI          RELEASE STACK                               
         FIN      #MAP                                                          
*                                                                               
*                                   ***** FREE THE STI,LMI                      
*                                         STCB AND DISAPPEAR*****               
*                                                                               
         LW,R7    STITCB,R4         R5=LMID                                     
         LI,R0    STCBSIZE          R6=RDLI LEVEL                               
         STB,R0   R7                R7=STCB                                     
         LI,R3    LMIRTS+2*CTID                                                 
         STW,R3   K:RTS             POINT TO CONTROL TASK RTS                   
         BAL,R8   RELTEMPI          RELEASE THE STCB                            
*                                                                               
         DISABLE                                                                
*                                                                               
         STW,R14  TDLAST            ZERO ID OF LAST TASK DISPATCHED             
         STH,R14  LMISTAT,R5        FREE THE LMI                                
         STD,R14  LMINAME,R5                                                    
         MTW,1    RUN99                                                         
         DO1      #MULTDSP                                                      
         XPSD,0   TMDQR             REMOVE THE STI FROM QUEUES                  
         STW,R14  STITCB,R4         FREE THE STI                                
         LI,R14   1                                                             
         STW,R14  TDTRIG            SET SOFTWARE TRIGGER FLAG                   
         WD,R1    -X'0500',R2       ARM AND ENABLE THE RDL                      
         WD,R1    0,R2              TRIGGER RDL                                 
         STW,R12  TCBPOINT          RESTORE THE DISPATCHERS                     
         STW,R13  PCBPOINT              TCB AND PCB POINTERS                    
         DO       #UST                                                          
*                 SEE IF ANYTHING CAN BE LOADED NOW                             
         MTB,1    K:FGLD            INDICATE FGLD SHOULD RUN                    
         LW,R11   K:CTST            FGLD SET RUNNING                            
         CW,R11   Y4                                                            
         BAZ      STFGL             NO                                          
         LW,R11   Y0008              YES                                        
         STS,R11  K:CTST             SET RECYCLE                                
STFGL    EQU      %                                                             
         BAL,R11  CTRIG             TRIGGER THE CONTROL TASK                    
         FIN      #UST                                                          
*                                                                               
         ENABLE                     THE TASK IS NOW NON-EXISTANT                
*                                                                               
         LI,R13   100                                                           
         BDR,R13  %                 WAIT FOR INTERRUPT                          
TTFCR    CRASH    'TT FAILURE'                                                  
*                                                                               
*                 ********** LOGIC TO ALTER PRIORITY TO LOW :*****              
*                                                                               
         DO       #MAP                                                          
TTF03    LW,R1    XSTIPR                SET PRIO = FFFF                         
         DISABLE                                                                
         STS,R1   STIPRIO,R4                                                    
         LW,R1    XSTICA                                                        
         STS,R1   STITCB,R4                                                     
         DO1      #MULTDSP                                                      
         XPSD,0   TMDQ              REQUEUE THE STI                             
         ENABLE                                                                 
         BAL,R8   TMRDLTRG              REDISPATCH LOW                          
         B        TTF01                                                         
*                                                                               
TTRTS    EQU      128               SIZE OF TT TEMP STACK                       
         FIN      #MAP                                                          
         TITLE    'GETTEMP AND RELTEMP SERVICE ROUTINES'                        
***********************************************************************         
*        GETTEMP DESIGNED AND WRITTEN BY DAVE CRONK 05-01-72                    
*                                                                               
*        CALL CONDITIONS                                                        
*                                                                               
*        R8=LINK                                                                
*        R7 = NUMBER OF WORDS FROM 1 THRU 255                                   
*                                                                               
*        RETURNS    TO   LINK  IF NO  SPACE/LINK+1 IF NORMAL                    
*        R0=DESTROYED                                                           
*        R1--R6=SAVED                                                           
*        R7=BYTE  ONE/ORIGINAL R7    BYTE2,3,4/SPACE ADDRESS OR                 
*             IF  NO SPACE R7 = SAVED                                           
*        R8=LINK                                                                
*        R9--R11=DESTROYED                                                      
*        R12--R15=SAVED NORMALLY  R15=TYC IF NO SPCE                            
*        RETURNS DISABLED(DISABLES JUST BEFORE GETTING SPACE)                   
*        RETURNS ENABLED IF NO SPACE EXIT                                       
***********************************************************************         
GETTEMPI RES      0                 INHIBITED ENTRY                             
         LW,R9    Y008              SET INHIBIT INDICATOR                       
         STS,R9   R8                IN R8                                       
GETTEMP  DISABLE                                                                
         STB,R7   R8                SAVE VALUE 1 THRU 255                       
GETTMPA  LB,R7    R8                GET SPACE SIZE                              
         AI,R7    -1                LESS ONE TOO ROUND DOWN                     
         BGEZ     %+2               REBIAS FOR ZERO(256) CASE                   
         AI,R7    256                                                           
         CI,R7    16                IS IT LESS THAN 4TH POWER                   
         BL       GETTMPB           YES                                         
         SLS,R7   -4                NO, SHIFT OFF LOW ORDER STUFF               
         LB,R7    GABBLE,R7         AND GET POWER                               
         AI,R7    4                 AND ADD 4                                   
         B        %+2                                                           
GETTMPB  LB,R7    GABBLE,R7         JUST GET POWER                              
         LW,R10   GREENT            SAVE IN REGISTER                            
         LW,R11   R7                SAVE ORIGINAL POWER                         
         CW,R8    Y008              IS INHIBIT INDICATOR SET                    
         BANZ     %+2               YES                                         
         ENABLE                                                                 
GETTMPX  ANLZ,R9  %+1               GET ADDRESS OF HEAD                         
         CW,R9    GTBL,R7           ANY SPACE AT THIS LEVEL                     
         BNE      GETTMP1           YES                                         
         CI,R7    8                                                             
         BE       GETTMPZ           NO SPACE                                    
         AI,R7    1                 INCREMENT POWER                             
         B        GETTMPX           RECURSE                                     
*                                                                               
*                                                                               
*                                                                               
GETTMPR  AI,R7    -1                DECREMENT LEVEL                             
         AW,R9    GINC,R7           SPLIT THE BLOCK                             
         LW,R0    GTBL,R7           GET PRESENT HEAD                            
         STW,R9   GTBL,R7           LINK NEW HEAD                               
         STW,R9   *R9,R7            MARK IT AVAILABLE                           
         STW,R0   *R9               LINK OLD HEAD                               
         SW,R9    GINC,R7           GET OTHER HALF                              
         B        GETTMPY           EXIT                                        
*                                                                               
GETTMP1  LW,R9    GTBL,R7           GET BLOCK                                   
         DISABLE                                                                
         CW,R10   GREENT            HAS REENTRANCE OCCURRED                     
         BNE      GETTMPA           YES                                         
         MTW,1    GREENT            INC REENTRANCY COUNTER                      
         LW,R0    *R9               GET NEW HEAD                                
         STW,R0   GTBL,R7           LINK IT IN                                  
         STW,R7   *R9,R7            UNMARK SPACE                                
*                                                                               
GETTMPY  CW,R7    R11               ENTRY LEVEL                                 
         BNE      GETTMPR           NO                                          
*        ENABLE                     IF TRUE REENTRANCE DESIRED                  
         LI,R0    0                                                             
         STW,R0   *R9               CLEAR WORD ONE OF SPACE                     
         LB,R0    R8                GET ORIGINAL WORD COUNT                     
         STB,R0   R9                ADD TO ADR OF SPACE                         
         LW,R7    R9                PUT IN R7 FOR EXIT                          
         AI,R8    1                 BUMP LINK FOR NORMAL RETURN                 
         B        *R8               RETURN TO CALLER                            
*                                                                               
GETTMPZ  LI,R15   X'66'             TYC FOR NO SPACE                            
         LB,R7    R8                PUT ORIGINAL IN R7                          
         B        *R8               RETURN TO CALLER                            
*                                                                               
* FAST POWER OF TWO TABLE                                                       
*                                                                               
GABBLE   DATA     X'01010202',X'03030303',X'04040404',X'04040404'               
         PAGE                                                                   
GINC     DATA,4   0,2,4,8,16,32,64,128                                          
GTBL     DATA,4   256               OVERLAP TABLES                              
         DATA,4   %,%,%,%,%,%,%     POINT TO SELF                               
GMSK     DATA,4   %,-3,-5,-9,-17,-33,-65,-129                                   
GREENT   DATA     0                                                             
         BOUND    8                                                             
GTEMP    DATA     S:TEMP            BASE OF SPACE                               
GUTEMP   DATA     0                 UPPER BOUND OF SPACE                        
         PAGE                                                                   
***********************************************************************         
*        RELTEMP DESIGNED AND WRITTEN BY DAVE CRONK 05-01-72                    
*                                                                               
*        CALL CONDITIONS                                                        
*                                                                               
*        R8=LINK                                                                
*        R7=BYTE  1 / NO. OF WORDS  BYTE 2,3,4/ADR OF SPACE                     
*                                                                               
*        RETURUNS TO LINK                                                       
*        R0=DESTROYED                                                           
*        R1--R6=SAVED                                                           
*        R7=NO OF WORDS                                                         
*        R8=LINK                                                                
*        R9--R11=DESTROYED                                                      
*        R12--R15=SAVED                                                         
*        RETURNS ENABLED(ENABLES JUST AFTER RELEASING SPACE)                    
***********************************************************************         
RELTEMPI RES      0                 INHIBITED ENTRY                             
         LW,R9    Y008              SET INHIVIT INDICATOR                       
         STS,R9   R8                IN R8                                       
RELTEMP  DISABLE                                                                
         LW,R9    R7                GET ADDRESS                                 
         LB,R0    R7                RIGHT JUSTIFY 1 THRU 255                    
         STB,R0   R8                SAVE WORDS                                  
         AND,R9   M17               CLEAR UPPER BYTE                            
         CLM,R9   GTEMP             OUT OF BOUNDS                               
         BCS,9    RELCRASH          YES                                         
         LB,R7    R8                GET SPACE SIZE                              
         AI,R7    -1                LESS ONE TOO ROUND DOWN                     
         BGEZ     %+2               REBIAS FOR ZERO(256) CASE                   
         AI,R7    256                                                           
         CI,R7    16                IS IT LESS THAN 4TH POWER                   
         BL       RELTMPB           YES                                         
         SLS,R7   -4                NO, SHIFT OFF LOW ORDER STUFF               
         LB,R7    GABBLE,R7         AND GET POWER                               
         AI,R7    4                 AND ADD 4                                   
         B        %+2                                                           
RELTMPB  LB,R7    GABBLE,R7         JUST GET POWER                              
*                                   USE * FOR TRUE REENTRANCE                   
*        LW,R10   GREENT            SAVE COUNT IN REGISTER                      
*RELTMPX ENABLE                                                                 
*        DISABLE                                                                
*        CW,R10   GREENT            HAS REENTRANCE OCCURRED                     
*        BNE      RELTMPA           YES                                         
RELTMPX  SW,R9    GTEMP             BASE OF SPACE                               
         EOR,R9   GINC,R7           GET ADDRESS OF BUDDY                        
         AI,R9    S:TEMP            BASE OF SPACE                               
         LW,R0    R9                PRESERVE                                    
         AW,R0    GINC,R7           CHECK FOR UPPER                             
         CW,R0    GUTEMP            BOUND                                       
         BG       RELTMP1           GREATER                                     
         CW,R9    *R9,R7            IS IT AVAIBLE                               
         BNE      RELTMP1           NO                                          
         CI,R7    8                 LARGEST                                     
         BE       RELTMP1           YES                                         
         LW,R0    GTBL,R7           PROBABLY                                    
RELTMP3  CW,R9    *R0               IS THIS IT                                  
         BE       RELTMP2           YES                                         
         LW,R0    *R0               GET NEXT                                    
         CW,R0    GTBL,R7           DONE                                        
         BE       RELTMP1           NO                                          
         B        RELTMP3           GO ON                                       
RELTMP2  STW,R7   *R9,R7            FOUND BUDDY,UNMARK IT                       
         LW,R11   *R9               DELINK BUDDY                                
         STW,R11  *R0                                                           
         SW,R9    GTEMP             BASE OF SPACE                               
         AND,R9   GMSK,R7           GET BASE OF PAIR                            
         AI,R9    S:TEMP            BASE OF SPACE                               
         AI,R7    1                 BUMP POWER                                  
         B        RELTMPX           RECURSE                                     
*                                                                               
RELTMP1  SW,R9    GTEMP             BASE OF SPACE                               
         EOR,R9   GINC,R7           GET ORIGINAL ADDRESS                        
         AI,R9    S:TEMP            BASE OF SPACE                               
         LW,R0    GTBL,R7           LINK IN                                     
         STW,R0   *R9               NEW SPACE                                   
         STW,R9   *R9,R7            MARK IT                                     
         STW,R9   GTBL,R7                                                       
         MTW,1    GREENT            INC REENTRANCY COUNTER                      
*                                                                               
         CW,R8    Y008              IS INHIBIT INDICATOR SET                    
         BANZ     %+2               YES                                         
         ENABLE                                                                 
         LB,R7    R8                GET ORIGINAL COUNT                          
         B        *R8               RETURN                                      
*                                                                               
RELCRASH CRASH    'BAD SPACE RELEASED'                                          
*                                                                               
         BOUND    8                                                             
KEYBUF   EQU      %                 KEYIN BUFFER                                
         DO       KEYBYTES/4                                                    
         TEXT     '    '            BLANKS                                      
         FIN                                                                    
*                                                                               
         TITLE    'OVERLAY MANAGEMENT'                                          
********************************                                                
*    OMAN(OVERLAY MANAGER)                                                      
********************************                                                
* ENTRY-THIS PROGRAM CAN ONLY BE CALLED BY LINKS                                
*       SET UP BY SYSLOAD IN TABLE EPIEP OR BY A                                
*       SPECIAL RBMEXIT CHECK                                                   
*                                                                               
* EXIT -ALL REGISTERS,CC,INHIBITS,ETC. ARE THE SAME AS                          
*       UPON ENTRY(UNINHIBITS HAVE OCCURRED HOWEVER)                            
*       ONE STACK WORD IS IN USE UNTIL OVERLAY EXIT                             
*                                                                               
*                                                                               
OMAN     RES      0                 ENTERED BY BAL FROM CAL1                    
         LI,R1    X'1FFFF'                                                      
         AND,R1   CAL1PSD           GET ADDRESS OF CAL1                         
         CI,R1    OLAYFWA+OLAYSIZE  IS IT AN EXIT POINT                         
         BGE      *R0               NO                                          
         CI,R1    OLAYFWA           BELOW START OF OVERLAY                      
         BL       OMANE1            YES                                         
         LW,R1    *R1               GET CAL1 INSTRUCTION                        
         AND,R1   XFFFFFF           MASK OFF CAL1                               
         CI,R1    EPIB              IS IT AN EXIT POINT                         
         BGE      *R0               NO                                          
         AI,R1    -EPIEP            LOWER THAN THE BASE                         
         BLEZ     *R0               YES, NOT EXIT POINT                         
         LI,R0    0                 SET R0 FOR EXIT POINT                       
         B        OMANSET           COMMON START                                
OMANE1   CI,R1    EPIB              IS IT IN EP TABLE                           
         BGE      *R0               NO                                          
         AI,R1    -EPIEP            SUB TABLE BASE                              
         BLEZ     *R0               NO                                          
         DO       #PATCH                                                        
         LW,R0    S:TRACE           WAS TRACE SET UP                            
*                                   IF YES, WE MUST GO TO TRACE                 
*                                   EVEN IF INDIVIDUAL EP NOT TRACED            
*                                   OR STUFFING IN BUFFER TEMPORARILY           
*                                   TURNED OFF BY SETTING (S:TRACES=0)          
         BEZ      OMANE2            NO                                          
         STD,R0   OMANR0R1          SAVE R0 AND R1                              
         XPSD,0   OMANTPSD          GO TO TRACER                                
         LD,R0    OMANR0R1          RESTORE R0 AND R1                           
OMANE2   RES      0                                                             
         FIN      #PATCH                                                        
         LH,R0    *CAL1PSD          GET CAL1 INST                               
         AND,R0   X7F               MASK OFF OVERLAY ID                         
OMANSET  RES      0                                                             
         STD,R0   OMANR0R1          SAVE R0 AND R1                              
         DO       #MAP                                                          
         LH,R0    CAL1PSD                                                       
         BAL,R1   SETMAP            MAP IF MAPPED                               
         FIN      #MAP                                                          
         LI,R1    2                 ENOUGH ROOM                                 
         LH,R0    *K:RTS,R1         GET ROOM                                    
         CI,R0    41                NEEDED                                      
         BL       TMABORT           MUST ABORT TASK                             
         LD,R0    TEMP              GET RO,R1                                   
         PUSH     0,R0              PUSH ALL REGS                               
         MTW,1    OMANRENT          UP RE-ENTRANCY COUNT                        
         LB,R3    TCBPOINT          STI INDEX                                   
         LD,R0    OMANR0R1          RESTORE R0 AND R1                           
         LW,R2    R0                SET OVERLAY ID IN R2                        
         CI,R1    0                 RELOAD OF AN OVERLAY                        
         BE       OMANALLX          YES                                         
         CI,R0    0                 IS THIS AN EXIT                             
         BNE      OMANNP            NO                                          
*                                                                               
OMAN1A   LW,R2    *K:RTS            GET OLD OVID                                
         AI,R2    -16                                                           
         LW,R2    *R2                                                           
         BEZ      OMAN1B            EXIT POINT                                  
         BLZ      OMAN1AA           CRASH IF NEGATIVE                           
         LB,R0    OVIGR                                                         
         CW,R2    R0                IS IT LEGAL                                 
         BLE      OMANALLX          YES GO RESTORE LAST OLAY                    
OMAN1AA  RES      0                                                             
         CRASH    'OMAN SAYS STACK MESSED UP'                                   
OMAN1B   STH,R2   STIOVID,R3        CLEAR OVID                                  
         B        OMANDN1                                                       
*                                                                               
OMANRE   STD,R0   TEMP              SAVE RO AND R1                              
         LB,R1    TCBPOINT          GET TASKID                                  
         LH,R0    STIOVID,R1        GET OLD OVID                                
         LI,R1    0                 INDICATE RELOAD                             
         B        OMANSET           GO TO GENERAL START                         
OMANNP   LH,R2    STIOVID,R3        GET ACTIVE OVERLAY                          
         PUSH     R2                SAVE IT                                     
         LW,R2    R0                GET NEW OVERLAY ID                          
*                                                                               
OMANALLX RES      0                                                             
         DO       #MAP                                                          
         BIFREAL  OMANPPSD                                                      
         MTB,1    OVICT,R2          INCREMENT USER COUNT                        
         MTW,1    OVIUSAGE,R2       INCREMENT TOTAL USAGE COUNT                 
         BNEZ     OMANPPSD          OVERFLOW: B IF NOT                          
         LB,R4    OVIGR             YES,GET INDEX                               
         LI,R0    0                 CLEAR COUNTS                                
         STB,R0   OVICT,R4                                                      
         BDR,R4   %-1               NEXT                                        
         FIN      #MAP                                                          
*                                                                               
*                                                                               
OMANPPSD RES      0                                                             
         LD,R4    CAL1PSD           GET PSD                                     
         PUSH     2,R4              PRESERVE IT                                 
*                                                                               
OMANALL  LI,R0    0                                                             
         STH,R0   STIOVID,R3        CLEAR TASKS NEED FOR OVERLAY                
         ENABLE                                                                 
         SCD,R0   64                HOLD THE WINDOW OPEN                        
         DISABLE                                                                
*                                                                               
         DO       #MAP                                                          
         BIFMAP   OMANMAP           BRANCH IF MAPPED                            
         FIN      #MAP                                                          
*                                                                               
         LB,R0    OMANTYC           IS LAST READ DONE                           
         BNEZ     OMANT1            DONE                                        
         PUSH     3,R1              SAVE R1,R2,R3                               
         LI,R1    SPINDEX           SET SP AREA INDEX TO                        
         LB,R1    MDDCTI,R1         GET DCT INDEX FOR AREA'S DEVICE             
         BAL,R2   SERDEV            DRIVE IT                                    
         PULL     3,R1                                                          
         B        OMANALL           DONE YET                                    
OMANT1   CI,R0    1                 NORMAL COMPLETION                           
         BE       OMANT2            YES                                         
         CI,R0    4                 RETRY CODE                                  
         BNE      OMANT1A           NO                                          
         LI,R0    0                                                             
         STW,R0   OMANOV            CLEAR OVERLAY ID                            
         B        OMANT2            KEEP GOING                                  
OMANT1A  CRASH    'UNABLE TO READ OVERLAY'                                      
*                                                                               
OMANT2   CW,R2    OMANOV                                                        
         BE       OMANDN            DONE                                        
         DO       #MAP                                                          
         LH,R4    OVIMA,R2          IS IT IN CORE                               
         BEZ      OMANT3            NO                                          
         LW,R0    OVIECB,R2         JUST COMING IN                              
         BNEZ     OMANT3            YES                                         
         LI,R0    0                 CLEAR OVID                                  
         STW,R0   OMANOV                                                        
         SLS,R4   9                 CREATE WORD ADR.                            
         LI,R5    OLAYFWA           FIRST ADR OF OLAY AREA                      
         LW,R6    OMANRENT                                                      
         LH,R7    OVILG,R2          BYTE LENGTH OF OVERLAY                      
         AI,R7    X'7F'             FOR ROUNDING UP                             
         SLS,R7   -7                GET NUMBER OF 32 WORD LUMPS                 
OMANT2A  RES      0                                                             
         DO       #SIGMA9                                                       
         WD,R0    X'47'             SET MODE ALTERED                            
         FIN      #SIGMA9                                                       
         DO       #SIGMA9M                                                      
         LPSD,0    PSDRE1                                                       
         BOUND     8                                                            
PSDRE1   DATA      %+2                                                          
         DATA      X'07800000'                                                  
         FIN       #SIGMA9M                                                     
         LCI      8                                                             
         LM,R8    0,R4                                                          
         STM,R8   0,R5                                                          
         LM,R8    8,R4                                                          
         STM,R8   8,R5                                                          
         LM,R8    16,R4                                                         
         STM,R8   16,R5                                                         
         LM,R8    24,R4                                                         
         STM,R8   24,R5                                                         
         AI,R4    32                                                            
         AI,R5    32                                                            
         DO       #SIGMA9                                                       
         WD,R0    X'46'             RESET MODE ALTERED                          
         FIN      #SIGMA9                                                       
         DO       #SIGMA9M                                                      
         LPSD,0    PSDRE2                                                       
         BOUND     8                                                            
PSDRE2   DATA      %+2                                                          
         DATA      X'00000000'                                                  
         FIN       #SIGMA9M                                                     
         ENABLE                                                                 
         DISABLE                                                                
         CW,R6    OMANRENT          HAS RE-ENTRANCE OCCURRED                    
         BNE      OMANALL           YES                                         
         BDR,R7   OMANT2A           NEXT                                        
         STW,R2   OMANOV            SET IT ACTIVE                               
         B        OMANALL                                                       
OMANT3   RES      0                                                             
         FIN      #MAP                                                          
         LI,R4    FCRRAD            SEEK READ RAD OR DISK                       
         LI,R6    6                 NO. OF RETRIES                              
         LI,R7    SPINDEX           SET SP AREA INDEX TO                        
         LB,R7    MDDCTI,R7         GET DCT INDEX FOR AREA'S DEVICE             
         LD,R8    OMANEA            END ACTION                                  
         LI,R10   OLAYFWA                                                       
         SLS,R10  2                 BYTE ADR OF BUFFER                          
         LH,R11   OVILG,R2          GET BYTE LENGTH                             
         LW,R12   OVISK,R2          GET SEEK ADDRESS                            
         LI,R13   1                 PRIORITY HIGHEST                            
         STW,R2   OMANOV                                                        
         LI,R0    0                 CLEAR TYC                                   
         STW,R0   OMANTYC                                                       
         BAL,R5   QUEUE                                                         
         B        OMANT1A           DOWN                                        
         B        OMANALL                                                       
*                                                                               
*                                                                               
OMANDN   STH,R2   STIOVID,R3        SET ACTIVE OVERLAY                          
         PULL     2,R4                                                          
         STD,R4   CAL1PSD           SET UP EXIT                                 
         CI,R1    0                 EPIOV EQUAL ZERO                            
         BNE      OMANDN1           NO                                          
         TRACE,R0 'OM',6            TRACE ALL                                   
*                                                                               
OMANDN2  PULL     0,R0              SET UP REGISTERS                            
         LPSD,0   CAL1PSD           RETURN                                      
*                                                                               
OMANDN1  RES      0                                                             
         TRACE,R0 'O1',6                                                        
         LW,R0    CAL1PSD           SET UP EXIT                                 
         AND,R0   YFFFE             CLEAR ADR                                   
         LW,R4    CAL1PSD           GET ADDRESS OF TRAP                         
         AND,R4   M17               MASK IT OFF                                 
         CI,R4    EPIB              ENTRY OR EXIT                               
         BG       OMANDN3           EXIT                                        
         LW,R4    *CAL1PSD          GET EP                                      
         AND,R4   M16               GET ENTRY ADDRESS IN OVERLAY                
         AW,R0    R4                SET UP PSD                                  
         STW,R0   CAL1PSD           STORE PSD                                   
         PULL     R0                GET LAST OVID                               
         STW,R0   OMANS             SAVE IT                                     
         PULL     0,R0              GET ALL REGISTERS                           
         XW,R0    OMANS                                                         
         PUSH     R0                PUSH OLD OVID                               
         XW,R0    OMANS                                                         
         LPSD,0   CAL1PSD           RETURN                                      
*                                                                               
OMANDN3  RES      0                                                             
         AI,R0    EPIEP             ADD BASE OF EP TABLE                        
         AW,R0    R1                PLUS EXIT OFFSET                            
         STW,R0   CAL1PSD           SET UP PSD                                  
         PULL     0,R0              GET REGISTERS                               
         STW,R0   OMANS             SAVE R0                                     
         PULL     R0                RULL OLD STIOVID                            
         LW,R0    OMANS             RESTORE R0                                  
         LPSD,0   CAL1PSD           EXIT                                        
*                                                                               
*                                                                               
*                                                                               
         DO       #MAP                                                          
OMANMAP  DISABLE                    IS OVERLAY IN                               
         LH,R0    OVIMA,R2                                                      
         BEZ      OMANMP1                                                       
*                                                                               
         DO       #SIGMA9M                                                      
         CH,R0    OMANPAGE                                                      
         ELSE     #SIGMA9M                                                      
         CB,R0    OMANPAGE                                                      
         FIN      #SIGMA9M                                                      
*                                                                               
         BE       OMANDN            YES                                         
         LW,R0    OVIECB,R2         GET HEAD OF ECB CHAIN                       
         BNEZ     OMANMP1           PRESENTLY COMING IN                         
         LH,R0    OVIMA,R2          GET ADR OF OVERLAY                          
*                                                                               
         DO       #SIGMA9M                                                      
         STH,R0   OMANPAGE                                                      
         ELSE     #SIGMA9M                                                      
         STB,R0   OMANPAGE                                                      
         FIN      #SIGMA9M                                                      
*                                                                               
         LD,R4    OMANMMC                                                       
         MMC,R4   4+#SIGMA9M        LOAD MAP                                    
         B        OMANDN            DONE                                        
*                                                                               
OMANMP4  DISABLE                                                                
         LI,R0    0                                                             
         DO       #SIGMA9M                                                      
*                                                                               
         STH,R0   OMANPAGE                                                      
         ELSE     #SIGMA9M                                                      
         STB,R0   OMANPAGE                                                      
         FIN      #SIGMA9M                                                      
*                                                                               
         LI,R6    0                 SET DUMMY SD ADDRESS                        
         BAL,R8   MMGSTM            GET A PAGE                                  
         B        OMANMPE           B IF NO PAGE AVAILABLE                      
         MTH,0    OVIMA,R2                                                      
         BNEZ     OMANMP2           B IF PAGE WAS ACQUIRED                      
         STH,R14  OVIMA,R2          SET NEW OLAY PAGE                           
         B        OMANMP5                                                       
*                                                                               
OMANMP2  RES      0                                                             
         BAL,R8   MMRSTM            RELEASE NEW PAGE                            
         B        OMANMP7A          AND RESTART                                 
OMANMPE  LB,R4    OVIGR             GET LENGTH OF OVI                           
         LI,R5    X'FF'             LARGE COUNT                                 
         DISABLE                                                                
         LH,R0    OVIMA,R2          IS IT THERE NOW                             
         BNEZ     OMANMP7A                                                      
*                                                                               
OMANMPG  LH,R0    OVIMA,R4          IS THIS ALLOCATED                           
         BEZ      OMANMPF           NO                                          
         MTW,0    OVIECB,R4         I/O IN PROGRESS                             
         BNEZ     OMANMPF           YES                                         
         CB,R5    OVICT,R4          SMALLEST                                    
         BL       OMANMPF           NO                                          
         LB,R5    OVICT,R4          YES                                         
         STB,R4   R5                SAVE THIS ONE                               
OMANMPF  BDR,R4   OMANMPG           AGAIN                                       
         LB,R4    R5                GET ONE FOUND                               
         BEZ      OMANMP7A          NONE, GO UNLINK SAFETY                      
         LI,R5    0                                                             
         LH,R14   OVIMA,R4          PUT IN R14 PAGE ADR                         
         STH,R5   OVIMA,R4          CLEAR IT                                    
         STH,R14  OVIMA,R2          SET NEW OLAY PAGE                           
         MTW,1    OMANRENT          AVOID CONFLICT WITH UNMAPPED OMAN           
         B        OMANMP5                                                       
*                                                                               
OMANMP1  LI,R7    2                 TWO WORDS                                   
         BAL,R8   GETTEMP           GET TEMP SPACE                              
         B        TMABORT           NONE AVAILABLE                              
         LW,R0    STISPCE,R3        LINK FOR SAFETY                             
         STW,R7   STISPCE,R3                                                    
         STW,R0   0,R7                                                          
OMANMP7  LH,R0    OVIMA,R2          IS MEMORY NEEDED                            
         BEZ      OMANMP4           YES                                         
         DISABLE                                                                
         LW,R0    OVIECB,R2         DONE YET                                    
         BNEZ     OMANMP5           NO                                          
OMANMP7A RES      0                                                             
         LW,R0    0,R7              UNLINK SPACE                                
         STW,R0   STISPCE,R3                                                    
         BAL,R8   RELTEMP           RELEASE IT                                  
         B        OMANALL           GO GET IT MAPPED                            
*                                                                               
OMANMP5  STW,R3   1,R7              SAVE TASK ID                                
         LW,R0    0,R7              UNLINK SAFETY                               
         STW,R0   STISPCE,R3                                                    
         LW,R0    OVIECB,R2         GET HEAD OF CHAIN                           
         STW,R0   0,R7              LINK THIS ONE                               
         STW,R7   OVIECB,R2                                                     
         CI,R0    0                 HAS I/O BEEN ISSUED                         
         BNE      OMANMP6           YES                                         
         LI,R4    FCRRAD            SEEK READ ON DISK OR RAD                    
         LI,R6    6                 NO. OF RETRIES                              
         LI,R7    SPINDEX           SET SP AREA INDEX TO                        
         LB,R7    MDDCTI,R7         GET DCT INDEX FOR AREA'S DEVICE             
         LD,R8    OMANMPEA          END ACTION                                  
         LH,R10   OVIMA,R2          PAGE ADR                                    
         SLS,R10  11                CREATE BYTE ADR                             
         LH,R11   OVILG,R2          GET BYTE LENGTH                             
         CI,R11   OLAYSIZE*4        BIGGER THAN BA(OLAY)                        
         BG       OMANT1A           YES,CRASH                                   
         LW,R12   OVISK,R2          GET SEEK ADR                                
         LI,R13   1                 PRIORITY HIGHEST                            
         BAL,R5   QUEUE                                                         
         B        OMANT1A                                                       
OMANMP6  DISABLE                                                                
*                                                                               
         LW,R7    OVIECB,R2         GET FIRST ECB                               
OMANMP6A RES      0                                                             
         BEZ      OMANALL           B:IF END OF ECB CHAIN                       
         CW,R3    1,R7              ECB FOR THIS TASK??                         
         BE       OMANMP6B          B:IF YES                                    
         LW,R7    0,R7              GET NEXT ECB                                
         B        OMANMP6A          RETURN                                      
*        THERE IS A ECB FOR THIS TASK - OV READ STILL PENDING                   
OMANMP6B RES      0                                                             
*                                                                               
         MTB,1    STICOUNT,R3       PUT IT IN WAIT                              
         LW,R5    R1                PRESERVE                                    
         BAL,R8   TMRDLTRG          GO DISPATCH                                 
         LW,R1    R5                RESTORE                                     
         B        OMANALL           GO MAP IT                                   
         FIN      #MAP                                                          
*                                                                               
*                                                                               
*                                                                               
         BOUND    8                                                             
         DO       #PATCH                                                        
OMANTPSD PSD      0,7                                                           
         FIN      #PATCH                                                        
OMANPSD  DATA     OMANRE                                                        
         GEN,8,24 7,0                                                           
OMANTYC  DATA     X'01000000'                                                   
OMANOV   DATA     0                                                             
         BOUND    8                                                             
OMANEA   GEN,8,24 1,OMANTYC                                                     
         DATA     0                                                             
OMANS    DATA     0                                                             
*                                                                               
OMANRENT DATA     0                 RE-ENTRANCY COUNT                           
         DO       #MAP                                                          
         BOUND    8                                                             
OMANMMC  DATA     OMANPAGE                                                      
         GEN,8,24 1,OLAYFWA                                                     
OMANPAGE DATA     0                                                             
OMANFWA  DATA     0                                                             
OMAN#PGS DATA     OMANCNT           NUMBER OF PAGES OMAN WILL KEEP              
         BOUND    8                                                             
OMANMPEA GEN,8,24 3,OMANCALL                                                    
         DATA     0                                                             
         FIN      #MAP                                                          
         BOUND    8                                                             
OMANR0R1 DATA     0,0                                                           
*                                                                               
*                                                                               
*                                                                               
         DO       #MAP                                                          
OMANCALL RES      0                                                             
         LW,R13   R14               SAVE LINK                                   
         AND,R12  M8                TYC                                         
         CI,R12   1                 NORMAL                                      
         BNE      OMANT1A           CRASH                                       
OMANPT1  DISABLE                                                                
         LW,R7    OVIECB,R2         GET NEXT ECB                                
         BEZ      OMANPT2                                                       
         LW,R0    0,R7              GET NEXT                                    
         STW,R0   OVIECB,R2         SET UP NEXT                                 
         LW,R4    1,R7              GET TASK ID                                 
         BAL,R8   RELTEMP           RELEASE TEMP                                
         LB,R0    STICOUNT,R4       IS IT ALREADY ZERO                          
         BEZ      %+2               YES                                         
         MTB,-1   STICOUNT,R4       DECREMENT IT                                
         BAL,R8   TMTRIG            GO TRIGGER DISPATCHER                       
         B        OMANPT1           AGAIN                                       
OMANPT2  B        *R13              RETURN                                      
********************                                                            
*     OMANFP                                                                    
********************                                                            
*                                                                               
*      BAL,R8 OAMNFP  FOR OMAN FREE ONE PAGE                                    
*             +1      NO PAGES TO FREE                                          
*             +2      ONE PAGE WAS FREED                                        
* DESTROYS R0,R1.R2,R4,R14 REST SAVED                                           
*                                                                               
OMANFP   DISABLE                    LOCATE LEAST USED OVERLAY                   
         LB,R1    OVIGR             GET LENGTH OF OVI                           
         LI,R4    0                                                             
         LI,R2    X'FF'             ZERO COUNT OF OVERLAY PGS                   
OMANFP2  LH,R0    OVIMA,R1          IS THIS ALLOCATED                           
         BEZ      OMANFP3           NO                                          
         AI,R4    1                     INCR # OF OVERLAY PAGES                 
         MTW,0    OVIECB,R1         I/O IN PROGRESS                             
         BNEZ     OMANFP3           YES                                         
         DO       #SIGMA9M                                                      
         CH,R0    OMANPAGE                                                      
         ELSE     #SIGMA9M                                                      
         CB,R0    OMANPAGE                                                      
         FIN      #SIGMA9M                                                      
         BE       OMANFP3           IN USE                                      
         CB,R2    OVICT,R1          SMALLEST                                    
         BL       OMANFP3           NO                                          
         LB,R2    OVICT,R1          YES                                         
         STB,R1   R2                SAVE THIS ONE                               
OMANFP3  BDR,R1   OMANFP2           AGAIN                                       
         LB,R1    R2                GET ONE FOUND                               
         BEZ      OMANFP4           NONE, GO TO NEXT LEVEL                      
         CW,R4    OMAN#PGS          MIN # OF PAGES TO OPERATE WITH              
         BLE      OMANFP4               DO NOT RELEASE ANY MORE                 
         LI,R2    0                                                             
         LH,R14   OVIMA,R1          PUT IN R14 PAGE ADR                         
         STH,R2   OVIMA,R1          CLEAR IT                                    
         MTW,1    OMANRENT              MODIFY RE-ENT COUNT                     
         PUSH     R8                SAVE LIN                                    
         BAL,R8   MMRSTM                                                        
         PULL     R8                RESTORE LINK                                
         AI,R8    1                 INCREMENT FOR NORMAL                        
OMANFP4  ENABLE                                                                 
         B        *R8               RETURN                                      
*                                                                               
*                                                                               
********************                                                            
*     OMANFPP            OMAN FREE PREFERRED PAGE                               
********************                                                            
*                                                                               
*      BAL,R8 OMANFPP                                                           
*             +1          PAGE ONE IN USE OR NONEXISTENT                        
*             +2          PAGE RELEASED                                         
*                                                                               
* R14 IS PAGE ADDRESS OF PREFERRED PAGE                                         
* R0 DESTROYED REST SAVED                                                       
*                                                                               
OMANFPP  PUSH     1,R7              SAVE REGS                                   
OMANFPP1 ENABLE                                                                 
         DISABLE                                                                
         LB,R7    OVIGR             GET NO. OF OVERLAYS                         
         CH,R14   OVIMA,R7          IS THIS IT                                  
         BE       OMANFPP2          YES                                         
         BDR,R7   %-2               TRY NEXT                                    
         B        OMANFPP3          NOT FOUND                                   
OMANFPP2 MTW,0    OVIECB,R7         I/O ACTIVE IN PAGE                          
         BNEZ     OMANFPP1          YES                                         
         LI,R0    0                                                             
         DO       #SIGMA9M                                                      
         CH,R14   OMANPAGE                                                      
         ELSE     #SIGMA9M                                                      
         CB,R14   OMANPAGE                                                      
         FIN      #SIGMA9M                                                      
         BNE      OMANFPP4          B IF NOT CURRENT PAGE                       
         PUSH     R8                                                            
         BAL,R8   TMRDLTRG          TRIGGER DISPATCHER TO RELOAD IT             
         PULL     R8                                                            
         DO       #SIGMA9M                                                      
         STH,R0   OMANPAGE          RELEASE IT                                  
         ELSE     #SIGMA9M                                                      
         STB,R0   OMANPAGE          RELEASE IT                                  
         FIN      #SIGMA9M                                                      
OMANFPP4 RES      0                                                             
         STH,R0   OVIMA,R7          MAPPED IN                                   
         MTW,1    OMANRENT          INCR REENTRACE                              
         PUSH     R8                SAVE LINK                                   
         BAL,R8   MMRSTM            GO RELEASE PAGE                             
         PULL     R8                RESTORE LINK                                
         AI,R8    1                 NORMAL RETURN                               
OMANFPP3 ENABLE                                                                 
         PULL     1,R7                                                          
         B        *R8               RETURN                                      
*                                                                               
*                                                                               
         FIN      #MAP                                                          
*                                                                               
ROOTEND  RES      0                                                             
*                                                                               
         END                                                                    
